From 64c5d19fc41aa985eb674c42934cfcb93fa4a801 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 4 Oct 2026 10:18:41 +0100
Subject: [PATCH 01/20] agent: aggregate cap on skipped message keys (#1903)

* agent: aggregate cap on skipped message keys

* migration

* update migration

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 simplexmq.cabal                               |  1 +
 src/Simplex/Messaging/Agent.hs                |  2 +-
 .../Messaging/Agent/Store/AgentStore.hs       | 12 ++++++---
 .../Agent/Store/Postgres/Migrations/App.hs    |  4 ++-
 .../M20260929_skipped_messages_index.hs       | 21 +++++++++++++++
 .../Migrations/agent_postgres_schema.sql      |  2 +-
 src/Simplex/Messaging/Crypto/Ratchet.hs       |  4 +++
 tests/AgentTests/SQLiteTests.hs               | 26 ++++++++++++++++++-
 8 files changed, 64 insertions(+), 8 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 39b40dd33..78fd61a1f 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -195,6 +195,7 @@ library
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index
   else
       exposed-modules:
           Simplex.Messaging.Agent.Store.SQLite
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index be34deafb..1cf455114 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -4386,7 +4386,7 @@ agentRatchetDecrypt g db connId encAgentMsg = do
 
 agentRatchetDecrypt' :: TVar ChaChaDRG -> DB.Connection -> ConnId -> CR.RatchetX448 -> ByteString -> ExceptT StoreError IO (ByteString, PQEncryption)
 agentRatchetDecrypt' g db connId rc encAgentMsg = do
-  skipped <- liftIO $ getSkippedMsgKeys db connId
+  skipped <- liftIO $ getSkippedMsgKeys db connId CR.maxSkippedMsgKeys
   (agentMsgBody_, rc', skippedDiff) <- withExceptT (SEAgentError . cryptoError) $ CR.rcDecrypt g rc skipped encAgentMsg
   agentMsgBody <- liftEither $ first (SEAgentError . cryptoError) agentMsgBody_
   liftIO $ updateRatchet db connId rc' skippedDiff
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 311cdc14e..38b454c2b 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -1594,12 +1594,16 @@ getRatchet_ q db connId =
   where
     ratchet = maybe (Left SERatchetNotFound) Right . fromOnly
 
-getSkippedMsgKeys :: DB.Connection -> ConnId -> IO SkippedMsgKeys
-getSkippedMsgKeys db connId =
-  skipped <$> DB.query db "SELECT header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ?" (Only connId)
+getSkippedMsgKeys :: DB.Connection -> ConnId -> Int -> IO SkippedMsgKeys
+getSkippedMsgKeys db connId maxKeys = do
+  (keys, oldKeys) <- splitAt maxKeys <$> DB.query db "SELECT skipped_message_id, header_key, msg_n, msg_key FROM skipped_messages WHERE conn_id = ? ORDER BY skipped_message_id DESC LIMIT ?" (connId, maxKeys + 1)
+  case oldKeys of
+    (skippedMsgId :: Int64, _, _, _) : _ -> DB.execute db "DELETE FROM skipped_messages WHERE conn_id = ? AND skipped_message_id <= ?" (connId, skippedMsgId)
+    [] -> pure ()
+  pure $ skipped keys
   where
     skipped = foldl' addSkippedKey M.empty
-    addSkippedKey smks (hk, msgN, mk) = M.alter (Just . addMsgKey) hk smks
+    addSkippedKey smks (_, hk, msgN, mk) = M.alter (Just . addMsgKey) hk smks
       where
         addMsgKey = maybe (M.singleton msgN mk) (M.insert msgN mk)
 
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
index f34b120e2..0173c4fb8 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
@@ -16,6 +16,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -31,7 +32,8 @@ schemaMigrations =
     ("20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
     ("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
     ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
-    ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
+    ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
+    ("20260929_skipped_messages_index", m20260929_skipped_messages_index, Just down_m20260929_skipped_messages_index)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs
new file mode 100644
index 000000000..7f465cec7
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20260929_skipped_messages_index :: Text
+m20260929_skipped_messages_index =
+  [r|
+DROP INDEX idx_skipped_messages_conn_id;
+CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id, skipped_message_id);
+|]
+
+down_m20260929_skipped_messages_index :: Text
+down_m20260929_skipped_messages_index =
+  [r|
+DROP INDEX idx_skipped_messages_conn_id;
+CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
index a0d408c36..c5be00a6e 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
@@ -1241,7 +1241,7 @@ CREATE UNIQUE INDEX idx_server_certs_user_id_host_port ON smp_agent_test_protoco
 
 
 
-CREATE INDEX idx_skipped_messages_conn_id ON smp_agent_test_protocol_schema.skipped_messages USING btree (conn_id);
+CREATE INDEX idx_skipped_messages_conn_id ON smp_agent_test_protocol_schema.skipped_messages USING btree (conn_id, skipped_message_id);
 
 
 
diff --git a/src/Simplex/Messaging/Crypto/Ratchet.hs b/src/Simplex/Messaging/Crypto/Ratchet.hs
index fe74d772a..067fedd89 100644
--- a/src/Simplex/Messaging/Crypto/Ratchet.hs
+++ b/src/Simplex/Messaging/Crypto/Ratchet.hs
@@ -72,6 +72,7 @@ module Simplex.Messaging.Crypto.Ratchet
     rcEncryptHeader,
     rcEncryptMsg,
     rcDecrypt,
+    maxSkippedMsgKeys,
     -- used in tests
     MsgHeader (..),
     RatchetInitParams (..),
@@ -962,6 +963,9 @@ type DecryptResult a = (Either CryptoError ByteString, Ratchet a, SkippedMsgDiff
 maxSkip :: Word32
 maxSkip = 512
 
+maxSkippedMsgKeys :: Int
+maxSkippedMsgKeys = 2000
+
 rcDecrypt ::
   forall a.
   (AlgorithmI a, DhAlgorithm a) =>
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index c22eddd7a..0a418cabb 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -20,12 +20,13 @@ import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.MVar
 import Control.Concurrent.STM
 import Control.Exception (SomeException)
-import Control.Monad (replicateM_)
+import Control.Monad (forM_, replicateM_)
 import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.ByteArray (ScrubbedBytes)
 import Data.ByteString.Char8 (ByteString)
 import Data.List (isInfixOf)
+import qualified Data.Map.Strict as M
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time
@@ -51,6 +52,7 @@ import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.File (CryptoFile (..))
 import Simplex.Messaging.Crypto.Ratchet (pattern IKPQOn)
 import qualified Simplex.Messaging.Crypto.Ratchet as CR
+import Simplex.Messaging.Encoding (Encoding (..))
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
 import Simplex.Messaging.Protocol (EntityId (..), QueueMode (..), SubscriptionMode (..), pattern VersionSMPC)
 import qualified Simplex.Messaging.Protocol as SMP
@@ -135,6 +137,7 @@ storeTests = do
           testCreateRcvMsg
           testCreateSndMsg
           testCreateRcvAndSndMsgs
+      it "should keep only the newest skipped message keys" testGetSkippedMsgKeys
       describe "Work items" $ do
         it "should getPendingQueueMsg" testGetPendingQueueMsg
         it "should getPendingServerCommand" testGetPendingServerCommand
@@ -599,6 +602,27 @@ testCreateRcvAndSndMsgs =
       testCreateSndMsg_ db "snd_hash_1" connId sq $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
       testCreateSndMsg_ db "snd_hash_2" connId sq $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"
 
+testGetSkippedMsgKeys :: DBStore -> Expectation
+testGetSkippedMsgKeys st = do
+  g <- C.newRandom
+  withTransaction st $ \db -> do
+    Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
+    Right connId' <- createNewConn db g cData1 {connId = ""} SCMInvitation
+    createSkippedKeys db connId'
+    createSkippedKeys db connId
+    M.map M.keys <$> getSkippedMsgKeys db connId 4
+      `shouldReturn` M.singleton (C.Key "header_key") [1, 2, 3, 4]
+    getMsgNs db connId `shouldReturn` [1 .. 4]
+    getMsgNs db connId' `shouldReturn` [1 .. 10]
+  where
+    createSkippedKeys :: DB.Connection -> ConnId -> IO ()
+    createSkippedKeys db connId = do
+      DB.execute db "INSERT INTO ratchets (conn_id) VALUES (?)" (Only connId)
+      forM_ ([10, 9 .. 1] :: [Int]) $ \msgN ->
+        DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, "header_key" :: ByteString, msgN, smpEncode ("key" :: ByteString, "iv" :: ByteString))
+    getMsgNs :: DB.Connection -> ConnId -> IO [Int]
+    getMsgNs db connId = map fromOnly <$> DB.query db "SELECT msg_n FROM skipped_messages WHERE conn_id = ? ORDER BY msg_n" (Only connId)
+
 testCloseReopenStore :: IO ()
 testCloseReopenStore = do
   st <- createStore'

From 18440c0d17322975d24197392a2c8bf56b525bb7 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 4 Oct 2026 13:41:48 +0100
Subject: [PATCH 02/20] smp-server: check queue is not secured in link store
 (#1917)

Co-authored-by: shum <github.shum@liber.li>
---
 src/Simplex/Messaging/Server.hs               |  5 ---
 src/Simplex/Messaging/Server/QueueStore.hs    |  7 ++++
 .../Messaging/Server/QueueStore/Postgres.hs   |  7 ++--
 .../Messaging/Server/QueueStore/STM.hs        |  1 +
 tests/CoreTests/MsgStoreTests.hs              | 32 +++++++++++++++++--
 5 files changed, 42 insertions(+), 10 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 7894a4eab..7dd7817a7 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1319,11 +1319,6 @@ isContactQueue QueueRec {queueMode, senderKey} = case queueMode of
   Just QMContact -> True
   Nothing -> isNothing senderKey -- for backward compatibility with pre-SKEY contact addresses
 
-isSecuredMsgQueue :: QueueRec -> Bool
-isSecuredMsgQueue QueueRec {queueMode, senderKey} = case queueMode of
-  Just QMContact -> False
-  _ -> isJust senderKey
-
 -- Random correlation ID is used as a nonce in case crypto_box authenticator is used to authorize transmission
 verifyCmdAuthorization :: Maybe (THandleAuth 'TServer) -> Maybe TAuthorizations -> ByteString -> CorrId -> C.APublicAuthKey -> Bool
 verifyCmdAuthorization thAuth tAuth authorized corrId key = maybe False (verify key) tAuth
diff --git a/src/Simplex/Messaging/Server/QueueStore.hs b/src/Simplex/Messaging/Server/QueueStore.hs
index 3904871bf..fa86e85d4 100644
--- a/src/Simplex/Messaging/Server/QueueStore.hs
+++ b/src/Simplex/Messaging/Server/QueueStore.hs
@@ -13,12 +13,14 @@ module Simplex.Messaging.Server.QueueStore
     ServiceRec (..),
     CertFingerprint,
     ServerEntityStatus (..),
+    isSecuredMsgQueue,
   ) where
 
 import Control.Applicative (optional, (<|>))
 import qualified Data.ByteString.Char8 as B
 import Data.Functor (($>))
 import Data.List.NonEmpty (NonEmpty)
+import Data.Maybe (isJust)
 import qualified Data.X509 as X
 import qualified Data.X509.Validation as XV
 import Simplex.Messaging.Encoding
@@ -48,6 +50,11 @@ data QueueRec = QueueRec
   }
   deriving (Show)
 
+isSecuredMsgQueue :: QueueRec -> Bool
+isSecuredMsgQueue QueueRec {queueMode, senderKey} = case queueMode of
+  Just QMContact -> False
+  _ -> isJust senderKey
+
 data NtfCreds = NtfCreds
   { notifierId :: NotifierId,
     notifierKey :: NtfPublicAuthKey,
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
index 39f02131c..72f051fe3 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
@@ -314,9 +314,9 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
   addQueueLinkData st sq lnkId d =
     withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
       Nothing ->
-        addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId))
+        addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId, QMContact))
       Just (lnkId', _) | lnkId' == lnkId ->
-        addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, fst d))
+        addLink q $ \db -> DB.execute db (qry <> " AND (fixed_data IS NULL OR fixed_data = ?)") (d :. (lnkId, rId, QMContact, fst d))
       _ -> throwE AUTH
     where
       rId = recipientId sq
@@ -324,7 +324,8 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
         assertUpdated $ withDB' "addQueueLinkData" st update
         atomically $ writeTVar (queueRec sq) $ Just q {queueData = Just (lnkId, d)}
         withLog "addQueueLinkData" st $ \s -> logCreateLink s rId lnkId d
-      qry = "UPDATE msg_queues SET fixed_data = ?, user_data = ?, link_id = ? WHERE recipient_id = ? AND deleted_at IS NULL"
+      -- the sender key condition is checked in SQL because without cache each command reads its own copy of the queue record
+      qry = "UPDATE msg_queues SET fixed_data = ?, user_data = ?, link_id = ? WHERE recipient_id = ? AND deleted_at IS NULL AND (sender_key IS NULL OR queue_mode = ?)"
 
   deleteQueueLinkData :: PostgresQueueStore q -> q -> IO (Either ErrorType ())
   deleteQueueLinkData st sq =
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 1e17b9051..6e1a94802 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -173,6 +173,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       rId = recipientId sq
       qr = queueRec sq
       add q = case queueData q of
+        _ | isSecuredMsgQueue q -> pure $ Left AUTH
         Nothing -> addLink
         Just (lnkId', d') | lnkId' == lnkId && fst d' == fst d -> addLink
         _ -> pure $ Left AUTH
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 05878cc14..d4a2d7582 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -34,7 +34,7 @@ import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EntityId (..), ErrorType, LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
 import Simplex.Messaging.Server (exportMessages, importMessages, printMessageStats)
 import Simplex.Messaging.Server.Env.STM (MsgStore (..), journalMsgStoreDepth, readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..), expireBeforeEpoch)
@@ -43,6 +43,7 @@ import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
 import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
 import System.FilePath ((</>))
@@ -57,7 +58,6 @@ import Simplex.Messaging.Agent.Store.Postgres.Common
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Postgres
-import Simplex.Messaging.Server.QueueStore.Types
 import SMPClient (postgressBracket, testServerDBConnectInfo, testStoreDBOpts)
 #endif
 
@@ -101,6 +101,7 @@ msgStoreTests = do
       it "should get queue and store/read messages" testGetQueue
       it "should write/ack messages" testWriteAckMessages
       it "should not fail on EOF when changing read journal" testChangeReadJournal
+      it "should not add link data to secured messaging queue" testLinkDataSecuredQueue
 
 -- TODO constrain to STM stores?
 withMsgStore :: MsgStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
@@ -267,6 +268,33 @@ testChangeReadJournal ms = do
     (Msg "message 5", Nothing) <- tryDelPeekMsg ms q mId5
     void $ ExceptT $ deleteQueue ms q
 
+testLinkDataSecuredQueue :: MsgStoreClass s => s -> IO ()
+testLinkDataSecuredQueue ms = do
+  g <- C.newRandom
+  (sKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+  let st = queueStore ms
+      ld = (EncDataBytes "fixed data", EncDataBytes "user data")
+      rndId = atomically $ EntityId <$> C.randomBytes 24 g
+  (rId, qr) <- testNewQueueRec g QMMessaging
+  (cId, cqr) <- testNewQueueRec g QMContact
+  lnkId <- rndId
+  cLnkId <- rndId
+  runRight_ $ do
+    q <- ExceptT $ addQueue ms rId qr
+    -- the handle is read before SKEY, as in a command that raced with it
+    staleQ <- ExceptT $ getQueue ms SRecipient rId
+    ExceptT $ secureQueue st q sKey
+    liftIO $ addQueueLinkData st staleQ lnkId ld `shouldReturn` Left AUTH
+    freshQ <- ExceptT $ getQueue ms SRecipient rId
+    liftIO $ getQueueLinkData st freshQ lnkId `shouldReturn` Left AUTH
+    cq <- ExceptT $ addQueue ms cId cqr
+    ExceptT $ secureQueue st cq sKey
+    ExceptT $ addQueueLinkData st cq cLnkId ld
+    ld' <- ExceptT $ getQueueLinkData st cq cLnkId
+    liftIO $ ld' `shouldBe` ld
+    void $ ExceptT $ deleteQueue ms q
+    void $ ExceptT $ deleteQueue ms cq
+
 testExportImportStore :: JournalMsgStore 'QSMemory -> IO ()
 testExportImportStore ms = do
   g <- C.newRandom

From fcc5670ae2c87f02538ba284b47b20fb6789f773 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 4 Oct 2026 14:43:21 +0100
Subject: [PATCH 03/20] agent: keep ratchet hashes for connection lifetime, up
 to some cap, to prevent replay of expired ratchets (#1893)

* agent: keep ratchet hashes for connection lifetime, to prevent replay of expired ratchets

* cap

* simpler

* simpler2

* split

* one query

* simplify

* performance

* migration

* fix schema

* comment

* improve

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 simplexmq.cabal                               |  3 +-
 src/Simplex/Messaging/Agent.hs                |  5 ++-
 .../Messaging/Agent/Store/AgentStore.hs       | 38 +++++++++++++------
 .../Agent/Store/Postgres/Migrations/App.hs    |  4 +-
 ..._index.hs => M20260929_ratchet_indexes.hs} | 12 +++---
 .../Migrations/agent_postgres_schema.sql      |  4 ++
 .../Agent/Store/SQLite/Migrations/App.hs      |  4 +-
 .../Migrations/M20260929_ratchet_indexes.hs   | 19 ++++++++++
 .../Store/SQLite/Migrations/agent_schema.sql  |  4 ++
 tests/AgentTests/FunctionalAPITests.hs        | 29 ++++++++++++--
 tests/AgentTests/SQLiteTests.hs               | 16 ++++++++
 11 files changed, 113 insertions(+), 25 deletions(-)
 rename src/Simplex/Messaging/Agent/Store/Postgres/Migrations/{M20260929_skipped_messages_index.hs => M20260929_ratchet_indexes.hs} (56%)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 78fd61a1f..7244d4de0 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -195,7 +195,7 @@ library
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
-          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
   else
       exposed-modules:
           Simplex.Messaging.Agent.Store.SQLite
@@ -251,6 +251,7 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
           Simplex.Messaging.Agent.Store.SQLite.Util
   if flag(client_postgres) || flag(server_postgres)
       exposed-modules:
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 1cf455114..d7cd4d453 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -3404,6 +3404,9 @@ subscriber c@AgentClient {msgQ, subQ} = run $ forever $ do
     run a = a `catchOwn` \e -> notify $ CRITICAL True $ "Agent subscriber stopped: " <> show e
     notify err = atomically $ writeTBQueue subQ ("", "", AEvt SAEConn $ ERR err)
 
+maxRatchetKeyHashes :: Int
+maxRatchetKeyHashes = 100
+
 cleanupManager :: AgentClient -> AM' ()
 cleanupManager c@AgentClient {subQ} = do
   AgentConfig {initialCleanupDelay, cleanupInterval = int, storedMsgDataTTL = ttl, cleanupBatchSize = limit} <-
@@ -3413,7 +3416,7 @@ cleanupManager c@AgentClient {subQ} = do
     run ERR deleteConns
     run ERR $ withStore' c $ \db -> deleteRcvMsgHashesExpired db ttl limit
     run ERR $ withStore' c $ \db -> deleteSndMsgsExpired db ttl limit
-    run ERR $ withStore' c $ \db -> deleteRatchetKeyHashesExpired db ttl limit
+    run ERR $ withStore' c $ \db -> deleteRatchetKeyHashesExpired db ttl maxRatchetKeyHashes
     run ERR $ withStore' c (`deleteExpiredNtfTokensToDelete` ttl)
     run RFERR deleteRcvFilesExpired
     run RFERR deleteRcvFilesDeleted
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 38b454c2b..25ea50495 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -2818,21 +2818,35 @@ checkRatchetKeyHashExists db connId hash =
       (connId, Binary hash)
 
 deleteRatchetKeyHashesExpired :: DB.Connection -> NominalDiffTime -> Int -> IO ()
-deleteRatchetKeyHashesExpired db ttl limit = do
+deleteRatchetKeyHashesExpired db ttl maxConnHashes = do
   cutoffTs <- addUTCTime (-ttl) <$> getCurrentTime
+#if defined(dbPostgres)
   DB.execute
     db
-    [sql|
-      DELETE FROM processed_ratchet_key_hashes
-      WHERE processed_ratchet_key_hash_id IN (
-        SELECT processed_ratchet_key_hash_id
-        FROM processed_ratchet_key_hashes
-        WHERE created_at < ?
-        ORDER BY created_at ASC
-        LIMIT ?
-      )
-    |]
-    (cutoffTs, limit)
+    ("DELETE FROM processed_ratchet_key_hashes h USING (" <> maxExcessIdsQuery <> ") e WHERE h.conn_id = e.conn_id AND h.processed_ratchet_key_hash_id <= e.max_excess_id AND h.created_at < ?")
+    (maxConnHashes, maxConnHashes, cutoffTs)
+#else
+  maxExcessIds <- DB.query db maxExcessIdsQuery (maxConnHashes, maxConnHashes)
+  DB.executeMany
+    db
+    "DELETE FROM processed_ratchet_key_hashes WHERE conn_id = ? AND processed_ratchet_key_hash_id <= ? AND created_at < ?"
+    (map (\(connId :: ConnId, maxExcessId :: Int64) -> (connId, maxExcessId, cutoffTs)) maxExcessIds)
+#endif
+  where
+    maxExcessIdsQuery :: Query
+    maxExcessIdsQuery =
+      [sql|
+        SELECT conn_id, (
+          SELECT processed_ratchet_key_hash_id
+          FROM processed_ratchet_key_hashes
+          WHERE conn_id = c.conn_id
+          ORDER BY processed_ratchet_key_hash_id DESC
+          LIMIT 1 OFFSET ?
+        ) AS max_excess_id
+        FROM processed_ratchet_key_hashes c
+        GROUP BY conn_id
+        HAVING COUNT(*) > ?
+      |]
 
 -- | returns all connection queues, the first queue is the primary one
 getRcvQueuesByConnId_ :: DB.Connection -> ConnId -> IO (Maybe (NonEmpty RcvQueue))
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
index 0173c4fb8..26c7a80da 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
@@ -16,7 +16,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260411_service_certs
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
-import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -33,7 +33,7 @@ schemaMigrations =
     ("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
     ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
     ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
-    ("20260929_skipped_messages_index", m20260929_skipped_messages_index, Just down_m20260929_skipped_messages_index)
+    ("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
similarity index 56%
rename from src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs
rename to src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
index 7f465cec7..37b81f3eb 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_skipped_messages_index.hs
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
@@ -1,21 +1,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 
-module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_skipped_messages_index where
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes where
 
 import Data.Text (Text)
 import Text.RawString.QQ (r)
 
-m20260929_skipped_messages_index :: Text
-m20260929_skipped_messages_index =
+m20260929_ratchet_indexes :: Text
+m20260929_ratchet_indexes =
   [r|
 DROP INDEX idx_skipped_messages_conn_id;
 CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id, skipped_message_id);
+CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
 |]
 
-down_m20260929_skipped_messages_index :: Text
-down_m20260929_skipped_messages_index =
+down_m20260929_ratchet_indexes :: Text
+down_m20260929_ratchet_indexes =
   [r|
+DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
 DROP INDEX idx_skipped_messages_conn_id;
 CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
 |]
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
index c5be00a6e..e7d90ae27 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
@@ -1169,6 +1169,10 @@ CREATE INDEX idx_ntf_tokens_ntf_host_ntf_port ON smp_agent_test_protocol_schema.
 
 
 
+CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (conn_id, processed_ratchet_key_hash_id);
+
+
+
 CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (created_at);
 
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
index e50d8bd43..bae3b6afc 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
@@ -52,6 +52,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260411_service_certs
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -103,7 +104,8 @@ schemaMigrations =
     ("m20260411_service_certs", m20260411_service_certs, Just down_m20260411_service_certs),
     ("m20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
     ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
-    ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes)
+    ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
+    ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs
new file mode 100644
index 000000000..d2ca60a35
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- idx_skipped_messages_conn_id is not changed: SQLite index entries include rowid (skipped_message_id)
+m20260929_ratchet_indexes :: Query
+m20260929_ratchet_indexes =
+  [sql|
+CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
+  |]
+
+down_m20260929_ratchet_indexes :: Query
+down_m20260929_ratchet_indexes =
+  [sql|
+DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
+  |]
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 de0c1494b..47fd154a0 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -641,6 +641,10 @@ CREATE INDEX idx_connections_deleted ON connections(deleted);
 CREATE INDEX idx_connections_service_request_expires_at ON connections(
   service_request_expires_at
 );
+CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(
+  conn_id,
+  processed_ratchet_key_hash_id
+);
 CREATE TRIGGER tr_rcv_queue_insert
 AFTER INSERT ON rcv_queues
 FOR EACH ROW
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 8194e9ccd..ac9ae7a2c 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -71,7 +71,7 @@ import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight)
 import Data.Int (Int64)
 import Data.List (find, isPrefixOf, isSuffixOf)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map as M
 import Data.Maybe (isJust, isNothing)
 import qualified Data.Set as S
@@ -87,12 +87,12 @@ import SMPAgentClient
 import SMPClient
 import Simplex.Messaging.Agent hiding (acceptContact, createConnection, deleteConnection, deleteConnections, getConnShortLink, joinConnection, sendMessage, setConnShortLink, subscribeConnection, suspendConnection)
 import qualified Simplex.Messaging.Agent as A
-import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), waitForUserNetwork)
+import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), UserNetworkInfo (..), UserNetworkType (..), sendAgentMessage, waitForUserNetwork)
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Env (..), InitialAgentServers (..), createAgentStore)
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Agent.Store (Connection' (..), SomeConn' (..), StoredRcvQueue (..))
-import Simplex.Messaging.Agent.Store.AgentStore (getConn)
+import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getRatchetX3dhKeys)
 import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
 import Simplex.Messaging.Agent.Store.Interface
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -463,6 +463,8 @@ functionalAPITests ps = do
         testRatchetSyncSuspendForeground ps
       it "should synchronize ratchets when clients start synchronization simultaneously" $
         testRatchetSyncSimultaneous ps
+      it "should ignore replayed ratchet key after expired hashes are deleted" $
+        testRatchetSyncReplayedKey ps
 #endif
     describe "Subscription mode OnlyCreate" $ do
       it "messages delivered only when polled" $
@@ -2748,6 +2750,27 @@ testRatchetSyncSimultaneous ps = do
   disposeAgentClient bob
   disposeAgentClient bob2
 
+testRatchetSyncReplayedKey :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncReplayedKey ps = withAgentClients2 $ \alice bob -> do
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2
+  _ <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
+  Right pks <- withTransaction (store $ agentEnv bob2) (`getRatchetX3dhKeys` aliceId)
+  Right (SomeConn _ (DuplexConnection _ _ (sq :| _))) <- withTransaction (store $ agentEnv bob2) (`getConn` aliceId)
+  withSmpServerStoreMsgLogOn ps testPort $ \_ -> do
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
+    get alice =##> ratchetSyncP bobId RSOk
+    get bob2 =##> ratchetSyncP aliceId RSOk
+    withTransaction (store $ agentEnv alice) $ \db -> deleteRatchetKeyHashesExpired db 0 100
+    let keyMsg = AgentRatchetKey {agentVersion = currentSMPAgentVersion, e2eEncryption = CR.mkRcvE2ERatchetParams CR.currentE2EEncryptVersion pks, info = ""}
+    Right _ <- runReaderT (runExceptT $ sendAgentMessage bob2 sq SMP.noMsgFlags $ smpEncode keyMsg) (agentEnv bob2)
+    runRight_ $ exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
+  disposeAgentClient bob2
+
 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"
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 0a418cabb..8a5fd14d7 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -137,6 +137,7 @@ storeTests = do
           testCreateRcvMsg
           testCreateSndMsg
           testCreateRcvAndSndMsgs
+      describe "deleteRatchetKeyHashesExpired" testDeleteRatchetKeyHashesExpired
       it "should keep only the newest skipped message keys" testGetSkippedMsgKeys
       describe "Work items" $ do
         it "should getPendingQueueMsg" testGetPendingQueueMsg
@@ -602,6 +603,21 @@ testCreateRcvAndSndMsgs =
       testCreateSndMsg_ db "snd_hash_1" connId sq $ mkSndMsgData (InternalId 5) (InternalSndId 2) "snd_hash_2"
       testCreateSndMsg_ db "snd_hash_2" connId sq $ mkSndMsgData (InternalId 6) (InternalSndId 3) "snd_hash_3"
 
+testDeleteRatchetKeyHashesExpired :: SpecWith DBStore
+testDeleteRatchetKeyHashesExpired =
+  it "should delete expired ratchet key hashes except the newest in each connection" . withStoreTransaction $ \db -> do
+    g <- C.newRandom
+    Right connId <- createNewConn db g cData1 {connId = ""} SCMInvitation
+    Right connId' <- createNewConn db g cData1 {connId = ""} SCMContact
+    let hashes = ["h1", "h2", "h3", "h4", "h5", "h6"]
+    forM_ hashes $ addProcessedRatchetKeyHash db connId
+    forM_ (take 4 hashes) $ addProcessedRatchetKeyHash db connId'
+    deleteRatchetKeyHashesExpired db 86400 4
+    mapM (checkRatchetKeyHashExists db connId) hashes `shouldReturn` replicate 6 True
+    deleteRatchetKeyHashesExpired db 0 4
+    mapM (checkRatchetKeyHashExists db connId) hashes `shouldReturn` [False, False, True, True, True, True]
+    mapM (checkRatchetKeyHashExists db connId') (take 4 hashes) `shouldReturn` replicate 4 True
+
 testGetSkippedMsgKeys :: DBStore -> Expectation
 testGetSkippedMsgKeys st = do
   g <- C.newRandom

From 65893a359aea3d0e386de4d53e0581350505c72d Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 4 Oct 2026 22:28:50 +0100
Subject: [PATCH 04/20] agent: resolve potential race conditions in double
 ratchet (#1923)

* agent: resolve potential race conditions in double ratchet

* update

* improve

* diff

* diff

* diff

* simpler

* more races

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 protocol/agent-protocol.md                    |   5 +-
 src/Simplex/Messaging/Agent.hs                | 244 ++++++++++--------
 src/Simplex/Messaging/Agent/Protocol.hs       |  17 +-
 .../Messaging/Agent/Store/AgentStore.hs       |   6 +
 .../Migrations/M20260929_ratchet_indexes.hs   |  11 +
 .../Migrations/agent_postgres_schema.sql      |   2 +-
 .../Migrations/M20260929_ratchet_indexes.hs   |  10 +
 .../Store/SQLite/Migrations/agent_schema.sql  |   8 +-
 tests/AgentTests/ConnectionRequestTests.hs    |   4 +
 tests/AgentTests/FunctionalAPITests.hs        | 100 ++++++-
 tests/AgentTests/SchemaDump.hs                |  19 +-
 11 files changed, 301 insertions(+), 125 deletions(-)

diff --git a/protocol/agent-protocol.md b/protocol/agent-protocol.md
index 00b099e40..f30b33b92 100644
--- a/protocol/agent-protocol.md
+++ b/protocol/agent-protocol.md
@@ -208,7 +208,7 @@ This syntax of decrypted SMP client message body is defined by `decryptedAgentMe
 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.
+- `agentRatchetInfo` - used to pass additional information when renegotiating double ratchet encryption - sent in `agentRatchetKey` envelope. A key sent in reply to another key includes the hash of that key; agents do not reply to such keys.
 - `agentMessage` - all other agent messages.
 
 `agentMessage` contains these parts:
@@ -233,7 +233,8 @@ connInfo = *OCTET
 agentConnInfoReply = %s"D" smpQueues connInfo
 smpQueues = length 1*newQueueInfo ; NonEmpty list of reply queues
 agentRatchetInfo = %s"R" ratchetInfo
-ratchetInfo = *OCTET
+ratchetInfo = [answeredKeyHash *OCTET] ; bytes after answeredKeyHash are ignored
+answeredKeyHash = %s"0" / (%s"1" shortString) ; "0" in a key that starts renegotiation, otherwise SHA-256 of the two raw public keys of the answered key
 
 agentMessage = %s"M" agentMsgHeader aMessage
 agentMsgHeader = agentMsgId prevMsgHash
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index d7cd4d453..067031899 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2435,62 +2435,66 @@ enqueueMessageB c reqs = do
   cfg <- asks config
   (_, reqMids) <- unsafeWithStore c $ \db -> do
     mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
-  forME reqMids $ \((csqs_, _, _, _), InternalId msgId, pqSecr) -> forM csqs_ $ \(cData, sq :| sqs) -> do
-    submitPendingMsg c sq
-    let sqs' = filter (isActiveSndQ cData) sqs
-    pure ((msgId, pqSecr), if null sqs' then Nothing else Just (sqs', msgId))
+  forME reqMids $ submitSentMsg c
   where
-    storeSentMsg ::
-      DB.Connection ->
-      AgentConfig ->
-      IntMap (Maybe Int64, AMessage) ->
-      Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage) ->
-      IO (IntMap (Maybe Int64, AMessage), Either AgentErrorType ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption))
-    storeSentMsg db cfg aMessageIds = \case
-      Left e -> pure (aMessageIds, Left e)
-      Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
-        VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
-          Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
-          Nothing -> do
-            (mbId_, r) <- case csqs_ of
-              Left e -> pure (Nothing, Left e)
-              Right (cData, sq :| _) -> do
-                mbId <- createSndMsgBody db aMessage
-                (Just mbId,) <$> storeSentMsg_ cData sq mbId aMessage
-            let aMessageIds' = maybe id (`IM.insert` (mbId_, aMessage)) i_ aMessageIds
-            pure (aMessageIds', r)
-        VRRef i -> case csqs_ of
-          Left e -> pure $ (aMessageIds, Left e)
-          Right (cData, sq :| _) -> case IM.lookup i aMessageIds of
-            Just (Just mbId, aMessage) -> (aMessageIds,) <$> storeSentMsg_ cData sq mbId aMessage
-            Just (Nothing, aMessage) -> do
-              mbId <- createSndMsgBody db aMessage
-              let aMessageIds' = IM.insert i (Just mbId, aMessage) aMessageIds
-              (aMessageIds',) <$> storeSentMsg_ cData sq mbId aMessage
-            Nothing -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg missing saved message body id")
-        where
-          storeSentMsg_ cData@ConnData {connId} sq sndMsgBodyId aMessage = fmap (first storeError) $ runExceptT $ do
-            let AgentConfig {e2eEncryptVRange} = cfg
-            internalTs <- liftIO getCurrentTime
-            (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
-            -- We need to do pre-flight encoding that is not stored in database
-            -- to calculate its hash and remember it on connection (createSndMsg -> updateSndMsgHash)
-            -- to enable next enqueue.
-            -- (As encoding is different per connection, we can't store shared body, so it's repeated on delivery)
-            let agentMsgStr = encodeAgentMsgStr aMessage internalSndId prevMsgHash
-                internalHash = C.sha256Hash agentMsgStr
-                currentE2EVersion = maxVersion e2eEncryptVRange
-            (mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData e2eEncAgentMsgLength pqEnc_ currentE2EVersion
-            withExceptT (SEAgentError . cryptoError) $ CR.rcCheckCanPad paddedLen agentMsgStr
-            let msgType = aMessageType aMessage
-                -- msgBody is empty, because snd_messages record is linked to snd_message_bodies
-                msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody = "", pqEncryption = pqEnc, internalHash, prevMsgHash, sndMsgPrepData_ = Just SndMsgPrepData {encryptKey = mek, paddedLen, sndMsgBodyId}}
-            liftIO $ createSndMsg db connId msgData
-            liftIO $ createSndMsgDelivery db sq internalId
-            pure (req, internalId, pqEnc)
     handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
     handleInternal = pure . Left . INTERNAL . show
 
+submitSentMsg :: AgentClient -> ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption) -> AM' (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId)))
+submitSentMsg c ((csqs_, _, _, _), InternalId msgId, pqSecr) = forM csqs_ $ \(cData, sq :| sqs) -> do
+  submitPendingMsg c sq
+  let sqs' = filter (isActiveSndQ cData) sqs
+  pure ((msgId, pqSecr), if null sqs' then Nothing else Just (sqs', msgId))
+
+storeSentMsg ::
+  DB.Connection ->
+  AgentConfig ->
+  IntMap (Maybe Int64, AMessage) ->
+  Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage) ->
+  IO (IntMap (Maybe Int64, AMessage), Either AgentErrorType ((Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage), InternalId, PQEncryption))
+storeSentMsg db cfg aMessageIds = \case
+  Left e -> pure (aMessageIds, Left e)
+  Right req@(csqs_, pqEnc_, msgFlags, mbr) -> case mbr of
+    VRValue i_ aMessage -> case i_ >>= (`IM.lookup` aMessageIds) of
+      Just _ -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg duplicate saved message body")
+      Nothing -> do
+        (mbId_, r) <- case csqs_ of
+          Left e -> pure (Nothing, Left e)
+          Right (cData, sq :| _) -> do
+            mbId <- createSndMsgBody db aMessage
+            (Just mbId,) <$> storeSentMsg_ cData sq mbId aMessage
+        let aMessageIds' = maybe id (`IM.insert` (mbId_, aMessage)) i_ aMessageIds
+        pure (aMessageIds', r)
+    VRRef i -> case csqs_ of
+      Left e -> pure $ (aMessageIds, Left e)
+      Right (cData, sq :| _) -> case IM.lookup i aMessageIds of
+        Just (Just mbId, aMessage) -> (aMessageIds,) <$> storeSentMsg_ cData sq mbId aMessage
+        Just (Nothing, aMessage) -> do
+          mbId <- createSndMsgBody db aMessage
+          let aMessageIds' = IM.insert i (Just mbId, aMessage) aMessageIds
+          (aMessageIds',) <$> storeSentMsg_ cData sq mbId aMessage
+        Nothing -> pure (aMessageIds, Left $ INTERNAL "enqueueMessageB: storeSentMsg missing saved message body id")
+    where
+      storeSentMsg_ cData@ConnData {connId} sq sndMsgBodyId aMessage = fmap (first storeError) $ runExceptT $ do
+        let AgentConfig {e2eEncryptVRange} = cfg
+        internalTs <- liftIO getCurrentTime
+        (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+        -- We need to do pre-flight encoding that is not stored in database
+        -- to calculate its hash and remember it on connection (createSndMsg -> updateSndMsgHash)
+        -- to enable next enqueue.
+        -- (As encoding is different per connection, we can't store shared body, so it's repeated on delivery)
+        let agentMsgStr = encodeAgentMsgStr aMessage internalSndId prevMsgHash
+            internalHash = C.sha256Hash agentMsgStr
+            currentE2EVersion = maxVersion e2eEncryptVRange
+        (mek, paddedLen, pqEnc) <- agentRatchetEncryptHeader db cData e2eEncAgentMsgLength pqEnc_ currentE2EVersion
+        withExceptT (SEAgentError . cryptoError) $ CR.rcCheckCanPad paddedLen agentMsgStr
+        let msgType = aMessageType aMessage
+            -- msgBody is empty, because snd_messages record is linked to snd_message_bodies
+            msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgFlags, msgBody = "", pqEncryption = pqEnc, internalHash, prevMsgHash, sndMsgPrepData_ = Just SndMsgPrepData {encryptKey = mek, paddedLen, sndMsgBodyId}}
+        liftIO $ createSndMsg db connId msgData
+        liftIO $ createSndMsgDelivery db sq internalId
+        pure (req, internalId, pqEnc)
+
 encodeAgentMsgStr :: AMessage -> InternalSndId -> PrevSndMsgHash -> ByteString
 encodeAgentMsgStr aMessage internalSndId prevMsgHash = do
   let privHeader = APrivHeader (unSndId internalSndId) prevMsgHash
@@ -2865,15 +2869,18 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
     SomeConn _ (DuplexConnection cData@ConnData {pqSupport} rqs sqs)
       | ratchetSyncAllowed cData || force -> do
           -- check queues are not switching?
-          when (pqSupport' /= pqSupport) $ withStore' c $ \db -> setConnPQSupport db connId pqSupport'
           let cData' = cData {pqSupport = pqSupport'} :: ConnData
-          AgentConfig {e2eEncryptVRange} <- asks config
+          AgentConfig {e2eEncryptVRange, smpAgentVRange} <- asks config
           g <- asks random
           (pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eEncryptVRange) pqSupport'
-          enqueueRatchetKeyMsgs c cData' sqs e2eParams
-          withStore' c $ \db -> do
-            setConnRatchetSync db connId RSStarted
-            setRatchetX3dhKeys db connId pks
+          msgId <- withStore c $ \db -> runExceptT $ do
+            msgId <- storeRatchetKey db (L.head sqs) (maxVersion smpAgentVRange) e2eParams Nothing
+            liftIO $ do
+              when (pqSupport' /= pqSupport) $ setConnPQSupport db connId pqSupport'
+              setConnRatchetSync db connId RSStarted
+              setRatchetX3dhKeys db connId pks
+            pure msgId
+          lift $ enqueueRatchetKeyMsgs c cData' sqs msgId
           let cData'' = cData' {ratchetSyncState = RSStarted} :: ConnData
               conn' = DuplexConnection cData'' rqs sqs
           connectionStats c conn'
@@ -3613,9 +3620,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                       _ -> prohibited "handshake: incorrect state" >> ack
                   (Just e2eDh, Nothing) -> do
                     decryptClientMessage e2eDh clientMsg >>= \case
-                      (SMP.PHEmpty, AgentRatchetKey {agentVersion, e2eEncryption}) -> do
+                      (SMP.PHEmpty, AgentRatchetKey {agentVersion, e2eEncryption, info}) -> do
                         conn' <- updateConnVersion conn cData agentVersion
-                        qDuplex conn' "AgentRatchetKey" $ \a -> newRatchetKey e2eEncryption a >> ack
+                        qDuplex conn' "AgentRatchetKey" $ \a -> newRatchetKey e2eEncryption info a >> ack
                       (SMP.PHEmpty, AgentMsgEnvelope {agentVersion, encAgentMessage}) -> do
                         conn' <- updateConnVersion conn cData agentVersion
                         -- primary queue is set as Active in helloMsg, below is to set additional queues Active
@@ -3658,7 +3665,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                               qDuplexAckDel conn'' name a = qDuplex conn'' name a >> ackDel msgId
                               resetRatchetSync :: AM (Connection c)
                               resetRatchetSync
-                                | rss `notElem` ([RSOk, RSStarted] :: [RatchetSyncState]) = do
+                                | rss `notElem` ([RSOk, RSStarted] :: [RatchetSyncState]) = ifM ((RSStarted ==) <$> getRatchetSyncState) (pure conn') $ do
                                     let cData'' = (toConnData conn') {ratchetSyncState = RSOk} :: ConnData
                                         conn'' = updateConnection cData'' conn'
                                     cStats <- connectionStats c conn''
@@ -3699,7 +3706,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                               notifySync :: AM ()
                               notifySync = qDuplex conn' "AGENT A_CRYPTO error" $ \connDuplex -> do
                                 let rss' = cryptoErrToSyncState e
-                                when (rss `elem` ([RSOk, RSAllowed, RSRequired] :: [RatchetSyncState])) $ do
+                                whenM ((`elem` ([RSOk, RSAllowed, RSRequired] :: [RatchetSyncState])) <$> getRatchetSyncState) $ do
                                   let cData'' = (toConnData conn') {ratchetSyncState = rss'} :: ConnData
                                       conn'' = updateConnection cData'' connDuplex
                                   cStats <- connectionStats c conn''
@@ -3795,6 +3802,9 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
           enqueueCmd :: InternalCommand -> AM ()
           enqueueCmd = enqueueCommand c "" connId (Just srv) . AInternalCommand
 
+          getRatchetSyncState :: AM RatchetSyncState
+          getRatchetSyncState = withStore c (`getConnRatchetSync` connId)
+
           unexpected :: BrokerMsg -> AM ()
           unexpected r = do
             logServer "<--" c srv rId $ "unexpected: " <> bshow r
@@ -4163,42 +4173,47 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
             DuplexConnection {} -> action conn'
             _ -> qError $ name <> ": message must be sent to duplex connection"
 
-          newRatchetKey :: CR.RcvE2ERatchetParams 'C.X448 -> Connection 'CDuplex -> AM ()
-          newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
+          newRatchetKey :: CR.RcvE2ERatchetParams 'C.X448 -> ByteString -> Connection 'CDuplex -> AM ()
+          newRatchetKey e2eOtherPartyParams@(CR.E2ERatchetParams e2eVersion k1Rcv k2Rcv _) info conn'@(DuplexConnection cData'@ConnData {lastExternalSndId, pqSupport} _ sqs) =
             unlessM ratchetExists $ do
               AgentConfig {e2eEncryptVRange} <- asks config
               unless (e2eVersion `isCompatible` e2eEncryptVRange) (throwE $ AGENT A_VERSION)
-              keys <- getSendRatchetKeys
+              keys_ <- getSendRatchetKeys
               let rcVs = CR.RatchetVersions {current = e2eVersion, maxSupported = maxVersion e2eEncryptVRange}
-              initRatchet rcVs keys
-              notifyAgreed
+              case keys_ of
+                Just (keys, replyKey_) -> initRatchet rcVs keys replyKey_ >> notifyAgreed
+                Nothing -> withStore' c $ \db -> addProcessedRatchetKeyHash db connId rkHashRcv
             where
               rkHashRcv = rkHash k1Rcv k2Rcv
               rkHash k1 k2 = C.sha256Hash $ C.pubKeyBytes k1 <> C.pubKeyBytes k2
+              answeredKeyHash_ = case smpDecode info of
+                Right (AgentRatchetInfo RatchetInfo {answeredKeyHash}) -> answeredKeyHash
+                _ -> Nothing
               ratchetExists :: AM Bool
               ratchetExists = withStore' c $ \db -> do
                 exists <- checkRatchetKeyHashExists db connId rkHashRcv
-                unless exists $ addProcessedRatchetKeyHash db connId rkHashRcv
                 pure exists
-              getSendRatchetKeys :: AM (CR.RcvE2EPrivRatchetParams 'C.X448)
-              getSendRatchetKeys = case rss of
-                RSOk -> sendReplyKey -- receiving client
-                RSAllowed -> sendReplyKey
-                RSRequired -> sendReplyKey
-                RSStarted -> withStore c (`getRatchetX3dhKeys` connId) -- initiating client
-                RSAgreed -> do
-                  withStore' c $ \db -> setConnRatchetSync db connId RSRequired
+              getSendRatchetKeys :: AM (Maybe (CR.RcvE2EPrivRatchetParams 'C.X448, Maybe (CR.RcvE2ERatchetParams 'C.X448)))
+              getSendRatchetKeys = getRatchetSyncState >>= \rss' -> case (rss', answeredKeyHash_) of
+                (RSStarted, Nothing) -> Just . (,Nothing) <$> withStore c (`getRatchetX3dhKeys` connId) -- initiating client
+                (RSStarted, Just h) -> fmap (,Nothing) . answeredKeys h <$> withStore c (`getRatchetX3dhKeys` connId)
+                (_, Nothing) -> Just <$> sendReplyKey -- receiving client
+                (RSAgreed, Just _) -> do
+                  withStore' c $ \db -> addProcessedRatchetKeyHash db connId rkHashRcv >> setConnRatchetSync db connId RSRequired
                   notifyRatchetSyncError
                   -- can communicate for other client to reset to RSRequired
                   -- - need to add new AgentMsgEnvelope, AgentMessage, AgentMessageType
                   -- - need to deduplicate on receiving side
                   throwE $ AGENT (A_CRYPTO RATCHET_SYNC)
+                (_, Just _) -> pure Nothing
                 where
+                  answeredKeys h keys@(pk1, pk2, _)
+                    | rkHash (C.publicKey pk1) (C.publicKey pk2) == h = Just keys
+                    | otherwise = Nothing
                   sendReplyKey = do
                     g <- asks random
                     (pks, e2eParams) <- liftIO $ CR.generateRcvE2EParams g e2eVersion pqSupport
-                    enqueueRatchetKeyMsgs c cData' sqs e2eParams
-                    pure pks
+                    pure (pks, Just e2eParams)
                   notifyRatchetSyncError = do
                     let cData'' = cData' {ratchetSyncState = RSRequired} :: ConnData
                         conn'' = updateConnection cData'' conn'
@@ -4210,23 +4225,33 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                     conn'' = updateConnection cData'' conn'
                 cStats <- connectionStats c conn''
                 notify $ RSYNC RSAgreed Nothing cStats
-              recreateRatchet :: CR.Ratchet 'C.X448 -> AM ()
-              recreateRatchet rc = withStore' c $ \db -> do
-                setConnRatchetSync db connId RSAgreed
-                deleteRatchet db connId
-                createRatchet db connId rc
+              recreateRatchet :: Maybe (CR.RcvE2ERatchetParams 'C.X448) -> Maybe AMessage -> CR.Ratchet 'C.X448 -> AM ()
+              recreateRatchet replyKey_ eready_ rc = do
+                cfg@AgentConfig {smpAgentVRange} <- asks config
+                (msgId_, r_) <- withStore c $ \db -> runExceptT $ do
+                  msgId_ <- forM replyKey_ $ \e2eParams -> storeRatchetKey db (L.head sqs) (maxVersion smpAgentVRange) e2eParams (Just rkHashRcv)
+                  liftIO $ do
+                    addProcessedRatchetKeyHash db connId rkHashRcv
+                    setConnRatchetSync db connId RSAgreed
+                    deleteRatchet db connId
+                    createRatchet db connId rc
+                  r_ <- forM eready_ $ \msg -> liftIO $ storeSentMsg db cfg IM.empty (Right (Right (cData', sqs), Nothing, SMP.MsgFlags {notification = True}, vrValue msg)) >>= either E.throwIO pure . snd
+                  pure (msgId_, r_)
+                forM_ msgId_ $ lift . enqueueRatchetKeyMsgs c cData' sqs
+                forM_ r_ $ \r -> lift $ do
+                  r' <- submitSentMsg c r
+                  enqueueSavedMessageB c $ mapMaybe snd $ rights [r']
               -- compare public keys `k1` in AgentRatchetKey messages sent by self and other party
               -- to determine ratchet initilization ordering
-              initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> AM ()
-              initRatchet rcVs (pk1, pk2, pKem)
+              initRatchet :: CR.RatchetVersions -> CR.RcvE2EPrivRatchetParams 'C.X448 -> Maybe (CR.RcvE2ERatchetParams 'C.X448) -> AM ()
+              initRatchet rcVs (pk1, pk2, pKem) replyKey_
                 | rkHash (C.publicKey pk1) (C.publicKey pk2) <= rkHashRcv = do
                     rcParams <- liftError cryptoError $ CR.pqX3dhRcv (pk1, pk2, pKem) e2eOtherPartyParams
-                    recreateRatchet $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport
+                    recreateRatchet replyKey_ Nothing $ CR.initRcvRatchet rcVs pk2 rcParams pqSupport
                 | otherwise = do
                     (_, rcDHRs) <- atomically . C.generateKeyPair =<< asks random
                     rcParams <- liftEitherWith cryptoError $ CR.pqX3dhSnd (pk1, pk2, CR.APRKP CR.SRKSProposed <$> pKem) e2eOtherPartyParams
-                    recreateRatchet $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
-                    void . enqueueMessages' c cData' sqs SMP.MsgFlags {notification = True} $ EREADY lastExternalSndId
+                    recreateRatchet replyKey_ (Just $ EREADY lastExternalSndId) $ CR.initSndRatchet rcVs k2Rcv rcDHRs rcParams
 
           checkMsgIntegrity :: PrevExternalSndId -> ExternalSndId -> PrevRcvMsgHash -> ByteString -> MsgIntegrity
           checkMsgIntegrity prevExtSndId extSndId internalPrevMsgHash receivedPrevMsgHash
@@ -4339,32 +4364,25 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
     liftIO $ createSndMsg db connId msgData
     liftIO $ createSndMsgDelivery db sq internalId
 
-enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> AM ()
-enqueueRatchetKeyMsgs c cData (sq :| sqs) e2eEncryption = do
-  msgId <- enqueueRatchetKey c sq e2eEncryption
-  mapM_ (lift . enqueueSavedMessage c msgId) $ filter (isActiveSndQ cData) sqs
+enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> InternalId -> AM' ()
+enqueueRatchetKeyMsgs c cData (sq :| sqs) (InternalId msgId) = do
+  submitPendingMsg c sq
+  mapM_ (enqueueSavedMessage c msgId) $ filter (isActiveSndQ cData) sqs
 
-enqueueRatchetKey :: AgentClient -> SndQueue -> CR.RcvE2ERatchetParams 'C.X448 -> AM AgentMsgId
-enqueueRatchetKey c sq@SndQueue {connId} e2eEncryption = do
-  aVRange <- asks $ smpAgentVRange . config
-  msgId <- storeRatchetKey $ maxVersion aVRange
-  lift $ submitPendingMsg c sq
-  pure $ unId msgId
-  where
-    storeRatchetKey :: VersionSMPA -> AM InternalId
-    storeRatchetKey agentVersion = withStore c $ \db -> runExceptT $ do
-      internalTs <- liftIO getCurrentTime
-      (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
-      let agentMsg = AgentRatchetInfo ""
-          agentMsgStr = smpEncode agentMsg
-          internalHash = C.sha256Hash agentMsgStr
-      let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr}
-          msgType = agentMessageType agentMsg
-          -- this message is e2e encrypted with queue key, not with double ratchet
-          msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
-      liftIO $ createSndMsg db connId msgData
-      liftIO $ createSndMsgDelivery db sq internalId
-      pure internalId
+storeRatchetKey :: DB.Connection -> SndQueue -> VersionSMPA -> CR.RcvE2ERatchetParams 'C.X448 -> Maybe ByteString -> ExceptT StoreError IO InternalId
+storeRatchetKey db sq@SndQueue {connId} agentVersion e2eEncryption answeredKeyHash_ = do
+  internalTs <- liftIO getCurrentTime
+  (internalId, internalSndId, prevMsgHash) <- ExceptT $ updateSndIds db connId
+  let agentMsg = AgentRatchetInfo RatchetInfo {answeredKeyHash = answeredKeyHash_}
+      agentMsgStr = smpEncode agentMsg
+      internalHash = C.sha256Hash agentMsgStr
+  let msgBody = smpEncode $ AgentRatchetKey {agentVersion, e2eEncryption, info = agentMsgStr}
+      msgType = agentMessageType agentMsg
+      -- this message is e2e encrypted with queue key, not with double ratchet
+      msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption = PQEncOff, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
+  liftIO $ createSndMsg db connId msgData
+  liftIO $ createSndMsgDelivery db sq internalId
+  pure internalId
 
 -- encoded AgentMessage -> encoded EncAgentMessage
 agentRatchetEncrypt :: DB.Connection -> ConnData -> ByteString -> (PQSupport -> Int) -> Maybe PQEncryption -> CR.VersionE2E -> ExceptT StoreError IO (ByteString, PQEncryption)
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index afe698769..5f7977e45 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -79,6 +79,7 @@ module Simplex.Messaging.Agent.Protocol
     SMPConfirmation (..),
     AgentMsgEnvelope (..),
     AgentMessage (..),
+    RatchetInfo (..),
     RequestSignature (..),
     AgentMessageType (..),
     APrivHeader (..),
@@ -928,7 +929,7 @@ data AgentMessage
   | -- AgentConnInfoReply is used by accepting party in duplexHandshake mode (v2), allowing to include reply queue(s) in the initial confirmation.
     -- It made removed REPLY message unnecessary.
     AgentConnInfoReply (NonEmpty SMPQueueInfo) ConnInfo
-  | AgentRatchetInfo ByteString
+  | AgentRatchetInfo RatchetInfo
   | AgentMessage APrivHeader AMessage
   | AgentServiceRequest (NonEmpty SMPQueueInfo) (Maybe RequestSignature) MsgBody
   | AgentServiceResponse MsgBody
@@ -939,7 +940,7 @@ instance Encoding AgentMessage where
   smpEncode = \case
     AgentConnInfo cInfo -> smpEncode ('I', Tail cInfo)
     AgentConnInfoReply smpQueues cInfo -> smpEncode ('D', smpQueues, Tail cInfo) -- 'D' stands for "duplex"
-    AgentRatchetInfo info -> smpEncode ('R', Tail info)
+    AgentRatchetInfo info -> smpEncode ('R', info)
     AgentMessage hdr aMsg -> smpEncode ('M', hdr, aMsg)
     AgentServiceRequest qs sig_ body -> smpEncode ('A', qs, sig_, Tail body)
     AgentServiceResponse body -> smpEncode ('P', Tail body)
@@ -948,13 +949,23 @@ instance Encoding AgentMessage where
     smpP >>= \case
       'I' -> AgentConnInfo . unTail <$> smpP
       'D' -> AgentConnInfoReply <$> smpP <*> (unTail <$> smpP)
-      'R' -> AgentRatchetInfo . unTail <$> smpP
+      'R' -> AgentRatchetInfo <$> smpP
       'M' -> AgentMessage <$> smpP <*> smpP
       'A' -> AgentServiceRequest <$> smpP <*> smpP <*> (unTail <$> smpP)
       'P' -> AgentServiceResponse . unTail <$> smpP
       'J' -> AgentRejection . unTail <$> smpP
       _ -> fail "bad AgentMessage"
 
+data RatchetInfo = RatchetInfo {answeredKeyHash :: Maybe ByteString}
+  deriving (Eq, Show)
+
+instance Encoding RatchetInfo where
+  smpEncode RatchetInfo {answeredKeyHash} = smpEncode answeredKeyHash
+  smpP = do
+    answeredKeyHash <- smpP <|> pure Nothing
+    _ <- A.takeByteString
+    pure RatchetInfo {answeredKeyHash}
+
 -- internal type for storing message type in the database
 data AgentMessageType
   = AM_CONN_INFO
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 25ea50495..21c087d46 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -76,6 +76,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     getExpiredServiceConns,
     deleteExpiredServiceRequests,
     getDeletedWaitingDeliveryConnIds,
+    getConnRatchetSync,
     setConnRatchetSync,
     addProcessedRatchetKeyHash,
     checkRatchetKeyHashExists,
@@ -2797,6 +2798,11 @@ getDeletedWaitingDeliveryConnIds :: DB.Connection -> IO [ConnId]
 getDeletedWaitingDeliveryConnIds db =
   map fromOnly <$> DB.query_ db "SELECT conn_id FROM connections WHERE deleted_at_wait_delivery IS NOT NULL"
 
+getConnRatchetSync :: DB.Connection -> ConnId -> IO (Either StoreError RatchetSyncState)
+getConnRatchetSync db connId =
+  firstRow fromOnly SEConnNotFound $
+    DB.query db "SELECT ratchet_sync_state FROM connections WHERE conn_id = ?" (Only connId)
+
 setConnRatchetSync :: DB.Connection -> ConnId -> RatchetSyncState -> IO ()
 setConnRatchetSync db connId ratchetSyncState =
   DB.execute db "UPDATE connections SET ratchet_sync_state = ? WHERE conn_id = ?" (ratchetSyncState, connId)
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
index 37b81f3eb..511064cf5 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20260929_ratchet_indexes.hs
@@ -11,6 +11,15 @@ m20260929_ratchet_indexes =
   [r|
 DROP INDEX idx_skipped_messages_conn_id;
 CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id, skipped_message_id);
+
+DELETE FROM processed_ratchet_key_hashes AS h
+WHERE EXISTS (
+  SELECT 1 FROM processed_ratchet_key_hashes d
+  WHERE d.conn_id = h.conn_id AND d.hash = h.hash AND d.processed_ratchet_key_hash_id < h.processed_ratchet_key_hash_id
+);
+
+DROP INDEX idx_processed_ratchet_key_hashes_hash;
+CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
 CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
 |]
 
@@ -18,6 +27,8 @@ down_m20260929_ratchet_indexes :: Text
 down_m20260929_ratchet_indexes =
   [r|
 DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
+DROP INDEX idx_processed_ratchet_key_hashes_hash;
+CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
 DROP INDEX idx_skipped_messages_conn_id;
 CREATE INDEX idx_skipped_messages_conn_id ON skipped_messages(conn_id);
 |]
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
index e7d90ae27..55a9ab78d 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
@@ -1177,7 +1177,7 @@ CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON smp_agent_test_proto
 
 
 
-CREATE INDEX idx_processed_ratchet_key_hashes_hash ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (conn_id, hash);
+CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON smp_agent_test_protocol_schema.processed_ratchet_key_hashes USING btree (conn_id, hash);
 
 
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs
index d2ca60a35..a1e70a2e2 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20260929_ratchet_indexes.hs
@@ -9,6 +9,14 @@ import Database.SQLite.Simple.QQ (sql)
 m20260929_ratchet_indexes :: Query
 m20260929_ratchet_indexes =
   [sql|
+DELETE FROM processed_ratchet_key_hashes AS h
+WHERE EXISTS (
+  SELECT 1 FROM processed_ratchet_key_hashes d
+  WHERE d.conn_id = h.conn_id AND d.hash = h.hash AND d.processed_ratchet_key_hash_id < h.processed_ratchet_key_hash_id
+);
+
+DROP INDEX idx_processed_ratchet_key_hashes_hash;
+CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
 CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(conn_id, processed_ratchet_key_hash_id);
   |]
 
@@ -16,4 +24,6 @@ down_m20260929_ratchet_indexes :: Query
 down_m20260929_ratchet_indexes =
   [sql|
 DROP INDEX idx_processed_ratchet_key_hashes_conn_id;
+DROP INDEX idx_processed_ratchet_key_hashes_hash;
+CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(conn_id, hash);
   |]
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 47fd154a0..e118a17eb 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -573,10 +573,6 @@ CREATE INDEX idx_encrypted_rcv_message_hashes_hash ON encrypted_rcv_message_hash
   conn_id,
   hash
 );
-CREATE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
-  conn_id,
-  hash
-);
 CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
   conn_id,
   rcpt_internal_id
@@ -641,6 +637,10 @@ CREATE INDEX idx_connections_deleted ON connections(deleted);
 CREATE INDEX idx_connections_service_request_expires_at ON connections(
   service_request_expires_at
 );
+CREATE UNIQUE INDEX idx_processed_ratchet_key_hashes_hash ON processed_ratchet_key_hashes(
+  conn_id,
+  hash
+);
 CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_hashes(
   conn_id,
   processed_ratchet_key_hash_id
diff --git a/tests/AgentTests/ConnectionRequestTests.hs b/tests/AgentTests/ConnectionRequestTests.hs
index d76d8d305..40ca12cf9 100644
--- a/tests/AgentTests/ConnectionRequestTests.hs
+++ b/tests/AgentTests/ConnectionRequestTests.hs
@@ -362,6 +362,10 @@ connectionRequestTests =
       smpEncodingTest $ AgentServiceRequest [qInfo] Nothing "service request payload"
       smpEncodingTest $ AgentServiceResponse "service response payload"
       smpEncodingTest $ AgentRejection "rejected: not allowed"
+    it "should serialize and parse ratchet key info" $ do
+      smpDecode "R" `shouldBe` Right (AgentRatchetInfo RatchetInfo {answeredKeyHash = Nothing})
+      smpDecode "R1\3abcdef" `shouldBe` Right (AgentRatchetInfo RatchetInfo {answeredKeyHash = Just "abc"})
+      smpEncodingTest $ AgentRatchetInfo RatchetInfo {answeredKeyHash = Just "0123456789abcdef0123456789abcdef"}
   where
     smpEncodingTest :: (Encoding a, Eq a, Show a, HasCallStack) => a -> Expectation
     smpEncodingTest a = smpDecode (smpEncode a) `shouldBe` Right a
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index ac9ae7a2c..727c47d5a 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -70,7 +70,7 @@ import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Either (isRight)
 import Data.Int (Int64)
-import Data.List (find, isPrefixOf, isSuffixOf)
+import Data.List (find, isInfixOf, isPrefixOf, isSuffixOf)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.Map as M
 import Data.Maybe (isJust, isNothing)
@@ -465,6 +465,14 @@ functionalAPITests ps = do
         testRatchetSyncSimultaneous ps
       it "should ignore replayed ratchet key after expired hashes are deleted" $
         testRatchetSyncReplayedKey ps
+      it "should synchronize ratchets when synchronization is forced again" $
+        testRatchetSyncRepeated ps
+      it "should not mark ratchet key as processed when ratchet recreation fails" $
+        testRatchetSyncFailedKeyNotProcessed ps
+      it "should not store reply ratchet key when ratchet recreation fails" $
+        testRatchetSyncFailedRecreationNoReply ps
+      it "should not store ratchet key when starting synchronization fails" $
+        testRatchetSyncStartFailedNoKey ps
 #endif
     describe "Subscription mode OnlyCreate" $ do
       it "messages delivered only when polled" $
@@ -2771,6 +2779,96 @@ testRatchetSyncReplayedKey ps = withAgentClients2 $ \alice bob -> do
     runRight_ $ exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
   disposeAgentClient bob2
 
+testRatchetSyncRepeated :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncRepeated ps = withAgentClients2 $ \alice bob -> do
+  (aliceId, bobId, bob2) <- startRatchetSyncOffline ps alice bob
+  ConnectionStats {ratchetSyncState = rss2} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn True
+  rss2 `shouldBe` RSStarted
+
+  withSmpServerStoreMsgLogOn ps testPort $ \_ -> do
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [ratchetSyncP' aliceId RSAgreed, serverUpP])
+    runRight_ $ do
+      get alice =##> ratchetSyncP bobId RSAgreed
+      get alice =##> ratchetSyncP bobId RSOk
+      get bob2 =##> ratchetSyncP aliceId RSOk
+      msgId <- sendMessage alice bobId SMP.noMsgFlags "hello"
+      get alice ##> ("", bobId, SENT msgId)
+      get bob2 =##> \case ("", c, Msg "hello") -> c == aliceId; _ -> False
+      ackMessage bob2 aliceId 8 Nothing
+  map fst <$> processedRatchetKeyHashes bob2 `shouldReturn` [aliceId, aliceId]
+  disposeAgentClient bob2
+
+testRatchetSyncFailedKeyNotProcessed :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncFailedKeyNotProcessed ps = withAgentClients2 $ \alice bob -> do
+  (aliceId, bobId, bob2) <- startRatchetSyncOffline ps alice bob
+  withTransaction (store $ agentEnv bob2) $ \db ->
+    DB.execute_ db "UPDATE ratchets SET x3dh_priv_key_1 = NULL"
+
+  withSmpServerStoreMsgLogOn ps testPort $ \_ ->
+    concurrently_
+      (getInAnyOrder alice [ratchetSyncP' bobId RSAgreed, serverUpP])
+      (getInAnyOrder bob2 [x3dhKeysNotFoundP aliceId, serverUpP])
+  map fst <$> processedRatchetKeyHashes alice `shouldReturn` [bobId]
+  processedRatchetKeyHashes bob2 `shouldReturn` []
+  disposeAgentClient bob2
+  where
+    x3dhKeysNotFoundP :: ConnId -> ATransmission -> Bool
+    x3dhKeysNotFoundP cId = \case
+      (_, cId', AEvt SAEConn (ERR (A.INTERNAL e))) -> cId' == cId && "SEX3dhKeysNotFound" `isPrefixOf` e
+      _ -> False
+
+testRatchetSyncFailedRecreationNoReply :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncFailedRecreationNoReply ps = withAgentClients2 $ \alice bob -> do
+  (_, bobId, bob2) <- startRatchetSyncOffline ps alice bob
+  aliceSndMsgs <- sndMessages alice
+  withTransaction (store $ agentEnv alice) $ \db ->
+    DB.execute_ db "CREATE TRIGGER fail_ratchet_insert BEFORE INSERT ON ratchets BEGIN SELECT RAISE(ABORT, 'ratchet insert failed'); END"
+  withSmpServerStoreMsgLogOn ps testPort $ \_ ->
+    concurrently_
+      (getInAnyOrder alice [ratchetInsertFailedP bobId, serverUpP])
+      (getInAnyOrder bob2 [serverUpP])
+  processedRatchetKeyHashes alice `shouldReturn` []
+  sndMessages alice `shouldReturn` aliceSndMsgs
+  disposeAgentClient bob2
+  where
+    ratchetInsertFailedP :: ConnId -> ATransmission -> Bool
+    ratchetInsertFailedP cId = \case
+      (_, cId', AEvt SAEConn (ERR (A.INTERNAL e))) -> cId' == cId && "ratchet insert failed" `isInfixOf` e
+      _ -> False
+
+testRatchetSyncStartFailedNoKey :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncStartFailedNoKey ps = withAgentClients2 $ \alice bob -> do
+  (aliceId, _, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+  bobSndMsgs <- sndMessages bob2
+  withTransaction (store $ agentEnv bob2) $ \db ->
+    DB.execute_ db "CREATE TRIGGER fail_ratchet_update BEFORE UPDATE ON ratchets BEGIN SELECT RAISE(ABORT, 'ratchet update failed'); END"
+  Left (A.INTERNAL e) <- runExceptT $ synchronizeRatchet bob2 aliceId PQSupportOff False
+  e `shouldContain` "ratchet update failed"
+  ConnectionStats {ratchetSyncState} <- runRight $ getConnectionServers bob2 aliceId
+  ratchetSyncState `shouldBe` RSRequired
+  withTransaction (store $ agentEnv bob2) (`DB.query_` "SELECT conn_id, pq_support FROM connections") `shouldReturn` [(aliceId, PQSupportOn)]
+  sndMessages bob2 `shouldReturn` bobSndMsgs
+  disposeAgentClient bob2
+
+startRatchetSyncOffline :: HasCallStack => (ASrvTransport, AStoreType) -> AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
+startRatchetSyncOffline ps alice bob = do
+  (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
+    setupDesynchronizedRatchet alice bob
+  ("", "", DOWN _ _) <- nGet alice
+  ("", "", DOWN _ _) <- nGet bob2
+  ConnectionStats {ratchetSyncState} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn False
+  ratchetSyncState `shouldBe` RSStarted
+  pure (aliceId, bobId, bob2)
+
+processedRatchetKeyHashes :: AgentClient -> IO [(ConnId, ByteString)]
+processedRatchetKeyHashes c = withTransaction (store $ agentEnv c) (`DB.query_` "SELECT conn_id, hash FROM processed_ratchet_key_hashes")
+
+sndMessages :: AgentClient -> IO [(ConnId, Int64)]
+sndMessages c = withTransaction (store $ agentEnv c) (`DB.query_` "SELECT conn_id, internal_id FROM snd_messages ORDER BY conn_id, internal_id")
+
 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"
diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs
index d9aa79513..ee401bf19 100644
--- a/tests/AgentTests/SchemaDump.hs
+++ b/tests/AgentTests/SchemaDump.hs
@@ -48,6 +48,7 @@ schemaDumpTest = do
   it "verify strict tables" testVerifyStrict
   it "should NOT create user record for new database" testUsersMigrationNew
   it "should create user record for old database" testUsersMigrationOld
+  it "should remove duplicate ratchet key hashes before adding unique index" testRatchetKeyHashesUniqueMigration
 
 testVerifySchemaDump :: IO ()
 testVerifySchemaDump = do
@@ -114,12 +115,28 @@ testUsersMigrationOld = do
     `shouldReturn` ([Only (1 :: Int)])
   closeDBStore st'
 
+testRatchetKeyHashesUniqueMigration :: IO ()
+testRatchetKeyHashesUniqueMigration = do
+  let beforeUnique = takeWhile (("m20260929_ratchet_indexes" /=) . name) appMigrations
+  Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeUnique (MigrationConfig MCError Nothing)
+  withTransaction' st $ \db -> do
+    SQL.execute_ db "INSERT INTO users (user_id) VALUES (1)"
+    SQL.execute_ db "INSERT INTO connections (conn_id, conn_mode, user_id) VALUES (x'01', 'INV', 1), (x'02', 'INV', 1)"
+    SQL.execute_ db "INSERT INTO processed_ratchet_key_hashes (conn_id, hash) VALUES (x'01', x'aa'), (x'01', x'aa'), (x'01', x'bb'), (x'02', x'aa'), (x'01', x'aa')"
+  closeDBStore st
+  Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing)
+  withTransaction' st' (`SQL.query_` "SELECT processed_ratchet_key_hash_id FROM processed_ratchet_key_hashes ORDER BY processed_ratchet_key_hash_id")
+    `shouldReturn` [Only (1 :: Int), Only 3, Only 4]
+  closeDBStore st'
+
 skipComparisonForDownMigrations :: [String]
 skipComparisonForDownMigrations =
   [ -- on down migration idx_messages_internal_snd_id_ts index moves down to the end of the file
     "m20230814_indexes",
     -- snd_secure and last_broker_ts columns swap order on down migration
-    "m20250322_short_links"
+    "m20250322_short_links",
+    -- on down migration idx_processed_ratchet_key_hashes_hash index moves down to the end of the file
+    "m20260929_ratchet_indexes"
   ]
 
 getSchema :: FilePath -> FilePath -> IO String

From 4ab5376a6e7032579d90ec17a634a2bf85104176 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Mon, 5 Oct 2026 11:31:57 +0100
Subject: [PATCH 05/20] smp: reduce min supported version to 15 (short links
 support, 3/30/2025) (#1931)

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent.hs         | 32 +++++++++++---------------
 src/Simplex/Messaging/Agent/Client.hs  | 10 ++++----
 src/Simplex/Messaging/Protocol.hs      | 30 ++++++++++--------------
 src/Simplex/Messaging/Transport.hs     | 14 ++++-------
 tests/AgentTests/FunctionalAPITests.hs | 24 +------------------
 5 files changed, 36 insertions(+), 74 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 067031899..c5f57cdd9 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -1325,7 +1325,7 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
     Just d -> do
       (nonce, qUri, cReq, qd) <- prepareLinkData addrKeys_ (setLinkDataRatchetKeys addrKeys_ d) $ fst e2eKeys
       (rq, qUri') <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode (Just nonce) qd e2eKeys
-      connReqWithShortLink qUri cReq qUri' (shortLink rq)
+      connReqWithShortLink pqInitKeys qUri cReq qUri' rq
     Nothing -> do
       let qd = case cMode of SCMContact -> CQRContact Nothing; SCMInvitation -> CQRMessaging Nothing
       (_rq, qUri) <- createRcvQueue c nm userId connId srvWithAuth enableNtfs subMode Nothing qd e2eKeys
@@ -1372,23 +1372,19 @@ newRcvConnSrv c nm userId connId enableNtfs cMode userLinkData_ clientData pqIni
           srvData <- liftError id $ SL.encryptLinkData g k linkData
           pure $ CQRMessaging $ Just CQRData {linkKey, privSigKey, srvReq = (sndId, srvData)}
       pure (nonce, qUri, connReq, qd)
-    connReqWithShortLink :: SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> Maybe ShortLinkCreds -> AM (CreatedConnLink c)
-    connReqWithShortLink qUri cReq qUri' shortLink = case shortLink of
-      Just ShortLinkCreds {shortLinkId, shortLinkKey}
-        | qUri == qUri' -> pure $ case cReq of
-            CRContactUri _ _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey
-            CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) ->
-              let cReq' = case pqInitKeys of
-                    CR.IKPQOn -> CRInvitationUri crData $ CR.E2ERatchetParamsUri vr k1 k2 Nothing -- remove PQ keys
-                    _ -> cReq -- either PQ is disabled, or disabled for initial request because there is no short link
-               in CCLink cReq' $ Just $ CSLInvitation SLSServer srv shortLinkId shortLinkKey
-        | otherwise -> throwE $ INTERNAL "different rcv queue address"
-      Nothing ->
-        let updated (ConnReqUriData _ vr _ _) = (ConnReqUriData SSSimplex vr [qUri'] clientData)
-            cReq' = case cReq of
-              CRContactUri crData rk -> CRContactUri (updated crData) rk
-              CRInvitationUri crData e2eParams -> CRInvitationUri (updated crData) e2eParams
-         in pure $ CCLink cReq' Nothing
+
+connReqWithShortLink :: CR.InitialKeys -> SMPQueueUri -> ConnectionRequestUri c -> SMPQueueUri -> RcvQueue -> AM (CreatedConnLink c)
+connReqWithShortLink pqInitKeys qUri cReq qUri' RcvQueue {server = srv, shortLink} = case shortLink of
+  Just ShortLinkCreds {shortLinkId, shortLinkKey}
+    | qUri == qUri' -> pure $ case cReq of
+        CRContactUri _ _ -> CCLink cReq $ Just $ CSLContact SLSServer CCTContact srv shortLinkKey
+        CRInvitationUri crData (CR.E2ERatchetParamsUri vr k1 k2 _) ->
+          let cReq' = case pqInitKeys of
+                CR.IKPQOn -> CRInvitationUri crData $ CR.E2ERatchetParamsUri vr k1 k2 Nothing -- remove PQ keys
+                _ -> cReq -- either PQ is disabled, or disabled for initial request because there is no short link
+           in CCLink cReq' $ Just $ CSLInvitation SLSServer srv shortLinkId shortLinkKey
+    | otherwise -> throwE $ INTERNAL "different rcv queue address"
+  Nothing -> throwE $ INTERNAL "no short link credentials"
 
 newQueueNtfServer :: AM (Maybe NtfServer)
 newQueueNtfServer = fmap ntfServer_ . readTVarIO . ntfTkn =<< asks ntfSupervisor
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 453acf106..3d8f8c1bd 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -312,7 +312,7 @@ import Simplex.Messaging.Session
 import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfo), TransportError (..), TransportPeer (..), shortLinksSMPVersion, newNtfCredsSMPVersion)
+import Simplex.Messaging.Transport (HandshakeError (..), SMPServiceRole (..), SMPVersion, ServiceCredentials (..), SessionId, THClientService' (..), THandleAuth (..), THandleParams (sessionId, thAuth, thVersion, serverInfo), TransportError (..), newNtfCredsSMPVersion)
 import Simplex.Messaging.Transport.Client (TransportHost (..))
 import Simplex.Messaging.Transport.Credentials
 import Simplex.Messaging.Util
@@ -1499,7 +1499,7 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
   let sessServiceId = (\THClientService {serviceId = sId} -> sId) <$> (clientService =<< thAuth thParams')
   when (isJust serviceId && serviceId /= sessServiceId) $ logError "incorrect service ID in NEW response"
   liftIO . logServer "<--" c srv NoEntity $ B.unwords ["IDS", logSecret rcvId, logSecret sndId]
-  shortLink <- mkShortLinkCreds thParams' qik
+  shortLink <- mkShortLinkCreds qik
   let rq =
         RcvQueue
           { userId,
@@ -1540,8 +1540,8 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
       (Just ((ntfPublicKey, ntfPrivateKey), dhpk), Just (ServerNtfCreds notifierId dhk')) ->
         Just ClientNtfCreds {ntfPublicKey, ntfPrivateKey, notifierId, rcvNtfDhSecret = C.dh' dhk' dhpk}
       _ -> Nothing
-    mkShortLinkCreds :: THandleParams SMPVersion 'TClient -> QueueIdsKeys -> AM (Maybe ShortLinkCreds)
-    mkShortLinkCreds thParams' QIK {sndId, queueMode, linkId} = case (cqrd, queueMode) of
+    mkShortLinkCreds :: QueueIdsKeys -> AM (Maybe ShortLinkCreds)
+    mkShortLinkCreds QIK {sndId, queueMode, linkId} = case (cqrd, queueMode) of
       (CQRMessaging ld, Just QMMessaging) ->
         withLinkData ld $ \lnkId CQRData {linkKey, privSigKey, srvReq = (sndId', d)} ->
           if sndId == sndId'
@@ -1555,11 +1555,9 @@ newRcvQueue_ c nm userId connId (ProtoServerWithAuth srv auth) vRange cqrd enabl
       (_, Nothing) -> newErr "unexpected link ID"
       _ -> newErr "unexpected queue mode"
       where
-        v = thVersion thParams'
         withLinkData :: Maybe d -> (SMP.LinkId -> d -> AM (Maybe ShortLinkCreds)) -> AM (Maybe ShortLinkCreds)
         withLinkData ld_ mkLink = case (ld_, linkId) of
           (Just ld, Just lnkId) -> mkLink lnkId ld
-          (Just _, Nothing) | v < shortLinksSMPVersion -> pure Nothing
           (Nothing, Nothing) -> pure Nothing
           _ -> newErr "unexpected or absent link ID"
         newErr :: String -> AM (Maybe ShortLinkCreds)
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index a62e84224..ab0f362f4 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -1824,8 +1824,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where
   encodeProtocol v = \case
     NEW NewQueueReq {rcvAuthKey = rKey, rcvDhKey = dhKey, auth_, subMode, queueReqData, ntfCreds}
       | v >= newNtfCredsSMPVersion -> new <> e (subMode, queueReqData, ntfCreds)
-      | v >= shortLinksSMPVersion -> new <> e (subMode, queueReqData)
-      | otherwise -> new <> e (subMode, senderCanSecure (queueReqMode <$> queueReqData))
+      | otherwise -> new <> e (subMode, queueReqData)
       where
         new = e (NEW_, ' ', rKey, dhKey, auth_)
     SUB -> e SUB_
@@ -1912,20 +1911,18 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where
     CT SCreator NEW_ -> Cmd SCreator <$> newCmd
       where
         newCmd
-          | v >= newNtfCredsSMPVersion = new smpP smpP
-          | v >= shortLinksSMPVersion = new smpP nothing
-          | otherwise = new (qReq <$> smpP) nothing
+          | v >= newNtfCredsSMPVersion = new smpP
+          | otherwise = new nothing
           where
             nothing = pure Nothing
-            new p2 p3 = NEW <$> do
+            new p3 = NEW <$> do
               rcvAuthKey <- _smpP
               rcvDhKey <- smpP
               auth_ <- smpP
               subMode <- smpP
-              queueReqData <- p2
+              queueReqData <- smpP
               ntfCreds <- p3
               pure NewQueueReq {rcvAuthKey, rcvDhKey, auth_, subMode, queueReqData, ntfCreds}
-            qReq sndSecure = Just $ if sndSecure then QRMessaging Nothing else QRContact Nothing
     CT SRecipient tag ->
       Cmd SRecipient <$> case tag of
         SUB_ -> pure SUB
@@ -1976,8 +1973,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
     IDS QIK {rcvId, sndId, rcvPublicDhKey = srvDh, queueMode, linkId, serviceId, serverNtfCreds}
       | v >= newNtfCredsSMPVersion -> ids <> e (queueMode, linkId, serviceId, serverNtfCreds)
       | v >= serviceCertsSMPVersion -> ids <> e (queueMode, linkId, serviceId)
-      | v >= shortLinksSMPVersion -> ids <> e (queueMode, linkId)
-      | otherwise -> ids <> e (senderCanSecure queueMode)
+      | otherwise -> ids <> e (queueMode, linkId)
       where
         ids = e (IDS_, ' ', rcvId, sndId, srvDh)
     LNK sId d -> e (LNK_, ' ', sId, d)
@@ -2028,19 +2024,17 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
         bodyP = EncRcvMsgBody . unTail <$> smpP
     ALLS_ -> pure ALLS
     IDS_
-      | v >= newNtfCredsSMPVersion -> ids smpP smpP smpP smpP
-      | v >= serviceCertsSMPVersion -> ids smpP smpP smpP nothing
-      | v >= shortLinksSMPVersion -> ids smpP smpP nothing nothing
-      | otherwise -> ids (qm <$> smpP) nothing nothing nothing
+      | v >= newNtfCredsSMPVersion -> ids smpP smpP
+      | v >= serviceCertsSMPVersion -> ids smpP nothing
+      | otherwise -> ids nothing nothing
       where
-        qm sndSecure = Just $ if sndSecure then QMMessaging else QMContact
         nothing = pure Nothing
-        ids p1 p2 p3 p4 = do
+        ids p3 p4 = do
           rcvId <- _smpP
           sndId <- smpP
           rcvPublicDhKey <- smpP
-          queueMode <- p1
-          linkId <- p2
+          queueMode <- smpP
+          linkId <- smpP
           serviceId <- p3
           serverNtfCreds <- p4
           pure $ IDS QIK {rcvId, sndId, rcvPublicDhKey, queueMode, linkId, serviceId, serverNtfCreds}
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 0a082a388..32e33ad1a 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -46,7 +46,6 @@ module Simplex.Messaging.Transport
     minServerSMPRelayVersion,
     currentClientSMPRelayVersion,
     currentServerSMPRelayVersion,
-    shortLinksSMPVersion,
     serviceCertsSMPVersion,
     newNtfCredsSMPVersion,
     clientNoticesSMPVersion,
@@ -191,11 +190,8 @@ type VersionRangeSMP = VersionRange SMPVersion
 pattern VersionSMP :: Word16 -> VersionSMP
 pattern VersionSMP v = Version v
 
-_proxyServerHandshakeSMPVersion :: VersionSMP
-_proxyServerHandshakeSMPVersion = VersionSMP 14
-
-shortLinksSMPVersion :: VersionSMP
-shortLinksSMPVersion = VersionSMP 15
+_shortLinksSMPVersion :: VersionSMP
+_shortLinksSMPVersion = VersionSMP 15
 
 serviceCertsSMPVersion :: VersionSMP
 serviceCertsSMPVersion = VersionSMP 16
@@ -224,10 +220,10 @@ fwdNoncesSMPVersion :: VersionSMP
 fwdNoncesSMPVersion = VersionSMP 23
 
 minClientSMPRelayVersion :: VersionSMP
-minClientSMPRelayVersion = VersionSMP 14
+minClientSMPRelayVersion = VersionSMP 15
 
 minServerSMPRelayVersion :: VersionSMP
-minServerSMPRelayVersion = VersionSMP 14
+minServerSMPRelayVersion = VersionSMP 15
 
 currentClientSMPRelayVersion :: VersionSMP
 currentClientSMPRelayVersion = VersionSMP 23
@@ -245,7 +241,7 @@ currentServerSMPRelayVersion = VersionSMP 23
 proxiedSMPRelayVersion :: VersionSMP
 proxiedSMPRelayVersion = VersionSMP 23
 
--- minimal supported protocol version is 14
+-- minimal supported protocol version is 15
 supportedClientSMPRelayVRange :: VersionRangeSMP
 supportedClientSMPRelayVRange = mkVersionRange minClientSMPRelayVersion currentClientSMPRelayVersion
 
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 727c47d5a..0467306f5 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -112,7 +112,7 @@ import Simplex.Messaging.Server.Information (ServerPublicInfo (..))
 import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.StoreLog (StoreLogRecord (..))
-import Simplex.Messaging.Transport (ASrvTransport, SMPVersion, VersionSMP, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
+import Simplex.Messaging.Transport (ASrvTransport, SMPVersion, VersionSMP, currentServerSMPRelayVersion, minClientSMPRelayVersion, minServerSMPRelayVersion, alpnSupportedSMPHandshakes)
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..))
 import Simplex.Messaging.Util (bshow, diffToMicroseconds)
 import Simplex.Messaging.Version (VersionRange (..))
@@ -415,7 +415,6 @@ functionalAPITests ps = do
     describe "should connect via 1-time short link with async join" $ testProxyMatrix ps testInvitationShortLinkAsync
     describe "should connect via contact short link" $ testProxyMatrix ps testContactShortLink
     describe "should add short link to existing contact and connect" $ testProxyMatrix ps testAddContactShortLink
-    xdescribe "try to create 1-time short link with prev versions" $ testProxyMatrixWithPrev ps testInvitationShortLinkPrev
     describe "server restart" $ do
       it "should get 1-time link data after restart" $ testInvitationShortLinkRestart ps
       it "should connect via contact short link after restart" $ testContactShortLinkRestart ps
@@ -677,19 +676,6 @@ testProxyMatrix ps runTest = do
   it "2 servers, directly" $ withSmpServers2 ps $ withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers2) $ runTest False
   it "2 servers, via proxy" $ withSmpServersProxy2 ps $ withAgentClientsServers2 (agentCfg, initAgentServersProxy) (agentCfg, initAgentServersProxy2) $ runTest True
 
-testProxyMatrixWithPrev :: HasCallStack => (ASrvTransport, AStoreType) -> (Bool -> Bool -> AgentClient -> AgentClient -> IO ()) -> Spec
-testProxyMatrixWithPrev ps@(t, msType@(ASType qs _ms)) runTest = do
-  it "2 servers, directly, curr clients, prev servers" $ withSmpServers2Prev $ withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers2) $ runTest False True
-  it "2 servers, via proxy, curr clients, prev servers" $ withSmpServersProxy2Prev $ withAgentClientsServers2 (agentCfg, initAgentServersProxy) (agentCfg, initAgentServersProxy2) $ runTest True True
-  it "2 servers, directly, prev clients, curr servers" $ withSmpServers2 ps $ withAgentClientsServers2 (agentCfgVPrevPQ, initAgentServers) (agentCfgVPrevPQ, initAgentServers2) $ runTest False False
-  it "2 servers, via proxy, prev clients, curr servers" $ withSmpServersProxy2 ps $ withAgentClientsServers2 (agentCfgVPrevPQ, initAgentServersProxy) (agentCfgVPrevPQ, initAgentServersProxy2) $ runTest True False
-  where
-    prev cfg' = updateCfg cfg' $ \cfg_ -> cfg_ {smpServerVRange = prevRange supportedServerSMPRelayVRange}
-    withSmpServers2Prev a = withServers2 (prev $ cfgMS msType) (prev $ cfgJ2QS qs) a
-    withSmpServersProxy2Prev a = withServers2 (prev $ proxyCfgMS msType) (prev $ proxyCfgJ2QS qs) a
-    withServers2 cfg1 cfg2 a =
-      withSmpServerConfigOn t cfg1 testPort $ \_ -> withSmpServerConfigOn t cfg2 testPort2 $ \_ -> a
-
 testPQMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 testPQMatrix2 = pqMatrix2_ True
 
@@ -1791,14 +1777,6 @@ testJoinConn_ viaProxy sndSecure a bId b connReq = do
   get b ##> ("", aId, CON)
   exchangeGreetingsViaProxy viaProxy a bId b aId
 
-testInvitationShortLinkPrev :: HasCallStack => Bool -> Bool -> AgentClient -> AgentClient -> IO ()
-testInvitationShortLinkPrev viaProxy sndSecure a b = runRight_ $ do
-  let userData = UserLinkData "some user data"
-      newLinkData = UserInvLinkData userData
-  -- can't create short link with previous version
-  (bId, CCLink connReq Nothing) <- A.createConnection a NRMInteractive 1 True True SCMInvitation (Just newLinkData) Nothing CR.IKPQOn False SMSubscribe
-  testJoinConn_ viaProxy sndSecure a bId b connReq
-
 testInvitationShortLinkAsync :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
 testInvitationShortLinkAsync viaProxy a b = do
   let userData = UserLinkData "some user data"

From c0a1b7bd2d79c4af5163d9a863cb0780f556d7a9 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Tue, 6 Oct 2026 13:01:55 +0100
Subject: [PATCH 06/20] agent: fail database transaction instantly when
 database is closed, prevent race conditions in command processing, fix race
 when uploading files (#1885)

* agent: fail database transaction instantly when database is closed

* update direct-sqlcipher

* update direct-sqlcipher, fixes

* autoincrement command ID

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 cabal.project                                 |   2 +-
 simplexmq.cabal                               |   1 +
 src/Simplex/FileTransfer/Agent.hs             |   5 +-
 src/Simplex/Messaging/Agent.hs                | 136 ++++++++++--------
 .../Messaging/Agent/Store/SQLite/Common.hs    |   3 +-
 .../Agent/Store/SQLite/Migrations/App.hs      |   4 +-
 .../M20261005_commands_autoincrement.hs       |  33 +++++
 .../Store/SQLite/Migrations/agent_schema.sql  |   4 +-
 tests/AgentTests/SQLiteTests.hs               |   2 +-
 tests/AgentTests/SchemaDump.hs                |   4 +-
 10 files changed, 122 insertions(+), 72 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261005_commands_autoincrement.hs

diff --git a/cabal.project b/cabal.project
index 924f09c9e..af04f8ed0 100644
--- a/cabal.project
+++ b/cabal.project
@@ -31,7 +31,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/direct-sqlcipher.git
-    tag: f814ee68b16a9447fbb467ccc8f29bdd3546bfd9
+    tag: 2330df3dc8c4b660674d3c02d76bb86f66c2abee
 
 source-repository-package
     type: git
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 7244d4de0..ef46fb723 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -252,6 +252,7 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
           Simplex.Messaging.Agent.Store.SQLite.Util
   if flag(client_postgres) || flag(server_postgres)
       exposed-modules:
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index aa6bbabf7..b0e8c056a 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -568,9 +568,10 @@ runXFTPSndWorker c srv Worker {doWork} = do
       notify c sndFileEntityId $ SFPROG uploaded total
       when complete $ do
         (sndDescr, rcvDescrs) <- sndFileToDescrs sf
+        flip catchAllErrors (\e -> logError $ "XFTP snd worker error: " <> tshow e) $ do
+          lift . forM_ prefixPath $ removePath <=< toFSFilePath
+          withStore' c $ \db -> updateSndFileComplete db sndFileId
         notify c sndFileEntityId $ SFDONE sndDescr rcvDescrs (sndFileExpiresAt chunks)
-        lift . forM_ prefixPath $ removePath <=< toFSFilePath
-        withStore' c $ \db -> updateSndFileComplete db sndFileId
       where
         addRecipients :: SndFileChunk -> SndFileChunkReplica -> AM SndFileChunkReplica
         addRecipients ch@SndFileChunk {numRecipients} cr@SndFileChunkReplica {sndChunkReplicaId, rcvIdsKeys}
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index c5f57cdd9..05df98ecc 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -506,7 +506,7 @@ joinConnection c nm userId connId enableNtfs = withAgentEnv c .:: joinConn c nm
 
 -- | Allow connection to continue after CONF notification (LET command)
 allowConnection :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AE ()
-allowConnection c = withAgentEnv c .:. allowConnection' c
+allowConnection c = withAgentEnv c .:. allowConnection' c Nothing
 {-# INLINE allowConnection #-}
 
 -- | Accept contact after REQ notification (ACPT command)
@@ -636,7 +636,7 @@ sendMessagesB c = withAgentEnv c . sendMessagesB' c
 {-# INLINE sendMessagesB #-}
 
 ackMessage :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AE ()
-ackMessage c = withAgentEnv c .:. ackMessage' c
+ackMessage c = withAgentEnv c .:. ackMessage' c Nothing
 {-# INLINE ackMessage #-}
 
 getConnectionQueueInfo :: AgentClient -> NetworkRequestMode -> ConnId -> AE ServerQueueInfo
@@ -1621,8 +1621,8 @@ delInvSL c connId srv lnkId =
   withStore' c (\db -> deleteInvShortLink db (protoServer srv) lnkId) `catchE` \e ->
     liftIO $ nonBlockingWriteTBQueue (subQ c) ("", connId, AEvt SAEConn (ERR $ INTERNAL $ "error deleting short link " <> show e))
 
-joinConnSrvAsync :: AgentClient -> ConnId -> (ConnData -> Maybe SndQueue -> AM (SndQueue, (Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId))) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
-joinConnSrvAsync c connId startJoin cInfo subMode srv = do
+joinConnSrvAsync :: AgentClient -> AsyncCmdId -> ConnId -> (ConnData -> Maybe SndQueue -> AM (SndQueue, (Maybe (CR.SndE2ERatchetParams 'C.X448), Maybe SMP.LinkId))) -> ConnInfo -> SubscriptionMode -> SMPServerWithAuth -> AM SndQueueSecured
+joinConnSrvAsync c cmdId connId startJoin cInfo subMode srv = do
   SomeConn cType conn <- withStore c (`getConn` connId)
   let cData = toConnData conn
   case conn of
@@ -1637,7 +1637,7 @@ joinConnSrvAsync c connId startJoin cInfo subMode srv = do
     doJoin :: ConnData -> Maybe RcvQueue -> Maybe SndQueue -> AM SndQueueSecured
     doJoin cData rq_ sq_ = do
       (sq, (e2eSndParams, lnkId_)) <- startJoin cData sq_
-      secureConfirmQueueAsync c cData rq_ sq srv cInfo e2eSndParams subMode
+      secureConfirmQueueAsync c cmdId cData rq_ sq srv cInfo e2eSndParams subMode
         >>= (mapM_ (delInvSL c connId srv) lnkId_ $>)
 
 createReplyQueue :: AgentClient -> NetworkRequestMode -> ConnData -> SndQueue -> SubscriptionMode -> SMPServerWithAuth -> AM SMPQueueInfo
@@ -1652,13 +1652,15 @@ createReplyQueue c nm ConnData {userId, connId, enableNtfs} SndQueue {smpClientV
   pure qInfo
 
 -- | Approve confirmation (LET command) in Reader monad
-allowConnection' :: AgentClient -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
-allowConnection' c connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
+allowConnection' :: AgentClient -> Maybe AsyncCmdId -> ConnId -> ConfirmationId -> ConnInfo -> AM ()
+allowConnection' c cmdId_ connId confId ownConnInfo = withConnLock c connId "allowConnection" $ do
   withStore c (`getConn` connId) >>= \case
     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
+      withStore c $ \db -> runExceptT $ do
+        AcceptedConfirmation {senderConf = SMPConfirmation {senderKey}} <- ExceptT $ acceptConfirmation db confId ownConnInfo
+        ExceptT $ createCommand db "" connId (Just server) $ AInternalCommand $ ICAllowSecure rcvId senderKey
+        liftIO $ mapM_ (deleteCommand db) cmdId_
+      lift . void $ getAsyncCmdWorker True c connId (Just server)
     _ -> throwE $ CMD PROHIBITED "allowConnection"
 
 -- | Accept contact (ACPT command) in Reader monad
@@ -1744,7 +1746,7 @@ prepareReply c userId Invitation {invitationId, connReq, serviceRequest, created
     CRInvitationDR dr -> do
       cData <- newConnToAcceptDR c userId "" dr False
       sq <- startJoinInvitationDR c userId cData dr
-      storeConfirmation c cData sq Nothing innerMsg
+      storeConfirmation c Nothing cData sq Nothing innerMsg
       pure (cData, sq)
 
 serviceReqBinding :: CR.Ratchet a -> ByteString
@@ -2160,7 +2162,7 @@ getAsyncCmdWorker :: Bool -> AgentClient -> ConnId -> Maybe SMPServer -> AM' Wor
 getAsyncCmdWorker hasWork c connId server =
   getAgentWorker "async_cmd" hasWork c (connId, server) (asyncCmdWorkers c) (runCommandProcessing c connId server)
 
-data CommandCompletion = CCMoved | CCCompleted
+data CommandCompletion = CCMoved | CCCompleted | CCDeleted
 
 runCommandProcessing :: AgentClient -> ConnId -> Maybe SMPServer -> Worker -> AM ()
 runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
@@ -2195,15 +2197,15 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
             notify $ LDATA fixedData linkData connReq
         JOIN (JRInvitationDR dr@DRInvitation {replyQueue}) subMode ownCInfo -> noServer $ do
           triedHosts <- newTVarIO S.empty
-          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do
+          tryAtomicCommand . withNextSrv c userId storageSrvs triedHosts [qServer replyQueue] $ \srv -> do
             let startJoin cData sq_ = (,(Nothing, Nothing)) <$> maybe (startJoinInvitationDR c userId cData dr) pure sq_
-            sqSecured <- joinConnSrvAsync c connId startJoin ownCInfo subMode srv
+            sqSecured <- joinConnSrvAsync c cmdId connId startJoin ownCInfo subMode srv
             notify $ JOINED sqSecured
         JOIN (JRConnReq enableNtfs (ACR _ cReq@(CRInvitationUri ConnReqUriData {crSmpQueues = q :| _} _)) pqEnc) subMode connInfo -> noServer $ do
           triedHosts <- newTVarIO S.empty
-          tryCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
+          tryAtomicCommand . withNextSrv c userId storageSrvs triedHosts [qServer q] $ \srv -> do
             let startJoin _ sq_ = first snd <$> startJoinInvitation c userId connId sq_ enableNtfs cReq pqEnc
-            sqSecured <- joinConnSrvAsync c connId startJoin connInfo subMode srv
+            sqSecured <- joinConnSrvAsync c cmdId connId startJoin connInfo subMode srv
             notify $ JOINED sqSecured
         -- TODO TBC using joinConnSrvAsync for contact URIs, with receive queue created asynchronously.
         -- Currently joinConnSrv is used because even joinConnSrvAsync for invitation URIs creates receive queue synchronously.
@@ -2225,35 +2227,37 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                       if temporaryOrHostError e
                         then throwE e
                         else atomically $ void $ tryPutTMVar v $ Left e -- will not overwrite existing result
-        LET confId ownCInfo -> withServer' . tryCommand $ allowConnection' c connId confId ownCInfo >> notify OK
-        ACK msgId rcptInfo_ -> withServer' . tryCommand $ ackMessage' c connId msgId rcptInfo_ >> notify OK
+        LET confId ownCInfo -> withServer' . tryAtomicCommand $ allowConnection' c (Just cmdId) connId confId ownCInfo >> notify OK
+        ACK msgId rcptInfo_ -> withServer' . tryAtomicCommand $ ackMessage' c (Just cmdId) connId msgId rcptInfo_ >> notify OK
         SWCH ->
-          noServer . tryWithLock "switchConnection" $
+          noServer . tryAtomicWithLock "switchConnection" $
             withStore c (`getConn` connId) >>= \case
               SomeConn _ conn@(DuplexConnection _ (replaced :| _rqs) _) ->
-                switchDuplexConnection c NRMBackground conn replaced >>= notify . SWITCH QDRcv SPStarted
+                switchDuplexConnection c NRMBackground (Just cmdId) conn replaced >>= notify . SWITCH QDRcv SPStarted
               _ -> throwE $ CMD PROHIBITED "SWCH: not duplex"
-        DEL -> withServer' . tryCommand $ deleteConnection' c NRMBackground connId >> notify OK
+        DEL -> withServer' . tryAtomicCommand $ deleteConnection' c NRMBackground connId >> notify OK
       AInternalCommand cmd -> case cmd of
         ICAckDel rId srvMsgId msgId -> withServer $ \srv ->
-          tryCommand $ withConnLockNotify c connId "ICAckDel" $ do
+          tryAtomicCommand $ withConnLockNotify c connId "ICAckDel" $ do
             t_ <- ack srv rId srvMsgId
-            withStore' c (\db -> deleteMsg db connId msgId)
+            withStore' c (\db -> deleteMsg db connId msgId >> deleteCommand db cmdId)
             pure t_
         ICAck rId srvMsgId -> withServer $ \srv ->
           tryCommand $ withConnLockNotify c connId "ICAck" $ ack srv rId srvMsgId
         ICAllowSecure _rId senderKey -> withServer' . tryMoveableWithLock "ICAllowSecure" $ do
           (SomeConn _ conn, AcceptedConfirmation {senderConf, ownConnInfo}) <-
             withStore c $ \db -> runExceptT $ (,) <$> ExceptT (getConn db connId) <*> ExceptT (getAcceptedConfirmation db connId)
+          let connectReplyQueues_ cData sq_ = case L.nonEmpty $ smpReplyQueues senderConf of
+                Just qs -> connectReplyQueues c cmdId cData ownConnInfo sq_ qs $> CCDeleted
+                Nothing -> pure CCCompleted
           case conn of
             RcvConnection cData rq -> do
               mapM_ (secure rq) senderKey
-              mapM_ (connectReplyQueues c cData ownConnInfo Nothing) (L.nonEmpty $ smpReplyQueues senderConf)
-              pure CCCompleted
+              connectReplyQueues_ cData Nothing
             -- duplex connection is matched to handle SKEY retries
             DuplexConnection cData _ (sq :| _) -> do
-              tryAllErrors (mapM_ (connectReplyQueues c cData ownConnInfo (Just sq)) (L.nonEmpty $ smpReplyQueues senderConf)) >>= \case
-                Right () -> pure CCCompleted
+              tryAllErrors (connectReplyQueues_ cData (Just sq)) >>= \case
+                Right cc -> pure cc
                 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
@@ -2264,36 +2268,36 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
               where
                 server = qServer sq
             _ -> throwE $ INTERNAL $ "incorrect connection type " <> show (internalCmdTag cmd)
-        ICDuplexSecure _rId senderKey -> withServer' . tryWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
+        ICDuplexSecure _rId senderKey -> withServer' . tryAtomicWithLock "ICDuplexSecure" . withDuplexConn $ \(DuplexConnection cData (rq :| _) (sq :| _)) -> do
           secure rq senderKey
-          void $ enqueueMessage c cData sq SMP.MsgFlags {notification = True} HELLO
+          void $ enqueueMessage c (Just cmdId) cData sq SMP.MsgFlags {notification = True} HELLO
         ICReplyDel -> withServer' . tryWithLock "ICReplyDel" $
           withStore c (`getConn` connId) >>= \case
             SomeConn _ (SndConnection cData sq) -> sendReplySync c NRMBackground (cData, sq)
             _ -> throwE $ INTERNAL "ICReplyDel: incorrect connection type"
         -- ICDeleteConn is no longer used, but it can be present in old client databases
         ICDeleteConn -> withStore' c (`deleteCommand` cmdId)
-        ICDeleteRcvQueue rId -> withServer $ \srv -> tryWithLock "ICDeleteRcvQueue" $ do
+        ICDeleteRcvQueue rId -> withServer $ \srv -> tryAtomicWithLock "ICDeleteRcvQueue" $ do
           rq <- withStore c (\db -> getDeletedRcvQueue db connId srv rId)
           maxErrs <- asks $ deleteErrorCount . config
           tryAllErrors (deleteQueue c NRMBackground rq) >>= \case
             Left e | temporaryOrHostError e && deleteErrors rq + 1 < maxErrs -> do
               withStore' c (`incRcvDeleteErrors` rq)
               throwE e
-            _ -> withStore' c (`deleteConnRcvQueue` rq)
+            _ -> withStore' c $ \db -> deleteConnRcvQueue db rq >> deleteCommand db cmdId
         ICQSecure rId senderKey ->
-          withServer $ \srv -> tryWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
+          withServer $ \srv -> tryAtomicWithLock "ICQSecure" . withDuplexConn $ \(DuplexConnection cData rqs sqs) ->
             case find (sameQueue (srv, rId)) rqs of
               Just rq'@RcvQueue {server, sndId, status, dbReplaceQueueId = Just replaceQId} ->
                 case find ((replaceQId ==) . dbQId) rqs of
-                  Just rq1 -> when (status == Confirmed) $ do
+                  Just rq1 -> if status /= Confirmed then withStore' c (`deleteCommand` cmdId) else do
                     secureQueue c NRMBackground 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
+                    rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 (Just RSSendingQUSE) <* deleteCommand db cmdId
                     let rqs' = updatedQs rq1' rqs
                         conn' = DuplexConnection cData rqs' sqs
                     cStats <- connectionStats c conn'
@@ -2326,7 +2330,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                     forM_ (find (\q -> sndSwchStatus q == Just SSSendingQEND) sqs) $ \oldSq ->
                       void $ enqueueMessages c cData [oldSq, sq'] SMP.noMsgFlags $ QEND [qAddress oldSq]
         ICQDelete rId -> do
-          withServer $ \srv -> tryWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData@ConnData {enableNtfs} rqs sqs) -> do
+          withServer $ \srv -> tryAtomicWithLock "ICQDelete" . withDuplexConn $ \(DuplexConnection cData@ConnData {enableNtfs} rqs sqs) -> do
             case removeQ (srv, rId) rqs of
               Nothing -> internalErr "ICQDelete: queue address not found in connection"
               Just (rq'@RcvQueue {primary}, rq'' : rqs')
@@ -2337,10 +2341,10 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                       Right () -> finalizeSwitch
                       Left e
                         | temporaryOrHostError e -> throwE e
-                        | otherwise -> finalizeSwitch >> throwE e
+                        | otherwise -> finalizeSwitch >> notify (ERR e)
                 where
                   finalizeSwitch = do
-                    withStore' c $ \db -> deleteConnRcvQueue db rq'
+                    withStore' c $ \db -> deleteConnRcvQueue db rq' >> deleteCommand db cmdId
                     when enableNtfs $ do
                       ns <- asks ntfSupervisor
                       liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
@@ -2373,6 +2377,7 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
             SomeConn _ conn@DuplexConnection {} -> a conn
             _ -> internalErr "command requires duplex connection"
         tryCommand action = tryMoveableCommand (action $> CCCompleted)
+        tryAtomicCommand action = tryMoveableCommand (action $> CCDeleted)
         tryMoveableCommand action = withRetryInterval2 ri $ \_ loop -> do
           liftIO $ waitWhileSuspended c
           liftIO $ waitForUserNetwork c
@@ -2388,7 +2393,9 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
               | otherwise -> cmdError e
             Right CCCompleted -> withStore' c (`deleteCommand` cmdId)
             Right CCMoved -> pure () -- command processing moved to another command queue
+            Right CCDeleted -> pure ()
         tryWithLock name = tryCommand . withConnLock c connId name
+        tryAtomicWithLock name = tryAtomicCommand . 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)
@@ -2410,7 +2417,7 @@ enqueueMessages' c cData sqs msgFlags aMessage =
 
 enqueueMessagesB :: Traversable t => AgentClient -> t (Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType (AgentMsgId, PQEncryption)))
 enqueueMessagesB c reqs = do
-  reqs' <- enqueueMessageB c reqs
+  reqs' <- enqueueMessageB c Nothing reqs
   enqueueSavedMessageB c $ mapMaybe snd $ rights $ toList reqs'
   pure $ fst <$$> reqs'
 
@@ -2420,17 +2427,19 @@ isActiveSndQ ConnData {connAgentVersion} sq@SndQueue {status, sndSwchStatus} =
     && (status == Secured || status == Active || (connAgentVersion >= rpcAddressSMPAgentVersion && securingSndQueue sq))
 {-# INLINE isActiveSndQ #-}
 
-enqueueMessage :: AgentClient -> ConnData -> SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
-enqueueMessage c cData sq msgFlags aMessage =
-  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c (Identity (Right (Right (cData, [sq]), Nothing, msgFlags, vrValue aMessage)))
+enqueueMessage :: AgentClient -> Maybe AsyncCmdId -> ConnData -> SndQueue -> MsgFlags -> AMessage -> AM (AgentMsgId, PQEncryption)
+enqueueMessage c cmdId_ cData sq msgFlags aMessage =
+  ExceptT $ fmap fst . runIdentity <$> enqueueMessageB c cmdId_ (Identity (Right (Right (cData, [sq]), Nothing, msgFlags, vrValue aMessage)))
 {-# INLINE enqueueMessage #-}
 
 -- this function is used only for sending messages in batch, it returns the list of successes to enqueue additional deliveries
-enqueueMessageB :: forall t. Traversable t => AgentClient -> t (Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId))))
-enqueueMessageB c reqs = do
+enqueueMessageB :: forall t. Traversable t => AgentClient -> Maybe AsyncCmdId -> t (Either AgentErrorType (Either AgentErrorType (ConnData, NonEmpty SndQueue), Maybe PQEncryption, MsgFlags, ValueOrRef AMessage)) -> AM' (t (Either AgentErrorType ((AgentMsgId, PQEncryption), Maybe ([SndQueue], AgentMsgId))))
+enqueueMessageB c cmdId_ reqs = do
   cfg <- asks config
   (_, reqMids) <- unsafeWithStore c $ \db -> do
-    mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
+    res@(_, rs) <- mapAccumLM (\ids r -> storeSentMsg db cfg ids r `E.catchAny` \e -> (ids,) <$> handleInternal e) IM.empty reqs
+    when (all isRight rs) $ mapM_ (deleteCommand db) cmdId_
+    pure res
   forME reqMids $ submitSentMsg c
   where
     handleInternal :: E.SomeException -> IO (Either AgentErrorType b)
@@ -2756,8 +2765,8 @@ withConnLockNotify c connId name action = do
   t_ <- withConnLock c connId name action
   forM_ t_ $ atomically . writeTBQueue (subQ c)
 
-ackMessage' :: AgentClient -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
-ackMessage' c connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage" $ do
+ackMessage' :: AgentClient -> Maybe AsyncCmdId -> ConnId -> AgentMsgId -> Maybe MsgReceiptInfo -> AM ()
+ackMessage' c cmdId_ connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage" $ do
   SomeConn _ conn <- withStore c (`getConn` connId)
   case conn of
     DuplexConnection {} -> do
@@ -2779,7 +2788,7 @@ ackMessage' c connId msgId rcptInfo_ = withConnLockNotify c connId "ackMessage"
       (rq, srvMsgId) <- withStore c $ \db -> setMsgUserAck db connId $ InternalId msgId
       ackQueueMessage c rq srvMsgId
     del :: AM ()
-    del = withStore' c $ \db -> deleteMsg db connId $ InternalId msgId
+    del = withStore' c $ \db -> deleteMsg db connId (InternalId msgId) >> mapM_ (deleteCommand db) cmdId_
     sendRcpt :: Connection 'CDuplex -> AM ()
     sendRcpt (DuplexConnection cData _ sqs) = do
       msg@RcvMsg {msgType, msgReceipt} <- withStore c $ \db -> getRcvMsg db connId $ InternalId msgId
@@ -2814,11 +2823,11 @@ switchConnection' c nm connId =
         | otherwise -> do
             when (ratchetSyncSendProhibited cData) $ throwE $ CMD PROHIBITED "switchConnection: send prohibited"
             rq' <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSwitchStarted
-            switchDuplexConnection c nm conn rq'
+            switchDuplexConnection c nm Nothing conn rq'
       _ -> throwE $ CMD PROHIBITED "switchConnection: not duplex"
 
-switchDuplexConnection :: AgentClient -> NetworkRequestMode -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
-switchDuplexConnection c nm (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBEntityId dbQueueId, sndId} = do
+switchDuplexConnection :: AgentClient -> NetworkRequestMode -> Maybe AsyncCmdId -> Connection 'CDuplex -> RcvQueue -> AM ConnectionStats
+switchDuplexConnection c nm cmdId_ (DuplexConnection cData@ConnData {connId, userId} rqs sqs) rq@RcvQueue {server, dbQueueId = DBEntityId 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
@@ -2831,7 +2840,7 @@ switchDuplexConnection c nm (DuplexConnection cData@ConnData {connId, userId} rq
   rq'' <- withStore c $ \db -> addConnRcvQueue db connId rq' SMSubscribe
   lift $ addNewQueueSubscription c rq'' tSess sessId serviceId_
   void . enqueueMessages c cData sqs SMP.noMsgFlags $ QADD [(qUri, Just (server, sndId))]
-  rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq $ Just RSSendingQADD
+  rq1 <- withStore' c $ \db -> setRcvSwitchStatus db rq (Just RSSendingQADD) <* mapM_ (deleteCommand db) cmdId_
   let rqs' = updatedQs rq1 rqs <> [rq'']
   connectionStats c $ DuplexConnection cData rqs' sqs
 
@@ -3961,7 +3970,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
               enqueueDuplexHello :: SndQueue -> AM ()
               enqueueDuplexHello sq = do
                 let cData' = toConnData conn'
-                void $ enqueueMessage c cData' sq SMP.MsgFlags {notification = True} HELLO
+                void $ enqueueMessage c Nothing cData' sq SMP.MsgFlags {notification = True} HELLO
 
           continueSending :: SMP.MsgId -> (SMPServer, SMP.SenderId) -> Connection 'CDuplex -> AM ()
           continueSending srvMsgId addr (DuplexConnection _ _ sqs) =
@@ -4276,8 +4285,8 @@ switchStatusError q expected actual =
       <> (", actual=" <> show actual)
 
 -- used only in background
-connectReplyQueues :: AgentClient -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
-connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
+connectReplyQueues :: AgentClient -> AsyncCmdId -> ConnData -> ConnInfo -> Maybe SndQueue -> NonEmpty SMPQueueInfo -> AM ()
+connectReplyQueues c cmdId cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _) = do
   clientVRange <- asks $ smpClientVRange . config
   case qInfo `proveCompatible` clientVRange of
     Nothing -> throwE $ AGENT A_VERSION
@@ -4285,17 +4294,17 @@ connectReplyQueues c cData@ConnData {userId, connId} ownConnInfo sq_ (qInfo :| _
       -- in case of SKEY retry the connection is already duplex
       sq' <- maybe upgradeConn pure sq_
       void $ agentSecureSndQueue c NRMBackground cData sq'
-      enqueueConfirmation c cData sq' ownConnInfo Nothing
+      enqueueConfirmation c cmdId cData sq' ownConnInfo Nothing
       where
         upgradeConn = do
           (sq, _) <- lift $ newSndQueue userId connId qInfo' Nothing
           withStore c $ \db -> upgradeRcvConnToDuplex db connId sq
 
-secureConfirmQueueAsync :: AgentClient -> ConnData -> Maybe RcvQueue -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
-secureConfirmQueueAsync c cData rq_ sq srv connInfo e2eEncryption_ subMode = do
+secureConfirmQueueAsync :: AgentClient -> AsyncCmdId -> ConnData -> Maybe RcvQueue -> SndQueue -> SMPServerWithAuth -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> SubscriptionMode -> AM SndQueueSecured
+secureConfirmQueueAsync c cmdId cData rq_ sq srv connInfo e2eEncryption_ subMode = do
   sqSecured <- agentSecureSndQueue c NRMBackground cData sq
   qInfo <- mkAgentConfirmation c NRMBackground cData rq_ sq srv connInfo subMode
-  storeConfirmation c cData sq e2eEncryption_ qInfo
+  storeConfirmation c (Just cmdId) cData sq e2eEncryption_ qInfo
   lift $ submitPendingMsg c sq
   pure sqSecured
 
@@ -4339,13 +4348,13 @@ mkAgentConfirmation c nm cData rq_ sq srv connInfo subMode = do
     Just rq@RcvQueue {smpClientVersion = v} -> pure $ SMPQueueInfo v $ rcvSMPQueueAddress rq
   pure $ AgentConnInfoReply (qInfo :| []) connInfo
 
-enqueueConfirmation :: AgentClient -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AM ()
-enqueueConfirmation c cData sq connInfo e2eEncryption_ = do
-  storeConfirmation c cData sq e2eEncryption_ $ AgentConnInfo connInfo
+enqueueConfirmation :: AgentClient -> AsyncCmdId -> ConnData -> SndQueue -> ConnInfo -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AM ()
+enqueueConfirmation c cmdId cData sq connInfo e2eEncryption_ = do
+  storeConfirmation c (Just cmdId) cData sq e2eEncryption_ $ AgentConnInfo connInfo
   lift $ submitPendingMsg c sq
 
-storeConfirmation :: AgentClient -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> AM ()
-storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = do
+storeConfirmation :: AgentClient -> Maybe AsyncCmdId -> ConnData -> SndQueue -> Maybe (CR.SndE2ERatchetParams 'C.X448) -> AgentMessage -> AM ()
+storeConfirmation c cmdId_ cData@ConnData {connId, pqSupport, connAgentVersion = v} sq e2eEncryption_ agentMsg = do
   currentE2EVersion <- asks $ maxVersion . e2eEncryptVRange . config
   withStore c $ \db -> runExceptT $ do
     internalTs <- liftIO getCurrentTime
@@ -4359,6 +4368,7 @@ storeConfirmation c cData@ConnData {connId, pqSupport, connAgentVersion = v} sq
         msgData = SndMsgData {internalId, internalSndId, internalTs, msgType, msgBody, pqEncryption, msgFlags = SMP.MsgFlags {notification = True}, internalHash, prevMsgHash, sndMsgPrepData_ = Nothing}
     liftIO $ createSndMsg db connId msgData
     liftIO $ createSndMsgDelivery db sq internalId
+    liftIO $ mapM_ (deleteCommand db) cmdId_
 
 enqueueRatchetKeyMsgs :: AgentClient -> ConnData -> NonEmpty SndQueue -> InternalId -> AM' ()
 enqueueRatchetKeyMsgs c cData (sq :| sqs) (InternalId msgId) = do
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
index 2f9350a37..087d84eb1 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Common.hs
@@ -100,7 +100,8 @@ withTransaction st = withTransactionPriority st False
 {-# INLINE withTransaction #-}
 
 withTransactionPriority :: DBStore -> Bool -> (DB.Connection -> IO a) -> IO a
-withTransactionPriority st priority action = withConnectionPriority st priority $ dbBusyLoop . transaction
+withTransactionPriority st@DBStore {dbClosed} priority action = withConnectionPriority st priority $ \db ->
+  ifM (readTVarIO dbClosed) (fail "withTransaction: database closed") (dbBusyLoop $ transaction db)
   where
     transaction db@DB.Connection {conn} = SQL.withImmediateTransaction conn $ action db
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
index bae3b6afc..856c86626 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
@@ -53,6 +53,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260712_address_dr_rpc
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -105,7 +106,8 @@ schemaMigrations =
     ("m20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
     ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
     ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
-    ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
+    ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
+    ("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261005_commands_autoincrement.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261005_commands_autoincrement.hs
new file mode 100644
index 000000000..8d3208e4c
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261005_commands_autoincrement.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20261005_commands_autoincrement :: Query
+m20261005_commands_autoincrement =
+  [sql|
+INSERT INTO sqlite_sequence (name, seq)
+SELECT 'commands', MAX(ROWID) FROM commands;
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master SET sql = replace(sql, 'command_id INTEGER PRIMARY KEY,', 'command_id INTEGER PRIMARY KEY AUTOINCREMENT,')
+WHERE name = 'commands' AND type = 'table';
+
+PRAGMA writable_schema=RESET;
+  |]
+
+down_m20261005_commands_autoincrement :: Query
+down_m20261005_commands_autoincrement =
+  [sql|
+DELETE FROM sqlite_sequence WHERE name = 'commands';
+
+PRAGMA writable_schema=1;
+
+UPDATE sqlite_master SET sql = replace(sql, 'command_id INTEGER PRIMARY KEY AUTOINCREMENT,', 'command_id INTEGER PRIMARY KEY,')
+WHERE name = 'commands' AND type = 'table';
+
+PRAGMA writable_schema=RESET;
+  |]
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 e118a17eb..963f918ac 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -247,7 +247,7 @@ CREATE TABLE ntf_subscriptions(
   ON DELETE RESTRICT ON UPDATE CASCADE
 ) WITHOUT ROWID, STRICT;
 CREATE TABLE commands(
-  command_id INTEGER PRIMARY KEY,
+  command_id INTEGER PRIMARY KEY AUTOINCREMENT,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
   host TEXT,
   port TEXT,
@@ -261,6 +261,7 @@ CREATE TABLE commands(
   FOREIGN KEY(host, port) REFERENCES servers
   ON DELETE RESTRICT ON UPDATE CASCADE
 ) STRICT;
+CREATE TABLE sqlite_sequence(name,seq);
 CREATE TABLE snd_message_deliveries(
   snd_message_delivery_id INTEGER PRIMARY KEY AUTOINCREMENT,
   conn_id BLOB NOT NULL REFERENCES connections ON DELETE CASCADE,
@@ -269,7 +270,6 @@ CREATE TABLE snd_message_deliveries(
   failed INTEGER DEFAULT 0,
   FOREIGN KEY(conn_id, internal_id) REFERENCES messages ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED
 ) STRICT;
-CREATE TABLE sqlite_sequence(name,seq);
 CREATE TABLE users(
   user_id INTEGER PRIMARY KEY AUTOINCREMENT
   ,
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index 8a5fd14d7..ea0523a09 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -688,7 +688,7 @@ hasMigrations :: DBStore -> Expectation
 hasMigrations st = getMigrations st `shouldReturn` True
 
 errorGettingMigrations :: DBStore -> Expectation
-errorGettingMigrations st = getMigrations st `shouldThrow` \(e :: SomeException) -> "ErrorMisuse" `isInfixOf` show e
+errorGettingMigrations st = getMigrations st `shouldThrow` \(e :: SomeException) -> "withTransaction: database closed" `isInfixOf` show e
 
 testGetPendingQueueMsg :: DBStore -> Expectation
 testGetPendingQueueMsg st = do
diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs
index ee401bf19..f7435a23b 100644
--- a/tests/AgentTests/SchemaDump.hs
+++ b/tests/AgentTests/SchemaDump.hs
@@ -136,7 +136,9 @@ skipComparisonForDownMigrations =
     -- snd_secure and last_broker_ts columns swap order on down migration
     "m20250322_short_links",
     -- on down migration idx_processed_ratchet_key_hashes_hash index moves down to the end of the file
-    "m20260929_ratchet_indexes"
+    "m20260929_ratchet_indexes",
+    -- sqlite_sequence moves after commands table after VACUUM
+    "m20261005_commands_autoincrement"
   ]
 
 getSchema :: FilePath -> FilePath -> IO String

From 8d81f775b131201d55b16cc0adf07277a9699cc4 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 8 Oct 2026 09:32:11 +0100
Subject: [PATCH 07/20] smp protocol: require fixed size corr ID when used as
 nonce, and min size msg ID to use as nonce (#1925)

* smp protocol: require fixed size corr ID when used as nonce, and min size msg ID to use as nonce

* simpler

* fixes

* randomMsgId

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 src/Simplex/FileTransfer/Protocol.hs          |  4 +-
 src/Simplex/Messaging/Agent.hs                | 26 +++----
 src/Simplex/Messaging/Agent/Client.hs         |  6 +-
 .../Messaging/Agent/Store/AgentStore.hs       | 13 ++--
 src/Simplex/Messaging/Client.hs               | 16 ++---
 src/Simplex/Messaging/Crypto.hs               | 68 +++++++++++++-----
 src/Simplex/Messaging/Protocol.hs             | 70 ++++++++++++++-----
 src/Simplex/Messaging/Server.hs               | 21 +++---
 src/Simplex/Messaging/Server/Env/STM.hs       |  5 +-
 .../Messaging/Server/MsgStore/Postgres.hs     | 14 ++--
 .../Messaging/Server/QueueStore/Postgres.hs   |  4 ++
 tests/AgentTests/FunctionalAPITests.hs        |  2 +-
 tests/AgentTests/NotificationTests.hs         | 26 +++----
 tests/AgentTests/SQLiteTests.hs               |  4 +-
 tests/CoreTests/BatchingTests.hs              |  8 +--
 tests/CoreTests/MsgStoreTests.hs              |  4 +-
 tests/NtfServerTests.hs                       | 22 +++---
 tests/SMPProxyTests.hs                        | 16 ++++-
 tests/ServerTests.hs                          | 34 ++++-----
 tests/XFTPWebTests.hs                         | 34 ++++-----
 20 files changed, 243 insertions(+), 154 deletions(-)

diff --git a/src/Simplex/FileTransfer/Protocol.hs b/src/Simplex/FileTransfer/Protocol.hs
index 50c84e711..467452775 100644
--- a/src/Simplex/FileTransfer/Protocol.hs
+++ b/src/Simplex/FileTransfer/Protocol.hs
@@ -80,7 +80,7 @@ import Simplex.Messaging.Protocol
     tParse,
   )
 import Simplex.Messaging.Transport (THandleParams (..), TransportError (..), TransportPeer (..))
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
 
 xftpBlockSize :: Int
 xftpBlockSize = 16384
@@ -383,7 +383,7 @@ checkParty' c = case testEquality (sFileParty @p) (sFileParty @p') of
 xftpEncodeAuthTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion 'TClient -> C.APrivateAuthKey -> Transmission c -> Either TransportError ByteString
 xftpEncodeAuthTransmission thParams@THandleParams {thAuth} pKey t@(corrId, _, _) = do
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams t
-  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (C.cbNonce $ bs corrId) tForAuth
+  xftpEncodeBatch1 . (,tToSend) =<< authTransmission thAuth False (Just pKey) (eitherToMaybe $ C.cbNonce $ bs corrId) tForAuth
 
 xftpEncodeTransmission :: ProtocolEncoding XFTPVersion XFTPErrorType c => THandleParams XFTPVersion p -> Transmission c -> Either TransportError ByteString
 xftpEncodeTransmission thParams t = xftpEncodeBatch1 (Nothing, encodeTransmission thParams t)
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 05df98ecc..833815f36 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -3652,7 +3652,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                               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' (SMP.unMsgId srvMsgId)
                                 notify $ MSG msgMeta msgFlags body
                                 pure ACKPending
                               A_RCVD rcpts -> qDuplex conn'' "RCVD" $ messagesRcvd rcpts msgMeta
@@ -3662,7 +3662,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                               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' (SMP.unMsgId srvMsgId)) >> ackDel msgId
                               QEND addrs -> qDuplexAckDel conn'' "QEND" $ qEndMsg srvMsgId addrs
                               EREADY _ -> qDuplexAckDel conn'' "EREADY" $ ereadyMsg rcPrev
                             where
@@ -3697,7 +3697,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                                       else
                                         liftEither (parse smpP (AGENT $ A_MESSAGE "parse msg body 1") agentMsgBody) >>= \case
                                           AgentMessage _ (A_MSG body) -> do
-                                            logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' srvMsgId
+                                            logServer "<--" c srv rId $ "MSG <MSG>:" <> logSecret' (SMP.unMsgId srvMsgId)
                                             notify $ MSG msgMeta msgFlags body
                                             pure ACKPending
                                           _ -> ack
@@ -3843,7 +3843,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
 
           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 phVer agentVersion = do
-            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <CONF>:" <> logSecret' (SMP.unMsgId srvMsgId)
             checkConfVersions agentVersion phVer
             let ConnData {pqSupport, serviceRequestExpiresAt} = toConnData conn'
             case status of
@@ -3952,7 +3952,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
 
           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' (SMP.unMsgId srvMsgId)
             case status of
               Active -> prohibited "hello: active"
               _ ->
@@ -3976,7 +3976,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
           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' (SMP.unMsgId srvMsgId)
                 atomically $
                   TM.lookup (qAddress sq) (smpDeliveryWorkers c)
                     >>= mapM_ (\(_, retryLock) -> tryPutTMVar retryLock ())
@@ -3985,7 +3985,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
 
           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' (SMP.unMsgId srvMsgId)
             rs <- forM rcpts $ \rcpt -> clientReceipt rcpt `catchAllErrors` \e -> notify (ERR e) $> Nothing
             case L.nonEmpty . catMaybes $ L.toList rs of
               Just rs' -> notify (RCVD msgMeta rs') $> ACKPending
@@ -4026,7 +4026,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                           lockConnForUpdate db connId
                           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' (SMP.unMsgId srvMsgId) <> " " <> logSecret (senderId queueAddress)
                         swchStatus <-
                           if connAgentVersion >= rpcAddressSMPAgentVersion
                             then do
@@ -4056,7 +4056,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
               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' (SMP.unMsgId 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
@@ -4078,7 +4078,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                 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' (SMP.unMsgId 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
@@ -4096,7 +4096,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
           qEndMsg srvMsgId addrs (DuplexConnection cData'@ConnData {enableNtfs} rqs sqs) =
             case L.partition (\rq' -> any (`sameQAddress` sndAddress rq') addrs) rqs of
               (removed@(_ : _), keptRq : keptRqs) -> do
-                logServer "<--" c srv rId $ "MSG <QEND>:" <> logSecret' srvMsgId
+                logServer "<--" c srv rId $ "MSG <QEND>:" <> logSecret' (SMP.unMsgId srvMsgId)
                 forM_ removed $ \rq'@RcvQueue {server = rmServer, rcvId} -> do
                   withStore' c $ \db -> setRcvQueueDeleted db rq'
                   enqueueCommand c "" connId (Just rmServer) $ AInternalCommand $ ICDeleteRcvQueue rcvId
@@ -4120,7 +4120,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
 
           smpInvitation :: SMP.MsgId -> Connection c -> ConnectionRequestUri 'CMInvitation -> ConnInfo -> AM ()
           smpInvitation srvMsgId conn' connReq@(CRInvitationUri crData (CR.E2ERatchetParamsUri _ k1 k2 kem_)) cInfo = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' (SMP.unMsgId srvMsgId)
             case conn' of
               ContactConnection _ RcvQueue {sndId} -> do
                 -- show connection request even if invitaion via contact address is not compatible.
@@ -4137,7 +4137,7 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
 
           smpContactRequest :: SMP.MsgId -> Connection c -> VersionSMPA -> CR.SndE2ERatchetParams 'C.X448 -> RatchetKeyId -> ByteString -> VersionSMPC -> AM ()
           smpContactRequest srvMsgId conn' agentVersion e2eSndParams ratchetKeyId encConnInfo phVer = do
-            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' srvMsgId
+            logServer "<--" c srv rId $ "MSG <KEY>:" <> logSecret' (SMP.unMsgId srvMsgId)
             case conn' of
               ContactConnection {} -> do
                 checkConfVersions agentVersion phVer
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 3d8f8c1bd..766298948 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -1982,7 +1982,7 @@ decryptSMPMessage :: RcvQueue -> SMP.RcvMessage -> AM SMP.ClientRcvMsgBody
 decryptSMPMessage rq SMP.RcvMessage {msgId, msgBody = SMP.EncRcvMsgBody body} =
   liftEither $ parse SMP.clientRcvMsgBodyP (AGENT $ A_MESSAGE "decrypt message") =<< decrypt body
   where
-    decrypt = agentCbDecrypt (rcvDhSecret rq) (C.cbNonce msgId)
+    decrypt = agentCbDecrypt (rcvDhSecret rq) msgId
 
 secureQueue :: AgentClient -> NetworkRequestMode -> RcvQueue -> SndPublicAuthKey -> AM ()
 secureQueue c nm rq@RcvQueue {rcvId, rcvPrivateKey} senderKey =
@@ -2082,7 +2082,7 @@ disableQueuesNtfs c = sendTSessionBatches "NDEL" (mkSMPTSession . snd) disableQu
 
 sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
-  withSMPClient c NRMBackground rq ("ACK:" <> logSecret' msgId) $ \smp ->
+  withSMPClient c NRMBackground rq ("ACK:" <> logSecret' (SMP.unMsgId msgId)) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
 
 hasGetLock :: SomeRcvQueue q => AgentClient -> q -> IO Bool
@@ -2277,7 +2277,7 @@ 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 -> Either AgentErrorType ByteString
+agentCbDecrypt :: C.CbNonceI n => C.DhSecretX25519 -> n -> ByteString -> Either AgentErrorType ByteString
 agentCbDecrypt dhSecret nonce msg =
   first cryptoError $
     C.cbDecrypt dhSecret nonce msg
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 21c087d46..2816d4615 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -1255,7 +1255,7 @@ getLastMsg db connId msgId =
         LEFT JOIN snd_messages s ON s.conn_id = r.conn_id AND s.rcpt_internal_id = r.internal_id
         WHERE r.conn_id = ? AND r.broker_id = ?
       |]
-      (connId, Binary msgId)
+      (connId, msgId)
 
 toRcvMsg :: (Int64, InternalTs, BrokerId, BrokerTs) :. (AgentMsgId, MsgIntegrity, MsgHash, AgentMessageType, MsgBody, PQEncryption, Maybe AgentMsgId, Maybe MsgReceiptStatus, BoolInt) -> RcvMsg
 toRcvMsg ((agentMsgId, internalTs, brokerId, brokerTs) :. (sndMsgId, integrity, internalHash, msgType, msgBody, pqEncryption, rcptInternalId_, rcptStatus_, BI userAck)) =
@@ -1287,7 +1287,7 @@ checkRcvMsgHashExists db connId hash =
 getRcvMsgBrokerTs :: DB.Connection -> ConnId -> SMP.MsgId -> IO (Either StoreError BrokerTs)
 getRcvMsgBrokerTs db connId msgId =
   firstRow fromOnly (SEMsgNotFound "getRcvMsgBrokerTs") $
-    DB.query db "SELECT broker_ts FROM rcv_messages WHERE conn_id = ? AND broker_id = ?" (connId, Binary msgId)
+    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 =
@@ -3035,7 +3035,7 @@ insertRcvMsgDetails_ db connId RcvQueue {dbQueueId} RcvMsgData {msgMeta, interna
       VALUES
         (?,?,?,?,?,?,?,?,?,?)
     |]
-    (connId, dbQueueId, internalRcvId, fst recipient, sndMsgId, Binary (fst broker), snd broker, Binary internalHash, Binary externalPrevSndHash, integrity)
+    (connId, dbQueueId, internalRcvId, fst recipient, sndMsgId, fst broker, snd broker, Binary internalHash, Binary externalPrevSndHash, integrity)
   DB.execute db "INSERT INTO encrypted_rcv_message_hashes (conn_id, hash) VALUES (?,?)" (connId, Binary encryptedMsgHash)
 
 updateRcvMsgHash :: DB.Connection -> ConnId -> AgentMsgId -> InternalRcvId -> MsgHash -> IO ()
@@ -3183,7 +3183,8 @@ createRcvFile db gVar userId fd@FileDescription {chunks} prefixPath tmpPath file
 createRcvFileRedirect :: DB.Connection -> TVar ChaChaDRG -> UserId -> FileDescription 'FRecipient -> FilePath -> FilePath -> CryptoFile -> FilePath -> CryptoFile -> Bool -> IO (Either StoreError RcvFileId)
 createRcvFileRedirect _ _ _ FileDescription {redirect = Nothing} _ _ _ _ _ _ = pure $ Left $ SEInternal "createRcvFileRedirect called without redirect"
 createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redirectChunks, redirect = Just RedirectFileInfo {size, digest}} prefixPath redirectPath redirectFile dstPath dstFile approvedRelays = runExceptT $ do
-  (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId dummyDst prefixPath dstPath dstFile Nothing Nothing approvedRelays
+  nonce <- atomically $ C.randomCbNonce gVar
+  (dstEntityId, dstId) <- ExceptT $ insertRcvFile db gVar userId (dummyDst nonce) prefixPath dstPath dstFile Nothing Nothing approvedRelays
   (_, redirectId) <- ExceptT $ insertRcvFile db gVar userId redirectFd prefixPath redirectPath redirectFile (Just dstId) (Just dstEntityId) approvedRelays
   liftIO $
     forM_ redirectChunks $ \fc@FileChunk {replicas} -> do
@@ -3191,7 +3192,7 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
       forM_ (zip [1 ..] replicas) $ \(rno, replica) -> insertRcvFileChunkReplica db rno replica chunkId
   pure dstEntityId
   where
-    dummyDst =
+    dummyDst nonce =
       FileDescription
         { party = SFRecipient,
           size,
@@ -3199,7 +3200,7 @@ createRcvFileRedirect db gVar userId redirectFd@FileDescription {chunks = redire
           redirect = Nothing,
           -- updated later with updateRcvFileRedirect
           key = C.unsafeSbKey $ B.replicate 32 '#',
-          nonce = C.cbNonce "",
+          nonce,
           chunkSize = FileSize 0,
           chunks = []
         }
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 7a2eedeb9..87b4319e7 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -1228,7 +1228,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
   -- encode
   let TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth serverThParams (CorrId corrId, sId, Cmd (sParty @p) command)
   -- serviceAuth is False here – proxied commands are not used with service certificates
-  auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth False spKey nonce tForAuth
+  auth <- liftEitherWith PCETransportError $ authTransmission serverThAuth False spKey (Just nonce) tForAuth
   b <- case batchTransmissions serverThParams [Right (auth, tToSend)] of
     [] -> throwE $ PCETransportError TELargeMsg
     TBError e _ : _ -> throwE $ PCETransportError e
@@ -1262,7 +1262,7 @@ proxySMPCommand c@ProtocolClient {thParams = proxyThParams, client_ = PClient {c
 -- receives RRES :: Maybe C.CbNonce -> EncFwdResponse -> BrokerMsg
 -- proxy should send PRES to the client with EncResponse
 -- Always uses background timeout mode
-forwardSMPTransmission :: SMPClient -> CorrId -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO (Maybe C.CbNonce, EncResponse)
+forwardSMPTransmission :: SMPClient -> C.CorrCbNonce -> VersionSMP -> C.PublicKeyX25519 -> EncTransmission -> ExceptT SMPClientError IO (Maybe C.CbNonce, EncResponse)
 forwardSMPTransmission c@ProtocolClient {thParams, client_ = PClient {clientCorrId = g}} fwdCorrId fwdVersion fwdKey fwdTransmission = do
   -- prepare params
   sessSecret <- case thAuth thParams of
@@ -1400,7 +1400,7 @@ mkTransmission_ :: forall v err msg. Protocol v err msg => ProtocolClient v err
 mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentCommands}} nonce_ (entityId, pKey_, command) = do
   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) (useServiceAuth command) pKey_ nonce tForAuth
+      auth = authTransmission (thAuth thParams) (useServiceAuth command) pKey_ (Just nonce) tForAuth
   r <- mkRequest (CorrId corrId)
   pure ((,tToSend) <$> auth, r)
   where
@@ -1419,14 +1419,14 @@ mkTransmission_ ProtocolClient {thParams, client_ = PClient {clientCorrId, sentC
       atomically $ TM.insert corrId r sentCommands
       pure r
 
-authTransmission :: Maybe (THandleAuth 'TClient) -> Bool -> Maybe C.APrivateAuthKey -> C.CbNonce -> ByteString -> Either TransportError (Maybe TAuthorizations)
-authTransmission thAuth serviceAuth pKey_ nonce t = traverse authenticate pKey_
+authTransmission :: Maybe (THandleAuth 'TClient) -> Bool -> Maybe C.APrivateAuthKey -> Maybe C.CbNonce -> ByteString -> Either TransportError (Maybe TAuthorizations)
+authTransmission thAuth serviceAuth pKey_ nonce_ t = traverse authenticate pKey_
   where
     authenticate :: C.APrivateAuthKey -> Either TransportError TAuthorizations
     authenticate (C.APrivateAuthKey a pk) = (,serviceSig) <$> case a of
-      C.SX25519 -> case thAuth of
-        Just THAuthClient {peerServerPubKey = k} -> Right $ TAAuthenticator $ C.cbAuthenticate k pk nonce t'
-        Nothing -> Left TENoServerAuth
+      C.SX25519 -> case (thAuth, nonce_) of
+        (Just THAuthClient {peerServerPubKey = k}, Just nonce) -> Right $ TAAuthenticator $ C.cbAuthenticate k pk nonce t'
+        _ -> Left TENoServerAuth
       C.SEd25519 -> sign pk
       C.SEd448 -> sign pk
     -- When command is signed by both entity key and service key,
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index a22833976..858e040e4 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -140,8 +140,10 @@ module Simplex.Messaging.Crypto
     gcmIV,
 
     -- * NaCl crypto_box
-    CbNonce (unCbNonce),
+    CbNonceI (..),
+    CbNonce,
     pattern CbNonce,
+    CorrCbNonce,
     cbEncrypt,
     cbEncryptNoPad,
     cbEncryptMaxLenBS,
@@ -152,8 +154,12 @@ module Simplex.Messaging.Crypto
     sbEncryptNoPad,
     sbDecryptNoPad,
     cbNonce,
+    unsafeCbNonce,
+    corrCbNonce,
     randomCbNonce,
     reverseNonce,
+    xorNonce,
+    toCbNonce,
 
     -- * NaCl crypto_secretbox
     SbKey (unSbKey),
@@ -232,6 +238,7 @@ import Data.ASN1.Types
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.Bifunctor (bimap, first)
+import Data.Bits (xor)
 import Data.ByteArray (ByteArrayAccess)
 import qualified Data.ByteArray as BA
 import Data.ByteString.Base64 (decode)
@@ -254,7 +261,7 @@ import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (.
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
-import Simplex.Messaging.Util ((<$?>))
+import Simplex.Messaging.Util (packZipWith, (<$?>))
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1324,8 +1331,8 @@ sbEncryptNoPad (SbKey key) (CbNonce nonce) = cryptoBox key nonce
 {-# INLINE sbEncryptNoPad #-}
 
 -- | NaCl @crypto_box@ encrypt with a shared DH secret and 192-bit nonce.
-cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> ByteString
-cbEncryptMaxLenBS (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
+cbEncryptMaxLenBS :: (KnownNat i, CbNonceI n) => DhSecret X25519 -> n -> MaxLenBS i -> ByteString
+cbEncryptMaxLenBS (DhSecretX25519 secret) nonce = cryptoBox secret (unCbNonce nonce) . unMaxLenBS . padMaxLenBS
 {-# INLINE cbEncryptMaxLenBS #-}
 
 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
@@ -1335,8 +1342,8 @@ cryptoBox secret nonce s = BA.convert tag <> c
     tag = Poly1305.auth rs c
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
-cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
-cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret
+cbDecrypt :: CbNonceI n => DhSecret X25519 -> n -> ByteString -> Either CryptoError ByteString
+cbDecrypt (DhSecretX25519 secret) = sbDecrypt_ secret . toCbNonce
 {-# INLINE cbDecrypt #-}
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding).
@@ -1383,9 +1390,16 @@ cbAuthenticate k pk nonce msg = CbAuthenticator $ cbEncryptNoPad (dh' k pk) nonc
 cbVerify :: PublicKeyX25519 -> PrivateKeyX25519 -> CbNonce -> CbAuthenticator -> ByteString -> Bool
 cbVerify k pk nonce (CbAuthenticator s) authorized = cbDecryptNoPad (dh' k pk) nonce s == Right (sha512Hash authorized)
 
-newtype CbNonce = CryptoBoxNonce {unCbNonce :: ByteString}
+class CbNonceI n where
+  unCbNonce :: n -> ByteString
+
+newtype CbNonce = CryptoBoxNonce ByteString
   deriving (Eq, Show)
-  deriving newtype (FromField)
+
+instance CbNonceI CbNonce where
+  unCbNonce (CryptoBoxNonce s) = s
+
+instance FromField CbNonce where fromField = blobFieldDecoder cbNonce
 
 instance ToField CbNonce where toField (CryptoBoxNonce s) = toField $ Binary s
 
@@ -1396,7 +1410,7 @@ pattern CbNonce s <- CryptoBoxNonce s
 
 instance StrEncoding CbNonce where
   strEncode (CbNonce s) = strEncode s
-  strP = cbNonce <$> strP
+  strP = cbNonce <$?> strP
 
 instance ToJSON CbNonce where
   toJSON = strToJSON
@@ -1405,13 +1419,16 @@ instance ToJSON CbNonce where
 instance FromJSON CbNonce where
   parseJSON = strParseJSON "CbNonce"
 
-cbNonce :: ByteString -> CbNonce
+cbNonce :: ByteString -> Either String CbNonce
 cbNonce s
-  | len == 24 = CryptoBoxNonce s
-  | len > 24 = CryptoBoxNonce . fst $ B.splitAt 24 s
-  | otherwise = CryptoBoxNonce $ s <> B.replicate (24 - len) (toEnum 0)
-  where
-    len = B.length s
+  | B.length s == 24 = Right $ CryptoBoxNonce s
+  | otherwise = Left "CbNonce: invalid length"
+
+unsafeCbNonce :: ByteString -> CbNonce
+unsafeCbNonce s = either error id $ cbNonce s
+
+corrCbNonce :: ByteString -> Either String CorrCbNonce
+corrCbNonce s = CorrCbNonce . unCbNonce <$> cbNonce s
 
 randomCbNonce :: TVar ChaChaDRG -> STM CbNonce
 randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
@@ -1419,13 +1436,30 @@ randomCbNonce = fmap CryptoBoxNonce . randomBytes 24
 randomBytes :: Int -> TVar ChaChaDRG -> STM ByteString
 randomBytes n gVar = stateTVar gVar $ randomBytesGenerate n
 
-reverseNonce :: CbNonce -> CbNonce
-reverseNonce (CryptoBoxNonce s) = CryptoBoxNonce (B.reverse s)
+reverseNonce :: CbNonceI n => n -> CbNonce
+reverseNonce = CryptoBoxNonce . B.reverse . unCbNonce
+
+xorNonce :: CbNonceI n => ByteString -> n -> CbNonce
+xorNonce s nonce = CryptoBoxNonce $ packZipWith xor s n <> B.drop (B.length s) n
+  where
+    n = unCbNonce nonce
+
+toCbNonce :: CbNonceI n => n -> CbNonce
+toCbNonce = CryptoBoxNonce . unCbNonce
 
 instance Encoding CbNonce where
   smpEncode = unCbNonce
   smpP = CryptoBoxNonce <$> A.take 24
 
+newtype CorrCbNonce = CorrCbNonce ByteString
+
+instance CbNonceI CorrCbNonce where
+  unCbNonce (CorrCbNonce s) = s
+
+instance Encoding CorrCbNonce where
+  smpEncode = smpEncode . unCbNonce
+  smpP = corrCbNonce <$?> smpP
+
 newtype SbKey = SecretBoxKey {unSbKey :: ByteString}
   deriving (Eq, Show)
   deriving newtype (FromField)
diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index ab0f362f4..fdb2a0209 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -145,7 +145,10 @@ module Simplex.Messaging.Protocol
     RcvNtfDhSecret,
     Message (..),
     RcvMessage (..),
-    MsgId,
+    MsgId (unMsgId),
+    mkMsgId,
+    unsafeMsgId,
+    randomMsgId,
     MsgBody,
     IdsHash (..),
     ServiceSub (..),
@@ -233,8 +236,10 @@ module Simplex.Messaging.Protocol
 where
 
 import Control.Applicative (optional, (<|>))
+import Control.Concurrent.STM (STM, TVar)
 import Control.Exception (Exception, SomeException, displayException, fromException)
 import Control.Monad.Except
+import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import qualified Data.Aeson as J
 import qualified Data.Aeson.TH as J
@@ -269,7 +274,7 @@ import qualified GHC.TypeLits as TE
 import qualified GHC.TypeLits as Type
 import Network.Socket (ServiceName)
 import qualified Network.TLS as TLS
-import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
+import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..), blobFieldDecoder)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -281,7 +286,7 @@ import Simplex.Messaging.ServiceScheme
 import Simplex.Messaging.SimplexName (LabelHash, SimplexDomain (..), SimplexTLD (..), fullDomainName, labelHash)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client (TransportHost, TransportHosts (..))
-import Simplex.Messaging.Util (bshow, eitherToMaybe, packZipWith, safeDecodeUtf8, (<$?>))
+import Simplex.Messaging.Util (bshow, eitherToMaybe, safeDecodeUtf8, (<$?>))
 import Simplex.Messaging.Version
 import Simplex.Messaging.Version.Internal
 
@@ -703,24 +708,24 @@ instance Encoding NewNtfCreds where
 newtype EncTransmission = EncTransmission ByteString
   deriving (Show)
 
-encTransmissionNonce :: VersionSMP -> C.CbNonce -> C.CbNonce
-encTransmissionNonce v nonce@(C.CbNonce s)
-  | v >= fwdNoncesSMPVersion = C.cbNonce $ packZipWith xor (smpEncode v) s <> BS.drop 2 s
-  | otherwise = nonce
+encTransmissionNonce :: C.CbNonceI n => VersionSMP -> n -> C.CbNonce
+encTransmissionNonce v nonce
+  | v >= fwdNoncesSMPVersion = C.xorNonce (smpEncode v) nonce
+  | otherwise = C.toCbNonce nonce
 
 data FwdTransmission = FwdTransmission
-  { fwdCorrId :: CorrId,
+  { fwdCorrId :: C.CorrCbNonce,
     fwdVersion :: VersionSMP,
     fwdKey :: C.PublicKeyX25519,
     fwdTransmission :: EncTransmission
   }
 
 instance Encoding FwdTransmission where
-  smpEncode FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
-    smpEncode (corrId, fwdVersion, fwdKey, Tail t)
+  smpEncode FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t} =
+    smpEncode (fwdCorrId, fwdVersion, fwdKey, Tail t)
   smpP = do
-    (corrId, fwdVersion, fwdKey, Tail t) <- smpP
-    pure FwdTransmission {fwdCorrId = CorrId corrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}
+    (fwdCorrId, fwdVersion, fwdKey, Tail t) <- smpP
+    pure FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission t}
 
 newtype EncFwdTransmission = EncFwdTransmission ByteString
   deriving (Show)
@@ -766,16 +771,16 @@ newtype EncFwdResponse = EncFwdResponse ByteString
   deriving (Eq, Show)
 
 data FwdResponse = FwdResponse
-  { fwdCorrId :: CorrId,
+  { fwdCorrId :: C.CorrCbNonce,
     fwdResponse :: EncResponse
   }
 
 instance Encoding FwdResponse where
-  smpEncode FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t} =
-    smpEncode (corrId, Tail t)
+  smpEncode FwdResponse {fwdCorrId, fwdResponse = EncResponse t} =
+    smpEncode (fwdCorrId, Tail t)
   smpP = do
-    (corrId, Tail t) <- smpP
-    pure FwdResponse {fwdCorrId = CorrId corrId, fwdResponse = EncResponse t}
+    (fwdCorrId, Tail t) <- smpP
+    pure FwdResponse {fwdCorrId, fwdResponse = EncResponse t}
 
 newtype EncResponse = EncResponse ByteString
   deriving (Eq, Show)
@@ -798,7 +803,7 @@ toMsgInfo = \case
   Message {msgId, msgTs} -> msgInfo msgId msgTs MTMessage
   MessageQuota {msgId, msgTs} -> msgInfo msgId msgTs MTQuota
   where
-    msgInfo msgId msgTs msgType = MsgInfo {msgId = decodeLatin1 $ B64.encode msgId, msgTs = systemToUTCTime msgTs, msgType}
+    msgInfo msgId msgTs msgType = MsgInfo {msgId = decodeLatin1 $ B64.encode $ unMsgId msgId, msgTs = systemToUTCTime msgTs, msgType}
 
 messageId :: Message -> MsgId
 messageId = \case
@@ -1499,7 +1504,34 @@ type RcvNtfPublicDhKey = C.PublicKeyX25519
 type RcvNtfDhSecret = C.DhSecretX25519
 
 -- | SMP message server ID.
-type MsgId = ByteString
+newtype MsgId = MsgId {unMsgId :: ByteString}
+  deriving (Eq, Show)
+
+instance C.CbNonceI MsgId where
+  unCbNonce (MsgId s) = B.take 24 s
+
+instance Encoding MsgId where
+  smpEncode (MsgId s) = smpEncode s
+  smpP = mkMsgId <$?> smpP
+
+instance StrEncoding MsgId where
+  strEncode (MsgId s) = strEncode s
+  strP = mkMsgId <$?> strP
+
+instance FromField MsgId where fromField = blobFieldDecoder mkMsgId
+
+instance ToField MsgId where toField (MsgId s) = toField $ Binary s
+
+mkMsgId :: ByteString -> Either String MsgId
+mkMsgId s
+  | B.length s >= 24 = Right $ MsgId s
+  | otherwise = Left "MsgId: invalid length"
+
+unsafeMsgId :: ByteString -> MsgId
+unsafeMsgId s = either error id $ mkMsgId s
+
+randomMsgId :: Int -> TVar ChaChaDRG -> STM MsgId
+randomMsgId n = fmap MsgId . C.randomBytes (max 24 n)
 
 -- | SMP message body.
 type MsgBody = ByteString
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 7dd7817a7..600c9d287 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1334,7 +1334,7 @@ verifyCmdAuthorization thAuth tAuth authorized corrId key = maybe False (verify
 
 verifyCmdAuth :: Maybe (THandleAuth 'TServer) -> C.PublicKeyX25519 -> C.CbAuthenticator -> ByteString -> CorrId -> Bool
 verifyCmdAuth thAuth k authenticator authorized (CorrId corrId) = case thAuth of
-  Just THAuthServer {serverPrivKey = pk} -> C.cbVerify k pk (C.cbNonce corrId) authenticator authorized
+  Just THAuthServer {serverPrivKey = pk} -> either (const False) (\nonce -> C.cbVerify k pk nonce authenticator authorized) $ C.cbNonce corrId
   Nothing -> False
 
 dummyVerifyCmd :: Maybe (THandleAuth 'TServer) -> Maybe TAuthorizations -> ByteString -> CorrId -> Bool
@@ -1453,14 +1453,15 @@ client
         ServerStats {pMsgFwds, pMsgFwdsOwn} <- asks serverStats
         let inc = mkIncProxyStats pMsgFwds pMsgFwdsOwn
         liftIO (lookupSMPServerClient a sessId) >>= \case
-          Just (own, smp) -> do
+          Just (own, smp) | Right fwdCorrId <- C.corrCbNonce (bs corrId) -> do
             inc own pRequests
             forkProxiedCmd $ do
-              liftIO (runExceptT (forwardSMPTransmission smp corrId fwdV pubKey encBlock) `E.catches` clientHandlers)  >>= \case
+              liftIO (runExceptT (forwardSMPTransmission smp fwdCorrId fwdV pubKey encBlock) `E.catches` clientHandlers)  >>= \case
                 Right (nonce_, r) -> PRES nonce_ r <$ inc own pSuccesses
                 Left e -> ERR (smpProxyError e) <$ case e of
                   PCEProtocolError {} -> inc own pSuccesses
                   _ -> inc own pErrorsOther
+          Just _ -> pure $ Just $ ERR $ CMD SYNTAX
           Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
       where
         forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg)
@@ -1950,7 +1951,7 @@ client
             getDelivered :: Sub -> STM (Maybe (ServerSub, SystemSeconds))
             getDelivered Sub {delivered, subThread} = do
               readTVar delivered $>>= \(msgId', ts) ->
-                if msgId == msgId' || B.null msgId
+                if msgId == msgId'
                   then writeTVar delivered Nothing $> Just (subThread, ts)
                   else pure Nothing
             updateStats :: ServerStats -> Bool -> SystemSeconds -> Message -> IO ()
@@ -1996,7 +1997,7 @@ client
                       when (isJust (queueData qr) && isSecuredMsgQueue qr) $ void $ liftIO $
                         deleteQueueLinkData (queueStore ms) q
                       ServerConfig {messageExpiration, expireMessagesOnSend, msgIdBytes} <- asks config
-                      msgId <- randomId' msgIdBytes
+                      msgId <- atomically . randomMsgId msgIdBytes =<< asks random
                       msg_ <- liftIO $ runExceptT $ do
                         when expireMessagesOnSend $ mapM_ (expireMessages stats) messageExpiration
                         msg <- liftIO $ mkMessage msgId body
@@ -2109,7 +2110,7 @@ client
               liftIO $ storeNtf ns nId ntf
               incStat . ntfCount =<< asks serverStats
 
-            mkMessageNotification :: ByteString -> SystemTime -> RcvNtfDhSecret -> M s MsgNtf
+            mkMessageNotification :: MsgId -> SystemTime -> RcvNtfDhSecret -> M s MsgNtf
             mkMessageNotification msgId msgTs rcvNtfDhSecret = do
               ntfNonce <- atomically . C.randomCbNonce =<< asks random
               let msgMeta = NMsgMeta {msgId, msgTs}
@@ -2120,12 +2121,12 @@ client
         processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do
           THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
           sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
-          let proxyNonce = C.cbNonce $ bs corrId
+          proxyNonce <- liftEitherWith (const CRYPTO) $ C.cbNonce $ bs corrId
           s' <- liftEitherWith (const CRYPTO) $ C.cbDecryptNoPad sessSecret proxyNonce s
           FwdTransmission {fwdCorrId, fwdVersion, fwdKey, fwdTransmission = EncTransmission et} <- liftEitherWith (const $ CMD SYNTAX) $ smpDecode s'
           unless (fwdVersion `isCompatible` thServerVRange thParams') $ throwE $ transportErr TEVersion
           let clientSecret = C.dh' fwdKey serverPrivKey
-              clientNonce = C.cbNonce $ bs fwdCorrId
+              clientNonce = fwdCorrId
           b <- liftEitherWith (const CRYPTO) $ C.cbDecrypt clientSecret (encTransmissionNonce fwdVersion clientNonce) et
           let clntTHParams = smpTHParamsSetVersion fwdVersion thParams'
           -- only allowing single forwarded transactions
@@ -2187,7 +2188,7 @@ client
           MessageQuota {} -> RcvMsgQuota msgTs'
           where
             encrypt :: KnownNat i => C.MaxLenBS i -> RcvMessage
-            encrypt body = RcvMessage msgId' . EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) (C.cbNonce msgId') body
+            encrypt body = RcvMessage msgId' . EncRcvMsgBody $ C.cbEncryptMaxLenBS (rcvDhSecret qr) msgId' body
             msgId' = messageId msg
             msgTs' = messageTs msg
 
@@ -2236,7 +2237,7 @@ client
                     SubPending -> QSubPending
                     SubThread _ -> QSubThread
                 ProhibitSub -> pure QProhibitSub
-              qDelivered <- decodeLatin1 . encode . fst <$$> readTVarIO delivered
+              qDelivered <- decodeLatin1 . encode . unMsgId . fst <$$> readTVarIO delivered
               pure QSub {qSubThread, qDelivered}
 
         ok :: Transmission BrokerMsg
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index b4333959f..ca59f75f6 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -571,7 +571,10 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig s -> IO (Env s)
-newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig, msgIdBytes} = do
+  when (msgIdBytes < 24) $ do
+    logError "Error: msgIdBytes must be at least 24"
+    exitFailure
   serverActive <- newTVarIO True
   server <- newServer
   msgStore_ <- case serverStoreCfg of
diff --git a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
index a79643f08..c8506709c 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
@@ -202,7 +202,7 @@ instance MsgStoreClass PostgresMsgStore where
           DB.query
             db
             "SELECT quota_written, was_empty FROM write_message(?,?,?,?,?,?,?)"
-            (recipientId' q, Binary (messageId msg), systemSeconds (messageTs msg), msgQuota, ntf, Binary body, quota)
+            (recipientId' q, messageId msg, systemSeconds (messageTs msg), msgQuota, ntf, Binary body, quota)
     where
       toResult = \case
         ((msgQuota, wasEmpty) : _) -> if msgQuota then Nothing else Just (msg, wasEmpty)
@@ -271,14 +271,14 @@ instance MsgStoreClass PostgresMsgStore where
     uninterruptibleMask_ $
       withDB' "tryDelMsg" (queueStore_ ms) $ \db ->
         maybeFirstRow toMessage $
-          DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_msg(?, ?)" (recipientId' q, Binary msgId)
+          DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_msg(?, ?)" (recipientId' q, msgId)
 
   tryDelPeekMsg :: PostgresMsgStore -> PostgresQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
   tryDelPeekMsg ms q msgId =
     uninterruptibleMask_ $
       withDB' "tryDelPeekMsg" (queueStore_ ms) $ \db ->
         toResult . map toMessage
-          <$> DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_peek_msg(?, ?)" (recipientId' q, Binary msgId)
+          <$> DB.query db "SELECT r_msg_id, r_msg_ts, r_msg_quota, r_msg_ntf_flag, r_msg_body FROM try_del_peek_msg(?, ?)" (recipientId' q, msgId)
     where
       toResult = \case
         [] -> (Nothing, Nothing)
@@ -297,13 +297,13 @@ uninterruptibleMask_ :: ExceptT ErrorType IO a -> ExceptT ErrorType IO a
 uninterruptibleMask_ = ExceptT . E.uninterruptibleMask_ . runExceptT
 {-# INLINE uninterruptibleMask_ #-}
 
-toMaybeMessage :: (Maybe (Binary MsgId), Maybe Int64, Maybe Bool, Maybe Bool, Maybe (Binary MsgBody)) -> Maybe Message
+toMaybeMessage :: (Maybe MsgId, Maybe Int64, Maybe Bool, Maybe Bool, Maybe (Binary MsgBody)) -> Maybe Message
 toMaybeMessage = \case
   (Just msgId, Just ts, Just msgQuota, Just ntf, Just body) -> Just $ toMessage (msgId, ts, msgQuota, ntf, body)
   _ -> Nothing
 
-toMessage :: (Binary MsgId, Int64, Bool, Bool, Binary MsgBody) -> Message
-toMessage (Binary msgId, ts, msgQuota, ntf, Binary body)
+toMessage :: (MsgId, Int64, Bool, Bool, Binary MsgBody) -> Message
+toMessage (msgId, ts, msgQuota, ntf, Binary body)
   | msgQuota = MessageQuota {msgId, msgTs}
   | otherwise = Message {msgId, msgTs, msgFlags = MsgFlags ntf, msgBody = C.unsafeMaxLenBS body} -- TODO [messages] unsafeMaxLenBS?
   where
@@ -429,7 +429,7 @@ messageRecToText rId msg =
     tabFields = BB.char7 ',' `intersperse` fields
     fields =
       [ renderField (toField rId),
-        renderField (toField $ Binary (messageId msg)),
+        renderField (toField $ messageId msg),
         renderField (toField $ systemSeconds (messageTs msg)),
         renderField (toField msgQuota),
         renderField (toField ntf),
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
index 72f051fe3..2a879f8cb 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
@@ -825,6 +825,10 @@ instance ToField EncDataBytes where toField (EncDataBytes s) = toField (Binary s
 
 deriving newtype instance FromField EncDataBytes
 
+instance ToField MsgId where toField = toField . Binary . unMsgId
+
+instance FromField MsgId where fromField = blobFieldDecoder mkMsgId
+
 deriving newtype instance ToField (RoundedSystemTime t)
 
 deriving newtype instance FromField (RoundedSystemTime t)
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 0467306f5..1d6f0c121 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -4861,7 +4861,7 @@ testServerQueueInfo = do
     Just srvMsgId <- checkMsgQ bob aliceId 1
     get bob =##> \case
       ("", c, MSG MsgMeta {integrity = MsgOk, broker = (smId, _), recipient = (mId, _), pqEncryption = PQEncOn} _ "hello") ->
-        c == aliceId && decodeLatin1 (B64.encode smId) == srvMsgId && mId == msgId
+        c == aliceId && decodeLatin1 (B64.encode $ SMP.unMsgId smId) == srvMsgId && mId == msgId
       _ -> False
     ackMessage bob aliceId msgId Nothing
     liftIO $ threadDelay 200000
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index d81c08a41..8e1a85e8a 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -230,7 +230,7 @@ testNotificationToken apns = do
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
     verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
     verifyNtfToken a tkn nonce verification
     NTActive <- checkNtfToken a tkn
     deleteNtfToken a tkn
@@ -254,7 +254,7 @@ testNtfTokenRepeatRegistration apns = do
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
     verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
     NTRegistered <- registerNtfToken a tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
       getMockNotification apns tkn
@@ -273,14 +273,14 @@ testNtfTokenSecondRegistration apns =
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
     verification <- ntfData .-> "verification"
-    nonce <- C.cbNonce <$> ntfData .-> "nonce"
+    nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
     verifyNtfToken a tkn nonce verification
 
     NTRegistered <- registerNtfToken a' tkn NMPeriodic
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
       getMockNotification apns tkn
     verification' <- ntfData' .-> "verification"
-    nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+    nonce' <- C.unsafeCbNonce <$> ntfData' .-> "nonce"
 
     -- at this point the first token is still active
     NTActive <- checkNtfToken a tkn
@@ -311,7 +311,7 @@ testNtfTokenServerRestart t apns = do
     -- so that repeat verification happens without restarting the clients, when notification arrives
     withNtfServer t $ runRight_ $ do
       verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
       NTActive <- checkNtfToken a' tkn
       pure ()
@@ -327,7 +327,7 @@ testNtfTokenServerRestartReverify t apns = do
       pure ntfData
     runRight_ $ do
       verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
       Left (BROKER _ (NETWORK _)) <- tryE $ verifyNtfToken a tkn nonce verification
       pure ()
   threadDelay 1500000
@@ -348,7 +348,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
       APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
         getMockNotification apns tkn
       verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> 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
@@ -393,7 +393,7 @@ testNtfTokenServerRestartReregister t apns = do
       APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
         getMockNotification apns tkn
       verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
       NTActive <- checkNtfToken a' tkn
       pure ()
@@ -428,7 +428,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
       APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
         getMockNotification apns tkn
       verification <- ntfData .-> "verification"
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
       verifyNtfToken a' tkn nonce verification
       NTActive <- checkNtfToken a' tkn
       pure ()
@@ -450,7 +450,7 @@ testNtfTokenMultipleServers t apns = do
         APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
           getMockNotification apns tkn
         verification <- ntfData .-> "verification"
-        nonce <- C.cbNonce <$> ntfData .-> "nonce"
+        nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
         verifyNtfToken a tkn nonce verification
         NTActive <- checkNtfToken a tkn
         -- shut down the "other" server
@@ -566,7 +566,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
       getMockNotification apns tkn
     verification <- ntfData .-> "verification"
-    vNonce <- C.cbNonce <$> ntfData .-> "nonce"
+    vNonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
     verifyNtfToken alice tkn vNonce verification
     NTActive <- checkNtfToken alice tkn
     -- send message
@@ -657,7 +657,7 @@ registerTestToken a token mode apns = do
   Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
     timeout 1000000 $ getMockNotification apns tkn
   verification' <- ntfData' .-> "verification"
-  nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
+  nonce' <- C.unsafeCbNonce <$> ntfData' .-> "nonce"
   verifyNtfToken a tkn nonce' verification'
   NTActive <- checkNtfToken a tkn
   pure tkn
@@ -1035,7 +1035,7 @@ messageNotification apns tkn = do
   500000 `timeout` getMockNotification apns tkn >>= \case
     Nothing -> error "no notification"
     Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
-      nonce <- C.cbNonce <$> ntfData .-> "nonce"
+      nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
       message <- ntfData .-> "message"
       pure (nonce, message)
     _ -> error "bad notification"
diff --git a/tests/AgentTests/SQLiteTests.hs b/tests/AgentTests/SQLiteTests.hs
index ea0523a09..169d1ad7e 100644
--- a/tests/AgentTests/SQLiteTests.hs
+++ b/tests/AgentTests/SQLiteTests.hs
@@ -513,7 +513,7 @@ hw = encodeUtf8 "Hello world!"
 ts :: UTCTime
 ts = UTCTime (fromGregorian 2021 02 24) (secondsToDiffTime 0)
 
-mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> BrokerId -> MsgHash -> RcvMsgData
+mkRcvMsgData :: InternalId -> InternalRcvId -> ExternalSndId -> ByteString -> MsgHash -> RcvMsgData
 mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
   RcvMsgData
     { internalRcvId,
@@ -522,7 +522,7 @@ mkRcvMsgData internalId internalRcvId externalSndId brokerId internalHash =
           { integrity = MsgOk,
             recipient = (unId internalId, ts),
             sndMsgId = externalSndId,
-            broker = (brokerId, ts),
+            broker = (SMP.unsafeMsgId $ mconcat (replicate 24 brokerId), ts),
             pqEncryption = CR.PQEncOn
           },
       msgType = AM_A_MSG_,
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index 960c2113e..efed59f77 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -183,7 +183,7 @@ randomSUB sessId = do
   thAuth_ <- testTHandleAuth g rKey
   let thParams = testTHandleParams sessId
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId rId, Cmd SRecipient SUB)
-  pure $ (,tToSend) <$> authTransmission thAuth_ True (Just rpKey) nonce tForAuth
+  pure $ (,tToSend) <$> authTransmission thAuth_ True (Just rpKey) (Just nonce) tForAuth
 
 randomSUBCmd :: ProtocolClient SMPVersion ErrorType BrokerMsg -> IO (PCTransmission ErrorType BrokerMsg)
 randomSUBCmd c = do
@@ -202,7 +202,7 @@ randomNMSGCmd :: SystemTime -> IO (Transmission BrokerMsg)
 randomNMSGCmd ts = do
   g <- C.newRandom
   nId <- atomically $ C.randomBytes 24 g
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
   (k, pk) <- atomically $ C.generateKeyPair g
   nonce <- atomically $ C.randomCbNonce g
   let msgMeta = NMsgMeta {msgId, msgTs = ts}
@@ -221,7 +221,7 @@ randomMSG = do
   g <- C.newRandom
   corrId <- atomically $ C.randomBytes 24 g
   rId <- atomically $ C.randomBytes 24 g
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
   msg <- atomically $ C.randomBytes maxMessageLength g
   pure (CorrId corrId, EntityId rId, MSG RcvMessage {msgId, msgBody = EncRcvMsgBody msg})
 
@@ -235,7 +235,7 @@ randomSEND sessId len = do
   msg <- atomically $ C.randomBytes len g
   let thParams = testTHandleParams sessId
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
-  pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) nonce tForAuth
+  pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) (Just nonce) tForAuth
 
 testTHandleParams :: ByteString -> THandleParams SMPVersion 'TClient
 testTHandleParams sessionId =
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index d4a2d7582..d9a259051 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -34,7 +34,7 @@ import Data.Time.Clock.System (SystemTime (..), getSystemTime)
 import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags)
+import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags, randomMsgId)
 import Simplex.Messaging.Server (exportMessages, importMessages, printMessageStats)
 import Simplex.Messaging.Server.Env.STM (MsgStore (..), journalMsgStoreDepth, readWriteQueueStore)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..), expireBeforeEpoch)
@@ -147,7 +147,7 @@ mkMessage :: MonadIO m => ByteString -> m Message
 mkMessage body = liftIO $ do
   g <- C.newRandom
   msgTs <- getSystemTime
-  msgId <- atomically $ C.randomBytes 24 g
+  msgId <- atomically $ randomMsgId 24 g
   pure Message {msgId, msgTs, msgFlags = noMsgFlags, msgBody = C.unsafeMaxLenBS body}
 
 pattern Msg :: ByteString -> Maybe Message
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index 7fd430fef..fe19259db 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -136,7 +136,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           let dhSecret = C.dh' ntfDh dhPriv
               decryptCode nd =
                 let Right verification = nd .-> "verification"
-                    Right nonce = C.cbNonce <$> nd .-> "nonce"
+                    Right nonce = C.cbNonce =<< nd .-> "nonce"
                     Right pt = C.cbDecrypt dhSecret nonce verification
                  in NtfRegCode pt
           let code = decryptCode ntfData
@@ -160,7 +160,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           -- receive notification
           APNSMockRequest {notification} <- getMockNotification apns tkn
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
-              Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
+              Right nonce' = C.cbNonce =<< ntfData' .-> "nonce"
               Right message = ntfData' .-> "message"
               Right ntfDataDecrypted = C.cbDecrypt dhSecret nonce' message
               Right pnMsgs1 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted
@@ -171,7 +171,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           notifierId `shouldBe` nId
           -- 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)
+          Right ClientRcvMsgBody {msgTs = mTs, msgBody} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId1 body)
           mId1 `shouldBe` msgId
           mTs `shouldBe` msgTs
           (msgBody, "hello") #== "delivered from queue"
@@ -183,7 +183,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
             getMockNotification apns tkn'
           let Right verification2 = ntfData2 .-> "verification"
-              Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
+              Right nonce2 = C.cbNonce =<< ntfData2 .-> "nonce"
               Right code2 = NtfRegCode <$> C.cbDecrypt dhSecret nonce2 verification2
           RespNtf "8" _ NROk <- signSendRecvNtf nh tknKey ("8", tId, TVFY code2)
           RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
@@ -191,7 +191,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
           APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
-              Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
+              Right nonce3 = C.cbNonce =<< ntfData3 .-> "nonce"
               Right message3 = ntfData3 .-> "message"
               Right ntfDataDecrypted3 = C.cbDecrypt dhSecret nonce3 message3
               Right pnMsgs2 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted3
@@ -199,7 +199,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           smpServer3 `shouldBe` srv
           notifierId3 `shouldBe` nId
           Resp "" _ (MSG RcvMessage {msgId = mId2, msgBody = EncRcvMsgBody body2}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 2"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId2) body2)
+          Right ClientRcvMsgBody {msgBody = "hello 2"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId2 body2)
           Resp "10" _ OK <- signSendRecv rh rKey ("10", rId, ACK mId2)
 
           q2 <- createQueue rh sPub nPub
@@ -218,7 +218,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           Resp "14" _ OK <- signSendRecv sh sKey ("14", sId, _SEND' "hello 3")
           APNSMockRequest {notification = notification4} <- getMockNotification apns tkn'
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData4} = notification4
-              Right nonce4 = C.cbNonce <$> ntfData4 .-> "nonce"
+              Right nonce4 = C.cbNonce =<< ntfData4 .-> "nonce"
               Right message4 = ntfData4 .-> "message"
               Right ntfDataDecrypted4 = C.cbDecrypt dhSecret nonce4 message4
               Right pnMsgs4 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted4
@@ -226,14 +226,14 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           smpServer4 `shouldBe` srv
           notifierId4 `shouldBe` nId
           Resp "" _ (MSG RcvMessage {msgId = mId3, msgBody = EncRcvMsgBody body3}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 3"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret (C.cbNonce mId3) body3)
+          Right ClientRcvMsgBody {msgBody = "hello 3"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret mId3 body3)
           Resp "15" _ OK <- signSendRecv rh rKey ("15", rId, ACK mId3)
 
           -- deliver to queue with ntf sub created while SMP was offline
           Resp "16" _ OK <- signSendRecv sh sKey ("16", sId', _SEND' "hello 4")
           APNSMockRequest {notification = notification5} <- getMockNotification apns tkn'
           let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData5} = notification5
-              Right nonce5 = C.cbNonce <$> ntfData5 .-> "nonce"
+              Right nonce5 = C.cbNonce =<< ntfData5 .-> "nonce"
               Right message5 = ntfData5 .-> "message"
               Right ntfDataDecrypted5 = C.cbDecrypt dhSecret nonce5 message5
               Right pnMsgs5 = parse pnMessagesP (AP.INTERNAL "error parsing PNMessageData") ntfDataDecrypted5
@@ -241,7 +241,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
           smpServer5 `shouldBe` srv
           notifierId5 `shouldBe` nId'
           Resp "" _ (MSG RcvMessage {msgId = mId4, msgBody = EncRcvMsgBody body4}) <- tGet1 rh
-          Right ClientRcvMsgBody {msgBody = "hello 4"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret' (C.cbNonce mId4) body4)
+          Right ClientRcvMsgBody {msgBody = "hello 4"} <- pure $ parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt rcvDhSecret' mId4 body4)
           Resp "17" _ OK <- signSendRecv rh rKey' ("17", rId', ACK mId4)
           pure ()
 
@@ -307,7 +307,7 @@ registerToken nh apns token = do
   let dhSecret = C.dh' ntfDh dhPriv
       decryptCode nd =
         let Right verification = nd .-> "verification"
-            Right nonce = C.cbNonce <$> nd .-> "nonce"
+            Right nonce = C.cbNonce =<< nd .-> "nonce"
             Right pt = C.cbDecrypt dhSecret nonce verification
          in NtfRegCode pt
   let code = decryptCode ntfData
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 91bae09a6..134093acc 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -75,6 +75,8 @@ smpProxyTests = do
     xit "batching proxy requests" todo
     it "relay rejects forwarded command with changed version" $ \_ ->
       testChangedFwdVersion
+    it "proxy rejects forwarded correlation ID that is not 24 bytes" $ \_ ->
+      testFwdCorrIdSize
   describe "deliver message via SMP proxy" $ do
     let srv1 = SMPServer testHost testPort testKeyHash
         srv2 = SMPServer testHost2 testPort2 testKeyHash
@@ -472,10 +474,22 @@ testChangedFwdVersion =
     nonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
     let v = currentClientSMPRelayVersion
     et <- either (fail . show) (pure . SMP.EncTransmission) $ C.cbEncrypt (C.dh' peerServerPubKey cmdPrivKey) (SMP.encTransmissionNonce v nonce) "" SMP.paddedProxiedTLength
-    let forward fwdVersion = forwardSMPTransmission rc (SMP.CorrId corrId) fwdVersion cmdPubKey et
+    let forward fwdVersion = forwardSMPTransmission rc (either error id $ C.corrCbNonce corrId) fwdVersion cmdPubKey et
     _ <- runExceptT' $ forward v
     runExceptT (forward $ prevVersion v) `shouldReturn` Left (PCEProtocolError SMP.CRYPTO)
 
+testFwdCorrIdSize :: IO ()
+testFwdCorrIdSize =
+  withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
+    withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ ->
+      testSMPClient_ "localhost" testPort supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
+        (_, _, Right (SMP.PKEY sessId _ _)) <- sendRecv th (Nothing, "1", NoEntity, SMP.PRXY testSMPServer2 Nothing)
+        g <- C.newRandom
+        (cmdPubKey, _) <- atomically $ C.generateKeyPair g
+        forM_ (["", "2", "3333333333333333333333333"] :: [ByteString]) $ \corrId -> do
+          (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission ""))
+          reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
+
 -- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable
 -- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect,
 -- let any stored connection error expire, then require the proxy to establish the session (PKEY).
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 116b4f0ec..6165dfb46 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -166,7 +166,7 @@ signSend_ h@THandle {params} (C.APrivateAuthKey a pk) serviceKey_ (corrId, qId,
     authorize t = (,(`C.sign'` t) <$> serviceKey_) <$> case a of
       C.SEd25519 -> Just . TASignature . C.ASignature C.SEd25519 $ C.sign' pk t'
       C.SEd448 -> Just . TASignature . C.ASignature C.SEd448 $ C.sign' pk t'
-      C.SX25519 -> (\THAuthClient {peerServerPubKey = k} -> TAAuthenticator $ C.cbAuthenticate k pk (C.cbNonce corrId) t') <$> thAuth params
+      C.SX25519 -> (\THAuthClient {peerServerPubKey = k} -> TAAuthenticator $ C.cbAuthenticate k pk (C.unsafeCbNonce corrId) t') <$> thAuth params
 #if !MIN_VERSION_base(4,18,0)
       _sx448 -> undefined -- ghc8107 fails to the branch excluded by types
 #endif
@@ -194,12 +194,12 @@ _SEND = SEND noMsgFlags
 _SEND' :: MsgBody -> Command 'Sender
 _SEND' = SEND MsgFlags {notification = True}
 
-decryptMsgV2 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either C.CryptoError ByteString
-decryptMsgV2 dhShared = C.cbDecrypt dhShared . C.cbNonce
+decryptMsgV2 :: C.DhSecret 'C.X25519 -> MsgId -> ByteString -> Either C.CryptoError ByteString
+decryptMsgV2 = C.cbDecrypt
 
-decryptMsgV3 :: C.DhSecret 'C.X25519 -> ByteString -> ByteString -> Either String MsgBody
+decryptMsgV3 :: C.DhSecret 'C.X25519 -> MsgId -> ByteString -> Either String MsgBody
 decryptMsgV3 dhShared nonce body =
-  case parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt dhShared (C.cbNonce nonce) body) of
+  case parseAll clientRcvMsgBodyP =<< first show (C.cbDecrypt dhShared nonce body) of
     Right ClientRcvMsgBody {msgBody} -> Right msgBody
     Right ClientRcvMsgQuota {} -> Left "ClientRcvMsgQuota"
     Left e -> Left e
@@ -425,7 +425,7 @@ testCreateDelete =
       Resp "dabc" _ err8 <- sendRecv sh ("", "dabc", sId, _SEND "hello")
       (err8, ERR AUTH) #== "rejects unsigned SEND too when deleted"
 
-      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, ACK "")
+      Resp "abcd" _ err11 <- signSendRecv rh rKey ("abcd", rId, ACK mId2)
       (err11, ERR AUTH) #== "rejects ACK when conn deleted - the second message is deleted"
 
       Resp "bcda" _ err9 <- signSendRecv rh rKey ("bcda", rId, OFF)
@@ -609,7 +609,7 @@ testGetSubCommands =
       Resp "4" _ (Msg mId2 msg2) <- signSendRecv rh1 rKey ("4", rId, ACK mId1)
       (dec mId2 msg2, Right "hello 2") #== "received from queue via SUB"
       -- bad msgId returns error
-      Resp "5" _ (ERR NO_MSG) <- signSendRecv rh2 rKey ("5", rId, ACK "1234")
+      Resp "5" _ (ERR NO_MSG) <- signSendRecv rh2 rKey ("5", rId, ACK mId2)
       -- already ACK'd by subscriber, but still returns OK when msgId matches
       Resp "5a" _ OK <- signSendRecv rh2 rKey ("5a", rId, ACK mId1)
       -- msg2 is not lost - even if subscriber does not ACK it, it is delivered to getter
@@ -1302,9 +1302,9 @@ testTiming =
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
-      Resp "abcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcd", NoEntity, New rPub dhPub)
+      Resp "abcdabcdabcdabcdabcdabcd" NoEntity (Ids rId sId srvDh) <- signSendRecv rh rKey ("abcdabcdabcdabcdabcdabcd", NoEntity, New rPub dhPub)
       let dec = decryptMsgV3 $ C.dh' srvDh dhPriv
-      Resp "cdab" _ resp <- signSendRecv rh rKey ("cdab", rId, SUB)
+      Resp "cdabcdabcdabcdabcdabcdab" _ resp <- signSendRecv rh rKey ("cdabcdabcdabcdabcdabcdab", rId, SUB)
       case resp of
         OK -> pure ()
         SOK Nothing -> pure ()
@@ -1314,9 +1314,9 @@ testTiming =
       runTimingTest rh badKey rId SUB
 
       (sPub, sKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
-      Resp "dabc" _ OK <- signSendRecv rh rKey ("dabc", rId, KEY sPub)
+      Resp "dabcdabcdabcdabcdabcdabc" _ OK <- signSendRecv rh rKey ("dabcdabcdabcdabcdabcdabc", rId, KEY sPub)
 
-      Resp "bcda" _ OK <- signSendRecv sh sKey ("bcda", sId, _SEND "hello")
+      Resp "bcdabcdabcdabcdabcdabcda" _ OK <- signSendRecv sh sKey ("bcdabcdabcdabcdabcdabcda", sId, _SEND "hello")
       Resp "" _ (Msg mId msg) <- tGet1 rh
       (dec mId msg, Right "hello") #== "delivered from queue"
 
@@ -1327,15 +1327,15 @@ testTiming =
           threadDelay 100000
           _ <- timeRepeat n $ do
             -- "warm up" the server
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           threadDelay 100000
           timeWrongKey <- timeRepeat n $ do
-            Resp "cdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdab", qId, cmd)
+            Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd)
             return ()
           threadDelay 100000
           timeNoQueue <- timeRepeat n $ do
-            Resp "dabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabc", EntityId "1234", cmd)
+            Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           let ok = similarTime timeNoQueue timeWrongKey msType
           unless ok . putStrLn . unwords $
@@ -1814,10 +1814,10 @@ serverSyntaxTests (ATransport t) = do
     it "no parameters" $ (sampleSig, "abcd", "12345678", SEND_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
     it "no queue ID" $ (sampleSig, "bcda", "", (SEND_, ' ', noMsgFlags, ' ', "hello" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_ENTITY)
   describe "ACK" $ do
-    it "valid syntax" $ (sampleSig, "cdab", "12345678", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
+    it "valid syntax" $ (sampleSig, "cdab", "12345678", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "cdab", "12345678", ERR AUTH)
     it "no parameters" $ (sampleSig, "abcd", "12345678", ACK_) >#> ("", "abcd", "12345678", ERR $ CMD SYNTAX)
-    it "no queue ID" $ (sampleSig, "bcda", "", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_AUTH)
-    it "no signature" $ ("", "cdab", "12345678", (ACK_, ' ', "1234" :: ByteString)) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
+    it "no queue ID" $ (sampleSig, "bcda", "", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "bcda", "", ERR $ CMD NO_AUTH)
+    it "no signature" $ ("", "cdab", "12345678", (ACK_, ' ', "123456789012345678901234" :: ByteString)) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
   describe "PING" $ do
     it "valid syntax" $ ("", "abcd", "", PING_) >#> ("", "abcd", "", PONG)
   describe "broker response not allowed" $ do
diff --git a/tests/XFTPWebTests.hs b/tests/XFTPWebTests.hs
index b56fbef72..ddb1d1f56 100644
--- a/tests/XFTPWebTests.hs
+++ b/tests/XFTPWebTests.hs
@@ -768,7 +768,7 @@ tsSecretboxTests :: Spec
 tsSecretboxTests = describe "crypto/secretbox" $ do
   let key32 = B.pack [1 .. 32]
       nonce24 = B.pack [1 .. 24]
-      cbNonceVal = C.cbNonce nonce24
+      cbNonceVal = C.unsafeCbNonce nonce24
       sbKeyVal = C.unsafeSbKey key32
 
   describe "NaCl secretbox (tag prepended)" $ do
@@ -979,7 +979,7 @@ tsFileCryptoTests :: Spec
 tsFileCryptoTests = describe "crypto/file" $ do
   let key32 = B.pack [1 .. 32]
       nonce24 = B.pack [1 .. 24]
-      cbNonceVal = C.cbNonce nonce24
+      cbNonceVal = C.unsafeCbNonce nonce24
       sbKeyVal = C.unsafeSbKey key32
 
   describe "FileHeader encoding" $ do
@@ -2329,7 +2329,7 @@ tsClientTests = describe "protocol/client" $ do
             C.cbAuthenticate
               (C.PublicKeyX25519 pubA)
               (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
               msg
       tsResult <-
         callNode $
@@ -2352,7 +2352,7 @@ tsClientTests = describe "protocol/client" $ do
             C.cbAuthenticate
               (C.PublicKeyX25519 pubA)
               (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
               msg
       B.length expected `shouldBe` 80
 
@@ -2363,7 +2363,7 @@ tsClientTests = describe "protocol/client" $ do
             C.cbAuthenticate
               (C.PublicKeyX25519 pubA)
               (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
               msg
       tsResult <-
         callNode $
@@ -2389,7 +2389,7 @@ tsClientTests = describe "protocol/client" $ do
             C.cbAuthenticate
               (C.PublicKeyX25519 pubA)
               (C.PrivateKeyX25519 privB)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
               msg
       tsResult <-
         callNode $
@@ -2427,7 +2427,7 @@ tsClientTests = describe "protocol/client" $ do
             C.cbVerify
               (C.PublicKeyX25519 pubB)
               (C.PrivateKeyX25519 privA)
-              (C.cbNonce nonce24)
+              (C.unsafeCbNonce nonce24)
               (C.CbAuthenticator tsAuth)
               msg
       hsValid `shouldBe` True
@@ -2438,7 +2438,7 @@ tsClientTests = describe "protocol/client" $ do
 
     it "encryptTransportChunk matches Haskell" $ do
       let plaintext = B.pack [100 .. 199]
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 plaintext
           tag = BA.convert $ LC.sbAuth state1 :: B.ByteString
           expected = cipher <> tag
@@ -2457,7 +2457,7 @@ tsClientTests = describe "protocol/client" $ do
 
     it "decryptTransportChunk decrypts Haskell-encrypted data" $ do
       let plaintext = B.pack ([200 .. 255] <> [0 .. 99])
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 plaintext
           tag = BA.convert $ LC.sbAuth state1 :: B.ByteString
           encData = cipher <> tag
@@ -2542,7 +2542,7 @@ tsDownloadTests = describe "download" $ do
       -- File-level key/nonce (different from transport)
       fileKey32 = B.pack [1 .. 32]
       fileNonce24 = B.pack [1 .. 24]
-      fileCbNonce = C.cbNonce fileNonce24
+      fileCbNonce = C.unsafeCbNonce fileNonce24
       fileSbKey = C.unsafeSbKey fileKey32
 
   describe "processFileResponse" $ do
@@ -2568,7 +2568,7 @@ tsDownloadTests = describe "download" $ do
           dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
           chunkData = B.pack [50 .. 149]
           chunkDigest = C.sha256Hash chunkData
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 chunkData
           tag = BA.convert (LC.sbAuth state1) :: B.ByteString
           encData = cipher <> tag
@@ -2592,7 +2592,7 @@ tsDownloadTests = describe "download" $ do
           dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
           chunkData = B.pack [50 .. 149]
           wrongDigest = B.replicate 32 0xff
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 chunkData
           tag = BA.convert (LC.sbAuth state1) :: B.ByteString
           encData = cipher <> tag
@@ -2615,7 +2615,7 @@ tsDownloadTests = describe "download" $ do
       let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
           dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
           chunkData = B.pack [10 .. 50]
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 chunkData
           tag = BA.convert (LC.sbAuth state1) :: B.ByteString
           encData = cipher <> tag
@@ -2652,7 +2652,7 @@ tsDownloadTests = describe "download" $ do
       -- Step 2: transport-level encryption (simulates server sending chunk)
       let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
           dhSecretBytes = case dhSecret of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
-          ts0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          ts0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (transportCipher, ts1) = LC.sbEncryptChunk ts0 fileEncrypted
           transportTag = BA.convert (LC.sbAuth ts1) :: B.ByteString
           transportEncData = transportCipher <> transportTag
@@ -2702,7 +2702,7 @@ tsDownloadTests = describe "download" $ do
           dhSecret1 = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
           dhSecret1Bytes = case dhSecret1 of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
           nonce1 = nonce24
-          t1s0 = either (error . show) id $ LC.cbInit dhSecret1 (C.cbNonce nonce1)
+          t1s0 = either (error . show) id $ LC.cbInit dhSecret1 (C.unsafeCbNonce nonce1)
           (t1cipher, t1s1) = LC.sbEncryptChunk t1s0 fileChunk1
           t1tag = BA.convert (LC.sbAuth t1s1) :: B.ByteString
           transportEnc1 = t1cipher <> t1tag
@@ -2710,7 +2710,7 @@ tsDownloadTests = describe "download" $ do
           nonce2 = B.pack [24 .. 47]
           dhSecret2 = C.dh' (C.PublicKeyX25519 pubB) (C.PrivateKeyX25519 privA)
           dhSecret2Bytes = case dhSecret2 of C.DhSecretX25519 k -> BA.convert k :: B.ByteString
-          t2s0 = either (error . show) id $ LC.cbInit dhSecret2 (C.cbNonce nonce2)
+          t2s0 = either (error . show) id $ LC.cbInit dhSecret2 (C.unsafeCbNonce nonce2)
           (t2cipher, t2s1) = LC.sbEncryptChunk t2s0 fileChunk2
           t2tag = BA.convert (LC.sbAuth t2s1) :: B.ByteString
           transportEnc2 = t2cipher <> t2tag
@@ -2748,7 +2748,7 @@ tsDownloadTests = describe "download" $ do
       -- Client side: generate FGET command
       let dhSecret = C.dh' (C.PublicKeyX25519 pubA) (C.PrivateKeyX25519 privB)
           chunkData = "FGET round-trip test data" :: B.ByteString
-          state0 = either (error . show) id $ LC.cbInit dhSecret (C.cbNonce nonce24)
+          state0 = either (error . show) id $ LC.cbInit dhSecret (C.unsafeCbNonce nonce24)
           (cipher, state1) = LC.sbEncryptChunk state0 chunkData
           tag = BA.convert (LC.sbAuth state1) :: B.ByteString
           encData = cipher <> tag

From 7754f8624ec0dde4359df89ee61751ceaac46650 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Thu, 8 Oct 2026 18:28:38 +0400
Subject: [PATCH 08/20] smp-server: copy entity IDs out of received block
 (#1906)

---
 src/Simplex/Messaging/Protocol.hs |  4 +++-
 tests/CoreTests/BatchingTests.hs  | 26 +++++++++++++++++++++++++-
 2 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs
index fdb2a0209..3d3322522 100644
--- a/src/Simplex/Messaging/Protocol.hs
+++ b/src/Simplex/Messaging/Protocol.hs
@@ -2449,7 +2449,9 @@ tDecodeServer THandleParams {sessionId, thVersion = v, implySessId} = \case
           where
             cmdOrErr = parseProtocol @v @err @cmd v command >>= checkCredentials tAuth entityId
             t :: a -> (CorrId, EntityId, a)
-            t = (corrId,entityId,)
+            -- IDs are slices of the ~16 KB received block and are kept as subscription keys,
+            -- so without a copy one live key retains the whole block
+            t = (CorrId $ B.copy $ bs corrId,EntityId $ B.copy $ unEntityId entityId,)
         Left _ -> tError corrId PEBlock
     | otherwise -> tError corrId PESession
   Left _ -> tError "" PEBlock
diff --git a/tests/CoreTests/BatchingTests.hs b/tests/CoreTests/BatchingTests.hs
index efed59f77..fef0d584f 100644
--- a/tests/CoreTests/BatchingTests.hs
+++ b/tests/CoreTests/BatchingTests.hs
@@ -14,11 +14,13 @@ import Control.Monad
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteString as B
 import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Unsafe (unsafeUseAsCString)
 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 Foreign.Ptr (plusPtr)
 import Simplex.Messaging.Client
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -40,6 +42,8 @@ batchingTests = do
     it "should batch subscription responses with message" testBatchSubResponses
     it "should break on message that does not fit" testClientBatchWithMessage
     it "should break on large message" testClientBatchWithLargeMessage
+  describe "tDecodeServer" $
+    it "should copy IDs out of received block" testDecodeServerCopiesIds
 
 testBatchSubscriptions :: IO ()
 testBatchSubscriptions = do
@@ -166,6 +170,26 @@ testClientBatchWithLargeMessage = do
   (length rs1', length rs2') `shouldBe` (75, 135)
   all lenOk [s1', s2'] `shouldBe` True
 
+testDecodeServerCopiesIds :: IO ()
+testDecodeServerCopiesIds = do
+  sessId <- atomically . C.randomBytes 32 =<< C.newRandom
+  subs <- replicateM 2 $ randomSUB sessId
+  let thParams = testTHandleParams sessId
+  [TBTransmissions s 2 _] <- pure $ batchTransmissions thParams $ L.fromList subs
+  forM_ (tParse thParams s) $ \t -> do
+    let (corrId, entId, _) = tDecodeClient @SMPVersion @ErrorType @Cmd thParams t
+    Right (_, _, (corrId', entId', _)) <- pure $ tDecodeServer @SMPVersion @ErrorType @Cmd (testTHandleParams sessId) t
+    (corrId', entId') `shouldBe` (corrId, entId)
+    sharesBuffer s (bs corrId) `shouldReturn` True
+    sharesBuffer s (unEntityId entId) `shouldReturn` True
+    sharesBuffer s (bs corrId') `shouldReturn` False
+    sharesBuffer s (unEntityId entId') `shouldReturn` False
+
+sharesBuffer :: ByteString -> ByteString -> IO Bool
+sharesBuffer block s =
+  unsafeUseAsCString block $ \blockPtr -> unsafeUseAsCString s $ \ptr ->
+    pure $ ptr >= blockPtr && ptr < blockPtr `plusPtr` B.length block
+
 testClientStub :: IO (ProtocolClient SMPVersion ErrorType BrokerMsg)
 testClientStub = do
   g <- C.newRandom
@@ -237,7 +261,7 @@ randomSEND sessId len = do
       TransmissionForAuth {tForAuth, tToSend} = encodeTransmissionForAuth thParams (CorrId corrId, EntityId sId, Cmd SSender $ SEND noMsgFlags msg)
   pure $ (,tToSend) <$> authTransmission thAuth_ False (Just spKey) (Just nonce) tForAuth
 
-testTHandleParams :: ByteString -> THandleParams SMPVersion 'TClient
+testTHandleParams :: ByteString -> THandleParams SMPVersion p
 testTHandleParams sessionId =
   THandleParams
     { sessionId,

From e24d537eaaa32230eec1fefcd957d474d7b8d4d5 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 8 Oct 2026 16:03:06 +0100
Subject: [PATCH 09/20] agent: fix race when switching reception to the new
 queue (#1933)

* agent: fix race when switching reception to the new queue

* return bool

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 ...026-10-08-fast-rotation-old-queue-drain.md | 58 +++++++++++++++
 src/Simplex/Messaging/Agent.hs                | 54 ++++++++++----
 src/Simplex/Messaging/Agent/Client.hs         |  2 +-
 src/Simplex/Messaging/Agent/Protocol.hs       |  3 +
 src/Simplex/Messaging/Agent/Store.hs          |  1 +
 .../Messaging/Agent/Store/AgentStore.hs       |  5 ++
 src/Simplex/Messaging/Client.hs               |  9 ++-
 tests/AgentTests/FunctionalAPITests.hs        | 72 ++++++++++++++++++-
 8 files changed, 184 insertions(+), 20 deletions(-)
 create mode 100644 plans/2026-10-08-fast-rotation-old-queue-drain.md

diff --git a/plans/2026-10-08-fast-rotation-old-queue-drain.md b/plans/2026-10-08-fast-rotation-old-queue-drain.md
new file mode 100644
index 000000000..8cf3413cf
--- /dev/null
+++ b/plans/2026-10-08-fast-rotation-old-queue-drain.md
@@ -0,0 +1,58 @@
+# Fast rotation: draining the old receive queue
+
+Recipient only. The sender is unchanged.
+
+## Decisions
+
+- New `RcvSwitchStatus` value:
+
+  | constructor      | encoding        |
+  |------------------|-----------------|
+  | `RSReceivedQEND` | `received_qend` |
+
+  - Stored in `rcv_queues.switch_status`.
+  - `canAbortRcvSwitch` returns `False` for it.
+- `qEndMsg`, by the queue that delivered `QEND`:
+  - the queue named in `QEND`: the named queue is marked deleted, `ICDeleteRcvQueue` is enqueued.
+  - the new queue: the named queue is set to `RSReceivedQEND` and stays subscribed.
+  - `NSCCreate` and `SWITCH QDRcv SPCompleted`: sent when the named queue had no `RSReceivedQEND`.
+- Deletion of an `RSReceivedQEND` queue:
+  - trigger: `OK` response to an `ACK` on that queue, without a `GET` lock on it.
+  - action: the queue is marked deleted, `ICDeleteRcvQueue` is enqueued.
+- Bound, a `cleanupManager` step, for each connection with an `RSReceivedQEND` queue:
+  - condition: another receive queue of the connection has an active subscription.
+  - `delete_errors + 1 < deleteErrorCount`: `delete_errors` is incremented.
+  - otherwise: the queue is deleted as above; the first `DEL` error of `ICDeleteRcvQueue` removes it locally.
+- `ackSMPMessage` result, `type QueueDrained = Bool`:
+  - `OK`: `True`.
+  - `MSG`: `False`; the message is written to `msgQ`.
+- Apps: `received_qend` is added to `RcvSwitchStatus`.
+
+## Mechanics
+
+- `Agent/Protocol.hs`: `RSReceivedQEND`.
+- `Agent/Store.hs`: `canAbortRcvSwitch`.
+- `Client.hs`: `QueueDrained`; `ackSMPMessage` returns it.
+- `Agent/Client.hs`: `sendAck` returns `QueueDrained`.
+- `Agent/Store/AgentStore.hs`: `getEndedRcvQueueConnIds`:
+
+  ```sql
+  SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0
+  ```
+
+- `Agent.hs`:
+  - `deleteRcvQueueAsync`: `setRcvQueueDeleted`, then `ICDeleteRcvQueue`.
+  - `qEndMsg`.
+  - `ackQueueMessage`.
+  - `cleanupManager`: `expireEndedRcvQueues`.
+- Apps:
+  - `apps/ios/SimpleXChat/APITypes.swift`
+  - `apps/multiplatform/common/src/commonMain/kotlin/chat/simplex/common/model/SimpleXAPI.kt`
+
+## Tests
+
+- `QEND` on the new queue while a message waits on the old queue:
+  - the message is delivered;
+  - the old queue is deleted after the `ACK` that returns `OK`.
+- The same with a recipient restart before the `ACK`.
+- Old server stopped: the old queue is deleted by the bound.
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 833815f36..4d6913411 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2893,22 +2893,27 @@ synchronizeRatchet' c connId pqSupport' force = withConnLock c connId "synchroni
     _ -> throwE $ CMD PROHIBITED "synchronizeRatchet: not duplex"
 
 ackQueueMessage :: AgentClient -> RcvQueue -> SMP.MsgId -> AM (Maybe ATransmission)
-ackQueueMessage c rq@RcvQueue {userId, connId, server} srvMsgId = do
+ackQueueMessage c rq@RcvQueue {userId, connId, server, rcvSwchStatus} srvMsgId = do
   atomically $ incSMPServerStat c userId server ackAttempts
   tryAllErrors (sendAck c rq srvMsgId) >>= \case
-    Right _ -> sendMsgNtf ackMsgs
-    Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs
+    Right drained -> sendMsgNtf ackMsgs $ drained && rcvSwchStatus == Just RSReceivedQEND
+    Left (SMP _ SMP.NO_MSG) -> sendMsgNtf ackNoMsgErrs False
     Left e -> do
       unless (temporaryOrHostError e) $ atomically $ incSMPServerStat c userId server ackOtherErrs
       throwE e
   where
-    sendMsgNtf stat = do
+    sendMsgNtf stat ended = do
       atomically $ incSMPServerStat c userId server stat
       ifM (liftIO $ hasGetLock c rq)
         (do atomically $ releaseGetLock c rq
             brokerTs_ <- eitherToMaybe <$> tryAllErrors (withStore c $ \db -> getRcvMsgBrokerTs db connId srvMsgId)
             pure $ Just ("", connId, AEvt SAEConn $ MSGNTF srvMsgId brokerTs_))
-        (pure Nothing)
+        (Nothing <$ when ended (deleteRcvQueueAsync c rq))
+
+deleteRcvQueueAsync :: AgentClient -> RcvQueue -> AM ()
+deleteRcvQueueAsync c rq@RcvQueue {connId, server, rcvId} = do
+  withStore' c (`setRcvQueueDeleted` rq)
+  enqueueCommand c "" connId (Just server) $ AInternalCommand $ ICDeleteRcvQueue rcvId
 
 -- | Suspend SMP agent connection (OFF command) in Reader monad
 suspendConnection' :: AgentClient -> NetworkRequestMode -> ConnId -> AM ()
@@ -3438,6 +3443,7 @@ cleanupManager c@AgentClient {subQ} = do
     run SFERR deleteSndFilesPrefixPaths
     run SFERR deleteExpiredReplicasForDeletion
     run ERR deleteExpiredServiceReqs
+    run ERR expireEndedRcvQueues
     liftIO $ threadDelay' int
   where
     run :: forall e. AEntityI e => (AgentErrorType -> AEvent e) -> AM () -> AM' ()
@@ -3495,6 +3501,20 @@ cleanupManager c@AgentClient {subQ} = do
         deleteExpiredServiceRequests db $ addUTCTime (negate serviceResponseTimeout) now
         getExpiredServiceConns db now
       deleteConnectionsAsync' c False expiredConns
+    expireEndedRcvQueues = do
+      maxErrs <- asks $ deleteErrorCount . config
+      connIds <- withStore' c getEndedRcvQueueConnIds
+      forM_ connIds $ \connId -> flip catchAllErrors (notify connId . ERR) $
+        withConnLock c connId "cleanupManager" $
+          withStore c (`getConn` connId) >>= \case
+            SomeConn _ (DuplexConnection _ rqs _) -> do
+              let (ended, current) = L.partition ((Just RSReceivedQEND ==) . rcvSwchStatus) rqs
+              whenM (anyM $ map (atomically . hasActiveSubscription c) current) $
+                forM_ ended $ \rq ->
+                  if deleteErrors rq + 1 < maxErrs
+                    then withStore' c (`incRcvDeleteErrors` rq)
+                    else deleteRcvQueueAsync c rq
+            _ -> pure ()
     notify :: forall e. AEntityI e => AEntityId -> AEvent e -> AM ()
     notify entId cmd = atomically $ writeTBQueue subQ ("", entId, AEvt (sAEntity @e) cmd)
 
@@ -4094,19 +4114,23 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
           -- processed by queue recipient
           qEndMsg :: SMP.MsgId -> NonEmpty SndQAddr -> Connection 'CDuplex -> AM ()
           qEndMsg srvMsgId addrs (DuplexConnection cData'@ConnData {enableNtfs} rqs sqs) =
-            case L.partition (\rq' -> any (`sameQAddress` sndAddress rq') addrs) rqs of
+            case L.partition isRemoved rqs of
               (removed@(_ : _), keptRq : keptRqs) -> do
                 logServer "<--" c srv rId $ "MSG <QEND>:" <> logSecret' (SMP.unMsgId srvMsgId)
-                forM_ removed $ \rq'@RcvQueue {server = rmServer, rcvId} -> do
-                  withStore' c $ \db -> setRcvQueueDeleted db rq'
-                  enqueueCommand c "" connId (Just rmServer) $ AInternalCommand $ ICDeleteRcvQueue rcvId
-                when enableNtfs $ do
-                  ns <- asks ntfSupervisor
-                  liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
-                let conn' = DuplexConnection cData' (keptRq :| keptRqs) sqs
-                cStats <- connectionStats c conn'
-                notify $ SWITCH QDRcv SPCompleted cStats
+                let completed = any ((Just RSReceivedQEND ==) . rcvSwchStatus) removed
+                if isRemoved rq
+                  then mapM_ (deleteRcvQueueAsync c) removed
+                  else withStore' c $ \db -> forM_ removed $ \rq' -> setRcvSwitchStatus db rq' $ Just RSReceivedQEND
+                unless completed $ do
+                  when enableNtfs $ do
+                    ns <- asks ntfSupervisor
+                    liftIO $ sendNtfSubCommand ns (NSCCreate, [connId])
+                  let conn' = DuplexConnection cData' (keptRq :| keptRqs) sqs
+                  cStats <- connectionStats c conn'
+                  notify $ SWITCH QDRcv SPCompleted cStats
               _ -> pure ()
+            where
+              isRemoved rq' = any (`sameQAddress` sndAddress rq') addrs
 
           qError :: String -> AM a
           qError = throwE . AGENT . A_QUEUE
diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 766298948..08eb64ea9 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -2080,7 +2080,7 @@ disableQueuesNtfs c = sendTSessionBatches "NDEL" (mkSMPTSession . snd) disableQu
     queueCreds :: DisableQueueNtfReq -> (SMP.RecipientId, SMP.RcvPrivateAuthKey)
     queueCreds (_, RcvQueue {rcvPrivateKey, rcvId}) = (rcvId, rcvPrivateKey)
 
-sendAck :: AgentClient -> RcvQueue -> MsgId -> AM ()
+sendAck :: AgentClient -> RcvQueue -> MsgId -> AM QueueDrained
 sendAck c rq@RcvQueue {rcvId, rcvPrivateKey} msgId =
   withSMPClient c NRMBackground rq ("ACK:" <> logSecret' (SMP.unMsgId msgId)) $ \smp ->
     ackSMPMessage smp rcvPrivateKey rcvId msgId
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 5f7977e45..3ea9f3b1a 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -612,6 +612,7 @@ data RcvSwitchStatus
   | RSSendingQADD
   | RSSendingQUSE
   | RSReceivedMessage
+  | RSReceivedQEND
   deriving (Eq, Show)
 
 instance StrEncoding RcvSwitchStatus where
@@ -620,12 +621,14 @@ instance StrEncoding RcvSwitchStatus where
     RSSendingQADD -> "sending_qadd"
     RSSendingQUSE -> "sending_quse"
     RSReceivedMessage -> "received_message"
+    RSReceivedQEND -> "received_qend"
   strP =
     A.takeTill (== ' ') >>= \case
       "switch_started" -> pure RSSwitchStarted
       "sending_qadd" -> pure RSSendingQADD
       "sending_quse" -> pure RSSendingQUSE
       "received_message" -> pure RSReceivedMessage
+      "received_qend" -> pure RSReceivedQEND
       _ -> fail "bad RcvSwitchStatus"
 
 instance ToField RcvSwitchStatus where toField = toField . decodeLatin1 . strEncode
diff --git a/src/Simplex/Messaging/Agent/Store.hs b/src/Simplex/Messaging/Agent/Store.hs
index e75cdb05e..67415c718 100644
--- a/src/Simplex/Messaging/Agent/Store.hs
+++ b/src/Simplex/Messaging/Agent/Store.hs
@@ -219,6 +219,7 @@ canAbortRcvSwitch ConnData {connAgentVersion} = maybe False canAbort . rcvSwchSt
       -- if switch is in RSReceivedMessage status, aborting switch (deleting new queue)
       -- will break the connection because the sender would have original queue deleted
       RSReceivedMessage -> False
+      RSReceivedQEND -> False
 
 data ClientNtfCreds = ClientNtfCreds
   { -- | key pair to be used by the notification server to authorize transmissions
diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
index 2816d4615..2d3c7b3f2 100644
--- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs
+++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs
@@ -100,6 +100,7 @@ module Simplex.Messaging.Agent.Store.AgentStore
     setSndQueuePrimary,
     deleteConnRcvQueue,
     incRcvDeleteErrors,
+    getEndedRcvQueueConnIds,
     deleteConnSndQueue,
     getPrimaryRcvQueue,
     getRcvQueue,
@@ -763,6 +764,10 @@ incRcvDeleteErrors :: DB.Connection -> RcvQueue -> IO ()
 incRcvDeleteErrors db RcvQueue {connId, dbQueueId} =
   DB.execute db "UPDATE rcv_queues SET delete_errors = delete_errors + 1 WHERE conn_id = ? AND rcv_queue_id = ?" (connId, dbQueueId)
 
+getEndedRcvQueueConnIds :: DB.Connection -> IO [ConnId]
+getEndedRcvQueueConnIds db =
+  map fromOnly <$> DB.query db "SELECT conn_id FROM rcv_queues WHERE switch_status = ? AND deleted = 0" (Only RSReceivedQEND)
+
 deleteConnRcvQueue :: DB.Connection -> RcvQueue -> IO ()
 deleteConnRcvQueue db RcvQueue {connId, dbQueueId} =
   DB.execute db "DELETE FROM rcv_queues WHERE conn_id = ? AND rcv_queue_id = ?" (connId, dbQueueId)
diff --git a/src/Simplex/Messaging/Client.hs b/src/Simplex/Messaging/Client.hs
index 87b4319e7..9989a96eb 100644
--- a/src/Simplex/Messaging/Client.hs
+++ b/src/Simplex/Messaging/Client.hs
@@ -67,6 +67,7 @@ module Simplex.Messaging.Client
     enableSMPQueuesNtfs,
     disableSMPQueuesNtfs,
     sendSMPMessage,
+    QueueDrained,
     ackSMPMessage,
     suspendSMPQueue,
     deleteSMPQueue,
@@ -1087,15 +1088,17 @@ resolvedNameOrNotFound d NameResponse {registration} = case registration of
   NRRegistered {nameRecord} -> T.toLower (nrName nameRecord) == fullDomainName d
   _ -> True
 
+type QueueDrained = Bool
+
 -- | Acknowledge message delivery (server deletes the message).
 --
 -- https://github.com/simplex-chat/simplexmq/blob/master/protocol/simplex-messaging.md#acknowledge-message-delivery
 -- This command is always sent in background request mode
-ackSMPMessage :: SMPClient -> RcvPrivateAuthKey -> QueueId -> MsgId -> ExceptT SMPClientError IO ()
+ackSMPMessage :: SMPClient -> RcvPrivateAuthKey -> QueueId -> MsgId -> ExceptT SMPClientError IO QueueDrained
 ackSMPMessage c rpKey rId msgId =
   sendSMPCommand c NRMBackground (Just rpKey) rId (ACK msgId) >>= \case
-    OK -> return ()
-    cmd@MSG {} -> liftIO $ writeSMPMessage c rId cmd
+    OK -> pure True
+    cmd@MSG {} -> liftIO (writeSMPMessage c rId cmd) $> False
     r -> throwE $ unexpectedResponse r
 
 -- | Irreversibly suspend SMP queue.
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 1d6f0c121..bdc37f6e2 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -550,6 +550,10 @@ functionalAPITests ps = do
       testServerMatrix2 ps testFastSwitchConnection
     it "should switch delivery to the new queue when the old server is down" $
       testFastSwitchDeadOldServer ps
+    it "should drain the old queue after QEND on the new queue" $
+      testFastSwitchDrainOldQueue ps
+    it "should drain the old queue after QEND on the new queue and restart" $
+      testFastSwitchDrainOldQueueRestart ps
     describe "should switch delivery to the new queue" $
       testServerMatrix2 ps testSwitchConnection
     describe "should switch to new queue asynchronously" $
@@ -3729,7 +3733,7 @@ testFastSwitchDeadOldServer :: HasCallStack => (ASrvTransport, AStoreType) -> IO
 testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
   let bServers = initAgentServers {smp = userServers [testSMPServer2]}
   withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ ->
-    withAgent 1 agentCfg initAgentServers testDB $ \a ->
+    withAgent 1 aCfg initAgentServers testDB $ \a ->
       withAgent 2 agentCfg bServers testDB2 $ \b -> do
         (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
           (aId, bId) <- makeConnection a b
@@ -3745,7 +3749,10 @@ testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
           queuedReceived <- drainSwitchCompletedRcvMsg a bId "queued while down"
           liftIO $ queuedReceived `shouldBe` True
           drainSwitchCompleted b aId QDSnd
+          waitOneRcvQueue a bId
           exchangeGreetingsMsgId 7 a bId b aId
+  where
+    aCfg = agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3}
 
 -- drains switch and network events until the connection reports SPCompleted in the given direction,
 -- tolerating DOWN/UP and intermediate phases (the old server is stopped mid-rotation)
@@ -3765,6 +3772,69 @@ drainSwitchCompletedRcvMsg c connId body = go False
         (_, connId', AEvt SAEConn (Msg' mId _ body')) | connId' == connId && body' == body -> ackMessage c connId' mId Nothing >> go True
         _ -> go seen
 
+testFastSwitchDrainOldQueue :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueue ps =
+  withSmpServers2 ps $ withAgentClients2 $ \a b -> runRight_ $ do
+    (aId, bId, aM1Id) <- endSwitchOnNewQueue a b
+    ackMessage a bId aM1Id Nothing
+    drainOldQueue a bId b aId
+
+testFastSwitchDrainOldQueueRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueueRestart ps =
+  withSmpServers2 ps $
+    withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
+      (aId, bId, _) <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ endSwitchOnNewQueue a b
+      withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
+        subscribeConnection a bId
+        drainOldQueue a bId b aId
+
+endSwitchOnNewQueue :: HasCallStack => AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId, AgentMsgId)
+endSwitchOnNewQueue a b = do
+  (aId, bId) <- makeConnection a b
+  exchangeGreetings a bId b aId
+  liftIO $ setProtocolServers a 1 [noAuthSrvCfg testSMPServer2]
+  m1Id <- sendMessage b aId SMP.noMsgFlags "m1"
+  get b ##> ("", aId, SENT m1Id)
+  ("", c, Msg' aM1Id _ "m1") <- get a
+  liftIO $ c `shouldBe` bId
+  m2Id <- sendMessage b aId SMP.noMsgFlags "m2"
+  get b ##> ("", aId, SENT m2Id)
+  _ <- switchConnectionAsync a "" bId
+  fastSwitchComplete a bId b aId
+  stats <- getConnectionServers a bId
+  liftIO $ rcvSwchStatuses' stats `shouldMatchList` [Nothing, Just RSReceivedQEND]
+  pure (aId, bId, aM1Id)
+
+drainOldQueue :: HasCallStack => AgentClient -> ConnId -> AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+drainOldQueue a bId b aId = do
+  ("", c, MSG MsgMeta {recipient = (aM2Id, _)} _ "m2") <- get a
+  liftIO $ c `shouldBe` bId
+  ackMessage a bId aM2Id Nothing
+  waitOneRcvQueue a bId
+  bMsgId <- sendMessage b aId SMP.noMsgFlags "hello"
+  get b ##> ("", aId, SENT bMsgId)
+  ("", c', MSG MsgMeta {recipient = (aMsgId, _)} _ "hello") <- get a
+  liftIO $ c' `shouldBe` bId
+  ackMessage a bId aMsgId Nothing
+  aMsgId' <- sendMessage a bId SMP.noMsgFlags "hello too"
+  get a ##> ("", bId, SENT aMsgId')
+  ("", c'', MSG MsgMeta {recipient = (bMsgId', _)} _ "hello too") <- get b
+  liftIO $ c'' `shouldBe` aId
+  ackMessage b aId bMsgId' Nothing
+  liftIO $ noMessages a "nothing else should be delivered to alice"
+  liftIO $ noMessages b "nothing else should be delivered to bob"
+
+waitOneRcvQueue :: HasCallStack => AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
+waitOneRcvQueue c connId = go (300 :: Int)
+  where
+    go n = do
+      stats <- getConnectionServers c connId
+      case rcvSwchStatuses' stats of
+        [Nothing] -> pure ()
+        statuses
+          | n > 0 -> liftIO (threadDelay 100000) >> go (n - 1)
+          | otherwise -> liftIO $ expectationFailure $ "old receive queue was not deleted: " <> show statuses
+
 phaseRcv :: AgentClient -> ByteString -> SwitchPhase -> [Maybe RcvSwitchStatus] -> ExceptT AgentErrorType IO ()
 phaseRcv c connId p swchStatuses = phase c connId QDRcv p (\stats -> rcvSwchStatuses' stats `shouldMatchList` swchStatuses)
 

From c18e0297c4db1bb75f4579b31e671a0b66513e1c Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 8 Oct 2026 17:07:55 +0100
Subject: [PATCH 10/20] agent: migration to add index to read queues (#1934)

* agent: migration to add index to read queues

* update postgres schema

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 ...026-10-08-fast-rotation-old-queue-drain.md |  4 ++++
 simplexmq.cabal                               |  2 ++
 .../Agent/Store/Postgres/Migrations/App.hs    |  4 +++-
 .../Migrations/M20261008_rcv_switch_status.hs | 20 +++++++++++++++++++
 .../Migrations/agent_postgres_schema.sql      |  4 ++++
 .../Agent/Store/SQLite/Migrations/App.hs      |  4 +++-
 .../Migrations/M20261008_rcv_switch_status.hs | 19 ++++++++++++++++++
 .../Store/SQLite/Migrations/agent_schema.sql  |  1 +
 tests/AgentTests/SchemaDump.hs                | 16 +++++++++++++++
 9 files changed, 72 insertions(+), 2 deletions(-)
 create mode 100644 src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20261008_rcv_switch_status.hs
 create mode 100644 src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261008_rcv_switch_status.hs

diff --git a/plans/2026-10-08-fast-rotation-old-queue-drain.md b/plans/2026-10-08-fast-rotation-old-queue-drain.md
index 8cf3413cf..aa226bf82 100644
--- a/plans/2026-10-08-fast-rotation-old-queue-drain.md
+++ b/plans/2026-10-08-fast-rotation-old-queue-drain.md
@@ -27,6 +27,9 @@ Recipient only. The sender is unchanged.
   - `OK`: `True`.
   - `MSG`: `False`; the message is written to `msgQ`.
 - Apps: `received_qend` is added to `RcvSwitchStatus`.
+- Migration `20261008_rcv_switch_status`, SQLite and Postgres:
+  - up: index `idx_rcv_queues_switch_status` on `rcv_queues(switch_status)`.
+  - down: `received_qend` is set to `NULL`, the index is dropped.
 
 ## Mechanics
 
@@ -56,3 +59,4 @@ Recipient only. The sender is unchanged.
   - the old queue is deleted after the `ACK` that returns `OK`.
 - The same with a recipient restart before the `ACK`.
 - Old server stopped: the old queue is deleted by the bound.
+- Downgrade: `received_qend` is cleared, other switch statuses are kept.
diff --git a/simplexmq.cabal b/simplexmq.cabal
index ef46fb723..0153db450 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -196,6 +196,7 @@ library
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
           Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
+          Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
   else
       exposed-modules:
           Simplex.Messaging.Agent.Store.SQLite
@@ -253,6 +254,7 @@ library
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
           Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
+          Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
           Simplex.Messaging.Agent.Store.SQLite.Util
   if flag(client_postgres) || flag(server_postgres)
       exposed-modules:
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
index 26c7a80da..4e473f473 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/App.hs
@@ -17,6 +17,7 @@ import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260712_address_dr_rp
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260823_snd_files_entitlement
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20260929_ratchet_indexes
+import Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Text, Maybe Text)]
@@ -33,7 +34,8 @@ schemaMigrations =
     ("20260712_address_dr_rpc", m20260712_address_dr_rpc, Just down_m20260712_address_dr_rpc),
     ("20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
     ("20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
-    ("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes)
+    ("20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
+    ("20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20261008_rcv_switch_status.hs b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20261008_rcv_switch_status.hs
new file mode 100644
index 000000000..5ec0ae377
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/M20261008_rcv_switch_status.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.Postgres.Migrations.M20261008_rcv_switch_status where
+
+import Data.Text (Text)
+import Text.RawString.QQ (r)
+
+m20261008_rcv_switch_status :: Text
+m20261008_rcv_switch_status =
+  [r|
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
+|]
+
+down_m20261008_rcv_switch_status :: Text
+down_m20261008_rcv_switch_status =
+  [r|
+UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
+DROP INDEX idx_rcv_queues_switch_status;
+|]
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
index 55a9ab78d..ff28100f5 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
@@ -1233,6 +1233,10 @@ CREATE UNIQUE INDEX idx_rcv_queues_ntf ON smp_agent_test_protocol_schema.rcv_que
 
 
 
+CREATE INDEX idx_rcv_queues_switch_status ON smp_agent_test_protocol_schema.rcv_queues USING btree (switch_status);
+
+
+
 CREATE INDEX idx_rcv_queues_to_subscribe ON smp_agent_test_protocol_schema.rcv_queues USING btree (to_subscribe);
 
 
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
index 856c86626..5dbd314f9 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/App.hs
@@ -54,6 +54,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260823_snd_files_entit
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260919_ratchet_verify_codes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20260929_ratchet_indexes
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261005_commands_autoincrement
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status
 import Simplex.Messaging.Agent.Store.Shared (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -107,7 +108,8 @@ schemaMigrations =
     ("m20260823_snd_files_entitlement", m20260823_snd_files_entitlement, Just down_m20260823_snd_files_entitlement),
     ("m20260919_ratchet_verify_codes", m20260919_ratchet_verify_codes, Just down_m20260919_ratchet_verify_codes),
     ("m20260929_ratchet_indexes", m20260929_ratchet_indexes, Just down_m20260929_ratchet_indexes),
-    ("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement)
+    ("m20261005_commands_autoincrement", m20261005_commands_autoincrement, Just down_m20261005_commands_autoincrement),
+    ("m20261008_rcv_switch_status", m20261008_rcv_switch_status, Just down_m20261008_rcv_switch_status)
   ]
 
 -- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261008_rcv_switch_status.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261008_rcv_switch_status.hs
new file mode 100644
index 000000000..cf0283d7e
--- /dev/null
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20261008_rcv_switch_status.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20261008_rcv_switch_status where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20261008_rcv_switch_status :: Query
+m20261008_rcv_switch_status =
+  [sql|
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
+|]
+
+down_m20261008_rcv_switch_status :: Query
+down_m20261008_rcv_switch_status =
+  [sql|
+UPDATE rcv_queues SET switch_status = NULL WHERE switch_status = 'received_qend';
+DROP INDEX idx_rcv_queues_switch_status;
+|]
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 963f918ac..cdbcee7dd 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql
@@ -645,6 +645,7 @@ CREATE INDEX idx_processed_ratchet_key_hashes_conn_id ON processed_ratchet_key_h
   conn_id,
   processed_ratchet_key_hash_id
 );
+CREATE INDEX idx_rcv_queues_switch_status ON rcv_queues(switch_status);
 CREATE TRIGGER tr_rcv_queue_insert
 AFTER INSERT ON rcv_queues
 FOR EACH ROW
diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs
index f7435a23b..c64d45e1e 100644
--- a/tests/AgentTests/SchemaDump.hs
+++ b/tests/AgentTests/SchemaDump.hs
@@ -49,6 +49,7 @@ schemaDumpTest = do
   it "should NOT create user record for new database" testUsersMigrationNew
   it "should create user record for old database" testUsersMigrationOld
   it "should remove duplicate ratchet key hashes before adding unique index" testRatchetKeyHashesUniqueMigration
+  it "should clear received_qend switch status on downgrade" testRcvSwitchStatusDowngrade
 
 testVerifySchemaDump :: IO ()
 testVerifySchemaDump = do
@@ -129,6 +130,21 @@ testRatchetKeyHashesUniqueMigration = do
     `shouldReturn` [Only (1 :: Int), Only 3, Only 4]
   closeDBStore st'
 
+testRcvSwitchStatusDowngrade :: IO ()
+testRcvSwitchStatusDowngrade = do
+  Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
+  withTransaction' st $ \db -> do
+    SQL.execute_ db "INSERT INTO users (user_id) VALUES (1)"
+    SQL.execute_ db "INSERT INTO connections (conn_id, conn_mode, user_id) VALUES (x'01', 'INV', 1)"
+    SQL.execute_ db "INSERT INTO servers (host, port, key_hash) VALUES ('localhost', '5001', x'00')"
+    SQL.execute_ db "INSERT INTO rcv_queues (host, port, rcv_id, conn_id, rcv_private_key, rcv_dh_secret, e2e_priv_key, snd_id, status, rcv_queue_id, rcv_primary, switch_status) VALUES ('localhost', '5001', x'01', x'01', x'00', x'00', x'00', x'01', 'active', 1, 0, 'received_qend'), ('localhost', '5001', x'02', x'01', x'00', x'00', x'00', x'02', 'active', 2, 1, 'sending_qadd')"
+  closeDBStore st
+  let beforeRcvSwitchStatus = takeWhile (("m20261008_rcv_switch_status" /=) . name) appMigrations
+  Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeRcvSwitchStatus (MigrationConfig MCYesUpDown Nothing)
+  withTransaction' st' (`SQL.query_` "SELECT switch_status FROM rcv_queues ORDER BY rcv_queue_id")
+    `shouldReturn` [Only (Nothing :: Maybe Text), Only (Just "sending_qadd")]
+  closeDBStore st'
+
 skipComparisonForDownMigrations :: [String]
 skipComparisonForDownMigrations =
   [ -- on down migration idx_messages_internal_snd_id_ts index moves down to the end of the file

From a2f985dc68f870c0327fc3e871f2816828bcba2d Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 10 Oct 2026 23:15:19 +0100
Subject: [PATCH 11/20] agent: prepare invitation link, create ratchet when
 connection is prepared (#1880)

* agent: prepare invitation link

* simplify

* refactor

* fix

* change min SMP version to 15

* remove dead code for SMP version <= 15

* update

* diff

* create ratchet when connection is prepared

* createRatchetIfNotExists

* clean up, only check client notices for contacts, fix orphan record

* simplify

* refactor

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent.hs            | 175 +++++++++++++++-------
 src/Simplex/Messaging/Agent/Protocol.hs   |   7 +-
 src/Simplex/Messaging/Crypto/ShortLink.hs |   8 +-
 tests/AgentTests/FunctionalAPITests.hs    |  92 +++++++++++-
 4 files changed, 219 insertions(+), 63 deletions(-)

diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 4d6913411..8d4af8002 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -63,7 +63,10 @@ module Simplex.Messaging.Agent
     createConnection,
     prepareConnectionLink,
     createConnectionForLink,
+    prepareInvitationLink,
+    createInvitationForLink,
     setConnShortLink,
+    prepareConnShortLink,
     deleteConnShortLink,
     getConnShortLink,
     resolveSimplexName,
@@ -439,22 +442,39 @@ createConnection c nm userId enableNtfs checkNotices = withAgentEnv c .::: newCo
 -- Caller provides root signing key pair and link entity ID.
 -- Returns the created link and internal params.
 -- The link address is fully determined at this point.
-prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams)
+prepareConnectionLink :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AE (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
 prepareConnectionLink c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ =
   withAgentEnv c $ prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_
 {-# INLINE prepareConnectionLink #-}
 
 -- | Create connection for prepared link (single network call).
 -- Validates that server response matches the prepared link.
-createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
+createConnectionForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AE ConnId
 createConnectionForLink c nm userId enableNtfs = withAgentEnv c .:: createConnectionForLink' c nm userId enableNtfs
 {-# INLINE createConnectionForLink #-}
 
+-- | Prepare one-time invitation link (no network call).
+-- Returns the invitation and internal params with the link key.
+-- The link ID is assigned by the server when the connection is created.
+prepareInvitationLink :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AE (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
+prepareInvitationLink c userId pqInitKeys srv_ = withAgentEnv c $ prepareInvitationLink' c userId pqInitKeys srv_
+{-# INLINE prepareInvitationLink #-}
+
+-- | Create connection for prepared invitation link (single network call).
+-- Returns the created link with the link ID assigned by the server.
+createInvitationForLink :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AE (ConnId, CreatedConnLink 'CMInvitation)
+createInvitationForLink c nm userId enableNtfs = withAgentEnv c .:: createInvitationForLink' c nm userId enableNtfs
+{-# INLINE createInvitationForLink #-}
+
 -- | Create or update user's contact connection short link
 setConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> UserConnLinkData c -> Maybe CRClientData -> NewRatchetKeys -> Maybe CR.InitialKeys -> AE (ConnShortLink c)
 setConnShortLink c = withAgentEnv c .:::. setConnShortLink' c
 {-# INLINE setConnShortLink #-}
 
+prepareConnShortLink :: AgentClient -> ConnId -> Maybe CRClientData -> AE (ConnShortLink 'CMContact)
+prepareConnShortLink c = withAgentEnv c .: prepareConnShortLink' c
+{-# INLINE prepareConnShortLink #-}
+
 deleteConnShortLink :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AE ()
 deleteConnShortLink c = withAgentEnv c .:. deleteConnShortLink' c
 {-# INLINE deleteConnShortLink #-}
@@ -1035,30 +1055,20 @@ newConn c nm userId enableNtfs checkNotices cMode linkData_ clientData pqInitKey
 
 -- | Prepare connection link for contact mode (no network, no database).
 -- Caller provides root signing key pair and link entity ID.
-prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams)
-prepareConnectionLink' c userId rootKey@(_, plpRootPrivKey) linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
-  g <- asks random
-  plpSrvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
-  when checkNotices $ checkClientNotices c plpSrvWithAuth
-  AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
-  plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
-  plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
+prepareConnectionLink' :: AgentClient -> UserId -> C.KeyPairEd25519 -> ByteString -> Bool -> Maybe CRClientData -> CR.InitialKeys -> UseRatchetKeys -> Maybe SMPServerWithAuth -> AM (CreatedConnLink 'CMContact, PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)))
+prepareConnectionLink' c userId rootKey linkEntityId checkNotices clientData pqInitKeys useDR srv_ = do
+  srvWithAuth@(ProtoServerWithAuth srv _) <- maybe (getSMPServer c userId) pure srv_
+  when checkNotices $ checkClientNotices c srvWithAuth
   addrKeys_ <- if useDR then Just <$> generateAddressRatchetKeys pqInitKeys else pure Nothing
-  let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
-      qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just QMContact)
-      connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) (fst <$> addrKeys_)
-      (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq (Just linkEntityId)
-      ccLink = CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey
-      params = PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys = pqInitKeys, plpAddressKeys = snd <$> addrKeys_}
-  pure (ccLink, params)
+  (connReq, params@PreparedLinkParams {plpLinkKey}) <-
+    prepareLinkParams rootKey (Just linkEntityId) clientData pqInitKeys srvWithAuth QMContact (`CRContactUri` (fst <$> addrKeys_)) (snd <$> addrKeys_)
+  pure (CCLink connReq $ Just $ CSLContact SLSServer CCTContact srv plpLinkKey, params)
 
 -- | Create connection for prepared link (single network call).
-createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
-createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpAddressKeys} userLinkData subMode = do
+createConnectionForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> CreatedConnLink 'CMContact -> PreparedLinkParams (Maybe (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448)) -> UserConnLinkData 'CMContact -> SubscriptionMode -> AM ConnId
+createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpRatchetKeys} userLinkData subMode = do
   g <- asks random
   AgentConfig {smpAgentVRange} <- asks config
-  connId <- newConnNoQueues c userId enableNtfs SCMContact (CR.connPQEncryption plpInitKeys)
-  mapM_ (storeAddressRatchetKeys c connId) plpAddressKeys
   let CRContactUri ConnReqUriData {crSmpQueues = SMPQueueUri _ SMPQueueAddress {senderId = sndId} :| _} addrKeys_ = connReq
       userLinkData' = case addrKeys_ of
         Just arKeys -> let UserContactLinkData ucd = userLinkData in UserContactLinkData ucd {ratchetKeys = Just arKeys}
@@ -1066,13 +1076,54 @@ createConnectionForLink' c nm userId enableNtfs (CCLink connReq _) PreparedLinkP
       md = SL.encodeSignUserData SCMContact plpRootPrivKey smpAgentVRange userLinkData'
       linkData = (plpSignedFixedData, md)
   qd <- encryptContactLinkData g plpRootPrivKey plpLinkKey sndId linkData
-  (_, qUri) <-
-    createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys
-      `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
+  (connId, _, qUri) <- createLinkQueue c nm userId enableNtfs SCMContact params subMode qd $ \connId -> mapM_ (storeAddressRatchetKeys c connId) plpRatchetKeys
   let SMPQueueUri _ SMPQueueAddress {senderId = actualSndId} = qUri
   unless (actualSndId == sndId) $ throwE $ INTERNAL "createConnectionForLink: sender ID mismatch"
   pure connId
 
+-- | Prepare one-time invitation link (no network, no database).
+prepareInvitationLink' :: AgentClient -> UserId -> CR.InitialKeys -> Maybe SMPServerWithAuth -> AM (ConnectionRequestUri 'CMInvitation, PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448))
+prepareInvitationLink' c userId pqInitKeys srv_ = do
+  g <- asks random
+  srvWithAuth <- maybe (getSMPServer c userId) pure srv_
+  e2eVR <- asks $ e2eEncryptVRange . config
+  rootKey <- atomically $ C.generateKeyPair g
+  (pks, e2eRcvParams) <- liftIO $ CR.generateRcvE2EParams g (maxVersion e2eVR) (CR.initialPQEncryption True pqInitKeys)
+  prepareLinkParams rootKey Nothing Nothing pqInitKeys srvWithAuth QMMessaging (`CRInvitationUri` toVersionRangeT e2eRcvParams e2eVR) pks
+
+-- | Create connection for prepared invitation link (single network call).
+createInvitationForLink' :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> ConnectionRequestUri 'CMInvitation -> PreparedLinkParams (CR.RcvE2EPrivRatchetParams 'C.X448) -> UserConnLinkData 'CMInvitation -> SubscriptionMode -> AM (ConnId, CreatedConnLink 'CMInvitation)
+createInvitationForLink' c nm userId enableNtfs connReq params@PreparedLinkParams {plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpInitKeys, plpRatchetKeys} userLinkData subMode = do
+  g <- asks random
+  AgentConfig {smpAgentVRange} <- asks config
+  let CRInvitationUri ConnReqUriData {crSmpQueues = qUri@(SMPQueueUri _ SMPQueueAddress {senderId = sndId}) :| _} _ = connReq
+      md = SL.encodeSignUserData SCMInvitation plpRootPrivKey smpAgentVRange userLinkData
+  srvData <- liftError id $ SL.encryptLinkData g (SL.invShortLinkKdf plpLinkKey) (plpSignedFixedData, md)
+  let qd = CQRMessaging $ Just CQRData {linkKey = plpLinkKey, privSigKey = plpRootPrivKey, srvReq = (sndId, srvData)}
+  (connId, rq, qUri') <- createLinkQueue c nm userId enableNtfs SCMInvitation params subMode qd $ \connId -> withStore' c $ \db -> createRatchetX3dhKeys db connId plpRatchetKeys
+  (connId,) <$> connReqWithShortLink plpInitKeys qUri connReq qUri' rq
+
+-- | Generate queue keys and sign fixed link data (no network, no database).
+prepareLinkParams :: ConnectionModeI c => C.KeyPairEd25519 -> Maybe ByteString -> Maybe CRClientData -> CR.InitialKeys -> SMPServerWithAuth -> QueueMode -> (ConnReqUriData -> ConnectionRequestUri c) -> k -> AM (ConnectionRequestUri c, PreparedLinkParams k)
+prepareLinkParams rootKey@(_, plpRootPrivKey) linkEntityId clientData plpInitKeys plpSrvWithAuth@(ProtoServerWithAuth srv _) qm mkConnReq plpRatchetKeys = do
+  g <- asks random
+  AgentConfig {smpClientVRange, smpAgentVRange} <- asks config
+  plpNonce@(C.CbNonce corrId) <- atomically $ C.randomCbNonce g
+  plpQueueE2EKeys@(e2ePubKey, _) <- atomically $ C.generateKeyPair g
+  let sndId = SMP.EntityId $ B.take 24 $ C.sha3_384 corrId
+      qUri = SMPQueueUri smpClientVRange $ SMPQueueAddress srv sndId e2ePubKey (Just qm)
+      connReq = mkConnReq $ ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData
+      (plpLinkKey, plpSignedFixedData) = SL.encodeSignFixedData rootKey smpAgentVRange connReq linkEntityId
+  pure (connReq, PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpLinkKey, plpRootPrivKey, plpSignedFixedData, plpSrvWithAuth, plpInitKeys, plpRatchetKeys})
+
+-- | Create connection and its queue with link data; the connection is deleted when either step fails.
+createLinkQueue :: AgentClient -> NetworkRequestMode -> UserId -> Bool -> SConnectionMode c -> PreparedLinkParams k -> SubscriptionMode -> ClntQueueReqData -> (ConnId -> AM ()) -> AM (ConnId, RcvQueue, SMPQueueUri)
+createLinkQueue c nm userId enableNtfs cMode PreparedLinkParams {plpNonce, plpQueueE2EKeys, plpSrvWithAuth, plpInitKeys} subMode qd storeKeys = do
+  connId <- newConnNoQueues c userId enableNtfs cMode (CR.connPQEncryption plpInitKeys)
+  uncurry (connId,,)
+    <$> (storeKeys connId >> createRcvQueue c nm userId connId plpSrvWithAuth enableNtfs subMode (Just plpNonce) qd plpQueueE2EKeys)
+      `catchE` \e -> withStore' c (`deleteConnRecord` connId) >> throwE e
+
 generateAddressRatchetKeys :: CR.InitialKeys -> AM (AddressRatchetKeys, (RatchetKeyId, CR.RcvE2EPrivRatchetParams 'C.X448))
 generateAddressRatchetKeys pqInitKeys = do
   g <- asks random
@@ -1197,7 +1248,7 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
     prepareContactLinkData ConnData {} rq@RcvQueue {shortLink} (UserContactLinkData ucd) = do
       liftEitherWith (CMD PROHIBITED . ("setConnShortLink: " <>)) $ validateOwners shortLink ucd
       g <- asks random
-      AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
+      AgentConfig {smpAgentVRange} <- asks config
       -- rotate makes fresh keys from InitialKeys; otherwise keep current keys or create based on InitialKeys if there are no ratchet keys
       let currKeys = currentAddressRatchetKeys c connId
       ratchetKeys <- case pqKeys_ of
@@ -1207,32 +1258,47 @@ setConnShortLink' c nm connId cMode userLinkData clientData rotateKeys pqKeys_ =
         Nothing -> currKeys
       let ud = UserContactLinkData ucd {ratchetKeys}
           cslContact = CSLContact SLSServer CCTContact (qServer rq)
-      case shortLink of
-        Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
+      (ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData}, k) <- case shortLink of
+        Just creds@ShortLinkCreds {shortLinkId, shortLinkKey} -> do
           let (linkId, k) = SL.contactShortLinkKdf shortLinkKey
           unless (shortLinkId == linkId) $ throwE $ INTERNAL "setConnShortLink: link ID is not derived from link"
-          d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
-          pure (rq, linkId, cslContact shortLinkKey, (linkEncFixedData, d))
-        Nothing -> do
-          sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
-          let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
-              connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) ratchetKeys
-              (linkKey, linkData) = SL.encodeSignLinkData sigKeys smpAgentVRange connReq Nothing ud
-              (linkId, k) = SL.contactShortLinkKdf linkKey
-          srvData <- liftError id $ SL.encryptLinkData g k linkData
-          let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing (fst srvData)
-          withStore' c $ \db -> updateShortLinkCreds db rq slCreds
-          pure (rq, linkId, cslContact linkKey, srvData)
-    prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
-    prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
-      Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
-        g <- asks random
-        AgentConfig {smpAgentVRange} <- asks config
-        let k = SL.invShortLinkKdf shortLinkKey
-        d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
-        let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
-        pure (rq, shortLinkId, sl, (linkEncFixedData, d))
-      Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
+          pure (creds, k)
+        Nothing -> newContactLinkCreds c rq clientData
+      d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMContact linkPrivSigKey smpAgentVRange ud
+      pure (rq, shortLinkId, cslContact shortLinkKey, (linkEncFixedData, d))
+
+newContactLinkCreds :: AgentClient -> RcvQueue -> Maybe CRClientData -> AM (ShortLinkCreds, C.SbKey)
+newContactLinkCreds c rq clientData = do
+  g <- asks random
+  AgentConfig {smpClientVRange = vr, smpAgentVRange} <- asks config
+  sigKeys@(_, privSigKey) <- atomically $ C.generateKeyPair @'C.Ed25519 g
+  let qUri = SMPQueueUri vr $ (rcvSMPQueueAddress rq) {queueMode = Just QMContact}
+      connReq = CRContactUri (ConnReqUriData SSSimplex smpAgentVRange [qUri] clientData) Nothing
+      (linkKey, fixedData) = SL.encodeSignFixedData sigKeys smpAgentVRange connReq Nothing
+      (linkId, k) = SL.contactShortLinkKdf linkKey
+  encFixedData <- liftError id $ SL.encryptFixedData g k fixedData
+  let slCreds = ShortLinkCreds linkId linkKey privSigKey Nothing encFixedData
+  withStore' c $ \db -> updateShortLinkCreds db rq slCreds
+  pure (slCreds, k)
+
+prepareInvLinkData :: RcvQueue -> UserConnLinkData 'CMInvitation -> AM (RcvQueue, SMP.LinkId, ConnShortLink 'CMInvitation, QueueLinkData)
+prepareInvLinkData rq@RcvQueue {shortLink} ud = case shortLink of
+  Just ShortLinkCreds {shortLinkId, shortLinkKey, linkPrivSigKey, linkEncFixedData} -> do
+    g <- asks random
+    AgentConfig {smpAgentVRange} <- asks config
+    let k = SL.invShortLinkKdf shortLinkKey
+    d <- liftError id $ SL.encryptUserData g k $ SL.encodeSignUserData SCMInvitation linkPrivSigKey smpAgentVRange ud
+    let sl = CSLInvitation SLSServer (qServer rq) shortLinkId shortLinkKey
+    pure (rq, shortLinkId, sl, (linkEncFixedData, d))
+  Nothing -> throwE $ CMD PROHIBITED "setConnShortLink: no ShortLinkCreds in invitation"
+
+prepareConnShortLink' :: AgentClient -> ConnId -> Maybe CRClientData -> AM (ConnShortLink 'CMContact)
+prepareConnShortLink' c connId clientData =
+  withConnLock c connId "prepareConnShortLink" $
+    withStore c (`getConn` connId) >>= \case
+      SomeConn _ (ContactConnection _ rq@RcvQueue {shortLink}) ->
+        CSLContact SLSServer CCTContact (qServer rq) . shortLinkKey <$> maybe (fst <$> newContactLinkCreds c rq clientData) pure shortLink
+      _ -> throwE $ CMD PROHIBITED "prepareConnShortLink: not contact address"
 
 deleteConnShortLink' :: AgentClient -> NetworkRequestMode -> ConnId -> SConnectionMode c -> AM ()
 deleteConnShortLink' c nm connId cMode =
@@ -1443,11 +1509,11 @@ newConnToAccept c userId connId enableNtfs invId pqSup = do
       pure (connId', CRBRatchet $ ratchetVerifyCodes ratchetState)
 
 newConnToAcceptDR :: AgentClient -> UserId -> ConnId -> DRInvitation -> Bool -> AM ConnData
-newConnToAcceptDR c userId connId DRInvitation {agentVersion, pqSupport} enableNtfs = do
+newConnToAcceptDR c userId connId DRInvitation {ratchetState, agentVersion, pqSupport} enableNtfs = do
   g <- asks random
   let cData = ConnData {userId, connId, connAgentVersion = agentVersion, enableNtfs, lastExternalSndId = 0, deleted = False, ratchetSyncState = RSOk, pqSupport, serviceRequestExpiresAt = Nothing}
-  connId' <- withStore c $ \db -> createNewConn db g cData SCMInvitation
-  pure (cData {connId = connId'} :: ConnData)
+  withStore c $ \db ->
+    createNewConn db g cData SCMInvitation $>>= \connId' -> Right (cData {connId = connId'} :: ConnData) <$ createRatchet db connId' ratchetState
 
 joinConn :: AgentClient -> NetworkRequestMode -> UserId -> ConnId -> Bool -> ConnectionRequestUri c -> ConnInfo -> PQSupport -> SubscriptionMode -> AM SndQueueSecured
 joinConn c nm userId connId enableNtfs cReq cInfo pqSupport subMode = do
@@ -1505,9 +1571,8 @@ startJoinInvitationDR c userId ConnData {connId} DRInvitation {ratchetState, rep
   qInfo <- maybe (throwE $ AGENT A_VERSION) pure $ replyQueue `proveCompatible` clientVRange
   (q, _) <- lift $ newSndQueue userId connId qInfo Nothing
   withStore c $ \db -> runExceptT $ do
-    liftIO $ lockConnForUpdate db connId
-    liftIO $ createRatchet db connId ratchetState
-    ExceptT $ updateNewConnSnd db connId q
+    sq <- ExceptT $ updateNewConnSnd db connId q
+    sq <$ liftIO (createRatchet db connId ratchetState)
 
 connRequestAgentVersion :: AgentClient -> ConnectionRequestUri c -> IO (Maybe VersionSMPA)
 connRequestAgentVersion c cReq = withAgentEnv' c $ case cReq of
diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs
index 3ea9f3b1a..7625092d1 100644
--- a/src/Simplex/Messaging/Agent/Protocol.hs
+++ b/src/Simplex/Messaging/Agent/Protocol.hs
@@ -246,7 +246,6 @@ import Simplex.Messaging.Crypto.Ratchet
     RcvE2ERatchetParams,
     RcvE2ERatchetParamsUri,
     SndE2ERatchetParams,
-    RcvE2EPrivRatchetParams,
     pattern PQSupportOff,
     pattern PQSupportOn,
   )
@@ -1627,7 +1626,7 @@ newtype LinkKey = LinkKey ByteString -- sha3-256(fixed_data)
 instance ToField LinkKey where toField (LinkKey s) = toField $ Binary s
 
 -- | Parameters for creating a connection with a prepared link.
-data PreparedLinkParams = PreparedLinkParams
+data PreparedLinkParams k = PreparedLinkParams
   { -- | Correlation ID / determines sender ID
     plpNonce :: C.CbNonce,
     -- | Queue E2EE DH key pair
@@ -1642,8 +1641,8 @@ data PreparedLinkParams = PreparedLinkParams
     plpSrvWithAuth :: SMPServerWithAuth,
     -- | Initial PQ keys
     plpInitKeys :: InitialKeys,
-    -- | Contact address double ratchet keys
-    plpAddressKeys :: Maybe (RatchetKeyId, RcvE2EPrivRatchetParams 'C.X448)
+    -- | Contact address double ratchet keys or invitation X3DH keys
+    plpRatchetKeys :: k
   }
 
 instance ConnectionModeI c => ToField (ConnectionLink c) where toField = toField . Binary . strEncode
diff --git a/src/Simplex/Messaging/Crypto/ShortLink.hs b/src/Simplex/Messaging/Crypto/ShortLink.hs
index 840366543..2ebd8d350 100644
--- a/src/Simplex/Messaging/Crypto/ShortLink.hs
+++ b/src/Simplex/Messaging/Crypto/ShortLink.hs
@@ -17,6 +17,7 @@ module Simplex.Messaging.Crypto.ShortLink
     encodeSignUserData,
     newOwnerAuth,
     encryptLinkData,
+    encryptFixedData,
     encryptUserData,
     decryptLinkData,
   )
@@ -84,9 +85,10 @@ newOwnerAuth g ownerId signingKey = do
   pure (ownerPrivKey, OwnerAuth {ownerId, ownerKey, authOwnerSig})
 
 encryptLinkData :: TVar ChaChaDRG -> C.SbKey -> (ByteString, ByteString) -> ExceptT AgentErrorType IO QueueLinkData
-encryptLinkData g k = bimapM (encrypt fixedDataPaddedLength) (encrypt userDataPaddedLength)
-  where
-    encrypt len = encryptData g k len
+encryptLinkData g k = bimapM (encryptFixedData g k) (encryptUserData g k)
+
+encryptFixedData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
+encryptFixedData g k s = encryptData g k fixedDataPaddedLength s
 
 encryptUserData :: TVar ChaChaDRG -> C.SbKey -> ByteString -> ExceptT AgentErrorType IO EncDataBytes
 encryptUserData g k s = encryptData g k userDataPaddedLength s
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index bdc37f6e2..090e8b2f3 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -92,7 +92,7 @@ import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Env (..), InitialAg
 import Simplex.Messaging.Agent.Protocol hiding (CON, CONF, INFO, REQ, SENT)
 import qualified Simplex.Messaging.Agent.Protocol as A
 import Simplex.Messaging.Agent.Store (Connection' (..), SomeConn' (..), StoredRcvQueue (..))
-import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getRatchetX3dhKeys)
+import Simplex.Messaging.Agent.Store.AgentStore (deleteRatchetKeyHashesExpired, getConn, getConnIds, getRatchetX3dhKeys)
 import Simplex.Messaging.Agent.Store.Common (DBStore (..), withTransaction)
 import Simplex.Messaging.Agent.Store.Interface
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -371,6 +371,10 @@ functionalAPITests ps = do
       testAddDRViaSetConnShortLink ps
     it "should resume DR accept after a transient failure (reuse the send queue and ratchet)" $
       testAcceptContactDRResumeAfterOffline ps
+    it "should store the ratchet when DR accept is prepared" $
+      withSmpServer ps $ testAcceptContactDRPrepared False
+    it "should create the ratchet at DR accept when the prepared connection has none" $
+      withSmpServer ps $ testAcceptContactDRPrepared True
     it "should support rejecting contact request" $
       withSmpServer ps testRejectContactRequest
     it "should communicate rejection reason via double ratchet" $
@@ -421,6 +425,10 @@ functionalAPITests ps = do
       it "should connect via added contact short link after restart" $ testAddContactShortLinkRestart ps
     it "should create and get short links with the old contact queues" $ testOldContactQueueShortLink ps
     it "should connect via prepared connection link" $ testPrepareCreateConnectionLink ps
+    it "should connect via prepared invitation link" $ testPrepareCreateInvitationLink ps
+    it "should not create connection for prepared invitation link with too large data" $ testPrepareInvitationLinkTooLarge ps
+    it "should not create connection for prepared contact link with too large data" $ testPrepareContactLinkTooLarge ps
+    it "should connect via short link prepared for existing contact connection" $ testPrepareConnShortLink ps
   describe "Message delivery" $ do
     describe "update connection agent version on received messages" $ do
       it "should increase if compatible, shouldn'ps decrease" $
@@ -1241,6 +1249,30 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
     ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
     allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
 
+testAcceptContactDRPrepared :: HasCallStack => Bool -> IO ()
+testAcceptContactDRPrepared ratchetDeleted =
+  withAgentClients2 $ \alice bob -> runRight_ $ do
+    let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
+        pqEnc = PQEncryption $ pqConnectionMode IKPQOn PQSupportOn
+    (_, CCLink connReq _) <- A.createConnection alice NRMInteractive 1 True True SCMContact (Just userLinkData) Nothing IKPQOn True SMSubscribe
+    (aliceId, CRBRatchet codes) <- A.prepareConnectionToJoin bob 1 True connReq PQSupportOn
+    void $ A.joinConnection bob NRMInteractive 1 aliceId True connReq "bob's connInfo" PQSupportOn SMSubscribe
+    ("", _, A.REQ invId _ _ "bob's connInfo" (CRBRatchet reqCodes) _) <- get alice
+    (bobId, CRBRatchet acceptCodes) <- A.prepareConnectionToAccept alice 1 True invId PQSupportOn
+    liftIO $ do
+      reqCodes `shouldBe` codes
+      acceptCodes `shouldBe` codes
+    if ratchetDeleted
+      then do
+        liftIO $ withTransaction (store $ agentEnv alice) (`DB.execute_` "DELETE FROM ratchets")
+        Left (CONN NOT_FOUND _) <- tryError $ getConnectionVerifyCodes alice bobId
+        pure ()
+      else getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
+    void $ acceptContact alice 1 bobId True invId "alice's connInfo" PQSupportOn SMSubscribe
+    ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
+    allowConfirmGreet alice bobId bob aliceId confId IKPQOn pqEnc
+    getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
+
 runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
   (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
@@ -2055,6 +2087,64 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
     get b ##> ("", bId, CON)
     exchangeGreetings a aId b bId
 
+testPrepareCreateInvitationLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareCreateInvitationLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
+  let userData = UserLinkData "test user data"
+  runRight_ $ do
+    (preparedReq, preparedParams@PreparedLinkParams {plpLinkKey}) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
+    (bId, CCLink connReq (Just shortLink@(CSLInvitation _ _ _ linkKey))) <- A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData userData) SMSubscribe
+    liftIO $ linkKey `shouldBe` plpLinkKey
+    (_, connData', connReq') <- getConnShortLink b 1 shortLink
+    liftIO $ connReq' `shouldBe` preparedReq
+    liftIO $ connReq `shouldNotBe` preparedReq
+    liftIO $ linkUserData connData' `shouldBe` userData
+    testJoinConn_ False True a bId b connReq
+
+testPrepareInvitationLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareInvitationLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
+  runRight_ $ do
+    (preparedReq, preparedParams) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
+    Left (A.CMD LARGE _) <- tryError $ A.createInvitationForLink a NRMInteractive 1 True preparedReq preparedParams (UserInvLinkData $ UserLinkData $ B.replicate 14000 'a') SMSubscribe
+    pure ()
+  withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
+
+testPrepareContactLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareContactLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
+  let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData $ B.replicate 14000 'a', ratchetKeys = Nothing}
+  g <- C.newRandom
+  rootKey <- atomically $ C.generateKeyPair g
+  linkEntId <- atomically $ C.randomBytes 32 g
+  runRight_ $ do
+    (ccLink, preparedParams) <- A.prepareConnectionLink a 1 rootKey linkEntId True Nothing CR.IKPQOn True Nothing
+    Left (A.CMD LARGE _) <- tryError $ A.createConnectionForLink a NRMInteractive 1 True ccLink preparedParams (UserContactLinkData userCtData) SMSubscribe
+    pure ()
+  withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
+
+testPrepareConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
+  let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
+  runRight_ $ do
+    (contactId, CCLink _ Nothing) <- A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe
+    shortLink <- A.prepareConnShortLink a contactId Nothing
+    shortLink' <- A.prepareConnShortLink a contactId Nothing
+    liftIO $ shortLink' `shouldBe` shortLink
+    shortLink'' <- A.setConnShortLink a NRMInteractive contactId SCMContact (UserContactLinkData userCtData) Nothing False Nothing
+    liftIO $ shortLink'' `shouldBe` shortLink
+    (_, ContactLinkData _ userCtData', connReq) <- getConnShortLink b 1 shortLink
+    liftIO $ userCtData' `shouldBe` userCtData
+    (aId, sndSecure) <- joinConnection b 1 True connReq "bob's connInfo" SMSubscribe
+    liftIO $ sndSecure `shouldBe` False
+    ("", _, REQ invId _ "bob's connInfo") <- get a
+    (bId, _) <- A.prepareConnectionToAccept a 1 True invId PQSupportOn
+    sndSecure' <- acceptContact a 1 bId True invId "alice's connInfo" PQSupportOn SMSubscribe
+    liftIO $ sndSecure' `shouldBe` True
+    ("", _, CONF confId _ "alice's connInfo") <- get b
+    allowConnection b aId confId "bob's connInfo"
+    get a ##> ("", bId, INFO "bob's connInfo")
+    get a ##> ("", bId, CON)
+    get b ##> ("", aId, CON)
+    exchangeGreetings a bId b aId
+
 connReqWithKeys :: BinaryConnectionRequestUri m -> Maybe AddressRatchetKeys -> ConnectionRequestUri m
 connReqWithKeys cr rk = case cr of
   BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams

From 8a80727fa59d862ea8c1e1e874145fa2fe565201 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 11 Oct 2026 07:37:33 +0100
Subject: [PATCH 12/20] smp server: delayed AUTH responses (#1937)

* smp server: delayed AUTH responses

* plan

* update

* simplify

* simplify

* stat when sent without delay

* update schema

* round up response time to the nearest delay multiple

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 plans/2026-10-09-auth-error-delay.md          | 52 +++++++++++++++
 simplexmq.cabal                               |  1 -
 src/Simplex/Messaging/Server.hs               | 41 ++++++++++--
 src/Simplex/Messaging/Server/Env/STM.hs       |  5 ++
 src/Simplex/Messaging/Server/Main.hs          |  1 +
 src/Simplex/Messaging/Server/Main/Init.hs     |  4 +-
 src/Simplex/Messaging/Server/Prometheus.hs    |  5 ++
 .../QueueStore/Postgres/server_schema.sql     |  2 -
 src/Simplex/Messaging/Server/Stats.hs         |  8 +++
 tests/SMPClient.hs                            |  1 +
 tests/SMPProxyTests.hs                        | 17 ++++-
 tests/ServerTests.hs                          | 66 +++++++++++++------
 12 files changed, 174 insertions(+), 29 deletions(-)
 create mode 100644 plans/2026-10-09-auth-error-delay.md

diff --git a/plans/2026-10-09-auth-error-delay.md b/plans/2026-10-09-auth-error-delay.md
new file mode 100644
index 000000000..5ac82c8e6
--- /dev/null
+++ b/plans/2026-10-09-auth-error-delay.md
@@ -0,0 +1,52 @@
+# Delayed AUTH error responses
+
+## Decisions
+
+- Responses that include `ERR AUTH` are sent at the next multiple of the delay after the start time.
+- Delayed response sets:
+
+  | Source | Responses sent together | Start time |
+  |---|---|---|
+  | `receive`, failed verification | verification and parsing errors of one received block | block receipt |
+  | `client`, command processing | responses and messages of one batch | batch read from `rcvQ` |
+  | `RFWD`, forwarded command | the `RRES` of that command | start of forwarded command processing |
+
+- A thread created by `forkClient` writes the responses to the send queue.
+- Delay 0: the responses are written to the send queue directly.
+- `authDelayExceeded`: incremented when processing took longer than the delay.
+  - Prometheus counter `simplex_smp_auth_delay_exceeded`.
+  - Not saved in the stats backup.
+  - Not in the daily stats log.
+- Configuration:
+
+  | Item | Value |
+  |---|---|
+  | INI section | `TRANSPORT` |
+  | INI key | `auth_error_delay_ms` |
+  | default | 50 |
+  | `ServerConfig` field | `authErrorDelay`, microseconds |
+  | test servers | 20 ms |
+
+- AUTH timing test: elapsed time of 5 requests, test servers' delay.
+- Out of scope: NTF and XFTP servers.
+
+## Mechanics
+
+- `Server.hs`:
+  - `isAuthError`: response is `ERR AUTH`.
+  - `sendResponses`: responses with `ERR AUTH` to `sendAfterDelay`, others to the send queue.
+  - `sendAfterDelay`: writes responses to the send queue at the next multiple of the delay.
+  - `receive`: block receipt time from the `rcvActiveAt` reading.
+  - `client`: batch time.
+  - `processForwardedCommand`: start time.
+- `Server/Env/STM.hs`: `authErrorDelay` field, `defaultAuthErrorDelayMs`.
+- `Server/Stats.hs`: `authDelayExceeded` in `ServerStats` and `ServerStatsData`.
+- `Server/Prometheus.hs`: `simplex_smp_auth_delay_exceeded`.
+- `Server/Main.hs`: INI value.
+- `Server/Main/Init.hs`: INI template line.
+- `simplexmq.cabal`: `timeit` removed from the test suite.
+- `tests/SMPClient.hs`: `authErrorDelay = 20000`.
+- `tests/ServerTests.hs`:
+  - delayed AUTH for wrong key, absent queue, absent link and suspended queue; immediate `SOK`.
+  - AUTH timing test measures elapsed time.
+- `tests/SMPProxyTests.hs`: delayed AUTH to forwarded `SEND` and `LGET`.
diff --git a/simplexmq.cabal b/simplexmq.cabal
index 0153db450..11384f5ae 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -640,7 +640,6 @@ test-suite simplexmq-test
     , stm
     , text
     , time
-    , timeit ==2.0.*
     , tls >=1.9.0 && <1.10
     , transformers
     , unliftio
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 600c9d287..e2cef6f50 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -1145,14 +1145,16 @@ cancelSub s = case subThread s of
 type VerifiedTransmissionOrError s = Either (Transmission BrokerMsg) (VerifiedTransmission s)
 
 receive :: forall c s. (Transport c, MsgStoreClass s) => THandleSMP c 'TServer -> s -> Client s -> M s ()
-receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, sndQ, rcvActiveAt} = do
+receive h@THandle {params = THandleParams {thAuth, sessionId}} ms c@Client {rcvQ, rcvActiveAt} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " receive"
   sa <- asks serverActive
   stats <- asks serverStats
+  authDelay <- asks $ authErrorDelay . config
   liftIO $ forever $ do
     ts <- tGetServer h
     unlessM (readTVarIO sa) $ throwIO $ userError "server stopped"
-    atomically . (writeTVar rcvActiveAt $!) =<< getSystemTime
+    receivedAt <- getSystemTime
+    atomically $ writeTVar rcvActiveAt $! receivedAt
     let (es, ts') = partitionEithers $ L.toList ts
         errs = map (second ERR) es
     errs' <- case ts' of
@@ -1168,7 +1170,7 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
         mapM_ (atomically . writeTBQueue rcvQ) $ L.nonEmpty cmds
         pure $ errs ++ errs'
       [] -> pure errs
-    mapM_ (atomically . writeTBQueue sndQ . (,[])) $ L.nonEmpty errs'
+    mapM_ (sendResponses c stats authDelay receivedAt . (,[])) $ L.nonEmpty errs'
   where
     sameParty :: SParty p -> SignedTransmission Cmd -> Bool
     sameParty p (_, _, (_, _, Cmd p' _)) = isJust $ testEquality p p'
@@ -1191,6 +1193,27 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ,
             GET -> incStat $ msgGetAuth stats
             _ -> pure ()
 
+isAuthError :: Transmission BrokerMsg -> Bool
+isAuthError (_, _, r) = case r of
+  ERR AUTH -> True
+  _ -> False
+
+sendResponses :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
+sendResponses c@Client {sndQ} stats authDelay since rs@(ts, _)
+  | any isAuthError ts = sendAfterDelay c stats authDelay since rs
+  | otherwise = atomically $ writeTBQueue sndQ rs
+
+sendAfterDelay :: Client s -> ServerStats -> Int64 -> SystemTime -> (NonEmpty (Transmission BrokerMsg), [Transmission BrokerMsg]) -> IO ()
+sendAfterDelay c@Client {sndQ, clientTHParams = THandleParams {sessionId}} stats delay since rs
+  | delay > 0 = do
+      elapsed <- subtract (microseconds since) . microseconds <$> getSystemTime
+      when (elapsed >= delay) $ incStat $ authDelayExceeded stats
+      forkClient c (B.unpack $ "client $" <> encode sessionId <> " auth") $ threadDelay' (delay - elapsed `mod` delay) >> write
+  | otherwise = write
+  where
+    write = atomically $ writeTBQueue sndQ rs
+    microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000)
+
 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
 send th c@Client {sndQ, msgQ, clientTHParams = THandleParams {sessionId}} = do
   labelMyThread . B.unpack $ "client $" <> encode sessionId <> " send"
@@ -1374,15 +1397,18 @@ client
   ms
   clnt@Client {clientId, rcvQ, sndQ, msgQ, clientTHParams = thParams'@THandleParams {sessionId}, procThreads} = do
     labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
+    stats <- asks serverStats
+    authDelay <- asks $ authErrorDelay . config
     let clntServiceId = (\THClientService {serviceId} -> serviceId) <$> (peerClientService =<< thAuth thParams')
         process batchSubs t acc@(rs, msgs) =
           (maybe acc (\(!r, !msg_) -> (r : rs, maybe msgs (: msgs) msg_)))
             <$> processCommand clntServiceId batchSubs t
     forever $ do
       batch <- atomically (readTBQueue rcvQ)
+      processedAt <- liftIO getSystemTime
       batchSubs <- prepareBatchSubs clntServiceId batch
       foldrM (process batchSubs) ([], []) batch
-        >>= \(rs_, msgs) -> mapM_ (atomically . writeTBQueue sndQ . (,msgs)) (L.nonEmpty rs_)
+        >>= \(rs_, msgs) -> mapM_ (liftIO . sendResponses clnt stats authDelay processedAt . (,msgs)) (L.nonEmpty rs_)
   where
     prepareBatchSubs ::
       Maybe ServiceId ->
@@ -2119,6 +2145,7 @@ client
 
         processForwardedCommand :: EncFwdTransmission -> M s (Maybe BrokerMsg)
         processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do
+          startedAt <- liftIO getSystemTime
           THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
           sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
           proxyNonce <- liftEitherWith (const CRYPTO) $ C.cbNonce $ bs corrId
@@ -2162,7 +2189,11 @@ client
               _ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
           stats <- asks serverStats
           incStat $ pMsgFwdsRecv stats
-          traverse encodeResp r_
+          traverse encodeResp r_ >>= \case
+            Just rres | any isAuthError r_ -> do
+              authDelay <- asks $ authErrorDelay . config
+              Nothing <$ liftIO (sendAfterDelay clnt stats authDelay startedAt ([(corrId, NoEntity, rres)], []))
+            rres_ -> pure rres_
           where
             rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s)
             rejectOrVerify clntThAuth = \case
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index ca59f75f6..2c1843e51 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -68,6 +68,7 @@ module Simplex.Messaging.Server.Env.STM
     defaultInactiveClientExpiration,
     defaultProxyClientConcurrency,
     defaultNameResolverConcurrency,
+    defaultAuthErrorDelayMs,
     defaultMaxJournalMsgCount,
     defaultMaxJournalStateLines,
     defaultIdleQueueInterval,
@@ -187,6 +188,7 @@ data ServerConfig s = ServerConfig
     ntfDeliveryInterval :: Int,
     -- | interval between sending pending END events to unsubscribed clients, seconds
     pendingENDInterval :: Int,
+    authErrorDelay :: Int64,
     smpCredentials :: ServerCredentials,
     httpCredentials :: Maybe ServerCredentials,
     -- | SMP client-server protocol version range
@@ -255,6 +257,9 @@ defaultProxyClientConcurrency = 32
 defaultNameResolverConcurrency :: Int
 defaultNameResolverConcurrency = 1000
 
+defaultAuthErrorDelayMs :: Int64
+defaultAuthErrorDelayMs = 50
+
 journalMsgStoreDepth :: Int
 journalMsgStoreDepth = 5
 
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 138a25fc0..4a3c909ed 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -580,6 +580,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               prometheusMetricsFile = combine logPath "smp-server-metrics.txt",
               pendingENDInterval = 15000000, -- 15 seconds
               ntfDeliveryInterval = 1500000, -- 1.5 second
+              authErrorDelay = 1000 * readIniDefault defaultAuthErrorDelayMs "TRANSPORT" "auth_error_delay_ms" ini,
               smpServerVRange = supportedServerSMPRelayVRange,
               transportConfig =
                 mkTransportServerConfig
diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs
index 89df1ad93..b82061ca3 100644
--- a/src/Simplex/Messaging/Server/Main/Init.hs
+++ b/src/Simplex/Messaging/Server/Main/Init.hs
@@ -130,7 +130,9 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
     <> ("host = " <> T.pack host <> "\n")
     <> ("port = " <> defaultServerPorts <> "\n")
     <> "log_tls_errors = off\n\n\
-        \# Use `websockets = 443` to run websockets server in addition to plain TLS.\n\
+        \# Minimum time to respond with AUTH error, milliseconds.\n"
+    <> ("# auth_error_delay_ms = " <> tshow defaultAuthErrorDelayMs <> "\n\n")
+    <> "# Use `websockets = 443` to run websockets server in addition to plain TLS.\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"
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index 85d2624fd..864a2014f 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -126,6 +126,7 @@ prometheusMetrics sm rtm ts =
         _ntfServices,
         _rcvServicesSubMsg,
         _rcvServicesSubDuplicate,
+        _authDelayExceeded,
         _qCount,
         _msgCount,
         _ntfCount,
@@ -192,6 +193,10 @@ prometheusMetrics sm rtm ts =
       \# HELP simplex_smp_queues_notify_monthly Monthly active queues with notifications.\n\
       \# TYPE simplex_smp_queues_notify_monthly gauge\n\
       \simplex_smp_queues_notify_monthly " <> mstr (monthCount psNtf) <> "\n# monthCountNtf\n\
+      \\n\
+      \# HELP simplex_smp_auth_delay_exceeded Responses with AUTH errors sent without delay, as processing took longer than the delay.\n\
+      \# TYPE simplex_smp_auth_delay_exceeded counter\n\
+      \simplex_smp_auth_delay_exceeded " <> mshow _authDelayExceeded <> "\n# authDelayExceeded\n\
       \\n"
     subscriptions =
       "# Subscriptions\n\
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
index c39b82990..fcaaf7257 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
@@ -1,6 +1,5 @@
 
 
-
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -555,4 +554,3 @@ ALTER TABLE ONLY smp_server.msg_queues
 
 
 
-
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index 11a7de666..c1c599822 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -128,6 +128,7 @@ data ServerStats = ServerStats
     ntfServices :: ServiceStats,
     rcvServicesSubMsg :: IORef Int,
     rcvServicesSubDuplicate :: IORef Int,
+    authDelayExceeded :: IORef Int,
     qCount :: IORef Int,
     msgCount :: IORef Int,
     ntfCount :: IORef Int,
@@ -190,6 +191,7 @@ data ServerStatsData = ServerStatsData
     _rcvServices :: ServiceStatsData,
     _rcvServicesSubMsg :: Int,
     _rcvServicesSubDuplicate :: Int,
+    _authDelayExceeded :: Int,
     _qCount :: Int,
     _msgCount :: Int,
     _ntfCount :: Int,
@@ -254,6 +256,7 @@ newServerStats ts = do
   ntfServices <- newServiceStats
   rcvServicesSubMsg <- newIORef 0
   rcvServicesSubDuplicate <- newIORef 0
+  authDelayExceeded <- newIORef 0
   qCount <- newIORef 0
   msgCount <- newIORef 0
   ntfCount <- newIORef 0
@@ -315,6 +318,7 @@ newServerStats ts = do
         ntfServices,
         rcvServicesSubMsg,
         rcvServicesSubDuplicate,
+        authDelayExceeded,
         qCount,
         msgCount,
         ntfCount,
@@ -378,6 +382,7 @@ getServerStatsData s = do
   _ntfServices <- getServiceStatsData $ ntfServices s
   _rcvServicesSubMsg <- readIORef $ rcvServicesSubMsg s
   _rcvServicesSubDuplicate <- readIORef $ rcvServicesSubDuplicate s
+  _authDelayExceeded <- readIORef $ authDelayExceeded s
   _qCount <- readIORef $ qCount s
   _msgCount <- readIORef $ msgCount s
   _ntfCount <- readIORef $ ntfCount s
@@ -439,6 +444,7 @@ getServerStatsData s = do
         _ntfServices,
         _rcvServicesSubMsg,
         _rcvServicesSubDuplicate,
+        _authDelayExceeded,
         _qCount,
         _msgCount,
         _ntfCount,
@@ -503,6 +509,7 @@ setServerStats s d = do
   setServiceStats (ntfServices s) $! _ntfServices d
   writeIORef (rcvServicesSubMsg s) $! _rcvServicesSubMsg d
   writeIORef (rcvServicesSubDuplicate s) $! _rcvServicesSubDuplicate d
+  writeIORef (authDelayExceeded s) $! _authDelayExceeded d
   writeIORef (qCount s) $! _qCount d
   writeIORef (msgCount s) $! _msgCount d
   writeIORef (ntfCount s) $! _ntfCount d
@@ -705,6 +712,7 @@ instance StrEncoding ServerStatsData where
           _ntfServices,
           _rcvServicesSubMsg = 0,
           _rcvServicesSubDuplicate = 0,
+          _authDelayExceeded = 0,
           _qCount,
           _msgCount = 0,
           _ntfCount = 0,
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index f1d5af1db..2db4a9819 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -263,6 +263,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       prometheusMetricsFile = testPrometheusMetricsFile,
       pendingENDInterval = 500000,
       ntfDeliveryInterval = 200000,
+      authErrorDelay = 20000,
       smpCredentials =
         ServerCredentials
           { caCertificateFile = Just "tests/fixtures/ca.crt",
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 134093acc..62bb4a85e 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -26,7 +26,7 @@ import qualified Data.List.NonEmpty as L
 import Data.Time.Clock (getCurrentTime)
 import SMPAgentClient
 import SMPClient
-import ServerTests (decryptMsgV3, sendRecv)
+import ServerTests (decryptMsgV3, responseTime, sendRecv)
 import Simplex.Messaging.Agent hiding (createConnection, joinConnection, sendMessage)
 import qualified Simplex.Messaging.Agent as A
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..))
@@ -77,6 +77,8 @@ smpProxyTests = do
       testChangedFwdVersion
     it "proxy rejects forwarded correlation ID that is not 24 bytes" $ \_ ->
       testFwdCorrIdSize
+    it "relay delays AUTH errors to forwarded commands" $ \_ ->
+      testForwardedAuthErrorDelay
   describe "deliver message via SMP proxy" $ do
     let srv1 = SMPServer testHost testPort testKeyHash
         srv2 = SMPServer testHost2 testPort2 testKeyHash
@@ -490,6 +492,19 @@ testFwdCorrIdSize =
           (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission ""))
           reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
 
+testForwardedAuthErrorDelay :: IO ()
+testForwardedAuthErrorDelay =
+  withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
+    withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
+      g <- C.newRandom
+      ts <- getCurrentTime
+      pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
+      sess <- runExceptT' $ connectSMPProxiedRelay pc NRMInteractive testSMPServer2 Nothing
+      (sendTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxySMPMessage pc NRMInteractive sess Nothing (SMP.EntityId "1234") noMsgFlags "hello"
+      (getLinkTime, Left (PCEProtocolError SMP.AUTH)) <- responseTime $ runExceptT $ proxyGetSMPQueueLink pc NRMInteractive sess (SMP.EntityId "1234")
+      sendTime `shouldSatisfy` (>= 0.5)
+      getLinkTime `shouldSatisfy` (>= 0.5)
+
 -- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable
 -- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect,
 -- let any stored connection error expire, then require the proxy to establish the session (PKEY).
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 6165dfb46..89ac46144 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -36,6 +36,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.List (isPrefixOf)
 import Data.Maybe (catMaybes)
 import Data.String (IsString (..))
+import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
 import Text.Read (readMaybe)
 import Data.Type.Equality
 import qualified Data.X509.Validation as XV
@@ -58,7 +59,6 @@ import Simplex.Messaging.Transport.Credentials
 import Simplex.Messaging.Util (whenM)
 import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile)
 import System.IO (IOMode (..), withFile)
-import System.TimeIt (timeItT)
 import System.Timeout
 import Test.HUnit
 import Test.Hspec hiding (fit, it)
@@ -97,6 +97,7 @@ serverTests = do
   describe "Restore messages (old / v2)" testRestoreExpireMessages
   describe "Save prometheus metrics" testPrometheusMetrics
   describe "Timing of AUTH error" testTiming
+  describe "Delay of AUTH error" testAuthErrorDelay
   describe "Message notifications" $ do
     testMessageNotifications
     testMessageServiceNotifications
@@ -1274,21 +1275,21 @@ testTiming =
         smpTest2Cfg (cfgMS msType) supportedServerSMPRelayVRange t $ \rh sh ->
           testSameTiming rh sh tst msType
   where
-    testName :: (C.AuthAlg, C.AuthAlg, Int) -> String
-    testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, _) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
-    timingTests :: [(C.AuthAlg, C.AuthAlg, Int)]
+    testName :: (C.AuthAlg, C.AuthAlg) -> String
+    testName (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) = unwords ["queue key:", show goodKeyAlg, "/ used key:", show badKeyAlg]
+    timingTests :: [(C.AuthAlg, C.AuthAlg)]
     timingTests =
-      [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519, 200), -- correct key type
-      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448, 150),
-      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519, 200),
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519, 200),
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448, 150), -- correct key type
-        (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519, 200),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519, 200),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448, 150),
-        (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519, 200) -- correct key type
+      [ (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd25519), -- correct key type
+      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SEd448),
+      -- (C.AuthAlg C.SEd25519, C.AuthAlg C.SX25519),
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd25519),
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SEd448), -- correct key type
+        (C.AuthAlg C.SEd448, C.AuthAlg C.SX25519),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd25519),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SEd448),
+        (C.AuthAlg C.SX25519, C.AuthAlg C.SX25519) -- correct key type
       ]
-    timeRepeat n = fmap fst . timeItT . forM_ (replicate n ()) . const
+    timeRepeat = fmap fst . responseTime . replicateM_ 5
     similarTime t1 t2 msType
       | t1 <= t2 = abs (1 - t1 / t2) < diff
       | otherwise = similarTime t2 t1 msType
@@ -1297,8 +1298,8 @@ testTiming =
         diff = case msType of
           ASType SQSPostgres _ -> 0.45
           _ -> 0.3
-    testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg, Int) -> AStoreType -> Expectation
-    testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg, n) msType = do
+    testSameTiming :: forall c. Transport c => THandleSMP c 'TClient -> THandleSMP c 'TClient -> (C.AuthAlg, C.AuthAlg) -> AStoreType -> Expectation
+    testSameTiming rh sh (C.AuthAlg goodKeyAlg, C.AuthAlg badKeyAlg) msType = do
       g <- C.newRandom
       (rPub, rKey) <- atomically $ C.generateAuthKeyPair goodKeyAlg g
       (dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
@@ -1325,16 +1326,16 @@ testTiming =
         runTimingTest :: PartyI p => THandleSMP c 'TClient -> C.APrivateAuthKey -> EntityId -> Command p -> IO ()
         runTimingTest h badKey qId cmd = do
           threadDelay 100000
-          _ <- timeRepeat n $ do
+          _ <- timeRepeat $ do
             -- "warm up" the server
             Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           threadDelay 100000
-          timeWrongKey <- timeRepeat n $ do
+          timeWrongKey <- timeRepeat $ do
             Resp "cdabcdabcdabcdabcdabcdab" _ (ERR AUTH) <- signSendRecv h badKey ("cdabcdabcdabcdabcdabcdab", qId, cmd)
             return ()
           threadDelay 100000
-          timeNoQueue <- timeRepeat n $ do
+          timeNoQueue <- timeRepeat $ do
             Resp "dabcdabcdabcdabcdabcdabc" _ (ERR AUTH) <- signSendRecv h badKey ("dabcdabcdabcdabcdabcdabc", EntityId "1234", cmd)
             return ()
           let ok = similarTime timeNoQueue timeWrongKey msType
@@ -1347,6 +1348,33 @@ testTiming =
             ]
           ok `shouldBe` True
 
+testAuthErrorDelay :: SpecWith (ASrvTransport, AStoreType)
+testAuthErrorDelay =
+  it "should send AUTH errors after the delay and other responses without it" $ \(ATransport t, msType) ->
+    smpTest2Cfg (updateCfg (cfgMS msType) $ \cfg' -> cfg' {authErrorDelay = 500000}) supportedClientSMPRelayVRange t $ \rh sh -> do
+      g <- C.newRandom
+      (rPub, rKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (dhPub, _ :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
+      Resp "1" NoEntity (Ids rId sId _) <- signSendRecv rh rKey ("1", NoEntity, New rPub dhPub)
+      (_, badKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
+      (wrongKeyTime, Resp "2" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("2", rId, SUB)
+      (noQueueTime, Resp "3" _ (ERR AUTH)) <- responseTime $ signSendRecv rh badKey ("3", EntityId "1234", SUB)
+      (noLinkTime, Resp "4" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "4", EntityId "1234", LGET)
+      (subTime, Resp "5" _ (SOK Nothing)) <- responseTime $ signSendRecv rh rKey ("5", rId, SUB)
+      Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, OFF)
+      (suspendedTime, Resp "7" _ (ERR AUTH)) <- responseTime $ sendRecv sh ("", "7", sId, _SEND "hello")
+      wrongKeyTime `shouldSatisfy` (>= 0.5)
+      noQueueTime `shouldSatisfy` (>= 0.5)
+      suspendedTime `shouldSatisfy` (>= 0.5)
+      noLinkTime `shouldSatisfy` (>= 0.5)
+      subTime `shouldSatisfy` (< 0.5)
+
+responseTime :: IO a -> IO (NominalDiffTime, a)
+responseTime action = do
+  t <- getCurrentTime
+  r <- action
+  (,r) . (`diffUTCTime` t) <$> getCurrentTime
+
 testMessageNotifications :: SpecWith (ASrvTransport, AStoreType)
 testMessageNotifications =
   it "should create simplex connection, subscribe notifier and deliver notifications" $ \(ATransport t, msType) -> do

From 3db4029bb9c218f82739c9c67064a3c61db642ea Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 11 Oct 2026 11:52:24 +0100
Subject: [PATCH 13/20] ci: build cache (#1938)

* ci: build cache

* update build job

* rename steps, cache all builds, patch timestamps for ghc 8.10.7

* refactor, save O0 caches in master and stable builds

* update build to include toolchain fingerprint

* do not save cache on exact match

* remove caching docker from prs

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 .github/workflows/build.yml     | 174 ++++++++++++++++++++++++++++----
 scripts/ci/prune-old-builds.sh  |   9 ++
 scripts/ci/source-timestamps.sh |  27 +++++
 tests/Util.hs                   |   2 +-
 4 files changed, 192 insertions(+), 20 deletions(-)
 create mode 100755 scripts/ci/prune-old-builds.sh
 create mode 100755 scripts/ci/source-timestamps.sh

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index 6d445b8b1..a6a3283c5 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -66,8 +66,19 @@ jobs:
   build:
     name: "ubuntu-${{ matrix.os }}-${{ matrix.arch }}, GHC: ${{ matrix.ghc }}"
     needs: maybe-release
+    permissions:
+      contents: write
+      packages: write
     env:
       apps: "smp-server xftp-server ntf-server xftp"
+      opt: ${{ github.event_name == 'pull_request' && 'O0' || 'O2' }}
+      ghc_options: ${{ github.event_name == 'pull_request' && '--ghc-options=-O0' || '' }}
+      release: ${{ startsWith(github.ref, 'refs/tags/v') }}
+      postgres_dist: ${{ startsWith(github.ref, 'refs/tags/v') && 'dist-newstyle' || 'dist-postgres' }}
+      branch: ${{ github.base_ref || github.ref_name }}
+      cache_o0: ${{ github.event_name == 'push' && (github.ref == 'refs/heads/master' || github.ref == 'refs/heads/stable') }}
+      image_cache: ghcr.io/simplex-chat/simplexmq-build-cache:${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}
+      source_hashes: dist-newstyle/sources.sha256
     runs-on: ${{ matrix.runner }}
     services:
       postgres:
@@ -146,6 +157,18 @@ jobs:
           sudo apt update
           sudo apt -y install postgresql-client-15
 
+      - name: Log in to GitHub Container Registry
+        if: matrix.should_run == true && env.release != 'true'
+        shell: bash
+        env:
+          GHCR_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+        run: echo "$GHCR_TOKEN" | docker login ghcr.io -u "${{ github.actor }}" --password-stdin
+
+      - name: Compute image cache week
+        id: week
+        if: matrix.should_run == true && env.release != 'true'
+        run: echo "week=$(date -u +%G-W%V)" >> "$GITHUB_OUTPUT"
+
       - name: Build and cache Docker image
         if: matrix.should_run == true
         uses: simplex-chat/docker-build-push-action@v6
@@ -157,20 +180,14 @@ jobs:
           build-args: |
             TAG=${{ matrix.os }}
             GHC=${{ matrix.ghc }}
-
-      - name: Cache dependencies
-        if: matrix.should_run == true
-        uses: actions/cache@v4
-        with:
-          path: |
-            ~/.cabal/store
-            dist-newstyle
-          key: ubuntu-${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-${{ hashFiles('cabal.project', 'simplexmq.cabal') }}
+          cache-from: ${{ env.release != 'true' && format('type=registry,ref={0}-{1}', env.image_cache, steps.week.outputs.week) || '' }}
+          cache-to: ${{ github.event_name == 'push' && github.ref == 'refs/heads/master' && format('type=registry,ref={0}-{1},mode=max,ignore-error=true', env.image_cache, steps.week.outputs.week) || '' }}
 
       - name: Start container
         if: matrix.should_run == true
         shell: bash
         run: |
+          mkdir -p ~/.cabal
           docker run -t -d \
             --device /dev/fuse \
             --cap-add SYS_ADMIN \
@@ -181,21 +198,66 @@ jobs:
             -v ${{ github.workspace }}:/project \
             build/${{ matrix.os }}:latest
 
+      - name: Compute cache key prefixes
+        id: keys
+        if: matrix.should_run == true && env.release != 'true'
+        run: |
+          toolchain=$(docker exec builder dpkg-query -W -f '${db:Status-Status} ${binary:Package} ${Version}\n' 'binutils*' 'cpp*' 'gcc*' '*-dev' | grep '^installed ' | sha256sum | cut -c1-16)
+          target=${{ matrix.os }}-${{ matrix.arch }}-ghc${{ matrix.ghc }}-$toolchain
+          echo "deps=deps-$target" >> "$GITHUB_OUTPUT"
+          echo "dist=dist-$target" >> "$GITHUB_OUTPUT"
+
+      - name: Restore dependencies from cache
+        id: restore-deps
+        if: matrix.should_run == true && env.release != 'true'
+        uses: actions/cache/restore@v4
+        with:
+          path: ~/.cabal/store
+          key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.deps }}-${{ env.branch }}-
+            ${{ steps.keys.outputs.deps }}-
+
+      - name: Warn if dependencies not in cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key == ''
+        run: echo "::warning title=Cache miss::${{ steps.keys.outputs.deps }}-${{ env.branch }}"
+
+      - name: Restore build directories from cache
+        id: restore-build
+        if: matrix.should_run == true && env.release != 'true'
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-
+            ${{ steps.keys.outputs.dist }}-${{ env.opt }}-
+
+      - name: Warn if build directories not in cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-matched-key == ''
+        run: echo "::warning title=Cache miss::${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}"
+
+      - name: Set old timestamps on unchanged sources (GHC 8.10.7)
+        if: matrix.ghc == '8.10.7' && steps.restore-build.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != ''
+        run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
+
       - name: Build smp-server, xftp-server (postgresql) and tests
         if: matrix.should_run == true
         shell: docker exec -t builder sh -eu {0}
         run: |
-          chmod -fR 777 ~/.cabal ./dist-newstyle || :; git config --global --add safe.directory '*'
-          cabal clean
+          chmod -fR 777 ~/.cabal ./dist-newstyle ./dist-postgres || :; git config --global --add safe.directory '*'
+          scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
           cabal update
-          cabal build --jobs=$(nproc) --enable-tests -fserver_postgres
+          cabal build --builddir=${{ env.postgres_dist }} --jobs=$(nproc) --enable-tests -fserver_postgres ${{ env.ghc_options }}
           mkdir -p /out
-          for i in smp-server xftp-server simplexmq-test; do
-            bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
+          for i in smp-server xftp-server ntf-server simplexmq-test; do
+            bin=$(find /project/${{ env.postgres_dist }} -name "$i" -type f -executable)
             chmod +x "$bin"
-            mv "$bin" /out/
+            cp "$bin" /out/
           done
-          strip /out/smp-server /out/xftp-server
+          strip /out/smp-server /out/xftp-server /out/ntf-server
 
       - name: Copy simplexmq-test from container
         if: matrix.should_run == true
@@ -228,16 +290,17 @@ jobs:
           cat hashes.output >> "$GITHUB_OUTPUT"
 
       - name: Build everything else (standard)
+        id: build-standard
         if: matrix.should_run == true
         shell: docker exec -t builder sh -eu {0}
         run: |
-          cabal build --jobs=$(nproc)
+          cabal build --jobs=$(nproc) ${{ env.ghc_options }}
           mkdir -p /out
-          for i in ${{ env.apps }}; do
+          for i in smp-server xftp-server xftp; do
             bin=$(find /project/dist-newstyle -name "$i" -type f -executable)
             strip "$bin"
             chmod +x "$bin"
-            mv "$bin" /out/
+            cp "$bin" /out/
           done
 
       - name: Copy binaries from container and prepare them
@@ -282,6 +345,33 @@ jobs:
         env:
           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
 
+      - name: Record source hashes (GHC 8.10.7)
+        if: matrix.should_run == true && matrix.ghc == '8.10.7'
+        shell: docker exec -t builder sh -eu {0}
+        run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
+
+      - name: Compute dependency cache key
+        id: hash-deps
+        if: matrix.should_run == true && env.release != 'true'
+        shell: bash
+        run: echo "hash=$(ls ~/.cabal/store/ghc-*/ | sha256sum | cut -c1-16)" >> "$GITHUB_OUTPUT"
+
+      - name: Save dependencies to cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-deps.outputs.cache-matched-key != format('{0}-{1}-{2}', steps.keys.outputs.deps, env.branch, steps.hash-deps.outputs.hash)
+        uses: actions/cache/save@v4
+        with:
+          path: ~/.cabal/store
+          key: ${{ steps.keys.outputs.deps }}-${{ env.branch }}-${{ steps.hash-deps.outputs.hash }}
+
+      - name: Save build directories to cache
+        if: matrix.should_run == true && env.release != 'true' && steps.restore-build.outputs.cache-hit != 'true'
+        uses: actions/cache/save@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
+
       - name: Test
         if: matrix.should_run == true && matrix.arch == 'x86-64'
         timeout-minutes: 120
@@ -306,6 +396,52 @@ jobs:
             exit 1
           fi
 
+      - name: Remove -O2 build directories
+        id: remove-o2
+        if: env.cache_o0 == 'true' && !cancelled() && steps.build-standard.outcome == 'success'
+        shell: docker exec -t builder sh -eu {0}
+        run: rm -rf dist-newstyle dist-postgres
+
+      - name: Restore -O0 build directories from cache
+        id: restore-build-o0
+        if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
+        uses: actions/cache/restore@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
+          restore-keys: |
+            ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-
+            ${{ steps.keys.outputs.dist }}-O0-
+
+      - name: Set old timestamps on unchanged sources for -O0 build (GHC 8.10.7)
+        if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.restore-build-o0.outputs.cache-matched-key != '' && hashFiles(env.source_hashes) != '' }}
+        run: scripts/ci/source-timestamps.sh restore ${{ env.source_hashes }}
+
+      - name: Build at -O0 for pull request caches
+        id: build-o0
+        if: ${{ !cancelled() && steps.remove-o2.outcome == 'success' }}
+        shell: docker exec -t builder sh -eu {0}
+        run: |
+          scripts/ci/prune-old-builds.sh dist-newstyle dist-postgres
+          cabal build --builddir=dist-postgres --jobs=$(nproc) --enable-tests -fserver_postgres --ghc-options=-O0
+          cabal build --jobs=$(nproc) --ghc-options=-O0
+
+      - name: Record source hashes for -O0 build (GHC 8.10.7)
+        if: ${{ !cancelled() && matrix.ghc == '8.10.7' && steps.build-o0.outcome == 'success' }}
+        shell: docker exec -t builder sh -eu {0}
+        run: scripts/ci/source-timestamps.sh record ${{ env.source_hashes }}
+
+      - name: Save -O0 build directories to cache
+        if: ${{ !cancelled() && steps.build-o0.outcome == 'success' && steps.restore-build-o0.outputs.cache-hit != 'true' }}
+        uses: actions/cache/save@v4
+        with:
+          path: |
+            dist-newstyle
+            dist-postgres
+          key: ${{ steps.keys.outputs.dist }}-O0-${{ env.branch }}-${{ github.sha }}
+
 # =============================
 #      Resolver test job
 # =============================
diff --git a/scripts/ci/prune-old-builds.sh b/scripts/ci/prune-old-builds.sh
new file mode 100755
index 000000000..c122ed338
--- /dev/null
+++ b/scripts/ci/prune-old-builds.sh
@@ -0,0 +1,9 @@
+#!/bin/sh
+set -eu
+
+version=$(awk '/^version:/ {print $2}' simplexmq.cabal)
+for dir in "$@"; do
+  if [ -d "$dir/build" ]; then
+    find "$dir/build" -mindepth 3 -maxdepth 3 -type d -name 'simplexmq-*' ! -name "simplexmq-$version" -exec rm -rf {} +
+  fi
+done
diff --git a/scripts/ci/source-timestamps.sh b/scripts/ci/source-timestamps.sh
new file mode 100755
index 000000000..e8bc8b1ce
--- /dev/null
+++ b/scripts/ci/source-timestamps.sh
@@ -0,0 +1,27 @@
+#!/bin/sh
+set -eu
+
+command=$1
+hashes=$2
+
+sources() {
+  git ls-files -z '*.hs' '*.hsc'
+}
+
+case "$command" in
+  record)
+    sources | xargs -0 sha256sum > "$hashes"
+    ;;
+  restore)
+    sources | xargs -0 touch
+    while read -r hash file; do
+      if [ -f "$file" ] && [ "$(sha256sum "$file" | cut -d' ' -f1)" = "$hash" ]; then
+        touch -d 2000-01-01 "$file"
+      fi
+    done < "$hashes"
+    ;;
+  *)
+    echo "usage: $0 record|restore <hashes file>" >&2
+    exit 1
+    ;;
+esac
diff --git a/tests/Util.hs b/tests/Util.hs
index 9a4049d68..eaa670f06 100644
--- a/tests/Util.hs
+++ b/tests/Util.hs
@@ -56,7 +56,7 @@ instance Example a => Example (TestWrapper a) where
     ci <- envCI
     runTest `E.catches` [E.Handler (onTestFailure ci), E.Handler (onTestException ci)]
     where
-      tt = 120
+      tt = 300
       runTest =
         timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case
           Just r -> pure r

From b5e8a4b8cc120481b7c701f63faed0e3a6a36f9b Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sun, 11 Oct 2026 20:36:51 +0100
Subject: [PATCH 14/20] fix tests on ghc 8.10.7 (#1939)

* fix tests on ghc 8.10.7

* fix test

* fix schema dump test

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 simplexmq.cabal                                               | 2 +-
 .../Notifications/Server/Store/ntf_server_schema.sql          | 2 ++
 .../Messaging/Server/QueueStore/Postgres/server_schema.sql    | 2 ++
 tests/AgentTests/FunctionalAPITests.hs                        | 2 +-
 tests/PostgresSchemaDump.hs                                   | 4 ++--
 tests/ServerTests.hs                                          | 4 ++--
 6 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/simplexmq.cabal b/simplexmq.cabal
index 11384f5ae..b70911391 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -602,7 +602,7 @@ test-suite simplexmq-test
   default-extensions:
       StrictData
   -- add -fhpc to ghc-options to run tests with coverage
-  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
+  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 -N1"
   build-depends:
       base
     , aeson
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
index 801208aaa..35e4ff47f 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
+++ b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
@@ -1,5 +1,6 @@
 
 
+
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -312,3 +313,4 @@ ALTER TABLE ONLY ntf_server.subscriptions
 
 
 
+
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
index fcaaf7257..c39b82990 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
@@ -1,5 +1,6 @@
 
 
+
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -554,3 +555,4 @@ ALTER TABLE ONLY smp_server.msg_queues
 
 
 
+
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 090e8b2f3..ebcd8d7d1 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -5052,9 +5052,9 @@ testServerQueueInfo = do
     get bob =##> \case ("", c, Msg' mId PQEncOn "hello 4") -> c == aliceId && mId == msgId4; _ -> False
     ackMessage bob aliceId msgId4 Nothing
     liftIO $ threadDelay 200000
-    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
     get alice ##> ("", bobId, QCONT)
     get alice ##> ("", bobId, SENT msgId5)
+    Just _ <- checkMsgQ bob aliceId 1 -- the one that did not fit now accepted
     liftIO $ threadDelay 200000
     Just _srvMsgId <- checkQ bob aliceId True (Just QNoSub) 1 (Just MTMessage)
     get bob =##> \case ("", c, Msg' mId PQEncOn "hello: quota exceeded") -> c == aliceId && mId == msgId5 + 1; _ -> False
diff --git a/tests/PostgresSchemaDump.hs b/tests/PostgresSchemaDump.hs
index 3aa0a18c6..a0f3fe45b 100644
--- a/tests/PostgresSchemaDump.hs
+++ b/tests/PostgresSchemaDump.hs
@@ -15,6 +15,7 @@ import qualified Simplex.Messaging.Agent.Store.Postgres.Migrations as Migrations
 import Simplex.Messaging.Agent.Store.Shared (Migration (..), MigrationConfig (..), MigrationConfirmation (..), MigrationsToRun (..), toDownMigration)
 import Simplex.Messaging.Util (ifM, whenM)
 import System.Directory (doesFileExist, removeFile)
+import System.Info (os)
 import System.Process (readCreateProcess, shell)
 import Test.Hspec hiding (fit, it)
 import Util
@@ -57,14 +58,13 @@ postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBO
 
     getSchema :: FilePath -> IO String
     getSchema schemaPath = do
-      ci <- envCI
       let cmd =
             ("pg_dump " <> B.unpack connstr <> " --schema " <> B.unpack testDBSchema)
               <> " --schema-only --no-owner --no-privileges --no-acl --no-subscriptions --no-tablespaces > "
               <> schemaPath
       void $ readCreateProcess (shell cmd) ""
       threadDelay 20000
-      let sed = (if ci then "sed -i" else "sed -i ''")
+      let sed = (if os == "linux" then "sed -i" else "sed -i ''")
       void $ readCreateProcess (shell $ sed <> " '/^--/d; /^\\\\restrict/d; /^\\\\unrestrict/d' " <> schemaPath) ""
       sch <- readFile schemaPath
       sch `deepseq` pure sch
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 89ac46144..aff1fdbe0 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -905,7 +905,7 @@ testServiceSubsTotalCount =
                 _ -> pure Nothing
             ]
         threadDelay 1500000
-        readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 2
+        B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 2
 
       -- Phase 2: associate 1 more queue via SUB, reconnect with SUBS 3, check metric = 3
       (rPub3, rKey3) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -935,7 +935,7 @@ testServiceSubsTotalCount =
                 _ -> pure Nothing
             ]
         threadDelay 1500000
-        readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric m `shouldBe` Just 3
+        B.readFile testPrometheusMetricsFile >>= \m -> readServiceSubsMetric (B.unpack m) `shouldBe` Just 3
 
 readServiceSubsMetric :: String -> Maybe Int
 readServiceSubsMetric content =

From cba13823567d7cd564d8a1f354046174fba375d8 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Sun, 11 Oct 2026 22:33:06 +0100
Subject: [PATCH 15/20] 7.1.0.11

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

diff --git a/simplexmq.cabal b/simplexmq.cabal
index b70911391..c07df376a 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:           simplexmq
-version:        7.1.0.10
+version:        7.1.0.11
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

From 1d39da91c5bafba75c3ee8fb42fa2b76875356e0 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Thu, 15 Oct 2026 13:58:07 +0400
Subject: [PATCH 16/20] smp-server: enforce command concurrency limit (#1944)

* smp-server: hold command slot until completion

* smp-server: command slot wait timeout and stats

* smp-server: clarify command slot comments

* smp-server: simplify command slot fork

* smp-server: limit direct RSLV per client

* smp-server: distinct error for RSLV slot timeout

* smp-server: client command slot wait timeout

* smp-server: reply to forwarded RSLV slot timeout

* smp-server: raise default concurrency limits

* smp-server: simplify command slot wait
---
 src/Simplex/Messaging/Server.hs            | 81 +++++++++++++++-----
 src/Simplex/Messaging/Server/Env/STM.hs    | 11 ++-
 src/Simplex/Messaging/Server/Main.hs       |  1 +
 src/Simplex/Messaging/Server/Main/Init.hs  |  4 +-
 src/Simplex/Messaging/Server/Prometheus.hs | 17 +++++
 src/Simplex/Messaging/Server/Stats.hs      | 33 ++++++++
 tests/RSLVTests.hs                         | 87 ++++++++++++++++++++++
 tests/SMPClient.hs                         |  1 +
 8 files changed, 211 insertions(+), 24 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index e2cef6f50..c26a8b0a6 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -98,8 +98,8 @@ 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, clientHandlers, forwardSMPTransmission, smpProxyError, temporaryClientError)
-import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
+import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), ProtocolClient (thParams), ProtocolClientConfig (..), ProtocolClientError (..), SMPClient, SMPClientError, clientHandlers, forwardSMPTransmission, netTimeoutInt, smpProxyError, temporaryClientError)
+import Simplex.Messaging.Client.Agent (OwnServer, SMPClientAgent (..), SMPClientAgentConfig (..), SMPClientAgentEvent (..), closeSMPClientAgent, getSMPServerClient'', isOwnServer, lookupSMPServerClient, getConnectedSMPServerClient)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
@@ -1212,7 +1212,23 @@ sendAfterDelay c@Client {sndQ, clientTHParams = THandleParams {sessionId}} stats
   | otherwise = write
   where
     write = atomically $ writeTBQueue sndQ rs
-    microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000)
+
+updateSlotWaitStats :: ServerStats -> SystemTime -> Bool -> IO ()
+updateSlotWaitStats ServerStats {cmdSlotWaits, cmdSlotWaitMs, cmdSlotWaitMaxMs, cmdSlotWaitTimeouts} since taken = do
+  waitMs <- fromIntegral . (`div` 1000) . subtract (microseconds since) . microseconds <$> getSystemTime
+  incStat cmdSlotWaits
+  atomicModifyIORef'_ cmdSlotWaitMs (+ waitMs)
+  atomicModifyIORef'_ cmdSlotWaitMaxMs (max waitMs)
+  unless taken $ incStat cmdSlotWaitTimeouts
+
+rslvTooManyRequests :: BrokerMsg
+rslvTooManyRequests = ERR $ NAME $ RESOLVER "too many requests"
+
+forwardedCmdWait :: ServerConfig s -> Int
+forwardedCmdWait = (`netTimeoutInt` NRMBackground) . tcpTimeout . networkConfig . smpCfg . smpAgentCfg
+
+microseconds :: SystemTime -> Int64
+microseconds (MkSystemTime s ns) = s * 1000000 + fromIntegral (ns `div` 1000)
 
 send :: Transport c => MVar (THandleSMP c 'TServer) -> Client s -> IO ()
 send th c@Client {sndQ, msgQ, clientTHParams = THandleParams {sessionId}} = do
@@ -1491,21 +1507,45 @@ client
           Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
       where
         forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg)
-        forkProxiedCmd = forkCmd serverClientConcurrency corrId (EntityId sessId)
-    -- Run a slow command on a thread
-    forkCmd :: (ServerConfig s -> Int) -> CorrId -> EntityId -> M s BrokerMsg -> M s (Maybe a)
-    forkCmd concurrency corrId entId cmdAction = do
-      bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " cmd") $
-        -- commands MUST be processed under a reasonable timeout or the client would halt
-        cmdAction >>= \t -> atomically $ writeTBQueue sndQ ([(corrId, entId, t)], [])
+        forkProxiedCmd = forkCmd serverClientConcurrency corrId (EntityId sessId) (ERR $ smpProxyError PCEResponseTimeout)
+    -- Run a slow command on a thread, responding with timeoutErr if it was not started before the client timeout
+    forkCmd :: (ServerConfig s -> Int) -> CorrId -> EntityId -> BrokerMsg -> M s BrokerMsg -> M s (Maybe a)
+    forkCmd concurrency corrId entId timeoutErr cmdAction =
+      -- commands MUST be processed under a reasonable timeout or the client would halt
+      forkCmd_ concurrency maxClientCmdWait (sendResp timeoutErr) $ cmdAction >>= sendResp
+      where
+        sendResp t = atomically $ writeTBQueue sndQ ([(corrId, entId, t)], [])
+    -- Run a slow command on a thread that sends its response
+    forkCmd_ :: (ServerConfig s -> Int) -> (ServerConfig s -> Int) -> M s () -> M s () -> M s (Maybe a)
+    forkCmd_ concurrency waitTimeout onTimeout cmd = do
+      let label = B.unpack $ "client $" <> encode sessionId <> " cmd"
+      -- Exceptions are masked so the slot is never lost between taking it and starting the thread.
+      -- The thread frees the slot when the command finishes; the caller frees it only if forking failed.
+      mask $ \restore ->
+        ifM
+          wait
+          (forkClient clnt label (restore cmd `finally` signal) `onException` signal)
+          (restore onTimeout)
       pure Nothing
       where
+        -- Takes a free slot at once if there is one. Otherwise waits for a slot until the client
+        -- timeout, after which the client no longer expects the response.
+        -- Other commands of this client are not processed while it waits.
         wait = do
           limit <- asks (concurrency . config)
-          atomically $ do
-            used <- readTVar procThreads
-            when (used >= limit) retry
-            writeTVar procThreads $! used + 1
+          ifM (atomically $ takeSlot limit) (pure True) $ do
+            clientTimeout <- asks $ waitTimeout . config
+            waitStarted <- liftIO getSystemTime
+            expired <- liftIO $ registerDelay clientTimeout
+            taken <- atomically $ ifM (takeSlot limit) (pure True) (ifM (readTVar expired) (pure False) retry)
+            stats <- asks serverStats
+            liftIO $ updateSlotWaitStats stats waitStarted taken
+            pure taken
+        takeSlot limit = do
+          used <- readTVar procThreads
+          let free = used < limit
+          when free $ writeTVar procThreads $! used + 1
+          pure free
         signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
     rslvNamesEnv :: M s (Maybe NamesEnv)
     rslvNamesEnv = do
@@ -1515,7 +1555,7 @@ client
         Nothing -> incStat (rslvDisabled st) $> Nothing
         Just nenv -> pure (Just nenv)
     -- Runs on a forked thread so RSLV does not block other commands;
-    -- concurrency is limited by serverResolverConcurrency in forkCmd.
+    -- concurrency is limited in forkCmd by serverClientConcurrency for direct and serverResolverConcurrency for forwarded RSLV.
     resolveNameMsg :: VersionSMP -> NamesEnv -> NameQuery -> M s BrokerMsg
     resolveNameMsg v nenv q = do
       st <- asks (rslvStats . serverStats)
@@ -1545,7 +1585,7 @@ client
       Cmd SProxyService (RFWD encBlock) -> (response . (corrId, NoEntity,) =<<) <$> processForwardedCommand encBlock
       Cmd SResolver (RSLV d) -> rslvNamesEnv >>= \case
         Nothing -> pure $ response (corrId, NoEntity, ERR (NAME NO_RESOLVER))
-        Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity (resolveNameMsg (thVersion thParams') nenv d)
+        Just nenv -> forkCmd serverClientConcurrency corrId NoEntity rslvTooManyRequests (resolveNameMsg (thVersion thParams') nenv d)
       Cmd SSenderLink command -> case command of
         LKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k $>> getQueueLink_ q qr
         LGET -> withQueue $ \q qr -> checkContact qr $ getQueueLink_ q qr
@@ -2181,9 +2221,12 @@ client
             Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
               Cmd SResolver (RSLV d) -> lift $ rslvNamesEnv >>= \case
                 Nothing -> pure $ Just (corrId', entId', ERR (NAME NO_RESOLVER))
-                Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity $ do
-                  msg <- resolveNameMsg (thVersion clntTHParams) nenv d
-                  either ERR id <$> runExceptT (encodeResp (corrId', entId', msg))
+                Just nenv -> do
+                  let sendResolved msg = do
+                        rres <- either ERR id <$> runExceptT (encodeResp (corrId', entId', msg))
+                        atomically $ writeTBQueue sndQ ([(corrId, NoEntity, rres)], [])
+                  forkCmd_ serverResolverConcurrency forwardedCmdWait (sendResolved rslvTooManyRequests) $
+                    resolveNameMsg (thVersion clntTHParams) nenv d >>= sendResolved
               -- INTERNAL because processCommand never returns Nothing for sender commands;
               -- `fst` drops the empty message only returned for SUB.
               _ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing (Right (M.empty, M.empty, M.empty)) t'')
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 2c1843e51..79bfe21f4 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -68,6 +68,7 @@ module Simplex.Messaging.Server.Env.STM
     defaultInactiveClientExpiration,
     defaultProxyClientConcurrency,
     defaultNameResolverConcurrency,
+    defaultMaxClientCmdWait,
     defaultAuthErrorDelayMs,
     defaultMaxJournalMsgCount,
     defaultMaxJournalStateLines,
@@ -201,11 +202,12 @@ data ServerConfig s = ServerConfig
     smpAgentCfg :: SMPClientAgentConfig,
     allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth`
     serverClientConcurrency :: Int,
-    -- | max concurrent name resolutions per connection, enforced in forkCmd.
+    -- | max concurrent forwarded name resolutions per proxy connection, enforced in forkCmd.
     -- Much higher than serverClientConcurrency: forwarded RSLVs from many clients
     -- aggregate over a single proxy->relay connection (only servers send proxied
     -- requests), so bounding them by the per-client limit would throttle unduly.
     serverResolverConcurrency :: Int,
+    maxClientCmdWait :: Int,
     -- | public-namespace resolver config; Nothing disables the names role
     namesConfig :: Maybe NamesConfig,
     -- | server public information
@@ -252,10 +254,13 @@ defaultInactiveClientExpiration =
     }
 
 defaultProxyClientConcurrency :: Int
-defaultProxyClientConcurrency = 32
+defaultProxyClientConcurrency = 500
 
 defaultNameResolverConcurrency :: Int
-defaultNameResolverConcurrency = 1000
+defaultNameResolverConcurrency = 5000
+
+defaultMaxClientCmdWait :: Int
+defaultMaxClientCmdWait = 60000000 -- microseconds
 
 defaultAuthErrorDelayMs :: Int64
 defaultAuthErrorDelayMs = 50
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 4a3c909ed..64b4af287 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -611,6 +611,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               allowSMPProxy = True,
               serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
               serverResolverConcurrency = readIniDefault defaultNameResolverConcurrency "NAMES" "resolver_concurrency" ini,
+              maxClientCmdWait = defaultMaxClientCmdWait,
               namesConfig = readNamesConfig ini,
               information = serverPublicInfo ini,
               startOptions
diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs
index b82061ca3..d2938821c 100644
--- a/src/Simplex/Messaging/Server/Main/Init.hs
+++ b/src/Simplex/Messaging/Server/Main/Init.hs
@@ -154,7 +154,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
         \# `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"
+        \# Limit number of threads a client can spawn to process proxy commands and name resolutions in parallel.\n"
     <> ("# client_concurrency = " <> tshow defaultProxyClientConcurrency)
     <> "\n\n\
         \[NAMES]\n\
@@ -169,7 +169,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
         \# resolver_auth: basic <username>:<password>\n\
         \# resolver_timeout_ms: 3000\n\
         \# resolver_max_response_bytes: 16000\n\
-        \# Max concurrent name resolutions per connection (forwarded RSLVs from many\n\
+        \# Max concurrent forwarded name resolutions per proxy connection (forwarded RSLVs from many\n\
         \# clients share one proxy connection, so this is much higher than PROXY client_concurrency).\n"
     <> ("# resolver_concurrency = " <> tshow defaultNameResolverConcurrency)
     <> "\n\n\
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index 864a2014f..940407569 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -127,6 +127,10 @@ prometheusMetrics sm rtm ts =
         _rcvServicesSubMsg,
         _rcvServicesSubDuplicate,
         _authDelayExceeded,
+        _cmdSlotWaits,
+        _cmdSlotWaitMs,
+        _cmdSlotWaitMaxMs,
+        _cmdSlotWaitTimeouts,
         _qCount,
         _msgCount,
         _ntfCount,
@@ -197,6 +201,19 @@ prometheusMetrics sm rtm ts =
       \# HELP simplex_smp_auth_delay_exceeded Responses with AUTH errors sent without delay, as processing took longer than the delay.\n\
       \# TYPE simplex_smp_auth_delay_exceeded counter\n\
       \simplex_smp_auth_delay_exceeded " <> mshow _authDelayExceeded <> "\n# authDelayExceeded\n\
+      \\n\
+      \# HELP simplex_smp_cmd_slot_wait_ms Time commands waited for a free slot of the connection concurrency limit, in ms.\n\
+      \# TYPE simplex_smp_cmd_slot_wait_ms summary\n\
+      \simplex_smp_cmd_slot_wait_ms_sum " <> mshow _cmdSlotWaitMs <> "\n# cmdSlotWaitMs\n\
+      \simplex_smp_cmd_slot_wait_ms_count " <> mshow _cmdSlotWaits <> "\n# cmdSlotWaits\n\
+      \\n\
+      \# HELP simplex_smp_cmd_slot_wait_ms_max The longest wait for a free command slot, in ms.\n\
+      \# TYPE simplex_smp_cmd_slot_wait_ms_max gauge\n\
+      \simplex_smp_cmd_slot_wait_ms_max " <> mshow _cmdSlotWaitMaxMs <> "\n# cmdSlotWaitMaxMs\n\
+      \\n\
+      \# HELP simplex_smp_cmd_slot_wait_timeouts Commands not processed because the client timed out while they waited for a free slot.\n\
+      \# TYPE simplex_smp_cmd_slot_wait_timeouts counter\n\
+      \simplex_smp_cmd_slot_wait_timeouts " <> mshow _cmdSlotWaitTimeouts <> "\n# cmdSlotWaitTimeouts\n\
       \\n"
     subscriptions =
       "# Subscriptions\n\
diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs
index c1c599822..a1c9dfa29 100644
--- a/src/Simplex/Messaging/Server/Stats.hs
+++ b/src/Simplex/Messaging/Server/Stats.hs
@@ -129,6 +129,11 @@ data ServerStats = ServerStats
     rcvServicesSubMsg :: IORef Int,
     rcvServicesSubDuplicate :: IORef Int,
     authDelayExceeded :: IORef Int,
+    -- commands that waited for a free slot in forkCmd, total and max wait in ms, and waits that timed out
+    cmdSlotWaits :: IORef Int,
+    cmdSlotWaitMs :: IORef Int,
+    cmdSlotWaitMaxMs :: IORef Int,
+    cmdSlotWaitTimeouts :: IORef Int,
     qCount :: IORef Int,
     msgCount :: IORef Int,
     ntfCount :: IORef Int,
@@ -192,6 +197,10 @@ data ServerStatsData = ServerStatsData
     _rcvServicesSubMsg :: Int,
     _rcvServicesSubDuplicate :: Int,
     _authDelayExceeded :: Int,
+    _cmdSlotWaits :: Int,
+    _cmdSlotWaitMs :: Int,
+    _cmdSlotWaitMaxMs :: Int,
+    _cmdSlotWaitTimeouts :: Int,
     _qCount :: Int,
     _msgCount :: Int,
     _ntfCount :: Int,
@@ -257,6 +266,10 @@ newServerStats ts = do
   rcvServicesSubMsg <- newIORef 0
   rcvServicesSubDuplicate <- newIORef 0
   authDelayExceeded <- newIORef 0
+  cmdSlotWaits <- newIORef 0
+  cmdSlotWaitMs <- newIORef 0
+  cmdSlotWaitMaxMs <- newIORef 0
+  cmdSlotWaitTimeouts <- newIORef 0
   qCount <- newIORef 0
   msgCount <- newIORef 0
   ntfCount <- newIORef 0
@@ -319,6 +332,10 @@ newServerStats ts = do
         rcvServicesSubMsg,
         rcvServicesSubDuplicate,
         authDelayExceeded,
+        cmdSlotWaits,
+        cmdSlotWaitMs,
+        cmdSlotWaitMaxMs,
+        cmdSlotWaitTimeouts,
         qCount,
         msgCount,
         ntfCount,
@@ -383,6 +400,10 @@ getServerStatsData s = do
   _rcvServicesSubMsg <- readIORef $ rcvServicesSubMsg s
   _rcvServicesSubDuplicate <- readIORef $ rcvServicesSubDuplicate s
   _authDelayExceeded <- readIORef $ authDelayExceeded s
+  _cmdSlotWaits <- readIORef $ cmdSlotWaits s
+  _cmdSlotWaitMs <- readIORef $ cmdSlotWaitMs s
+  _cmdSlotWaitMaxMs <- readIORef $ cmdSlotWaitMaxMs s
+  _cmdSlotWaitTimeouts <- readIORef $ cmdSlotWaitTimeouts s
   _qCount <- readIORef $ qCount s
   _msgCount <- readIORef $ msgCount s
   _ntfCount <- readIORef $ ntfCount s
@@ -445,6 +466,10 @@ getServerStatsData s = do
         _rcvServicesSubMsg,
         _rcvServicesSubDuplicate,
         _authDelayExceeded,
+        _cmdSlotWaits,
+        _cmdSlotWaitMs,
+        _cmdSlotWaitMaxMs,
+        _cmdSlotWaitTimeouts,
         _qCount,
         _msgCount,
         _ntfCount,
@@ -510,6 +535,10 @@ setServerStats s d = do
   writeIORef (rcvServicesSubMsg s) $! _rcvServicesSubMsg d
   writeIORef (rcvServicesSubDuplicate s) $! _rcvServicesSubDuplicate d
   writeIORef (authDelayExceeded s) $! _authDelayExceeded d
+  writeIORef (cmdSlotWaits s) $! _cmdSlotWaits d
+  writeIORef (cmdSlotWaitMs s) $! _cmdSlotWaitMs d
+  writeIORef (cmdSlotWaitMaxMs s) $! _cmdSlotWaitMaxMs d
+  writeIORef (cmdSlotWaitTimeouts s) $! _cmdSlotWaitTimeouts d
   writeIORef (qCount s) $! _qCount d
   writeIORef (msgCount s) $! _msgCount d
   writeIORef (ntfCount s) $! _ntfCount d
@@ -713,6 +742,10 @@ instance StrEncoding ServerStatsData where
           _rcvServicesSubMsg = 0,
           _rcvServicesSubDuplicate = 0,
           _authDelayExceeded = 0,
+          _cmdSlotWaits = 0,
+          _cmdSlotWaitMs = 0,
+          _cmdSlotWaitMaxMs = 0,
+          _cmdSlotWaitTimeouts = 0,
           _qCount,
           _msgCount = 0,
           _ntfCount = 0,
diff --git a/tests/RSLVTests.hs b/tests/RSLVTests.hs
index 9263b6953..a52aa2a86 100644
--- a/tests/RSLVTests.hs
+++ b/tests/RSLVTests.hs
@@ -11,11 +11,14 @@
 
 module RSLVTests (rslvTests) where
 
+import Control.Concurrent (threadDelay)
+import Control.Monad (forM_)
 import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy as LB
 import Data.IORef (IORef, readIORef)
 import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as L
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Time.Clock (getCurrentTime)
@@ -47,6 +50,7 @@ import Simplex.Messaging.Protocol
     tPut,
   )
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Server.Env.STM (ServerConfig (..))
 import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Version (mkVersionRange)
@@ -102,6 +106,10 @@ rslvTests = do
     it "RSLV sends the 2LD as its hash" testRslvSendsTheHash
     it "a name with subnames is sent as text" testSubnameKeepsItsLabels
     it "a record naming a different name is rejected" testRslvWrongName
+  describe "RSLV resource use" $ do
+    it "one connection has at most client_concurrency lookups in flight" testRslvConnectionCap
+    it "a lookup waiting for a slot runs when a slot is released" testRslvSlotWait
+    it "a lookup waiting for a slot fails when the client times out" testRslvSlotWaitTimeout
 
 -- | /v2/resolve answers 200, 400 or 502, so a 404 is a resolver that predates
 -- the route, not a name that does not exist.
@@ -275,5 +283,84 @@ testRslvWrongName =
       Left (PCEUnexpectedResponse _) -> pure ()
       _ -> expectationFailure $ "expected Left (PCEUnexpectedResponse ..), got: " <> show r
 
+-- The resolver answers after 3s and the server gives up after 1s, so a request
+-- that reached the resolver stays in flight for the whole check.
+testRslvConnectionCap :: IO ()
+testRslvConnectionCap =
+  NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
+    withSmpServerConfigOn (transport @TLS) (updateCfg (withNames port memCfg) $ \c -> c {serverClientConcurrency = connCap}) testPort $ const $
+      testSMPClient @TLS $ \h -> do
+        sendRslvs h "cap" 16
+        threadDelay 800000
+        length <$> resolvePaths reqs `shouldReturn` connCap
+        recvResponses h 16 `shouldReturn` replicate 16 (Right (ERR (NAME (RESOLVER "timeout"))))
+  where
+    connCap = 4
+
+-- 4 lookups take the slots for the 1s resolver timeout, the 5th waits for a slot.
+testRslvSlotWait :: IO ()
+testRslvSlotWait =
+  NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
+    withSmpServerConfigOn (transport @TLS) (slotWaitCfg port 10000000) testPort $ const $
+      testSMPClient @TLS $ \h -> do
+        sendRslvs h "wait" 5
+        recvResponses h 5 `shouldReturn` replicate 5 (Right (ERR (NAME (RESOLVER "timeout"))))
+        length <$> resolvePaths reqs `shouldReturn` 5
+        threadDelay 1500000
+        SlotWaitMetrics {waits, waitTimeouts, waitMaxMs, waitSumMs} <- readSlotWaitMetrics
+        (waits, waitTimeouts) `shouldBe` (1, 0)
+        waitMaxMs `shouldSatisfy` (\t -> t >= 500 && t < 2000)
+        waitSumMs `shouldBe` waitMaxMs
+
+-- The client times out after 0.2s, so the 2 waiting lookups fail before the slots are released.
+-- The connection does not process further commands while one waits, so the 6th waits after the 5th times out.
+testRslvSlotWaitTimeout :: IO ()
+testRslvSlotWaitTimeout =
+  NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
+    withSmpServerConfigOn (transport @TLS) (slotWaitCfg port 200000) testPort $ const $
+      testSMPClient @TLS $ \h -> do
+        sendRslvs h "wait" 6
+        recvResponses h 6 `shouldReturn` (replicate 2 (Right (ERR (NAME (RESOLVER "too many requests")))) <> replicate 4 (Right (ERR (NAME (RESOLVER "timeout")))))
+        threadDelay 1500000
+        length <$> resolvePaths reqs `shouldReturn` 4
+        SlotWaitMetrics {waits, waitTimeouts, waitMaxMs, waitSumMs} <- readSlotWaitMetrics
+        (waits, waitTimeouts) `shouldBe` (2, 2)
+        waitMaxMs `shouldSatisfy` (\t -> t >= 200 && t < 1000)
+        waitSumMs `shouldSatisfy` (>= 400)
+
+slotWaitCfg :: Int -> Int -> AServerConfig
+slotWaitCfg port clientTimeout =
+  updateCfg (withNames port memCfg) $ \c -> c {serverClientConcurrency = 4, prometheusInterval = Just 1, maxClientCmdWait = clientTimeout}
+
+data SlotWaitMetrics = SlotWaitMetrics {waits :: Int, waitTimeouts :: Int, waitMaxMs :: Int, waitSumMs :: Int}
+
+readSlotWaitMetrics :: IO SlotWaitMetrics
+readSlotWaitMetrics = do
+  ms <- map words . lines <$> readFile testPrometheusMetricsFile
+  -- metric lines are "name value timestamp"
+  let metric name = case [v | n : v : _ <- ms, n == name] of
+        [v] -> pure $ read v
+        _ -> fail $ "no metric " <> name
+  SlotWaitMetrics
+    <$> metric "simplex_smp_cmd_slot_wait_ms_count"
+    <*> metric "simplex_smp_cmd_slot_wait_timeouts"
+    <*> metric "simplex_smp_cmd_slot_wait_ms_max"
+    <*> metric "simplex_smp_cmd_slot_wait_ms_sum"
+
+-- | One RSLV per block, so no batch limit applies.
+sendRslvs :: THandleSMP TLS 'TClient -> String -> Int -> IO ()
+sendRslvs h@THandle {params} prefix n =
+  forM_ [1 .. n] $ \i -> do
+    let TransmissionForAuth {tToSend} = encodeTransmissionForAuth params (CorrId (B.pack $ prefix <> show i), NoEntity, Cmd SResolver (RSLV (NQDomain (domain "alice.simplex"))))
+    [Right ()] <- tPut h (Right (Nothing, tToSend) :| [])
+    pure ()
+
+recvResponses :: THandleSMP TLS 'TClient -> Int -> IO [Either ErrorType BrokerMsg]
+recvResponses h n
+  | n <= 0 = pure []
+  | otherwise = do
+      rs <- map (\(_, _, r) -> r) . L.toList <$> tGetClient h
+      (rs <>) <$> recvResponses h (n - length rs)
+
 runExceptT' :: Show e => ExceptT e IO a -> IO a
 runExceptT' a = runExceptT a >>= either (fail . show) pure
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 2db4a9819..dd84bd6e9 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -278,6 +278,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       allowSMPProxy = False,
       serverClientConcurrency = 2,
       serverResolverConcurrency = defaultNameResolverConcurrency,
+      maxClientCmdWait = defaultMaxClientCmdWait,
       namesConfig = Nothing,
       information = Nothing,
       startOptions = defaultStartOptions

From 9d83c0378e804323e2766b40cfb01d80b0870b76 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 15 Oct 2026 14:10:04 +0100
Subject: [PATCH 17/20] tests: execute in parallel, agent: fix race condition
 with files and when switching queue (#1932)

* tests: execute in parallel

* fix test

* fix postgresql build

* fix test

* fix test

* fix some tests

* fix tests

* fix tests

* fix test

* update schema

* fix test

* update schemas

* diff

* fix race

* fixes

* update schemas

* fix tests

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 .github/workflows/build.yml                   |   8 +
 contributing/PROJECT.md                       |   8 +
 plans/2026-10-07-parallel-tests.md            |  80 ++++
 simplexmq.cabal                               |   2 +-
 src/Simplex/FileTransfer/Agent.hs             |  11 +-
 src/Simplex/Messaging/Agent.hs                |  12 +-
 .../Migrations/agent_postgres_schema.sql      |   5 -
 .../Server/Store/ntf_server_schema.sql        |   7 -
 src/Simplex/Messaging/Server/Main.hs          |   2 +
 .../Messaging/Server/Names/HttpResolver.hs    |   6 +-
 .../QueueStore/Postgres/server_schema.sql     |   7 -
 tests/AgentTests.hs                           |  19 +-
 tests/AgentTests/FunctionalAPITests.hs        | 381 +++++++++---------
 tests/AgentTests/NotificationTests.hs         |  64 +--
 tests/AgentTests/ResolveNameTests.hs          |  30 +-
 tests/AgentTests/ServerChoice.hs              |   4 +-
 tests/CLITests.hs                             |  44 +-
 tests/CoreTests/CryptoFileTests.hs            |  16 +-
 tests/CoreTests/CryptoTests.hs                |   8 +-
 tests/CoreTests/MsgStoreTests.hs              |  73 ++--
 tests/CoreTests/RetryIntervalTests.hs         |  68 ++--
 tests/CoreTests/StoreLogTests.hs              |   8 +-
 tests/CoreTests/XFTPStoreTests.hs             |  32 +-
 tests/FileDescriptionTests.hs                 |  10 +-
 tests/NamesResolverServer.hs                  |   7 +-
 tests/NtfClient.hs                            |  58 +--
 tests/NtfServerTests.hs                       |   4 +-
 tests/PostgresSchemaDump.hs                   |   5 +-
 tests/RSLVTests.hs                            |  54 +--
 tests/SMPAgentClient.hs                       |  62 +--
 tests/SMPClient.hs                            | 177 ++++----
 tests/SMPProxyTests.hs                        | 120 +++---
 tests/ServerTests.hs                          |  25 +-
 tests/Test.hs                                 | 223 +++++-----
 tests/Util.hs                                 |  97 ++++-
 tests/XFTPAgent.hs                            |  99 ++---
 tests/XFTPCLI.hs                              |  48 +--
 tests/XFTPClient.hs                           |  93 ++---
 tests/XFTPServerTests.hs                      | 101 +++--
 tests/XFTPWebTests.hs                         |  49 +--
 40 files changed, 1157 insertions(+), 970 deletions(-)
 create mode 100644 plans/2026-10-07-parallel-tests.md

diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index a6a3283c5..3caf2cbcc 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -372,6 +372,14 @@ jobs:
             dist-postgres
           key: ${{ steps.keys.outputs.dist }}-${{ env.opt }}-${{ env.branch }}-${{ github.sha }}
 
+      - name: Increase PostgreSQL connection limit
+        if: matrix.should_run == true && matrix.arch == 'x86-64'
+        shell: bash
+        run: |
+          docker exec ${{ job.services.postgres.id }} psql -U postgres -c "ALTER SYSTEM SET max_connections = 500"
+          docker restart ${{ job.services.postgres.id }}
+          timeout 60 sh -c 'until docker exec ${{ job.services.postgres.id }} pg_isready -U postgres; do sleep 1; done'
+
       - name: Test
         if: matrix.should_run == true && matrix.arch == 'x86-64'
         timeout-minutes: 120
diff --git a/contributing/PROJECT.md b/contributing/PROJECT.md
index cda71597d..bfbf5865d 100644
--- a/contributing/PROJECT.md
+++ b/contributing/PROJECT.md
@@ -97,6 +97,14 @@ cabal test --test-option=--match="/SMP client agent/functional API/"
 
 Tests require PostgreSQL running on `localhost:5432` when using `-fserver_postgres` or `-fclient_postgres`.
 
+Tests run in parallel, one job per processor. With 4 jobs, the tests open up to 220 PostgreSQL connections with `-fserver_postgres` and up to 420 with both flags, while the default limit is 100. Raise the limit and restart PostgreSQL:
+
+```bash
+psql -U postgres -c "ALTER SYSTEM SET max_connections = 500"
+```
+
+With more than 4 processors, also limit the jobs: `--test-option=--jobs=4`.
+
 Test files are in `tests/` with structure:
 - `Test.hs`: Main runner
 - `AgentTests/`: Agent protocol and connection tests
diff --git a/plans/2026-10-07-parallel-tests.md b/plans/2026-10-07-parallel-tests.md
new file mode 100644
index 000000000..a5f92a873
--- /dev/null
+++ b/plans/2026-10-07-parallel-tests.md
@@ -0,0 +1,80 @@
+# Parallel test execution
+
+Every test gets its own ports, directory and Postgres schemas, so hspec runs
+the tree concurrently in one process with `parallel` and `--jobs`.
+
+## Decisions
+
+- `Util` defines the test environment:
+
+  ```haskell
+  data TestEnv = TestEnv
+    { testNo :: Int,
+      portBase :: Int
+    }
+
+  type HasTestEnv = (?testEnv :: TestEnv)
+  ```
+
+- `Util.it`, `fit` and `xit` take `HasTestEnv => a`. The test wrapper
+  creates the environment for each attempt, so a CI retry gets fresh ports,
+  directory and schemas.
+- Environment creation:
+  - `testNo` from a counter, never reused in a run.
+  - `portBase` from a pool `[10000, 10010 .. 19990]`, returned after the test.
+  - directory `tests/tmp/<testNo>` with `xftp-sender-files` and
+    `xftp-recipient-files`, removed after the test.
+- Fixture constants become `HasTestEnv =>` values:
+  - ports: offsets from `portBase`
+
+    | offset | fixture         |
+    |--------|-----------------|
+    | 1      | `testPort`      |
+    | 2      | `testPort2`     |
+    | 3      | `ntfTestPort`   |
+    | 4      | `ntfTestPort2`  |
+    | 5      | `apnsTestPort`  |
+    | 6      | `xftpTestPort`  |
+    | 7      | `xftpTestPort2` |
+
+  - server addresses: built from the ports.
+  - files: in the test directory.
+  - Postgres schemas: `test<testNo>_<name>`.
+- Functions that use fixtures gain `HasTestEnv` in their signatures.
+- `withXFTPServerCfg` creates the server files directory.
+- Removed hooks:
+  - `tests/tmp` creation and removal per test.
+  - per-test database recreation and schema drops.
+  - XFTP `testBracket` and server files directory hooks.
+  - `around (withMsgStore cfg)`: each test opens its store.
+- `tests/tmp` is cleared before the run and removed after it.
+- Postgres databases are created before the run and dropped after it.
+- Schema dumps and the Ntf CLI test keep the production schema names and
+  recreate the database per test.
+- Sequential, after all parallel tests:
+  - SMP proxy tests that change the number of capabilities.
+  - XFTP CLI tests: `withArgs` and stdout capture are process-wide.
+  - server CLI tests: the same, and fixed ports.
+  - tests with wall-clock assertions:
+    - retry intervals
+    - AUTH error timing
+    - agent user network info
+    - agent SMP queue info
+    - agent client notices
+  - schema dumps.
+- The SQLite agent schema dump resets `tests/tmp` after each item.
+- `createRandomFile_` in the XFTP agent tests writes random bytes directly.
+- Test suite `-with-rtsopts=-N1` becomes `-with-rtsopts=-N`.
+- `it "..." . f $ x` becomes `it "..." $ f $ x` where `f` or `x` uses the
+  environment.
+
+## Mechanics
+
+- `tests/Util.hs`: environment, wrapper, `it`, `fit`, `xit`,
+  `eventuallyRemove`, sender and recipient directories.
+- `tests/Test.hs`: `parallel` tree, sequential tail, `tests/tmp` and database
+  brackets around `hspec`.
+- `tests/SMPClient.hs`, `tests/SMPAgentClient.hs`, `tests/NtfClient.hs`,
+  `tests/XFTPClient.hs`, `tests/Fixtures.hs`: fixtures from the environment.
+- Test modules: signatures, literal paths and ports, removed hooks.
+- `simplexmq.cabal`: `-N`.
diff --git a/simplexmq.cabal b/simplexmq.cabal
index c07df376a..d43f81840 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -602,7 +602,7 @@ test-suite simplexmq-test
   default-extensions:
       StrictData
   -- add -fhpc to ghc-options to run tests with coverage
-  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 -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 -N"
   build-depends:
       base
     , aeson
diff --git a/src/Simplex/FileTransfer/Agent.hs b/src/Simplex/FileTransfer/Agent.hs
index b0e8c056a..f31922117 100644
--- a/src/Simplex/FileTransfer/Agent.hs
+++ b/src/Simplex/FileTransfer/Agent.hs
@@ -279,6 +279,7 @@ retryOnError name loop done e = do
 
 rcvWorkerInternalError :: AgentClient -> DBRcvFileId -> RcvFileId -> Maybe RcvFileId -> Maybe FilePath -> AgentErrorType -> AM ()
 rcvWorkerInternalError c rcvFileId rcvFileEntityId redirectEntityId_ tmpPath err = do
+  liftIO $ throwWhenInactive c
   lift $ forM_ tmpPath (removePath <=< toFSFilePath)
   withStore' c $ \db -> updateRcvFileError db rcvFileId (show err)
   notify c (fromMaybe rcvFileEntityId redirectEntityId_) (RFERR err)
@@ -318,9 +319,6 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
           withStore' c (`updateRcvFileComplete` rcvFileId)
         Just RcvFileRedirect {redirectFileInfo, redirectDbId} -> do
           let RedirectFileInfo {size = redirectSize, digest = redirectDigest} = redirectFileInfo
-          lift $ forM_ tmpPath (removePath <=< toFSFilePath)
-          liftIO $ waitUntilForeground c
-          withStore' c (`updateRcvFileComplete` rcvFileId)
           -- proceed with redirect
           yaml <- liftError (FILE . FILE_IO . show) (CF.readFile $ CryptoFile fsSavePath cfArgs) `allFinally` (lift $ toFSFilePath fsSavePath >>= removePath)
           next@FileDescription {chunks = nextChunks} <- case strDecode (LB.toStrict yaml) of
@@ -330,9 +328,12 @@ runXFTPRcvLocalWorker c Worker {doWork} = do
               | dstSize /= redirectSize -> throwE . FILE $ REDIRECT "size mismatch"
               | dstDigest /= redirectDigest -> throwE . FILE $ REDIRECT "digest mismatch"
               | otherwise -> pure fd
+          liftIO $ waitUntilForeground c
           -- register and download chunks from the actual file
-          withStore c $ \db -> updateRcvFileRedirect db redirectDbId next
+          withStore c $ \db -> updateRcvFileComplete db rcvFileId >> updateRcvFileRedirect db redirectDbId next
           forM_ nextChunks (downloadChunk c)
+          flip catchAllErrors (\e -> logError $ "XFTP rcv worker error: " <> tshow e) $
+            lift $ forM_ tmpPath (removePath <=< toFSFilePath)
       where
         getChunkPaths :: [RcvFileChunk] -> AM [FilePath]
         getChunkPaths [] = pure []
@@ -512,6 +513,7 @@ runXFTPSndPrepareWorker c Worker {doWork} = do
 
 sndWorkerInternalError :: AgentClient -> DBSndFileId -> SndFileId -> Maybe FilePath -> AgentErrorType -> AM ()
 sndWorkerInternalError c sndFileId sndFileEntityId prefixPath err = do
+  liftIO $ throwWhenInactive c
   lift . forM_ prefixPath $ removePath <=< toFSFilePath
   withStore' c $ \db -> updateSndFileError db sndFileId (show err)
   notify c sndFileEntityId $ SFERR err
@@ -733,6 +735,7 @@ runXFTPDelWorker c srv Worker {doWork} = do
 
 delWorkerInternalError :: AgentClient -> Int64 -> AgentErrorType -> AM ()
 delWorkerInternalError c deletedSndChunkReplicaId e = do
+  liftIO $ throwWhenInactive c
   withStore' c $ \db -> deleteDeletedSndChunkReplica db deletedSndChunkReplicaId
   notify c "" $ SFERR e
 
diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs
index 8d4af8002..1243d6589 100644
--- a/src/Simplex/Messaging/Agent.hs
+++ b/src/Simplex/Messaging/Agent.hs
@@ -2360,9 +2360,9 @@ runCommandProcessing c@AgentClient {subQ} connId server_ Worker {doWork} = do
                     -- 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
+                    rq1' <- withStore' c $ \db -> setRcvQueueStatus db rq' Secured >> setRcvSwitchStatus db rq1 (Just RSSendingQUSE)
                     void . enqueueMessages c cData sqs SMP.noMsgFlags $ QUSE [((server, sndId), True)]
-                    rq1' <- withStore' c $ \db -> setRcvSwitchStatus db rq1 (Just RSSendingQUSE) <* deleteCommand db cmdId
+                    withStore' c (`deleteCommand` cmdId)
                     let rqs' = updatedQs rq1' rqs
                         conn' = DuplexConnection cData rqs' sqs
                     cStats <- connectionStats c conn'
@@ -4118,15 +4118,15 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), THandlePar
                               withStore' c $ \db -> copyPendingSndDeliveries db sq sq2
                               enqueueCommand c "" connId (Just $ qServer sq2) $ AInternalCommand $ ICQSndSecure (snd $ qAddress sq2)
                               pure SSSecuringQueue
-                            else do
-                              let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
-                              void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', C.toPublic sndPrivateKey)]
-                              pure SSSendingQKEY
+                            else pure SSSendingQKEY
                         sq1 <- withStore' c $ \db -> setSndSwitchStatus db sq $ Just swchStatus
                         let sqs'' = updatedQs sq1 sqs' <> [sq2]
                             conn' = DuplexConnection cData' rqs sqs''
                         cStats <- connectionStats c conn'
                         notify $ SWITCH QDSnd SPStarted cStats
+                        when (connAgentVersion < rpcAddressSMPAgentVersion) $ do
+                          let sqInfo' = (sqInfo :: SMPQueueInfo) {queueAddress = queueAddress {dhPublicKey}}
+                          void . enqueueMessages c cData' sqs SMP.noMsgFlags $ QKEY [(sqInfo', C.toPublic sndPrivateKey)]
                       _ -> qError "QADD: won't delete all snd queues in connection"
                   _ -> qError "QADD: replaced queue address is not found in connection"
               _ -> throwE $ AGENT A_VERSION
diff --git a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
index ff28100f5..bbcacfd01 100644
--- a/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
+++ b/src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql
@@ -1,5 +1,3 @@
-
-
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -1531,6 +1529,3 @@ ALTER TABLE ONLY smp_agent_test_protocol_schema.snd_queues
 
 ALTER TABLE ONLY smp_agent_test_protocol_schema.snd_queues
     ADD CONSTRAINT snd_queues_host_port_fkey FOREIGN KEY (host, port) REFERENCES smp_agent_test_protocol_schema.servers(host, port) ON UPDATE CASCADE ON DELETE RESTRICT;
-
-
-
diff --git a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
index 35e4ff47f..627ee9dcf 100644
--- a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
+++ b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql
@@ -1,6 +1,3 @@
-
-
-
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -310,7 +307,3 @@ ALTER TABLE ONLY ntf_server.subscriptions
 
 ALTER TABLE ONLY ntf_server.subscriptions
     ADD CONSTRAINT subscriptions_token_id_fkey FOREIGN KEY (token_id) REFERENCES ntf_server.tokens(token_id) ON UPDATE RESTRICT ON DELETE CASCADE;
-
-
-
-
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 64b4af287..a0088f9a3 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -719,6 +719,7 @@ importStoreLogToDatabase logPath storeLogFile dbOpts = do
   ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
   sCnt <- batchInsertServices services' $ postgresQueueStore ps
   qCnt <- batchInsertQueues @(JournalQueue 'QSMemory) True queues $ postgresQueueStore ps
+  closeMsgStore ps
   renameFile storeLogFile $ storeLogFile <> ".bak"
   pure (sCnt, qCnt)
 
@@ -745,6 +746,7 @@ exportDatabaseToStoreLog logPath dbOpts storeLogFilePath = do
   Sum sCnt <- foldServiceRecs (postgresQueueStore ps) $ \sr -> logNewService sl sr $> Sum (1 :: Int)
   Sum qCnt <- foldQueueRecs True True (postgresQueueStore ps) $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
   closeStoreLog sl
+  closeMsgStore ps
   pure (sCnt, qCnt)
 #endif
 
diff --git a/src/Simplex/Messaging/Server/Names/HttpResolver.hs b/src/Simplex/Messaging/Server/Names/HttpResolver.hs
index 0f272bcf4..b1620447b 100644
--- a/src/Simplex/Messaging/Server/Names/HttpResolver.hs
+++ b/src/Simplex/Messaging/Server/Names/HttpResolver.hs
@@ -141,4 +141,8 @@ httpGet ResolverEnv {manager, baseUrl, authHdr, timeoutMicro, maxResponseBytes}
       else do
         bs <- brReadSome (responseBody res) (maxResponseBytes + 1)
         pure $ if BL.length bs > fromIntegral maxResponseBytes then Left BodyTooLarge else Right bs
-  pure (either (Left . HttpFailure) id result)
+  pure (either (Left . httpError) id result)
+  where
+    httpError = \case
+      HC.HttpExceptionRequest _ HC.ResponseTimeout -> ResolverTimeout
+      e -> HttpFailure e
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
index c39b82990..cea2e0835 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql
@@ -1,6 +1,3 @@
-
-
-
 SET statement_timeout = 0;
 SET lock_timeout = 0;
 SET idle_in_transaction_session_timeout = 0;
@@ -552,7 +549,3 @@ ALTER TABLE ONLY smp_server.msg_queues
 
 ALTER TABLE ONLY smp_server.msg_queues
     ADD CONSTRAINT msg_queues_rcv_service_id_fkey FOREIGN KEY (rcv_service_id) REFERENCES smp_server.services(service_id) ON UPDATE RESTRICT ON DELETE SET NULL;
-
-
-
-
diff --git a/tests/AgentTests.hs b/tests/AgentTests.hs
index 36dc92a95..80539aa49 100644
--- a/tests/AgentTests.hs
+++ b/tests/AgentTests.hs
@@ -19,17 +19,12 @@ import Simplex.Messaging.Server.Env.STM (AStoreType (..))
 import Simplex.Messaging.Transport (ASrvTransport)
 import Test.Hspec hiding (fit, it)
 
-#if defined(dbPostgres)
-import Fixtures
-import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
-#else
+#if !defined(dbPostgres)
 import AgentTests.SQLiteTests (storeTests)
 #endif
 
 #if defined(dbServerPostgres)
 import AgentTests.NotificationTests (notificationTests)
-import SMPClient (postgressBracket)
-import NtfClient (ntfTestServerDBConnectInfo)
 #endif
 
 agentCoreTests :: Spec
@@ -42,16 +37,10 @@ agentCoreTests = do
 
 agentTests :: (ASrvTransport, AStoreType) -> Spec
 agentTests ps = do
-#if defined(dbPostgres)
-  after_ (dropAllSchemasExceptSystem testDBConnectInfo) $ do
-#else
-  do
-#endif
-    describe "Functional API" $ functionalAPITests ps
-    describe "Chosen servers" serverChoiceTests
+  describe "Functional API" $ functionalAPITests ps
+  describe "Chosen servers" serverChoiceTests
 #if defined(dbServerPostgres)
-    around_ (postgressBracket ntfTestServerDBConnectInfo) $
-      describe "Notification tests" $ notificationTests ps
+  describe "Notification tests" $ notificationTests ps
 #endif
 #if !defined(dbPostgres)
   describe "SQLite store" storeTests
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index ebcd8d7d1..cc2b02a29 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -20,6 +20,7 @@
 
 module AgentTests.FunctionalAPITests
   ( functionalAPITests,
+    functionalAPITimingTests,
     testServerMatrix2,
     withAgentClientsCfg2,
     withAgentClientsCfgServers2,
@@ -230,7 +231,7 @@ pattern Rcvd agentMsgId <- RCVD MsgMeta {integrity = MsgOk} [MsgReceipt {agentMs
 pattern Rcvd' :: AgentMsgId -> AgentMsgId -> AEvent 'AEConn
 pattern Rcvd' aMsgId rcvdMsgId <- RCVD MsgMeta {integrity = MsgOk, recipient = (aMsgId, _)} [MsgReceipt {agentMsgId = rcvdMsgId, msgRcptStatus = MROk}]
 
-smpCfgVPrev :: ProtocolClientConfig SMPVersion
+smpCfgVPrev :: HasTestEnv => ProtocolClientConfig SMPVersion
 smpCfgVPrev =
   (smpCfg agentCfg)
     { serverVRange = prevRange $ serverVRange $ smpCfg agentCfg,
@@ -241,10 +242,10 @@ smpCfgVPrev =
 -- ntfCfgVPrev = (ntfCfg agentCfg) {clientALPN = Nothing, serverVRange = V.mkVersionRange (VersionNTF 1) (VersionNTF 1)}
 
 -- currently, previous e2e version is not supported
-agentCfgVPrev :: AgentConfig
+agentCfgVPrev :: HasTestEnv => AgentConfig
 agentCfgVPrev = agentCfgVPrevPQ -- {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
 
-agentCfgVPrevPQ :: AgentConfig
+agentCfgVPrevPQ :: HasTestEnv => AgentConfig
 agentCfgVPrevPQ =
   agentCfg
     { sndAuthAlg = C.AuthAlg C.SEd25519,
@@ -254,7 +255,7 @@ agentCfgVPrevPQ =
       -- ntfCfg = ntfCfgVPrev -- previous version is not supported
     }
 
-agentCfgRatchetVPrev :: AgentConfig
+agentCfgRatchetVPrev :: HasTestEnv => AgentConfig
 agentCfgRatchetVPrev = agentCfg {e2eEncryptVRange = prevRange $ e2eEncryptVRange agentCfg}
 
 mkVersionRange :: Word16 -> Word16 -> VersionRange v
@@ -599,12 +600,15 @@ functionalAPITests ps = do
         it "auth, disabled" $ testBasicAuth ps 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 ps Nothing (noAuthSrv testSMPServer2) `shouldReturn` Right (Just (Right testServerInformation))
-    let srv1 = testSMPServer2 {keyHash = "1234"}
+    let srv1 :: HasTestEnv => SMPServer
+        srv1 = testSMPServer2 {keyHash = "1234"}
     it "should fail with incorrect fingerprint" $ do
       testSMPServerConnectionTest ps Nothing (noAuthSrv srv1) `shouldReturn` Left (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) $ NETWORK NEUnknownCAError)
     describe "server with password" $ do
       let auth = Just "abcd"
+          srv :: HasTestEnv => Maybe BasicAuth -> SMPServerWithAuth
           srv = ProtoServerWithAuth testSMPServer2
+          authErr :: HasTestEnv => ProtocolTestFailure
           authErr = ProtocolTestFailure TSCreateQueue $ SMP (B.unpack $ strEncode testSMPServer2) AUTH
       it "should pass with correct password" $ testSMPServerConnectionTest ps auth (srv auth) `shouldReturn` Right (Just (Right testServerInformation))
       it "should fail without password" $ testSMPServerConnectionTest ps auth (srv Nothing) `shouldReturn` Left authErr
@@ -615,6 +619,9 @@ functionalAPITests ps = do
   describe "Delivery receipts" $ do
     it "should send and receive delivery receipt" $ withSmpServer ps testDeliveryReceipts
     it "send delivery receipts concurrently with messages" $ testDeliveryReceiptsConcurrent ps
+
+functionalAPITimingTests :: (ASrvTransport, AStoreType) -> Spec
+functionalAPITimingTests ps = do
   describe "user network info" $ do
     it "should wait for user network" testWaitForUserNetwork
     it "should not reset online to offline if happens too quickly" testDoNotResetOnlineToOffline
@@ -627,7 +634,7 @@ functionalAPITests ps = do
     it "should create client notice" $ testClientNotice ps
 #endif
 
-testBasicAuth :: (ASrvTransport, AStoreType) -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
+testBasicAuth :: HasTestEnv => (ASrvTransport, AStoreType) -> Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
 testBasicAuth (t, msType) allowNewQueues srv@(srvAuth, srvVersion) clnt1 clnt2 sqSecured baseId = do
   let testCfg = updateCfg (cfgMS msType) $ \cfg' -> cfg' {allowNewQueues, newQueueBasicAuth = srvAuth, smpServerVRange = V.mkVersionRange minServerSMPRelayVersion srvVersion}
       canCreate1 = canCreateQueue allowNewQueues srv clnt1
@@ -644,7 +651,7 @@ canCreateQueue :: Bool -> (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, Ver
 canCreateQueue allowNew (srvAuth, _) (clntAuth, _) =
   allowNew && (isNothing srvAuth || srvAuth == clntAuth)
 
-testMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2 ps runTest = do
   it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentCfg agentCfg initAgentServersProxy 1 $ runTest PQSupportOn True True
   it "current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
@@ -652,7 +659,7 @@ testMatrix2 ps runTest = do
   it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrev agentCfg 1 $ runTest PQSupportOff True False
   it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrev 1 $ runTest PQSupportOff True False
 
-testMatrix2Stress :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testMatrix2Stress :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testMatrix2Stress ps runTest = do
   it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 aCfg aCfg initAgentServersProxy 1 $ runTest PQSupportOn True
   it "current" $ withSmpServer ps $ runTestCfg2 aCfg aCfg 1 $ runTest PQSupportOn False
@@ -660,6 +667,7 @@ testMatrix2Stress ps runTest = do
   it "prev to current" $ withSmpServer ps $ runTestCfg2 aCfgVPrev aCfg 1 $ runTest PQSupportOff False
   it "current to prev" $ withSmpServer ps $ runTestCfg2 aCfg aCfgVPrev 1 $ runTest PQSupportOff False
   where
+    aCfg, aCfgVPrev :: HasTestEnv => AgentConfig
     aCfg = agentCfg {messageRetryInterval = fastMessageRetryInterval}
     aCfgVPrev = agentCfgVPrev {messageRetryInterval = fastMessageRetryInterval}
 
@@ -670,7 +678,7 @@ testBasicMatrix2 ps runTest = do
   it "prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgVPrevPQ agentCfg 1 runTest
   it "current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgVPrevPQ 1 runTest
 
-testRatchetMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
+testRatchetMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> Spec
 testRatchetMatrix2 ps runTest = do
   it "current, via proxy" $ withSmpServerProxy ps $ runTestCfgServers2 agentCfg agentCfg initAgentServersProxy 1 $ runTest PQSupportOn True True
   it "ratchet current" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfg 1 $ runTest PQSupportOn True False
@@ -678,23 +686,23 @@ testRatchetMatrix2 ps runTest = do
   it "ratchets prev to current" $ withSmpServer ps $ runTestCfg2 agentCfgRatchetVPrev agentCfg 1 $ runTest PQSupportOff True False
   it "ratchets current to prev" $ withSmpServer ps $ runTestCfg2 agentCfg agentCfgRatchetVPrev 1 $ runTest PQSupportOff True False
 
-testServerMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (InitialAgentServers -> IO ()) -> Spec
+testServerMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => InitialAgentServers -> IO ()) -> Spec
 testServerMatrix2 ps runTest = do
   it "1 server" $ withSmpServer ps $ runTest initAgentServers
   it "2 servers" $ withSmpServers2 ps $ runTest initAgentServers2
 
-testProxyMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> (Bool -> AgentClient -> AgentClient -> IO ()) -> Spec
+testProxyMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => Bool -> AgentClient -> AgentClient -> IO ()) -> Spec
 testProxyMatrix ps runTest = do
   it "2 servers, directly" $ withSmpServers2 ps $ withAgentClientsServers2 (agentCfg, initAgentServers) (agentCfg, initAgentServers2) $ runTest False
   it "2 servers, via proxy" $ withSmpServersProxy2 ps $ withAgentClientsServers2 (agentCfg, initAgentServersProxy) (agentCfg, initAgentServersProxy2) $ runTest True
 
-testPQMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+testPQMatrix2 :: HasCallStack => (ASrvTransport, AStoreType) -> ((HasCallStack, HasTestEnv) => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 testPQMatrix2 = pqMatrix2_ True
 
-testPQMatrix2NoInv :: HasCallStack => (ASrvTransport, AStoreType) -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+testPQMatrix2NoInv :: HasCallStack => (ASrvTransport, AStoreType) -> ((HasCallStack, HasTestEnv) => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 testPQMatrix2NoInv = pqMatrix2_ False
 
-pqMatrix2_ :: HasCallStack => Bool -> (ASrvTransport, AStoreType) -> (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
+pqMatrix2_ :: HasCallStack => Bool -> (ASrvTransport, AStoreType) -> ((HasCallStack, HasTestEnv) => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) -> Spec
 pqMatrix2_ pqInv ps 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)
@@ -704,12 +712,13 @@ pqMatrix2_ pqInv ps 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 :: HasTestEnv => (AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
     runTest = withSmpServerProxy ps . runTestCfgServers2 agentCfg agentCfg initAgentServersProxy 1
 
 testPQMatrix3 ::
   HasCallStack =>
   (ASrvTransport, AStoreType) ->
-  (HasCallStack => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) ->
+  ((HasCallStack, HasTestEnv) => (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()) ->
   Spec
 testPQMatrix3 ps test = do
   it "dh" $ runTest $ \a b c -> test (a, IKPQOff) (b, PQSupportOff) (c, PQSupportOff)
@@ -721,52 +730,54 @@ testPQMatrix3 ps test = do
   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 :: HasTestEnv => (AgentClient -> AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
     runTest test' =
       withSmpServerProxy ps $
         runTestCfgServers2 agentCfg agentCfg servers 1 $ \a b baseMsgId ->
           withAgent 3 agentCfg servers testDB3 $ \c -> test' a b c baseMsgId
+    servers :: HasTestEnv => InitialAgentServers
     servers = initAgentServersProxy
 
-runTestCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
+runTestCfg2 :: (HasCallStack, HasTestEnv) => AgentConfig -> AgentConfig -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
 runTestCfg2 aCfg bCfg = runTestCfgServers2 aCfg bCfg initAgentServers
 {-# INLINE runTestCfg2 #-}
 
-runTestCfgServers2 :: HasCallStack => AgentConfig -> AgentConfig -> InitialAgentServers -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
+runTestCfgServers2 :: (HasCallStack, HasTestEnv) => AgentConfig -> AgentConfig -> InitialAgentServers -> AgentMsgId -> (HasCallStack => AgentClient -> AgentClient -> AgentMsgId -> IO ()) -> IO ()
 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 a) -> IO a
+withAgentClientsCfgServers2 :: (HasCallStack, HasTestEnv) => 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
 
-withAgentClientsServers2 :: HasCallStack => (AgentConfig, InitialAgentServers) -> (AgentConfig, InitialAgentServers) -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
+withAgentClientsServers2 :: (HasCallStack, HasTestEnv) => (AgentConfig, InitialAgentServers) -> (AgentConfig, InitialAgentServers) -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClientsServers2 (aCfg, aServers) (bCfg, bServers) runTest =
   withAgent 1 aCfg aServers testDB $ \a ->
     withAgent 2 bCfg bServers testDB2 $ \b ->
       runTest a b
 
-withAgentClientsCfg2 :: HasCallStack => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
+withAgentClientsCfg2 :: (HasCallStack, HasTestEnv) => AgentConfig -> AgentConfig -> (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClientsCfg2 aCfg bCfg = withAgentClientsCfgServers2 aCfg bCfg initAgentServers
 {-# INLINE withAgentClientsCfg2 #-}
 
-withAgentClients2 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
+withAgentClients2 :: (HasCallStack, HasTestEnv) => (HasCallStack => AgentClient -> AgentClient -> IO a) -> IO a
 withAgentClients2 = withAgentClientsCfg2 agentCfg agentCfg
 {-# INLINE withAgentClients2 #-}
 
-withAgentClients3 :: HasCallStack => (HasCallStack => AgentClient -> AgentClient -> AgentClient -> IO ()) -> IO ()
+withAgentClients3 :: (HasCallStack, HasTestEnv) => (HasCallStack => AgentClient -> AgentClient -> AgentClient -> IO ()) -> IO ()
 withAgentClients3 runTest =
   withAgentClients2 $ \a b ->
     withAgent 3 agentCfg initAgentServers testDB3 $ \c ->
       runTest a b c
 
-runAgentClientTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientTest :: (HasCallStack, HasTestEnv) => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientTest pqSupport _sqSecured viaProxy alice bob baseId =
   runAgentClientTestPQ viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId
 
-runAgentClientTestPQ :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientTestPQ :: (HasCallStack, HasTestEnv) => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientTestPQ viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
     (bobId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMInvitation Nothing Nothing aPQ False SMSubscribe
@@ -809,7 +820,7 @@ 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 :: (HasCallStack, HasTestEnv) => 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
@@ -841,19 +852,20 @@ runAgentClientStressTestOneWay n pqSupport viaProxy alice bob baseId = runRight_
   where
     msgId = subtract baseId . fst
 
-runAgentClientStressTestConc :: HasCallStack => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientStressTestConc :: (HasCallStack, HasTestEnv) => Int64 -> PQSupport -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientStressTestConc n pqSupport viaProxy alice bob _baseId = runRight_ $ do
   (aliceId, bobId) <- makeConnection_ pqSupport alice bob
   amId <- newTVarIO 0
   bmId <- newTVarIO 0
+  finished <- newTVarIO (0 :: Int)
   let n2 = n `div` 2
   mapConcurrently_ id
     ( [ send alice bobId [1 .. n2],
         send alice bobId [n2 + 1 .. n],
         send bob aliceId [1 .. n2],
         send bob aliceId [n2 + 1 .. n],
-        receive alice bobId amId (n, n, n, 2 * n),
-        receive bob aliceId bmId (n, n, n, 2 * n)
+        receive alice bobId amId finished (n, n, n, 2 * n),
+        receive bob aliceId bmId finished (n, n, n, 2 * n)
       ] :: [ExceptT AgentErrorType IO ()]
     )
   liftIO $ noMessagesIngoreQCONT alice "nothing else should be delivered to alice"
@@ -864,15 +876,19 @@ runAgentClientStressTestConc n pqSupport viaProxy alice bob _baseId = runRight_
     message i = "message " <> bshow i
     send :: AgentClient -> ConnId -> [Int64] -> ExceptT AgentErrorType IO ()
     send a bId = mapM_ $ \i -> void $ A.sendMessage a bId pqEnc SMP.noMsgFlags (message i)
-    receive :: AgentClient -> ConnId -> TVar AgentMsgId -> (Int64, Int64, Int64, Int64) -> ExceptT AgentErrorType IO ()
-    receive a bId mIdVar acc' = loop acc' >> liftIO drain
+    receive :: AgentClient -> ConnId -> TVar AgentMsgId -> TVar Int -> (Int64, Int64, Int64, Int64) -> ExceptT AgentErrorType IO ()
+    receive a bId mIdVar finished acc' = loop acc' >> atomically (modifyTVar' finished (+ 1)) >> liftIO drain
       where
         drain =
-          timeout 100000 (get a)
-            >>= mapM_ (\case ("", _, QCONT) -> drain; r -> expectationFailure $ "unexpected: " <> show r)
+          timeout 100000 (get a) >>= \case
+            Just ("", _, QCONT) -> drain
+            Just r -> expectationFailure $ "unexpected: " <> show r
+            Nothing -> do
+              allFinished <- (== 2) <$> readTVarIO finished
+              unless allFinished drain
         loop (0, 0, 0, 0) = pure ()
         loop acc@(s, !m, !r, !o) =
-          timeout 3000000 (get a) >>= \case
+          timeout 10000000 (get a) >>= \case
             Nothing -> error $ "timeout " <> show acc
             Just evt -> case evt of
               ("", c, A.SENT _mId srv) -> do
@@ -901,7 +917,7 @@ runAgentClientStressTestConc n pqSupport viaProxy alice bob _baseId = runRight_
                 loop (s, m, r, o - 1)
               _ -> liftIO $ expectationFailure $ "unexpected: " <> show r
 
-testEnablePQEncryption :: HasCallStack => IO ()
+testEnablePQEncryption :: (HasCallStack, HasTestEnv) => IO ()
 testEnablePQEncryption =
   withAgentClients2 $ \ca cb -> runRight_ $ do
     g <- liftIO C.newRandom
@@ -968,7 +984,7 @@ sndRcv pqEnc pqEnc' ((c1, id1), mId, msg) (c2, id2) = do
   get c2 =##> \case ("", connId, Msg' mId' pq msg') -> connId == id1 && mId' == mId && msg' == msg && pq == pqEnc; _ -> False
   ackMessage c2 id1 mId Nothing
 
-testAgentClient3 :: HasCallStack => IO ()
+testAgentClient3 :: (HasCallStack, HasTestEnv) => IO ()
 testAgentClient3 =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (aIdForB, bId) <- makeConnection a b
@@ -991,11 +1007,11 @@ testAgentClient3 =
     get c =##> \case ("", connId, Msg "c5") -> connId == aIdForC; _ -> False
     ackMessage c aIdForC 3 Nothing
 
-runAgentClientContactTest :: HasCallStack => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
+runAgentClientContactTest :: (HasCallStack, HasTestEnv) => PQSupport -> SndQueueSecured -> Bool -> AgentClient -> AgentClient -> AgentMsgId -> IO ()
 runAgentClientContactTest pqSupport sqSecured viaProxy alice bob baseId =
   runAgentClientContactTestPQ sqSecured viaProxy (alice, IKLinkPQ pqSupport) (bob, pqSupport) baseId
 
-runAgentClientContactTestPQ :: HasCallStack => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ :: (HasCallStack, HasTestEnv) => SndQueueSecured -> Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ sqSecured viaProxy (alice, aPQ) (bob, bPQ) baseId =
   runRight_ $ do
     (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
@@ -1049,7 +1065,7 @@ allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc = do
   exchangeGreetings_ pqEnc alice bobId bob aliceId
 
 -- DR-advertising contact address, across accept/join modes, InitialKeys, and joiner PQ
-runAgentClientContactDRTest_ :: HasCallStack => Bool -> Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
+runAgentClientContactDRTest_ :: (HasCallStack, HasTestEnv) => Bool -> Bool -> InitialKeys -> Bool -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
 runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
   g <- C.newRandom
   rootKey <- atomically $ C.generateKeyPair g
@@ -1089,7 +1105,7 @@ runAgentClientContactDRTest_ asyncAccept asyncJoin addrIK useDR bPQ ps = withSmp
     allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
 
 -- DR advertising via createConnection (sync) and createConnectionAsync (async NEW), reaching newRcvConnSrv
-runCreateConnectionDRTest_ :: HasCallStack => Bool -> InitialKeys -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
+runCreateConnectionDRTest_ :: (HasCallStack, HasTestEnv) => Bool -> InitialKeys -> PQSupport -> (ASrvTransport, AStoreType) -> IO ()
 runCreateConnectionDRTest_ asyncNew addrIK bPQ ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
   let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
       pqEnc = PQEncryption $ pqConnectionMode addrIK bPQ
@@ -1141,7 +1157,7 @@ joinContactDR alice requester connReq addrIK pqEnc = do
   ("", _, A.CONF confId _ _ "alice's connInfo") <- get requester
   allowConfirmGreet alice reqId requester aliceId confId addrIK pqEnc
 
-testAddressKeyRotation :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAddressKeyRotation :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob carol -> do
   g <- C.newRandom
   rootKey <- atomically $ C.generateKeyPair g
@@ -1168,7 +1184,7 @@ testAddressKeyRotation ps = withSmpServer ps $ withAgentClients3 $ \alice bob ca
     void $ A.joinConnection bob NRMInteractive 1 aId True connReq1 "bob's connInfo" PQSupportOn SMSubscribe
     get alice =##> \case ("", _, A.ERR _) -> True; _ -> False
 
-testAddDRViaSetConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAddDRViaSetConnShortLink :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
   g <- C.newRandom
   rootKey <- atomically $ C.generateKeyPair g
@@ -1186,7 +1202,7 @@ testAddDRViaSetConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \alice
     liftIO $ ratchetKeys cd1 `shouldSatisfy` isJust
 
 -- updating a DR address's link data must preserve the stored ratchet keys
-testAddressUpdatePreservesDRKeys :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAddressUpdatePreservesDRKeys :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \alice bob -> do
   g <- C.newRandom
   rootKey <- atomically $ C.generateKeyPair g
@@ -1217,7 +1233,7 @@ testAddressUpdatePreservesDRKeys ps = withSmpServer ps $ withAgentClients2 $ \al
     allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
 
 -- a DR accept that fails at the network step after committing send queue + ratchet must resume on retry
-testAcceptContactDRResumeAfterOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAcceptContactDRResumeAfterOffline :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
   g <- C.newRandom
   rootKey <- atomically $ C.generateKeyPair g
@@ -1249,7 +1265,7 @@ testAcceptContactDRResumeAfterOffline ps = withAgentClients2 $ \alice bob -> do
     ("", _, A.CONF confId _ _ "alice's connInfo") <- get bob
     allowConfirmGreet alice bobId bob aliceId confId addrIK pqEnc
 
-testAcceptContactDRPrepared :: HasCallStack => Bool -> IO ()
+testAcceptContactDRPrepared :: (HasCallStack, HasTestEnv) => Bool -> IO ()
 testAcceptContactDRPrepared ratchetDeleted =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
@@ -1273,7 +1289,7 @@ testAcceptContactDRPrepared ratchetDeleted =
     allowConfirmGreet alice bobId bob aliceId confId IKPQOn pqEnc
     getConnectionVerifyCodes alice bobId >>= liftIO . (`shouldBe` codes)
 
-runAgentClientContactTestPQ3 :: HasCallStack => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
+runAgentClientContactTestPQ3 :: (HasCallStack, HasTestEnv) => Bool -> (AgentClient, InitialKeys) -> (AgentClient, PQSupport) -> (AgentClient, PQSupport) -> AgentMsgId -> IO ()
 runAgentClientContactTestPQ3 viaProxy (alice, aPQ) (bob, bPQ) (tom, tPQ) baseId = runRight_ $ do
   (_, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing aPQ False SMSubscribe
   (bAliceId, bobId, abPQEnc) <- connectViaContact bob bPQ qInfo
@@ -1325,7 +1341,7 @@ noMessages_ ingoreQCONT c err = tryGet `shouldReturn` ()
         Just msg -> error $ err <> ": " <> show msg
         Nothing -> return ()
 
-testRejectContactRequest :: HasCallStack => IO ()
+testRejectContactRequest :: (HasCallStack, HasTestEnv) => IO ()
 testRejectContactRequest =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (_addrConnId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
@@ -1337,7 +1353,7 @@ testRejectContactRequest =
     rejectContact alice NRMInteractive 1 invId Nothing
     liftIO $ noMessages bob "nothing delivered to bob"
 
-testRejectContactRequestDR :: HasCallStack => IO ()
+testRejectContactRequestDR :: (HasCallStack, HasTestEnv) => IO ()
 testRejectContactRequestDR =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
@@ -1349,7 +1365,7 @@ testRejectContactRequestDR =
     ("", _, A.RJCT "not now") <- get bob
     pure ()
 
-testRejectContactRequestDRAsync :: HasCallStack => IO ()
+testRejectContactRequestDRAsync :: (HasCallStack, HasTestEnv) => IO ()
 testRejectContactRequestDRAsync =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     let userLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
@@ -1364,7 +1380,7 @@ testRejectContactRequestDRAsync =
 serviceUserLinkData :: UserConnLinkData 'CMContact
 serviceUserLinkData = UserContactLinkData UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
 
-testServiceRequestResponse :: HasCallStack => IO ()
+testServiceRequestResponse :: (HasCallStack, HasTestEnv) => IO ()
 testServiceRequestResponse =
   withAgentClients2 $ \service client -> runRight_ $ do
     (_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
@@ -1378,7 +1394,7 @@ testServiceRequestResponse =
     liftIO $ resp `shouldBe` "service response"
     liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
 
-testServiceRequestResponseAsync :: HasCallStack => IO ()
+testServiceRequestResponseAsync :: (HasCallStack, HasTestEnv) => IO ()
 testServiceRequestResponseAsync =
   withAgentClients2 $ \service client -> runRight_ $ do
     (_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
@@ -1392,7 +1408,7 @@ testServiceRequestResponseAsync =
     liftIO $ resp `shouldBe` "service response"
     liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
 
-testServiceRequestRejected :: HasCallStack => IO ()
+testServiceRequestRejected :: (HasCallStack, HasTestEnv) => IO ()
 testServiceRequestRejected =
   withAgentClients2 $ \service client -> runRight_ $ do
     (_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
@@ -1404,7 +1420,7 @@ testServiceRequestRejected =
     liftIO $ resp `shouldBe` Left (AGENT (A_SERVICE (ASERejected "not allowed")))
     liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
 
-testSignedServiceRequest :: HasCallStack => IO ()
+testSignedServiceRequest :: (HasCallStack, HasTestEnv) => IO ()
 testSignedServiceRequest =
   withAgentClients2 $ \service client -> runRight_ $ do
     (_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
@@ -1419,7 +1435,7 @@ testSignedServiceRequest =
     liftIO $ resp `shouldBe` "service response"
     liftIO $ threadDelay 250000 -- let the async teardown of the reply queues settle before dispose
 
-testSignedServiceRequestAsync :: HasCallStack => IO ()
+testSignedServiceRequestAsync :: (HasCallStack, HasTestEnv) => IO ()
 testSignedServiceRequestAsync =
   withAgentClients2 $ \service client -> runRight_ $ do
     (_addrConnId, CCLink connReq _) <- A.createConnection service NRMInteractive 1 True True SCMContact (Just serviceUserLinkData) Nothing IKPQOn True SMSubscribe
@@ -1437,7 +1453,7 @@ testSignedServiceRequestAsync =
 -- server down, send, up, receive, down, reply, up, receive response.
 -- The request send retries the outage (bounded by serviceRequestTimeout) until the server is back; the reply is
 -- queued while the server is down and delivered on reconnect (async reply via ICReplyDel); the blocking call receives it.
-testServiceRequestResilient :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testServiceRequestResilient :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testServiceRequestResilient ps = withAgentClients2 $ \service client -> do
   -- server up: create the service address
   connReq <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
@@ -1463,7 +1479,7 @@ testServiceRequestResilient ps = withAgentClients2 $ \service client -> do
     wait reqAsync
   resp `shouldBe` Right "resilient response"
 
-testUpdateConnectionUserId :: HasCallStack => IO ()
+testUpdateConnectionUserId :: (HasCallStack, HasTestEnv) => IO ()
 testUpdateConnectionUserId =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (connId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -1480,7 +1496,7 @@ testUpdateConnectionUserId =
     get bob ##> ("", aliceId, A.INFO PQSupportOn "alice's connInfo")
     get bob ##> ("", aliceId, A.CON pqEnc)
 
-testAsyncInitiatingOffline :: HasCallStack => IO ()
+testAsyncInitiatingOffline :: (HasCallStack, HasTestEnv) => IO ()
 testAsyncInitiatingOffline =
   withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> runRight_ $ do
     alice <- liftIO $ getSMPAgentClient' 1 agentCfg initAgentServers testDB
@@ -1516,7 +1532,7 @@ testAsyncInitiatingOffline =
     exchangeGreetingsMsgId 4 alice' bobId bob aliceId
     liftIO $ disposeAgentClient alice'
 
-testAsyncJoiningOfflineBeforeActivation :: HasCallStack => IO ()
+testAsyncJoiningOfflineBeforeActivation :: (HasCallStack, HasTestEnv) => IO ()
 testAsyncJoiningOfflineBeforeActivation =
   withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight_ $ do
     bob <- liftIO $ getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -1534,7 +1550,7 @@ testAsyncJoiningOfflineBeforeActivation =
     exchangeGreetings alice bobId bob' aliceId
     liftIO $ disposeAgentClient bob'
 
-testAsyncBothOffline :: HasCallStack => IO ()
+testAsyncBothOffline :: (HasCallStack, HasTestEnv) => IO ()
 testAsyncBothOffline = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -1557,7 +1573,7 @@ testAsyncBothOffline = do
     liftIO $ disposeAgentClient alice'
     liftIO $ disposeAgentClient bob'
 
-testAsyncServerOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAsyncServerOffline :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAsyncServerOffline ps = withAgentClients2 $ \alice bob -> do
   -- create connection and shutdown the server
   (bobId, cReq) <- withSmpServerStoreLogOn ps testPort $ \_ ->
@@ -1583,7 +1599,7 @@ testAsyncServerOffline ps = withAgentClients2 $ \alice bob -> do
     get bob ##> ("", aliceId, CON)
     exchangeGreetings alice bobId bob aliceId
 
-testAllowConnectionClientRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAllowConnectionClientRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
   let initAgentServersSrv2 = initAgentServers {smp = userServers [testSMPServer2]}
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
@@ -1622,7 +1638,7 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
     disposeAgentClient alice2
     disposeAgentClient bob
 
-testInvitationErrors :: HasCallStack => (ASrvTransport, AStoreType) -> Bool -> IO ()
+testInvitationErrors :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> Bool -> IO ()
 testInvitationErrors ps restart = do
   a <- getAgentA
   b <- getAgentB
@@ -1675,10 +1691,10 @@ testInvitationErrors ps restart = do
       disposeAgentClient a
       disposeAgentClient b'
 
-restartAgentA :: Bool -> AgentClient -> [ConnId] -> IO AgentClient
+restartAgentA :: HasTestEnv => Bool -> AgentClient -> [ConnId] -> IO AgentClient
 restartAgentA = restartAgent_ getAgentA
 
-restartAgentB :: Bool -> AgentClient -> [ConnId] -> IO AgentClient
+restartAgentB :: HasTestEnv => Bool -> AgentClient -> [ConnId] -> IO AgentClient
 restartAgentB = restartAgent_ getAgentB
 
 restartAgent_ :: IO AgentClient -> Bool -> AgentClient -> [ConnId] -> IO AgentClient
@@ -1692,7 +1708,7 @@ restartAgent_ getAgent restart c cIds
       pure c'
   | otherwise = pure c
 
-testContactErrors :: HasCallStack => (ASrvTransport, AStoreType) -> Bool -> IO ()
+testContactErrors :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> Bool -> IO ()
 testContactErrors ps restart = do
   a <- getAgentA
   b <- getAgentB
@@ -1750,6 +1766,10 @@ testContactErrors ps restart = do
             Left _ -> putStrLn "retrying accept confirm" >> threadDelay 200000 >> loopConfirm (n + 1)
     n <- loopConfirm 1
     ("", _, A.CONF confId PQSupportOn _ "alice's connInfo") <- get b''
+    let waitAck = do
+          ServerQueueInfo {info = QueueInfo {qiSize}} <- runRight $ getConnectionQueueInfo b'' NRMInteractive aId
+          when (qiSize > 0) $ threadDelay 20000 >> waitAck
+    waitAck
     pure (n, confId)
   ("", "", DOWN _ [_]) <- nGet b''
   runRight_ $ allowConnection b'' aId confId "bob's connInfo"
@@ -1765,19 +1785,19 @@ testContactErrors ps restart = do
       disposeAgentClient a''
       disposeAgentClient b''
 
-getAgentA :: IO AgentClient
+getAgentA :: HasTestEnv => IO AgentClient
 getAgentA = getSMPAgentClient' 1 agentCfg initAgentServers testDB
 
-getAgentB :: IO AgentClient
+getAgentB :: HasTestEnv => IO AgentClient
 getAgentB = getSMPAgentClient' 2 agentCfg (initAgentServers {smp = userServers [testSMPServer2]}) testDB2
 
-withServer1 :: (ASrvTransport, AStoreType) -> IO a -> IO a
+withServer1 :: HasTestEnv => (ASrvTransport, AStoreType) -> IO a -> IO a
 withServer1 ps = withSmpServerStoreLogOn ps testPort . const
 
-withServer2 :: (ASrvTransport, AStoreType) -> IO a -> IO a
+withServer2 :: HasTestEnv => (ASrvTransport, AStoreType) -> IO a -> IO a
 withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 . const
 
-testInvitationShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
+testInvitationShortLink :: (HasCallStack, HasTestEnv) => Bool -> AgentClient -> AgentClient -> IO ()
 testInvitationShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
     let userData = UserLinkData "some user data"
@@ -1839,7 +1859,7 @@ relayLink1 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406
 relayLink2 :: ConnShortLink 'CMContact
 relayLink2 = either error id $ strDecode "https://localhost/a#4AkRDmhf64tdRlN406g8lJRg5OCmhD6ynIhi6glOcCM"
 
-testContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
+testContactShortLink :: (HasCallStack, HasTestEnv) => Bool -> AgentClient -> AgentClient -> IO ()
 testContactShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
     let userData = UserLinkData "some user data"
@@ -1891,7 +1911,7 @@ testContactShortLink viaProxy a b =
     Left (SMP _ AUTH) <- runExceptT $ getConnShortLink c 1 shortLink
     pure ()
 
-testAddContactShortLink :: HasCallStack => Bool -> AgentClient -> AgentClient -> IO ()
+testAddContactShortLink :: (HasCallStack, HasTestEnv) => Bool -> AgentClient -> AgentClient -> IO ()
 testAddContactShortLink viaProxy a b =
   withAgent 3 agentCfg initAgentServers testDB3 $ \c -> do
     (contactId, CCLink connReq0 Nothing) <- runRight $ A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMSubscribe
@@ -1937,7 +1957,7 @@ testAddContactShortLink viaProxy a b =
     connReq4 `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
 
-testInvitationShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testInvitationShortLinkRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
   let userData = UserLinkData "some user data"
       newLinkData = UserInvLinkData userData
@@ -1950,7 +1970,7 @@ testInvitationShortLinkRestart ps = withAgentClients2 $ \a b -> do
     connReq' `shouldBe` connReq
     linkUserData connData' `shouldBe` userData
 
-testContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testContactShortLinkRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
   let userData = UserLinkData "some user data"
       userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
@@ -1974,7 +1994,7 @@ testContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
     linkConnReq fd4 `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
 
-testAddContactShortLinkRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testAddContactShortLinkRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
   let userData = UserLinkData "some user data"
       userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
@@ -1999,7 +2019,7 @@ testAddContactShortLinkRestart ps = withAgentClients2 $ \a b -> do
     linkConnReq fd4 `shouldBe` connReq
     updatedCtData' `shouldBe` updatedCtData
 
-testOldContactQueueShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testOldContactQueueShortLink :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
   (contactId, CCLink connReq Nothing) <- withSmpServer ps $ runRight $
     A.createConnection a NRMInteractive 1 True True SCMContact Nothing Nothing CR.IKPQOn False SMOnlyCreate
@@ -2055,7 +2075,7 @@ replaceSubstringInFile filePath oldText newText = do
   let newContent = T.replace oldText newText content
   T.writeFile filePath newContent
 
-testPrepareCreateConnectionLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareCreateConnectionLink :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
   let userData = UserLinkData "test user data"
       userCtData = UserContactData {direct = True, owners = [], relays = [], userData, ratchetKeys = Nothing}
@@ -2087,7 +2107,7 @@ testPrepareCreateConnectionLink ps = withSmpServer ps $ withAgentClients2 $ \a b
     get b ##> ("", bId, CON)
     exchangeGreetings a aId b bId
 
-testPrepareCreateInvitationLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareCreateInvitationLink :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testPrepareCreateInvitationLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
   let userData = UserLinkData "test user data"
   runRight_ $ do
@@ -2100,7 +2120,7 @@ testPrepareCreateInvitationLink ps = withSmpServer ps $ withAgentClients2 $ \a b
     liftIO $ linkUserData connData' `shouldBe` userData
     testJoinConn_ False True a bId b connReq
 
-testPrepareInvitationLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareInvitationLinkTooLarge :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testPrepareInvitationLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
   runRight_ $ do
     (preparedReq, preparedParams) <- A.prepareInvitationLink a 1 CR.IKPQOn Nothing
@@ -2108,7 +2128,7 @@ testPrepareInvitationLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg i
     pure ()
   withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
 
-testPrepareContactLinkTooLarge :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareContactLinkTooLarge :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testPrepareContactLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg initAgentServers testDB $ \a -> do
   let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData $ B.replicate 14000 'a', ratchetKeys = Nothing}
   g <- C.newRandom
@@ -2120,7 +2140,7 @@ testPrepareContactLinkTooLarge ps = withSmpServer ps $ withAgent 1 agentCfg init
     pure ()
   withTransaction (store $ agentEnv a) getConnIds `shouldReturn` []
 
-testPrepareConnShortLink :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testPrepareConnShortLink :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testPrepareConnShortLink ps = withSmpServer ps $ withAgentClients2 $ \a b -> do
   let userCtData = UserContactData {direct = True, owners = [], relays = [], userData = UserLinkData "test user data", ratchetKeys = Nothing}
   runRight_ $ do
@@ -2150,7 +2170,7 @@ connReqWithKeys cr rk = case cr of
   BCRInvitationUri crData e2eParams -> CRInvitationUri crData e2eParams
   BCRContactUri crData -> CRContactUri crData rk
 
-testIncreaseConnAgentVersion :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testIncreaseConnAgentVersion :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testIncreaseConnAgentVersion ps = do
   alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 6 7} initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 6 7} initAgentServers testDB2
@@ -2215,7 +2235,7 @@ checkVersion c connId v = do
   ConnectionStats {connAgentVersion} <- getConnectionServers c connId
   liftIO $ connAgentVersion `shouldBe` VersionSMPA v
 
-testIncreaseConnAgentVersionMaxCompatible :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testIncreaseConnAgentVersionMaxCompatible :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testIncreaseConnAgentVersionMaxCompatible ps = do
   alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 6 7} initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 6 7} initAgentServers testDB2
@@ -2245,7 +2265,7 @@ testIncreaseConnAgentVersionMaxCompatible ps = do
     disposeAgentClient alice2
     disposeAgentClient bob2
 
-testIncreaseConnAgentVersionStartDifferentVersion :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testIncreaseConnAgentVersionStartDifferentVersion :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testIncreaseConnAgentVersionStartDifferentVersion ps = do
   alice <- getSMPAgentClient' 1 agentCfg {smpAgentVRange = mkVersionRange 6 7} initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg {smpAgentVRange = mkVersionRange 6 8} initAgentServers testDB2
@@ -2271,7 +2291,7 @@ testIncreaseConnAgentVersionStartDifferentVersion ps = do
     disposeAgentClient alice2
     disposeAgentClient bob
 
-testDeliverClientRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testDeliverClientRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testDeliverClientRestart ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2302,7 +2322,7 @@ testDeliverClientRestart ps = do
   disposeAgentClient alice
   disposeAgentClient bob2
 
-testDuplicateMessage :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testDuplicateMessage :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testDuplicateMessage ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2354,7 +2374,7 @@ testDuplicateMessage ps = do
   disposeAgentClient alice2
   disposeAgentClient bob2
 
-testSkippedMessages :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testSkippedMessages :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testSkippedMessages (t, msType) = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2405,7 +2425,7 @@ testSkippedMessages (t, msType) = do
   where
     cfg' = withServerCfg (cfgMS msType) $ \cfg_ -> ASrvCfg SQSMemory SMSMemory cfg_ {serverStoreCfg = SSCMemory $ Just $ StorePaths testStoreLogFile Nothing}
 
-testDeliveryAfterSubscriptionError :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testDeliveryAfterSubscriptionError :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testDeliveryAfterSubscriptionError ps = do
   (aId, bId) <- withAgentClients2 $ \a b -> do
     (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ makeConnection a b
@@ -2423,7 +2443,7 @@ testDeliveryAfterSubscriptionError ps = do
       withUP b aId $ \case ("", c, Msg "hello") -> c == aId; _ -> False
       ackMessage b aId 2 Nothing
 
-testMsgDeliveryQuotaExceeded :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testMsgDeliveryQuotaExceeded :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testMsgDeliveryQuotaExceeded ps =
   withAgentClients2 $ \a b -> withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -2451,7 +2471,7 @@ testMsgDeliveryQuotaExceeded ps =
     get a =##> \case ("", c, SENT 6) -> bId == c; _ -> False
     liftIO $ concurrently_ (noMessages a "no more events") (noMessages b "no more events")
 
-testExpireMessage :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testExpireMessage :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testExpireMessage ps =
   withAgent 1 agentCfg {messageTimeout = 1.5, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
@@ -2467,7 +2487,7 @@ testExpireMessage ps =
         withUP b aId $ \case ("", _, MsgErr 2 (MsgSkipped 2 2) "2") -> True; _ -> False
         ackMessage b aId 2 Nothing
 
-testExpireManyMessages :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testExpireManyMessages :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testExpireManyMessages ps =
   withAgent 1 agentCfg {messageTimeout = 2, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB $ \a ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
@@ -2506,7 +2526,7 @@ withUP a bId p =
         \case (corrId, c, AEvt SAEConn cmd) -> c == bId && p (corrId, c, cmd); _ -> False
       ]
 
-testExpireMessageQuota :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testExpireMessageQuota :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testExpireMessageQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
   a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 1, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
   b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2534,7 +2554,7 @@ testExpireMessageQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
 
-testExpireManyMessagesQuota :: (ASrvTransport, AStoreType) -> IO ()
+testExpireManyMessagesQuota :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
   a <- getSMPAgentClient' 1 agentCfg {quotaExceededTimeout = 2, messageRetryInterval = fastMessageRetryInterval} initAgentServers testDB
   b <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2573,7 +2593,7 @@ testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
 
-testJoinFullContactAsync :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testJoinFullContactAsync :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
   (contactId, qInfo) <- fillContactAddress
   withAgent 2 agentCfg {commandQuotaRetryInterval = fastRetryInterval} initAgentServers testDB2 $ \bob -> do
@@ -2592,7 +2612,7 @@ testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
 
-testJoinFullContactAsyncExpire :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testJoinFullContactAsyncExpire :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
   (_, qInfo) <- fillContactAddress
   withAgent 2 agentCfg {quotaExceededTimeout = 2, commandQuotaRetryInterval = fastRetryInterval} initAgentServers testDB2 $ \bob -> do
@@ -2606,7 +2626,7 @@ testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPo
   where
     cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
 
-fillContactAddress :: HasCallStack => IO (ConnId, ConnectionRequestUri 'CMContact)
+fillContactAddress :: (HasCallStack, HasTestEnv) => IO (ConnId, ConnectionRequestUri 'CMContact)
 fillContactAddress = do
   (contactId, qInfo) <- withAgent 1 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     (contactId, CCLink qInfo Nothing) <- A.createConnection alice NRMInteractive 1 True True SCMContact Nothing Nothing IKPQOn False SMSubscribe
@@ -2616,7 +2636,7 @@ fillContactAddress = do
     void $ A.joinConnection carol NRMInteractive 1 aliceId True qInfo "carol's connInfo" PQSupportOn SMSubscribe
   pure (contactId, qInfo)
 
-testDropMsgAfterRcvAttempts :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testDropMsgAfterRcvAttempts :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testDropMsgAfterRcvAttempts ps =
   withSmpServerStoreLogOn ps testPort $ \_ -> do
     let rcvCfg = agentCfg {rcvExpireCount = 2, rcvExpireInterval = 1}
@@ -2648,7 +2668,7 @@ testDropMsgAfterRcvAttempts ps =
     disposeAgentClient bob3
     disposeAgentClient alice
 
-testRatchetSync :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSync :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSync ps = withAgentClients2 $ \alice bob ->
   withSmpServerStoreMsgLogOn ps testPort $ \_ -> do
     (aliceId, bobId, bob2) <- setupDesynchronizedRatchet alice bob
@@ -2662,7 +2682,7 @@ testRatchetSync ps = withAgentClients2 $ \alice bob ->
       exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
     disposeAgentClient bob2
 
-setupDesynchronizedRatchet :: HasCallStack => AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
+setupDesynchronizedRatchet :: (HasCallStack, HasTestEnv) => AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
 setupDesynchronizedRatchet alice bob = do
   (aliceId, bobId) <- runRight $ makeConnection alice bob
   runRight_ $ do
@@ -2722,7 +2742,7 @@ ratchetSyncP' cId rss = \case
     cId' == cId && rss' == rss && ratchetSyncState == rss
   _ -> False
 
-testRatchetSyncServerOffline :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncServerOffline :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncServerOffline ps = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
     setupDesynchronizedRatchet alice bob
@@ -2748,7 +2768,7 @@ serverUpP = \case
   ("", "", AEvt SAENone (UP _ _)) -> True
   _ -> False
 
-testRatchetSyncClientRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncClientRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncClientRestart ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2773,7 +2793,7 @@ testRatchetSyncClientRestart ps = do
   disposeAgentClient bob
   disposeAgentClient bob3
 
-testRatchetSyncSuspendForeground :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncSuspendForeground :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncSuspendForeground ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2802,7 +2822,7 @@ testRatchetSyncSuspendForeground ps = do
   disposeAgentClient bob
   disposeAgentClient bob2
 
-testRatchetSyncSimultaneous :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncSimultaneous :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncSimultaneous ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bob <- getSMPAgentClient' 2 agentCfg initAgentServers testDB2
@@ -2830,7 +2850,7 @@ testRatchetSyncSimultaneous ps = do
   disposeAgentClient bob
   disposeAgentClient bob2
 
-testRatchetSyncReplayedKey :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncReplayedKey :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncReplayedKey ps = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
     setupDesynchronizedRatchet alice bob
@@ -2851,7 +2871,7 @@ testRatchetSyncReplayedKey ps = withAgentClients2 $ \alice bob -> do
     runRight_ $ exchangeGreetingsMsgIds alice bobId 10 bob2 aliceId 7
   disposeAgentClient bob2
 
-testRatchetSyncRepeated :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncRepeated :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncRepeated ps = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId, bob2) <- startRatchetSyncOffline ps alice bob
   ConnectionStats {ratchetSyncState = rss2} <- runRight $ synchronizeRatchet bob2 aliceId PQSupportOn True
@@ -2872,7 +2892,7 @@ testRatchetSyncRepeated ps = withAgentClients2 $ \alice bob -> do
   map fst <$> processedRatchetKeyHashes bob2 `shouldReturn` [aliceId, aliceId]
   disposeAgentClient bob2
 
-testRatchetSyncFailedKeyNotProcessed :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncFailedKeyNotProcessed :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncFailedKeyNotProcessed ps = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId, bob2) <- startRatchetSyncOffline ps alice bob
   withTransaction (store $ agentEnv bob2) $ \db ->
@@ -2891,7 +2911,7 @@ testRatchetSyncFailedKeyNotProcessed ps = withAgentClients2 $ \alice bob -> do
       (_, cId', AEvt SAEConn (ERR (A.INTERNAL e))) -> cId' == cId && "SEX3dhKeysNotFound" `isPrefixOf` e
       _ -> False
 
-testRatchetSyncFailedRecreationNoReply :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncFailedRecreationNoReply :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncFailedRecreationNoReply ps = withAgentClients2 $ \alice bob -> do
   (_, bobId, bob2) <- startRatchetSyncOffline ps alice bob
   aliceSndMsgs <- sndMessages alice
@@ -2910,7 +2930,7 @@ testRatchetSyncFailedRecreationNoReply ps = withAgentClients2 $ \alice bob -> do
       (_, cId', AEvt SAEConn (ERR (A.INTERNAL e))) -> cId' == cId && "ratchet insert failed" `isInfixOf` e
       _ -> False
 
-testRatchetSyncStartFailedNoKey :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testRatchetSyncStartFailedNoKey :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testRatchetSyncStartFailedNoKey ps = withAgentClients2 $ \alice bob -> do
   (aliceId, _, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
     setupDesynchronizedRatchet alice bob
@@ -2925,7 +2945,7 @@ testRatchetSyncStartFailedNoKey ps = withAgentClients2 $ \alice bob -> do
   sndMessages bob2 `shouldReturn` bobSndMsgs
   disposeAgentClient bob2
 
-startRatchetSyncOffline :: HasCallStack => (ASrvTransport, AStoreType) -> AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
+startRatchetSyncOffline :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> AgentClient -> AgentClient -> IO (ConnId, ConnId, AgentClient)
 startRatchetSyncOffline ps alice bob = do
   (aliceId, bobId, bob2) <- withSmpServerStoreMsgLogOn ps testPort $ \_ ->
     setupDesynchronizedRatchet alice bob
@@ -2951,7 +2971,7 @@ getMSGNTF :: AgentClient -> ConnId -> ExceptT AgentErrorType IO ()
 getMSGNTF c cId =
   get c =##> \case ("", c', MSGNTF {}) -> c' == cId; _ -> False
 
-testOnlyCreatePull :: IO ()
+testOnlyCreatePull :: HasTestEnv => IO ()
 testOnlyCreatePull = withAgentClients2 $ \alice bob -> runRight_ $ do
   (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMOnlyCreate
   (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMOnlyCreate
@@ -3004,7 +3024,7 @@ makeConnectionForUsers_ pqSupport alice aliceUserId bob bobUserId = do
   get bob ##> ("", aliceId, A.CON pqEnc)
   pure (aliceId, bobId)
 
-testInactiveNoSubs :: (ASrvTransport, AStoreType) -> IO ()
+testInactiveNoSubs :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testInactiveNoSubs (t, msType) = do
   let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
   withSmpServerConfigOn t cfg' testPort $ \_ ->
@@ -3014,7 +3034,7 @@ testInactiveNoSubs (t, msType) = do
       Just (_, _, AEvt SAENone (DISCONNECT _ _)) <- timeout 5000000 $ atomically (readTBQueue $ subQ alice)
       pure ()
 
-testInactiveWithSubs :: (ASrvTransport, AStoreType) -> IO ()
+testInactiveWithSubs :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testInactiveWithSubs (t, msType) = do
   let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
   withSmpServerConfigOn t cfg' testPort $ \_ ->
@@ -3025,7 +3045,7 @@ testInactiveWithSubs (t, msType) = do
       -- and after 2 sec of inactivity no DOWN is sent as we have a live subscription
       liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing
 
-testActiveClientNotDisconnected :: (ASrvTransport, AStoreType) -> IO ()
+testActiveClientNotDisconnected :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testActiveClientNotDisconnected (t, msType) = do
   let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}}
   withSmpServerConfigOn t cfg' testPort $ \_ ->
@@ -3052,7 +3072,7 @@ testActiveClientNotDisconnected (t, msType) = do
           liftIO $ timeout 1200000 (get alice) `shouldReturn` Nothing
     milliseconds ts = systemSeconds ts * 1000 + fromIntegral (systemNanoseconds ts `div` 1000000)
 
-testSuspendingAgent :: IO ()
+testSuspendingAgent :: HasTestEnv => IO ()
 testSuspendingAgent =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -3068,7 +3088,7 @@ testSuspendingAgent =
     liftIO $ foregroundAgent b
     get b =##> \case ("", c, Msg "hello 2") -> c == aId; _ -> False
 
-testSuspendingAgentCompleteSending :: (ASrvTransport, AStoreType) -> IO ()
+testSuspendingAgentCompleteSending :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testSuspendingAgentCompleteSending ps = withAgentClients2 $ \a b -> do
   (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -3099,7 +3119,7 @@ testSuspendingAgentCompleteSending ps = withAgentClients2 $ \a b -> do
     get a =##> \case ("", c, Msg "how are you?") -> c == bId; _ -> False
     ackMessage a bId 4 Nothing
 
-testSuspendingAgentTimeout :: (ASrvTransport, AStoreType) -> IO ()
+testSuspendingAgentTimeout :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testSuspendingAgentTimeout ps = withAgentClients2 $ \a b -> do
   (aId, _) <- withSmpServer ps . runRight $ do
     (aId, bId) <- makeConnection a b
@@ -3118,7 +3138,7 @@ testSuspendingAgentTimeout ps = withAgentClients2 $ \a b -> do
     ("", "", SUSPENDED) <- nGet b
     pure ()
 
-testBatchedSubscriptions :: Int -> Int -> (ASrvTransport, AStoreType) -> IO ()
+testBatchedSubscriptions :: HasTestEnv => Int -> Int -> (ASrvTransport, AStoreType) -> IO ()
 testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) = do
   (conns, conns') <- withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     conns <- runServers $ do
@@ -3187,7 +3207,7 @@ testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) = do
         killThread t1
         pure res
 
-testBatchedPendingMessages :: Int -> Int -> IO ()
+testBatchedPendingMessages :: HasTestEnv => Int -> Int -> IO ()
 testBatchedPendingMessages nCreate nMsgs =
   withA $ \a -> do
     conns <- withB $ \b -> runRight $ do
@@ -3208,7 +3228,7 @@ testBatchedPendingMessages nCreate nMsgs =
     withA = withAgent 1 agentCfg initAgentServers testDB
     withB = withAgent 2 agentCfg initAgentServers testDB2
 
-testSendMessagesB :: IO ()
+testSendMessagesB :: HasTestEnv => IO ()
 testSendMessagesB = withAgentClients2 $ \a b -> runRight_ $ do
   (aId, bId) <- makeConnection a b
   let msg cId body = Right (cId, PQEncOn, SMP.noMsgFlags, vrValue body)
@@ -3220,7 +3240,7 @@ testSendMessagesB = withAgentClients2 $ \a b -> runRight_ $ do
   receiveMsg b aId 3 "msg 2"
   receiveMsg b aId 4 "msg 3"
 
-testSendMessagesB2 :: IO ()
+testSendMessagesB2 :: HasTestEnv => IO ()
 testSendMessagesB2 = withAgentClients3 $ \a b c -> runRight_ $ do
   (abId, bId) <- makeConnection a b
   (acId, cId) <- makeConnection a c
@@ -3320,7 +3340,7 @@ testAsyncCommands alice bob baseId =
   where
     msgId = subtract baseId
 
-testSetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
+testSetConnShortLinkAsync :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
   withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
     let userData = UserLinkData "test user data"
@@ -3352,7 +3372,7 @@ testSetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
 
-testGetConnShortLinkAsync :: (ASrvTransport, AStoreType) -> IO ()
+testGetConnShortLinkAsync :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
   withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
     let userData = UserLinkData "test user data"
@@ -3380,7 +3400,7 @@ testGetConnShortLinkAsync ps = withAgentClients2 $ \alice bob ->
     get alice ##> ("", bobId, CON)
     get bob ##> ("", aliceId, CON)
 
-testAsyncCommandsRestore :: (ASrvTransport, AStoreType) -> IO ()
+testAsyncCommandsRestore :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testAsyncCommandsRestore ps = do
   alice <- getSMPAgentClient' 1 agentCfg initAgentServers testDB
   bobId <- runRight $ do
@@ -3435,7 +3455,7 @@ testAcceptContactAsync alice bob baseId =
   where
     msgId = subtract baseId
 
-testDeleteConnectionAsync :: (ASrvTransport, AStoreType) -> IO ()
+testDeleteConnectionAsync :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testDeleteConnectionAsync ps =
   withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \a -> do
     connIds <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
@@ -3444,14 +3464,14 @@ testDeleteConnectionAsync ps =
       (bId3, _inv) <- createConnection a 1 True SCMInvitation Nothing SMSubscribe
       pure ([bId1, bId2, bId3] :: [ConnId])
     runRight_ $ do
-      deleteConnectionsAsync a False connIds
       nGet a =##> \case ("", "", DOWN {}) -> True; _ -> False
+      deleteConnectionsAsync a False connIds
       let delOk = \case (c, _, _, Just (BROKER _ e)) -> c `elem` connIds && networkOrTimeoutError e; _ -> False
       get a =##> \case ("", "", DEL_RCVQS rs) -> length rs == 3 && all delOk rs; _ -> False
       get a =##> \case ("", "", DEL_CONNS cs) -> length cs == 3 && all (`elem` connIds) cs; _ -> False
       liftIO $ noMessages a "nothing else should be delivered to alice"
 
-testWaitDeliveryNoPending :: (ASrvTransport, AStoreType) -> IO ()
+testWaitDeliveryNoPending :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testWaitDeliveryNoPending ps = withAgentClients2 $ \alice bob ->
   withSmpServerStoreLogOn ps testPort $ \_ -> runRight_ $ do
     (aliceId, bobId) <- makeConnection alice bob
@@ -3479,7 +3499,7 @@ testWaitDeliveryNoPending ps = withAgentClients2 $ \alice bob ->
     baseId = 1
     msgId = subtract baseId
 
-testWaitDelivery :: (ASrvTransport, AStoreType) -> IO ()
+testWaitDelivery :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testWaitDelivery ps =
   withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
@@ -3533,7 +3553,7 @@ testWaitDelivery ps =
     baseId = 1
     msgId = subtract baseId
 
-testWaitDeliveryAUTHErr :: (ASrvTransport, AStoreType) -> IO ()
+testWaitDeliveryAUTHErr :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testWaitDeliveryAUTHErr ps =
   withAgent 1 agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
@@ -3576,7 +3596,7 @@ testWaitDeliveryAUTHErr ps =
     baseId = 1
     msgId = subtract baseId
 
-testWaitDeliveryTimeout :: (ASrvTransport, AStoreType) -> IO ()
+testWaitDeliveryTimeout :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testWaitDeliveryTimeout ps = do
   aliceId <- withAgent 1 agentCfg {connDeleteDeliveryTimeout = 1, initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
@@ -3621,7 +3641,7 @@ testWaitDeliveryTimeout ps = do
     baseId = 1
     msgId = subtract baseId
 
-testWaitDeliveryTimeout2 :: (ASrvTransport, AStoreType) -> IO ()
+testWaitDeliveryTimeout2 :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testWaitDeliveryTimeout2 ps =
   withAgent 1 agentCfg {connDeleteDeliveryTimeout = 2, messageRetryInterval = fastMessageRetryInterval, initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3} initAgentServers testDB $ \alice ->
     withAgent 2 agentCfg initAgentServers testDB2 $ \bob -> do
@@ -3673,7 +3693,7 @@ networkOrTimeoutError = \case
   NETWORK _ -> True
   _ -> False
 
-testJoinConnectionAsyncReplyError :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testJoinConnectionAsyncReplyError :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
   let initAgentServersSrv2 = initAgentServers {smp = userServers [testSMPServer2]}
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
@@ -3715,7 +3735,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
           get b ##> ("", aId, CON)
           exchangeGreetings a bId b aId
 
-testUsers :: IO ()
+testUsers :: HasTestEnv => IO ()
 testUsers =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -3730,7 +3750,7 @@ testUsers =
     exchangeGreetingsMsgId 4 a bId b aId
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
-testDeleteUserQuietly :: IO ()
+testDeleteUserQuietly :: HasTestEnv => IO ()
 testDeleteUserQuietly =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -3742,7 +3762,7 @@ testDeleteUserQuietly =
     exchangeGreetingsMsgId 4 a bId b aId
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
-testUsersNoServer :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testUsersNoServer :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testUsersNoServer ps = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
   (aId, bId, auId, _aId', bId') <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -3768,10 +3788,10 @@ testUsersNoServer ps = withAgentClientsCfg2 aCfg agentCfg $ \a b -> do
     aCfg = agentCfg {initialCleanupDelay = 10000, cleanupInterval = 10000, deleteErrorCount = 3}
 
 -- fast rotation runs at agent version 8+; these tests pin to v7 to exercise the QKEY/QUSE slow path and switch abort
-agentCfgV7 :: AgentConfig
+agentCfgV7 :: HasTestEnv => AgentConfig
 agentCfgV7 = agentCfg {smpAgentVRange = mkVersionRange 6 7}
 
-testSwitchConnection :: InitialAgentServers -> IO ()
+testSwitchConnection :: HasTestEnv => InitialAgentServers -> IO ()
 testSwitchConnection servers =
   withAgentClientsCfgServers2 agentCfgV7 agentCfgV7 servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -3797,7 +3817,7 @@ switchComplete a bId b aId = do
   phaseSnd b aId SPCompleted [Nothing]
   phaseRcv a bId SPCompleted [Nothing]
 
-testFastSwitchConnection :: InitialAgentServers -> IO ()
+testFastSwitchConnection :: HasTestEnv => InitialAgentServers -> IO ()
 testFastSwitchConnection servers =
   withAgentClientsCfgServers2 agentCfg agentCfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -3819,7 +3839,7 @@ fastSwitchComplete a bId b aId = do
 -- A's old receive queue is on server1 (stopped after the connection is set up); B's queue and the new queue are on server2.
 -- Fast rotation completes over the live server: B secures the new queue and sends the confirmation and QEND on it,
 -- so the recipient moves to it and removes the old queue without the old server.
-testFastSwitchDeadOldServer :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDeadOldServer :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
   let bServers = initAgentServers {smp = userServers [testSMPServer2]}
   withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ ->
@@ -3862,14 +3882,14 @@ drainSwitchCompletedRcvMsg c connId body = go False
         (_, connId', AEvt SAEConn (Msg' mId _ body')) | connId' == connId && body' == body -> ackMessage c connId' mId Nothing >> go True
         _ -> go seen
 
-testFastSwitchDrainOldQueue :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueue :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testFastSwitchDrainOldQueue ps =
   withSmpServers2 ps $ withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId, aM1Id) <- endSwitchOnNewQueue a b
     ackMessage a bId aM1Id Nothing
     drainOldQueue a bId b aId
 
-testFastSwitchDrainOldQueueRestart :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testFastSwitchDrainOldQueueRestart :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testFastSwitchDrainOldQueueRestart ps =
   withSmpServers2 ps $
     withAgent 2 agentCfg initAgentServers testDB2 $ \b -> do
@@ -3878,7 +3898,7 @@ testFastSwitchDrainOldQueueRestart ps =
         subscribeConnection a bId
         drainOldQueue a bId b aId
 
-endSwitchOnNewQueue :: HasCallStack => AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId, AgentMsgId)
+endSwitchOnNewQueue :: (HasCallStack, HasTestEnv) => AgentClient -> AgentClient -> ExceptT AgentErrorType IO (ConnId, ConnId, AgentMsgId)
 endSwitchOnNewQueue a b = do
   (aId, bId) <- makeConnection a b
   exchangeGreetings a bId b aId
@@ -3952,7 +3972,7 @@ phase c connId d p statsExpectation =
         SWITCH {} <- pure r
         pure ()
 
-testSwitchAsync :: HasCallStack => InitialAgentServers -> IO ()
+testSwitchAsync :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testSwitchAsync servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -3997,7 +4017,7 @@ sessionSubscribe withC connIds a =
     liftIO $ noMessages c "nothing else should be delivered"
     pure r
 
-testSwitchDelete :: InitialAgentServers -> IO ()
+testSwitchDelete :: HasTestEnv => InitialAgentServers -> IO ()
 testSwitchDelete servers =
   withAgentClientsCfgServers2 agentCfgV7 agentCfgV7 servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -4011,7 +4031,7 @@ testSwitchDelete servers =
     get a =##> \case ("", "", DEL_CONNS [c]) -> c == bId; _ -> False
     liftIO $ noMessages a "nothing else should be delivered to alice"
 
-testAbortSwitchStarted :: HasCallStack => InitialAgentServers -> IO ()
+testAbortSwitchStarted :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testAbortSwitchStarted servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -4061,7 +4081,7 @@ testAbortSwitchStarted servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfgV7 servers testDB2
 
-testAbortSwitchStartedReinitiate :: HasCallStack => InitialAgentServers -> IO ()
+testAbortSwitchStartedReinitiate :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testAbortSwitchStartedReinitiate servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -4128,7 +4148,7 @@ errQueueNotFoundP cId = \case
   (_, cId', AEvt SAEConn (ERR AGENT {agentErr = A_QUEUE {queueErr = "QKEY: queue address not found in connection"}})) -> cId' == cId
   _ -> False
 
-testCannotAbortSwitchSecured :: HasCallStack => InitialAgentServers -> IO ()
+testCannotAbortSwitchSecured :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testCannotAbortSwitchSecured servers = do
   (aId, bId) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId, bId) <- makeConnection a b
@@ -4166,7 +4186,7 @@ testCannotAbortSwitchSecured servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfgV7 servers testDB2
 
-testSwitch2Connections :: HasCallStack => InitialAgentServers -> IO ()
+testSwitch2Connections :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testSwitch2Connections servers = do
   (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId1, bId1) <- makeConnection a b
@@ -4224,7 +4244,7 @@ testSwitch2Connections servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfgV7 servers testDB2
 
-testSwitch2ConnectionsAbort1 :: HasCallStack => InitialAgentServers -> IO ()
+testSwitch2ConnectionsAbort1 :: (HasCallStack, HasTestEnv) => InitialAgentServers -> IO ()
 testSwitch2ConnectionsAbort1 servers = do
   (aId1, bId1, aId2, bId2) <- withA $ \a -> withB $ \b -> runRight $ do
     (aId1, bId1) <- makeConnection a b
@@ -4277,7 +4297,7 @@ testSwitch2ConnectionsAbort1 servers = do
     withB :: (AgentClient -> IO a) -> IO a
     withB = withAgent 2 agentCfgV7 servers testDB2
 
-testCreateQueueAuth :: HasCallStack => (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
+testCreateQueueAuth :: (HasCallStack, HasTestEnv) => (Maybe BasicAuth, VersionSMP) -> (Maybe BasicAuth, VersionSMP) -> SndQueueSecured -> AgentMsgId -> IO Int
 testCreateQueueAuth clnt1 clnt2 sqSecured baseId = do
   a <- getClient 1 clnt1 testDB
   b <- getClient 2 clnt2 testDB2
@@ -4309,7 +4329,7 @@ testCreateQueueAuth clnt1 clnt2 sqSecured baseId = do
           sndAuthAlg = C.AuthAlg C.SX25519
        in getSMPAgentClient' clientId agentCfg {smpCfg, sndAuthAlg} servers db
 
-testSMPServerConnectionTest :: (ASrvTransport, AStoreType) -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
+testSMPServerConnectionTest :: HasTestEnv => (ASrvTransport, AStoreType) -> Maybe BasicAuth -> SMPServerWithAuth -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 testSMPServerConnectionTest (t, msType) newQueueBasicAuth srv =
   withSmpServerConfigOn t cfg' testPort2 $ \_ -> do
     -- initially passed server is not running
@@ -4332,7 +4352,7 @@ testServerInformation =
       serverCountry = Nothing
     }
 
-testConnectionVerifyCodes :: HasCallStack => IO ()
+testConnectionVerifyCodes :: (HasCallStack, HasTestEnv) => IO ()
 testConnectionVerifyCodes =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -4350,7 +4370,7 @@ testConnectionVerifyCodes =
     codes1'' <- getConnectionVerifyCodes a bId
     liftIO $ codes1'' `shouldBe` codes1
 
-testDeliveryReceipts :: HasCallStack => IO ()
+testDeliveryReceipts :: (HasCallStack, HasTestEnv) => IO ()
 testDeliveryReceipts =
   withAgentClients2 $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -4370,7 +4390,7 @@ testDeliveryReceipts =
     ackMessage b aId 5 (Just "") `catchError` \case (A.CMD PROHIBITED _) -> pure (); e -> liftIO $ expectationFailure ("unexpected error " <> show e)
     ackMessage b aId 5 Nothing
 
-testDeliveryReceiptsConcurrent :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testDeliveryReceiptsConcurrent :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testDeliveryReceiptsConcurrent (t, msType) =
   withSmpServerConfigOn t cfg' testPort $ \_ -> do
     withAgentClients2 $ \a b -> do
@@ -4421,7 +4441,7 @@ testDeliveryReceiptsConcurrent (t, msType) =
             Just r -> pure r
             _ -> error "timeout"
 
-testTwoUsers :: HasCallStack => IO ()
+testTwoUsers :: (HasCallStack, HasTestEnv) => IO ()
 testTwoUsers = withAgentClients2 $ \a b -> do
   let nc = netCfg initAgentServers
   sessionMode nc `shouldBe` TSMSession
@@ -4444,10 +4464,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     liftIO $ threadDelay 250000
     setNetworkConfig a nc {sessionMode = TSMUser}
     liftIO $ threadDelay 250000
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
+    reconnected a [[bId1], [bId1']] [bId1, bId1']
     a `hasClients` 1
 
     aUserId2 <- createUser a False [noAuthSrvCfg testSMPServer] [noAuthSrvCfg testXFTPServer]
@@ -4459,12 +4476,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     b `hasClients` 1
     setNetworkConfig a nc {sessionMode = TSMEntity}
     liftIO $ threadDelay 250000
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
-    ("", "", UP _ _) <- nGet a
+    reconnected a [[bId1, bId1'], [bId2, bId2']] [bId1, bId1', bId2, bId2']
     a `hasClients` 4
     exchangeGreetingsMsgId 6 a bId1 b aId1
     exchangeGreetingsMsgId 6 a bId1' b aId1'
@@ -4473,15 +4485,7 @@ testTwoUsers = withAgentClients2 $ \a b -> do
     liftIO $ threadDelay 250000
     setNetworkConfig a nc {sessionMode = TSMUser}
     liftIO $ threadDelay 250000
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", DOWN _ _) <- nGet a
-    ("", "", DOWN _ _) <- 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
+    reconnected a [[bId1], [bId1'], [bId2], [bId2']] [bId1, bId1', bId2, bId2']
     a `hasClients` 2
     exchangeGreetingsMsgId 8 a bId1 b aId1
     exchangeGreetingsMsgId 8 a bId1' b aId1'
@@ -4490,8 +4494,15 @@ testTwoUsers = withAgentClients2 $ \a b -> do
   where
     hasClients :: HasCallStack => AgentClient -> Int -> ExceptT AgentErrorType IO ()
     hasClients c n = liftIO $ M.size <$> readTVarIO (smpClients c) `shouldReturn` n
+    reconnected :: HasCallStack => AgentClient -> [[ConnId]] -> [ConnId] -> ExceptT AgentErrorType IO ()
+    reconnected c downs ups = liftIO $ getInAnyOrder c $ map down downs <> map up ups
+      where
+        down :: [ConnId] -> ATransmission -> Bool
+        down cs = \case ("", "", AEvt SAENone (DOWN _ cs')) -> S.fromList cs' == S.fromList cs; _ -> False
+        up :: ConnId -> ATransmission -> Bool
+        up cId = \case ("", "", AEvt SAENone (UP _ [cId'])) -> cId' == cId; _ -> False
 
-testClientServiceConnection :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testClientServiceConnection :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testClientServiceConnection ps = do
   ((sId, uId), qIdHash) <- withSmpServerStoreLogOn ps testPort $ \_ -> do
     conns@(sId, uId) <- withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> runRight $ do
@@ -4544,7 +4555,7 @@ testClientServiceConnection ps = do
       exchangeGreetingsMsgId 4 user sId' service uId'
       exchangeGreetingsMsgId 10 service uId user sId
 
-testClientServiceIDChange :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testClientServiceIDChange :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testClientServiceIDChange ps@(_, ASType qs _) = do
   (sId, uId) <- withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> do
     conns <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
@@ -4601,7 +4612,7 @@ testClientServiceIDChange ps@(_, ASType qs _) = do
 
 -- | Test that service subscription is correctly cleared and re-established
 -- when server temporarily stops supporting services (askClientCert = False).
-testServiceUnavailableClearsPending :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testServiceUnavailableClearsPending :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testServiceUnavailableClearsPending (t, msType) = do
   -- Same agent across all phases to test pendingServiceSub persistence
   withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> do
@@ -4649,7 +4660,7 @@ testServiceUnavailableClearsPending (t, msType) = do
 -- | Test that service subscription recovers when service ID changes on reconnect.
 -- Server restart with deleted service causes new service ID, triggering SSErrorServiceId.
 -- Queues should be unassociated, resubscribed, and re-associated with new service.
-testServiceIdChangeOnReconnect :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testServiceIdChangeOnReconnect :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testServiceIdChangeOnReconnect ps@(_, ASType qs _) = do
   withAgentClientsServers2 (agentCfg, initAgentServersClientService) (agentCfg, initAgentServers) $ \service user -> do
     -- Phase 1: Establish connection with active service subscription
@@ -4690,7 +4701,7 @@ testServiceIdChangeOnReconnect ps@(_, ASType qs _) = do
 
 -- | Test that subscribeAllConnections handles service unavailable on startup.
 -- Agent has service credentials but server doesn't support services (askClientCert = False).
-testServiceUnavailableOnStartup :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testServiceUnavailableOnStartup :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testServiceUnavailableOnStartup (t, msType) = do
   let srv = initAgentServersClientService
       noSrv = initAgentServers
@@ -4724,7 +4735,7 @@ testServiceUnavailableOnStartup (t, msType) = do
       ("", "", UP _ [_]) <- nGet user
       exchangeGreetingsMsgId 6 service uId user sId
 
-testMigrateConnectionsToService :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testMigrateConnectionsToService :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testMigrateConnectionsToService ps = do
   (((sId1, uId1), (uId2, sId2)), ((sId3, uId3), (uId4, sId4)), ((sId5, uId5), (uId6, sId6))) <-
     withSmpServerStoreLogOn ps testPort $ \_ -> do
@@ -4900,7 +4911,7 @@ insertUser :: DBStore -> IO ()
 insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
 #endif
 
-testServerMultipleIdentities :: HasCallStack => IO ()
+testServerMultipleIdentities :: (HasCallStack, HasTestEnv) => IO ()
 testServerMultipleIdentities =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -4930,13 +4941,13 @@ testServerMultipleIdentities =
               [ SMPQueueUri
                   supportedSMPClientVRange
                   queueAddr
-                    { smpServer = SMPServer "localhost" "5001" (C.KeyHash "\215m\248\251")
+                    { smpServer = SMPServer "localhost" testPort (C.KeyHash "\215m\248\251")
                     }
               ]
           }
         testE2ERatchetParams12
 
-testWaitForUserNetwork :: IO ()
+testWaitForUserNetwork :: HasTestEnv => IO ()
 testWaitForUserNetwork = withAgent 1 aCfg initAgentServers testDB $ \a -> do
   noNetworkDelay a
   setUserNetworkInfo a $ UserNetworkInfo UNNone False
@@ -4953,7 +4964,7 @@ testWaitForUserNetwork = withAgent 1 aCfg initAgentServers testDB $ \a -> do
   where
     aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0}
 
-testDoNotResetOnlineToOffline :: IO ()
+testDoNotResetOnlineToOffline :: HasTestEnv => IO ()
 testDoNotResetOnlineToOffline = withAgent 1 aCfg initAgentServers testDB $ \a -> do
   noNetworkDelay a
   setUserNetworkInfo a $ UserNetworkInfo UNWifi False
@@ -4974,7 +4985,7 @@ testDoNotResetOnlineToOffline = withAgent 1 aCfg initAgentServers testDB $ \a ->
   where
     aCfg = agentCfg {userNetworkInterval = 100000, userOfflineDelay = 0.1}
 
-testResumeMultipleThreads :: IO ()
+testResumeMultipleThreads :: HasTestEnv => IO ()
 testResumeMultipleThreads = withAgent 1 aCfg initAgentServers testDB $ \a -> do
   noNetworkDelay a
   setUserNetworkInfo a $ UserNetworkInfo UNNone False
@@ -4995,7 +5006,7 @@ testResumeMultipleThreads = withAgent 1 aCfg initAgentServers testDB $ \a -> do
   where
     aCfg = agentCfg {userOfflineDelay = 0}
 
-testServerQueueInfo :: IO ()
+testServerQueueInfo :: HasTestEnv => IO ()
 testServerQueueInfo = do
   withAgentClients2 $ \alice bob -> runRight_ $ do
     (bobId, cReq) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
@@ -5081,7 +5092,7 @@ testServerQueueInfo = do
         qDelivered <$> qiSub `shouldBe` Just msgId_
         pure msgId_
 
-testClientNotice :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testClientNotice :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testClientNotice ps = do
   withAgent 1 agentCfg initAgentServers testDB $ \c -> do
     (cId, _) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 8e1a85e8a..c375a06f2 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -65,7 +66,7 @@ import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, te
 import SMPClient
 import Simplex.Messaging.Agent hiding (checkNtfToken, createConnection, joinConnection, registerNtfToken, sendMessage, verifyNtfToken)
 import qualified Simplex.Messaging.Agent as A
-import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), withStore')
+import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), ServerQueueInfo (..), 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.AgentStore (getSavedNtfToken)
@@ -85,6 +86,7 @@ import Simplex.Messaging.Protocol (ErrorType (AUTH), NetworkError (..), MsgFlags
 import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..))
 import Simplex.Messaging.Server.Information (ServerPublicInfo (..))
+import Simplex.Messaging.Server.QueueStore.QueueInfo (QueueInfo (..))
 import Simplex.Messaging.Transport (ASrvTransport)
 import Simplex.Messaging.Transport.Server (TransportServerConfig (..))
 import System.Process (callCommand)
@@ -138,7 +140,8 @@ notificationTests ps@(t, _) = do
         testNtfTokenReRegisterInvalidOnCheck t apns
   describe "notification server tests" $ do
     it "should pass" $ testRunNTFServerTests t testNtfServer `shouldReturn` Right Nothing
-    let srv1 = testNtfServer {keyHash = "1234"}
+    let srv1 :: HasTestEnv => NtfServer
+        srv1 = testNtfServer {keyHash = "1234"}
     it "should fail with incorrect fingerprint" $ do
       testRunNTFServerTests t srv1 `shouldReturn` Left (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) $ NETWORK NEUnknownCAError)
   describe "Managing notification subscriptions" $ do
@@ -186,7 +189,7 @@ notificationTests ps@(t, _) = do
           testNotificationsNewToken apns ntf
   it "should migrate to service subscriptions" $ testMigrateToServiceSubscriptions ps
 
-testNtfMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
+testNtfMatrix :: HasCallStack => (ASrvTransport, AStoreType) -> (HasTestEnv => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> Spec
 testNtfMatrix ps@(_, msType) runTest = do
   describe "next and current" $ do
     it "curr servers; curr clients" $ runNtfTestCfg ps 1 cfg' ntfServerCfg agentCfg agentCfg runTest
@@ -200,6 +203,7 @@ testNtfMatrix ps@(_, msType) runTest = do
     it "servers: curr SMP, curr NTF; clients: curr/prev" $ runNtfTestCfg ps 1 cfg' ntfServerCfg agentCfg agentCfgVPrevPQ runTest
     it "servers: curr SMP, curr NTF; clients: prev/curr" $ runNtfTestCfg ps 1 cfg' ntfServerCfg agentCfgVPrevPQ agentCfg runTest
   where
+    cfg', cfgVPrev' :: HasTestEnv => AServerConfig
     cfg' = cfgMS msType
     cfgVPrev' = cfgVPrev msType
 
@@ -212,7 +216,7 @@ checkNtfToken c = A.checkNtfToken c NRMInteractive
 verifyNtfToken :: AgentClient -> DeviceToken -> C.CbNonce -> ByteString -> AE ()
 verifyNtfToken c = A.verifyNtfToken c NRMInteractive
 
-runNtfTestCfg :: HasCallStack => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
+runNtfTestCfg :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> AgentMsgId -> AServerConfig -> NtfServerConfig -> AgentConfig -> AgentConfig -> (APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()) -> IO ()
 runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
   ASSCfg qt mt serverStoreCfg <- pure $ testServerStoreConfig msType
   let smpCfg' = withServerCfg smpCfg $ \cfg_ -> ASrvCfg qt mt cfg_ {serverStoreCfg}
@@ -222,7 +226,7 @@ runNtfTestCfg (t, msType) baseId smpCfg ntfCfg aCfg bCfg runTest = do
         withAgentClientsCfg2 aCfg bCfg $ runTest apns baseId
   threadDelay 100000
 
-testNotificationToken :: APNSMockServer -> IO ()
+testNotificationToken :: HasTestEnv => APNSMockServer -> IO ()
 testNotificationToken apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
@@ -246,7 +250,7 @@ v .-> key = do
 -- logCfg :: LogConfig
 -- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
-testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
+testNtfTokenRepeatRegistration :: HasTestEnv => APNSMockServer -> IO ()
 testNtfTokenRepeatRegistration apns = do
   withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
@@ -265,7 +269,7 @@ testNtfTokenRepeatRegistration apns = do
     NTActive <- checkNtfToken a tkn
     pure ()
 
-testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
+testNtfTokenSecondRegistration :: HasTestEnv => APNSMockServer -> IO ()
 testNtfTokenSecondRegistration apns =
   withAgentClients2 $ \a a' -> runRight_ $ do
     let tkn = DeviceToken PPApnsTest "abcd"
@@ -295,7 +299,7 @@ testNtfTokenSecondRegistration apns =
     NTActive <- checkNtfToken a' tkn
     pure ()
 
-testNtfTokenServerRestart :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestart :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestart t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
@@ -316,7 +320,7 @@ testNtfTokenServerRestart t apns = do
       NTActive <- checkNtfToken a' tkn
       pure ()
 
-testNtfTokenServerRestartReverify :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReverify :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverify t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a -> do
@@ -339,7 +343,7 @@ testNtfTokenServerRestartReverify t apns = do
       NTActive <- checkNtfToken a' tkn
       pure ()
 
-testNtfTokenServerRestartReverifyTimeout :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReverifyTimeout :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReverifyTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
@@ -374,7 +378,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
       NTActive <- checkNtfToken a' tkn
       pure ()
 
-testNtfTokenServerRestartReregister :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReregister :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregister t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a ->
@@ -398,7 +402,7 @@ testNtfTokenServerRestartReregister t apns = do
       NTActive <- checkNtfToken a' tkn
       pure ()
 
-testNtfTokenServerRestartReregisterTimeout :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenServerRestartReregisterTimeout :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenServerRestartReregisterTimeout t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
@@ -439,7 +443,7 @@ getTestNtfTokenPort a =
     Just NtfToken {ntfServer = ProtocolServer {port}} -> pure port
     Nothing -> error "no active NtfToken"
 
-testNtfTokenMultipleServers :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenMultipleServers :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenMultipleServers t apns = do
   let tkn = DeviceToken PPApnsTest "abcd"
   withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
@@ -463,7 +467,7 @@ testNtfTokenMultipleServers t apns = do
         Left _ <- tryError (checkNtfToken a tkn)
         pure ()
 
-testNtfTokenChangeServers :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenChangeServers :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenChangeServers t apns =
   withNtfServerThreadOn t ntfTestPort ntfTestDBCfg $ \ntf -> do
     tkn1 <- withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
@@ -493,7 +497,7 @@ testNtfTokenChangeServers t apns =
         tkn <- registerTestToken a "qwer" NMInstant apns
         checkNtfToken a tkn >>= \r -> liftIO $ r `shouldBe` NTActive
 
-testNtfTokenReRegisterInvalid :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenReRegisterInvalid :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenReRegisterInvalid t apns = do
   tkn <- withNtfServer t $ do
     withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
@@ -518,7 +522,7 @@ testNtfTokenReRegisterInvalid t apns = do
       NTActive <- checkNtfToken a tkn1
       pure ()
 
-testNtfTokenReRegisterInvalidOnCheck :: ASrvTransport -> APNSMockServer -> IO ()
+testNtfTokenReRegisterInvalidOnCheck :: HasTestEnv => ASrvTransport -> APNSMockServer -> IO ()
 testNtfTokenReRegisterInvalidOnCheck t apns = do
   tkn <- withNtfServer t $ do
     withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight $ do
@@ -543,13 +547,13 @@ testNtfTokenReRegisterInvalidOnCheck t apns = do
       NTActive <- checkNtfToken a tkn1
       pure ()
 
-testRunNTFServerTests :: ASrvTransport -> NtfServer -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
+testRunNTFServerTests :: HasTestEnv => ASrvTransport -> NtfServer -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 testRunNTFServerTests t srv =
   withNtfServer t $
     withAgent 1 agentCfg initAgentServers testDB $ \a ->
       testProtocolServer a NRMInteractive 1 (ProtoServerWithAuth srv Nothing)
 
-testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
+testNotificationSubscriptionExistingConnection :: HasTestEnv => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
 testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
   (bobId, aliceId, nonce, message) <- runRight $ do
     -- establish connection
@@ -569,6 +573,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     vNonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
     verifyNtfToken alice tkn vNonce verification
     NTActive <- checkNtfToken alice tkn
+    waitNotifier bobId
     -- send message
     1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
     get bob ##> ("", aliceId, SENT $ baseId + 1)
@@ -609,6 +614,9 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
     noNotification alice apns
   where
     msgId = subtract baseId
+    waitNotifier connId = do
+      ServerQueueInfo {info = QueueInfo {qiNtf}} <- getConnectionQueueInfo alice NRMInteractive connId
+      unless qiNtf $ liftIO (threadDelay 20000) >> waitNotifier connId
 
 testNotificationSubscriptionNewConnection :: HasCallStack => APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
 testNotificationSubscriptionNewConnection apns baseId alice bob =
@@ -662,7 +670,7 @@ registerTestToken a token mode apns = do
   NTActive <- checkNtfToken a tkn
   pure tkn
 
-testChangeNotificationsMode :: HasCallStack => APNSMockServer -> IO ()
+testChangeNotificationsMode :: (HasCallStack, HasTestEnv) => APNSMockServer -> IO ()
 testChangeNotificationsMode apns =
   withAgentClients2 $ \alice bob -> runRight_ $ do
     -- establish connection
@@ -725,7 +733,7 @@ testChangeNotificationsMode apns =
     baseId = 1
     msgId = subtract baseId
 
-testChangeToken :: APNSMockServer -> IO ()
+testChangeToken :: HasTestEnv => APNSMockServer -> IO ()
 testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> do
   (aliceId, bobId) <- withAgent 2 agentCfg initAgentServers testDB $ \alice -> runRight $ do
     -- establish connection
@@ -765,7 +773,7 @@ testChangeToken apns = withAgent 1 agentCfg initAgentServers testDB2 $ \bob -> d
     baseId = 1
     msgId = subtract baseId
 
-testNotificationsStoreLog :: (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
+testNotificationsStoreLog :: HasTestEnv => (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
 testNotificationsStoreLog ps@(t, _) apns = withAgentClients2 $ \alice bob -> do
   withSmpServerStoreMsgLogOn ps testPort $ \_ -> do
     (aliceId, bobId) <- withNtfServer t $ runRight $ do
@@ -800,7 +808,7 @@ testNotificationsStoreLog ps@(t, _) apns = withAgentClients2 $ \alice bob -> do
     withNtfServer t $ runRight_ $ do
       void $ messageNotificationData alice apns
 
-testNotificationsSMPRestart :: (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
+testNotificationsSMPRestart :: HasTestEnv => (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
 testNotificationsSMPRestart ps apns = withAgentClients2 $ \alice bob -> do
   (aliceId, bobId) <- withSmpServerStoreLogOn ps testPort $ \threadId -> runRight $ do
     (aliceId, bobId) <- makeConnection alice bob
@@ -828,7 +836,7 @@ testNotificationsSMPRestart ps apns = withAgentClients2 $ \alice bob -> do
     get alice =##> \case ("", c, Msg "hello again") -> c == bobId; _ -> False
     liftIO $ killThread threadId
 
-testNotificationsSMPRestartBatch :: Int -> (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
+testNotificationsSMPRestartBatch :: HasTestEnv => Int -> (ASrvTransport, AStoreType) -> APNSMockServer -> IO ()
 testNotificationsSMPRestartBatch n ps@(t, ASType qsType _) apns =
   withAgentClientsCfgServers2 agentCfg agentCfg initAgentServers2 $ \a b -> do
     threadDelay 1000000
@@ -874,7 +882,7 @@ testNotificationsSMPRestartBatch n ps@(t, ASType qsType _) apns =
         killThread t1
         pure res
 
-testSwitchNotifications :: AgentConfig -> (AgentClient -> ByteString -> AgentClient -> ByteString -> ExceptT AgentErrorType IO ()) -> InitialAgentServers -> APNSMockServer -> IO ()
+testSwitchNotifications :: HasTestEnv => AgentConfig -> (AgentClient -> ByteString -> AgentClient -> ByteString -> ExceptT AgentErrorType IO ()) -> InitialAgentServers -> APNSMockServer -> IO ()
 testSwitchNotifications cfg completeSwitch servers apns =
   withAgentClientsCfgServers2 cfg cfg servers $ \a b -> runRight_ $ do
     (aId, bId) <- makeConnection a b
@@ -893,7 +901,7 @@ testSwitchNotifications cfg completeSwitch servers apns =
     liftIO $ threadDelay 500000
     testMessage "hello again"
 
-testNotificationsOldToken :: APNSMockServer -> IO ()
+testNotificationsOldToken :: HasTestEnv => APNSMockServer -> IO ()
 testNotificationsOldToken apns =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
@@ -912,7 +920,7 @@ testNotificationsOldToken apns =
     let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
-testNotificationsNewToken :: APNSMockServer -> ThreadId -> IO ()
+testNotificationsNewToken :: HasTestEnv => APNSMockServer -> ThreadId -> IO ()
 testNotificationsNewToken apns oldNtf =
   withAgentClients3 $ \a b c -> runRight_ $ do
     (abId, baId) <- makeConnection a b
@@ -934,7 +942,7 @@ testNotificationsNewToken apns oldNtf =
     let testMessageAC = testMessage_ apns a acId c caId
     testMessageAC "greetings"
 
-testMigrateToServiceSubscriptions :: HasCallStack => (ASrvTransport, AStoreType) -> IO ()
+testMigrateToServiceSubscriptions :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testMigrateToServiceSubscriptions ps@(t, msType) = withAgentClients2 $ \a b -> do
   (c1, c2, c3) <- withSmpServerConfigOn t cfgNoService testPort $ \_ -> do
     (c1, c2) <- withAPNSMockServer $ \apns -> do
@@ -1032,7 +1040,7 @@ testMessage_ apns a aId b bId msg = do
 
 messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
 messageNotification apns tkn = do
-  500000 `timeout` getMockNotification apns tkn >>= \case
+  5000000 `timeout` getMockNotification apns tkn >>= \case
     Nothing -> error "no notification"
     Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
       nonce <- C.unsafeCbNonce <$> ntfData .-> "nonce"
diff --git a/tests/AgentTests/ResolveNameTests.hs b/tests/AgentTests/ResolveNameTests.hs
index d8507194e..6fc538432 100644
--- a/tests/AgentTests/ResolveNameTests.hs
+++ b/tests/AgentTests/ResolveNameTests.hs
@@ -32,7 +32,7 @@ import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
 import Simplex.Messaging.Transport
 import Test.Hspec hiding (fit, it)
-import Util (it)
+import Util (HasTestEnv, it)
 
 nameSrvCfg :: SMPServer -> ServerCfg 'SMP.PSMP
 nameSrvCfg = presetServerCfg True ServerRoles {storage = True, proxy = False, names = True} (Just 1) . SMP.noAuthSrv
@@ -40,16 +40,16 @@ nameSrvCfg = presetServerCfg True ServerRoles {storage = True, proxy = False, na
 proxySrvCfg :: SMPServer -> ServerCfg 'SMP.PSMP
 proxySrvCfg = presetServerCfg True ServerRoles {storage = True, proxy = True, names = False} (Just 1) . SMP.noAuthSrv
 
-oneSrv :: ServerCfg 'SMP.PSMP -> InitialAgentServers
+oneSrv :: HasTestEnv => ServerCfg 'SMP.PSMP -> InitialAgentServers
 oneSrv cfg_ = (initAgentServersProxy_ SPMNever SPFProhibit) {smp = [(1, [cfg_])]}
 
-withDirectResolver :: (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
+withDirectResolver :: HasTestEnv => (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
 withDirectResolver (st, body) k =
   NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
     withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort $ \_ ->
       withAgent 1 agentCfg (oneSrv (nameSrvCfg testSMPServer)) testDB k
 
-withProxyAndResolver :: (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
+withProxyAndResolver :: HasTestEnv => (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
 withProxyAndResolver (st, body) k =
   NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
     withSmpServerConfigOn (transport @TLS) memProxyCfg testPort $ \_ ->
@@ -59,12 +59,12 @@ withProxyAndResolver (st, body) k =
     -- only testSMPServer2 (the resolver) has the names role; testSMPServer is the proxy
     proxyServers = (initAgentServersProxy_ SPMAlways SPFProhibit) {smp = [(1, [proxySrvCfg testSMPServer, nameSrvCfg testSMPServer2])]}
 
-withNoResolver :: (AgentClient -> IO a) -> IO a
+withNoResolver :: HasTestEnv => (AgentClient -> IO a) -> IO a
 withNoResolver k =
   withSmpServerConfigOn (transport @TLS) memCfg testPort $ \_ ->
     withAgent 1 agentCfg (oneSrv (nameSrvCfg testSMPServer)) testDB k
 
-withNoNameServers :: (AgentClient -> IO a) -> IO a
+withNoNameServers :: HasTestEnv => (AgentClient -> IO a) -> IO a
 withNoNameServers k = withAgent 1 agentCfg (oneSrv (proxySrvCfg testSMPServer)) testDB k
 
 resolveNameTests :: Spec
@@ -88,7 +88,7 @@ resolveNameTests = do
   describe "name availability" $
     it "an unregistered name answers as available" testAvailSuccess
 
-testAvailSuccess :: HasCallStack => IO ()
+testAvailSuccess :: (HasCallStack, HasTestEnv) => IO ()
 testAvailSuccess =
   withDirectResolver (status200, availableBody) $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -98,7 +98,7 @@ testAvailSuccess =
 
 -- | 404 is a resolver that predates /v2/resolve: no status from that endpoint
 -- means "not registered", since an unregistered name answers NRAvailable.
-testDirectResolverErr :: HasCallStack => IO ()
+testDirectResolverErr :: (HasCallStack, HasTestEnv) => IO ()
 testDirectResolverErr =
   withDirectResolver (status404, "{}") $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -106,7 +106,7 @@ testDirectResolverErr =
       Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
 
-testProxyResolverErr :: HasCallStack => IO ()
+testProxyResolverErr :: (HasCallStack, HasTestEnv) => IO ()
 testProxyResolverErr =
   withProxyAndResolver (status404, "{}") $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -114,7 +114,7 @@ testProxyResolverErr =
       Left (SMP host (SMP.NAME (SMP.RESOLVER _))) | testPort `isInfixOf` host -> pure ()
       _ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME (RESOLVER _))), got: " <> show r
 
-testTestingTldResolverErr :: HasCallStack => IO ()
+testTestingTldResolverErr :: (HasCallStack, HasTestEnv) => IO ()
 testTestingTldResolverErr =
   withDirectResolver (status404, "{}") $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
@@ -122,7 +122,7 @@ testTestingTldResolverErr =
       Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
 
-testWebTldResolverErr :: HasCallStack => IO ()
+testWebTldResolverErr :: (HasCallStack, HasTestEnv) => IO ()
 testWebTldResolverErr =
   withDirectResolver (status404, "{}") $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
@@ -130,7 +130,7 @@ testWebTldResolverErr =
       Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
 
-testNoResolver :: HasCallStack => IO ()
+testNoResolver :: (HasCallStack, HasTestEnv) => IO ()
 testNoResolver =
   withNoResolver $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -138,7 +138,7 @@ testNoResolver =
       Left (SMP _ (SMP.NAME SMP.NO_RESOLVER)) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME NO_RESOLVER)), got: " <> show r
 
-testNoNameServers :: HasCallStack => IO ()
+testNoNameServers :: (HasCallStack, HasTestEnv) => IO ()
 testNoNameServers =
   withNoNameServers $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -146,7 +146,7 @@ testNoNameServers =
       Left NO_NAME_SERVERS -> pure ()
       _ -> expectationFailure $ "expected Left NO_NAME_SERVERS, got: " <> show r
 
-testBackendError :: HasCallStack => IO ()
+testBackendError :: (HasCallStack, HasTestEnv) => IO ()
 testBackendError =
   withDirectResolver (status502, "{}") $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
@@ -154,7 +154,7 @@ testBackendError =
       Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER ..))), got: " <> show r
 
-testDirectSuccess :: HasCallStack => IO ()
+testDirectSuccess :: (HasCallStack, HasTestEnv) => IO ()
 testDirectSuccess =
   withDirectResolver (status200, registeredBody testNameRecord) $ \c -> do
     r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
diff --git a/tests/AgentTests/ServerChoice.hs b/tests/AgentTests/ServerChoice.hs
index a5808f6a7..8cffd9e15 100644
--- a/tests/AgentTests/ServerChoice.hs
+++ b/tests/AgentTests/ServerChoice.hs
@@ -57,7 +57,7 @@ storageOnly = ServerRoles {storage = True, proxy = False, names = False}
 proxyOnly :: ServerRoles
 proxyOnly = ServerRoles {storage = False, proxy = True, names = False}
 
-initServers :: InitialAgentServers
+initServers :: HasTestEnv => InitialAgentServers
 initServers =
   InitialAgentServers
     { smp = M.fromList [(1, testSMPServers)],
@@ -70,7 +70,7 @@ initServers =
       presetServers = []
     }
 
-testChooseDifferentOperator :: IO ()
+testChooseDifferentOperator :: HasTestEnv => IO ()
 testChooseDifferentOperator = withAgent 1 agentCfg initServers testDB $ \c -> runRight_ $ do
     -- chooses the only operator with storage role
     srv1 <- withAgentEnv c $ getNextServer c 1 storageSrvs []
diff --git a/tests/CLITests.hs b/tests/CLITests.hs
index b177d6004..06c846602 100644
--- a/tests/CLITests.hs
+++ b/tests/CLITests.hs
@@ -49,32 +49,32 @@ import Util
 import qualified Data.ByteString.Char8 as B
 import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple.Types (Query (..))
-import NtfClient (ntfTestServerDBConnectInfo, ntfTestServerDBConnstr, ntfTestStoreDBOpts)
+import NtfClient (ntfTestServerDBConnectInfo, ntfTestServerDBConnstr, ntfTestServerDBOpts)
 import SMPClient (postgressBracket)
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Notifications.Server.Main
 #endif
 
-cfgPath :: FilePath
-cfgPath = "tests/tmp/cli/etc/opt/simplex"
+cfgPath :: HasTestEnv => FilePath
+cfgPath = testPath "cli/etc/opt/simplex"
 
-logPath :: FilePath
-logPath = "tests/tmp/cli/etc/var/simplex"
+logPath :: HasTestEnv => FilePath
+logPath = testPath "cli/etc/var/simplex"
 
-webPath :: FilePath
-webPath = "tests/tmp/cli/var/www"
+webPath :: HasTestEnv => FilePath
+webPath = testPath "cli/var/www"
 
-ntfCfgPath :: FilePath
-ntfCfgPath = "tests/tmp/cli/etc/opt/simplex-notifications"
+ntfCfgPath :: HasTestEnv => FilePath
+ntfCfgPath = testPath "cli/etc/opt/simplex-notifications"
 
-ntfLogPath :: FilePath
-ntfLogPath = "tests/tmp/cli/etc/var/simplex-notifications"
+ntfLogPath :: HasTestEnv => FilePath
+ntfLogPath = testPath "cli/etc/var/simplex-notifications"
 
-fileCfgPath :: FilePath
-fileCfgPath = "tests/tmp/cli/etc/opt/simplex-files"
+fileCfgPath :: HasTestEnv => FilePath
+fileCfgPath = testPath "cli/etc/opt/simplex-files"
 
-fileLogPath :: FilePath
-fileLogPath = "tests/tmp/cli/etc/var/simplex-files"
+fileLogPath :: HasTestEnv => FilePath
+fileLogPath = testPath "cli/etc/var/simplex-files"
 
 cliTests :: Spec
 cliTests = do
@@ -87,7 +87,7 @@ cliTests = do
       it "static files" smpServerTestStatic
       it "cloud scripts disable embedded web without certificates" smpCloudScriptsDisableWeb
 #if defined(dbServerPostgres)
-  around_ (postgressBracket ntfTestServerDBConnectInfo) $ before_ (createNtfSchema ntfTestServerDBConnectInfo ntfTestStoreDBOpts) $
+  around_ (postgressBracket ntfTestServerDBConnectInfo) $ before_ (createNtfSchema ntfTestServerDBConnectInfo ntfTestServerDBOpts) $
     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
@@ -96,7 +96,7 @@ cliTests = do
     it "should initialize, start and delete the server (no store log)" $ xftpServerTest False
     it "should initialize, start and delete the server (with store log)" $ xftpServerTest True
 
-smpServerTest :: Bool -> Bool -> IO ()
+smpServerTest :: HasTestEnv => Bool -> Bool -> IO ()
 smpServerTest storeLog basicAuth = do
   -- init
   capture_ (withArgs (["init", "-y"] <> ["--disable-store-log" | not storeLog] <> ["--no-password" | not basicAuth]) $ smpServerCLI cfgPath logPath)
@@ -122,7 +122,7 @@ smpServerTest storeLog basicAuth = do
     XF.readSignedObject certPath >>= \case
       [cert'] -> pure . X.signedObject $ X.getSigned cert'
       _ -> error "bad crt format"
-  r' <- lines <$> capture_ (withArgs ["cert"] $ (100000 `timeout` smpServerCLI cfgPath logPath) `catchAll_` pure (Just ()))
+  r' <- lines <$> capture_ (withArgs ["cert"] $ smpServerCLI cfgPath logPath)
   r' `shouldContain` ["Generated new server credentials"]
   newCrt <-
     XF.readSignedObject certPath >>= \case
@@ -137,7 +137,7 @@ 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 :: (HasCallStack, HasTestEnv) => IO ()
 smpServerTestStatic = do
   let iniFile = cfgPath <> "/smp-server.ini"
   capture_ (withArgs ["init", "-y", "--no-password", "--web-path", webPath] $ smpServerCLI cfgPath logPath)
@@ -225,7 +225,7 @@ createNtfSchema connInfo DBOpts {schema} = do
   void $ PSQL.execute_ db $ Query $ "CREATE SCHEMA " <> schema
   PSQL.close db
 
-ntfServerTest :: Bool -> IO ()
+ntfServerTest :: HasTestEnv => Bool -> IO ()
 ntfServerTest storeLog = do
   capture_ (withArgs (["init", "--database=" <> B.unpack ntfTestServerDBConnstr] <> ["--disable-store-log" | not storeLog]) $ ntfServerCLI ntfCfgPath ntfLogPath)
     >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> ntfCfgPath <> "/ntf-server.ini") `isPrefixOf`))
@@ -244,9 +244,9 @@ ntfServerTest storeLog = do
   doesFileExist (cfgPath <> "/ca.key") `shouldReturn` False
 #endif
 
-xftpServerTest :: Bool -> IO ()
+xftpServerTest :: HasTestEnv => Bool -> IO ()
 xftpServerTest storeLog = do
-  capture_ (withArgs (["init", "-p", "tests/tmp", "-q", "10gb"] <> ["--disable-store-log" | not storeLog]) $ xftpServerCLI fileCfgPath fileLogPath)
+  capture_ (withArgs (["init", "-p", testDir, "-q", "10gb"] <> ["--disable-store-log" | not storeLog]) $ xftpServerCLI fileCfgPath fileLogPath)
     >>= (`shouldSatisfy` (("Server initialized, you can modify configuration in " <> fileCfgPath <> "/file-server.ini") `isPrefixOf`))
   Right ini <- readIniFile $ fileCfgPath <> "/file-server.ini"
   lookupValue "STORE_LOG" "enable" ini `shouldBe` Right (if storeLog then "on" else "off")
diff --git a/tests/CoreTests/CryptoFileTests.hs b/tests/CoreTests/CryptoFileTests.hs
index ce9fa7c35..40ee73579 100644
--- a/tests/CoreTests/CryptoFileTests.hs
+++ b/tests/CoreTests/CryptoFileTests.hs
@@ -24,10 +24,10 @@ cryptoFileTests = do
   it "should put/read file" testPutReadFile
   it "should fail reading empty or small file" testSmallFile
 
-testFilePath :: FilePath
-testFilePath = "tests/tmp/testcryptofile"
+testFilePath :: HasTestEnv => FilePath
+testFilePath = testPath "testcryptofile"
 
-testWriteReadFile :: IO ()
+testWriteReadFile :: HasTestEnv => IO ()
 testWriteReadFile = do
   g <- C.newRandom
   s <- atomically $ LB.fromStrict <$> C.randomBytes 100000 g
@@ -39,7 +39,7 @@ testWriteReadFile = do
     s' <- CF.readFile file
     liftIO $ s `shouldBe` s'
 
-testPutGetFile :: IO ()
+testPutGetFile :: HasTestEnv => IO ()
 testPutGetFile = do
   g <- C.newRandom
   s <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
@@ -59,7 +59,7 @@ testPutGetFile = do
       CF.hGetTag h
       liftIO $ (s <> s') `shouldBe` LB.fromStrict (s1 <> s2 <> s3)
 
-testWriteGetFile :: IO ()
+testWriteGetFile :: HasTestEnv => IO ()
 testWriteGetFile = do
   g <- C.newRandom
   s <- atomically $ LB.fromStrict <$> C.randomBytes 100000 g
@@ -73,7 +73,7 @@ testWriteGetFile = do
       liftIO $ runExceptT (CF.hGetTag h) `shouldReturn` Left FTCEInvalidAuthTag
       liftIO $ s `shouldBe` LB.fromStrict (s' <> s'')
 
-testPutReadFile :: IO ()
+testPutReadFile :: HasTestEnv => IO ()
 testPutReadFile = do
   g <- C.newRandom
   s <- atomically $ LB.fromStrict <$> C.randomBytes 50000 g
@@ -92,7 +92,7 @@ testPutReadFile = do
     s'' <- CF.readFile file
     liftIO $ (s <> s') `shouldBe` s''
 
-testSmallFile :: IO ()
+testSmallFile :: HasTestEnv => IO ()
 testSmallFile = do
   g <- C.newRandom
   file <- atomically $ mkCryptoFile g
@@ -101,5 +101,5 @@ testSmallFile = do
   LB.writeFile testFilePath "123"
   runExceptT (CF.readFile file) `shouldReturn` Left FTCEInvalidFileSize
 
-mkCryptoFile :: TVar ChaChaDRG -> STM CryptoFile
+mkCryptoFile :: HasTestEnv => TVar ChaChaDRG -> STM CryptoFile
 mkCryptoFile g = CryptoFile testFilePath . Just <$> CF.randomArgs g
diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs
index 268611990..ad5550b55 100644
--- a/tests/CoreTests/CryptoTests.hs
+++ b/tests/CoreTests/CryptoTests.hs
@@ -146,9 +146,9 @@ instance Eq C.APrivateKey where
     Just Refl -> k == k'
     Nothing -> False
 
-testPadUnpadFile :: IO ()
+testPadUnpadFile :: HasTestEnv => IO ()
 testPadUnpadFile = do
-  let f = "tests/tmp/testpad"
+  let f = testPath "testpad"
       paddedLen = 1024 * 1024
       len = 1000000
       s = LB.replicate len 'a'
@@ -208,7 +208,7 @@ testLazySecretBoxFile = it "should lazily encrypt / decrypt file with a random s
   g <- C.newRandom
   k <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
-  let f = "tests/tmp/testsecretbox"
+  let f = testPath "testsecretbox"
       paddedLen = 4 * 1024 * 1024
       len = 4 * 1000 * 1000 :: Int64
       s = LC.fastReplicate len 'a'
@@ -236,7 +236,7 @@ testLazySecretBoxFileTailTag = it "should lazily encrypt / decrypt file with a r
   g <- C.newRandom
   k <- atomically $ C.randomSbKey g
   nonce <- atomically $ C.randomCbNonce g
-  let f = "tests/tmp/testsecretbox"
+  let f = testPath "testsecretbox"
       paddedLen = 4 * 1024 * 1024
       len = 4 * 1000 * 1000 :: Int64
       s = LC.fastReplicate len 'a'
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index d9a259051..f4cfcf2b4 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -58,50 +58,47 @@ import Simplex.Messaging.Agent.Store.Postgres.Common
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Postgres
-import SMPClient (postgressBracket, testServerDBConnectInfo, testStoreDBOpts)
+import SMPClient (testStoreDBOpts)
 #endif
 
 msgStoreTests :: Spec
 msgStoreTests = do
-  around (withMsgStore testSMTStoreConfig) $ describe "STM message store" someMsgStoreTests
-  around (withMsgStore $ testJournalStoreCfg MQStoreCfg) $ describe "Journal message store" $ do
-    someMsgStoreTests
-    journalMsgStoreTests
-    it "should export and import journal store" testExportImportStore
+  describe "STM message store" $ someMsgStoreTests testSMTStoreConfig
+  describe "Journal message store" $ do
+    someMsgStoreTests $ testJournalStoreCfg MQStoreCfg
+    journalMsgStoreTests $ testJournalStoreCfg MQStoreCfg
+    it "should export and import journal store" $ withMsgStore (testJournalStoreCfg MQStoreCfg) testExportImportStore
 #if defined(dbServerPostgres)
-  around_ (postgressBracket testServerDBConnectInfo) $ do
-    around (withMsgStore $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg) $
-      describe "Postgres+journal message store" $ do
-        someMsgStoreTests
-        journalMsgStoreTests
-    around (withMsgStore testPostgresStoreConfig) $
-      describe "Postgres-only message store" $ do
-        someMsgStoreTests
-        it "should correctly update message counts and canWrite flag" testUpdateMessageCounts
-        it "tryDelPeekMsg (ACK not from NSE) should reset message counts when queue is empty" testResetMessageCounts
-        it "should expire messages across commit batches" testExpireMessagesInBatches
+  describe "Postgres+journal message store" $ do
+    someMsgStoreTests $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg
+    journalMsgStoreTests $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg
+  describe "Postgres-only message store" $ do
+    someMsgStoreTests testPostgresStoreConfig
+    it "should correctly update message counts and canWrite flag" $ withMsgStore testPostgresStoreConfig testUpdateMessageCounts
+    it "tryDelPeekMsg (ACK not from NSE) should reset message counts when queue is empty" $ withMsgStore testPostgresStoreConfig testResetMessageCounts
+    it "should expire messages across commit batches" $ withMsgStore testPostgresStoreConfig testExpireMessagesInBatches
 #endif
   describe "Journal message store: queue state backup expiration" $ do
     it "should remove old queue state backups" testRemoveQueueStateBackups
     it "should expire messages in idle queues" testExpireIdleQueues
   where
-    journalMsgStoreTests :: SpecWith (JournalMsgStore s)
-    journalMsgStoreTests = do
+    journalMsgStoreTests :: (HasTestEnv => JournalStoreConfig s) -> Spec
+    journalMsgStoreTests cfg = 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
-        it "should remove journal files when queue is empty" testRemoveJournals
+        it "should restore queue state from the last line" $ withMsgStore cfg testQueueState
+        it "should recover when message is written and state is not" $ withMsgStore cfg testMessageState
+        it "should remove journal files when queue is empty" $ withMsgStore cfg testRemoveJournals
       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
-    someMsgStoreTests :: MsgStoreClass s => SpecWith s
-    someMsgStoreTests = do
-      it "should get queue and store/read messages" testGetQueue
-      it "should write/ack messages" testWriteAckMessages
-      it "should not fail on EOF when changing read journal" testChangeReadJournal
-      it "should not add link data to secured messaging queue" testLinkDataSecuredQueue
+        it "should create read file when missing" $ withMsgStore cfg testReadFileMissing
+        it "should switch to write file when read file missing" $ withMsgStore cfg testReadFileMissingSwitch
+        it "should create write file when missing" $ withMsgStore cfg testWriteFileMissing
+        it "should create read file when read and write files are missing" $ withMsgStore cfg testReadAndWriteFilesMissing
+    someMsgStoreTests :: MsgStoreClass s => (HasTestEnv => MsgStoreConfig s) -> Spec
+    someMsgStoreTests cfg = do
+      it "should get queue and store/read messages" $ withMsgStore cfg testGetQueue
+      it "should write/ack messages" $ withMsgStore cfg testWriteAckMessages
+      it "should not fail on EOF when changing read journal" $ withMsgStore cfg testChangeReadJournal
+      it "should not add link data to secured messaging queue" $ withMsgStore cfg testLinkDataSecuredQueue
 
 -- TODO constrain to STM stores?
 withMsgStore :: MsgStoreClass s => MsgStoreConfig s -> (s -> IO ()) -> IO ()
@@ -110,7 +107,7 @@ withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore
 testSMTStoreConfig :: STMStoreConfig
 testSMTStoreConfig = STMStoreConfig {storePath = Nothing, quota = 3}
 
-testJournalStoreCfg :: QStoreCfg s -> JournalStoreConfig s
+testJournalStoreCfg :: HasTestEnv => QStoreCfg s -> JournalStoreConfig s
 testJournalStoreCfg queueStoreCfg =
   JournalStoreConfig
     { storePath = testStoreMsgsDir,
@@ -126,14 +123,14 @@ testJournalStoreCfg queueStoreCfg =
     }
 
 #if defined(dbServerPostgres)
-testPostgresStoreConfig :: PostgresMsgStoreCfg
+testPostgresStoreConfig :: HasTestEnv => PostgresMsgStoreCfg
 testPostgresStoreConfig =
   PostgresMsgStoreCfg
     { queueStoreCfg = testPostgresStoreCfg,
       quota = 3
     }
 
-testPostgresStoreCfg :: PostgresStoreCfg
+testPostgresStoreCfg :: HasTestEnv => PostgresStoreCfg
 testPostgresStoreCfg =
   PostgresStoreCfg
     { dbOpts = testStoreDBOpts,
@@ -295,7 +292,7 @@ testLinkDataSecuredQueue ms = do
     void $ ExceptT $ deleteQueue ms q
     void $ ExceptT $ deleteQueue ms cq
 
-testExportImportStore :: JournalMsgStore 'QSMemory -> IO ()
+testExportImportStore :: HasTestEnv => JournalMsgStore 'QSMemory -> IO ()
 testExportImportStore ms = do
   g <- C.newRandom
   (rId1, qr1) <- testNewQueueRec g QMMessaging
@@ -608,7 +605,7 @@ testRemoveJournals ms = do
     journalFilesCount dir = length . filter ("messages." `isPrefixOf`) <$> listDirectory dir
     stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
 
-testRemoveQueueStateBackups :: IO ()
+testRemoveQueueStateBackups :: HasTestEnv => IO ()
 testRemoveQueueStateBackups = do
   g <- C.newRandom
   (rId, qr) <- testNewQueueRec g QMMessaging
@@ -644,7 +641,7 @@ testRemoveQueueStateBackups = do
   where
     stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
 
-testExpireIdleQueues :: IO ()
+testExpireIdleQueues :: HasTestEnv => IO ()
 testExpireIdleQueues = do
   g <- C.newRandom
   (rId, qr) <- testNewQueueRec g QMMessaging
diff --git a/tests/CoreTests/RetryIntervalTests.hs b/tests/CoreTests/RetryIntervalTests.hs
index d1ab97124..f4b59ecc2 100644
--- a/tests/CoreTests/RetryIntervalTests.hs
+++ b/tests/CoreTests/RetryIntervalTests.hs
@@ -29,9 +29,9 @@ testRI =
   RetryInterval2
     { riSlow =
         RetryInterval
-          { initialInterval = 20000,
-            increaseAfter = 40000,
-            maxInterval = 40000
+          { initialInterval = 100000,
+            increaseAfter = 200000,
+            maxInterval = 200000
           },
       riFast = testFastRI
     }
@@ -39,9 +39,9 @@ testRI =
 testFastRI :: RetryInterval
 testFastRI =
   RetryInterval
-    { initialInterval = 10000,
-      increaseAfter = 20000,
-      maxInterval = 40000
+    { initialInterval = 50000,
+      increaseAfter = 100000,
+      maxInterval = 200000
     }
 
 type WithRetry2 = RetryInterval2 -> (RI2State -> (RetryIntervalMode -> IO ()) -> IO ()) -> IO ()
@@ -61,15 +61,15 @@ testRetryIntervalSameMode withRetry =
       when (length ints < 9) $ loop RIFast
     (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4, 4]
     (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [ (20000, 10000),
-                       (20000, 10000),
-                       (20000, 15000),
-                       (20000, 22500),
-                       (20000, 33750),
-                       (20000, 40000),
-                       (20000, 40000),
-                       (20000, 40000),
-                       (20000, 40000)
+      `shouldReturn` [ (100000, 50000),
+                       (100000, 50000),
+                       (100000, 75000),
+                       (100000, 112500),
+                       (100000, 168750),
+                       (100000, 200000),
+                       (100000, 200000),
+                       (100000, 200000),
+                       (100000, 200000)
                      ]
 
 testRetryIntervalSwitchMode :: WithRetry2 -> Spec
@@ -84,17 +84,17 @@ testRetryIntervalSwitchMode withRetry =
       when (length ints < 11) $ loop $ if length ints <= 5 then RIFast else RISlow
     (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 2, 2, 3, 4, 4]
     (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [ (20000, 10000),
-                       (20000, 10000),
-                       (20000, 15000),
-                       (20000, 22500),
-                       (20000, 33750),
-                       (20000, 40000),
-                       (20000, 40000),
-                       (30000, 40000),
-                       (40000, 40000),
-                       (40000, 40000),
-                       (40000, 40000)
+      `shouldReturn` [ (100000, 50000),
+                       (100000, 50000),
+                       (100000, 75000),
+                       (100000, 112500),
+                       (100000, 168750),
+                       (100000, 200000),
+                       (100000, 200000),
+                       (150000, 200000),
+                       (200000, 200000),
+                       (200000, 200000),
+                       (200000, 200000)
                      ]
 
 testRetryForeground :: Spec
@@ -110,7 +110,7 @@ testRetryForeground =
       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]
+      `shouldReturn` [50000, 50000, 75000, 112500, 168750, 200000, 200000, 200000]
 
 testRetryToBackground :: Spec
 testRetryToBackground =
@@ -121,7 +121,7 @@ testRetryToBackground =
     foreground <- newTVarIO True
     concurrently_
       ( do
-          threadDelay 50000
+          threadDelay 250000
           atomically $ writeTVar foreground False
       )
       ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
@@ -131,7 +131,7 @@ testRetryToBackground =
       )
     (reverse <$> readTVarIO intervals) `shouldReturn` [0, 1, 1, 1, 2, 3, 4, 4]
     (reverse <$> readTVarIO reportedIntervals)
-      `shouldReturn` [10000, 10000, 15000, 22500, 33750, 40000, 40000, 40000]
+      `shouldReturn` [50000, 50000, 75000, 112500, 168750, 200000, 200000, 200000]
 
 testRetrySkipWhenForeground :: Spec
 testRetrySkipWhenForeground =
@@ -142,11 +142,11 @@ testRetrySkipWhenForeground =
     foreground <- newTVarIO False
     concurrently_
       ( do
-          threadDelay 65000
+          threadDelay 312500
           atomically $ writeTVar foreground True
-          threadDelay 10000
+          threadDelay 150000
           atomically $ writeTVar foreground False
-          threadDelay 100000
+          threadDelay 381250
           atomically $ writeTVar foreground True
       )
       ( withRetryForeground testFastRI (readTVar foreground) (pure True) $ \delay loop -> do
@@ -156,11 +156,11 @@ testRetrySkipWhenForeground =
       )
     (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]
+      `shouldReturn` [50000, 50000, 75000, 112500, 168750, 50000, 50000, 75000, 112500, 168750, 200000, 50000]
 
 addInterval :: TVar [Int] -> TVar UTCTime -> IO [Int]
 addInterval intervals ts = do
   ts' <- getCurrentTime
   atomically $ do
-    int :: Int <- truncate . (* 100) . nominalDiffTimeToSeconds <$> stateTVar ts (\t -> (diffUTCTime ts' t, ts'))
+    int :: Int <- truncate . (* 20) . nominalDiffTimeToSeconds <$> stateTVar ts (\t -> (diffUTCTime ts' t, ts'))
     stateTVar intervals $ \ints -> (int : ints, int : ints)
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index 81a0535d5..3c030a143 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -177,10 +177,10 @@ testSMPStoreLog testSuite tests =
     closeStoreLog l
     replicateM_ 3 $ testReadWrite t
 #if defined(dbServerPostgres)
-    (sCnt, qCnt) <- importStoreLogToDatabase "tests/tmp/" testStoreLogFile testStoreDBOpts
+    (sCnt, qCnt) <- importStoreLogToDatabase testDir testStoreLogFile testStoreDBOpts
     fromIntegral (sCnt + qCnt) `shouldBe` length (compacted t)
     imported <- B.readFile $ testStoreLogFile <> ".bak"
-    (sCnt', qCnt') <- exportDatabaseToStoreLog "tests/tmp/" testStoreDBOpts testStoreLogFile
+    (sCnt', qCnt') <- exportDatabaseToStoreLog testDir testStoreDBOpts testStoreLogFile
     sCnt' `shouldBe` fromIntegral sCnt
     qCnt' `shouldBe` fromIntegral qCnt
     exported <- B.readFile testStoreLogFile
@@ -207,8 +207,8 @@ deriving instance Eq FileRecipient
 
 deriving instance Eq FileStoreLogRecord
 
-testFileStoreLogFile :: FilePath
-testFileStoreLogFile = "tests/tmp/xftp-server-store.log"
+testFileStoreLogFile :: HasTestEnv => FilePath
+testFileStoreLogFile = testPath "xftp-server-store.log"
 
 fileExpirationTests :: Spec
 fileExpirationTests =
diff --git a/tests/CoreTests/XFTPStoreTests.hs b/tests/CoreTests/XFTPStoreTests.hs
index 52c7cedfa..cb121b8d8 100644
--- a/tests/CoreTests/XFTPStoreTests.hs
+++ b/tests/CoreTests/XFTPStoreTests.hs
@@ -47,7 +47,7 @@ xftpMigrationTests = describe "XFTP migration round-trip" $ do
 
 -- Test helpers
 
-withPgStore :: (PostgresFileStore -> IO ()) -> IO ()
+withPgStore :: HasTestEnv => (PostgresFileStore -> IO ()) -> IO ()
 withPgStore test = do
   st <- newFileStore testXFTPPostgresCfg :: IO PostgresFileStore
   test st
@@ -75,7 +75,7 @@ testExpiresAt = RoundedSystemTime 2000000
 
 -- Tests
 
-testAddGetFileSender :: Expectation
+testAddGetFileSender :: HasTestEnv => Expectation
 testAddGetFileSender = withPgStore $ \st -> do
   g <- C.newRandom
   (sk, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -91,7 +91,7 @@ testAddGetFileSender = withPgStore $ \st -> do
       key `shouldBe` sk
     Left e -> expectationFailure $ "getFile failed: " <> show e
 
-testAddGetFileRecipient :: Expectation
+testAddGetFileRecipient :: HasTestEnv => Expectation
 testAddGetFileRecipient = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -106,7 +106,7 @@ testAddGetFileRecipient = withPgStore $ \st -> do
       key `shouldBe` rcpKey
     Left e -> expectationFailure $ "getFile failed: " <> show e
 
-testDuplicateFile :: Expectation
+testDuplicateFile :: HasTestEnv => Expectation
 testDuplicateFile = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -114,12 +114,12 @@ testDuplicateFile = withPgStore $ \st -> do
   addFile st testSenderId fileInfo testCreatedAt Nothing EntityActive `shouldReturn` Right ()
   addFile st testSenderId fileInfo testCreatedAt Nothing EntityActive `shouldReturn` Left DUPLICATE_
 
-testGetNonexistent :: Expectation
+testGetNonexistent :: HasTestEnv => Expectation
 testGetNonexistent = withPgStore $ \st -> do
   getFile st SFSender testSenderId >>= (`shouldBe` Left AUTH) . fmap (const ())
   getFile st SFRecipient testRecipientId >>= (`shouldBe` Left AUTH) . fmap (const ())
 
-testSetFilePath :: Expectation
+testSetFilePath :: HasTestEnv => Expectation
 testSetFilePath = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -134,7 +134,7 @@ testSetFilePath = withPgStore $ \st -> do
     Right (FileRec {filePath}, _) -> readTVarIO filePath `shouldReturn` Just "/tmp/test_file"
     Left e -> expectationFailure $ "getFile failed: " <> show e
 
-testDuplicateRecipient :: Expectation
+testDuplicateRecipient :: HasTestEnv => Expectation
 testDuplicateRecipient = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -144,7 +144,7 @@ testDuplicateRecipient = withPgStore $ \st -> do
   addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Right ()
   addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Left DUPLICATE_
 
-testDeleteFileCascade :: Expectation
+testDeleteFileCascade :: HasTestEnv => Expectation
 testDeleteFileCascade = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -157,7 +157,7 @@ testDeleteFileCascade = withPgStore $ \st -> do
   getFile st SFSender testSenderId >>= (`shouldBe` Left AUTH) . fmap (const ())
   getFile st SFRecipient testRecipientId >>= (`shouldBe` Left AUTH) . fmap (const ())
 
-testBlockFile :: Expectation
+testBlockFile :: HasTestEnv => Expectation
 testBlockFile = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -170,7 +170,7 @@ testBlockFile = withPgStore $ \st -> do
     Right (FileRec {fileStatus}, _) -> readTVarIO fileStatus `shouldReturn` EntityBlocked blockInfo
     Left e -> expectationFailure $ "getFile failed: " <> show e
 
-testAckFile :: Expectation
+testAckFile :: HasTestEnv => Expectation
 testAckFile = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -186,7 +186,7 @@ testAckFile = withPgStore $ \st -> do
     Right _ -> pure ()
     Left e -> expectationFailure $ "getFile failed: " <> show e
 
-testExpiredFiles :: Expectation
+testExpiredFiles :: HasTestEnv => Expectation
 testExpiredFiles = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -207,7 +207,7 @@ testExpiredFiles = withPgStore $ \st -> do
       sz `shouldBe` 128000
     _ -> expectationFailure "expected 1 expired file"
 
-testExpiredFilesStoredExpiration :: Expectation
+testExpiredFilesStoredExpiration :: HasTestEnv => Expectation
 testExpiredFilesStoredExpiration = withPgStore $ \st -> do
   g <- C.newRandom
   (sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -219,7 +219,7 @@ testExpiredFilesStoredExpiration = withPgStore $ \st -> do
   expired <- expiredFiles st (RoundedSystemTime 500000) 0 100
   map (\(sId, _, _) -> sId) expired `shouldBe` [EntityId "expired_file____"]
 
-testStorageAndCount :: Expectation
+testStorageAndCount :: HasTestEnv => Expectation
 testStorageAndCount = withPgStore $ \st -> do
   testStorageAndCountForStore st
 
@@ -250,10 +250,10 @@ testStorageAndCountForStore st = do
 
 -- Migration round-trip test
 
-testMigrationRoundTrip :: Expectation
+testMigrationRoundTrip :: HasTestEnv => Expectation
 testMigrationRoundTrip = do
-  let storeLogPath = "tests/tmp/xftp-migration-test.log"
-      storeLogPath2 = "tests/tmp/xftp-migration-test2.log"
+  let storeLogPath = testPath "xftp-migration-test.log"
+      storeLogPath2 = testPath "xftp-migration-test2.log"
   -- 1. Create STM store with test data
   stmStore <- newFileStore () :: IO STMFileStore
   g <- C.newRandom
diff --git a/tests/FileDescriptionTests.hs b/tests/FileDescriptionTests.hs
index b4b8ffd28..ad4557476 100644
--- a/tests/FileDescriptionTests.hs
+++ b/tests/FileDescriptionTests.hs
@@ -33,8 +33,8 @@ fileDescriptionTests = do
 fileDescPath :: FilePath
 fileDescPath = "tests/fixtures/file_description.yaml"
 
-tmpFileDescPath :: FilePath
-tmpFileDescPath = "tests/tmp/file_description.yaml"
+tmpFileDescPath :: HasTestEnv => FilePath
+tmpFileDescPath = testPath "file_description.yaml"
 
 testSbKey :: C.SbKey
 testSbKey = either error id $ strDecode "00n8p1tJq5E-SGnHcYTOrS4A9I07gTA_WFD6MTFFFOY="
@@ -144,7 +144,7 @@ testParseYAMLFileDescription = do
   yfd <- Y.decodeFileThrow fileDescPath
   yfd `shouldBe` yamlFileDesc
 
-testSerializeYAMLFileDescription :: IO ()
+testSerializeYAMLFileDescription :: HasTestEnv => IO ()
 testSerializeYAMLFileDescription = withRemoveTmpFile $ do
   Y.encodeFile tmpFileDescPath yamlFileDesc
   fdSer <- B.readFile tmpFileDescPath
@@ -158,7 +158,7 @@ testParseFileDescription = do
     Left e -> expectationFailure $ show e
     Right fd -> fd `shouldBe` fileDesc
 
-testSerializeFileDescription :: IO ()
+testSerializeFileDescription :: HasTestEnv => IO ()
 testSerializeFileDescription = withRemoveTmpFile $ do
   B.writeFile tmpFileDescPath $ strEncode fileDesc
   fdSer <- B.readFile tmpFileDescPath
@@ -177,7 +177,7 @@ testFileDescriptionURIExtras = do
   let descr = FileDescriptionURI SSSimplex vfd $ Just "{\"something\":\"extra\",\"more\":true}"
   strDecode (strEncode descr) `shouldBe` Right descr
 
-withRemoveTmpFile :: IO () -> IO ()
+withRemoveTmpFile :: HasTestEnv => IO () -> IO ()
 withRemoveTmpFile =
   bracket_
     (pure ())
diff --git a/tests/NamesResolverServer.hs b/tests/NamesResolverServer.hs
index 054d55e40..e7f57b2fb 100644
--- a/tests/NamesResolverServer.hs
+++ b/tests/NamesResolverServer.hs
@@ -30,6 +30,7 @@ import SMPClient (AServerConfig (..), cfgMS, proxyCfgMS, testStoreLogFile2, test
 import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..), ServerStoreCfg (..), StorePaths (..))
 import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
 import Simplex.Messaging.Server.Names (NamesConfig (..))
+import Util (HasTestEnv)
 
 -- | Run an action with a local HTTP resolver on a free port.
 withResolverServer :: ([Text] -> (Status, LB.ByteString)) -> (Int -> IORef [[Text]] -> IO a) -> IO a
@@ -64,13 +65,13 @@ testNamesConfig port =
       resolverMaxResponseBytes = 65536
     }
 
-memCfg :: AServerConfig
+memCfg :: HasTestEnv => AServerConfig
 memCfg = cfgMS (ASType SQSMemory SMSMemory)
 
-memProxyCfg :: AServerConfig
+memProxyCfg :: HasTestEnv => AServerConfig
 memProxyCfg = proxyCfgMS (ASType SQSMemory SMSMemory)
 
-memCfg2 :: AServerConfig
+memCfg2 :: HasTestEnv => AServerConfig
 memCfg2 = case memCfg of
   ASrvCfg qt mt c -> ASrvCfg qt mt c {serverStoreCfg = newStoreCfg (serverStoreCfg c)}
   where
diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs
index b0ee811d3..79dac6dd3 100644
--- a/tests/NtfClient.hs
+++ b/tests/NtfClient.hs
@@ -60,30 +60,31 @@ import UnliftIO.Async
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
 import UnliftIO.STM
+import Util
 
 testHost :: NonEmpty TransportHost
 testHost = "localhost"
 
-apnsTestPort :: ServiceName
-apnsTestPort = "6010"
+apnsTestPort :: HasTestEnv => ServiceName
+apnsTestPort = testServerPort 5
 
 testKeyHash :: C.KeyHash
 testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 
-ntfTestStoreLogFile :: FilePath
-ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"
+ntfTestStoreLogFile :: HasTestEnv => FilePath
+ntfTestStoreLogFile = testPath "ntf-server-store.log"
 
-ntfTestStoreLogFile2 :: FilePath
-ntfTestStoreLogFile2 = "tests/tmp/ntf-server-store.log.2"
+ntfTestStoreLogFile2 :: HasTestEnv => FilePath
+ntfTestStoreLogFile2 = testPath "ntf-server-store.log.2"
 
-ntfTestStoreLastNtfsFile :: FilePath
-ntfTestStoreLastNtfsFile = "tests/tmp/ntf-server-last-notifications.log"
+ntfTestStoreLastNtfsFile :: HasTestEnv => FilePath
+ntfTestStoreLastNtfsFile = testPath "ntf-server-last-notifications.log"
 
-ntfTestPrometheusMetricsFile :: FilePath
-ntfTestPrometheusMetricsFile = "tests/tmp/ntf-server-metrics.txt"
+ntfTestPrometheusMetricsFile :: HasTestEnv => FilePath
+ntfTestPrometheusMetricsFile = testPath "ntf-server-metrics.txt"
 
-ntfTestStoreDBOpts :: DBOpts
-ntfTestStoreDBOpts =
+ntfTestServerDBOpts :: DBOpts
+ntfTestServerDBOpts =
   DBOpts
     { connstr = ntfTestServerDBConnstr,
       schema = "ntf_server",
@@ -91,8 +92,11 @@ ntfTestStoreDBOpts =
       createSchema = True
     }
 
-ntfTestStoreDBOpts2 :: DBOpts
-ntfTestStoreDBOpts2 = ntfTestStoreDBOpts {schema = "smp_server2"}
+ntfTestStoreDBOpts :: HasTestEnv => DBOpts
+ntfTestStoreDBOpts = ntfTestServerDBOpts {schema = testSchemaName "ntf_server"}
+
+ntfTestStoreDBOpts2 :: HasTestEnv => DBOpts
+ntfTestStoreDBOpts2 = ntfTestStoreDBOpts {schema = testSchemaName "smp_server2"}
 
 ntfTestServerDBConnstr :: ByteString
 ntfTestServerDBConnstr = "postgresql://ntf_test_server_user@/ntf_test_server_db"
@@ -104,7 +108,7 @@ ntfTestServerDBConnectInfo =
       connectDatabase = "ntf_test_server_db"
     }
 
-ntfTestDBCfg :: PostgresStoreCfg
+ntfTestDBCfg :: HasTestEnv => PostgresStoreCfg
 ntfTestDBCfg =
   PostgresStoreCfg
     { dbOpts = ntfTestStoreDBOpts,
@@ -113,10 +117,10 @@ ntfTestDBCfg =
       deletedTTL = 86400
     }
 
-ntfTestDBCfg2 :: PostgresStoreCfg
+ntfTestDBCfg2 :: HasTestEnv => PostgresStoreCfg
 ntfTestDBCfg2 = ntfTestDBCfg {dbOpts = ntfTestStoreDBOpts2, dbStoreLogPath = Just ntfTestStoreLogFile2}
 
-testNtfClient :: Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
+testNtfClient :: (HasTestEnv, Transport c) => (THandleNTF c 'TClient -> IO a) -> IO a
 testNtfClient client = do
   Right host <- pure $ chooseTransportHost defaultNetworkConfig testHost
   runTransportClient defaultTransportClientConfig Nothing host ntfTestPort (Just testKeyHash) $ \h ->
@@ -124,7 +128,7 @@ testNtfClient client = do
       Right th -> client th
       Left e -> error $ show e
 
-ntfServerCfg :: NtfServerConfig
+ntfServerCfg :: HasTestEnv => NtfServerConfig
 ntfServerCfg =
   NtfServerConfig
     { transports = [],
@@ -151,7 +155,7 @@ ntfServerCfg =
       -- stats config
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
-      serverStatsLogFile = "tests/ntf-server-stats.daily.log",
+      serverStatsLogFile = testPath "ntf-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       prometheusInterval = Nothing,
       prometheusMetricsFile = ntfTestPrometheusMetricsFile,
@@ -171,7 +175,7 @@ ntfServerCfg =
 --     smpCfg' = smpCfg smpAgentCfg'
 --     serverVRange' = serverVRange smpCfg'
 
-withNtfServerThreadOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a
+withNtfServerThreadOn :: (HasCallStack, HasTestEnv) => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => ThreadId -> IO a) -> IO a
 withNtfServerThreadOn t port' dbStoreConfig =
   withNtfServerCfg ntfServerCfg {transports = [(port', t, False)], dbStoreConfig}
 
@@ -184,18 +188,18 @@ withNtfServerCfg cfg@NtfServerConfig {transports} =
         (\started -> runNtfServerBlocking started cfg)
         (pure ())
 
-withNtfServerOn :: HasCallStack => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => IO a) -> IO a
+withNtfServerOn :: (HasCallStack, HasTestEnv) => ASrvTransport -> ServiceName -> PostgresStoreCfg -> (HasCallStack => IO a) -> IO a
 withNtfServerOn t port' dbStoreConfig = withNtfServerThreadOn t port' dbStoreConfig . const
 
-withNtfServer :: HasCallStack => ASrvTransport -> (HasCallStack => IO a) -> IO a
+withNtfServer :: (HasCallStack, HasTestEnv) => ASrvTransport -> (HasCallStack => IO a) -> IO a
 withNtfServer t = withNtfServerOn t ntfTestPort ntfTestDBCfg
 
-runNtfTest :: forall c a. Transport c => (THandleNTF c 'TClient -> IO a) -> IO a
+runNtfTest :: forall c a. (HasTestEnv, Transport c) => (THandleNTF c 'TClient -> IO a) -> IO a
 runNtfTest test = withNtfServer (transport @c) $ testNtfClient test
 
 ntfServerTest ::
   forall c smp.
-  (Transport c, Encoding smp) =>
+  (HasTestEnv, Transport c, Encoding smp) =>
   TProxy c 'TServer ->
   (Maybe TAuthorizations, ByteString, ByteString, smp) ->
   IO (Maybe TAuthorizations, ByteString, ByteString, NtfResponse)
@@ -210,7 +214,7 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
       [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
       pure (Nothing, corrId, qId, cmd)
 
-ntfTest :: Transport c => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation
+ntfTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation
 ntfTest _ test' = runNtfTest test' `shouldReturn` ()
 
 data APNSMockRequest = APNSMockRequest
@@ -225,7 +229,7 @@ data APNSMockServer = APNSMockServer
     http2Server :: HTTP2Server
   }
 
-apnsMockServerConfig :: HTTP2ServerConfig
+apnsMockServerConfig :: HasTestEnv => HTTP2ServerConfig
 apnsMockServerConfig =
   HTTP2ServerConfig
     { qSize = 2,
@@ -242,7 +246,7 @@ apnsMockServerConfig =
       transportConfig = mkTransportServerConfig True Nothing False
     }
 
-withAPNSMockServer :: (APNSMockServer -> IO a) -> IO a
+withAPNSMockServer :: HasTestEnv => (APNSMockServer -> IO a) -> IO a
 withAPNSMockServer = E.bracket (getAPNSMockServer apnsMockServerConfig) closeAPNSMockServer
 
 deriving instance Generic APNSAlertBody
diff --git a/tests/NtfServerTests.hs b/tests/NtfServerTests.hs
index fe19259db..4b8a8d416 100644
--- a/tests/NtfServerTests.hs
+++ b/tests/NtfServerTests.hs
@@ -69,13 +69,13 @@ ntfSyntaxTests (ATransport t) = do
     it "token ID" $ (sampleSig, "abcd", "12345678", (TNEW_, ' ', ('T', 'A', 'T', "abcd" :: ByteString), samplePubKey, sampleDhPubKey)) >#> ("", "abcd", "12345678", NRErr $ CMD HAS_AUTH)
   where
     (>#>) ::
-      Encoding smp =>
+      (HasTestEnv, Encoding smp) =>
       (Maybe TAuthorizations, ByteString, ByteString, smp) ->
       (Maybe TAuthorizations, ByteString, ByteString, NtfResponse) ->
       Expectation
     command >#> response = withAPNSMockServer $ \_ -> ntfServerTest t command `shouldReturn` response
 
-testApnsTestProviderRejected :: ASrvTransport -> Expectation
+testApnsTestProviderRejected :: HasTestEnv => ASrvTransport -> Expectation
 testApnsTestProviderRejected (ATransport (t :: TProxy c 'TServer)) = do
   g <- C.newRandom
   (tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
diff --git a/tests/PostgresSchemaDump.hs b/tests/PostgresSchemaDump.hs
index a0f3fe45b..d7ae8e2cf 100644
--- a/tests/PostgresSchemaDump.hs
+++ b/tests/PostgresSchemaDump.hs
@@ -66,5 +66,6 @@ postgresSchemaDumpTest migrations skipComparisonForDownMigrations testDBOpts@DBO
       threadDelay 20000
       let sed = (if os == "linux" then "sed -i" else "sed -i ''")
       void $ readCreateProcess (shell $ sed <> " '/^--/d; /^\\\\restrict/d; /^\\\\unrestrict/d' " <> schemaPath) ""
-      sch <- readFile schemaPath
-      sch `deepseq` pure sch
+      sch <- unlines . dropWhileEnd null . dropWhile null . lines <$> readFile schemaPath
+      sch `deepseq` writeFile schemaPath sch
+      pure sch
diff --git a/tests/RSLVTests.hs b/tests/RSLVTests.hs
index a52aa2a86..0d096bccb 100644
--- a/tests/RSLVTests.hs
+++ b/tests/RSLVTests.hs
@@ -55,22 +55,22 @@ import Simplex.Messaging.SimplexName (SimplexDomain)
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Version (mkVersionRange)
 import Test.Hspec hiding (fit, it)
-import Util (it)
+import Util (HasTestEnv, it)
 
 domain :: Text -> SimplexDomain
 domain = either error id . strDecode . encodeUtf8
 
-withResolverServer :: (Status, LB.ByteString) -> IO a -> IO a
+withResolverServer :: HasTestEnv => (Status, LB.ByteString) -> IO a -> IO a
 withResolverServer (st, body) runTest =
   NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
     withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort (const runTest)
 
-withResolverServerReqs :: (Status, LB.ByteString) -> (IORef [[Text]] -> IO a) -> IO a
+withResolverServerReqs :: HasTestEnv => (Status, LB.ByteString) -> (IORef [[Text]] -> IO a) -> IO a
 withResolverServerReqs (st, body) runTest =
   NRS.withResolverServer (NRS.resolveResp st body) $ \port reqs ->
     withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort (const (runTest reqs))
 
-withProxyAndResolver :: (Status, LB.ByteString) -> IO a -> IO a
+withProxyAndResolver :: HasTestEnv => (Status, LB.ByteString) -> IO a -> IO a
 withProxyAndResolver (st, body) runTest =
   NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
     withSmpServerConfigOn (transport @TLS) memProxyCfg testPort $ \_ ->
@@ -113,7 +113,7 @@ rslvTests = do
 
 -- | /v2/resolve answers 200, 400 or 502, so a 404 is a resolver that predates
 -- the route, not a name that does not exist.
-testRslvBackendNotFound :: IO ()
+testRslvBackendNotFound :: HasTestEnv => IO ()
 testRslvBackendNotFound =
   withResolverServer (status404, "{}") $
     testSMPClient @TLS $ \h -> do
@@ -121,21 +121,21 @@ testRslvBackendNotFound =
       corrId `shouldBe` CorrId "rs01"
       resp `shouldBe` Right (ERR (NAME (RESOLVER "HTTP 404")))
 
-testRslvBackendHttpErr :: IO ()
+testRslvBackendHttpErr :: HasTestEnv => IO ()
 testRslvBackendHttpErr =
   withResolverServer (status502, "{}") $
     testSMPClient @TLS $ \h -> do
       (_, _, resp) <- sendRslv h "rs05" (domain "alice.simplex")
       resp `shouldBe` Right (ERR (NAME (RESOLVER "HTTP 502")))
 
-testRslvDisabled :: IO ()
+testRslvDisabled :: HasTestEnv => IO ()
 testRslvDisabled =
   withSmpServerConfigOn (transport @TLS) memCfg testPort $ const $
     testSMPClient @TLS $ \h -> do
       (_, _, resp) <- sendRslv h "rs06" (domain "alice.simplex")
       resp `shouldBe` Right (ERR (NAME NO_RESOLVER))
 
-testRslvVersion :: IO ()
+testRslvVersion :: HasTestEnv => IO ()
 testRslvVersion =
   withResolverServer (status200, registeredBody testNameRecord) $ do
     g <- C.newRandom
@@ -149,7 +149,7 @@ testRslvVersion =
       Left (PCETransportError TEVersion) -> pure ()
       _ -> expectationFailure $ "expected Left (PCETransportError TEVersion), got: " <> show r
 
-forwardedResolveAlice :: IO (Either SMPClientError (Either ProxyClientError SMP.NameResponse))
+forwardedResolveAlice :: HasTestEnv => IO (Either SMPClientError (Either ProxyClientError SMP.NameResponse))
 forwardedResolveAlice = do
   g <- C.newRandom
   ts <- getCurrentTime
@@ -161,21 +161,21 @@ forwardedResolveAlice = do
   sess <- runExceptT' (connectSMPProxiedRelay pc NRMInteractive relayServ Nothing)
   runExceptT (proxyResolveName pc NRMInteractive sess (domain "alice.simplex"))
 
-testRslvForwarded :: IO ()
+testRslvForwarded :: HasTestEnv => IO ()
 testRslvForwarded =
   withProxyAndResolver (status404, "{}") $
     forwardedResolveAlice >>= \r -> case r of
       Left (PCEProtocolError (SMP.NAME (SMP.RESOLVER _))) -> pure ()
       _ -> expectationFailure $ "expected Left (PCEProtocolError (NAME (RESOLVER _))), got: " <> show r
 
-testRslvForwardedSuccess :: IO ()
+testRslvForwardedSuccess :: HasTestEnv => IO ()
 testRslvForwardedSuccess =
   withProxyAndResolver (status200, registeredBody testNameRecord) $
     forwardedResolveAlice >>= \r -> case r of
       Right (Right NameResponse {registration = NRRegistered {nameRecord}}) -> nameRecord `shouldBe` testNameRecord
       _ -> expectationFailure $ "expected Right (Right NRRegistered), got: " <> show r
 
-testRslvSuccess :: IO ()
+testRslvSuccess :: HasTestEnv => IO ()
 testRslvSuccess =
   withResolverServer (status200, registeredBody testNameRecord) $
     testSMPClient @TLS $ \h -> do
@@ -185,7 +185,7 @@ testRslvSuccess =
         Right (RNAME NameResponse {registration = NRRegistered {nameRecord}}) -> nameRecord `shouldBe` testNameRecord
         _ -> expectationFailure $ "expected Right (RNAME NRRegistered), got: " <> show resp
 
-testRslvAvailable :: IO ()
+testRslvAvailable :: HasTestEnv => IO ()
 testRslvAvailable =
   withResolverServer (status200, availableBody) $
     testSMPClient @TLS $ \h -> do
@@ -193,7 +193,7 @@ testRslvAvailable =
       corrId `shouldBe` CorrId "na01"
       resp `shouldBe` Right (RNAME (resolved (NRAvailable testPricing)))
 
-testRslvReserved :: IO ()
+testRslvReserved :: HasTestEnv => IO ()
 testRslvReserved =
   withResolverServer (status200, reservedBody) $
     testSMPClient @TLS $ \h -> do
@@ -202,7 +202,7 @@ testRslvReserved =
 
 -- | A client that predates v22 must see exactly what it saw before: the record
 -- for a name that resolves, and NOT_FOUND for one that does not.
-oldClient :: IO SMPClient
+oldClient :: HasTestEnv => IO SMPClient
 oldClient = do
   g <- C.newRandom
   ts <- getCurrentTime
@@ -213,14 +213,14 @@ oldClient = do
   pcE <- getProtocolClient g NRMInteractive (1, srv, Nothing) oldCfg [] Nothing ts (\_ -> pure ())
   either (fail . show) pure pcE
 
-testRslvOldClientRecord :: IO ()
+testRslvOldClientRecord :: HasTestEnv => IO ()
 testRslvOldClientRecord =
   withResolverServer (status200, registeredBody testNameRecord) $ do
     pc <- oldClient
     r <- runExceptT' (directResolveName pc NRMInteractive (domain "alice.simplex"))
     r `shouldBe` NameResponse Nothing (NRRegistered Nothing Nothing Nothing testNameRecord)
 
-testRslvOldClientNotFound :: IO ()
+testRslvOldClientNotFound :: HasTestEnv => IO ()
 testRslvOldClientNotFound =
   withResolverServer (status200, availableBody) $ do
     pc <- oldClient
@@ -229,7 +229,7 @@ testRslvOldClientNotFound =
       Left (PCEProtocolError (SMP.NAME SMP.NOT_FOUND)) -> pure ()
       _ -> expectationFailure $ "expected Left (PCEProtocolError (NAME NOT_FOUND)), got: " <> show r
 
-testRslvForwardedAvailable :: IO ()
+testRslvForwardedAvailable :: HasTestEnv => IO ()
 testRslvForwardedAvailable =
   withProxyAndResolver (status200, availableBody) $
     forwardedResolveAlice >>= \r -> case r of
@@ -246,7 +246,7 @@ resolvePaths reqs = filter isResolve <$> readIORef reqs
   where
     isResolve = \case ("v2" : "resolve" : _) -> True; _ -> False
 
-currentClient :: IO SMPClient
+currentClient :: HasTestEnv => IO SMPClient
 currentClient = do
   g <- C.newRandom
   ts <- getCurrentTime
@@ -254,7 +254,7 @@ currentClient = do
   pcE <- getProtocolClient g NRMInteractive (1, srv, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
   either (fail . show) pure pcE
 
-testRslvSendsTheHash :: IO ()
+testRslvSendsTheHash :: HasTestEnv => IO ()
 testRslvSendsTheHash =
   withResolverServerReqs (status200, registeredBody testNameRecord) $ \reqs -> do
     pc <- currentClient
@@ -265,7 +265,7 @@ testRslvSendsTheHash =
       NameResponse {registration = NRRegistered {nameRecord}} -> SMP.nrName nameRecord `shouldBe` "alice.simplex"
       _ -> expectationFailure $ "expected NRRegistered, got: " <> show r
 
-testSubnameKeepsItsLabels :: IO ()
+testSubnameKeepsItsLabels :: HasTestEnv => IO ()
 testSubnameKeepsItsLabels =
   withResolverServerReqs (status200, availableBody) $ \reqs -> do
     pc <- currentClient
@@ -274,7 +274,7 @@ testSubnameKeepsItsLabels =
 
 -- a hashed query does not tell the router the name, so the record's own name is
 -- checked against the one that was asked for
-testRslvWrongName :: IO ()
+testRslvWrongName :: HasTestEnv => IO ()
 testRslvWrongName =
   withResolverServer (status200, registeredBody testNameRecord {SMP.nrName = "mallory.simplex"}) $ do
     pc <- currentClient
@@ -285,7 +285,7 @@ testRslvWrongName =
 
 -- The resolver answers after 3s and the server gives up after 1s, so a request
 -- that reached the resolver stays in flight for the whole check.
-testRslvConnectionCap :: IO ()
+testRslvConnectionCap :: HasTestEnv => IO ()
 testRslvConnectionCap =
   NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
     withSmpServerConfigOn (transport @TLS) (updateCfg (withNames port memCfg) $ \c -> c {serverClientConcurrency = connCap}) testPort $ const $
@@ -298,7 +298,7 @@ testRslvConnectionCap =
     connCap = 4
 
 -- 4 lookups take the slots for the 1s resolver timeout, the 5th waits for a slot.
-testRslvSlotWait :: IO ()
+testRslvSlotWait :: HasTestEnv => IO ()
 testRslvSlotWait =
   NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
     withSmpServerConfigOn (transport @TLS) (slotWaitCfg port 10000000) testPort $ const $
@@ -314,7 +314,7 @@ testRslvSlotWait =
 
 -- The client times out after 0.2s, so the 2 waiting lookups fail before the slots are released.
 -- The connection does not process further commands while one waits, so the 6th waits after the 5th times out.
-testRslvSlotWaitTimeout :: IO ()
+testRslvSlotWaitTimeout :: HasTestEnv => IO ()
 testRslvSlotWaitTimeout =
   NRS.withResolverServerDelayed 3000 (NRS.resolveResp status200 "{}") $ \port reqs ->
     withSmpServerConfigOn (transport @TLS) (slotWaitCfg port 200000) testPort $ const $
@@ -328,13 +328,13 @@ testRslvSlotWaitTimeout =
         waitMaxMs `shouldSatisfy` (\t -> t >= 200 && t < 1000)
         waitSumMs `shouldSatisfy` (>= 400)
 
-slotWaitCfg :: Int -> Int -> AServerConfig
+slotWaitCfg :: HasTestEnv => Int -> Int -> AServerConfig
 slotWaitCfg port clientTimeout =
   updateCfg (withNames port memCfg) $ \c -> c {serverClientConcurrency = 4, prometheusInterval = Just 1, maxClientCmdWait = clientTimeout}
 
 data SlotWaitMetrics = SlotWaitMetrics {waits :: Int, waitTimeouts :: Int, waitMaxMs :: Int, waitSumMs :: Int}
 
-readSlotWaitMetrics :: IO SlotWaitMetrics
+readSlotWaitMetrics :: HasTestEnv => IO SlotWaitMetrics
 readSlotWaitMetrics = do
   ms <- map words . lines <$> readFile testPrometheusMetricsFile
   -- metric lines are "name value timestamp"
diff --git a/tests/SMPAgentClient.hs b/tests/SMPAgentClient.hs
index 159460828..feb43387e 100644
--- a/tests/SMPAgentClient.hs
+++ b/tests/SMPAgentClient.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -15,79 +16,80 @@ 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 SMPClient (ntfTestPort, testPort)
+import SMPClient (ntfTestPort, ntfTestPort2, testHost, testHost2, testKeyHash, testPort, testPort2)
 import Simplex.Messaging.Agent.Env.SQLite
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.RetryInterval
 import Simplex.Messaging.Client (NetworkTimeout (..), ProtocolClientConfig (..), SMPProxyFallback (..), SMPProxyMode (..), defaultNetworkConfig, defaultSMPClientConfig)
 import Simplex.Messaging.Notifications.Client (defaultNTFClientConfig)
-import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer)
+import Simplex.Messaging.Protocol (NtfServer, ProtoServerWithAuth (..), ProtocolServer, pattern NtfServer)
 import Simplex.Messaging.Transport
+import Util
 import XFTPClient (testXFTPServer)
 
 -- name fixtures are reused, but they are used as schema name instead of database file path
 #if defined(dbPostgres)
-testDB :: String
-testDB = "smp_agent_test_protocol_schema"
+testDB :: HasTestEnv => String
+testDB = testSchemaName "smp_agent_test_protocol_schema"
 
-testDB2 :: String
-testDB2 = "smp_agent2_test_protocol_schema"
+testDB2 :: HasTestEnv => String
+testDB2 = testSchemaName "smp_agent2_test_protocol_schema"
 
-testDB3 :: String
-testDB3 = "smp_agent3_test_protocol_schema"
+testDB3 :: HasTestEnv => String
+testDB3 = testSchemaName "smp_agent3_test_protocol_schema"
 #else
-testDB :: FilePath
-testDB = "tests/tmp/smp-agent.test.protocol.db"
+testDB :: HasTestEnv => FilePath
+testDB = testPath "smp-agent.test.protocol.db"
 
-testDB2 :: FilePath
-testDB2 = "tests/tmp/smp-agent2.test.protocol.db"
+testDB2 :: HasTestEnv => FilePath
+testDB2 = testPath "smp-agent2.test.protocol.db"
 
-testDB3 :: FilePath
-testDB3 = "tests/tmp/smp-agent3.test.protocol.db"
+testDB3 :: HasTestEnv => FilePath
+testDB3 = testPath "smp-agent3.test.protocol.db"
 #endif
 
-testSMPServer :: SMPServer
-testSMPServer = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:5001"
+testSMPServer :: HasTestEnv => SMPServer
+testSMPServer = SMPServer testHost testPort testKeyHash
 
-testSMPServer2 :: SMPServer
-testSMPServer2 = "smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@127.0.0.1:5002"
+testSMPServer2 :: HasTestEnv => SMPServer
+testSMPServer2 = SMPServer testHost2 testPort2 testKeyHash
 
-testNtfServer :: NtfServer
-testNtfServer = "ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"
+testNtfServer :: HasTestEnv => NtfServer
+testNtfServer = NtfServer testHost ntfTestPort testKeyHash
 
-testNtfServer2 :: NtfServer
-testNtfServer2 = "ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6002"
+testNtfServer2 :: HasTestEnv => NtfServer
+testNtfServer2 = NtfServer testHost ntfTestPort2 testKeyHash
 
-initAgentServers :: InitialAgentServers
+initAgentServers :: HasTestEnv => InitialAgentServers
 initAgentServers =
   InitialAgentServers
     { smp = userServers [testSMPServer],
       ntf = [testNtfServer],
       xftp = userServers [testXFTPServer],
       entitlements = M.empty,
-      netCfg = defaultNetworkConfig {tcpTimeout = NetworkTimeout 500000 500000, tcpConnectTimeout = NetworkTimeout 500000 500000},
+      netCfg = defaultNetworkConfig {tcpTimeout = NetworkTimeout 2000000 2000000, tcpConnectTimeout = NetworkTimeout 2000000 2000000},
       useServices = M.empty,
       presetDomains = [],
       presetServers = []
     }
 
-initAgentServers2 :: InitialAgentServers
+initAgentServers2 :: HasTestEnv => InitialAgentServers
 initAgentServers2 = initAgentServers {smp = userServers [testSMPServer, testSMPServer2]}
 
-initAgentServersProxy :: InitialAgentServers
+initAgentServersProxy :: HasTestEnv => InitialAgentServers
 initAgentServersProxy = initAgentServersProxy_ SPMAlways SPFProhibit
 
-initAgentServersProxy_ :: SMPProxyMode -> SMPProxyFallback -> InitialAgentServers
+initAgentServersProxy_ :: HasTestEnv => SMPProxyMode -> SMPProxyFallback -> InitialAgentServers
 initAgentServersProxy_ smpProxyMode smpProxyFallback =
   initAgentServers {netCfg = (netCfg initAgentServers) {smpProxyMode, smpProxyFallback}}
 
-initAgentServersProxy2 :: InitialAgentServers
+initAgentServersProxy2 :: HasTestEnv => InitialAgentServers
 initAgentServersProxy2 = initAgentServersProxy {smp = userServers [testSMPServer2]}
 
-initAgentServersClientService :: InitialAgentServers
+initAgentServersClientService :: HasTestEnv => InitialAgentServers
 initAgentServersClientService = initAgentServers {useServices = M.fromList [(1, True)]}
 
-agentCfg :: AgentConfig
+agentCfg :: HasTestEnv => AgentConfig
 agentCfg =
   defaultAgentConfig
     { tcpPort = Nothing,
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index dd84bd6e9..90eb7ee91 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -45,7 +45,7 @@ import System.Info (os)
 import Test.Hspec hiding (fit, it)
 import UnliftIO.Concurrent
 import qualified UnliftIO.Exception as E
-import UnliftIO.STM (TMVar, atomically, newEmptyTMVarIO, putTMVar, takeTMVar)
+import UnliftIO.STM (TMVar, atomically, checkSTM, newEmptyTMVarIO, orElse, putTMVar, readTMVar, readTVar, registerDelay, takeTMVar)
 import UnliftIO.Timeout (timeout)
 import Util
 
@@ -72,29 +72,29 @@ testHost = "localhost"
 testHost2 :: NonEmpty TransportHost
 testHost2 = "127.0.0.1"
 
-testPort :: ServiceName
-testPort = "5001"
+testPort :: HasTestEnv => ServiceName
+testPort = testServerPort 1
 
-testPort2 :: ServiceName
-testPort2 = "5002"
+testPort2 :: HasTestEnv => ServiceName
+testPort2 = testServerPort 2
 
-ntfTestPort :: ServiceName
-ntfTestPort = "6001"
+ntfTestPort :: HasTestEnv => ServiceName
+ntfTestPort = testServerPort 3
 
-ntfTestPort2 :: ServiceName
-ntfTestPort2 = "6002"
+ntfTestPort2 :: HasTestEnv => ServiceName
+ntfTestPort2 = testServerPort 4
 
 testKeyHash :: C.KeyHash
 testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
 
-testStoreLogFile :: FilePath
-testStoreLogFile = "tests/tmp/smp-server-store.log"
+testStoreLogFile :: HasTestEnv => FilePath
+testStoreLogFile = testPath "smp-server-store.log"
 
-testStoreLogFile2 :: FilePath
-testStoreLogFile2 = "tests/tmp/smp-server-store.log.2"
+testStoreLogFile2 :: HasTestEnv => FilePath
+testStoreLogFile2 = testPath "smp-server-store.log.2"
 
-testStoreDBOpts :: DBOpts
-testStoreDBOpts =
+testServerDBOpts :: DBOpts
+testServerDBOpts =
   DBOpts
     { connstr = testServerDBConnstr,
       schema = "smp_server",
@@ -102,8 +102,11 @@ testStoreDBOpts =
       createSchema = True
     }
 
-testStoreDBOpts2 :: DBOpts
-testStoreDBOpts2 = testStoreDBOpts {schema = "smp_server2"}
+testStoreDBOpts :: HasTestEnv => DBOpts
+testStoreDBOpts = testServerDBOpts {schema = testSchemaName "smp_server"}
+
+testStoreDBOpts2 :: HasTestEnv => DBOpts
+testStoreDBOpts2 = testStoreDBOpts {schema = testSchemaName "smp_server2"}
 
 testServerDBConnstr :: ByteString
 testServerDBConnstr = "postgresql://test_server_user@/test_server_db"
@@ -117,48 +120,48 @@ testServerDBConnectInfo =
   }
 #endif
 
-testStoreMsgsFile :: FilePath
-testStoreMsgsFile = "tests/tmp/smp-server-messages.log"
+testStoreMsgsFile :: HasTestEnv => FilePath
+testStoreMsgsFile = testPath "smp-server-messages.log"
 
-testStoreMsgsFile2 :: FilePath
-testStoreMsgsFile2 = "tests/tmp/smp-server-messages.log.2"
+testStoreMsgsFile2 :: HasTestEnv => FilePath
+testStoreMsgsFile2 = testPath "smp-server-messages.log.2"
 
-testStoreMsgsDir :: FilePath
-testStoreMsgsDir = "tests/tmp/messages"
+testStoreMsgsDir :: HasTestEnv => FilePath
+testStoreMsgsDir = testPath "messages"
 
-testStoreMsgsDir2 :: FilePath
-testStoreMsgsDir2 = "tests/tmp/messages.2"
+testStoreMsgsDir2 :: HasTestEnv => FilePath
+testStoreMsgsDir2 = testPath "messages.2"
 
-testStoreNtfsFile :: FilePath
-testStoreNtfsFile = "tests/tmp/smp-server-ntfs.log"
+testStoreNtfsFile :: HasTestEnv => FilePath
+testStoreNtfsFile = testPath "smp-server-ntfs.log"
 
-testStoreNtfsFile2 :: FilePath
-testStoreNtfsFile2 = "tests/tmp/smp-server-ntfs.log.2"
+testStoreNtfsFile2 :: HasTestEnv => FilePath
+testStoreNtfsFile2 = testPath "smp-server-ntfs.log.2"
 
-testPrometheusMetricsFile :: FilePath
-testPrometheusMetricsFile = "tests/tmp/smp-server-metrics.txt"
+testPrometheusMetricsFile :: HasTestEnv => FilePath
+testPrometheusMetricsFile = testPath "smp-server-metrics.txt"
 
-testServerStatsBackupFile :: FilePath
-testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
+testServerStatsBackupFile :: HasTestEnv => FilePath
+testServerStatsBackupFile = testPath "smp-server-stats.log"
 
-xit' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
-xit' d = if os == "linux" then skip "skipped on Linux" . it d else it d
+xit' :: (HasCallStack, Example a) => String -> (HasTestEnv => a) -> SpecWith (Arg a)
+xit' d t = if os == "linux" then skip "skipped on Linux" $ it d t else it d t
 
-xit'' :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
-xit'' d = skipOnCI . it d
+xit'' :: (HasCallStack, Example a) => String -> (HasTestEnv => a) -> SpecWith (Arg a)
+xit'' d t = skipOnCI $ it d t
 
 skipOnCI :: SpecWith a -> SpecWith a
 skipOnCI t = ifM (runIO envCI) (skip "skipped on CI" t) t
 
-testSMPClient :: Transport c => (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClient :: (HasTestEnv, Transport c) => (THandleSMP c 'TClient -> IO a) -> IO a
 testSMPClient = testSMPClientVR supportedClientSMPRelayVRange
 
-testSMPClientVR :: Transport c => VersionRangeSMP -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPClientVR :: (HasTestEnv, Transport c) => VersionRangeSMP -> (THandleSMP c 'TClient -> IO a) -> IO a
 testSMPClientVR vr client = do
   Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
   testSMPClient_ useHost testPort vr Nothing client
 
-testSMPServiceClient :: Transport c => (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
+testSMPServiceClient :: (HasTestEnv, Transport c) => (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
 testSMPServiceClient serviceCreds client = do
   Right useHost <- pure $ chooseTransportHost defaultNetworkConfig testHost
   testSMPClient_ useHost testPort supportedClientSMPRelayVRange (Just serviceCreds) client
@@ -181,13 +184,13 @@ testSMPClient_ host port vr serviceCreds_ client = do
   where
     clientALPN = Just alpnSupportedSMPHandshakes
 
-runSMPClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> IO a
+runSMPClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> IO a
 runSMPClient _ test' = testSMPClient test'
 
-runSMPServiceClient :: Transport c => TProxy c 'TServer -> (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
+runSMPServiceClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (TLS.Credential, C.KeyPairEd25519) -> (THandleSMP c 'TClient -> IO a) -> IO a
 runSMPServiceClient _ serviceCreds test' = testSMPServiceClient serviceCreds test'
 
-testNtfServiceClient :: Transport c => TProxy c 'TServer -> C.KeyPairEd25519 -> (THandleSMP c 'TClient -> IO a) -> IO a
+testNtfServiceClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> C.KeyPairEd25519 -> (THandleSMP c 'TClient -> IO a) -> IO a
 testNtfServiceClient _ keys client = do
   tlsNtfServerCreds <- loadServerCredential ntfTestServerCredentials
   serviceCertHash <- loadFingerprint ntfTestServerCredentials
@@ -211,13 +214,13 @@ ntfTestServerCredentials =
       certificateFile = "tests/fixtures/server.crt"
     }
 
-cfg :: AServerConfig
+cfg :: HasTestEnv => AServerConfig
 cfg = cfgMS (ASType SQSMemory SMSJournal)
 
-cfgJ2 :: AServerConfig
+cfgJ2 :: HasTestEnv => AServerConfig
 cfgJ2 = journalCfg cfg testStoreLogFile2 testStoreMsgsDir2
 
-cfgJ2QS :: SQSType s -> AServerConfig
+cfgJ2QS :: HasTestEnv => SQSType s -> AServerConfig
 cfgJ2QS = \case
   SQSMemory -> journalCfg (cfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
   SQSPostgres -> journalCfgDB (cfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2
@@ -231,7 +234,7 @@ journalCfgDB (ASrvCfg _ _ cfg') dbOpts storeMsgsPath' =
   let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCYesUp, deletedTTL = 86400}
    in ASrvCfg SQSPostgres SMSJournal cfg' {serverStoreCfg = SSCDatabaseJournal {storeCfg, storeMsgsPath'}}
 
-cfgMS :: AStoreType -> AServerConfig
+cfgMS :: HasTestEnv => AStoreType -> AServerConfig
 cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
   ServerConfig
     { transports = [],
@@ -257,7 +260,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
-      serverStatsLogFile = "tests/tmp/smp-server-stats.daily.log",
+      serverStatsLogFile = testPath "smp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       prometheusInterval = Nothing,
       prometheusMetricsFile = testPrometheusMetricsFile,
@@ -290,10 +293,10 @@ withStoreCfg (ASSCfg qt mt storeCfg) f = ASrvCfg qt mt (f storeCfg)
 defaultStartOptions :: StartOptions
 defaultStartOptions = StartOptions {maintenance = False, compactLog = False, logLevel = testLogLevel, skipWarnings = False, confirmMigrations = MCYesUp}
 
-testServerStoreConfig :: AStoreType -> AServerStoreCfg
+testServerStoreConfig :: HasTestEnv => AStoreType -> AServerStoreCfg
 testServerStoreConfig = serverStoreConfig_ False
 
-serverStoreConfig_ :: Bool -> AStoreType -> AServerStoreCfg
+serverStoreConfig_ :: HasTestEnv => Bool -> AStoreType -> AServerStoreCfg
 serverStoreConfig_ useDbStoreLog = \case
   ASType SQSMemory SMSMemory ->
     ASSCfg SQSMemory SMSMemory $ SSCMemory $ Just StorePaths {storeLogFile = testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
@@ -309,7 +312,7 @@ serverStoreConfig_ useDbStoreLog = \case
     dbStoreLogPath = if useDbStoreLog then Just testStoreLogFile else Nothing
     storeCfg = PostgresStoreCfg {dbOpts = testStoreDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = 86400}
 
-cfgVPrev :: AStoreType -> AServerConfig
+cfgVPrev :: HasTestEnv => AStoreType -> AServerConfig
 cfgVPrev msType = updateCfg (cfgMS msType) $ \cfg' -> cfg' {smpServerVRange = prevRange $ smpServerVRange cfg'}
 
 prevRange :: VersionRange v -> VersionRange v
@@ -321,10 +324,10 @@ prevVersion (Version v) = Version (v - 1)
 nextVersion :: Version v -> Version v
 nextVersion (Version v) = Version (v + 1)
 
-proxyCfg :: AServerConfig
+proxyCfg :: HasTestEnv => AServerConfig
 proxyCfg = proxyCfgMS (ASType SQSMemory SMSJournal)
 
-proxyCfgMS :: AStoreType -> AServerConfig
+proxyCfgMS :: HasTestEnv => AStoreType -> AServerConfig
 proxyCfgMS msType =
   updateCfg (cfgMS msType) $ \cfg' ->
     let smpAgentCfg' = smpAgentCfg cfg'
@@ -333,17 +336,17 @@ proxyCfgMS msType =
             smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, proxyServer = True, serverVRange = supportedProxyClientSMPRelayVRange}}
           }
 
-proxyCfgJ2 :: AServerConfig
+proxyCfgJ2 :: HasTestEnv => AServerConfig
 proxyCfgJ2 = journalCfg proxyCfg testStoreLogFile2 testStoreMsgsDir2
 
-proxyCfgJ2QS :: SQSType qs -> AServerConfig
+proxyCfgJ2QS :: HasTestEnv => SQSType qs -> AServerConfig
 proxyCfgJ2QS = \case
   SQSMemory -> journalCfg (proxyCfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
   SQSPostgres -> journalCfgDB (proxyCfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2
 
 -- Proxy config with a short relay-connection timeout, to bound how long a failing
 -- proxy->relay connection attempt blocks in the relay reconnection tests.
-proxyCfgShortTimeout :: AServerConfig
+proxyCfgShortTimeout :: HasTestEnv => AServerConfig
 proxyCfgShortTimeout =
   updateCfg proxyCfg $ \cfg' ->
     let aCfg = smpAgentCfg cfg'
@@ -351,7 +354,7 @@ proxyCfgShortTimeout =
         nt = NetworkTimeout {backgroundTimeout = 4_000000, interactiveTimeout = 4_000000}
      in cfg' {smpAgentCfg = aCfg {smpCfg = cCfg {networkConfig = (networkConfig cCfg) {tcpConnectTimeout = nt}}}}
 
-proxyCfgVPrev :: AStoreType -> AServerConfig
+proxyCfgVPrev :: HasTestEnv => AStoreType -> AServerConfig
 proxyCfgVPrev msType =
   updateCfg (proxyCfgMS msType) $ \cfg' ->
     let aCfg = smpAgentCfg cfg'
@@ -361,11 +364,11 @@ proxyCfgVPrev msType =
             smpAgentCfg = aCfg {smpCfg = cCfg {serverVRange = prevRange $ serverVRange cCfg}}
           }
 
-withSmpServerStoreMsgLogOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withSmpServerStoreMsgLogOn :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreMsgLogOn (t, msType) =
   withSmpServerConfigOn t $ updateCfg (cfgMS msType) $ \cfg' -> cfg' {storeNtfsFile = Just testStoreNtfsFile, serverStatsBackupFile = Just testServerStatsBackupFile}
 
-withSmpServerStoreLogOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withSmpServerStoreLogOn :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerStoreLogOn (t, msType) =
   withSmpServerConfigOn t $ updateCfg (cfgMS msType) $ \cfg' -> cfg' {serverStatsBackupFile = Just testServerStatsBackupFile}
 
@@ -381,26 +384,32 @@ withSmpServerConfigOn t (ASrvCfg _ _ cfg') port' =
     (\started -> runSMPServerBlocking started cfg' {transports = [(port', t, False)]} Nothing)
     (threadDelay 10000)
 
-withSmpServerThreadOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
+withSmpServerThreadOn :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> ServiceName -> (HasCallStack => ThreadId -> IO a) -> IO a
 withSmpServerThreadOn (t, msType) = withSmpServerConfigOn t (cfgMS msType)
 
 serverBracket :: HasCallStack => (TMVar Bool -> IO ()) -> IO () -> (HasCallStack => ThreadId -> IO a) -> IO a
 serverBracket process afterProcess f = do
   started <- newEmptyTMVarIO
+  startError <- newEmptyTMVarIO
+  stopped <- newEmptyTMVarIO
   E.bracket
-    (forkIOWithUnmask (\unmask -> unmask (process started) `E.catchAny` handleStartError started))
-    (\t -> killThread t >> afterProcess >> waitFor started "stop")
-    (\t -> waitFor started "start" >> f t >>= \r -> r <$ threadDelay 100000)
+    (forkIOWithUnmask (\unmask -> (unmask (process started) `E.catchAny` handleStartError started startError) `E.finally` atomically (putTMVar stopped ())))
+    (\t -> forkIO (killThread t) >> afterProcess >> waitStopped stopped)
+    (\t -> checkStarted started startError >> f t >>= \r -> r <$ threadDelay 100000)
   where
-    -- it putTMVar is called twise to unlock both parts of the bracket in case of start failure
-    handleStartError started e = do
-      atomically $ putTMVar started False
+    handleStartError started startError e = do
+      atomically $ putTMVar startError e
       atomically $ putTMVar started False
       E.throwIO e
-    waitFor started s =
+    checkStarted started startError =
       5_000_000 `timeout` atomically (takeTMVar started) >>= \case
-        Nothing -> error $ "server did not " <> s
-        _ -> pure ()
+        Nothing -> error "server did not start"
+        Just True -> pure ()
+        Just False -> atomically (readTMVar startError) >>= \e -> error $ "server did not start: " <> show e
+    waitStopped stopped = do
+      delay <- registerDelay 30_000_000
+      ok <- atomically $ (True <$ takeTMVar stopped) `orElse` (False <$ (readTVar delay >>= checkSTM))
+      unless ok $ error "server did not stop"
 
 -- A TCP server that accepts connections but never performs a TLS handshake, so a client
 -- connecting to it stays blocked in the TLS handshake until its connection timeout.
@@ -411,28 +420,28 @@ withStallingServerOn port action =
     (pure ())
     (const action)
 
-withSmpServerOn :: HasCallStack => (ASrvTransport, AStoreType) -> ServiceName -> IO a -> IO a
+withSmpServerOn :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> ServiceName -> IO a -> IO a
 withSmpServerOn ps port' = withSmpServerThreadOn ps port' . const
 
-withSmpServer :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
+withSmpServer :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
 withSmpServer ps = withSmpServerOn ps testPort
 
-withSmpServerProxy :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
+withSmpServerProxy :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
 withSmpServerProxy (t, msType) = withSmpServerConfigOn t (proxyCfgMS msType) testPort . const
 
-withSmpServers2 :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
+withSmpServers2 :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
 withSmpServers2 ps@(t, ASType qs _ms) = withSmpServer ps . withSmpServerConfigOn t (cfgJ2QS qs) testPort2 . const
 
-withSmpServersProxy2 :: HasCallStack => (ASrvTransport, AStoreType) -> IO a -> IO a
+withSmpServersProxy2 :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
 withSmpServersProxy2 ps@(t, ASType qs _ms) = withSmpServerProxy ps . withSmpServerConfigOn t (proxyCfgJ2QS qs) testPort2 . const
 
-runSmpTest :: forall c a. (HasCallStack, Transport c) => AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO a) -> IO a
+runSmpTest :: forall c a. (HasCallStack, HasTestEnv, Transport c) => AStoreType -> (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) => AStoreType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
+runSmpTestN :: forall c a. (HasCallStack, HasTestEnv, Transport c) => AStoreType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
 runSmpTestN msType = runSmpTestNCfg (cfgMS msType) supportedClientSMPRelayVRange
 
-runSmpTestNCfg :: forall c a. (HasCallStack, Transport c) => AServerConfig -> VersionRangeSMP -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
+runSmpTestNCfg :: forall c a. (HasCallStack, HasTestEnv, Transport c) => AServerConfig -> VersionRangeSMP -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO a) -> IO a
 runSmpTestNCfg srvCfg clntVR nClients test = withSmpServerConfigOn (transport @c) srvCfg testPort $ \_ -> run nClients []
   where
     run :: Int -> [THandleSMP c 'TClient] -> IO a
@@ -441,7 +450,7 @@ runSmpTestNCfg srvCfg clntVR nClients test = withSmpServerConfigOn (transport @c
 
 smpServerTest ::
   forall c smp.
-  (Transport c, Encoding smp) =>
+  (HasTestEnv, Transport c, Encoding smp) =>
   TProxy c 'TServer ->
   (Maybe TAuthorizations, ByteString, ByteString, smp) ->
   IO (Maybe TAuthorizations, ByteString, ByteString, BrokerMsg)
@@ -456,30 +465,30 @@ smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >
       [(CorrId corrId, EntityId qId, Right cmd)] <- tGetClient h
       pure (Nothing, corrId, qId, cmd)
 
-smpTest :: (HasCallStack, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest :: (HasCallStack, HasTestEnv, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest _ msType test' = runSmpTest msType test' `shouldReturn` ()
 
-smpTestN :: (HasCallStack, Transport c) => AStoreType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO ()) -> Expectation
+smpTestN :: (HasCallStack, HasTestEnv, Transport c) => AStoreType -> Int -> (HasCallStack => [THandleSMP c 'TClient] -> IO ()) -> Expectation
 smpTestN msType n test' = runSmpTestN msType n test' `shouldReturn` ()
 
-smpTest2 :: forall c. (HasCallStack, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest2 :: forall c. (HasCallStack, HasTestEnv, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest2 t msType = smpTest2Cfg (cfgMS msType) supportedClientSMPRelayVRange t
 
-smpTest2Cfg :: forall c. (HasCallStack, Transport c) => AServerConfig -> VersionRangeSMP -> TProxy c 'TServer -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest2Cfg :: forall c. (HasCallStack, HasTestEnv, Transport c) => AServerConfig -> VersionRangeSMP -> TProxy c 'TServer -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
 smpTest2Cfg srvCfg clntVR _ test' = runSmpTestNCfg srvCfg clntVR 2 _test `shouldReturn` ()
   where
     _test :: HasCallStack => [THandleSMP c 'TClient] -> IO ()
     _test [h1, h2] = test' h1 h2
     _test _ = error "expected 2 handles"
 
-smpTest3 :: forall c. (HasCallStack, Transport c) => TProxy c 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest3 :: forall c. (HasCallStack, HasTestEnv, Transport c) => TProxy c 'TServer -> AStoreType -> (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 'TServer -> AStoreType -> (HasCallStack => THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO ()) -> Expectation
+smpTest4 :: forall c. (HasCallStack, HasTestEnv, Transport c) => TProxy c 'TServer -> AStoreType -> (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 ()
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index 62bb4a85e..d47d1a29d 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -45,13 +45,9 @@ import Simplex.Messaging.Util (bshow, tshow)
 import Simplex.Messaging.Version (mkVersionRange)
 import System.FilePath (splitExtensions)
 import System.Random (randomRIO)
-import Test.Hspec hiding (fit, it)
+import Test.Hspec hiding (fit, it, xit)
 import UnliftIO
 import Util
-#if defined(dbPostgres)
-import Fixtures
-import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
-#endif
 
 smpProxyTests :: SpecWith AStoreType
 smpProxyTests = do
@@ -80,73 +76,71 @@ smpProxyTests = do
     it "relay delays AUTH errors to forwarded commands" $ \_ ->
       testForwardedAuthErrorDelay
   describe "deliver message via SMP proxy" $ do
-    let srv1 = SMPServer testHost testPort testKeyHash
+    let srv1, srv2 :: HasTestEnv => SMPServer
+        srv1 = SMPServer testHost testPort testKeyHash
         srv2 = SMPServer testHost2 testPort2 testKeyHash
     describe "client API" $ do
       let maxLen = maxMessageLength
       describe "one server" $ do
-        it "deliver via proxy" . oneServer $ do
+        it "deliver via proxy" $ oneServer $ do
           deliverMessageViaProxy srv1 srv1 C.SEd448 "hello 1" "hello 2"
       describe "two servers" $ do
-        let proxyServ = srv1
+        let proxyServ, relayServ :: HasTestEnv => SMPServer
+            proxyServ = srv1
             relayServ = srv2
         (msg1, msg2) <- runIO $ do
           g <- C.newRandom
           atomically $ (,) <$> C.randomBytes maxLen g <*> C.randomBytes maxLen g
-        it "deliver via proxy" . twoServersFirstProxy $
+        it "deliver via proxy" $ twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SEd448 "hello 1" "hello 2"
-        it "max message size, Ed448 keys" . twoServersFirstProxy $
+        it "max message size, Ed448 keys" $ twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SEd448 msg1 msg2
-        it "max message size, Ed25519 keys" . twoServersFirstProxy $
+        it "max message size, Ed25519 keys" $ twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SEd25519 msg1 msg2
-        it "max message size, X25519 keys" . twoServersFirstProxy $
+        it "max message size, X25519 keys" $ twoServersFirstProxy $
           deliverMessageViaProxy proxyServ relayServ C.SX25519 msg1 msg2
       describe "version compatibility" $ do
         let deliver clientVR = deliverMessagesViaProxyVR clientVR srv1 srv2 C.SEd448 ["hello 1"] ["hello 2"]
-        it "prev client" . twoServersFirstProxy $ deliver (prevRange supportedClientSMPRelayVRange)
-        it "prev proxy" . twoServersPrevProxy $ deliver supportedClientSMPRelayVRange
-        it "prev relay" . twoServersPrevRelay $ deliver supportedClientSMPRelayVRange
+        it "prev client" $ twoServersFirstProxy $ deliver (prevRange supportedClientSMPRelayVRange)
+        it "prev proxy" $ twoServersPrevProxy $ deliver supportedClientSMPRelayVRange
+        it "prev relay" $ twoServersPrevRelay $ deliver supportedClientSMPRelayVRange
       describe "stress test 1k" $ do
         let deliver n = deliverMessagesViaProxy srv1 srv2 C.SEd448 [] (map bshow [1 :: Int .. n])
-        it "1x1000" . twoServersFirstProxy $ deliver 1000
-        it "5x200" . twoServersFirstProxy $ 5 `inParrallel` deliver 200
-        it "10x100" . twoServersFirstProxy $ 10 `inParrallel` deliver 100
+        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)
+        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
-        it "5x2000" . twoServersFirstProxy $ 5 `inParrallel` deliver 2000
-        it "10x1000" . twoServersFirstProxy $ 10 `inParrallel` deliver 1000
-        it "100x100 N1" . twoServersFirstProxy $ withNumCapabilities 1 $ 100 `inParrallel` deliver 100
-        it "100x100 N4 C1" . twoServersNoConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
-        it "100x100 N4 C2" . twoServersFirstProxy $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
-        it "100x100 N4 C16" . twoServersMoreConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
-        it "100x100 N" . twoServersFirstProxy $ withNCPUCapabilities $ 100 `inParrallel` deliver 100
-        it "500x20" . twoServersFirstProxy $ 500 `inParrallel` deliver 20
-#if defined(dbPostgres)
-    after_ (dropAllSchemasExceptSystem testDBConnectInfo) . describe "agent API" $ do
-#else
+        it "1x10000" $ twoServersFirstProxy $ deliver 10000
+        it "5x2000" $ twoServersFirstProxy $ 5 `inParrallel` deliver 2000
+        it "10x1000" $ twoServersFirstProxy $ 10 `inParrallel` deliver 1000
+        it "100x100 N1" $ twoServersFirstProxy $ withNumCapabilities 1 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C1" $ twoServersNoConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C2" $ twoServersFirstProxy $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N4 C16" $ twoServersMoreConc $ withNumCapabilities 4 $ 100 `inParrallel` deliver 100
+        it "100x100 N" $ twoServersFirstProxy $ withNCPUCapabilities $ 100 `inParrallel` deliver 100
+        it "500x20" $ twoServersFirstProxy $ 500 `inParrallel` deliver 20
     describe "agent API" $ do
-#endif
       describe "one server" $ do
-        it "always via proxy" . oneServer $
+        it "always via proxy" $ oneServer $
           agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv1], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1
-        it "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
         it "always via proxy" $ \msType -> twoServers
           (agentDeliverMessageViaProxy ([srv1], SPMAlways, True) ([srv2], SPMAlways, True) C.SEd448 "hello 1" "hello 2" 1)
           msType
-        it "both via proxy" . twoServers $
+        it "both via proxy" $ twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMUnknown, True) C.SEd448 "hello 1" "hello 2" 1
-        it "first via proxy" . twoServers $
+        it "first via proxy" $ twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMUnknown, True) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        it "without proxy" . twoServers $
+        it "without proxy" $ twoServers $
           agentDeliverMessageViaProxy ([srv1], SPMNever, False) ([srv2], SPMNever, False) C.SEd448 "hello 1" "hello 2" 1
-        it "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 "retries sending when destination or proxy relay is offline" $ \_ ->
           agentViaProxyRetryOffline
@@ -154,14 +148,11 @@ smpProxyTests = do
           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
-        it "5 agents, 10 pairs, 50 messages, N1" . oneServer . withNumCapabilities 1 $ deliver 5 50
-        it "5 agents, 10 pairs, 50 messages. N4" . oneServer . withNumCapabilities 4 $ deliver 5 50
+        it "2 agents, 250 messages" $ oneServer $ deliver 2 250
       xdescribe "stress test 10k" $ 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
+        it "25 agents, 300 pairs, 17 messages" $ oneServer $ withNumCapabilities 4 $ deliver 25 17
   where
-    oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) testPort $ const test
     twoServers test msType = twoServers_ (proxyCfgMS msType) (proxyCfgMS msType) test msType
     twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
     twoServersMoreConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 128}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
@@ -169,7 +160,7 @@ smpProxyTests = do
     twoServersPrevProxy test msType = twoServers_ (proxyCfgVPrev msType) (cfgMS msType) test msType
     twoServersPrevRelay test msType = twoServers_ (proxyCfgMS msType) (prevServerVRange $ cfgMS msType) test msType
     prevServerVRange cfg' = updateCfg cfg' $ \cfg_ -> cfg_ {smpServerVRange = prevRange $ smpServerVRange cfg_}
-    twoServers_ :: AServerConfig -> AServerConfig -> IO () -> AStoreType -> IO ()
+    twoServers_ :: HasTestEnv => AServerConfig -> AServerConfig -> IO () -> AStoreType -> IO ()
     twoServers_ cfg1 cfg2 runTest (ASType qsType _) =
       withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ ->
         let cfg2' = case qsType of
@@ -177,6 +168,15 @@ smpProxyTests = do
               SQSPostgres -> journalCfgDB cfg2 testStoreDBOpts2 testStoreMsgsDir2
          in withSmpServerConfigOn (transport @TLS) cfg2' testPort2 $ const runTest
 
+smpProxyCapabilityTests :: SpecWith AStoreType
+smpProxyCapabilityTests = do
+  let deliver nAgents nMsgs = agentDeliverMessagesViaProxyConc (replicate nAgents [testSMPServer]) (map bshow [1 :: Int .. nMsgs])
+  it "5 agents, 10 pairs, 50 messages, N1" $ oneServer $ withNumCapabilities 1 $ deliver 5 50
+  it "5 agents, 10 pairs, 50 messages. N4" $ oneServer $ withNumCapabilities 4 $ deliver 5 50
+
+oneServer :: HasTestEnv => IO a -> AStoreType -> IO a
+oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) testPort $ const test
+
 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']
 
@@ -243,7 +243,7 @@ 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 -> AgentMsgId -> IO ()
+agentDeliverMessageViaProxy :: (HasTestEnv, 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
@@ -282,7 +282,7 @@ agentDeliverMessageViaProxy aTestCfg@(aSrvs, _, aViaProxy) bTestCfg@(bSrvs, _, b
     aCfg = agentCfg {sndAuthAlg = C.AuthAlg alg, rcvAuthAlg = C.AuthAlg alg}
     servers (srvs, smpProxyMode, _) = (initAgentServersProxy_ smpProxyMode SPFAllow) {smp = userServers srvs}
 
-agentDeliverMessagesViaProxyConc :: [NonEmpty SMPServer] -> [MsgBody] -> IO ()
+agentDeliverMessagesViaProxyConc :: HasTestEnv => [NonEmpty SMPServer] -> [MsgBody] -> IO ()
 agentDeliverMessagesViaProxyConc agentServers msgs =
   withAgents $ \agents -> do
     let pairs = combinations 2 agents
@@ -349,7 +349,7 @@ agentDeliverMessagesViaProxyConc agentServers msgs =
     aCfg = agentCfg {sndAuthAlg = C.AuthAlg C.SEd448, rcvAuthAlg = C.AuthAlg C.SEd448}
     servers srvs = (initAgentServersProxy_ SPMAlways SPFAllow) {smp = userServers srvs}
 
-agentViaProxyRetryOffline :: IO ()
+agentViaProxyRetryOffline :: HasTestEnv => IO ()
 agentViaProxyRetryOffline = do
   let srv1 = SMPServer testHost testPort testKeyHash
       srv2 = SMPServer testHost testPort2 testKeyHash
@@ -422,7 +422,7 @@ agentViaProxyRetryOffline = do
     msgId = subtract baseId . fst
     servers srv = initAgentServersProxy {smp = userServers [srv]}
 
-agentViaProxyRetryNoSession :: IO ()
+agentViaProxyRetryNoSession :: HasTestEnv => IO ()
 agentViaProxyRetryNoSession = do
   let srv1 = SMPServer testHost testPort testKeyHash
       srv2 = SMPServer testHost testPort2 testKeyHash
@@ -442,14 +442,14 @@ agentViaProxyRetryNoSession = do
     withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2
     servers srv = initAgentServersProxy {smp = userServers [srv]}
 
-testNoProxy :: AStoreType -> IO ()
+testNoProxy :: HasTestEnv => AStoreType -> IO ()
 testNoProxy msType = do
   withSmpServerConfigOn (transport @TLS) (cfgMS msType) testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
       (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PRXY testSMPServer Nothing)
       reply `shouldBe` Right (SMP.ERR $ SMP.PROXY SMP.BASIC_AUTH)
 
-testProxyAuth :: AStoreType -> IO ()
+testProxyAuth :: HasTestEnv => AStoreType -> IO ()
 testProxyAuth msType = do
   withSmpServerConfigOn (transport @TLS) proxyCfgAuth testPort $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
@@ -460,12 +460,12 @@ testProxyAuth msType = do
 
 -- Connect a sender client to the proxy and request a relay session to testSMPServer2 (PRXY).
 -- On success the reply is PKEY; otherwise it is the proxy error for the relay connection.
-requestRelaySession :: IO (Either SMP.ErrorType SMP.BrokerMsg)
+requestRelaySession :: HasTestEnv => IO (Either SMP.ErrorType SMP.BrokerMsg)
 requestRelaySession =
   testSMPClient_ "localhost" testPort supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) ->
     (\(_, _, reply) -> reply) <$> sendRecv th (Nothing, "1", NoEntity, SMP.PRXY testSMPServer2 Nothing)
 
-testChangedFwdVersion :: IO ()
+testChangedFwdVersion :: HasTestEnv => IO ()
 testChangedFwdVersion =
   withSmpServerConfigOn (transport @TLS) cfg testPort $ \_ -> do
     g <- C.newRandom
@@ -480,7 +480,7 @@ testChangedFwdVersion =
     _ <- runExceptT' $ forward v
     runExceptT (forward $ prevVersion v) `shouldReturn` Left (PCEProtocolError SMP.CRYPTO)
 
-testFwdCorrIdSize :: IO ()
+testFwdCorrIdSize :: HasTestEnv => IO ()
 testFwdCorrIdSize =
   withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
     withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ ->
@@ -492,7 +492,7 @@ testFwdCorrIdSize =
           (_, _, reply) <- sendRecv th (Nothing, corrId, SMP.EntityId sessId, SMP.PFWD currentClientSMPRelayVersion cmdPubKey (SMP.EncTransmission ""))
           reply `shouldBe` Right (SMP.ERR $ SMP.CMD SMP.SYNTAX)
 
-testForwardedAuthErrorDelay :: IO ()
+testForwardedAuthErrorDelay :: HasTestEnv => IO ()
 testForwardedAuthErrorDelay =
   withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
     withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
@@ -508,7 +508,7 @@ testForwardedAuthErrorDelay =
 -- Shared "phase 2" of the reconnection tests: start a healthy relay, confirm it is reachable
 -- directly (PING, not via the proxy) so a proxy failure can only mean the proxy didn't reconnect,
 -- let any stored connection error expire, then require the proxy to establish the session (PKEY).
-requireProxyReconnect :: IO ()
+requireProxyReconnect :: HasTestEnv => IO ()
 requireProxyReconnect =
   withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
@@ -523,7 +523,7 @@ requireProxyReconnect =
 -- The connect fails by timing out (storing a Left error that self-heals via persistErrorInterval),
 -- so once a healthy relay is running the proxy reconnects. This proves the stalling relay alone
 -- does not cause the permanent failure - only the mid-connection disconnect does.
-testProxyRecoversWithoutDisconnect :: IO ()
+testProxyRecoversWithoutDisconnect :: HasTestEnv => IO ()
 testProxyRecoversWithoutDisconnect =
   withSmpServerConfigOn (transport @TLS) proxyCfgShortTimeout testPort $ \_ -> do
     withStallingServerOn testPort2 $
@@ -545,7 +545,7 @@ testProxyRecoversWithoutDisconnect =
 -- The stalling relay (accepts TCP, never completes TLS) holds the connect open long enough to
 -- interleave the disconnect. Phase 2 (requireProxyReconnect) is identical to the control above;
 -- the only difference is this disconnect.
-testProxyReconnectAfterRelayRestart :: IO ()
+testProxyReconnectAfterRelayRestart :: HasTestEnv => IO ()
 testProxyReconnectAfterRelayRestart =
   withSmpServerConfigOn (transport @TLS) proxyCfgShortTimeout testPort $ \_ -> do
     -- disconnect the sender 1s into the 4s connect to the stalling relay, killing the in-flight worker
@@ -559,7 +559,7 @@ testProxyReconnectAfterRelayRestart =
 -- skipped and the empty var is left in smpClients, so every later connection to that server times
 -- out on it. Phase 1 cancels a connect to a stalling relay; phase 2 requires a fresh connect to a
 -- healthy relay to succeed.
-testAgentClientReconnectAfterCancel :: IO ()
+testAgentClientReconnectAfterCancel :: HasTestEnv => IO ()
 testAgentClientReconnectAfterCancel =
   withAgent 1 agentCfg agentServersLeak testDB $ \a -> do
     withStallingServerOn testPort2 $ do
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index aff1fdbe0..89a2a00fa 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -61,7 +61,7 @@ import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecur
 import System.IO (IOMode (..), withFile)
 import System.Timeout
 import Test.HUnit
-import Test.Hspec hiding (fit, it)
+import Test.Hspec hiding (fit, it, xit)
 import Util
 
 #if defined(dbServerPostgres)
@@ -96,7 +96,6 @@ serverTests = do
   describe "Restore messages" testRestoreMessages
   describe "Restore messages (old / v2)" testRestoreExpireMessages
   describe "Save prometheus metrics" testPrometheusMetrics
-  describe "Timing of AUTH error" testTiming
   describe "Delay of AUTH error" testAuthErrorDelay
   describe "Message notifications" $ do
     testMessageNotifications
@@ -1035,15 +1034,15 @@ testWithStoreLog =
     logSize testStoreLogFile `shouldReturn` (if compacting then 1 else 6)
     removeFile testStoreLogFile
   where
-    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
+    runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
       killThread server
 
-    runClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
+    runClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
     runClient _ test' = testSMPClient test' `shouldReturn` ()
 
-serverStoreLogCfg :: AStoreType -> (AServerConfig, Bool)
+serverStoreLogCfg :: HasTestEnv => AStoreType -> (AServerConfig, Bool)
 serverStoreLogCfg msType =
   let cfg' =
         withServerCfg (cfgMS msType) $ \cfg_ ->
@@ -1142,12 +1141,12 @@ testRestoreMessages =
     whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
     removeFile testServerStatsBackupFile
   where
-    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
+    runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
       killThread server
 
-    runClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
+    runClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
     runClient _ test' = testSMPClient test' `shouldReturn` ()
 
 checkStats :: ServerStatsData -> [RecipientId] -> Int -> Int -> Expectation
@@ -1217,7 +1216,7 @@ testRestoreExpireMessages =
     Right ServerStatsData {_msgExpired} <- strDecode <$> B.readFile testServerStatsBackupFile
     _msgExpired `shouldBe` 2
   where
-    exportStoreMessages :: AStoreType -> IO ()
+    exportStoreMessages :: HasTestEnv => AStoreType -> IO ()
     exportStoreMessages = \case
       ASType _ SMSJournal -> export
       ASType _ SMSPostgres -> exportDB
@@ -1241,12 +1240,12 @@ testRestoreExpireMessages =
           readWriteQueueStore True (mkQueue ms True) testStoreLogFile (stmQueueStore ms) >>= closeStoreLog
           removeFileIfExists testStoreMsgsFile
           pure ms
-    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
+    runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
       killThread server
 
-    runClient :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
+    runClient :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> Expectation
     runClient _ test' = testSMPClient test' `shouldReturn` ()
 
 testPrometheusMetrics :: SpecWith (ASrvTransport, AStoreType)
@@ -1539,7 +1538,7 @@ testServiceNotificationsTwoRestarts =
         Resp "3.2" _ (SOK Nothing) <- signSendRecv rh rKey ("3.2", rId, SUB)
         deliverMessage rh rId rKey sh sId sKey nh "hello 3" dec
     where
-      runTest2 :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO a) -> ThreadId -> IO a
+      runTest2 :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> THandleSMP c 'TClient -> IO a) -> ThreadId -> IO a
       runTest2 _ test' server = do
         a <- testSMPClient $ \h1 -> testSMPClient $ \h2 -> test' h1 h2
         killThread server
@@ -1630,7 +1629,7 @@ testBlockMessageQueue =
       Resp "dabc" sId2 (ERR (BLOCKED (BlockingInfo BRContent Nothing))) <- signSendRecv h sKey ("dabc", sId, SKEY sPub)
       (sId2, sId) #== "same queue ID in response"
   where
-    runTest :: Transport c => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> ThreadId -> IO a
+    runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO a) -> ThreadId -> IO a
     runTest _ test' server = do
       a <- testSMPClient test'
       killThread server
@@ -1858,7 +1857,7 @@ serverSyntaxTests (ATransport t) = do
       it "no signature" $ ("", "cdab", "12345678", cmd) >#> ("", "cdab", "12345678", ERR $ CMD NO_AUTH)
       it "no queue ID" $ (sampleSig, "dabc", "", cmd) >#> ("", "dabc", "", ERR $ CMD NO_AUTH)
     (>#>) ::
-      Encoding smp =>
+      (HasTestEnv, Encoding smp) =>
       (Maybe TAuthorizations, ByteString, ByteString, smp) ->
       (Maybe TAuthorizations, ByteString, ByteString, BrokerMsg) ->
       Expectation
diff --git a/tests/Test.hs b/tests/Test.hs
index 16375bcc6..ccaf542f6 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -1,11 +1,10 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE TypeApplications #-}
 
 import AgentTests (agentCoreTests, agentTests)
+import AgentTests.FunctionalAPITests (functionalAPITimingTests)
 import CLITests
-import Control.Concurrent (threadDelay)
-import qualified Control.Exception as E
+import Control.Exception (bracket_)
 import Control.Logger.Simple
 import CoreTests.BatchingTests
 import CoreTests.CryptoFileTests
@@ -19,20 +18,19 @@ import CoreTests.TSessionSubs
 import CoreTests.UtilTests
 import CoreTests.VersionRangeTests
 import FileDescriptionTests (fileDescriptionTests)
-import GHC.IO.Exception (IOException (..))
-import qualified GHC.IO.Exception as IOException
 import RSLVTests (rslvTests)
 import RemoteControl (remoteControlTests)
 import SMPNamesTests (smpNamesTests)
-import SMPProxyTests (smpProxyTests)
+import SMPProxyTests (smpProxyCapabilityTests, smpProxyTests)
 import ServerTests
 import Simplex.Messaging.Server.Env.STM (AStoreType (..))
 import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
 import Simplex.Messaging.Transport (TLS, Transport (..))
 -- import Simplex.Messaging.Transport.WebSockets (WS)
-import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive)
-import System.Environment (setEnv)
+import System.Directory (createDirectory, removePathForcibly)
+import System.Environment (getArgs, setEnv, withArgs)
 import Test.Hspec hiding (fit, it)
+import Test.Hspec.Core.Runner (defaultConfig, evalSpec, evaluateResult, readConfig, runSpecForest)
 import Util
 import XFTPAgent
 import XFTPCLI (xftpCLIFileTests)
@@ -44,18 +42,18 @@ import XFTPWebTests (xftpWebTests)
 
 #if defined(dbPostgres)
 import Fixtures
-import SMPAgentClient (testDB)
 import Simplex.Messaging.Agent.Store.Postgres.Migrations.App
-import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
 #else
 import AgentTests.SchemaDump (schemaDumpTest)
+import System.Directory (listDirectory)
+import System.FilePath ((</>))
 #endif
 
 #if defined(dbServerPostgres)
 import CoreTests.XFTPStoreTests (xftpStoreTests, xftpMigrationTests)
 import NtfServerTests (ntfServerTests)
-import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts)
-import SMPClient (testServerDBConnectInfo, testStoreDBOpts)
+import NtfClient (ntfTestServerDBConnectInfo, ntfTestServerDBOpts)
+import SMPClient (testServerDBConnectInfo, testServerDBOpts)
 import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations)
 import Simplex.Messaging.Server.QueueStore.Postgres.Migrations (serverMigrations)
 import XFTPClient (testXFTPDBConnectInfo)
@@ -75,76 +73,54 @@ main = do
   withGlobalLogging logCfg $ do
     setEnv "APNS_KEY_ID" "H82WD9K9AQ"
     setEnv "APNS_KEY_FILE" "./tests/fixtures/AuthKey_H82WD9K9AQ.p8"
-    hspec
+    hspecInTmpDir
 #if defined(dbPostgres)
       . aroundAll_ (postgressBracket testDBConnectInfo)
 #endif
-      . before_ (createDirectoryIfMissing False "tests/tmp")
-      . after_ (eventuallyRemove "tests/tmp" 3)
-      $ do
-        describe "Core tests" $ do
-          describe "Batching tests" batchingTests
-          describe "Encoding tests" encodingTests
-          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
 #if defined(dbServerPostgres)
-          around_ (postgressBracket testServerDBConnectInfo) $
-            describe "Store log tests" storeLogTests
-#else
-          describe "Store log tests" storeLogTests
+      . aroundAll_ (postgressBracket testServerDBConnectInfo)
+      . aroundAll_ (postgressBracket ntfTestServerDBConnectInfo)
+      . aroundAll_ (postgressBracket testXFTPDBConnectInfo)
 #endif
-          describe "XFTP store log tests" fileStoreLogTests
-          fileExpirationTests
-          describe "TSessionSubs tests" tSessionSubsTests
-          describe "Util tests" utilTests
-          describe "Names resolver tests" smpNamesTests
-          describe "RSLV functional API tests" rslvTests
-          describe "Agent core tests" agentCoreTests
+      $ do
+        parallel $ do
+          describe "Core tests" $ do
+            describe "Batching tests" batchingTests
+            describe "Encoding tests" encodingTests
+            describe "Version range" versionRangeTests
+            describe "Encryption tests" cryptoTests
+            describe "Encrypted files tests" cryptoFileTests
+            describe "Message store tests" msgStoreTests
+            describe "SOCKS settings tests" socksSettingsTests
+            describe "Store log tests" storeLogTests
+            describe "XFTP store log tests" fileStoreLogTests
+            fileExpirationTests
+            describe "TSessionSubs tests" tSessionSubsTests
+            describe "Util tests" utilTests
+            describe "Names resolver tests" smpNamesTests
+            describe "RSLV functional API tests" rslvTests
+            describe "Agent core tests" agentCoreTests
 #if defined(dbServerPostgres)
-        around_ (postgressBracket testServerDBConnectInfo) $
-          describe "SMP server schema dump" $
-            postgresSchemaDumpTest
-              serverMigrations
-              [ "20250320_short_links", -- snd_secure moves to the bottom on down migration
-                "20260918_expire_messages" -- msg_queue_expire moves to the bottom on down migration
-              ] -- skipComparisonForDownMigrations
-              testStoreDBOpts
-              "src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql"
-        around_ (postgressBracket testServerDBConnectInfo) $ do
           -- xdescribe "SMP server via TLS, postgres+jornal message store" $
           --   before (pure (transport @TLS, ASType SQSPostgres SMSJournal)) serverTests
           describe "SMP server via TLS, postgres-only message store" $
             before (pure (transport @TLS, ASType SQSPostgres SMSPostgres)) serverTests
 #endif
-        describe "SMP server via TLS, jornal message store" $ do
-          describe "SMP syntax" $ serverSyntaxTests (transport @TLS)
-          before (pure (transport @TLS, ASType SQSMemory SMSJournal)) serverTests
-        describe "SMP server via TLS, memory message store" $
-          before (pure (transport @TLS, ASType SQSMemory SMSMemory)) serverTests
-        -- xdescribe "SMP server via WebSockets" $ do
-        --   describe "SMP syntax" $ serverSyntaxTests (transport @WS)
-        --   before (pure (transport @WS, ASType SQSMemory SMSJournal)) serverTests
+          describe "SMP server via TLS, jornal message store" $ do
+            describe "SMP syntax" $ serverSyntaxTests (transport @TLS)
+            before (pure (transport @TLS, ASType SQSMemory SMSJournal)) serverTests
+          describe "SMP server via TLS, memory message store" $
+            before (pure (transport @TLS, ASType SQSMemory SMSMemory)) serverTests
+          -- xdescribe "SMP server via WebSockets" $ do
+          --   describe "SMP syntax" $ serverSyntaxTests (transport @WS)
+          --   before (pure (transport @WS, ASType SQSMemory SMSJournal)) serverTests
 #if defined(dbServerPostgres)
-        around_ (postgressBracket ntfTestServerDBConnectInfo) $
-          describe "Ntf server schema dump" $
-            postgresSchemaDumpTest
-              ntfServerMigrations
-              [] -- skipComparisonForDownMigrations
-              ntfTestStoreDBOpts
-              "src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql"
-        around_ (postgressBracket ntfTestServerDBConnectInfo) $ do
           describe "Notifications server (SMP server: memory store)" $
             ntfServerTests (transport @TLS, ASType SQSMemory SMSMemory)
-          around_ (postgressBracket testServerDBConnectInfo) $ do
-            -- xdescribe "Notifications server (SMP server: postgres+jornal store)" $
-            --   ntfServerTests (transport @TLS, ASType SQSPostgres SMSJournal)
-            describe "Notifications server (SMP server: postgres-only store)" $
-              ntfServerTests (transport @TLS, ASType SQSPostgres SMSPostgres)
-        around_ (postgressBracket testServerDBConnectInfo) $ do
+          -- xdescribe "Notifications server (SMP server: postgres+jornal store)" $
+          --   ntfServerTests (transport @TLS, ASType SQSPostgres SMSJournal)
+          describe "Notifications server (SMP server: postgres-only store)" $
+            ntfServerTests (transport @TLS, ASType SQSPostgres SMSPostgres)
           -- xdescribe "SMP client agent, postgres+jornal message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSJournal)
           describe "SMP client agent, server postgres-only message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSPostgres)
           -- xdescribe "SMP proxy, postgres+jornal message store" $
@@ -152,55 +128,92 @@ main = do
           describe "SMP proxy, postgres-only message store" $
             before (pure $ ASType SQSPostgres SMSPostgres) smpProxyTests
 #endif
-        -- xdescribe "SMP client agent, server jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
-        describe "SMP client agent, server memory message store" $ agentTests (transport @TLS, ASType SQSMemory SMSMemory)
-        describe "SMP proxy, jornal message store" $
-          before (pure $ ASType SQSMemory SMSJournal) smpProxyTests
-        describe "XFTP" $ do
-          describe "XFTP server" $
-            before (pure $ AFSType SFSMemory) xftpServerTests
-          describe "XFTP file description" fileDescriptionTests
-          describe "XFTP CLI (memory)" $
-            before (pure $ AFSType SFSMemory) xftpCLIFileTests
-          describe "XFTP agent" $
-            before (pure $ AFSType SFSMemory) xftpAgentTests
+          -- xdescribe "SMP client agent, server jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
+          describe "SMP client agent, server memory message store" $ agentTests (transport @TLS, ASType SQSMemory SMSMemory)
+          describe "SMP proxy, jornal message store" $
+            before (pure $ ASType SQSMemory SMSJournal) smpProxyTests
+          describe "XFTP" $ do
+            describe "XFTP server" $
+              before (pure $ AFSType SFSMemory) xftpServerTests
+            describe "XFTP file description" fileDescriptionTests
+            describe "XFTP agent" $
+              before (pure $ AFSType SFSMemory) xftpAgentTests
 #if defined(dbServerPostgres)
-        around_ (postgressBracket testXFTPDBConnectInfo) $ do
           describe "XFTP Postgres store operations" xftpStoreTests
           describe "XFTP migration round-trip" xftpMigrationTests
           describe "XFTP server (PostgreSQL)" $
             before (pure $ AFSType SFSPostgres) xftpServerTests
           describe "XFTP agent (PostgreSQL)" $
             before (pure $ AFSType SFSPostgres) xftpAgentTests
+#endif
+          describe "XFTP Web Client" xftpWebTests
+          describe "XRCP" remoteControlTests
+          describe "Web" webTests
+        sequential $ do
+          describe "Core tests" $ describe "Retry interval tests" retryIntervalTests
+#if defined(dbServerPostgres)
+          describe "SMP server via TLS, postgres-only message store" $
+            before (pure (transport @TLS, ASType SQSPostgres SMSPostgres)) $ describe "Timing of AUTH error" testTiming
+#endif
+          describe "SMP server via TLS, jornal message store" $
+            before (pure (transport @TLS, ASType SQSMemory SMSJournal)) $ describe "Timing of AUTH error" testTiming
+          describe "SMP server via TLS, memory message store" $
+            before (pure (transport @TLS, ASType SQSMemory SMSMemory)) $ describe "Timing of AUTH error" testTiming
+#if defined(dbServerPostgres)
+          describe "SMP client agent, server postgres-only message store" $
+            describe "Functional API" $ functionalAPITimingTests (transport @TLS, ASType SQSPostgres SMSPostgres)
+#endif
+          describe "SMP client agent, server memory message store" $
+            describe "Functional API" $ functionalAPITimingTests (transport @TLS, ASType SQSMemory SMSMemory)
+#if defined(dbServerPostgres)
+          describe "SMP proxy capabilities, postgres-only message store" $
+            before (pure $ ASType SQSPostgres SMSPostgres) smpProxyCapabilityTests
+#endif
+          describe "SMP proxy capabilities, jornal message store" $
+            before (pure $ ASType SQSMemory SMSJournal) smpProxyCapabilityTests
+          describe "XFTP CLI (memory)" $
+            before (pure $ AFSType SFSMemory) xftpCLIFileTests
+#if defined(dbServerPostgres)
           describe "XFTP CLI (PostgreSQL)" $
             before (pure $ AFSType SFSPostgres) xftpCLIFileTests
 #endif
-#if defined(dbPostgres)
-        describe "XFTP Web Client" $ xftpWebTests (dropAllSchemasExceptSystem testDBConnectInfo)
-#else
-        describe "XFTP Web Client" $ xftpWebTests (pure ())
+          describe "Server CLIs" cliTests
+#if defined(dbServerPostgres)
+          around_ (postgressBracket testServerDBConnectInfo) $
+            describe "SMP server schema dump" $
+              postgresSchemaDumpTest
+                serverMigrations
+                [ "20250320_short_links", -- snd_secure moves to the bottom on down migration
+                  "20260918_expire_messages" -- msg_queue_expire moves to the bottom on down migration
+                ] -- skipComparisonForDownMigrations
+                testServerDBOpts
+                "src/Simplex/Messaging/Server/QueueStore/Postgres/server_schema.sql"
+          around_ (postgressBracket ntfTestServerDBConnectInfo) $
+            describe "Ntf server schema dump" $
+              postgresSchemaDumpTest
+                ntfServerMigrations
+                [] -- skipComparisonForDownMigrations
+                ntfTestServerDBOpts
+                "src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql"
 #endif
-        describe "XRCP" remoteControlTests
-        describe "Web" webTests
-        describe "Server CLIs" cliTests
 #if defined(dbPostgres)
-        around_ (postgressBracket testDBConnectInfo) $
-          describe "Agent PostgreSQL schema dump" $
-            postgresSchemaDumpTest
-              appMigrations
-              ["20250322_short_links"] -- snd_secure and last_broker_ts columns swap order on down migration
-              (testDBOpts testDB)
-              "src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql"
+          around_ (postgressBracket testDBConnectInfo) $
+            describe "Agent PostgreSQL schema dump" $
+              postgresSchemaDumpTest
+                appMigrations
+                ["20250322_short_links"] -- snd_secure and last_broker_ts columns swap order on down migration
+                (testDBOpts "smp_agent_test_protocol_schema")
+                "src/Simplex/Messaging/Agent/Store/Postgres/Migrations/agent_postgres_schema.sql"
 #else
-        describe "Agent SQLite schema dump" schemaDumpTest
+          after_ (listDirectory tmpDir >>= mapM_ (removeFileIfExists . (tmpDir </>))) $
+            describe "Agent SQLite schema dump" schemaDumpTest
 #endif
 
-eventuallyRemove :: FilePath -> Int -> IO ()
-eventuallyRemove path retries = case retries of
-  0 -> action
-  n ->
-    action `E.catch` \ioe@IOError {ioe_type, ioe_filename} -> case ioe_type of
-      IOException.UnsatisfiedConstraints | ioe_filename == Just path -> threadDelay 1000000 >> eventuallyRemove path (n - 1)
-      _ -> E.throwIO ioe
-  where
-    action = removeDirectoryRecursive path
+hspecInTmpDir :: Spec -> IO ()
+hspecInTmpDir spec = do
+  (config, forest) <- evalSpec defaultConfig spec
+  config' <- getArgs >>= readConfig config
+  withTmpDir (withArgs [] $ runSpecForest forest config') >>= evaluateResult
+
+withTmpDir :: IO a -> IO a
+withTmpDir = bracket_ (removePathForcibly tmpDir >> createDirectory tmpDir) (eventuallyRemove tmpDir 3)
diff --git a/tests/Util.hs b/tests/Util.hs
index eaa670f06..dbd824eba 100644
--- a/tests/Util.hs
+++ b/tests/Util.hs
@@ -1,21 +1,33 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Util where
 
+import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async
+import Control.Concurrent.STM
 import Control.Exception as E
 import Control.Logger.Simple
 import Control.Monad (replicateM, when)
 import Data.Either (partitionEithers)
 import Data.List (tails)
+import Data.String (IsString (..))
 import GHC.Conc (getNumCapabilities, getNumProcessors, setNumCapabilities)
-import System.Directory (doesFileExist, removeFile)
+import GHC.IO.Exception (IOException (..))
+import qualified GHC.IO.Exception as IOException
+import Network.Socket (ServiceName)
+import System.Directory (createDirectoryIfMissing, doesFileExist, removeDirectoryRecursive, removeFile)
 import System.Environment (lookupEnv)
+import System.FilePath ((</>))
+import System.IO.Unsafe (unsafePerformIO)
 import System.Process (callCommand)
 import System.Timeout (timeout)
-import Test.Hspec hiding (fit, it)
+import Test.Hspec hiding (fit, it, xit)
 import qualified Test.Hspec as Hspec
 import Test.Hspec.Core.Spec (Example (..), Result (..), ResultStatus (..))
 
@@ -44,7 +56,70 @@ removeFileIfExists filePath = do
   fileExists <- doesFileExist filePath
   when fileExists $ removeFile filePath
 
-newtype TestWrapper a = TestWrapper a
+data TestEnv = TestEnv
+  { testNo :: Int,
+    portBase :: Int
+  }
+
+type HasTestEnv = (?testEnv :: TestEnv)
+
+tmpDir :: FilePath
+tmpDir = "tests/tmp"
+
+testDir :: HasTestEnv => FilePath
+testDir = tmpDir </> show (testNo ?testEnv)
+
+testPath :: HasTestEnv => FilePath -> FilePath
+testPath = (testDir </>)
+
+testServerPort :: HasTestEnv => Int -> ServiceName
+testServerPort offset = show (portBase ?testEnv + offset)
+
+testSchemaName :: (HasTestEnv, IsString s) => String -> s
+testSchemaName name = fromString $ "test" <> show (testNo ?testEnv) <> "_" <> name
+
+senderFiles :: HasTestEnv => FilePath
+senderFiles = testPath "xftp-sender-files"
+
+recipientFiles :: HasTestEnv => FilePath
+recipientFiles = testPath "xftp-recipient-files"
+
+testCounter :: TVar Int
+testCounter = unsafePerformIO $ newTVarIO 0
+{-# NOINLINE testCounter #-}
+
+portBases :: TVar [Int]
+portBases = unsafePerformIO $ newTVarIO [10000, 10010 .. 19990]
+{-# NOINLINE portBases #-}
+
+withTestEnv :: (HasTestEnv => IO a) -> IO a
+withTestEnv action =
+  bracket takePortBase releasePortBase $ \portBase -> do
+    testNo <- atomically $ stateTVar testCounter $ \n -> (n, n + 1)
+    let ?testEnv = TestEnv {testNo, portBase}
+    bracket_
+      (mapM_ (createDirectoryIfMissing True) [senderFiles, recipientFiles])
+      (eventuallyRemove testDir 3)
+      action
+  where
+    takePortBase =
+      atomically $
+        readTVar portBases >>= \case
+          b : bs -> b <$ writeTVar portBases bs
+          [] -> retry
+    releasePortBase b = atomically $ modifyTVar' portBases (<> [b])
+
+eventuallyRemove :: FilePath -> Int -> IO ()
+eventuallyRemove path retries = case retries of
+  0 -> action
+  n ->
+    action `E.catch` \ioe@IOError {ioe_type, ioe_filename} -> case ioe_type of
+      IOException.UnsatisfiedConstraints | ioe_filename == Just path -> threadDelay 1000000 >> eventuallyRemove path (n - 1)
+      _ -> E.throwIO ioe
+  where
+    action = removeDirectoryRecursive path
+
+data TestWrapper a = TestWrapper (HasTestEnv => a)
 
 -- TODO [ntfdb] running wiht LogWarn level shows potential issue "Queue count differs"
 testLogLevel :: LogLevel
@@ -58,9 +133,10 @@ instance Example a => Example (TestWrapper a) where
     where
       tt = 300
       runTest =
-        timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case
-          Just r -> pure r
-          Nothing -> throwIO $ userError $ "test timed out after " <> show tt <> " seconds"
+        withTestEnv $
+          timeout (tt * 1000000) (evaluateExample action params hooks state) `finally` callCommand "sync" >>= \case
+            Just r -> pure r
+            Nothing -> throwIO $ userError $ "test timed out after " <> show tt <> " seconds"
       onTestFailure :: Bool -> ResultStatus -> IO Result
       onTestFailure ci = \case
         Failure loc_ reason | ci -> do
@@ -80,8 +156,11 @@ instance Example a => Example (TestWrapper a) where
 envCI :: IO Bool
 envCI = (Just "true" ==) <$> lookupEnv "CI"
 
-it :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
+it :: (HasCallStack, Example a) => String -> (HasTestEnv => a) -> SpecWith (Arg a)
 it label action = Hspec.it label (TestWrapper action)
 
-fit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a)
-fit = fmap focus . it
+fit :: (HasCallStack, Example a) => String -> (HasTestEnv => a) -> SpecWith (Arg a)
+fit label action = focus $ it label action
+
+xit :: (HasCallStack, Example a) => String -> (HasTestEnv => a) -> SpecWith (Arg a)
+xit label action = Hspec.xit label (TestWrapper action)
diff --git a/tests/XFTPAgent.hs b/tests/XFTPAgent.hs
index 2d513313d..e55b9483c 100644
--- a/tests/XFTPAgent.hs
+++ b/tests/XFTPAgent.hs
@@ -48,34 +48,25 @@ import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), MasterKey (..), s
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs)
 import qualified Simplex.Messaging.Crypto.File as CF
 import Simplex.Messaging.Encoding.String (StrEncoding (..))
-import Simplex.Messaging.Protocol (BasicAuth, NetworkError (..), ProtoServerWithAuth (..), ProtocolServer (..), XFTPServerWithAuth)
+import Simplex.Messaging.Protocol (BasicAuth, NetworkError (..), ProtoServerWithAuth (..), ProtocolServer (..), XFTPServer, XFTPServerWithAuth)
 import Simplex.Messaging.Server.Expiration (ExpirationConfig (..))
 import Simplex.Messaging.Server.Information (ServerPublicInfo)
 import Simplex.Messaging.Transport (EntitlementConfig (..))
 import Simplex.Messaging.Util (tshow)
 import System.Directory (doesDirectoryExist, doesFileExist, getFileSize, listDirectory, removeFile)
 import System.FilePath ((</>))
-import Test.Hspec hiding (fit, it)
+import Test.Hspec hiding (fit, it, xit)
 import UnliftIO
 import UnliftIO.Concurrent
 import Util
-import XFTPCLI
 import XFTPClient
-#if defined(dbPostgres)
-import Fixtures
-import Simplex.Messaging.Agent.Store.Postgres.Util (dropAllSchemasExceptSystem)
-#endif
 
 pattern SFDONE :: ValidFileDescription 'FSender -> [ValidFileDescription 'FRecipient] -> AEvent 'AESndFile
 pattern SFDONE sndDescr rcvDescrs <- A.SFDONE sndDescr rcvDescrs _
 
 xftpAgentTests :: SpecWith AFStoreType
 xftpAgentTests =
-  around_ testBracket
-#if defined(dbPostgres)
-    . after_ (dropAllSchemasExceptSystem testDBConnectInfo)
-#endif
-    . describe "agent XFTP API" $ do
+  describe "agent XFTP API" $ do
       it "should send and receive file" $ withXFTPServer testXFTPAgentSendReceive
       -- uncomment CPP option slow_servers and run hpack to run this test
       xit "should send and receive file with slow server responses" $ \_ ->
@@ -100,18 +91,21 @@ xftpAgentTests =
       it "should request additional recipient IDs when number of recipients exceeds maximum per request" testXFTPAgentRequestAdditionalRecipientIDs
       describe "XFTP server test via agent API" $ do
         it "should pass without basic auth" $ \_ -> testXFTPServerTest Nothing (noAuthSrv testXFTPServer2) `shouldReturn` Right (Just (Right testServerInformation))
-        let srv1 = testXFTPServer2 {keyHash = "1234"}
+        let srv1 :: HasTestEnv => XFTPServer
+            srv1 = testXFTPServer2 {keyHash = "1234"}
         it "should fail with incorrect fingerprint" $ \_ -> do
           testXFTPServerTest Nothing (noAuthSrv srv1) `shouldReturn` Left (ProtocolTestFailure TSConnect $ BROKER (B.unpack $ strEncode srv1) $ NETWORK NEUnknownCAError)
         describe "server with password" $ do
           let auth = Just "abcd"
+              srv :: HasTestEnv => Maybe BasicAuth -> XFTPServerWithAuth
               srv = ProtoServerWithAuth testXFTPServer2
+              authErr :: HasTestEnv => ProtocolTestFailure
               authErr = ProtocolTestFailure TSCreateFile $ XFTP (B.unpack $ strEncode testXFTPServer2) AUTH
           it "should pass with correct password" $ \_ -> testXFTPServerTest auth (srv auth) `shouldReturn` Right (Just (Right testServerInformation))
           it "should fail without password" $ \_ -> testXFTPServerTest auth (srv Nothing) `shouldReturn` Left authErr
           it "should fail with incorrect password" $ \_ -> testXFTPServerTest auth (srv $ Just "wrong") `shouldReturn` Left authErr
 
-testXFTPServerTest :: HasCallStack => Maybe BasicAuth -> XFTPServerWithAuth -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
+testXFTPServerTest :: (HasCallStack, HasTestEnv) => Maybe BasicAuth -> XFTPServerWithAuth -> IO (Either ProtocolTestFailure (Maybe (Either String ServerPublicInfo)))
 testXFTPServerTest newFileBasicAuth srv =
   withXFTPServerCfg testXFTPServerConfig {newFileBasicAuth, xftpPort = xftpTestPort2, information = Just testServerInformation} $ \_ ->
     -- initially passed server is not running
@@ -143,7 +137,7 @@ checkProgress (prev, expected) (progress, total) loop
   | progress < total = loop progress
   | otherwise = pure ()
 
-testXFTPAgentSendReceive :: HasCallStack => IO ()
+testXFTPAgentSendReceive :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentSendReceive = do
   filePath <- createRandomFile
   -- send file, delete snd file internally
@@ -160,7 +154,7 @@ testXFTPAgentSendReceive = do
         rfId <- runRight $ testReceive rcp rfd originalFilePath
         xftpDeleteRcvFile rcp rfId
 
-testXFTPAgentSendReceiveEncrypted :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentSendReceiveEncrypted :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentSendReceiveEncrypted = withXFTPServer $ do
   g <- C.newRandom
   filePath <- createRandomFile
@@ -181,13 +175,14 @@ testXFTPAgentSendReceiveEncrypted = withXFTPServer $ do
         rfId <- runRight $ testReceiveCF rcp rfd cfArgs originalFilePath
         xftpDeleteRcvFile rcp rfId
 
-testXFTPAgentSendReceiveRedirect :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentSendReceiveRedirect :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentSendReceiveRedirect = withXFTPServer $ do
   --- sender
   filePathIn <- createRandomFile
   let fileSize = mb 17
       totalSize = fileSize + mb 1
   withAgent 1 agentCfg initAgentServers testDB $ \sndr -> do
+    runRight_ $ xftpStartWorkers sndr (Just senderFiles)
     directFileId <- runRight $ xftpSendFile sndr 1 (CryptoFile filePathIn Nothing) 1
     sfGet sndr `shouldReturn` ("", directFileId, SFPROG 4194304 totalSize)
     sfGet sndr `shouldReturn` ("", directFileId, SFPROG 8388608 totalSize)
@@ -222,7 +217,7 @@ testXFTPAgentSendReceiveRedirect = withXFTPServer $ do
     --- recipient
     withAgent 2 agentCfg initAgentServers testDB2 $ \rcp -> do
       FileDescriptionURI {description} <- either fail pure $ strDecode uri
-
+      runRight_ $ xftpStartWorkers rcp (Just recipientFiles)
       rcvFileId <- runRight $ xftpReceiveFile rcp 1 description Nothing True
       rfGet rcp `shouldReturn` ("", rcvFileId, RFPROG 65536 totalSize) -- extra RFPROG before switching to real file
       rfGet rcp `shouldReturn` ("", rcvFileId, RFPROG 4194304 totalSize)
@@ -239,12 +234,13 @@ testXFTPAgentSendReceiveRedirect = withXFTPServer $ do
       inBytes <- B.readFile filePathIn
       B.readFile out `shouldReturn` inBytes
 
-testXFTPAgentSendReceiveNoRedirect :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentSendReceiveNoRedirect :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentSendReceiveNoRedirect = withXFTPServer $ do
   --- sender
   let fileSize = mb 5
   filePathIn <- createRandomFile_ fileSize "testfile"
   withAgent 1 agentCfg initAgentServers testDB $ \sndr -> do
+    runRight_ $ xftpStartWorkers sndr (Just senderFiles)
     directFileId <- runRight $ xftpSendFile sndr 1 (CryptoFile filePathIn Nothing) 1
     let totalSize = fileSize + mb 1
     sfGet sndr `shouldReturn` ("", directFileId, SFPROG 4194304 totalSize)
@@ -267,6 +263,7 @@ testXFTPAgentSendReceiveNoRedirect = withXFTPServer $ do
       FileDescriptionURI {description} <- either fail pure $ strDecode uri
       let ValidFileDescription FileDescription {redirect} = description
       redirect `shouldBe` Nothing
+      runRight_ $ xftpStartWorkers rcp (Just recipientFiles)
       rcvFileId <- runRight $ xftpReceiveFile rcp 1 description Nothing True
       -- NO extra "RFPROG 65k 65k" before switching to real file
       rfGet rcp `shouldReturn` ("", rcvFileId, RFPROG 4194304 totalSize)
@@ -280,7 +277,7 @@ testXFTPAgentSendReceiveNoRedirect = withXFTPServer $ do
       inBytes <- B.readFile filePathIn
       B.readFile out `shouldReturn` inBytes
 
-testXFTPAgentPrepareReceive :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentPrepareReceive :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentPrepareReceive = withXFTPServer $ do
   filePath <- createRandomFile
   (_, _, rfd1, rfd2) <- withAgent 1 agentCfg initAgentServers testDB $ \sndr -> runRight $ testSend sndr filePath
@@ -305,7 +302,7 @@ testXFTPAgentPrepareReceive = withXFTPServer $ do
       file <- B.readFile filePath
       B.readFile path `shouldReturn` file
 
-testXFTPAgentPrepareSend :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentPrepareSend :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentPrepareSend = withXFTPServer $ do
   filePath1 <- createRandomFile' "testfile1"
   filePath2 <- createRandomFile' "testfile2"
@@ -343,11 +340,12 @@ testXFTPAgentSendReceiveMatrix = do
     it "old sender, new recipient" $ run newServer oldClient newClient
     it "old clients" $ run newServer oldClient oldClient
   where
+    oldClient, newClient :: HasTestEnv => AgentConfig
     oldClient = agentCfg {xftpCfg = (xftpCfg agentCfg) {clientALPN = Nothing}}
     newClient = agentCfg
     oldServer = withXFTPServerCfgNoALPN
     newServer = withXFTPServerCfg
-    run :: HasCallStack => (HasCallStack => XFTPServerConfig STMFileStore -> (ThreadId -> IO ()) -> IO ()) -> AgentConfig -> AgentConfig -> IO ()
+    run :: (HasCallStack, HasTestEnv) => (HasCallStack => XFTPServerConfig STMFileStore -> (ThreadId -> IO ()) -> IO ()) -> AgentConfig -> AgentConfig -> IO ()
     run withServer sender receiver =
       withServer testXFTPServerConfig $ \_t -> do
         filePath <- createRandomFile_ (kb 319 :: Integer) "testfile"
@@ -355,29 +353,30 @@ testXFTPAgentSendReceiveMatrix = do
           (sfId, _, rfd1, _) <- runRight $ testSendCF' sndr (CF.plain filePath) (kb 320)
           rfd1 <$ xftpDeleteSndFileInternal sndr sfId
         withAgent 2 receiver initAgentServers testDB2 $ \rcp -> do
+          runRight_ $ xftpStartWorkers rcp (Just recipientFiles)
           rfId <- runRight $ testReceiveCF' rcp rfd Nothing filePath (kb 320)
           xftpDeleteRcvFile rcp rfId
 
-createRandomFile :: HasCallStack => IO FilePath
+createRandomFile :: (HasCallStack, HasTestEnv) => IO FilePath
 createRandomFile = createRandomFile' "testfile"
 
-createRandomFile' :: HasCallStack => FilePath -> IO FilePath
+createRandomFile' :: (HasCallStack, HasTestEnv) => FilePath -> IO FilePath
 createRandomFile' = createRandomFile_ (mb 17 :: Integer)
 
-createRandomFile_ :: (HasCallStack, Integral s, Show s) => s -> FilePath -> IO FilePath
+createRandomFile_ :: (HasCallStack, HasTestEnv, Integral s) => s -> FilePath -> IO FilePath
 createRandomFile_ size fileName = do
   let filePath = senderFiles </> fileName
-  xftpCLI ["rand", filePath, show size] `shouldReturn` ["File created: " <> filePath]
+  B.writeFile filePath =<< atomically . C.randomBytes (fromIntegral size) =<< C.newRandom
   getFileSize filePath `shouldReturn` toInteger size
   pure filePath
 
-testSend :: HasCallStack => AgentClient -> FilePath -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
+testSend :: (HasCallStack, HasTestEnv) => AgentClient -> FilePath -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
 testSend sndr = testSendCF sndr . CF.plain
 
-testSendCF :: HasCallStack => AgentClient -> CryptoFile -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
+testSendCF :: (HasCallStack, HasTestEnv) => AgentClient -> CryptoFile -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
 testSendCF sndr file = testSendCF' sndr file $ mb 18
 
-testSendCF' :: HasCallStack => AgentClient -> CryptoFile -> Int64 -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
+testSendCF' :: (HasCallStack, HasTestEnv) => AgentClient -> CryptoFile -> Int64 -> ExceptT AgentErrorType IO (SndFileId, ValidFileDescription 'FSender, ValidFileDescription 'FRecipient, ValidFileDescription 'FRecipient)
 testSendCF' sndr file size = do
   xftpStartWorkers sndr (Just senderFiles)
   sfId <- xftpSendFile sndr 1 file 2
@@ -392,7 +391,7 @@ testNoRedundancy :: HasCallStack => ValidFileDescription 'FRecipient -> IO ()
 testNoRedundancy (ValidFileDescription FileDescription {chunks}) =
   all (\FileChunk {replicas} -> length replicas == 1) chunks `shouldBe` True
 
-testXFTPAgentEntitlement :: HasCallStack => IO ()
+testXFTPAgentEntitlement :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentEntitlement = do
   Right (issuerPk, issuerSk) <- bbsKeyGen
   now <- getCurrentTime
@@ -429,10 +428,10 @@ testXFTPAgentEntitlement = do
         ("", _, SFPROG _ _) -> waitSndDone sndr
         r -> error $ "Expected SFDONE, got " <> show r
 
-testReceive :: HasCallStack => AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId
+testReceive :: (HasCallStack, HasTestEnv) => AgentClient -> ValidFileDescription 'FRecipient -> FilePath -> ExceptT AgentErrorType IO RcvFileId
 testReceive rcp rfd = testReceiveCF rcp rfd Nothing
 
-testReceiveCF :: HasCallStack => AgentClient -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> FilePath -> ExceptT AgentErrorType IO RcvFileId
+testReceiveCF :: (HasCallStack, HasTestEnv) => AgentClient -> ValidFileDescription 'FRecipient -> Maybe CryptoFileArgs -> FilePath -> ExceptT AgentErrorType IO RcvFileId
 testReceiveCF rcp rfd cfArgs originalFilePath = do
   xftpStartWorkers rcp (Just recipientFiles)
   testReceiveCF' rcp rfd cfArgs originalFilePath $ mb 18
@@ -454,7 +453,7 @@ testReceiveCF' rcp rfd cfArgs originalFilePath size = do
 logCfgNoLogs :: LogConfig
 logCfgNoLogs = LogConfig {lc_file = Nothing, lc_stderr = False}
 
-testXFTPAgentReceiveRestore :: HasCallStack => IO ()
+testXFTPAgentReceiveRestore :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentReceiveRestore = do
   filePath <- createRandomFile
 
@@ -498,7 +497,7 @@ testXFTPAgentReceiveRestore = do
       -- tmp path should be removed after receiving file
       doesDirectoryExist tmpPath `shouldReturn` False
 
-testXFTPAgentReceiveCleanup :: HasCallStack => IO ()
+testXFTPAgentReceiveCleanup :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentReceiveCleanup = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -523,13 +522,14 @@ 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:8000" AUTH)) <- rfGet rcp'
+      ("", rfId', RFERR (XFTP srv AUTH)) <- rfGet rcp'
       rfId' `shouldBe` rfId
+      srv `shouldBe` testXFTPServerStr
 
   -- tmp path should be removed after permanent error
   doesDirectoryExist tmpPath `shouldReturn` False
 
-testXFTPAgentSendRestore :: HasCallStack => IO ()
+testXFTPAgentSendRestore :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -576,7 +576,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
     withAgent 4 agentCfg initAgentServers testDB2 $ \rcp ->
       runRight_ . void $ testReceive rcp rfd1 filePath
 
-testXFTPAgentSendCleanup :: HasCallStack => IO ()
+testXFTPAgentSendCleanup :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentSendCleanup = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -602,15 +602,16 @@ 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:8000" AUTH)) <-
+      ("", sfId', SFERR (XFTP srv AUTH)) <-
         sfGet sndr'
       sfId' `shouldBe` sfId
+      srv `shouldBe` testXFTPServerStr
 
   -- prefix path should be removed after permanent error
   doesDirectoryExist prefixPath `shouldReturn` False
   doesFileExist encPath `shouldReturn` False
 
-testXFTPAgentDelete :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentDelete :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentDelete = withGlobalLogging logCfgNoLogs . withXFTPServer test
   where
     test = do
@@ -639,11 +640,12 @@ testXFTPAgentDelete = withGlobalLogging logCfgNoLogs . withXFTPServer test
         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:8000" AUTH)) <-
+          ("", rfId', RFERR (XFTP srv AUTH)) <-
             rfGet rcp2
           liftIO $ rfId' `shouldBe` rfId
+          liftIO $ srv `shouldBe` testXFTPServerStr
 
-testXFTPAgentDeleteRestore :: HasCallStack => IO ()
+testXFTPAgentDeleteRestore :: (HasCallStack, HasTestEnv) => IO ()
 testXFTPAgentDeleteRestore = withGlobalLogging logCfgNoLogs $ do
   filePath <- createRandomFile
 
@@ -677,11 +679,12 @@ 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:8000" AUTH)) <-
+        ("", rfId', RFERR (XFTP srv AUTH)) <-
           rfGet rcp2
         liftIO $ rfId' `shouldBe` rfId
+        liftIO $ srv `shouldBe` testXFTPServerStr
 
-testXFTPAgentDeleteOnServer :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentDeleteOnServer :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentDeleteOnServer = withGlobalLogging logCfgNoLogs . withXFTPServer test
   where
     test = do
@@ -713,14 +716,15 @@ testXFTPAgentDeleteOnServer = withGlobalLogging logCfgNoLogs . withXFTPServer te
           runRight_ . void $ do
             -- receive file 1 again
             rfId1 <- xftpReceiveFile rcp 1 rfd1_2 Nothing True
-            ("", rfId1', RFERR (XFTP "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000" AUTH)) <-
+            ("", rfId1', RFERR (XFTP srv AUTH)) <-
               rfGet rcp
             liftIO $ rfId1 `shouldBe` rfId1'
+            liftIO $ srv `shouldBe` testXFTPServerStr
 
             -- receive file 2
             testReceive' rcp rfd2 filePath2
 
-testXFTPAgentExpiredOnServer :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentExpiredOnServer :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentExpiredOnServer fsType = withGlobalLogging logCfgNoLogs $
   withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {fileExpiration = fastExpiration}) . const $ do
     filePath1 <- createRandomFile' "testfile1"
@@ -745,9 +749,10 @@ testXFTPAgentExpiredOnServer fsType = withGlobalLogging logCfgNoLogs $
         -- 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:8000" AUTH)) <-
+          ("", rfId', RFERR (XFTP srv AUTH)) <-
             rfGet rcp
           liftIO $ rfId' `shouldBe` rfId
+          liftIO $ srv `shouldBe` testXFTPServerStr
 
         -- create and send file 2
         filePath2 <- createRandomFile' "testfile2"
@@ -760,7 +765,7 @@ testXFTPAgentExpiredOnServer fsType = withGlobalLogging logCfgNoLogs $
   where
     fastExpiration = ExpirationConfig {ttl = 2, checkInterval = 1}
 
-testXFTPAgentRequestAdditionalRecipientIDs :: HasCallStack => AFStoreType -> IO ()
+testXFTPAgentRequestAdditionalRecipientIDs :: (HasCallStack, HasTestEnv) => AFStoreType -> IO ()
 testXFTPAgentRequestAdditionalRecipientIDs = withXFTPServer $ do
   filePath <- createRandomFile
 
diff --git a/tests/XFTPCLI.hs b/tests/XFTPCLI.hs
index 3fe2f3bf5..6ec442aab 100644
--- a/tests/XFTPCLI.hs
+++ b/tests/XFTPCLI.hs
@@ -1,6 +1,6 @@
-module XFTPCLI (xftpCLIFileTests, xftpCLI, senderFiles, recipientFiles, testBracket) where
+module XFTPCLI (xftpCLIFileTests, xftpCLI) where
 
-import Control.Exception (bracket_, try)
+import Control.Exception (try)
 import qualified Data.ByteString as LB
 import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
 import Simplex.FileTransfer.Client.Main
@@ -10,7 +10,7 @@ import Simplex.FileTransfer.Client.Main
   )
 import Simplex.FileTransfer.Description (kb, mb)
 import Simplex.FileTransfer.Util (safeFileNameStr, uniqueCombine)
-import System.Directory (createDirectoryIfMissing, getFileSize, listDirectory, removeDirectoryRecursive)
+import System.Directory (getFileSize, listDirectory)
 import System.Environment (withArgs)
 import System.Exit (ExitCode (ExitSuccess))
 import System.FilePath (takeFileName, (</>))
@@ -21,7 +21,7 @@ import Simplex.FileTransfer.Server.Env (AFStoreType)
 import XFTPClient (cfgFS, cfgFS2, withXFTPServer, withXFTPServerConfigOn, testXFTPServerStr, testXFTPServerStr2, xftpServerFiles, xftpServerFiles2)
 
 xftpCLIFileTests :: SpecWith AFStoreType
-xftpCLIFileTests = around_ testBracket $ do
+xftpCLIFileTests = do
   it "shows experimental deprecation notice in help" $ \_ ->
     testXFTPCLIHelpDeprecationNotice
   it "should send and receive file" $ withXFTPServer testXFTPCLISendReceive_
@@ -43,20 +43,6 @@ xftpCLIFileTests = around_ testBracket $ do
     sanitized n = let n' = safeFileNameStr n in n' /= "" && n' /= "." && n' /= ".."
     bareName n = let n' = safeFileNameStr n in n' == takeFileName n'
 
-testBracket :: IO () -> IO ()
-testBracket =
-  bracket_
-    (mapM_ (createDirectoryIfMissing False) testDirs)
-    (mapM_ removeDirectoryRecursive testDirs)
-  where
-    testDirs = [xftpServerFiles, xftpServerFiles2, senderFiles, recipientFiles]
-
-senderFiles :: FilePath
-senderFiles = "tests/tmp/xftp-sender-files"
-
-recipientFiles :: FilePath
-recipientFiles = "tests/tmp/xftp-recipient-files"
-
 xftpCLI :: [String] -> IO [String]
 xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)
 
@@ -66,7 +52,7 @@ testXFTPCLIHelpDeprecationNotice = do
   result `shouldBe` (Left ExitSuccess :: Either ExitCode ())
   unwords (words output) `shouldSatisfy` (xftpClientDeprecationNotice `isInfixOf`)
 
-testXFTPCLISendReceive_ :: IO ()
+testXFTPCLISendReceive_ :: HasTestEnv => IO ()
 testXFTPCLISendReceive_ = do
   let filePath = senderFiles </> "testfile"
   xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath]
@@ -75,7 +61,7 @@ testXFTPCLISendReceive_ = do
   let fdRcv1 = filePath <> ".xftp" </> "rcv1.xftp"
       fdRcv2 = filePath <> ".xftp" </> "rcv2.xftp"
       fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
-  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=tests/tmp"]
+  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr, "--tmp=" <> testDir]
   progress `shouldSatisfy` uploadProgress
   let (sendInfo, sendRest) = splitAt 4 sendResult
   sendInfo
@@ -90,19 +76,19 @@ testXFTPCLISendReceive_ = do
   testInfoFile fdRcv2 "Recipient"
   testReceiveFile fdRcv2 "testfile_1" file
   testInfoFile fdSnd "Sender"
-  xftpCLI ["recv", fdSnd, recipientFiles, "--tmp=tests/tmp"]
+  xftpCLI ["recv", fdSnd, recipientFiles, "--tmp=" <> testDir]
     `shouldThrow` anyException
   where
     testInfoFile fd party = do
       xftpCLI ["info", fd]
         `shouldReturn` [party <> " file description", "File download size: 18mb", "File server(s):", testXFTPServerStr <> ": 18mb"]
     testReceiveFile fd fileName file = do
-      progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"]
+      progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=" <> testDir, "-y"]
       progress `shouldSatisfy` downloadProgress fileName
       recvResult `shouldBe` ["File description " <> fd <> " is deleted."]
       LB.readFile (recipientFiles </> fileName) `shouldReturn` file
 
-testXFTPCLISendReceive2servers_ :: IO ()
+testXFTPCLISendReceive2servers_ :: HasTestEnv => IO ()
 testXFTPCLISendReceive2servers_ = do
   let filePath = senderFiles </> "testfile"
   xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath]
@@ -111,7 +97,7 @@ testXFTPCLISendReceive2servers_ = do
   let fdRcv1 = filePath <> ".xftp" </> "rcv1.xftp"
       fdRcv2 = filePath <> ".xftp" </> "rcv2.xftp"
       fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
-  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"]
+  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=" <> testDir]
   progress `shouldSatisfy` uploadProgress
   let (sendInfo, sendRest) = splitAt 4 sendResult
   sendInfo
@@ -135,12 +121,12 @@ testXFTPCLISendReceive2servers_ = do
           srv1 `shouldContain` testXFTPServerStr
           srv2 `shouldContain` testXFTPServerStr2
         _ -> print srvs >> error "more than 2 servers returned"
-      progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=tests/tmp", "-y"]
+      progress : recvResult <- xftpCLI ["recv", fd, recipientFiles, "--tmp=" <> testDir, "-y"]
       progress `shouldSatisfy` downloadProgress fileName
       recvResult `shouldBe` ["File description " <> fd <> " is deleted."]
       LB.readFile (recipientFiles </> fileName) `shouldReturn` file
 
-testXFTPCLIDelete_ :: IO ()
+testXFTPCLIDelete_ :: HasTestEnv => IO ()
 testXFTPCLIDelete_ = do
   let filePath = senderFiles </> "testfile"
   xftpCLI ["rand", filePath, "17mb"] `shouldReturn` ["File created: " <> filePath]
@@ -149,7 +135,7 @@ testXFTPCLIDelete_ = do
   let fdRcv1 = filePath <> ".xftp" </> "rcv1.xftp"
       fdRcv2 = filePath <> ".xftp" </> "rcv2.xftp"
       fdSnd = filePath <> ".xftp" </> "snd.xftp.private"
-  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=tests/tmp"]
+  progress : sendResult <- xftpCLI ["send", filePath, senderFiles, "-n", "2", "-s", testXFTPServerStr <> ";" <> testXFTPServerStr2, "--tmp=" <> testDir]
   progress `shouldSatisfy` uploadProgress
   let (sendInfo, sendRest) = splitAt 4 sendResult
   sendInfo
@@ -161,7 +147,7 @@ testXFTPCLIDelete_ = do
   sendRest `shouldSatisfy` any ("https://" `isPrefixOf`)
   xftpCLI ["del", fdRcv1]
     `shouldThrow` anyException
-  progress1 : recvResult <- xftpCLI ["recv", fdRcv1, recipientFiles, "--tmp=tests/tmp", "-y"]
+  progress1 : recvResult <- xftpCLI ["recv", fdRcv1, recipientFiles, "--tmp=" <> testDir, "-y"]
   progress1 `shouldSatisfy` downloadProgress "testfile"
   recvResult `shouldBe` ["File description " <> fdRcv1 <> " is deleted."]
   LB.readFile (recipientFiles </> "testfile") `shouldReturn` file
@@ -172,10 +158,10 @@ testXFTPCLIDelete_ = do
     `shouldReturn` ["File deleted!            \r", "File description " <> fdSnd <> " is deleted."]
   listDirectory xftpServerFiles >>= (`shouldBe` [])
   listDirectory xftpServerFiles2 >>= (`shouldBe` [])
-  xftpCLI ["recv", fdRcv2, recipientFiles, "--tmp=tests/tmp"]
+  xftpCLI ["recv", fdRcv2, recipientFiles, "--tmp=" <> testDir]
     `shouldThrow` anyException
 
-testReceivedFileNameCombine :: IO ()
+testReceivedFileNameCombine :: HasTestEnv => IO ()
 testReceivedFileNameCombine =
   uniqueCombine recipientFiles "../../escaped.txt" `shouldReturn` (recipientFiles </> "escaped.txt")
 
@@ -202,7 +188,7 @@ uploadProgress s =
     && "Uploading file..." `isInfixOf` s
     && "File uploaded!" `isInfixOf` s
 
-downloadProgress :: FilePath -> String -> Bool
+downloadProgress :: HasTestEnv => FilePath -> String -> Bool
 downloadProgress fileName s =
   "Downloading file..." `isPrefixOf` s
     && "Decrypting file..." `isInfixOf` s
diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs
index 772b1b692..688c90eda 100644
--- a/tests/XFTPClient.hs
+++ b/tests/XFTPClient.hs
@@ -26,11 +26,14 @@ import Simplex.Messaging.Crypto.File (CryptoFile)
 import Simplex.Messaging.Protocol (XFTPServer)
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server
+import System.Directory (createDirectoryIfMissing)
 import Test.Hspec hiding (fit, it)
+import Util
 #if defined(dbServerPostgres)
 import Control.Monad (void)
 import qualified Database.PostgreSQL.Simple as PSQL
 import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
+import Database.PostgreSQL.Simple.Types (Query (..))
 import Simplex.FileTransfer.Server.Store.Postgres.Config (PostgresFileStoreCfg (..), defaultXFTPDBOpts)
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
@@ -44,7 +47,7 @@ data AXFTPServerConfig = forall s. FileStoreClass s => AXFTPSrvCfg (XFTPServerCo
 updateXFTPCfg :: AXFTPServerConfig -> (forall s. XFTPServerConfig s -> XFTPServerConfig s) -> AXFTPServerConfig
 updateXFTPCfg (AXFTPSrvCfg cfg) f = AXFTPSrvCfg (f cfg)
 
-cfgFS :: AFStoreType -> AXFTPServerConfig
+cfgFS :: HasTestEnv => AFStoreType -> AXFTPServerConfig
 cfgFS (AFSType fs) = case fs of
   SFSMemory -> AXFTPSrvCfg testXFTPServerConfig
 #if defined(dbServerPostgres)
@@ -53,7 +56,7 @@ cfgFS (AFSType fs) = case fs of
   SFSPostgres -> error "no postgres support"
 #endif
 
-cfgFS2 :: AFStoreType -> AXFTPServerConfig
+cfgFS2 :: HasTestEnv => AFStoreType -> AXFTPServerConfig
 cfgFS2 (AFSType fs) = case fs of
   SFSMemory -> AXFTPSrvCfg testXFTPServerConfig2
 #if defined(dbServerPostgres)
@@ -73,12 +76,12 @@ testXFTPDBConnectInfo =
       connectDatabase = "test_xftp_server_db"
     }
 
-testXFTPPostgresCfg :: PostgresFileStoreCfg
+testXFTPPostgresCfg :: HasTestEnv => PostgresFileStoreCfg
 testXFTPPostgresCfg =
   PostgresFileStoreCfg
     { dbOpts = defaultXFTPDBOpts
         { connstr = "postgresql://test_xftp_server_user@/test_xftp_server_db",
-          schema = "xftp_server_test",
+          schema = testSchemaName "xftp_server_test",
           poolSize = 10,
           createSchema = True
         },
@@ -86,94 +89,94 @@ testXFTPPostgresCfg =
       confirmMigrations = MCYesUp
     }
 
-clearXFTPPostgresStore :: IO ()
+clearXFTPPostgresStore :: HasTestEnv => IO ()
 clearXFTPPostgresStore = do
-  let DBOpts {connstr} = dbOpts testXFTPPostgresCfg
+  let DBOpts {connstr, schema} = dbOpts testXFTPPostgresCfg
   conn <- PSQL.connectPostgreSQL connstr
-  void $ PSQL.execute_ conn "SET search_path TO xftp_server_test,public"
+  void $ PSQL.execute_ conn $ Query $ "SET search_path TO " <> schema <> ",public"
   void $ PSQL.execute_ conn "DELETE FROM files"
   PSQL.close conn
 #endif
 
-xftpTest :: HasCallStack => (HasCallStack => XFTPClient -> IO ()) -> AFStoreType -> Expectation
+xftpTest :: (HasCallStack, HasTestEnv) => (HasCallStack => XFTPClient -> IO ()) -> AFStoreType -> Expectation
 xftpTest test fsType = withXFTPServerConfigOn (cfgFS fsType) (\_ -> testXFTPClient test) `shouldReturn` ()
 
-xftpTestN :: HasCallStack => Int -> (HasCallStack => [XFTPClient] -> IO ()) -> AFStoreType -> Expectation
+xftpTestN :: (HasCallStack, HasTestEnv) => Int -> (HasCallStack => [XFTPClient] -> IO ()) -> AFStoreType -> Expectation
 xftpTestN nClients test fsType = withXFTPServerConfigOn (cfgFS fsType) (\_ -> run nClients []) `shouldReturn` ()
   where
     run :: Int -> [XFTPClient] -> IO ()
     run 0 hs = test hs
     run n hs = testXFTPClient $ \h -> run (n - 1) (h : hs)
 
-xftpTest2 :: HasCallStack => (HasCallStack => XFTPClient -> XFTPClient -> IO ()) -> AFStoreType -> Expectation
+xftpTest2 :: (HasCallStack, HasTestEnv) => (HasCallStack => XFTPClient -> XFTPClient -> IO ()) -> AFStoreType -> Expectation
 xftpTest2 test = xftpTestN 2 _test
   where
     _test [h1, h2] = test h1 h2
     _test _ = error "expected 2 handles"
 
-xftpTest4 :: HasCallStack => (HasCallStack => XFTPClient -> XFTPClient -> XFTPClient -> XFTPClient -> IO ()) -> AFStoreType -> Expectation
+xftpTest4 :: (HasCallStack, HasTestEnv) => (HasCallStack => XFTPClient -> XFTPClient -> XFTPClient -> XFTPClient -> IO ()) -> AFStoreType -> Expectation
 xftpTest4 test = xftpTestN 4 _test
   where
     _test [h1, h2, h3, h4] = test h1 h2 h3 h4
     _test _ = error "expected 4 handles"
 
-withXFTPServerStoreLogOn :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
+withXFTPServerStoreLogOn :: (HasCallStack, HasTestEnv) => (HasCallStack => ThreadId -> IO a) -> IO a
 withXFTPServerStoreLogOn = withXFTPServerCfg testXFTPServerConfig {serverStoreCfg = XSCMemory (Just testXFTPLogFile), storeLogFile = Just testXFTPLogFile, serverStatsBackupFile = Just testXFTPStatsBackupFile}
 
 withXFTPServerCfgNoALPN :: (HasCallStack, FileStoreClass s) => XFTPServerConfig s -> (HasCallStack => ThreadId -> IO a) -> IO a
 withXFTPServerCfgNoALPN cfg = withXFTPServerCfg cfg {transportConfig = (transportConfig cfg) {serverALPN = Nothing}}
 
 withXFTPServerCfg :: (HasCallStack, FileStoreClass s) => XFTPServerConfig s -> (HasCallStack => ThreadId -> IO a) -> IO a
-withXFTPServerCfg cfg =
+withXFTPServerCfg cfg@XFTPServerConfig {filesPath} =
   serverBracket
-    (\started -> runXFTPServerBlocking started cfg)
+    (\started -> createDirectoryIfMissing True filesPath >> runXFTPServerBlocking started cfg)
     (threadDelay 10000)
 
-withXFTPServerThreadOn :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
+withXFTPServerThreadOn :: (HasCallStack, HasTestEnv) => (HasCallStack => ThreadId -> IO a) -> IO a
 withXFTPServerThreadOn = withXFTPServerCfg testXFTPServerConfig
 
-withXFTPServer :: HasCallStack => IO a -> AFStoreType -> IO a
+withXFTPServer :: (HasCallStack, HasTestEnv) => IO a -> AFStoreType -> IO a
 withXFTPServer test fsType = withXFTPServerConfigOn (cfgFS fsType) $ const test
 
-withXFTPServer2 :: HasCallStack => IO a -> AFStoreType -> IO a
+withXFTPServer2 :: (HasCallStack, HasTestEnv) => IO a -> AFStoreType -> IO a
 withXFTPServer2 test fsType = withXFTPServerConfigOn (cfgFS2 fsType) $ const test
 
 -- Constants
 
-xftpTestPort :: ServiceName
-xftpTestPort = "8000"
+xftpTestPort :: HasTestEnv => ServiceName
+xftpTestPort = testServerPort 6
 
-xftpTestPort2 :: ServiceName
-xftpTestPort2 = "8001"
+xftpTestPort2 :: HasTestEnv => ServiceName
+xftpTestPort2 = testServerPort 7
 
-testXFTPServer :: XFTPServer
+testXFTPServer :: HasTestEnv => XFTPServer
 testXFTPServer = fromString testXFTPServerStr
 
-testXFTPServer2 :: XFTPServer
+testXFTPServer2 :: HasTestEnv => XFTPServer
 testXFTPServer2 = fromString testXFTPServerStr2
 
-testXFTPServerStr :: String
-testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8000"
+testXFTPServerStr :: HasTestEnv => String
+testXFTPServerStr = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:" <> xftpTestPort
 
-testXFTPServerStr2 :: String
-testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:8001"
+testXFTPServerStr2 :: HasTestEnv => String
+testXFTPServerStr2 = "xftp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:" <> xftpTestPort2
 
-xftpServerFiles :: FilePath
-xftpServerFiles = "tests/tmp/xftp-server-files"
+xftpServerFiles :: HasTestEnv => FilePath
+xftpServerFiles = testPath "xftp-server-files"
 
-xftpServerFiles2 :: FilePath
-xftpServerFiles2 = "tests/tmp/xftp-server-files2"
+xftpServerFiles2 :: HasTestEnv => FilePath
+xftpServerFiles2 = testPath "xftp-server-files2"
 
-testXFTPLogFile :: FilePath
-testXFTPLogFile = "tests/tmp/xftp-server-store.log"
+testXFTPLogFile :: HasTestEnv => FilePath
+testXFTPLogFile = testPath "xftp-server-store.log"
 
-testXFTPStatsBackupFile :: FilePath
-testXFTPStatsBackupFile = "tests/tmp/xftp-server-stats.log"
+testXFTPStatsBackupFile :: HasTestEnv => FilePath
+testXFTPStatsBackupFile = testPath "xftp-server-stats.log"
 
-xftpTestPrometheusMetricsFile :: FilePath
-xftpTestPrometheusMetricsFile = "tests/tmp/xftp-server-metrics.txt"
+xftpTestPrometheusMetricsFile :: HasTestEnv => FilePath
+xftpTestPrometheusMetricsFile = testPath "xftp-server-metrics.txt"
 
-testXFTPServerConfig :: XFTPServerConfig STMFileStore
+testXFTPServerConfig :: HasTestEnv => XFTPServerConfig STMFileStore
 testXFTPServerConfig =
   XFTPServerConfig
     { xftpPort = xftpTestPort,
@@ -204,7 +207,7 @@ testXFTPServerConfig =
       information = Nothing,
       logStatsInterval = Nothing,
       logStatsStartTime = 0,
-      serverStatsLogFile = "tests/tmp/xftp-server-stats.daily.log",
+      serverStatsLogFile = testPath "xftp-server-stats.daily.log",
       serverStatsBackupFile = Nothing,
       prometheusInterval = Nothing,
       prometheusMetricsFile = xftpTestPrometheusMetricsFile,
@@ -213,23 +216,23 @@ testXFTPServerConfig =
       webStaticPath = Nothing
     }
 
-testXFTPServerConfig2 :: XFTPServerConfig STMFileStore
+testXFTPServerConfig2 :: HasTestEnv => XFTPServerConfig STMFileStore
 testXFTPServerConfig2 = testXFTPServerConfig {xftpPort = xftpTestPort2, filesPath = xftpServerFiles2}
 
 testXFTPClientConfig :: XFTPClientConfig
 testXFTPClientConfig = defaultXFTPClientConfig
 
-testXFTPClient :: HasCallStack => (HasCallStack => XFTPClient -> IO a) -> IO a
+testXFTPClient :: (HasCallStack, HasTestEnv) => (HasCallStack => XFTPClient -> IO a) -> IO a
 testXFTPClient = testXFTPClientWith testXFTPClientConfig
 
-testXFTPClientWith :: HasCallStack => XFTPClientConfig -> (HasCallStack => XFTPClient -> IO a) -> IO a
+testXFTPClientWith :: (HasCallStack, HasTestEnv) => XFTPClientConfig -> (HasCallStack => XFTPClient -> IO a) -> IO a
 testXFTPClientWith cfg client = do
   ts <- getCurrentTime
   getXFTPClient (1, testXFTPServer, Nothing) cfg [] ts (\_ -> pure Nothing) (\_ -> pure ()) >>= \case
     Right c -> client c
     Left e -> error $ show e
 
-testXFTPServerConfigSNI :: XFTPServerConfig STMFileStore
+testXFTPServerConfigSNI :: HasTestEnv => XFTPServerConfig STMFileStore
 testXFTPServerConfigSNI =
   testXFTPServerConfig
     { httpCredentials =
@@ -245,10 +248,10 @@ testXFTPServerConfigSNI =
           }
     }
 
-withXFTPServerSNI :: HasCallStack => (HasCallStack => ThreadId -> IO a) -> IO a
+withXFTPServerSNI :: (HasCallStack, HasTestEnv) => (HasCallStack => ThreadId -> IO a) -> IO a
 withXFTPServerSNI = withXFTPServerCfg testXFTPServerConfigSNI
 
-testXFTPServerConfigEd25519SNI :: XFTPServerConfig STMFileStore
+testXFTPServerConfigEd25519SNI :: HasTestEnv => XFTPServerConfig STMFileStore
 testXFTPServerConfigEd25519SNI =
   testXFTPServerConfig
     { xftpCredentials =
diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs
index 693856d9f..a5a28feb8 100644
--- a/tests/XFTPServerTests.hs
+++ b/tests/XFTPServerTests.hs
@@ -47,7 +47,7 @@ import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..))
 import qualified Simplex.Messaging.Transport.HTTP2.Client as HC
 import Simplex.Messaging.Transport.Server (loadFileFingerprint)
 import Simplex.Messaging.Transport.Shared (ChainCertificates (..), chainIdCaCerts)
-import System.Directory (createDirectoryIfMissing, removeDirectoryRecursive, removeFile)
+import System.Directory (removeFile)
 import System.FilePath ((</>))
 import Test.Hspec hiding (fit, it)
 import UnliftIO.STM
@@ -55,8 +55,7 @@ import Util
 import XFTPClient
 
 xftpServerTests :: SpecWith AFStoreType
-xftpServerTests =
-  before_ (createDirectoryIfMissing False xftpServerFiles) . after_ (removeDirectoryRecursive xftpServerFiles) $ do
+xftpServerTests = do
     describe "XFTP file chunk delivery" $ do
       it "should create, upload and receive file chunk (1 client)" testFileChunkDelivery
       it "should create, upload and receive file chunk (2 clients)" testFileChunkDelivery2
@@ -90,8 +89,8 @@ xftpServerTests =
 chSize :: Integral a => a
 chSize = kb 128
 
-testChunkPath :: FilePath
-testChunkPath = "tests/tmp/chunk1"
+testChunkPath :: HasTestEnv => FilePath
+testChunkPath = testPath "chunk1"
 
 createTestChunk :: FilePath -> IO ByteString
 createTestChunk fp = do
@@ -103,16 +102,16 @@ createTestChunk fp = do
 createXFTPChunk :: XFTPClient -> C.APrivateAuthKey -> FileInfo -> NonEmpty C.APublicAuthKey -> Maybe BasicAuth -> ExceptT XFTPClientError IO (SenderId, NonEmpty RecipientId)
 createXFTPChunk c spKey file rcps auth = (\(sId, rIds, _) -> (sId, rIds)) <$> A.createXFTPChunk c spKey file rcps auth Nothing
 
-readChunk :: XFTPFileId -> IO ByteString
+readChunk :: HasTestEnv => XFTPFileId -> IO ByteString
 readChunk sId = B.readFile (xftpServerFiles </> B.unpack (B64.encode $ unEntityId sId))
 
-testFileChunkDelivery :: AFStoreType -> Expectation
+testFileChunkDelivery :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkDelivery = xftpTest $ \c -> runRight_ $ runTestFileChunkDelivery c c
 
-testFileChunkDelivery2 :: AFStoreType -> Expectation
+testFileChunkDelivery2 :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkDelivery2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkDelivery s r
 
-runTestFileChunkDelivery :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
+runTestFileChunkDelivery :: HasTestEnv => XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
 runTestFileChunkDelivery s r = do
   g <- liftIO C.newRandom
   (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -127,12 +126,12 @@ runTestFileChunkDelivery s r = do
   uploadXFTPChunk s spKey sId' chunkSpec
     `catchError` (liftIO . (`shouldBe` PCEProtocolError DIGEST))
   liftIO $ readChunk sId `shouldReturn` bytes
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize (digest <> "_wrong"))
+  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec (testPath "received_chunk1") chSize (digest <> "_wrong"))
     `catchError` (liftIO . (`shouldBe` PCEResponseError DIGEST))
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest
+  liftIO $ B.readFile (testPath "received_chunk1") `shouldReturn` bytes
 
-testFileChunkDeliveryAddRecipients :: AFStoreType -> Expectation
+testFileChunkDeliveryAddRecipients :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkDeliveryAddRecipients = xftpTest4 $ \s r1 r2 r3 -> runRight_ $ do
   g <- liftIO C.newRandom
   (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -149,17 +148,17 @@ testFileChunkDeliveryAddRecipients = xftpTest4 $ \s r1 r2 r3 -> runRight_ $ do
   let testReceiveChunk r rpKey rId fPath = do
         downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec fPath chSize digest
         liftIO $ B.readFile fPath `shouldReturn` bytes
-  testReceiveChunk r1 rpKey1 rId1 "tests/tmp/received_chunk1"
-  testReceiveChunk r2 rpKey2 rId2 "tests/tmp/received_chunk2"
-  testReceiveChunk r3 rpKey3 rId3 "tests/tmp/received_chunk3"
+  testReceiveChunk r1 rpKey1 rId1 (testPath "received_chunk1")
+  testReceiveChunk r2 rpKey2 rId2 (testPath "received_chunk2")
+  testReceiveChunk r3 rpKey3 rId3 (testPath "received_chunk3")
 
-testFileChunkDelete :: AFStoreType -> Expectation
+testFileChunkDelete :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkDelete = xftpTest $ \c -> runRight_ $ runTestFileChunkDelete c c
 
-testFileChunkDelete2 :: AFStoreType -> Expectation
+testFileChunkDelete2 :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkDelete2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkDelete s r
 
-runTestFileChunkDelete :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
+runTestFileChunkDelete :: HasTestEnv => XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
 runTestFileChunkDelete s r = do
   g <- liftIO C.newRandom
   (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -171,18 +170,18 @@ runTestFileChunkDelete s r = do
   (sId, [rId]) <- createXFTPChunk s spKey file [rcvKey] Nothing
   uploadXFTPChunk s spKey sId chunkSpec
 
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest
+  liftIO $ B.readFile (testPath "received_chunk1") `shouldReturn` bytes
   deleteXFTPChunk s spKey sId
   liftIO $
     readChunk sId
       `shouldThrow` \(e :: SomeException) -> "does not exist" `isInfixOf` show e
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
+  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec (testPath "received_chunk2") chSize digest)
     `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
   deleteXFTPChunk s spKey sId
     `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
 
-testWrongChunkSize :: AFStoreType -> Expectation
+testWrongChunkSize :: HasTestEnv => AFStoreType -> Expectation
 testWrongChunkSize = xftpTest $ \c -> do
   g <- C.newRandom
   (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
@@ -194,7 +193,7 @@ testWrongChunkSize = xftpTest $ \c -> do
     void (createXFTPChunk c spKey file [rcvKey] Nothing)
       `catchError` (liftIO . (`shouldBe` PCEProtocolError SIZE))
 
-testFileChunkExpiration :: AFStoreType -> Expectation
+testFileChunkExpiration :: HasTestEnv => AFStoreType -> Expectation
 testFileChunkExpiration fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {fileExpiration}) $
   \_ -> testXFTPClient $ \c -> runRight_ $ do
     g <- liftIO C.newRandom
@@ -207,18 +206,18 @@ testFileChunkExpiration fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fs
     (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] Nothing
     uploadXFTPChunk c spKey sId chunkSpec
 
-    downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-    liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+    downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest
+    liftIO $ B.readFile (testPath "received_chunk1") `shouldReturn` bytes
 
     liftIO $ threadDelay 1000000
-    downloadXFTPChunk g c rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
+    downloadXFTPChunk g c rpKey rId (XFTPRcvChunkSpec (testPath "received_chunk2") chSize digest)
       `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
     deleteXFTPChunk c spKey sId
       `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
   where
     fileExpiration = ExpirationConfig {ttl = 1, checkInterval = 1}
 
-testInactiveClientExpiration :: AFStoreType -> Expectation
+testInactiveClientExpiration :: HasTestEnv => AFStoreType -> Expectation
 testInactiveClientExpiration fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {inactiveClientExpiration}) $ \_ -> runRight_ $ do
   disconnected <- newEmptyTMVarIO
   ts <- liftIO getCurrentTime
@@ -234,7 +233,7 @@ testInactiveClientExpiration fsType = withXFTPServerConfigOn (updateXFTPCfg (cfg
   where
     inactiveClientExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}
 
-testFileStorageQuota :: AFStoreType -> Expectation
+testFileStorageQuota :: HasTestEnv => AFStoreType -> Expectation
 testFileStorageQuota fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {fileSizeQuota = Just $ chSize * 2}) $
   \_ -> testXFTPClient $ \c -> runRight_ $ do
     g <- liftIO C.newRandom
@@ -245,8 +244,8 @@ testFileStorageQuota fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsTyp
     let file = FileInfo {sndKey, size = chSize, digest}
         chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize}
         download rId = do
-          downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-          liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+          downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest
+          liftIO $ B.readFile (testPath "received_chunk1") `shouldReturn` bytes
     (sId1, [rId1]) <- createXFTPChunk c spKey file [rcvKey] Nothing
     uploadXFTPChunk c spKey sId1 chunkSpec
     download rId1
@@ -262,7 +261,7 @@ testFileStorageQuota fsType = withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsTyp
     uploadXFTPChunk c spKey sId3 chunkSpec
     download rId3
 
-testFileLog :: AFStoreType -> Expectation
+testFileLog :: HasTestEnv => AFStoreType -> Expectation
 testFileLog _ = do
   g <- C.newRandom
   bytes <- liftIO $ createTestChunk testChunkPath
@@ -298,9 +297,9 @@ testFileLog _ = do
     rId1 <- liftIO $ readTVarIO rIdVar1
     rId2 <- liftIO $ readTVarIO rIdVar2
     -- recipients and sender get AUTH error because server restarted without log
-    downloadXFTPChunk g c rpKey1 rId1 (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest)
+    downloadXFTPChunk g c rpKey1 rId1 (XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest)
       `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-    downloadXFTPChunk g c rpKey2 rId2 (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest)
+    downloadXFTPChunk g c rpKey2 rId2 (XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest)
       `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
     deleteXFTPChunk c spKey sId
       `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
@@ -331,10 +330,10 @@ testFileLog _ = do
   removeFile testXFTPStatsBackupFile
   where
     download g c rpKey rId digest bytes = do
-      downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-      liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
+      downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk1") chSize digest
+      liftIO $ B.readFile (testPath "received_chunk1") `shouldReturn` bytes
 
-testFileBasicAuth :: Bool -> Maybe BasicAuth -> Maybe BasicAuth -> Bool -> AFStoreType -> IO ()
+testFileBasicAuth :: HasTestEnv => Bool -> Maybe BasicAuth -> Maybe BasicAuth -> Bool -> AFStoreType -> IO ()
 testFileBasicAuth allowNewFiles newFileBasicAuth clntAuth success fsType =
   withXFTPServerConfigOn (updateXFTPCfg (cfgFS fsType) $ \c -> c {allowNewFiles, newFileBasicAuth}) $
     \_ -> testXFTPClient $ \c -> do
@@ -350,13 +349,13 @@ testFileBasicAuth allowNewFiles newFileBasicAuth clntAuth success fsType =
           then do
             (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] clntAuth
             uploadXFTPChunk c spKey sId chunkSpec
-            downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk" chSize digest
-            liftIO $ B.readFile "tests/tmp/received_chunk" `shouldReturn` bytes
+            downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk") chSize digest
+            liftIO $ B.readFile (testPath "received_chunk") `shouldReturn` bytes
           else do
             void (createXFTPChunk c spKey file [rcvKey] clntAuth)
               `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
 
-testFileSkipCommitted :: AFStoreType -> IO ()
+testFileSkipCommitted :: HasTestEnv => AFStoreType -> IO ()
 testFileSkipCommitted fsType =
   withXFTPServerConfigOn (cfgFS fsType) $
     \_ -> testXFTPClient $ \c -> do
@@ -372,8 +371,8 @@ testFileSkipCommitted fsType =
         uploadXFTPChunk c spKey sId chunkSpec
         void . liftIO $ createTestChunk testChunkPath -- trash chunk contents
         uploadXFTPChunk c spKey sId chunkSpec -- upload again to get FROk without getting stuck
-        downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk" chSize digest
-        liftIO $ B.readFile "tests/tmp/received_chunk" `shouldReturn` bytes -- new chunk content got ignored
+        downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec (testPath "received_chunk") chSize digest
+        liftIO $ B.readFile (testPath "received_chunk") `shouldReturn` bytes -- new chunk content got ignored
 
 -- SNI and CORS tests
 
@@ -386,7 +385,7 @@ getCerts tls =
   let X.CertificateChain cc = tlsPeerCert tls
    in map (X.signedObject . X.getSigned) cc
 
-testSNICertSelection :: Expectation
+testSNICertSelection :: HasTestEnv => Expectation
 testSNICertSelection =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
@@ -399,7 +398,7 @@ testSNICertSelection =
         leaf : _ -> expectationFailure $ "Expected RSA cert, got: " <> show (X.certPubKey leaf)
         [] -> expectationFailure "Empty certificate chain"
 
-testNoSNICertSelection :: Expectation
+testNoSNICertSelection :: HasTestEnv => Expectation
 testNoSNICertSelection =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpXFTP <- loadFileFingerprint "tests/fixtures/ca.crt"
@@ -412,7 +411,7 @@ testNoSNICertSelection =
         leaf : _ -> expectationFailure $ "Expected Ed448 cert, got: " <> show (X.certPubKey leaf)
         [] -> expectationFailure "Empty certificate chain"
 
-testCORSHeaders :: Expectation
+testCORSHeaders :: HasTestEnv => Expectation
 testCORSHeaders =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
@@ -426,7 +425,7 @@ testCORSHeaders =
       lookupResponseHeader "access-control-allow-origin" response `shouldBe` Just "*"
       lookupResponseHeader "access-control-expose-headers" response `shouldBe` Just "*"
 
-testCORSPreflight :: Expectation
+testCORSPreflight :: HasTestEnv => Expectation
 testCORSPreflight =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpHTTP <- loadFileFingerprint "tests/fixtures/web_ca.crt"
@@ -442,7 +441,7 @@ testCORSPreflight =
       lookupResponseHeader "access-control-allow-headers" response `shouldBe` Just "*"
       lookupResponseHeader "access-control-max-age" response `shouldBe` Just "86400"
 
-testNoCORSWithoutSNI :: Expectation
+testNoCORSWithoutSNI :: HasTestEnv => Expectation
 testNoCORSWithoutSNI =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpXFTP <- loadFileFingerprint "tests/fixtures/ca.crt"
@@ -455,11 +454,11 @@ testNoCORSWithoutSNI =
       HC.HTTP2Response {HC.response} <- either (error . show) pure =<< HC.sendRequest h2 req (Just 5000000)
       lookupResponseHeader "access-control-allow-origin" response `shouldBe` Nothing
 
-testFileChunkDeliverySNI :: Expectation
+testFileChunkDeliverySNI :: HasTestEnv => Expectation
 testFileChunkDeliverySNI =
   withXFTPServerSNI $ \_ -> testXFTPClient $ \c -> runRight_ $ runTestFileChunkDelivery c c
 
-testWebHandshake :: Expectation
+testWebHandshake :: HasTestEnv => Expectation
 testWebHandshake =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpWeb <- loadFileFingerprint "tests/fixtures/web_ca.crt"
@@ -501,7 +500,7 @@ testWebHandshake =
       let ackBody = bodyHead (HC.respBody resp2)
       B.length ackBody `shouldBe` 0
 
-testWebReHandshake :: Expectation
+testWebReHandshake :: HasTestEnv => Expectation
 testWebReHandshake =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpWeb <- loadFileFingerprint "tests/fixtures/web_ca.crt"
@@ -535,7 +534,7 @@ testWebReHandshake =
       resp2b <- either (error . show) pure =<< HC.sendRequest h2 (H2.requestBuilder "POST" "/" [] $ byteString clientHsPadded) (Just 5000000)
       B.length (bodyHead (HC.respBody resp2b)) `shouldBe` 0
 
-testStaleWebSession :: Expectation
+testStaleWebSession :: HasTestEnv => Expectation
 testStaleWebSession =
   withXFTPServerSNI $ \_ -> do
     Fingerprint fpWeb <- loadFileFingerprint "tests/fixtures/web_ca.crt"
diff --git a/tests/XFTPWebTests.hs b/tests/XFTPWebTests.hs
index ddb1d1f56..90153e669 100644
--- a/tests/XFTPWebTests.hs
+++ b/tests/XFTPWebTests.hs
@@ -51,7 +51,6 @@ import AgentTests.FunctionalAPITests (rfGet, runRight, runRight_, sfGet, withAge
 import Simplex.Messaging.Agent (AgentClient, xftpReceiveFile, xftpStartWorkers)
 import Simplex.Messaging.Agent.Protocol (AEvent (..))
 import SMPAgentClient (agentCfg, initAgentServers, testDB)
-import XFTPCLI (recipientFiles, senderFiles, testBracket)
 import qualified Simplex.Messaging.Crypto.File as CF
 
 xftpWebDir :: FilePath
@@ -168,8 +167,8 @@ impAddr = "import * as Addr from './dist/protocol/address.js';"
 jsOut :: String -> String
 jsOut expr = "process.stdout.write(Buffer.from(" <> expr <> "));"
 
-xftpWebTests :: IO () -> Spec
-xftpWebTests dbCleanup = do
+xftpWebTests :: Spec
+xftpWebTests = do
   xftpWebSourceHygieneTests
   distExists <- runIO $ doesDirectoryExist (xftpWebDir <> "/dist")
   if distExists
@@ -189,7 +188,7 @@ xftpWebTests dbCleanup = do
       tsClientTests
       tsDownloadTests
       tsAddressTests
-      tsIntegrationTests dbCleanup
+      tsIntegrationTests
     else
       it "skipped (run 'cd xftp-web && npm install && npm run build' first)" $
         pendingWith "TS project not compiled"
@@ -2847,9 +2846,8 @@ tsAddressTests = describe "protocol/address" $ do
 
 -- ── integration ───────────────────────────────────────────────────
 
-tsIntegrationTests :: IO () -> Spec
-tsIntegrationTests dbCleanup = describe "integration" $
-  around_ testBracket . after_ dbCleanup $ do
+tsIntegrationTests :: Spec
+tsIntegrationTests = describe "integration" $ do
   it "web handshake with Ed25519 identity verification" $
     webHandshakeTest testXFTPServerConfigEd25519SNI "tests/fixtures/ed25519/ca.crt"
   it "web handshake with Ed448 identity verification" $
@@ -2872,7 +2870,7 @@ tsIntegrationTests dbCleanup = describe "integration" $
   it "cross-language: Haskell upload, TS download" $
     haskellUploadTsDownloadTest testXFTPServerConfigSNI
 
-webHandshakeTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+webHandshakeTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 webHandshakeTest cfg caFile = do
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
@@ -2914,7 +2912,7 @@ webHandshakeTest cfg caFile = do
           <> jsOut "new Uint8Array([idOk ? 1 : 0, ack.length === 0 ? 1 : 0])"
     result `shouldBe` B.pack [1, 1]
 
-pingTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+pingTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 pingTest cfg caFile = do
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
@@ -2936,9 +2934,8 @@ pingTest cfg caFile = do
           <> jsOut "new Uint8Array([1])"
     result `shouldBe` B.pack [1]
 
-fullRoundTripTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+fullRoundTripTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 fullRoundTripTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
     let fpStr = map (toEnum . fromIntegral) $ B.unpack $ strEncode fp
@@ -3017,9 +3014,8 @@ agentURIRoundTripTest = do
         <> jsOut "new Uint8Array([match])"
   result `shouldBe` B.pack [1]
 
-agentUploadDownloadTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+agentUploadDownloadTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 agentUploadDownloadTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
     let fpStr = map (toEnum . fromIntegral) $ B.unpack $ strEncode fp
@@ -3050,9 +3046,8 @@ agentUploadDownloadTest cfg caFile = do
           <> jsOut "new Uint8Array([nameMatch, sizeMatch, dataMatch])"
     result `shouldBe` B.pack [1, 1, 1]
 
-agentDeleteTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+agentDeleteTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 agentDeleteTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
     let fpStr = map (toEnum . fromIntegral) $ B.unpack $ strEncode fp
@@ -3082,9 +3077,8 @@ agentDeleteTest cfg caFile = do
           <> jsOut "new Uint8Array([deleted])"
     result `shouldBe` B.pack [1]
 
-agentRedirectTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+agentRedirectTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 agentRedirectTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
     let fpStr = map (toEnum . fromIntegral) $ B.unpack $ strEncode fp
@@ -3116,9 +3110,8 @@ agentRedirectTest cfg caFile = do
           <> jsOut "new Uint8Array([hasRedirect, nameMatch, sizeMatch, dataMatch])"
     result `shouldBe` B.pack [1, 1, 1, 1]
 
-tsUploadHaskellDownloadTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+tsUploadHaskellDownloadTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 tsUploadHaskellDownloadTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   createDirectoryIfMissing False recipientFiles
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
@@ -3151,9 +3144,8 @@ tsUploadHaskellDownloadTest cfg caFile = do
       downloadedData <- B.readFile outPath
       downloadedData `shouldBe` originalData
 
-tsUploadRedirectHaskellDownloadTest :: XFTPServerConfig STMFileStore -> FilePath -> Expectation
+tsUploadRedirectHaskellDownloadTest :: HasTestEnv => XFTPServerConfig STMFileStore -> FilePath -> Expectation
 tsUploadRedirectHaskellDownloadTest cfg caFile = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   createDirectoryIfMissing False recipientFiles
   withXFTPServerCfg cfg $ \_ -> do
     Fingerprint fp <- loadFileFingerprint caFile
@@ -3186,9 +3178,8 @@ tsUploadRedirectHaskellDownloadTest cfg caFile = do
       downloadedData <- B.readFile outPath
       downloadedData `shouldBe` originalData
 
-haskellUploadTsDownloadTest :: XFTPServerConfig STMFileStore -> Expectation
+haskellUploadTsDownloadTest :: HasTestEnv => XFTPServerConfig STMFileStore -> Expectation
 haskellUploadTsDownloadTest cfg = do
-  createDirectoryIfMissing False "tests/tmp/xftp-server-files"
   createDirectoryIfMissing False senderFiles
   let filePath = senderFiles <> "/hs-to-ts.bin"
   originalData <- B.pack <$> replicateM 50000 (randomIO :: IO Word8)
@@ -3201,8 +3192,8 @@ haskellUploadTsDownloadTest cfg = do
       (_, _, SFDONE _ [rfd] _) <- sfGet sndr
       pure rfd
     let yamlDesc = strEncode vfd
-        tmpYaml = "tests/tmp/hs-to-ts-desc.yaml"
-        tmpData = "tests/tmp/hs-to-ts-data.bin"
+        tmpYaml = testPath "hs-to-ts-desc.yaml"
+        tmpData = testPath "hs-to-ts-data.bin"
     B.writeFile tmpYaml yamlDesc
     B.writeFile tmpData originalData
     result <-
@@ -3212,8 +3203,12 @@ haskellUploadTsDownloadTest cfg = do
         \import * as Agent from './dist/agent.js';\
         \import {decodeFileDescription, validateFileDescription} from './dist/protocol/description.js';\
         \await sodium.ready;\
-        \const yaml = fs.readFileSync('../tests/tmp/hs-to-ts-desc.yaml', 'utf-8');\
-        \const expected = new Uint8Array(fs.readFileSync('../tests/tmp/hs-to-ts-data.bin'));\
+        \const yaml = fs.readFileSync('../"
+          <> tmpYaml
+          <> "', 'utf-8');\
+        \const expected = new Uint8Array(fs.readFileSync('../"
+          <> tmpData
+          <> "'));\
         \const fd = decodeFileDescription(yaml);\
         \const err = validateFileDescription(fd);\
         \if (err) throw new Error(err);\

From f1f079044cfbf61678f2de326f9b64f4a6c8aad0 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Thu, 15 Oct 2026 17:37:49 +0100
Subject: [PATCH 18/20] smp-server: remove journal message store (#1919)

Co-authored-by: sh <github.shum@liber.li>
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 docs/smp-server-db-load.md                    |    4 +-
 simplexmq.cabal                               |    2 -
 src/Simplex/Messaging/Server.hs               |   36 +-
 src/Simplex/Messaging/Server/Env/STM.hs       |   75 +-
 src/Simplex/Messaging/Server/Main.hs          |  190 +--
 src/Simplex/Messaging/Server/Main/Init.hs     |    4 +-
 .../Messaging/Server/MsgStore/Journal.hs      | 1085 -----------------
 .../Server/MsgStore/Journal/SharedLock.hs     |   44 -
 .../Messaging/Server/MsgStore/Postgres.hs     |    2 +-
 src/Simplex/Messaging/Server/MsgStore/STM.hs  |    2 +-
 .../Messaging/Server/MsgStore/Types.hs        |    4 +-
 src/Simplex/Messaging/Server/Prometheus.hs    |   10 +-
 tests/AgentTests/FunctionalAPITests.hs        |   31 +-
 tests/AgentTests/NotificationTests.hs         |    2 +-
 tests/CoreTests/MsgStoreTests.hs              |  433 +------
 tests/CoreTests/StoreLogTests.hs              |   14 +-
 tests/NamesResolverServer.hs                  |    3 +
 tests/SMPClient.hs                            |   80 +-
 tests/SMPProxyTests.hs                        |   28 +-
 tests/ServerTests.hs                          |   36 +-
 tests/Test.hs                                 |   24 +-
 21 files changed, 167 insertions(+), 1942 deletions(-)
 delete mode 100644 src/Simplex/Messaging/Server/MsgStore/Journal.hs
 delete mode 100644 src/Simplex/Messaging/Server/MsgStore/Journal/SharedLock.hs

diff --git a/docs/smp-server-db-load.md b/docs/smp-server-db-load.md
index cd94d7d12..4d65c7194 100644
--- a/docs/smp-server-db-load.md
+++ b/docs/smp-server-db-load.md
@@ -144,9 +144,7 @@ space, so it is workload-dependent; `fillfactor = 80` reached 100% for this frac
 larger share of queues at once would need a lower value. `fillfactor` applies to pages rewritten after
 the change, so the ratio ramps up as the heap turns over, or immediately after `pg_repack`.
 
-Dropping the index regresses the deprecated journal message store's expiration (`foldRecentQueueRecs`,
-`Journal.hs:434`) to a sequential scan; this is accepted because that store is being retired. The
-Postgres message store does not read `updated_at`.
+The Postgres message store does not read `updated_at`, so no query depends on the dropped index.
 
 Autovacuum reloptions applied by the migration:
 
diff --git a/simplexmq.cabal b/simplexmq.cabal
index d43f81840..acc574d4f 100644
--- a/simplexmq.cabal
+++ b/simplexmq.cabal
@@ -284,8 +284,6 @@ library
           Simplex.Messaging.Server.Main.Init
           Simplex.Messaging.Server.Web
           Simplex.Messaging.Server.MsgStore
-          Simplex.Messaging.Server.MsgStore.Journal
-          Simplex.Messaging.Server.MsgStore.Journal.SharedLock
           Simplex.Messaging.Server.MsgStore.STM
           Simplex.Messaging.Server.MsgStore.Types
           Simplex.Messaging.Server.Names
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index c26a8b0a6..8b49ef441 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -108,7 +108,6 @@ 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 (JournalMsgStore, JournalQueue (..), getJournalQueueMessages)
 import Simplex.Messaging.Server.Names (NamesEnv, closeNamesEnv, resolveName)
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
@@ -2350,7 +2349,6 @@ saveServerMessages drainMsgs ms = case ms of
   StoreMemory STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
     Just f -> exportMessages False ms f drainMsgs
     Nothing -> logNote "undelivered messages are not saved"
-  StoreJournal _ -> logNote "closed journal message storage"
 #if defined(dbServerPostgres)
   StoreDatabase _ -> logNote "closed postgres message storage"
 #endif
@@ -2360,7 +2358,6 @@ exportMessages tty st f drainMsgs = do
   logNote $ "saving messages to file " <> T.pack f
   run $ case st of
     StoreMemory ms -> exportMessages_ ms $ getMsgs ms
-    StoreJournal ms -> exportMessages_ ms $ getJournalMsgs ms
 #if defined(dbServerPostgres)
     StoreDatabase ms -> exportDbMessages tty ms
 #endif
@@ -2372,10 +2369,6 @@ exportMessages tty st f drainMsgs = do
       Left e -> do
         logError $ "error exporting messages: " <> tshow e
         exitFailure
-    getJournalMsgs ms q =
-      readTVarIO (msgQueue' q) >>= \case
-        Just _ -> getMsgs ms q
-        Nothing -> getJournalQueueMessages ms q
     getMsgs :: MsgStoreClass s' => s' -> StoreQueue s' -> IO [Message]
     getMsgs ms q = unsafeRunStore q "saveQueueMsgs" $ getQueueMessages_ drainMsgs q =<< getMsgQueue ms q False
     saveQueueMsgs :: (StoreQueue s -> IO [Message]) -> Handle -> StoreQueue s -> IO (Sum Int)
@@ -2392,37 +2385,16 @@ processServerMessages StartOptions {skipWarnings} = do
   asks msgStore_ >>= liftIO . processMessages old_ expire
     where
       processMessages :: Maybe Int64 -> Bool -> MsgStore s' -> IO (Maybe MessageStats)
+#if defined(dbServerPostgres)
       processMessages old_ expire = \case
+#else
+      processMessages old_ _ = \case
+#endif
         StoreMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
           Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_ skipWarnings) (pure Nothing)
           Nothing -> pure Nothing
-        StoreJournal ms -> processJournalMessages old_ expire ms
 #if defined(dbServerPostgres)
         StoreDatabase ms -> processDbMessages old_ expire ms
-#endif
-      processJournalMessages :: forall s. Maybe Int64 -> Bool -> JournalMsgStore s -> IO (Maybe MessageStats)
-      processJournalMessages old_ expire ms
-        | expire = Just <$> case old_ of
-            Just old -> do
-              logNote "expiring journal store messages..."
-              run $ processExpireQueue old
-            Nothing -> do
-              logNote "validating journal store messages..."
-              run processValidateQueue
-        | otherwise = logWarn "skipping message expiration" $> Nothing
-        where
-          run a = unsafeWithAllMsgQueues False ms a `catchAny` \_ -> exitFailure
-          processExpireQueue :: Int64 -> JournalQueue s -> IO MessageStats
-          processExpireQueue old q = unsafeRunStore q "processExpireQueue" $ do
-            mq <- getMsgQueue ms q False
-            expiredMsgsCount <- deleteExpireMsgs_ old q mq
-            storedMsgsCount <- getQueueSize_ mq
-            pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
-          processValidateQueue :: JournalQueue s -> IO MessageStats
-          processValidateQueue q = unsafeRunStore q "processValidateQueue" $ do
-            storedMsgsCount <- getQueueSize_ =<< getMsgQueue ms q False
-            pure newMessageStats {storedMsgsCount, storedQueues = 1}
-#if defined(dbServerPostgres)
       processDbMessages old_ expire ms
         | expire = Just <$> case old_ of
             Just old -> do
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 79bfe21f4..40000db9d 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -42,7 +42,6 @@ module Simplex.Messaging.Server.Env.STM
     VerifiedTransmission,
     ResponseAndMessage,
     newEnv,
-    mkJournalStoreConfig,
     msgStore,
     fromMsgStore,
     newClient,
@@ -70,10 +69,6 @@ module Simplex.Messaging.Server.Env.STM
     defaultNameResolverConcurrency,
     defaultMaxClientCmdWait,
     defaultAuthErrorDelayMs,
-    defaultMaxJournalMsgCount,
-    defaultMaxJournalStateLines,
-    defaultIdleQueueInterval,
-    journalMsgStoreDepth,
     readWriteQueueStore,
     noPostgresExitStr,
     noPostgresExit,
@@ -98,7 +93,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import Data.Maybe (isJust)
 import qualified Data.Text as T
-import Data.Time.Clock (getCurrentTime, nominalDay)
+import Data.Time.Clock (getCurrentTime)
 import Data.Time.Clock.System (SystemTime)
 import qualified Data.X509 as X
 import Data.X509.Validation (Fingerprint (..))
@@ -115,7 +110,6 @@ 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.Names (NamesConfig (..), NamesEnv, newNamesEnv, pingEndpoint)
@@ -148,8 +142,6 @@ data ServerConfig s = ServerConfig
     smpHandshakeTimeout :: Int,
     tbqSize :: Natural,
     msgQueueQuota :: Int,
-    maxJournalMsgCount :: Int,
-    maxJournalStateLines :: Int,
     queueIdBytes :: Int,
     msgIdBytes :: Int,
     serverStoreCfg :: ServerStoreCfg s,
@@ -166,8 +158,6 @@ data ServerConfig s = ServerConfig
     messageExpiration :: Maybe ExpirationConfig,
     expireMessagesOnStart :: Bool,
     expireMessagesOnSend :: 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),
@@ -233,9 +223,6 @@ defaultMessageExpiration =
       checkInterval = 7200 -- seconds, 2 hours
     }
 
-defaultIdleQueueInterval :: Int64
-defaultIdleQueueInterval = 14400 -- seconds, 4 hours
-
 defNtfExpirationHours :: Int64
 defNtfExpirationHours = 24
 
@@ -265,21 +252,9 @@ defaultMaxClientCmdWait = 60000000 -- microseconds
 defaultAuthErrorDelayMs :: Int64
 defaultAuthErrorDelayMs = 50
 
-journalMsgStoreDepth :: Int
-journalMsgStoreDepth = 5
-
-defaultMaxJournalStateLines :: Int
-defaultMaxJournalStateLines = 16
-
-defaultMaxJournalMsgCount :: Int
-defaultMaxJournalMsgCount = 256
-
 defaultMsgQueueQuota :: Int
 defaultMsgQueueQuota = 128
 
-defaultStateTailSize :: Int
-defaultStateTailSize = 512
-
 data Env s = Env
   { config :: ServerConfig s,
     serverActive :: TVar Bool,
@@ -305,7 +280,6 @@ msgStore = fromMsgStore . msgStore_
 fromMsgStore :: MsgStore s -> s
 fromMsgStore = \case
   StoreMemory s -> s
-  StoreJournal s -> s
 #if defined(dbServerPostgres)
   StoreDatabase s -> s
 #endif
@@ -313,12 +287,10 @@ fromMsgStore = \case
 
 type family SupportedStore (qs :: QSType) (ms :: MSType) :: Constraint where
   SupportedStore 'QSMemory 'MSMemory = ()
-  SupportedStore 'QSMemory 'MSJournal = ()
   SupportedStore 'QSMemory 'MSPostgres =
     (Int ~ Bool, TypeError ('TE.Text "Storing messages in Postgres DB with queues in memory is not supported"))
   SupportedStore 'QSPostgres 'MSMemory =
     (Int ~ Bool, TypeError ('TE.Text "Storing messages in memory with queues in Postgres DB is not supported"))
-  SupportedStore 'QSPostgres 'MSJournal = ()
 #if defined(dbServerPostgres)
   SupportedStore 'QSPostgres 'MSPostgres = ()
 #else
@@ -332,8 +304,6 @@ data AStoreType =
 
 data ServerStoreCfg s where
   SSCMemory :: Maybe StorePaths -> ServerStoreCfg STMMsgStore
-  SSCMemoryJournal :: {storeLogFile :: FilePath, storeMsgsPath :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSMemory)
-  SSCDatabaseJournal :: {storeCfg :: PostgresStoreCfg, storeMsgsPath' :: FilePath} -> ServerStoreCfg (JournalMsgStore 'QSPostgres)
 #if defined(dbServerPostgres)
   SSCDatabase :: PostgresStoreCfg -> ServerStoreCfg PostgresMsgStore
 #endif
@@ -341,8 +311,6 @@ data ServerStoreCfg s where
 dbStoreCfg :: ServerStoreCfg s -> Maybe PostgresStoreCfg
 dbStoreCfg = \case
   SSCMemory _ -> Nothing
-  SSCMemoryJournal {} -> Nothing
-  SSCDatabaseJournal {storeCfg} -> Just storeCfg
 #if defined(dbServerPostgres)
   SSCDatabase cfg -> Just cfg
 #endif
@@ -350,8 +318,6 @@ dbStoreCfg = \case
 storeLogFile' :: ServerStoreCfg s -> Maybe FilePath
 storeLogFile' = \case
   SSCMemory sp_ -> (\StorePaths {storeLogFile} -> storeLogFile) <$> sp_
-  SSCMemoryJournal {storeLogFile} -> Just storeLogFile
-  SSCDatabaseJournal {storeCfg = PostgresStoreCfg {dbStoreLogPath}} -> dbStoreLogPath
 #if defined(dbServerPostgres)
   SSCDatabase (PostgresStoreCfg {dbStoreLogPath}) -> dbStoreLogPath
 #endif
@@ -360,14 +326,12 @@ data StorePaths = StorePaths {storeLogFile :: FilePath, storeMsgsFile :: Maybe F
 
 type family MsgStoreType (qs :: QSType) (ms :: MSType) where
   MsgStoreType 'QSMemory 'MSMemory = STMMsgStore
-  MsgStoreType qs 'MSJournal = JournalMsgStore qs
 #if defined(dbServerPostgres)
   MsgStoreType 'QSPostgres 'MSPostgres = PostgresMsgStore
 #endif
 
 data MsgStore s where
   StoreMemory :: STMMsgStore -> MsgStore STMMsgStore
-  StoreJournal :: JournalMsgStore qs -> MsgStore (JournalMsgStore qs)
 #if defined(dbServerPostgres)
   StoreDatabase :: PostgresMsgStore -> MsgStore PostgresMsgStore
 #endif
@@ -581,7 +545,7 @@ newProhibitedSub = do
   return Sub {subThread = ProhibitSub, delivered}
 
 newEnv :: ServerConfig s -> IO (Env s)
-newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig, msgIdBytes} = do
+newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, msgQueueQuota, namesConfig, msgIdBytes} = do
   when (msgIdBytes < 24) $ do
     logError "Error: msgIdBytes must be at least 24"
     exitFailure
@@ -593,30 +557,12 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
       ms <- newMsgStore STMStoreConfig {storePath, quota = msgQueueQuota}
       forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms True) f $ queueStore ms
       pure $ StoreMemory ms
-    SSCMemoryJournal {storeLogFile, storeMsgsPath} -> do
-      logWarn $
-        "Journal message store is deprecated and will be removed soon.\n"
-          <> "Please migrate to in-memory storage using `journal export` command.\n"
-          <> "After that you can migrate to PostgreSQL using `database import` command."
-      let qsCfg = MQStoreCfg
-          cfg = mkJournalStoreConfig qsCfg storeMsgsPath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
-      ms <- newMsgStore cfg
-      loadStoreLog (mkQueue ms True) storeLogFile $ stmQueueStore ms
-      pure $ StoreJournal ms
 #if defined(dbServerPostgres)
-    SSCDatabaseJournal {storeCfg, storeMsgsPath'} -> do
-      let StartOptions {compactLog, confirmMigrations} = startOptions config
-          qsCfg = PQStoreCfg (storeCfg {confirmMigrations} :: PostgresStoreCfg)
-          cfg = mkJournalStoreConfig qsCfg storeMsgsPath' msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval
-      when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
-      StoreJournal <$> newMsgStore cfg
     SSCDatabase storeCfg -> do
       let StartOptions {compactLog, confirmMigrations} = startOptions config
           cfg = PostgresMsgStoreCfg storeCfg {confirmMigrations} msgQueueQuota
       when compactLog $ compactDbStoreLog $ dbStoreLogPath storeCfg
       StoreDatabase <$> newMsgStore cfg
-#else
-    SSCDatabaseJournal {} -> noPostgresExit
 #endif
   ntfStore <- NtfStore <$> TM.emptyIO
   random <- C.newRandom
@@ -716,7 +662,9 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
             Nothing -> SPMMemoryOnly
             Just StorePaths {storeMsgsFile = Just _} -> SPMMessages
             _ -> SPMQueues
+#if defined(dbServerPostgres)
           _ -> SPMMessages
+#endif
 
 noPostgresExit :: IO a
 noPostgresExit = putStrLn noPostgresExitStr >> exitFailure
@@ -726,21 +674,6 @@ noPostgresExitStr =
   "Error: server binary is compiled without support for PostgreSQL database.\n"
     <> "Please download `smp-server-postgres` or re-compile with `cabal build -fserver_postgres`."
 
-mkJournalStoreConfig :: QStoreCfg s -> FilePath -> Int -> Int -> Int -> Int64 -> JournalStoreConfig s
-mkJournalStoreConfig queueStoreCfg storePath msgQueueQuota maxJournalMsgCount maxJournalStateLines idleQueueInterval =
-  JournalStoreConfig
-    { storePath,
-      quota = msgQueueQuota,
-      pathParts = journalMsgStoreDepth,
-      queueStoreCfg,
-      maxMsgCount = maxJournalMsgCount,
-      maxStateLines = maxJournalStateLines,
-      stateTailSize = defaultStateTailSize,
-      idleInterval = idleQueueInterval,
-      expireBackupsAfter = 14 * nominalDay,
-      keepMinBackups = 2
-    }
-
 newSMPProxyAgent :: SMPClientAgentConfig -> TVar ChaChaDRG -> IO ProxyAgent
 newSMPProxyAgent smpAgentCfg random = do
   smpAgent <- newSMPClientAgent SSender smpAgentCfg Nothing random
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index a0088f9a3..53864c5bd 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -28,7 +28,6 @@ module Simplex.Messaging.Server.Main
     importMessagesToDatabase,
     exportDatabaseToStoreLog,
 #endif
-    newJournalMsgStore,
     storeMsgsJournalDir',
     getServerSourceCode,
     simplexmqSource,
@@ -61,7 +60,6 @@ import qualified Data.Text.IO as T
 import Options.Applicative
 import Simplex.Messaging.Agent.Protocol (ConnectionLink (..), ConnectionMode (..), connReqUriP')
 import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..))
-import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SMPWebPortServers (..), SocksMode (..), defaultNetworkConfig, textToHostMode)
 import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
 import qualified Simplex.Messaging.Crypto as C
@@ -69,23 +67,20 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
 import Network.URI (URI (..), URIAuth (..), parseAbsoluteURI)
 import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
-import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, printMessageStats, runSMPServer)
+import Simplex.Messaging.Server (AttachHTTP, 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.Main.Init
 import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
-import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCfg (..), stmQueueStore)
-import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
+import Simplex.Messaging.Server.MsgStore.Types (SQSType (..), SMSType (..))
 import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..))
-import Simplex.Messaging.Server.QueueStore.Postgres.Config
-import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore)
 import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
 import Simplex.Messaging.Transport.Client (TransportHost (..), defaultSocksProxy)
 import Simplex.Messaging.Transport.HTTP2 (httpALPN)
 import Simplex.Messaging.Transport.Server (ServerCredentials (..), mkTransportServerConfig)
-import Simplex.Messaging.Util (eitherToMaybe, ifM, safeDecodeUtf8)
+import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
 import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import System.Exit (exitFailure)
 import System.FilePath (combine)
@@ -98,15 +93,16 @@ import Data.Int (Int64)
 import qualified Data.Map.Strict as M
 import Data.Semigroup (Sum (..))
 import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
-import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue)
-import Simplex.Messaging.Server.MsgStore.Types (QSType (..))
-import Simplex.Messaging.Server.MsgStore.Journal (postgresQueueStore)
+import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
-import Simplex.Messaging.Server.QueueStore.Postgres (batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
+import Simplex.Messaging.Server.MsgStore.STM (STMQueue, STMStoreConfig (..))
+import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
+import Simplex.Messaging.Server.QueueStore.Postgres.Config
+import Simplex.Messaging.Server.QueueStore.Postgres (PostgresQueueStore, batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (closeStoreLog, logNewService, logCreateQueue, openWriteStoreLog)
-import Simplex.Messaging.Util (unlessM)
+import Simplex.Messaging.Util (ifM)
 import System.Directory (renameFile)
 import System.IO (IOMode (..), withFile)
 #endif
@@ -136,79 +132,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       deleteDirIfExists cfgPath
       deleteDirIfExists logPath
       putStrLn "Deleted configuration and log files"
-    Journal cmd -> withIniFile $ \ini -> do
-      msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
-      msgsFileExists <- doesFileExist storeMsgsFilePath
-      storeLogFile <- getRequiredStoreLogFile ini
-      case cmd of
-        SCImport
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | msgsDirExists -> do
-              putStrLn $ storeMsgsJournalDir <> " directory already exists."
-              exitFailure
-          | not msgsFileExists -> do
-              putStrLn $ storeMsgsFilePath <> " file does not exist."
-              exitFailure
-          | otherwise -> do
-              confirmOrExit
-                ("WARNING: message log file " <> storeMsgsFilePath <> " will be imported to journal directory " <> storeMsgsJournalDir)
-                "Messages not imported"
-              ms <- newJournalMsgStore logPath MQStoreCfg
-              readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
-              msgStats <- importMessages True ms storeMsgsFilePath Nothing False -- no expiration
-              putStrLn "Import completed"
-              printMessageStats "Messages" msgStats
-              putStrLn $ case readStoreType ini of
-                Right (ASType SQSMemory SMSMemory) -> "store_messages set to `memory`, update it to `journal` in INI file"
-                Right (ASType SQSPostgres SMSPostgres) -> "store_messages set to `database`, update it to `journal` in INI file"
-                Right (ASType _ SMSJournal) -> "store_messages set to `journal`"
-                Left e -> e <> ", configure storage correctly"
-        SCExport
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | 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"
-              case readStoreType ini of
-                Right (ASType SQSMemory msType) -> do
-                  ms <- newJournalMsgStore logPath MQStoreCfg
-                  readQueueStore True (mkQueue ms False) storeLogFile $ stmQueueStore ms
-                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
-                  putStrLn "Export completed"
-                  putStrLn $ case msType of
-                    SMSMemory -> "store_messages set to `memory`, start the server."
-                    SMSJournal -> "store_messages set to `journal`, update it to `memory` in INI file"
-#if defined(dbServerPostgres)
-                Right (ASType SQSPostgres SMSJournal) -> do
-                  let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
-                      dbOpts@DBOpts {connstr, schema} = iniDBOptions ini defaultDBOpts
-                  unlessM (checkSchemaExists connstr schema) $ do
-                    putStrLn $ "Schema " <> B.unpack schema <> " does not exist in PostrgreSQL database: " <> B.unpack connstr
-                    exitFailure
-                  ms <- newJournalMsgStore logPath $ PQStoreCfg PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
-                  exportMessages True (StoreJournal ms) storeMsgsFilePath False
-                  putStrLn "Export completed"
-                  putStrLn "store_messages set to `journal`, store_queues is set to `database`.\nExport queues to store log to use memory storage for messages (`smp-server database export`)."
-                Right (ASType SQSPostgres SMSPostgres) -> do
-                  putStrLn $ "Messages can be exported with `dabatase export --table messages`."
-                  exitFailure
-#else
-                Right (ASType SQSPostgres SMSJournal) -> noPostgresExit
-#endif
-                Left e -> putStrLn $ e <> ", configure storage correctly"
-        SCDelete
-          | 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
 #if defined(dbServerPostgres)
     Database cmd tables dbOpts@DBOpts {connstr, schema} -> withIniFile $ \ini -> do
       schemaExists <- checkSchemaExists connstr schema
@@ -221,7 +144,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: store log file " <> storeLogFile <> " and message log file " <> storeMsgsFilePath <> " will be imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                 "Store logs not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
               putStrLn $ "Imported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn "Importing messages..."
               mCnt <- importMessagesToDatabase storeMsgsFilePath dbOpts
@@ -248,11 +171,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: store log file " <> storeLogFile <> " will be compacted and imported to PostrgreSQL database: " <> B.unpack connstr <> ", schema: " <> B.unpack schema)
                 "Queue records not imported"
-              (sCnt, qCnt) <- importStoreLogToDatabase logPath storeLogFile dbOpts
+              (sCnt, qCnt) <- importStoreLogToDatabase storeLogFile dbOpts
               putStrLn $ "Import completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn $ case readStoreType ini of
-                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, import messages to journal to use PostgreSQL database for queues (`smp-server journal import`)"
-                Right (ASType SQSMemory SMSJournal) -> setToDbStr
+                Right (ASType SQSMemory SMSMemory) -> setToDbStr <> "\nstore_messages set to `memory`, update it to `database` and import messages (`smp-server database import --table messages`)"
                 Right (ASType SQSPostgres _) -> "store_queues set to `database`, start the server."
                 Left e -> e <> ", configure storage correctly"
           where
@@ -280,7 +202,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath <> " and to message log file " <> storeMsgsFilePath)
                 "Database store not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
               putStrLn $ "Exported: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn "Exporting messages..."
               let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
@@ -306,7 +228,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               confirmOrExit
                 ("WARNING: PostrgreSQL schema " <> B.unpack schema <> " (database: " <> B.unpack connstr <> ") will be exported to store log file " <> storeLogFilePath)
                 "Queue records not exported"
-              (sCnt, qCnt) <- exportDatabaseToStoreLog logPath dbOpts storeLogFilePath
+              (sCnt, qCnt) <- exportDatabaseToStoreLog dbOpts storeLogFilePath
               putStrLn $ "Export completed: " <> show sCnt <> " services, " <> show qCnt <> " queues"
               putStrLn $ case readStoreType ini of
                 Right (ASType SQSPostgres _) -> "store_queues or store_messages set to `database`, update it to `memory` in INI file."
@@ -346,6 +268,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`."
+#if defined(dbServerPostgres)
     getRequiredStoreLogFile ini = do
       case enableStoreLog' ini $> storeLogFilePath of
         Just storeLogFile -> do
@@ -354,6 +277,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
             (pure storeLogFile)
             (putStrLn ("Store log file " <> storeLogFile <> " not found") >> exitFailure)
         Nothing -> putStrLn "Store log disabled, see `[STORE_LOG] enable`" >> exitFailure
+#endif
     iniFile = combine cfgPath "smp-server.ini"
     serverVersion = "SMP server v" <> simplexmqVersionCommit
     executableName = "smp-server"
@@ -364,10 +288,10 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
     readStoreType :: Ini -> Either String AStoreType
     readStoreType ini = case (iniStoreQueues, iniStoreMessage) of
       ("memory", "memory") -> Right $ ASType SQSMemory SMSMemory
-      ("memory", "journal") -> Right $ ASType SQSMemory SMSJournal
+      ("memory", "journal") -> Left journalRemovedStr
       ("memory", "database") -> Left "Database and memory storage are not compatible."
       ("database", "memory") -> Left "Database and memory storage are not compatible."
-      ("database", "journal") -> Right $ ASType SQSPostgres SMSJournal
+      ("database", "journal") -> Left journalRemovedStr
 #if defined(dbServerPostgres)
       ("database", "database") -> Right $ ASType SQSPostgres SMSPostgres
 #else
@@ -377,10 +301,12 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       where
         iniStoreQueues = fromRight "memory" $ lookupValue "STORE_LOG" "store_queues" ini
         iniStoreMessage = fromRight "memory" $ lookupValue "STORE_LOG" "store_messages" ini
+#if defined(dbServerPostgres)
     iniDeletedTTL ini = readIniDefault (86400 * defaultDeletedTTL) "STORE_LOG" "db_deleted_ttl" ini
+    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
+#endif
     defaultStaticPath = combine logPath "www"
     enableStoreLog' = settingIsOn "STORE_LOG" "enable"
-    enableDbStoreLog' = settingIsOn "STORE_LOG" "db_store_log"
     initializeServer opts
       | scripted opts = initialize opts
       | otherwise = do
@@ -517,16 +443,13 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
         iniStoreType = either error id $! readStoreType ini
         iniStoreCfg :: SupportedStore qs ms => SQSType qs -> SMSType ms -> ServerStoreCfg (MsgStoreType qs ms)
         iniStoreCfg SQSMemory SMSMemory = SSCMemory $ enableStoreLog' ini $> StorePaths {storeLogFile = storeLogFilePath, storeMsgsFile = restoreMessagesFile storeMsgsFilePath}
-        iniStoreCfg SQSMemory SMSJournal = SSCMemoryJournal {storeLogFile = storeLogFilePath, storeMsgsPath = storeMsgsJournalDir}
-        iniStoreCfg SQSPostgres SMSJournal =
-          let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
-              storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
-           in SSCDatabaseJournal {storeCfg, storeMsgsPath' = storeMsgsJournalDir}
 #if defined(dbServerPostgres)
         iniStoreCfg SQSPostgres SMSPostgres =
           let dbStoreLogPath = enableDbStoreLog' ini $> storeLogFilePath
               storeCfg = PostgresStoreCfg {dbOpts = iniDBOptions ini defaultDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = iniDeletedTTL ini}
            in SSCDatabase storeCfg
+#else
+        iniStoreCfg SQSPostgres _ = error noPostgresExitStr
 #endif
         serverConfig :: ServerStoreCfg s -> ServerConfig s
         serverConfig serverStoreCfg =
@@ -535,8 +458,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               smpHandshakeTimeout = 120000000,
               tbqSize = 128,
               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 =
@@ -561,7 +482,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
                     },
               expireMessagesOnStart = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_start" ini,
               expireMessagesOnSend = fromMaybe True $ iniOnOff "STORE_LOG" "expire_messages_on_send" ini,
-              idleQueueInterval = defaultIdleQueueInterval,
               notificationExpiration =
                 defaultNtfExpiration
                   { ttl = 3600 * readIniDefault defNtfExpirationHours "STORE_LOG" "expire_ntfs_hours" ini
@@ -639,7 +559,6 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
     checkMsgStoreMode ini mode = do
       msgsDirExists <- doesDirectoryExist storeMsgsJournalDir
       msgsFileExists <- doesFileExist storeMsgsFilePath
-      storeLogExists <- doesFileExist storeLogFilePath
       case mode of
 #if defined(dbServerPostgres)
         ASType SQSPostgres SMSPostgres
@@ -647,35 +566,22 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
               putStrLn $ "Error: " <> storeMsgsFilePath <> " file or " <> storeMsgsJournalDir <> " directory are present."
               putStrLn "Configure memory storage."
               exitFailure
-          | otherwise -> checkDbStorage ini storeLogExists
-#endif
-        ASType qs SMSJournal
-          | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
-          | 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."
-          | otherwise -> case qs of
-              SQSMemory ->
-                unless (storeLogExists) $ putStrLn $ "store_queues is `memory`, " <> storeLogFilePath <> " file will be created."
-#if defined(dbServerPostgres)
-              SQSPostgres -> checkDbStorage ini storeLogExists
+          | otherwise -> checkDbStorage ini =<< doesFileExist storeLogFilePath
 #else
-              SQSPostgres -> noPostgresExit
+        ASType SQSPostgres _ -> noPostgresExit
 #endif
         ASType SQSMemory SMSMemory
           | msgsFileExists && msgsDirExists -> exitConfigureMsgStorage
           | 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."
+              putStrLn journalRemovedStr
               exitFailure
           | otherwise -> pure ()
 
+    exitConfigureMsgStorage :: IO ()
     exitConfigureMsgStorage = do
       putStrLn $ "Error: both " <> storeMsgsFilePath <> " file and " <> storeMsgsJournalDir <> " directory are present."
-      putStrLn "Configure memory storage."
+      putStrLn journalRemovedStr
       exitFailure
 
 #if defined(dbServerPostgres)
@@ -707,19 +613,19 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
       putStrLn "Configure queue storage."
       exitFailure
 
-importStoreLogToDatabase :: FilePath -> FilePath -> DBOpts -> IO (Int64, Int64)
-importStoreLogToDatabase logPath storeLogFile dbOpts = do
-  ms <- newJournalMsgStore logPath MQStoreCfg
-  let st = stmQueueStore ms
+importStoreLogToDatabase :: FilePath -> DBOpts -> IO (Int64, Int64)
+importStoreLogToDatabase storeLogFile dbOpts = do
+  ms <- newMsgStore STMStoreConfig {storePath = Nothing, quota = defaultMsgQueueQuota}
+  let st = queueStore ms
   sl <- readWriteQueueStore True (mkQueue ms False) storeLogFile st
   closeStoreLog sl
   queues <- readTVarIO $ loadedQueues st
   services' <- M.elems <$> readTVarIO (services st)
   let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
-  sCnt <- batchInsertServices services' $ postgresQueueStore ps
-  qCnt <- batchInsertQueues @(JournalQueue 'QSMemory) True queues $ postgresQueueStore ps
-  closeMsgStore ps
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
+  sCnt <- batchInsertServices services' ps
+  qCnt <- batchInsertQueues @STMQueue True queues ps
+  closeQueueStore @PostgresQueue ps
   renameFile storeLogFile $ storeLogFile <> ".bak"
   pure (sCnt, qCnt)
 
@@ -738,22 +644,23 @@ importMessagesToDatabase msgsLogFile dbOpts = do
   renameFile msgsLogFile $ msgsLogFile <> ".bak"
   pure mCnt'
 
-exportDatabaseToStoreLog :: FilePath -> DBOpts -> FilePath -> IO (Int, Int)
-exportDatabaseToStoreLog logPath dbOpts storeLogFilePath = do
+exportDatabaseToStoreLog :: DBOpts -> FilePath -> IO (Int, Int)
+exportDatabaseToStoreLog dbOpts storeLogFilePath = do
   let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps <- newJournalMsgStore logPath $ PQStoreCfg storeCfg
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
   sl <- openWriteStoreLog False storeLogFilePath
-  Sum sCnt <- foldServiceRecs (postgresQueueStore ps) $ \sr -> logNewService sl sr $> Sum (1 :: Int)
-  Sum qCnt <- foldQueueRecs True True (postgresQueueStore ps) $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
+  Sum sCnt <- foldServiceRecs ps $ \sr -> logNewService sl sr $> Sum (1 :: Int)
+  Sum qCnt <- foldQueueRecs True True ps $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
   closeStoreLog sl
-  closeMsgStore ps
+  closeQueueStore @PostgresQueue ps
   pure (sCnt, qCnt)
 #endif
 
-newJournalMsgStore :: FilePath -> QStoreCfg s -> IO (JournalMsgStore s)
-newJournalMsgStore logPath qsCfg =
-  let cfg = mkJournalStoreConfig qsCfg (storeMsgsJournalDir' logPath) defaultMsgQueueQuota defaultMaxJournalMsgCount defaultMaxJournalStateLines $ checkInterval defaultMessageExpiration
-   in newMsgStore cfg
+journalRemovedStr :: String
+journalRemovedStr =
+  "Journal message storage is removed.\n"
+    <> "Export messages with `smp-server journal export` using smp-server v7.1.0.11 or earlier,\n"
+    <> "then set store_messages to `memory`, or to `database` and run `smp-server database import --table messages`."
 
 storeMsgsJournalDir' :: FilePath -> FilePath
 storeMsgsJournalDir' logPath = combine logPath "messages"
@@ -877,7 +784,6 @@ data CliCommand
   | OnlineCert CertOptions
   | Start StartOptions
   | Delete
-  | Journal StoreCmd
   | Database StoreCmd DatabaseTable DBOpts
 
 data StoreCmd = SCImport | SCExport | SCDelete
@@ -903,7 +809,6 @@ cliCommandP cfgPath logPath iniFile =
         <> command "cert" (info (OnlineCert <$> certOptionsP) (progDesc $ "Generate new online TLS server credentials (configuration: " <> iniFile <> ")"))
         <> command "start" (info (Start <$> startOptionsP) (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"))
         <> command "database" (info (Database <$> databaseCmdP <*> dbTableP <*> dbOptsP defaultDBOpts) (progDesc "Import/export queues to/from PostgreSQL database storage"))
     )
   where
@@ -1050,7 +955,6 @@ cliCommandP cfgPath logPath iniFile =
             disableWeb,
             scripted
           }
-    journalCmdP = storeCmdP "message log file" "journal storage"
     databaseCmdP = storeCmdP "queue store log file" "PostgreSQL database schema"
     storeCmdP src dest =
       hsubparser
diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs
index d2938821c..a0015b0cf 100644
--- a/src/Simplex/Messaging/Server/Main/Init.hs
+++ b/src/Simplex/Messaging/Server/Main/Init.hs
@@ -83,7 +83,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
     <> ("enable = " <> onOff enableStoreLog <> "\n\n")
     <> "# Queue storage mode: `memory` or `database` (to store queue records in PostgreSQL database).\n\
         \# `memory` - in-memory persistence, with optional append-only log (`enable = on`).\n\
-        \# `database`- PostgreSQL databass (requires `store_messages = journal`).\n\
+        \# `database`- PostgreSQL databass (requires `store_messages = database`).\n\
         \store_queues = memory\n\n\
         \# Database connection settings for PostgreSQL database (`store_queues = database`).\n"
     <> iniDbOpts dbOptions defaultDBOpts
@@ -91,7 +91,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
         \# db_store_log = off\n\n\
         \# Time to retain deleted queues in the database, days.\n"
     <> ("# db_deleted_ttl = " <> tshow defaultDeletedTTL <> "\n\n")
-    <> "# Message storage mode: `memory` or `journal`.\n\
+    <> "# Message storage mode: `memory` or `database` (requires `store_queues = database`).\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"
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal.hs b/src/Simplex/Messaging/Server/MsgStore/Journal.hs
deleted file mode 100644
index 185c113b7..000000000
--- a/src/Simplex/Messaging/Server/MsgStore/Journal.hs
+++ /dev/null
@@ -1,1085 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TupleSections #-}
-
-module Simplex.Messaging.Server.MsgStore.Journal
-  ( JournalMsgStore (random, expireBackupsBefore),
-    QStore (..),
-    QStoreCfg (..),
-    JournalQueue (msgQueue'), -- msgQueue' is used in tests
-    JournalMsgQueue (queue, state),
-    JMQueue (queueDirectory, statePath),
-    JournalStoreConfig (..),
-    closeMsgQueue,
-    closeMsgQueueHandles,
-    -- below are exported for tests
-    MsgQueueState (..),
-    JournalState (..),
-    SJournalType (..),
-    msgQueueDirectory,
-    msgQueueStatePath,
-    readQueueState,
-    newMsgQueueState,
-    getJournalQueueMessages,
-    newJournalId,
-    appendState,
-    queueLogFileName,
-    journalFilePath,
-    logFileExt,
-    stmQueueStore,
-#if defined(dbServerPostgres)
-    postgresQueueStore,
-#endif
-  )
-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 Data.Either (fromRight, partitionEithers)
-import Data.Functor (($>))
-import Data.Int (Int64)
-import Data.List (sort)
-import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Text.Encoding (decodeLatin1)
-import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
-import Data.Time.Format.ISO8601 (iso8601Show, iso8601ParseM)
-import GHC.IO (catchAny)
-import Simplex.Messaging.Agent.Client (getMapLock)
-import Simplex.Messaging.Agent.Lock
-import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server.MsgStore.Journal.SharedLock
-import Simplex.Messaging.Server.MsgStore.Types
-import Simplex.Messaging.Server.QueueStore
-#if defined(dbServerPostgres)
-import Simplex.Messaging.Server.QueueStore.Postgres
-#endif
-import Simplex.Messaging.Server.QueueStore.STM
-import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.SystemTime
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM, tshow, whenM, ($>>=), (<$$>))
-import System.Directory
-import System.FilePath (takeFileName, (</>))
-import System.IO (BufferMode (..), Handle, IOMode (..), SeekMode (..))
-import qualified System.IO as IO
-import System.Random (StdGen, genByteString, newStdGen)
-
-data JournalMsgStore s = JournalMsgStore
-  { config :: JournalStoreConfig s,
-    random :: TVar StdGen,
-    queueLocks :: TMap RecipientId Lock,
-    sharedLock :: TMVar RecipientId,
-    queueStore_ :: QStore s,
-    openedQueueCount :: TVar Int,
-    expireBackupsBefore :: UTCTime
-  }
-
-data QStore (s :: QSType) where
-  MQStore :: QStoreType 'QSMemory -> QStore 'QSMemory
-#if defined(dbServerPostgres)
-  PQStore :: QStoreType 'QSPostgres -> QStore 'QSPostgres
-#endif
-
-type family QStoreType s where
-  QStoreType 'QSMemory = STMQueueStore (JournalQueue 'QSMemory)
-#if defined(dbServerPostgres)
-  QStoreType 'QSPostgres = PostgresQueueStore (JournalQueue 'QSPostgres)
-#endif
-
-withQS :: (QueueStoreClass (JournalQueue s) (QStoreType s) => QStoreType s -> r) -> QStore s -> r
-withQS f = \case
-  MQStore st -> f st
-#if defined(dbServerPostgres)
-  PQStore st -> f st
-#endif
-{-# INLINE withQS #-}
-
-stmQueueStore :: JournalMsgStore 'QSMemory -> STMQueueStore (JournalQueue 'QSMemory)
-stmQueueStore st = case queueStore_ st of
-  MQStore st' -> st'
-
-#if defined(dbServerPostgres)
-postgresQueueStore :: JournalMsgStore 'QSPostgres -> PostgresQueueStore (JournalQueue 'QSPostgres)
-postgresQueueStore st = case queueStore_ st of
-  PQStore st' -> st'
-#endif
-
-data JournalStoreConfig s = JournalStoreConfig
-  { storePath :: FilePath,
-    pathParts :: Int,
-    queueStoreCfg :: QStoreCfg s,
-    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,
-    stateTailSize :: Int,
-    -- time in seconds after which the queue will be closed after message expiration
-    idleInterval :: Int64,
-    -- expire state backup files
-    expireBackupsAfter :: NominalDiffTime,
-    keepMinBackups :: Int
-  }
-
-data QStoreCfg s where
-  MQStoreCfg :: QStoreCfg 'QSMemory
-#if defined(dbServerPostgres)
-  PQStoreCfg :: PostgresStoreCfg -> QStoreCfg 'QSPostgres
-#endif
-
-data JournalQueue (s :: QSType) = JournalQueue
-  { recipientId' :: RecipientId,
-    queueLock :: Lock,
-    sharedLock :: TMVar RecipientId,
-    -- 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 s)),
-    -- system time in seconds since epoch
-    activeAt :: TVar Int64,
-    queueState :: TVar (Maybe QState) -- Nothing - unknown
-  }
-
-data QState = QState
-  { hasPending :: Bool,
-    hasStored :: Bool
-  }
-
-data JMQueue = JMQueue
-  { queueDirectory :: FilePath,
-    statePath :: FilePath
-  }
-
-data JournalMsgQueue (s :: QSType) = 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, Int64))),
-    handles :: TVar (Maybe MsgQueueHandles)
-  }
-
-data MsgQueueState = MsgQueueState
-  { readState :: JournalState 'JTRead,
-    writeState :: JournalState 'JTWrite,
-    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 t = JournalState
-  { journalType :: SJournalType t,
-    journalId :: ByteString,
-    msgPos :: Int,
-    msgCount :: Int,
-    bytePos :: Int64,
-    byteCount :: Int64
-  }
-  deriving (Show)
-
-qState :: MsgQueueState -> QState
-qState MsgQueueState {size, readState = rs, writeState = ws} =
-  let hasPending = size > 0
-   in QState {hasPending, hasStored = hasPending || msgCount rs > 0 || msgCount ws > 0}
-{-# INLINE qState #-}
-
-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 =
-  MsgQueueState
-    { writeState = newJournalState journalId,
-      readState = newJournalState journalId,
-      canWrite = True,
-      size = 0
-    }
-
-newJournalState :: JournalTypeI t => ByteString -> JournalState t
-newJournalState journalId = JournalState sJournalType journalId 0 0 0 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 JournalTypeI t => StrEncoding (JournalState t) where
-  strEncode JournalState {journalId, 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 (== ',')
-    JournalState sJournalType journalId <$> i <*> i <*> i <*> i
-    where
-      i :: Integral a => A.Parser a
-      i = A.char ',' *> A.decimal
-
-queueLogFileName :: String
-queueLogFileName = "queue_state"
-
-msgLogFileName :: String
-msgLogFileName = "messages"
-
-logFileExt :: String
-logFileExt = ".log"
-
-newtype StoreIO (s :: QSType) a = StoreIO {unStoreIO :: IO a}
-  deriving newtype (Functor, Applicative, Monad)
-
-instance StoreQueueClass (JournalQueue s) where
-  recipientId = recipientId'
-  {-# INLINE recipientId #-}
-  queueRec = queueRec'
-  {-# INLINE queueRec #-}
-  withQueueLock :: JournalQueue s -> Text -> IO a -> IO a
-  withQueueLock JournalQueue {recipientId', queueLock, sharedLock} =
-    withLockWaitShared recipientId' queueLock sharedLock
-  {-# INLINE withQueueLock #-}
-
-instance QueueStoreClass (JournalQueue s) (QStore s) where
-  type QueueStoreCfg (QStore s) = QStoreCfg s
-
-  newQueueStore :: QStoreCfg s -> IO (QStore s)
-  newQueueStore = \case
-    MQStoreCfg -> MQStore <$> newQueueStore @(JournalQueue s) ()
-#if defined(dbServerPostgres)
-    PQStoreCfg cfg -> PQStore <$> newQueueStore @(JournalQueue s) (cfg, True)
-#endif
-
-  closeQueueStore = withQS (closeQueueStore @(JournalQueue s))
-  {-# INLINE closeQueueStore #-}
-  loadedQueues = withQS loadedQueues
-  {-# INLINE loadedQueues #-}
-  compactQueues = withQS (compactQueues @(JournalQueue s))
-  {-# INLINE compactQueues #-}
-  getEntityCounts = withQS (getEntityCounts @(JournalQueue s))
-  {-# INLINE getEntityCounts #-}
-  addQueue_ = withQS addQueue_
-  {-# INLINE addQueue_ #-}
-  getQueue_ = withQS getQueue_
-  {-# INLINE getQueue_ #-}
-  getQueues_ = withQS getQueues_
-  {-# INLINE getQueues_ #-}
-  addQueueLinkData = withQS addQueueLinkData
-  {-# INLINE addQueueLinkData #-}
-  getQueueLinkData = withQS getQueueLinkData
-  {-# INLINE getQueueLinkData #-}
-  deleteQueueLinkData = withQS deleteQueueLinkData
-  {-# INLINE deleteQueueLinkData #-}
-  secureQueue = withQS secureQueue
-  {-# INLINE secureQueue #-}
-  updateKeys = withQS updateKeys
-  {-# INLINE updateKeys #-}
-  addQueueNotifier = withQS addQueueNotifier
-  {-# INLINE addQueueNotifier #-}
-  deleteQueueNotifier = withQS deleteQueueNotifier
-  {-# INLINE deleteQueueNotifier #-}
-  suspendQueue = withQS suspendQueue
-  {-# INLINE suspendQueue #-}
-  blockQueue = withQS blockQueue
-  {-# INLINE blockQueue #-}
-  unblockQueue = withQS unblockQueue
-  {-# INLINE unblockQueue #-}
-  updateQueueTime = withQS updateQueueTime
-  {-# INLINE updateQueueTime #-}
-  deleteStoreQueue = withQS deleteStoreQueue
-  {-# INLINE deleteStoreQueue #-}
-  getCreateService = withQS (getCreateService @(JournalQueue s))
-  {-# INLINE getCreateService #-}
-  setQueueService = withQS setQueueService
-  {-# INLINE setQueueService #-}
-  setQueueServices = withQS setQueueServices
-  {-# INLINE setQueueServices #-}
-  getQueueNtfServices = withQS (getQueueNtfServices @(JournalQueue s))
-  {-# INLINE getQueueNtfServices #-}
-  getServiceQueueCountHash = withQS (getServiceQueueCountHash @(JournalQueue s))
-  {-# INLINE getServiceQueueCountHash #-}
-
-makeQueue_ :: JournalMsgStore s -> RecipientId -> QueueRec -> Lock -> IO (JournalQueue s)
-makeQueue_ JournalMsgStore {sharedLock} rId qr queueLock = do
-  queueRec' <- newTVarIO $ Just qr
-  msgQueue' <- newTVarIO Nothing
-  activeAt <- newTVarIO 0
-  queueState <- newTVarIO Nothing
-  pure $
-    JournalQueue
-      { recipientId' = rId,
-        queueLock,
-        sharedLock,
-        queueRec',
-        msgQueue',
-        activeAt,
-        queueState
-      }
-
-instance MsgStoreClass (JournalMsgStore s) where
-  type StoreMonad (JournalMsgStore s) = StoreIO s
-  type MsgQueue (JournalMsgStore s) = JournalMsgQueue s
-  type QueueStore (JournalMsgStore s) = QStore s
-  type StoreQueue (JournalMsgStore s) = JournalQueue s
-  type MsgStoreConfig (JournalMsgStore s) = JournalStoreConfig s
-
-  newMsgStore :: JournalStoreConfig s -> IO (JournalMsgStore s)
-  newMsgStore config@JournalStoreConfig {queueStoreCfg} = do
-    random <- newTVarIO =<< newStdGen
-    queueLocks <- TM.emptyIO
-    sharedLock <- newEmptyTMVarIO
-    queueStore_ <- newQueueStore @(JournalQueue s) queueStoreCfg
-    openedQueueCount <- newTVarIO 0
-    expireBackupsBefore <- addUTCTime (- expireBackupsAfter config) <$> getCurrentTime
-    pure JournalMsgStore {config, random, queueLocks, sharedLock, queueStore_, openedQueueCount, expireBackupsBefore}
-
-  closeMsgStore :: JournalMsgStore s -> IO ()
-  closeMsgStore ms = do
-    let st = queueStore_ ms
-    closeQueues $ loadedQueues @(JournalQueue s) st
-    closeQueueStore @(JournalQueue s) st
-    where
-      closeQueues qs = readTVarIO qs >>= mapM_ (closeMsgQueue ms)
-
-  withActiveMsgQueues :: Monoid a => JournalMsgStore s -> (JournalQueue s -> IO a) -> IO a
-  withActiveMsgQueues = withQS withLoadedQueues . queueStore_
-
-  -- This function can only be used in server CLI commands or before server is started.
-  -- It does not cache queues and is NOT concurrency safe.
-  unsafeWithAllMsgQueues :: Monoid a => Bool -> JournalMsgStore s -> (JournalQueue s -> IO a) -> IO a
-  unsafeWithAllMsgQueues tty ms action = case queueStore_ ms of
-    MQStore st -> withLoadedQueues st run
-#if defined(dbServerPostgres)
-    PQStore st -> foldQueueRecs False tty st $ uncurry (mkQueue ms False) >=> run
-#endif
-    where
-      run q = do
-        r <- action q
-        closeMsgQueue ms q
-        pure r
-
-  -- This function is concurrency safe
-  expireOldMessages :: Bool -> JournalMsgStore s -> Int64 -> Int64 -> IO MessageStats
-  expireOldMessages tty ms now ttl = case queueStore_ ms of
-    MQStore st ->
-      withLoadedQueues st $ \q -> run $ isolateQueue ms q "deleteExpiredMsgs" $ do
-        StoreIO (readTVarIO $ queueRec q) >>= \case
-          Just QueueRec {updatedAt = Just (RoundedSystemTime t)} | t > veryOld ->
-            expireQueueMsgs ms now old q
-          _ -> pure newMessageStats
-#if defined(dbServerPostgres)
-    PQStore st -> do
-      let JournalMsgStore {queueLocks, sharedLock} = ms
-      foldRecentQueueRecs veryOld tty st $ \(rId, qr) -> do
-        q <- mkQueue ms False rId qr
-        withSharedWaitLock rId queueLocks sharedLock $ run $ tryStore' "deleteExpiredMsgs" rId $
-          getLoadedQueue q >>= unStoreIO . expireQueueMsgs ms now old
-#endif
-    where
-      old = now - ttl
-      veryOld = now - 2 * ttl - 86400
-      run :: ExceptT ErrorType IO MessageStats -> IO MessageStats
-      run = fmap (fromRight newMessageStats) . runExceptT
-      -- Use cached queue if available.
-      -- Also see the comment in loadQueue in PostgresQueueStore
-      getLoadedQueue :: JournalQueue s -> IO (JournalQueue s)
-      getLoadedQueue q = fromMaybe q <$> TM.lookupIO (recipientId q) (loadedQueues $ queueStore_ ms)
-
-  foldRcvServiceMessages :: JournalMsgStore s -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
-  foldRcvServiceMessages ms serviceId f acc = case queueStore_ ms of
-    MQStore st -> fmap Right $ foldRcvServiceQueues st serviceId f' acc
-      where
-        f' a (q, qr) = runExceptT (tryPeekMsg ms q) >>= f a (recipientId q) . ((qr,) <$$>)
-#if defined(dbServerPostgres)
-    PQStore st -> foldRcvServiceQueueRecs st serviceId f' acc
-      where
-        JournalMsgStore {queueLocks, sharedLock} = ms
-        f' a (rId, qr) = do
-          q <- mkQueue ms False rId qr
-          qMsg_ <-
-            withSharedWaitLock rId queueLocks sharedLock $ runExceptT $ tryStore' "foldRcvServiceMessages" rId $
-              (qr,) . snd <$$> (getLoadedQueue q >>= unStoreIO . getPeekMsgQueue ms)
-          f a rId qMsg_
-        -- Use cached queue if available.
-        -- Also see the comment in loadQueue in PostgresQueueStore
-        getLoadedQueue q = fromMaybe q <$> TM.lookupIO (recipientId q) (loadedQueues $ queueStore_ ms)
-#endif
-
-  logQueueStates :: JournalMsgStore s -> IO ()
-  logQueueStates ms = withActiveMsgQueues ms $ unStoreIO . logQueueState
-
-  logQueueState :: JournalQueue s -> StoreIO s ()
-  logQueueState q =
-    StoreIO . void $
-      readTVarIO (msgQueue' q)
-        $>>= \mq -> readTVarIO (handles mq)
-        $>>= (\hs -> (readTVarIO (state mq) >>= appendState (stateHandle hs)) $> Just ())
-
-  queueStore = queueStore_
-  {-# INLINE queueStore #-}
-
-  loadedQueueCounts :: JournalMsgStore s -> IO LoadedQueueCounts
-  loadedQueueCounts ms = do
-    let (qs, ns, nLocks_) = loaded
-    loadedQueueCount <- M.size <$> readTVarIO qs
-    loadedNotifierCount <- M.size <$> readTVarIO ns
-    openJournalCount <- readTVarIO (openedQueueCount ms)
-    queueLockCount <- M.size <$> readTVarIO (queueLocks ms)
-    notifierLockCount <- maybe (pure 0) (fmap M.size . readTVarIO) nLocks_
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount, queueLockCount, notifierLockCount}
-    where
-      loaded :: (TMap RecipientId (JournalQueue s), TMap NotifierId RecipientId, Maybe (TMap NotifierId Lock))
-      loaded = case queueStore_ ms of
-        MQStore STMQueueStore {queues, notifiers} -> (queues, notifiers, Nothing)
-#if defined(dbServerPostgres)
-        PQStore PostgresQueueStore {queues, notifiers, notifierLocks} -> (queues, notifiers, Just notifierLocks)
-#endif
-
-  mkQueue :: JournalMsgStore s -> Bool -> RecipientId -> QueueRec -> IO (JournalQueue s)
-  mkQueue ms keepLock rId qr = do
-    lock <- if keepLock then atomically $ getMapLock (queueLocks ms) rId else createLockIO
-    makeQueue_ ms rId qr lock
-
-  getMsgQueue :: JournalMsgStore s -> JournalQueue s -> Bool -> StoreIO s (JournalMsgQueue s)
-  getMsgQueue ms@JournalMsgStore {random} q'@JournalQueue {recipientId' = rId, msgQueue'} forWrite =
-    StoreIO $ readTVarIO msgQueue' >>= maybe newQ pure
-    where
-      newQ = do
-        let dir = msgQueueDirectory ms rId
-            statePath = msgQueueStatePath dir rId
-            queue = JMQueue {queueDirectory = dir, statePath}
-        q <- ifM (doesDirectoryExist dir) (openMsgQueue ms queue forWrite) (createQ queue)
-        atomically $ writeTVar msgQueue' $ Just q
-        st <- readTVarIO $ state q
-        atomically $ writeTVar (queueState q') $ Just $! qState st
-        pure q
-        where
-          createQ :: JMQueue -> IO (JournalMsgQueue s)
-          createQ queue = do
-            -- 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
-
-  getPeekMsgQueue :: JournalMsgStore s -> JournalQueue s -> StoreIO s (Maybe (JournalMsgQueue s, Message))
-  getPeekMsgQueue ms q@JournalQueue {queueState} =
-    StoreIO (readTVarIO queueState) >>= \case
-      Just QState {hasPending} -> if hasPending then peek else pure Nothing
-      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 ms q
-        pure r
-    where
-      peek = do
-        mq <- getMsgQueue ms q False
-        (mq,) <$$> tryPeekMsg_ q mq
-
-  -- only runs action if queue is not empty
-  withIdleMsgQueue :: Int64 -> JournalMsgStore s -> JournalQueue s -> (JournalMsgQueue s -> StoreIO s a) -> StoreIO s (Maybe a, Int)
-  withIdleMsgQueue now ms@JournalMsgStore {config} q@JournalQueue {queueState} action =
-    StoreIO $ readTVarIO (msgQueue' q) >>= \case
-      Nothing ->
-        E.bracket
-          getNonEmptyMsgQueue
-          (mapM_ $ \_ -> closeMsgQueue ms 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
-          then Just <$> unStoreIO (action mq) `E.finally` closeMsgQueue ms q
-          else pure Nothing
-        sz <- unStoreIO $ getQueueSize_ mq
-        pure (r, sz)
-    where
-      getNonEmptyMsgQueue :: IO (Maybe (JournalMsgQueue s))
-      getNonEmptyMsgQueue =
-        readTVarIO queueState >>= \case
-          Just QState {hasStored}
-            | hasStored -> Just <$> unStoreIO (getMsgQueue ms q False)
-            | otherwise -> pure Nothing
-          Nothing -> do
-            mq <- unStoreIO $ getMsgQueue ms q False
-            -- queueState was updated in getMsgQueue
-            readTVarIO queueState >>= \case
-              Just QState {hasStored} | not hasStored -> closeMsgQueue ms q $> Nothing
-              _ -> pure $ Just mq
-
-  deleteQueue :: JournalMsgStore s -> JournalQueue s -> IO (Either ErrorType QueueRec)
-  deleteQueue ms q = fst <$$> deleteQueue_ ms q
-
-  deleteQueueSize :: JournalMsgStore s -> JournalQueue s -> IO (Either ErrorType (QueueRec, Int))
-  deleteQueueSize ms q =
-    deleteQueue_ ms q >>= mapM (traverse getSize)
-    -- traverse operates on the second tuple element
-    where
-      getSize = maybe (pure (-1)) (fmap size . readTVarIO . state)
-
-   -- drainMsgs is never True with Journal storage
-  getQueueMessages_ :: Bool -> JournalQueue s -> JournalMsgQueue s -> StoreIO s [Message]
-  getQueueMessages_ drainMsgs q' q = StoreIO $ if drainMsgs then run [] else readTVarIO (state q) >>= runFast
-    where
-      run msgs = readTVarIO (handles q) >>= maybe (pure []) (getMsg msgs)
-      getMsg msgs hs = chooseReadJournal q' q drainMsgs hs >>= maybe (pure msgs) readMsg
-        where
-          readMsg (rs, h) = do
-            (msg, len) <- hGetMsgAt h $ bytePos rs
-            updateReadPos q' q drainMsgs len hs
-            (msg :) <$> run msgs
-      runFast MsgQueueState {writeState = ws, readState = rs, size}
-        | size > 0 =
-            readTVarIO (handles q) >>= \case
-              Just (MsgQueueHandles _ rh wh_) -> do
-                msgs <- getJournalRange rh (bytePos rs) (byteCount rs)
-                case wh_ of
-                  Just wh -> (msgs ++) <$> getJournalRange wh 0 (bytePos ws)
-                  Nothing -> pure msgs
-              Nothing -> pure []
-        | otherwise = pure []
-
-  writeMsg :: JournalMsgStore s -> JournalQueue s -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
-  writeMsg ms q' logState msg = isolateQueue ms q' "writeMsg" $ do
-    q <- getMsgQueue ms q' True
-    StoreIO $ (`E.finally` updateActiveAt q') $ 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 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 = 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
-        (ws, wh) <- case writeHandle hs of
-          Nothing | msgCount writeState >= maxMsgCount -> switchWriteJournal hs
-          wh_ -> pure (writeState, fromMaybe (readHandle hs) wh_)
-        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}
-        hAppend wh (bytePos ws) msgStr
-        updateQueueState q' 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
-            rh <- createNewJournal queueDirectory $ journalId rs
-            let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = Nothing}
-            atomically $ writeTVar handles $ Just hs
-            atomically $ modifyTVar' (openedQueueCount ms) (+ 1)
-            pure hs
-          switchWriteJournal hs = do
-            journalId <- newJournalId $ random ms
-            wh <- createNewJournal queueDirectory journalId
-            atomically $ writeTVar handles $ Just $ hs {writeHandle = Just wh}
-            pure (newJournalState journalId, wh)
-
-  -- can ONLY be used while restoring messages, not while server running
-  setOverQuota_ :: JournalQueue s -> IO ()
-  setOverQuota_ q =
-    readTVarIO (msgQueue' q)
-      >>= mapM_ (\JournalMsgQueue {state} -> atomically $ modifyTVar' state $ \st -> st {canWrite = False})
-
-  getQueueSize_ :: JournalMsgQueue s -> StoreIO s Int
-  getQueueSize_ JournalMsgQueue {state} = StoreIO $ size <$> readTVarIO state
-
-  tryPeekMsg_ :: JournalQueue s -> JournalMsgQueue s -> StoreIO s (Maybe Message)
-  tryPeekMsg_ q mq@JournalMsgQueue {tipMsg, handles} =
-    StoreIO $ (readTVarIO handles $>>= chooseReadJournal q mq True $>>= peekMsg)
-    where
-      peekMsg (rs, h) = readTVarIO tipMsg >>= maybe readMsg (pure . fmap fst)
-        where
-          readMsg = do
-            ml@(msg, _) <- hGetMsgAt h $ bytePos rs
-            atomically $ writeTVar tipMsg $ Just (Just ml)
-            pure $ Just msg
-
-  tryDeleteMsg_ :: JournalQueue s -> JournalMsgQueue s -> Bool -> StoreIO s ()
-  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 mq logState len hs $> Just ()
-
-  isolateQueue :: JournalMsgStore s -> JournalQueue s -> Text -> StoreIO s a -> ExceptT ErrorType IO a
-  isolateQueue _ sq op = tryStore' op (recipientId' sq) . withQueueLock sq op . unStoreIO
-
-  unsafeRunStore :: JournalQueue s -> Text -> StoreIO s a -> IO a
-  unsafeRunStore sq op a =
-    unStoreIO a `E.catch` \e -> storeError op (recipientId' sq) e >> E.throwIO e
-
-updateActiveAt :: JournalQueue s -> IO ()
-updateActiveAt q = atomically . writeTVar (activeAt q) . systemSeconds =<< getSystemTime
-
-tryStore' :: Text -> RecipientId -> IO a -> ExceptT ErrorType IO a
-tryStore' op rId = tryStore op rId . fmap Right
-
-tryStore :: forall a. Text -> RecipientId -> IO (Either ErrorType a) -> ExceptT ErrorType IO a
-tryStore op rId a = ExceptT $ E.mask_ $ a `E.catch` storeError op rId
-
-storeError :: Text -> RecipientId -> E.SomeException -> IO (Either ErrorType a)
-storeError op rId e =
-  let e' = T.intercalate ", " [op, decodeLatin1 $ strEncode rId, tshow e]
-    in logError ("STORE: " <> e') $> Left (STORE e')
-
-isolateQueueId :: Text -> JournalMsgStore s -> RecipientId -> IO (Either ErrorType a) -> ExceptT ErrorType IO a
-isolateQueueId op JournalMsgStore {queueLocks, sharedLock} rId =
-  tryStore op rId . withLockMapWaitShared rId queueLocks sharedLock op
-
-openMsgQueue :: JournalMsgStore s -> JMQueue -> Bool -> IO (JournalMsgQueue s)
-openMsgQueue ms@JournalMsgStore {config} q@JMQueue {queueDirectory = dir, statePath} forWrite = do
-  (st_, shouldBackup) <- readQueueState ms statePath
-  case st_ of
-    Nothing -> do
-      st <- newMsgQueueState <$> newJournalId (random ms)
-      when shouldBackup $ backupQueueState statePath -- rename invalid state file
-      mkJournalQueue q st Nothing
-    Just st
-      | size st == 0 -> do
-          (st', hs_) <- removeJournals st shouldBackup
-          when (isJust hs_) incOpenedCount
-          mkJournalQueue q st' hs_
-      | otherwise -> do
-          sh <- openBackupQueueState st shouldBackup
-          (st', rh, wh_) <- closeOnException sh $ openJournals ms dir st sh
-          let hs = MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = wh_}
-          incOpenedCount
-          mkJournalQueue q st' (Just hs)
-  where
-    incOpenedCount = atomically $ modifyTVar' (openedQueueCount ms) (+ 1)
-    -- If the queue is empty, journals are deleted.
-    -- New journal is created if queue is written to.
-    -- canWrite is set to True.
-    removeJournals MsgQueueState {readState = rs, writeState = ws} shouldBackup = E.uninterruptibleMask_ $ do
-      rjId <- newJournalId $ random ms
-      let st = newMsgQueueState rjId
-      hs_ <-
-        if forWrite
-          then Just <$> newJournalHandles st rjId
-          else Nothing <$ backupQueueState statePath
-      removeJournalIfExists dir rs
-      unless (journalId ws == journalId rs) $ removeJournalIfExists dir ws
-      pure (st, hs_)
-      where
-        newJournalHandles st rjId = do
-          sh <- openBackupQueueState st shouldBackup
-          appendState_ sh st
-          rh <- closeOnException sh $ createNewJournal dir rjId
-          pure MsgQueueHandles {stateHandle = sh, readHandle = rh, writeHandle = Nothing}
-    openBackupQueueState st shouldBackup
-      | shouldBackup = 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.
-          let tempBackup = statePath <> ".bak"
-          renameFile statePath tempBackup -- 1) temp backup
-          sh <- openFile statePath AppendMode
-          closeOnException sh $ appendState sh st -- 2) save state to new file
-          backupQueueState tempBackup -- 3) timed backup
-          pure sh
-      | otherwise = openFile statePath AppendMode
-    backupQueueState path = do
-      ts <- getCurrentTime
-      renameFile path $ stateBackupPath statePath ts
-      -- remove old backups
-      times <- sort . mapMaybe backupPathTime <$> listDirectory dir
-      let toDelete = filter (< expireBackupsBefore ms) $ take (length times - keepMinBackups config) times
-      mapM_ (safeRemoveFile "removeBackups" . stateBackupPath statePath) toDelete
-      where
-        backupPathTime :: FilePath -> Maybe UTCTime
-        backupPathTime = iso8601ParseM . T.unpack <=< T.stripSuffix ".bak" <=< T.stripPrefix statePathPfx . T.pack
-        statePathPfx = T.pack $ takeFileName statePath <> "."
-
-mkJournalQueue :: JMQueue -> MsgQueueState -> Maybe MsgQueueHandles -> IO (JournalMsgQueue s)
-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 {queue, state, tipMsg, handles}
-
-chooseReadJournal :: JournalQueue s -> JournalMsgQueue s -> Bool -> MsgQueueHandles -> IO (Maybe (JournalState 'JTRead, Handle))
-chooseReadJournal q' 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
-      when log' $ removeJournal (queueDirectory $ queue q) rs
-      let !rs' = (newJournalState $ journalId ws) {msgCount = msgCount ws, byteCount = byteCount ws}
-          !st' = st {readState = rs'}
-      updateQueueState q' 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 :: JournalQueue s -> JournalMsgQueue s -> Bool -> MsgQueueHandles -> MsgQueueState -> STM () -> IO ()
-updateQueueState q' 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 (queueState q') $ Just $! qState st
-  atomically $ writeTVar (state q) st >> a
-
-appendState :: Handle -> MsgQueueState -> IO ()
-appendState h = E.uninterruptibleMask_ . appendState_ h
-{-# INLINE appendState #-}
-
-appendState_ :: Handle -> MsgQueueState -> IO ()
-appendState_ h st = B.hPutStr h $ strEncode st `B.snoc` '\n'
-
-updateReadPos :: JournalQueue s -> JournalMsgQueue s -> Bool -> Int64 -> MsgQueueHandles -> IO ()
-updateReadPos q' 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' q log' hs st' $ writeTVar (tipMsg q) Nothing
-
-msgQueueDirectory :: JournalMsgStore s -> 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'
-
-msgQueueStatePath :: FilePath -> RecipientId -> FilePath
-msgQueueStatePath dir rId = dir </> (queueLogFileName <> "." <> B.unpack (strEncode rId) <> logFileExt)
-
-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 :: JournalMsgStore s -> 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
-      | 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
-          pure (st, rh, Nothing)
-      | otherwise -> closeOnException rh $ do
-          fixFileSize rh $ byteCount rs
-          openJournal ws >>= \case
-            Left path -> do
-              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
-       in ifM (doesFileExist path) (Right <$> openFile path ReadWriteMode) (pure $ Left path)
-    -- do that for all append operations
-
-fixFileSize :: Handle -> Int64 -> IO ()
-fixFileSize h pos = do
-  let pos' = fromIntegral pos
-  size <- IO.hFileSize h
-  if
-    | size > pos' -> do
-        name <- IO.hShow h
-        logWarn $ "STORE: fixFileSize, size " <> tshow size <> " > pos " <> tshow pos <> " - truncating, " <> T.pack name
-        IO.hSetFileSize h pos'
-    | size < pos' -> do
-        -- From code logic this can't happen.
-        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} =
-  safeRemoveFile "removeJournal" $ journalFilePath dir journalId
-
-removeJournalIfExists :: FilePath -> JournalState t -> IO ()
-removeJournalIfExists dir JournalState {journalId} = do
-  let path = journalFilePath dir journalId
-  handleError "removeJournalIfExists" path $
-    whenM (doesFileExist path) $ removeFile path
-
-safeRemoveFile :: Text -> FilePath -> IO ()
-safeRemoveFile cxt path = handleError cxt path $ removeFile path
-
-handleError :: Text -> FilePath -> IO () -> IO ()
-handleError cxt path a =
-  a `catchAny` \e -> logError $ "STORE: " <> cxt <> ", " <> 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.
-readQueueState :: JournalMsgStore s -> FilePath -> IO (Maybe MsgQueueState, Bool)
-readQueueState JournalMsgStore {config} statePath =
-  ifM
-    (doesFileExist tempBackup)
-    (renameFile tempBackup statePath >> readState)
-    (ifM (doesFileExist statePath) readState $ pure (Nothing, False))
-  where
-    tempBackup = statePath <> ".bak"
-    readState = do
-      ls <- B.lines <$> readFileTail
-      case ls of
-        [] -> do
-          logWarn $ "STORE: readWriteQueueState, empty queue state, " <> T.pack statePath
-          pure (Nothing, False)
-        _ -> do
-          r <- useLastLine (length ls) True ls
-          forM_ (fst r) $ \st ->
-            unless (validQueueState st) $ E.throwIO $ userError $ "readWriteQueueState inconsistent state: " <> show st
-          pure r
-    useLastLine len isLastLine ls = case strDecode $ last ls of
-      Right st ->
-        -- when state file has fewer than maxStateLines, we don't compact it
-        let shouldBackup = len > maxStateLines config || not isLastLine
-         in pure (Just st, shouldBackup)
-      Left e -- if the last line failed to parse
-        | isLastLine -> case init ls of -- or use the previous line
-            [] -> do
-              logWarn $ "STORE: readWriteQueueState, invalid 1-line queue state - initialized, " <> T.pack statePath
-              pure (Nothing, True) -- backup state file, because last line was invalid
-            ls' -> do
-              logWarn $ "STORE: readWriteQueueState, invalid last line in queue state - using the previous line, " <> T.pack statePath
-              useLastLine len False ls'
-        | otherwise -> E.throwIO $ userError $ "readWriteQueueState invalid state " <> statePath <> ": " <> show e
-    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)
-
-stateBackupPath :: FilePath -> UTCTime -> FilePath
-stateBackupPath statePath ts = statePath <> "." <> iso8601Show ts <> ".bak"
-
-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
-
-deleteQueue_ :: JournalMsgStore s -> JournalQueue s -> IO (Either ErrorType (QueueRec, Maybe (JournalMsgQueue s)))
-deleteQueue_ ms q =
-  runExceptT $ isolateQueueId "deleteQueue_" ms rId $ do
-    r <- deleteStoreQueue (queueStore_ ms) q >>= mapM remove
-    atomically $ TM.delete rId (queueLocks ms)
-    pure r
-  where
-    rId = recipientId q
-    remove qr = do
-      mq_ <- atomically $ swapTVar (msgQueue' q) Nothing
-      mapM_ (closeMsgQueueHandles ms) mq_
-      removeQueueDirectory ms rId
-      pure (qr, mq_)
-
-closeMsgQueue :: JournalMsgStore s -> JournalQueue s -> IO ()
-closeMsgQueue ms JournalQueue {msgQueue'} = atomically (swapTVar msgQueue' Nothing) >>= mapM_ (closeMsgQueueHandles ms)
-
-closeMsgQueueHandles :: JournalMsgStore s -> JournalMsgQueue s -> IO ()
-closeMsgQueueHandles ms q = readTVarIO (handles q) >>= mapM_ closeHandles
-  where
-    closeHandles (MsgQueueHandles sh rh wh_) = do
-      hClose sh
-      hClose rh
-      mapM_ hClose wh_
-      atomically $ modifyTVar' (openedQueueCount ms) (subtract 1)
-
-removeQueueDirectory :: JournalMsgStore s -> RecipientId -> IO ()
-removeQueueDirectory st = removeQueueDirectory_ . msgQueueDirectory st
-
-removeQueueDirectory_ :: FilePath -> IO ()
-removeQueueDirectory_ dir =
-  handleError "removeQueueDirectory" dir $ removePathForcibly dir
-
-hAppend :: Handle -> Int64 -> ByteString -> IO ()
-hAppend h pos s = do
-  fixFileSize h pos
-  IO.hSeek h SeekFromEnd 0
-  B.hPutStr h s
-
-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 $ "hGetMsgAt invalid message: " <> e
-
-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 -> 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
-
-getJournalQueueMessages :: JournalMsgStore s -> JournalQueue s -> IO [Message]
-getJournalQueueMessages ms q =
-  readQueueState ms (msgQueueStatePath dir rId) >>= \case
-    (Just MsgQueueState {readState = rs, writeState = ws, size}, _) | size > 0 -> do
-      msgs <- getMsgs (journalId rs) (bytePos rs) (byteCount rs)
-      if journalId rs == journalId ws
-        then pure msgs
-        else (msgs ++) <$> getMsgs (journalId ws) 0 (bytePos ws)
-    _ -> pure []
-  where
-    rId = recipientId' q
-    dir = msgQueueDirectory ms rId
-    getMsgs jId from to =
-      IO.withFile (journalFilePath dir jId) ReadWriteMode $ \h' ->
-        getJournalRange h' from to
-
-getJournalRange :: Handle -> Int64 -> Int64 -> IO [Message]
-getJournalRange h from to
-  | to > from = do
-      IO.hSeek h AbsoluteSeek $ fromIntegral from
-      parseMsgs =<< B.hGet h (fromIntegral $ to - from)
-  | otherwise = pure []
-  where
-    parseMsgs s = do
-      let (errs, msgs) = partitionEithers $ map strDecode $ B.lines s
-      unless (null errs) $ do
-        f <- IO.hShow h
-        putStrLn $ "Error reading " <> show (length errs) <> " messages from " <> f
-      pure msgs
diff --git a/src/Simplex/Messaging/Server/MsgStore/Journal/SharedLock.hs b/src/Simplex/Messaging/Server/MsgStore/Journal/SharedLock.hs
deleted file mode 100644
index 87b7294f1..000000000
--- a/src/Simplex/Messaging/Server/MsgStore/Journal/SharedLock.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-module Simplex.Messaging.Server.MsgStore.Journal.SharedLock
-  ( withLockWaitShared,
-    withLockMapWaitShared,
-    withSharedWaitLock,
-  )
-where
-
-import Control.Concurrent.STM
-import qualified Control.Exception as E
-import Control.Monad
-import Data.Text (Text)
-import Simplex.Messaging.Agent.Lock
-import Simplex.Messaging.Agent.Client (getMapLock)
-import Simplex.Messaging.Protocol (RecipientId)
-import Simplex.Messaging.TMap (TMap)
-import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (($>>), ($>>=))
-
--- wait until shared lock with passed ID is released and take lock
-withLockWaitShared :: RecipientId -> Lock -> TMVar RecipientId -> Text -> IO a -> IO a
-withLockWaitShared rId lock shared name =
-  E.bracket_
-    (atomically $ waitShared rId shared >> putTMVar lock name)
-    (void $ atomically $ takeTMVar lock)
-
--- wait until shared lock with passed ID is released and take lock from Map for this ID
-withLockMapWaitShared :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> Text -> IO a -> IO a
-withLockMapWaitShared rId locks shared name a =
-  E.bracket
-    (atomically $ waitShared rId shared >> getPutLock (getMapLock locks) rId name)
-    (atomically . takeTMVar)
-    (const a)
-
-waitShared :: RecipientId -> TMVar RecipientId -> STM ()
-waitShared rId shared = tryReadTMVar shared >>= mapM_ (\rId' -> when (rId == rId') retry)
-
--- wait until lock with passed ID in Map is released and take shared lock for this ID
-withSharedWaitLock :: RecipientId -> TMap RecipientId Lock -> TMVar RecipientId -> IO a -> IO a
-withSharedWaitLock rId locks shared =
-  E.bracket_
-    (atomically $ waitLock >> putTMVar shared rId)
-    (atomically $ takeTMVar shared)
-  where
-    waitLock = TM.lookup rId locks $>>= tryReadTMVar $>> retry
diff --git a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
index c8506709c..821c5e7f2 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
@@ -162,7 +162,7 @@ instance MsgStoreClass PostgresMsgStore where
     loadedQueueCount <- M.size <$> readTVarIO queues
     loadedNotifierCount <- M.size <$> readTVarIO notifiers
     notifierLockCount <- M.size <$> readTVarIO notifierLocks
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount}
+    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, queueLockCount = 0, notifierLockCount}
     where
       PostgresQueueStore {queues, notifiers, notifierLocks} = queueStore_ ms
 
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index f118e007c..0607ef8b5 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -103,7 +103,7 @@ instance MsgStoreClass STMMsgStore where
   loadedQueueCounts STMMsgStore {queueStore_ = st} = do
     loadedQueueCount <- M.size <$> readTVarIO (queues st)
     loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, openJournalCount = 0, queueLockCount = 0, notifierLockCount = 0}
+    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, queueLockCount = 0, notifierLockCount = 0}
 
   mkQueue _ _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
   {-# INLINE mkQueue #-}
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index a14dfd424..dce3bc638 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -124,13 +124,12 @@ class (Monad (StoreMonad s), QueueStoreClass (StoreQueue s) (QueueStore s)) => M
   getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
   {-# INLINE getQueueSize #-}
 
-data MSType = MSMemory | MSJournal | MSPostgres
+data MSType = MSMemory | MSPostgres
 
 data QSType = QSMemory | QSPostgres
 
 data SMSType :: MSType -> Type where
   SMSMemory :: SMSType 'MSMemory
-  SMSJournal :: SMSType 'MSJournal
   SMSPostgres :: SMSType 'MSPostgres
 
 data SQSType :: QSType -> Type where
@@ -155,7 +154,6 @@ instance Semigroup MessageStats where
 data LoadedQueueCounts = LoadedQueueCounts
   { loadedQueueCount :: Int,
     loadedNotifierCount :: Int,
-    openJournalCount :: Int,
     queueLockCount :: Int,
     notifierLockCount :: Int
   }
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index 940407569..b0ba2ea79 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -586,23 +586,19 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_subscription_ntf_service_subs_total gauge\n\
       \simplex_smp_subscription_ntf_service_subs_total " <> mshow (subServiceSubsCount ntfSubs) <> "\n# ntf.subServiceSubsCount\n\
       \\n\
-      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory/journal storage)\n\
+      \# HELP simplex_smp_loaded_queues_queue_count Total loaded queues count (all queues for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_queue_count gauge\n\
       \simplex_smp_loaded_queues_queue_count " <> mshow (loadedQueueCount loadedCounts) <> "\n# loadedCounts.loadedQueueCount\n\
       \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory/journal storage)\n\
+      \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_ntf_count gauge\n\
       \simplex_smp_loaded_queues_ntf_count " <> mshow (loadedNotifierCount loadedCounts) <> "\n# loadedCounts.loadedNotifierCount\n\
       \\n\
-      \# HELP simplex_smp_loaded_queues_open_journal_count Total opened queue journals (0 for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_open_journal_count gauge\n\
-      \simplex_smp_loaded_queues_open_journal_count " <> mshow (openJournalCount loadedCounts) <> "\n# loadedCounts.openJournalCount\n\
-      \\n\
       \# HELP simplex_smp_loaded_queues_queue_lock_count Total queue locks (0 for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_queue_lock_count gauge\n\
       \simplex_smp_loaded_queues_queue_lock_count " <> mshow (queueLockCount loadedCounts) <> "\n# loadedCounts.queueLockCount\n\
       \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_lock_count Total notifier locks (0 for memory/journal storage)\n\
+      \# HELP simplex_smp_loaded_queues_ntf_lock_count Total notifier locks (0 for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
       \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
 
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index cc2b02a29..028de1ab3 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -134,9 +134,7 @@ import Simplex.Messaging.Agent.Store.AgentStore (deleteClientService, getSubscri
 import qualified Database.PostgreSQL.Simple as PSQL
 import qualified Simplex.Messaging.Agent.Store.Postgres as Postgres
 import qualified Simplex.Messaging.Agent.Store.Postgres.Common as Postgres
-import Simplex.Messaging.Server.MsgStore.Journal (JournalQueue)
 import Simplex.Messaging.Server.MsgStore.Postgres (PostgresQueue)
-import Simplex.Messaging.Server.MsgStore.Types (QSType (..))
 import Simplex.Messaging.Server.QueueStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Postgres.Migrations
 import Simplex.Messaging.Server.QueueStore.Types (QueueStoreClass (..))
@@ -1606,7 +1604,7 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
   bob <- getSMPAgentClient' 2 agentCfg initAgentServersSrv2 testDB2
   withSmpServerStoreLogOn ps testPort $ \_ -> do
     (aliceId, bobId, confId) <-
-      withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
+      withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
         runRight $ do
           (bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
           (aliceId, sqSecured) <- joinConnection bob 1 True qInfo "bob's connInfo" SMSubscribe
@@ -1628,7 +1626,7 @@ testAllowConnectionClientRestart ps@(t, ASType qsType _) = do
     alice2 <- getSMPAgentClient' 3 agentCfg initAgentServers testDB
     runRight_ $ subscribeConnection alice2 bobId
     threadDelay 500000
-    withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
+    withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
       runRight $ do
         ("", "", UP _ _) <- nGet bob
         get alice2 ##> ("", bobId, CON)
@@ -1795,7 +1793,7 @@ withServer1 :: HasTestEnv => (ASrvTransport, AStoreType) -> IO a -> IO a
 withServer1 ps = withSmpServerStoreLogOn ps testPort . const
 
 withServer2 :: HasTestEnv => (ASrvTransport, AStoreType) -> IO a -> IO a
-withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 . const
+withServer2 (t, ASType qsType _) = withSmpServerConfigOn t (cfgS2QS qsType) testPort2 . const
 
 testInvitationShortLink :: (HasCallStack, HasTestEnv) => Bool -> AgentClient -> AgentClient -> IO ()
 testInvitationShortLink viaProxy a b =
@@ -2035,18 +2033,11 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
 #endif
   () <- case testServerStoreConfig msType of
     ASSCfg _ _ (SSCMemory sp_) -> mapM_ (\StorePaths {storeLogFile} -> updateStoreLog storeLogFile) sp_
-    ASSCfg _ _ SSCMemoryJournal {storeLogFile} -> updateStoreLog storeLogFile
 #if defined(dbServerPostgres)
-    ASSCfg _ _ SSCDatabaseJournal {storeCfg} -> do
-      st :: PostgresQueueStore (JournalQueue 'QSPostgres) <- newQueueStore @(JournalQueue 'QSPostgres) (storeCfg, True)
-      updateDbStore st
-      closeQueueStore @(JournalQueue 'QSPostgres) st
     ASSCfg _ _ (SSCDatabase storeCfg) -> do
       st :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
       updateDbStore st
       closeQueueStore @PostgresQueue st
-#else
-    ASSCfg _ _ SSCDatabaseJournal {} -> error "no dbServerPostgres flag"
 #endif
 
   withSmpServer ps $ do
@@ -2552,7 +2543,7 @@ testExpireMessageQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_
     ackMessage b' aId 4 Nothing
   disposeAgentClient a
   where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
 
 testExpireManyMessagesQuota :: HasTestEnv => (ASrvTransport, AStoreType) -> IO ()
 testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2591,7 +2582,7 @@ testExpireManyMessagesQuota (t, msType) = withSmpServerConfigOn t cfg' testPort
     ackMessage b' aId 4 Nothing
   disposeAgentClient a
   where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
 
 testJoinFullContactAsync :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2610,7 +2601,7 @@ testJoinFullContactAsync (t, msType) = withSmpServerConfigOn t cfg' testPort $ \
       ("", _, A.REQ _ _ _ "bob's connInfo" _ _) <- get alice
       pure ()
   where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
 
 testJoinFullContactAsyncExpire :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPort $ \_ -> do
@@ -2624,7 +2615,7 @@ testJoinFullContactAsyncExpire (t, msType) = withSmpServerConfigOn t cfg' testPo
     noMessages bob "joining should be retried until quota exceeded timeout"
     get bob =##> \case ("2", c, ERR (SMP _ QUOTA)) -> c == aliceId; _ -> False
   where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1, maxJournalMsgCount = 2}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 1}
 
 fillContactAddress :: (HasCallStack, HasTestEnv) => IO (ConnId, ConnectionRequestUri 'CMContact)
 fillContactAddress = do
@@ -3202,7 +3193,7 @@ testBatchedSubscriptions nCreate nDel ps@(t, ASType qsType _) = do
     runServers :: ExceptT AgentErrorType IO a -> IO a
     runServers a = do
       withSmpServerStoreLogOn ps testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \t2 ->
           runRight a `finally` killThread t2
         killThread t1
         pure res
@@ -3709,7 +3700,7 @@ testJoinConnectionAsyncReplyError ps@(t, ASType qsType _) = do
         ConnectionStats {rcvQueuesInfo = [], sndQueuesInfo = [SndQueueInfo {}]} <- getConnectionServers b aId
         pure (aId, bId)
       nGet a =##> \case ("", "", DOWN _ [c]) -> c == bId; _ -> False
-      withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ -> do
+      withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ -> do
         confId <- withSmpServerStoreLogOn ps 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
@@ -3842,7 +3833,7 @@ fastSwitchComplete a bId b aId = do
 testFastSwitchDeadOldServer :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO ()
 testFastSwitchDeadOldServer ps@(t, ASType qsType _) = do
   let bServers = initAgentServers {smp = userServers [testSMPServer2]}
-  withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \_ ->
+  withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \_ ->
     withAgent 1 aCfg initAgentServers testDB $ \a ->
       withAgent 2 agentCfg bServers testDB2 $ \b -> do
         (aId, bId) <- withSmpServerStoreLogOn ps testPort $ \_ -> runRight $ do
@@ -4402,7 +4393,7 @@ testDeliveryReceiptsConcurrent (t, msType) =
       liftIO $ noMessages a "nothing else should be delivered to alice"
       liftIO $ noMessages b "nothing else should be delivered to bob"
   where
-    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 256, maxJournalMsgCount = 512}
+    cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 256}
     runClient :: String -> AgentClient -> ConnId -> IO ()
     runClient _cName client connId = do
       concurrently_ send receive
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index c375a06f2..11ad9d333 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -877,7 +877,7 @@ testNotificationsSMPRestartBatch n ps@(t, ASType qsType _) apns =
     runServers :: ExceptT AgentErrorType IO a -> IO a
     runServers a = do
       withSmpServerStoreLogOn ps testPort $ \t1 -> do
-        res <- withSmpServerConfigOn t (cfgJ2QS qsType) testPort2 $ \t2 ->
+        res <- withSmpServerConfigOn t (cfgS2QS qsType) testPort2 $ \t2 ->
           runRight a `finally` killThread t2
         killThread t1
         pure res
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index f4cfcf2b4..558fbf96a 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -16,8 +16,7 @@
 
 module CoreTests.MsgStoreTests where
 
-import AgentTests.FunctionalAPITests (runRight, runRight_)
-import Control.Concurrent (threadDelay)
+import AgentTests.FunctionalAPITests (runRight_)
 import Control.Concurrent.STM
 import Control.Exception (bracket)
 import Control.Monad
@@ -25,33 +24,23 @@ 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 Data.Int (Int64)
-import Data.List (isPrefixOf, isSuffixOf)
-import Data.Maybe (fromJust)
-import Data.Time.Clock (addUTCTime)
-import Data.Time.Clock.System (SystemTime (..), getSystemTime)
-import SMPClient (testStoreLogFile, testStoreMsgsDir, testStoreMsgsDir2, testStoreMsgsFile, testStoreMsgsFile2)
+import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Protocol (EncDataBytes (..), EntityId (..), ErrorType (..), LinkId, Message (..), QueueLinkData, RecipientId, SParty (..), noMsgFlags, randomMsgId)
-import Simplex.Messaging.Server (exportMessages, importMessages, printMessageStats)
-import Simplex.Messaging.Server.Env.STM (MsgStore (..), journalMsgStoreDepth, readWriteQueueStore)
-import Simplex.Messaging.Server.Expiration (ExpirationConfig (..), expireBeforeEpoch)
-import Simplex.Messaging.Server.MsgStore.Journal
 import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
 import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.Server.StoreLog (closeStoreLog, logCreateQueue)
-import System.Directory (copyFile, createDirectoryIfMissing, listDirectory, removeFile, renameFile)
-import System.FilePath ((</>))
-import System.IO (IOMode (..), withFile)
 import Test.Hspec hiding (fit, it)
 import Util
 
 #if defined(dbServerPostgres)
+import AgentTests.FunctionalAPITests (runRight)
+import Control.Concurrent (threadDelay)
+import Data.Time.Clock.System (SystemTime (..))
 import Database.PostgreSQL.Simple (Only (..))
 import qualified Database.PostgreSQL.Simple as DB
 import Simplex.Messaging.Agent.Store.Postgres.Common
@@ -64,35 +53,14 @@ import SMPClient (testStoreDBOpts)
 msgStoreTests :: Spec
 msgStoreTests = do
   describe "STM message store" $ someMsgStoreTests testSMTStoreConfig
-  describe "Journal message store" $ do
-    someMsgStoreTests $ testJournalStoreCfg MQStoreCfg
-    journalMsgStoreTests $ testJournalStoreCfg MQStoreCfg
-    it "should export and import journal store" $ withMsgStore (testJournalStoreCfg MQStoreCfg) testExportImportStore
 #if defined(dbServerPostgres)
-  describe "Postgres+journal message store" $ do
-    someMsgStoreTests $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg
-    journalMsgStoreTests $ testJournalStoreCfg $ PQStoreCfg testPostgresStoreCfg
   describe "Postgres-only message store" $ do
     someMsgStoreTests testPostgresStoreConfig
     it "should correctly update message counts and canWrite flag" $ withMsgStore testPostgresStoreConfig testUpdateMessageCounts
     it "tryDelPeekMsg (ACK not from NSE) should reset message counts when queue is empty" $ withMsgStore testPostgresStoreConfig testResetMessageCounts
     it "should expire messages across commit batches" $ withMsgStore testPostgresStoreConfig testExpireMessagesInBatches
 #endif
-  describe "Journal message store: queue state backup expiration" $ do
-    it "should remove old queue state backups" testRemoveQueueStateBackups
-    it "should expire messages in idle queues" testExpireIdleQueues
   where
-    journalMsgStoreTests :: (HasTestEnv => JournalStoreConfig s) -> Spec
-    journalMsgStoreTests cfg = do
-      describe "queue state" $ do
-        it "should restore queue state from the last line" $ withMsgStore cfg testQueueState
-        it "should recover when message is written and state is not" $ withMsgStore cfg testMessageState
-        it "should remove journal files when queue is empty" $ withMsgStore cfg testRemoveJournals
-      describe "missing files" $ do
-        it "should create read file when missing" $ withMsgStore cfg testReadFileMissing
-        it "should switch to write file when read file missing" $ withMsgStore cfg testReadFileMissingSwitch
-        it "should create write file when missing" $ withMsgStore cfg testWriteFileMissing
-        it "should create read file when read and write files are missing" $ withMsgStore cfg testReadAndWriteFilesMissing
     someMsgStoreTests :: MsgStoreClass s => (HasTestEnv => MsgStoreConfig s) -> Spec
     someMsgStoreTests cfg = do
       it "should get queue and store/read messages" $ withMsgStore cfg testGetQueue
@@ -107,21 +75,6 @@ withMsgStore cfg = bracket (newMsgStore cfg) closeMsgStore
 testSMTStoreConfig :: STMStoreConfig
 testSMTStoreConfig = STMStoreConfig {storePath = Nothing, quota = 3}
 
-testJournalStoreCfg :: HasTestEnv => QStoreCfg s -> JournalStoreConfig s
-testJournalStoreCfg queueStoreCfg =
-  JournalStoreConfig
-    { storePath = testStoreMsgsDir,
-      pathParts = journalMsgStoreDepth,
-      queueStoreCfg,
-      quota = 3,
-      maxMsgCount = 4,
-      maxStateLines = 2,
-      stateTailSize = 256,
-      idleInterval = 21600,
-      expireBackupsAfter = 0,
-      keepMinBackups = 1
-    }
-
 #if defined(dbServerPostgres)
 testPostgresStoreConfig :: HasTestEnv => PostgresMsgStoreCfg
 testPostgresStoreConfig =
@@ -150,12 +103,6 @@ mkMessage body = liftIO $ do
 pattern Msg :: ByteString -> Maybe Message
 pattern Msg s <- Just Message {msgBody = MaxLenBS s}
 
-deriving instance Eq MsgQueueState
-
-deriving instance Eq (JournalState t)
-
-deriving instance Eq (SJournalType t)
-
 testNewQueueRec :: TVar ChaChaDRG -> QueueMode -> IO (RecipientId, QueueRec)
 testNewQueueRec g qm = testNewQueueRecData g qm Nothing
 
@@ -292,58 +239,6 @@ testLinkDataSecuredQueue ms = do
     void $ ExceptT $ deleteQueue ms q
     void $ ExceptT $ deleteQueue ms cq
 
-testExportImportStore :: HasTestEnv => JournalMsgStore 'QSMemory -> IO ()
-testExportImportStore ms = do
-  g <- C.newRandom
-  (rId1, qr1) <- testNewQueueRec g QMMessaging
-  (rId2, qr2) <- testNewQueueRec g QMMessaging
-  sl <- readWriteQueueStore True (mkQueue ms True) testStoreLogFile $ stmQueueStore ms
-  runRight_ $ do
-    let write q s = writeMsg ms q True =<< mkMessage s
-    q1 <- ExceptT $ addQueue ms rId1 qr1
-    liftIO $ logCreateQueue sl rId1 qr1
-    Just (Message {}, True) <- write q1 "message 1"
-    Just (Message {}, False) <- write q1 "message 2"
-    q2 <- ExceptT $ addQueue ms rId2 qr2
-    liftIO $ logCreateQueue sl rId2 qr2
-    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 ms q2 mId3
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms 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` 3
-  exportMessages False (StoreJournal ms) testStoreMsgsFile False
-  closeMsgStore ms
-  closeStoreLog sl
-  -- export with closed queues and compare
-  ms2 <- newMsgStore $ testJournalStoreCfg MQStoreCfg
-  readWriteQueueStore True (mkQueue ms2 True) testStoreLogFile (stmQueueStore ms2) >>= closeStoreLog
-  exportMessages False (StoreJournal ms2) (testStoreMsgsFile <> ".copy") False
-  s <- B.readFile testStoreMsgsFile
-  B.readFile (testStoreMsgsFile <> ".copy") `shouldReturn` s
-
-  let cfg = (testJournalStoreCfg MQStoreCfg :: JournalStoreConfig 'QSMemory) {storePath = testStoreMsgsDir2}
-  ms' <- newMsgStore cfg
-  readWriteQueueStore True (mkQueue ms' True) testStoreLogFile (stmQueueStore ms') >>= closeStoreLog
-  stats@MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages False ms' testStoreMsgsFile Nothing False
-  printMessageStats "Messages" stats
-  length <$> listDirectory (msgQueueDirectory ms rId1) `shouldReturn` 2
-  length <$> listDirectory (msgQueueDirectory ms rId2) `shouldReturn` 3 -- 2 message files
-  exportMessages False (StoreJournal ms') testStoreMsgsFile2 False
-  (B.readFile testStoreMsgsFile2 `shouldReturn`) =<< B.readFile (testStoreMsgsFile <> ".bak")
-  stmStore <- newMsgStore testSMTStoreConfig
-  readWriteQueueStore True (mkQueue stmStore True) testStoreLogFile (queueStore stmStore) >>= closeStoreLog
-  MessageStats {storedMsgsCount = 5, expiredMsgsCount = 0, storedQueues = 2} <-
-    importMessages False stmStore testStoreMsgsFile2 Nothing False
-  exportMessages False (StoreMemory stmStore) testStoreMsgsFile False
-  (B.sort <$> B.readFile testStoreMsgsFile `shouldReturn`) =<< (B.sort <$> B.readFile (testStoreMsgsFile2 <> ".bak"))
-
 #if defined(dbServerPostgres)
 testUpdateMessageCounts :: PostgresMsgStore -> IO ()
 testUpdateMessageCounts ms = do
@@ -452,321 +347,3 @@ testExpireMessagesInBatches ms = do
       where
         go n = write q "fill" >>= maybe (pure n) (const $ go (n + 1))
 #endif
-
-testQueueState :: JournalMsgStore s -> IO ()
-testQueueState ms = do
-  g <- C.newRandom
-  rId <- EntityId <$> atomically (C.randomBytes 24 g)
-  let dir = msgQueueDirectory ms rId
-      statePath = msgQueueStatePath dir rId
-  createDirectoryIfMissing True dir
-  state <- newMsgQueueState <$> newJournalId (random ms)
-  withFile statePath WriteMode (`appendState` state)
-  length . lines <$> readFile statePath `shouldReturn` 1
-  readQueueState ms statePath `shouldReturn` (Just state, False)
-  length <$> listDirectory dir `shouldReturn` 1 -- no backup
-  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 (`appendState` state1)
-  length . lines <$> readFile statePath `shouldReturn` 2
-  readQueueState ms statePath `shouldReturn` (Just state1, False)
-  length <$> listDirectory dir `shouldReturn` 1 -- no backup
-  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 (`appendState` state2)
-  length . lines <$> readFile statePath `shouldReturn` 3
-  copyFile statePath (statePath <> ".2")
-  readQueueState ms statePath `shouldReturn` (Just state2, True)
-  length <$> listDirectory dir `shouldReturn` 2 -- new state + copy
-  ls <- lines <$> readFile statePath
-  length ls `shouldBe` 3
-  -- mock compacting file
-  writeFile statePath $ last ls
-
-  -- corrupt the only line
-  corruptFile statePath
-  (Nothing, True) <- readQueueState ms statePath
-
-  -- corrupt the last line
-  renameFile (statePath <> ".2") statePath
-  removeOtherFiles dir statePath
-  length . lines <$> readFile statePath `shouldReturn` 3
-  corruptFile statePath
-  readQueueState ms statePath `shouldReturn` (Just state1, True)
-  length <$> listDirectory dir `shouldReturn` 1
-  length . lines <$> readFile statePath `shouldReturn` 3
-  where
-    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
-
-testMessageState :: JournalMsgStore s -> IO ()
-testMessageState ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  let dir = msgQueueDirectory ms rId
-      statePath = msgQueueStatePath dir rId
-      write q s = writeMsg ms q True =<< mkMessage s
-
-  mId1 <- runRight $ do
-    q <- ExceptT $ addQueue ms rId qr
-    Just (Message {msgId = mId1}, True) <- write q "message 1"
-    Just (Message {}, False) <- write q "message 2"
-    liftIO $ closeMsgQueue ms q
-    pure mId1
-
-  ls <- B.lines <$> B.readFile statePath
-  B.writeFile statePath $ B.unlines $ take (length ls - 1) ls
-
-  runRight_ $ do
-    q <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {msgId = mId3}, False) <- write q "message 3"
-    (Msg "message 1", Msg "message 3") <- tryDelPeekMsg ms q mId1
-    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
-    liftIO $ closeMsgQueue ms q
-
-testRemoveJournals :: JournalMsgStore s -> IO ()
-testRemoveJournals ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  let dir = msgQueueDirectory ms rId
-      statePath = msgQueueStatePath dir rId
-      write q s = writeMsg ms q True =<< mkMessage s
-
-  runRight $ do
-    q <- ExceptT $ addQueue ms rId qr
-    Just (Message {msgId = mId1}, True) <- write q "message 1"
-    Just (Message {msgId = mId2}, False) <- write q "message 2"
-    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
-    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
-    liftIO $ closeMsgQueue ms q
-
-  ls <- B.lines <$> B.readFile statePath
-  length ls `shouldBe` 4
-  journalFilesCount dir `shouldReturn` 1
-  stateBackupCount dir `shouldReturn` 0
-
-  runRight $ do
-    q <- ExceptT $ getQueue ms SRecipient rId
-    -- not removed yet
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    liftIO $ stateBackupCount dir `shouldReturn` 0
-    Nothing <- tryPeekMsg ms q
-    -- still not removed, queue is empty and not opened
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    _mq <- isolateQueue ms q "test" $ getMsgQueue ms q False
-    -- journal is removed
-    liftIO $ journalFilesCount dir `shouldReturn` 0
-    liftIO $ stateBackupCount dir `shouldReturn` 1
-    Just (Message {msgId = mId3}, True) <- write q "message 3"
-    -- journal is created
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    Just (Message {msgId = mId4}, False) <- write q "message 4"
-    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms q mId3
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q mId4
-    Just (Message {msgId = mId5}, True) <- write q "message 5"
-    Just (Message {msgId = mId6}, False) <- write q "message 6"
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    Just (Message {msgId = mId7}, False) <- write q "message 7"
-    -- separate write journal is created
-    liftIO $ journalFilesCount dir `shouldReturn` 2
-    Nothing <- write q "message 8"
-    (Msg "message 5", Msg "message 6") <- tryDelPeekMsg ms q mId5
-    liftIO $ journalFilesCount dir `shouldReturn` 2
-    (Msg "message 6", Msg "message 7") <- tryDelPeekMsg ms q mId6
-    -- read journal is removed
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    (Msg "message 7", Just MessageQuota {msgId = mId8}) <- tryDelPeekMsg ms q mId7
-    (Just MessageQuota {}, Nothing) <- tryDelPeekMsg ms q mId8
-    liftIO $ closeMsgQueue ms q
-
-  journalFilesCount dir `shouldReturn` 1
-  runRight $ do
-    q <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {}, True) <- write q "message 8"
-    liftIO $ journalFilesCount dir `shouldReturn` 1
-    liftIO $ stateBackupCount dir `shouldReturn` 2
-    liftIO $ closeMsgQueue ms q
-  where
-    journalFilesCount dir = length . filter ("messages." `isPrefixOf`) <$> listDirectory dir
-    stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
-
-testRemoveQueueStateBackups :: HasTestEnv => IO ()
-testRemoveQueueStateBackups = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-
-  ms' <- newMsgStore (testJournalStoreCfg MQStoreCfg) {maxStateLines = 1, expireBackupsAfter = 0, keepMinBackups = 0}
-  -- set expiration time 1 second ahead
-  let ms = ms' {expireBackupsBefore = addUTCTime 1 $ expireBackupsBefore ms'}
-
-  let dir = msgQueueDirectory ms rId
-      write q s = writeMsg ms q True =<< mkMessage s
-
-  runRight $ do
-    q <- ExceptT $ addQueue ms rId qr
-    Just (Message {msgId = mId1}, True) <- write q "message 1"
-    Just (Message {msgId = mId2}, False) <- write q "message 2"
-    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
-    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
-    liftIO $ closeMsgQueue ms q
-    liftIO $ stateBackupCount dir `shouldReturn` 0
-
-    q1 <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {}, True) <- write q1 "message 3"
-    Just (Message {}, False) <- write q1 "message 4"
-    liftIO $ closeMsgQueue ms q1
-    liftIO $ stateBackupCount dir `shouldReturn` 0
-
-    liftIO $ threadDelay 1000000
-    q2 <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {}, False) <- write q2 "message 5"
-    Nothing <- write q2 "message 5"
-    liftIO $ closeMsgQueue ms q2
-    liftIO $ stateBackupCount dir `shouldReturn` 1
-  where
-    stateBackupCount dir = length . filter (".bak" `isSuffixOf`) <$> listDirectory dir
-
-testExpireIdleQueues :: HasTestEnv => IO ()
-testExpireIdleQueues = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-
-  ms <- newMsgStore (testJournalStoreCfg MQStoreCfg) {idleInterval = 0}
-
-  let dir = msgQueueDirectory ms rId
-      statePath = msgQueueStatePath dir rId
-      write q s = writeMsg ms q True =<< mkMessage s
-
-  q <- runRight $ do
-    q <- ExceptT $ addQueue ms rId qr
-    Just (Message {msgId = mId1}, True) <- write q "message 1"
-    Just (Message {msgId = mId2}, False) <- write q "message 2"
-    (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
-    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
-    liftIO $ closeMsgQueue ms q
-    pure q
-
-  (Just MsgQueueState {size = 0, readState = rs, writeState = ws}, True) <- readQueueState ms statePath
-  msgCount rs `shouldBe` 2
-  msgCount ws `shouldBe` 2
-
-  old <- expireBeforeEpoch ExpirationConfig {ttl = 1, checkInterval = 1} -- no old messages
-  now <- systemSeconds <$> getSystemTime
-
-  (expired_, stored) <- runRight $ isolateQueue ms q "" $ withIdleMsgQueue now ms q $ deleteExpireMsgs_ old q
-  expired_ `shouldBe` Just 0
-  stored `shouldBe` 0
-  (Nothing, False) <- readQueueState ms statePath
-  pure ()
-
-testReadFileMissing :: JournalMsgStore s -> IO ()
-testReadFileMissing ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  let write q s = writeMsg ms q True =<< mkMessage s
-  q <- runRight $ do
-    q <- ExceptT $ addQueue ms rId qr
-    Just (Message {}, True) <- write q "message 1"
-    Msg "message 1" <- tryPeekMsg ms q
-    pure q
-
-  mq <- fromJust <$> readTVarIO (msgQueue' q)
-  MsgQueueState {readState = rs} <- readTVarIO $ state mq
-  closeMsgQueue ms q
-  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
-  removeFile path
-
-  runRight_ $ do
-    q' <- ExceptT $ getQueue ms SRecipient rId
-    Nothing <- tryPeekMsg ms q'
-    Just (Message {}, True) <- write q' "message 2"
-    Msg "message 2" <- tryPeekMsg ms q'
-    pure ()
-
-testReadFileMissingSwitch :: JournalMsgStore s -> IO ()
-testReadFileMissingSwitch ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  q <- writeMessages ms rId qr
-
-  mq <- fromJust <$> readTVarIO (msgQueue' q)
-  MsgQueueState {readState = rs} <- readTVarIO $ state mq
-  closeMsgQueue ms q
-  let path = journalFilePath (queueDirectory $ queue mq) $ journalId rs
-  removeFile path
-
-  runRight_ $ do
-    q' <- ExceptT $ getQueue ms SRecipient rId
-    Just (Message {}, False) <- writeMsg ms q' True =<< mkMessage "message 6"
-    Msg "message 5" <- tryPeekMsg ms q'
-    pure ()
-
-testWriteFileMissing :: JournalMsgStore s -> IO ()
-testWriteFileMissing ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  q <- writeMessages ms rId qr
-
-  mq <- fromJust <$> readTVarIO (msgQueue' q)
-  MsgQueueState {writeState = ws} <- readTVarIO $ state mq
-  closeMsgQueue ms q
-  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 q'
-    (Msg "message 3", Msg "message 4") <- tryDelPeekMsg ms q' mId3
-    Just Message {msgId = mId4} <- tryPeekMsg ms q'
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q' mId4
-    Just (Message {}, True) <- writeMsg ms q' True =<< mkMessage "message 6"
-    Msg "message 6" <- tryPeekMsg ms q'
-    pure ()
-
-testReadAndWriteFilesMissing :: JournalMsgStore s -> IO ()
-testReadAndWriteFilesMissing ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  q <- writeMessages ms rId qr
-
-  mq <- fromJust <$> readTVarIO (msgQueue' q)
-  MsgQueueState {readState = rs, writeState = ws} <- readTVarIO $ state mq
-  closeMsgQueue ms q
-  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 q'
-    Just (Message {}, True) <- writeMsg ms q' True =<< mkMessage "message 6"
-    Msg "message 6" <- tryPeekMsg ms q'
-    pure ()
-
-writeMessages :: JournalMsgStore s -> RecipientId -> QueueRec -> IO (JournalQueue s)
-writeMessages ms rId qr = runRight $ do
-  q <- ExceptT $ addQueue ms rId qr
-  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 {}, False) <- write "message 3"
-  (Msg "message 1", Msg "message 2") <- tryDelPeekMsg ms q mId1
-  (Msg "message 2", Msg "message 3") <- tryDelPeekMsg ms 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 3c030a143..fc47ddca8 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -28,7 +28,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Protocol.Types (ClientNotice (..))
 import Simplex.Messaging.Server.Env.STM (readWriteQueueStore)
-import Simplex.Messaging.Server.MsgStore.Journal
+import Simplex.Messaging.Server.MsgStore.STM (STMMsgStore (..))
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
@@ -177,10 +177,10 @@ testSMPStoreLog testSuite tests =
     closeStoreLog l
     replicateM_ 3 $ testReadWrite t
 #if defined(dbServerPostgres)
-    (sCnt, qCnt) <- importStoreLogToDatabase testDir testStoreLogFile testStoreDBOpts
+    (sCnt, qCnt) <- importStoreLogToDatabase testStoreLogFile testStoreDBOpts
     fromIntegral (sCnt + qCnt) `shouldBe` length (compacted t)
     imported <- B.readFile $ testStoreLogFile <> ".bak"
-    (sCnt', qCnt') <- exportDatabaseToStoreLog testDir testStoreDBOpts testStoreLogFile
+    (sCnt', qCnt') <- exportDatabaseToStoreLog testStoreDBOpts testStoreLogFile
     sCnt' `shouldBe` fromIntegral sCnt
     qCnt' `shouldBe` fromIntegral qCnt
     exported <- B.readFile testStoreLogFile
@@ -188,14 +188,14 @@ testSMPStoreLog testSuite tests =
 #endif
   where
     testReadWrite SLTC {compacted, state} = do
-      st <- newMsgStore $ testJournalStoreCfg MQStoreCfg
-      l <- readWriteQueueStore True (mkQueue st True) testStoreLogFile $ stmQueueStore st
+      st <- newMsgStore testSMTStoreConfig
+      l <- readWriteQueueStore True (mkQueue st True) testStoreLogFile $ queueStore st
       storeState st `shouldReturn` state
       closeStoreLog l
       ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
       compacted' `shouldBe` compacted
-    storeState :: JournalMsgStore 'QSMemory -> IO (M.Map RecipientId QueueRec)
-    storeState st = M.mapMaybe id <$> (readTVarIO (queues $ stmQueueStore st) >>= mapM (readTVarIO . queueRec))
+    storeState :: STMMsgStore -> IO (M.Map RecipientId QueueRec)
+    storeState st = M.mapMaybe id <$> (readTVarIO (queues $ queueStore st) >>= mapM (readTVarIO . queueRec))
 
 type FileRecState = (FileInfo, RoundedFileTime, Maybe RoundedFileTime, ServerEntityStatus)
 
diff --git a/tests/NamesResolverServer.hs b/tests/NamesResolverServer.hs
index e7f57b2fb..560095750 100644
--- a/tests/NamesResolverServer.hs
+++ b/tests/NamesResolverServer.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -78,7 +79,9 @@ memCfg2 = case memCfg of
     newStoreCfg :: ServerStoreCfg s -> ServerStoreCfg s
     newStoreCfg = \case
       SSCMemory _ -> SSCMemory (Just StorePaths {storeLogFile = testStoreLogFile2, storeMsgsFile = Just testStoreMsgsFile2})
+#if defined(dbServerPostgres)
       other -> other
+#endif
 
 withNames :: Int -> AServerConfig -> AServerConfig
 withNames port c = updateCfg c $ \cfg_ -> cfg_ {namesConfig = Just (testNamesConfig port)}
diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs
index 90eb7ee91..6d3df8122 100644
--- a/tests/SMPClient.hs
+++ b/tests/SMPClient.hs
@@ -33,7 +33,6 @@ import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server (runSMPServerBlocking)
 import Simplex.Messaging.Server.Env.STM
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SMSType (..), SQSType (..))
-import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Client
 import Simplex.Messaging.Transport.Server
@@ -51,6 +50,7 @@ import Util
 
 #if defined(dbServerPostgres)
 import Database.PostgreSQL.Simple (defaultConnectInfo)
+import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
 #endif
 
 #if defined(dbPostgres) || defined(dbServerPostgres)
@@ -126,12 +126,6 @@ testStoreMsgsFile = testPath "smp-server-messages.log"
 testStoreMsgsFile2 :: HasTestEnv => FilePath
 testStoreMsgsFile2 = testPath "smp-server-messages.log.2"
 
-testStoreMsgsDir :: HasTestEnv => FilePath
-testStoreMsgsDir = testPath "messages"
-
-testStoreMsgsDir2 :: HasTestEnv => FilePath
-testStoreMsgsDir2 = testPath "messages.2"
-
 testStoreNtfsFile :: HasTestEnv => FilePath
 testStoreNtfsFile = testPath "smp-server-ntfs.log"
 
@@ -215,24 +209,35 @@ ntfTestServerCredentials =
     }
 
 cfg :: HasTestEnv => AServerConfig
-cfg = cfgMS (ASType SQSMemory SMSJournal)
+cfg = cfgMS (ASType SQSMemory SMSMemory)
 
-cfgJ2 :: HasTestEnv => AServerConfig
-cfgJ2 = journalCfg cfg testStoreLogFile2 testStoreMsgsDir2
+cfgS2 :: HasTestEnv => AServerConfig
+cfgS2 = memoryCfg cfg testStoreLogFile2 testStoreMsgsFile2
 
-cfgJ2QS :: HasTestEnv => SQSType s -> AServerConfig
-cfgJ2QS = \case
-  SQSMemory -> journalCfg (cfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
-  SQSPostgres -> journalCfgDB (cfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2
+cfgS2QS :: HasTestEnv => SQSType s -> AServerConfig
+cfgS2QS = \case
+  SQSMemory -> memoryCfg (cfgMS $ ASType SQSMemory SMSMemory) testStoreLogFile2 testStoreMsgsFile2
+  SQSPostgres -> databaseCfg (cfgMS postgresStoreType) testStoreDBOpts2
 
-journalCfg :: AServerConfig -> FilePath -> FilePath -> AServerConfig
-journalCfg (ASrvCfg _ _ cfg') storeLogFile storeMsgsPath =
-  ASrvCfg SQSMemory SMSJournal cfg' {serverStoreCfg = SSCMemoryJournal {storeLogFile, storeMsgsPath}}
+memoryCfg :: AServerConfig -> FilePath -> FilePath -> AServerConfig
+memoryCfg (ASrvCfg _ _ cfg') storeLogFile storeMsgsFile =
+  ASrvCfg SQSMemory SMSMemory cfg' {serverStoreCfg = SSCMemory $ Just StorePaths {storeLogFile, storeMsgsFile = Just storeMsgsFile}}
 
-journalCfgDB :: AServerConfig -> DBOpts -> FilePath -> AServerConfig
-journalCfgDB (ASrvCfg _ _ cfg') dbOpts storeMsgsPath' =
+databaseCfg :: AServerConfig -> DBOpts -> AServerConfig
+#if defined(dbServerPostgres)
+databaseCfg (ASrvCfg _ _ cfg') dbOpts =
   let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCYesUp, deletedTTL = 86400}
-   in ASrvCfg SQSPostgres SMSJournal cfg' {serverStoreCfg = SSCDatabaseJournal {storeCfg, storeMsgsPath'}}
+   in ASrvCfg SQSPostgres SMSPostgres cfg' {serverStoreCfg = SSCDatabase storeCfg}
+#else
+databaseCfg _ _ = error "no dbServerPostgres flag"
+#endif
+
+postgresStoreType :: AStoreType
+#if defined(dbServerPostgres)
+postgresStoreType = ASType SQSPostgres SMSPostgres
+#else
+postgresStoreType = error "no dbServerPostgres flag"
+#endif
 
 cfgMS :: HasTestEnv => AStoreType -> AServerConfig
 cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
@@ -241,8 +246,6 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       smpHandshakeTimeout = 60000000,
       tbqSize = 4,
       msgQueueQuota = 4,
-      maxJournalMsgCount = 5,
-      maxJournalStateLines = 2,
       queueIdBytes = 24,
       msgIdBytes = 24,
       serverStoreCfg,
@@ -255,7 +258,6 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
       messageExpiration = Just defaultMessageExpiration,
       expireMessagesOnStart = True,
       expireMessagesOnSend = False,
-      idleQueueInterval = defaultIdleQueueInterval,
       notificationExpiration = defaultNtfExpiration,
       inactiveClientExpiration = Just defaultInactiveClientExpiration,
       logStatsInterval = Nothing,
@@ -297,20 +299,22 @@ testServerStoreConfig :: HasTestEnv => AStoreType -> AServerStoreCfg
 testServerStoreConfig = serverStoreConfig_ False
 
 serverStoreConfig_ :: HasTestEnv => Bool -> AStoreType -> AServerStoreCfg
+#if defined(dbServerPostgres)
 serverStoreConfig_ useDbStoreLog = \case
+#else
+serverStoreConfig_ _ = \case
+#endif
   ASType SQSMemory SMSMemory ->
     ASSCfg SQSMemory SMSMemory $ SSCMemory $ Just StorePaths {storeLogFile = testStoreLogFile, storeMsgsFile = Just testStoreMsgsFile}
-  ASType SQSMemory SMSJournal ->
-    ASSCfg SQSMemory SMSJournal $ SSCMemoryJournal {storeLogFile = testStoreLogFile, storeMsgsPath = testStoreMsgsDir}
-  ASType SQSPostgres SMSJournal ->
-    ASSCfg SQSPostgres SMSJournal SSCDatabaseJournal {storeCfg, storeMsgsPath' = testStoreMsgsDir}
 #if defined(dbServerPostgres)
   ASType SQSPostgres SMSPostgres ->
     ASSCfg SQSPostgres SMSPostgres $ SSCDatabase storeCfg
-#endif
   where
     dbStoreLogPath = if useDbStoreLog then Just testStoreLogFile else Nothing
     storeCfg = PostgresStoreCfg {dbOpts = testStoreDBOpts, dbStoreLogPath, confirmMigrations = MCYesUp, deletedTTL = 86400}
+#else
+  ASType SQSPostgres _ -> error "no dbServerPostgres flag"
+#endif
 
 cfgVPrev :: HasTestEnv => AStoreType -> AServerConfig
 cfgVPrev msType = updateCfg (cfgMS msType) $ \cfg' -> cfg' {smpServerVRange = prevRange $ smpServerVRange cfg'}
@@ -325,7 +329,7 @@ nextVersion :: Version v -> Version v
 nextVersion (Version v) = Version (v + 1)
 
 proxyCfg :: HasTestEnv => AServerConfig
-proxyCfg = proxyCfgMS (ASType SQSMemory SMSJournal)
+proxyCfg = proxyCfgMS (ASType SQSMemory SMSMemory)
 
 proxyCfgMS :: HasTestEnv => AStoreType -> AServerConfig
 proxyCfgMS msType =
@@ -336,13 +340,13 @@ proxyCfgMS msType =
             smpAgentCfg = smpAgentCfg' {smpCfg = (smpCfg smpAgentCfg') {agreeSecret = True, proxyServer = True, serverVRange = supportedProxyClientSMPRelayVRange}}
           }
 
-proxyCfgJ2 :: HasTestEnv => AServerConfig
-proxyCfgJ2 = journalCfg proxyCfg testStoreLogFile2 testStoreMsgsDir2
+proxyCfgS2 :: HasTestEnv => AServerConfig
+proxyCfgS2 = memoryCfg proxyCfg testStoreLogFile2 testStoreMsgsFile2
 
-proxyCfgJ2QS :: HasTestEnv => SQSType qs -> AServerConfig
-proxyCfgJ2QS = \case
-  SQSMemory -> journalCfg (proxyCfgMS $ ASType SQSMemory SMSJournal) testStoreLogFile2 testStoreMsgsDir2
-  SQSPostgres -> journalCfgDB (proxyCfgMS $ ASType SQSPostgres SMSJournal) testStoreDBOpts2 testStoreMsgsDir2
+proxyCfgS2QS :: HasTestEnv => SQSType qs -> AServerConfig
+proxyCfgS2QS = \case
+  SQSMemory -> memoryCfg (proxyCfgMS $ ASType SQSMemory SMSMemory) testStoreLogFile2 testStoreMsgsFile2
+  SQSPostgres -> databaseCfg (proxyCfgMS postgresStoreType) testStoreDBOpts2
 
 -- Proxy config with a short relay-connection timeout, to bound how long a failing
 -- proxy->relay connection attempt blocks in the relay reconnection tests.
@@ -430,10 +434,10 @@ withSmpServerProxy :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType)
 withSmpServerProxy (t, msType) = withSmpServerConfigOn t (proxyCfgMS msType) testPort . const
 
 withSmpServers2 :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
-withSmpServers2 ps@(t, ASType qs _ms) = withSmpServer ps . withSmpServerConfigOn t (cfgJ2QS qs) testPort2 . const
+withSmpServers2 ps@(t, ASType qs _ms) = withSmpServer ps . withSmpServerConfigOn t (cfgS2QS qs) testPort2 . const
 
 withSmpServersProxy2 :: (HasCallStack, HasTestEnv) => (ASrvTransport, AStoreType) -> IO a -> IO a
-withSmpServersProxy2 ps@(t, ASType qs _ms) = withSmpServerProxy ps . withSmpServerConfigOn t (proxyCfgJ2QS qs) testPort2 . const
+withSmpServersProxy2 ps@(t, ASType qs _ms) = withSmpServerProxy ps . withSmpServerConfigOn t (proxyCfgS2QS qs) testPort2 . const
 
 runSmpTest :: forall c a. (HasCallStack, HasTestEnv, Transport c) => AStoreType -> (HasCallStack => THandleSMP c 'TClient -> IO a) -> IO a
 runSmpTest msType test = withSmpServerConfigOn (transport @c) (cfgMS msType) testPort $ \_ -> testSMPClient test
@@ -454,7 +458,7 @@ smpServerTest ::
   TProxy c 'TServer ->
   (Maybe TAuthorizations, ByteString, ByteString, smp) ->
   IO (Maybe TAuthorizations, ByteString, ByteString, BrokerMsg)
-smpServerTest _ t = runSmpTest (ASType SQSMemory SMSJournal) $ \h -> tPut' h t >> tGet' h
+smpServerTest _ t = runSmpTest (ASType SQSMemory SMSMemory) $ \h -> tPut' h t >> tGet' h
   where
     tPut' :: THandleSMP c 'TClient -> (Maybe TAuthorizations, ByteString, ByteString, smp) -> IO ()
     tPut' h@THandle {params = THandleParams {sessionId, implySessId}} (sig, corrId, queueId, smp) = do
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index d47d1a29d..e7fabf09b 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -154,9 +154,9 @@ smpProxyTests = do
         it "25 agents, 300 pairs, 17 messages" $ oneServer $ withNumCapabilities 4 $ deliver 25 17
   where
     twoServers test msType = twoServers_ (proxyCfgMS msType) (proxyCfgMS msType) test msType
-    twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
-    twoServersMoreConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 128}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
-    twoServersNoConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 1}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) test msType
+    twoServersFirstProxy test msType = twoServers_ (proxyCfgMS msType) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
+    twoServersMoreConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 128}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
+    twoServersNoConc test msType = twoServers_ (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {serverClientConcurrency = 1}) (updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) test msType
     twoServersPrevProxy test msType = twoServers_ (proxyCfgVPrev msType) (cfgMS msType) test msType
     twoServersPrevRelay test msType = twoServers_ (proxyCfgMS msType) (prevServerVRange $ cfgMS msType) test msType
     prevServerVRange cfg' = updateCfg cfg' $ \cfg_ -> cfg_ {smpServerVRange = prevRange $ smpServerVRange cfg_}
@@ -164,8 +164,8 @@ smpProxyTests = do
     twoServers_ cfg1 cfg2 runTest (ASType qsType _) =
       withSmpServerConfigOn (transport @TLS) cfg1 testPort $ \_ ->
         let cfg2' = case qsType of
-              SQSMemory -> journalCfg cfg2 testStoreLogFile2 testStoreMsgsDir2
-              SQSPostgres -> journalCfgDB cfg2 testStoreDBOpts2 testStoreMsgsDir2
+              SQSMemory -> memoryCfg cfg2 testStoreLogFile2 testStoreMsgsFile2
+              SQSPostgres -> databaseCfg cfg2 testStoreDBOpts2
          in withSmpServerConfigOn (transport @TLS) cfg2' testPort2 $ const runTest
 
 smpProxyCapabilityTests :: SpecWith AStoreType
@@ -175,7 +175,7 @@ smpProxyCapabilityTests = do
   it "5 agents, 10 pairs, 50 messages. N4" $ oneServer $ withNumCapabilities 4 $ deliver 5 50
 
 oneServer :: HasTestEnv => IO a -> AStoreType -> IO a
-oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128, maxJournalMsgCount = 256}) testPort $ const test
+oneServer test msType = withSmpServerConfigOn (transport @TLS) (updateCfg (proxyCfgMS msType) $ \cfg_ -> cfg_ {msgQueueQuota = 128}) testPort $ const test
 
 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']
@@ -405,15 +405,15 @@ agentViaProxyRetryOffline = do
             ackMessage alice bobId (baseId + 4) Nothing
   where
     withServer :: (ThreadId -> IO a) -> IO a
-    withServer = withServer_ testStoreLogFile testStoreMsgsDir testStoreNtfsFile testPort
+    withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
     -- TODO [postgres]
     -- withServer = withServer_ testStoreDBOpts testStoreMsgsDir testStoreNtfsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
-    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
+    withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
     -- TODO [postgres]
     -- withServer2 = withServer_ testStoreDBOpts2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
     withServer_ storeLog storeMsgs storeNtfs =
-      let cfg' = updateCfg (journalCfg proxyCfg storeLog storeMsgs) $ \cfg_ -> cfg_ {storeNtfsFile = Just storeNtfs}
+      let cfg' = updateCfg (memoryCfg proxyCfg storeLog storeMsgs) $ \cfg_ -> cfg_ {storeNtfsFile = Just storeNtfs}
        in withSmpServerConfigOn (transport @TLS) cfg'
     a `up` cId = nGet a =##> \case ("", "", UP _ [c]) -> c == cId; _ -> False
     a `down` cId = nGet a =##> \case ("", "", DOWN _ [c]) -> c == cId; _ -> False
@@ -439,7 +439,7 @@ agentViaProxyRetryNoSession = do
           _ <- runRight $ makeConnection b a
           pure ()
   where
-    withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2
+    withServer2 = withSmpServerConfigOn (transport @TLS) proxyCfgS2 testPort2
     servers srv = initAgentServersProxy {smp = userServers [srv]}
 
 testNoProxy :: HasTestEnv => AStoreType -> IO ()
@@ -483,7 +483,7 @@ testChangedFwdVersion =
 testFwdCorrIdSize :: HasTestEnv => IO ()
 testFwdCorrIdSize =
   withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
-    withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ ->
+    withSmpServerConfigOn (transport @TLS) cfgS2 testPort2 $ \_ ->
       testSMPClient_ "localhost" testPort supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
         (_, _, Right (SMP.PKEY sessId _ _)) <- sendRecv th (Nothing, "1", NoEntity, SMP.PRXY testSMPServer2 Nothing)
         g <- C.newRandom
@@ -495,7 +495,7 @@ testFwdCorrIdSize =
 testForwardedAuthErrorDelay :: HasTestEnv => IO ()
 testForwardedAuthErrorDelay =
   withSmpServerConfigOn (transport @TLS) proxyCfg testPort $ \_ ->
-    withSmpServerConfigOn (transport @TLS) (updateCfg cfgJ2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
+    withSmpServerConfigOn (transport @TLS) (updateCfg cfgS2 $ \cfg_ -> cfg_ {authErrorDelay = 500000}) testPort2 $ \_ -> do
       g <- C.newRandom
       ts <- getCurrentTime
       pc <- either (fail . show) pure =<< getProtocolClient g NRMInteractive (1, testSMPServer, Nothing) defaultSMPClientConfig [] Nothing ts (\_ -> pure ())
@@ -510,7 +510,7 @@ testForwardedAuthErrorDelay =
 -- let any stored connection error expire, then require the proxy to establish the session (PKEY).
 requireProxyReconnect :: HasTestEnv => IO ()
 requireProxyReconnect =
-  withSmpServerConfigOn (transport @TLS) proxyCfgJ2 testPort2 $ \_ -> do
+  withSmpServerConfigOn (transport @TLS) proxyCfgS2 testPort2 $ \_ -> do
     testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
       (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
       reply `shouldBe` Right SMP.PONG
@@ -566,7 +566,7 @@ testAgentClientReconnectAfterCancel =
       t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn False SMSubscribe
       threadDelay 1000000 -- let the connect to the stalling relay start, then kill it mid-flight
       cancel t
-    withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ -> do
+    withSmpServerConfigOn (transport @TLS) cfgS2 testPort2 $ \_ -> do
       testSMPClient_ "127.0.0.1" testPort2 supportedServerSMPRelayVRange Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
         (_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
         reply `shouldBe` Right SMP.PONG -- the relay is up and reachable, so a timeout can only be the poisoned var
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 89a2a00fa..88554fcff 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -24,7 +24,6 @@ import Control.Concurrent.STM
 import Control.Exception (SomeException, throwIO, try)
 import Control.Monad
 import Control.Monad.IO.Class
-import CoreTests.MsgStoreTests (testJournalStoreCfg)
 import Data.Bifunctor (first)
 import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
@@ -47,17 +46,14 @@ import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll, parseString)
 import Simplex.Messaging.Protocol
-import Simplex.Messaging.Server (exportMessages)
-import Simplex.Messaging.Server.Env.STM (AStoreType (..), MsgStore (..), ServerConfig (..), ServerStoreCfg (..), readWriteQueueStore)
+import Simplex.Messaging.Server.Env.STM (AStoreType (..), ServerConfig (..), ServerStoreCfg (..))
 import Simplex.Messaging.Server.Expiration
-import Simplex.Messaging.Server.MsgStore.Journal (JournalStoreConfig (..), QStoreCfg (..), stmQueueStore)
-import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), QSType (..), SMSType (..), SQSType (..), newMsgStore)
+import Simplex.Messaging.Server.MsgStore.Types (SMSType (..), SQSType (..))
 import Simplex.Messaging.Server.Stats (PeriodStatsData (..), ServerStatsData (..))
-import Simplex.Messaging.Server.StoreLog (StoreLogRecord (..), closeStoreLog)
+import Simplex.Messaging.Server.StoreLog (StoreLogRecord (..))
 import Simplex.Messaging.Transport
 import Simplex.Messaging.Transport.Credentials
-import Simplex.Messaging.Util (whenM)
-import System.Directory (doesDirectoryExist, doesFileExist, removeDirectoryRecursive, removeFile)
+import System.Directory (doesFileExist, removeFile)
 import System.IO (IOMode (..), withFile)
 import System.Timeout
 import Test.HUnit
@@ -65,8 +61,11 @@ import Test.Hspec hiding (fit, it, xit)
 import Util
 
 #if defined(dbServerPostgres)
-import CoreTests.MsgStoreTests (testPostgresStoreConfig)
+import CoreTests.MsgStoreTests (testPostgresStoreConfig, testSMTStoreConfig)
+import Simplex.Messaging.Server.Env.STM (readWriteQueueStore)
 import Simplex.Messaging.Server.MsgStore.Postgres (PostgresMsgStoreCfg (..), exportDbMessages)
+import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
+import Simplex.Messaging.Server.StoreLog (closeStoreLog)
 #endif
 
 serverTests :: SpecWith (ASrvTransport, AStoreType)
@@ -1068,7 +1067,6 @@ 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
     removeFileIfExists testServerStatsBackupFile
 
     g <- C.newRandom
@@ -1138,7 +1136,6 @@ testRestoreMessages =
     Right stats3 <- strDecode <$> B.readFile testServerStatsBackupFile
     checkStats stats3 [rId] 5 5
     removeFileIfExists testStoreMsgsFile
-    whenM (doesDirectoryExist testStoreMsgsDir) $ removeDirectoryRecursive testStoreMsgsDir
     removeFile testServerStatsBackupFile
   where
     runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
@@ -1218,28 +1215,23 @@ testRestoreExpireMessages =
   where
     exportStoreMessages :: HasTestEnv => AStoreType -> IO ()
     exportStoreMessages = \case
-      ASType _ SMSJournal -> export
       ASType _ SMSPostgres -> exportDB
       ASType _ SMSMemory -> pure ()
       where
-        export = do
-          ms <- readWriteQueues
-          exportMessages False (StoreJournal ms) testStoreMsgsFile False
-          closeMsgStore ms
 #if defined(dbServerPostgres)
         exportDB = do
           readWriteQueues >>= closeMsgStore
           ms' <- newMsgStore (testPostgresStoreConfig {quota = 4} :: PostgresMsgStoreCfg)
           _n <- withFile testStoreMsgsFile WriteMode $ exportDbMessages False ms'
           closeMsgStore ms'
+        readWriteQueues = do
+          ms <- newMsgStore testSMTStoreConfig
+          readWriteQueueStore True (mkQueue ms True) testStoreLogFile (queueStore ms) >>= closeStoreLog
+          removeFileIfExists testStoreMsgsFile
+          pure ms
 #else
         exportDB = error "compiled without server_postgres flag"
 #endif
-        readWriteQueues = do
-          ms <- newMsgStore ((testJournalStoreCfg MQStoreCfg) {quota = 4} :: JournalStoreConfig 'QSMemory)
-          readWriteQueueStore True (mkQueue ms True) testStoreLogFile (stmQueueStore ms) >>= closeStoreLog
-          removeFileIfExists testStoreMsgsFile
-          pure ms
     runTest :: (HasTestEnv, Transport c) => TProxy c 'TServer -> (THandleSMP c 'TClient -> IO ()) -> ThreadId -> Expectation
     runTest _ test' server = do
       testSMPClient test' `shouldReturn` ()
@@ -1576,7 +1568,7 @@ testMsgExpireOnInterval =
   it "should expire messages that are not received before messageTTL after expiry interval" $ \(ATransport (t :: TProxy c 'TServer), msType) -> do
     g <- C.newRandom
     (sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
-    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {messageExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1}, idleQueueInterval = 1}
+    let cfg' = updateCfg (cfgMS msType) $ \cfg_ -> cfg_ {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
diff --git a/tests/Test.hs b/tests/Test.hs
index ccaf542f6..f8b42bc03 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -101,37 +101,27 @@ main = do
             describe "RSLV functional API tests" rslvTests
             describe "Agent core tests" agentCoreTests
 #if defined(dbServerPostgres)
-          -- xdescribe "SMP server via TLS, postgres+jornal message store" $
-          --   before (pure (transport @TLS, ASType SQSPostgres SMSJournal)) serverTests
           describe "SMP server via TLS, postgres-only message store" $
             before (pure (transport @TLS, ASType SQSPostgres SMSPostgres)) serverTests
 #endif
-          describe "SMP server via TLS, jornal message store" $ do
+          describe "SMP server via TLS, memory message store" $ do
             describe "SMP syntax" $ serverSyntaxTests (transport @TLS)
-            before (pure (transport @TLS, ASType SQSMemory SMSJournal)) serverTests
-          describe "SMP server via TLS, memory message store" $
             before (pure (transport @TLS, ASType SQSMemory SMSMemory)) serverTests
           -- xdescribe "SMP server via WebSockets" $ do
           --   describe "SMP syntax" $ serverSyntaxTests (transport @WS)
-          --   before (pure (transport @WS, ASType SQSMemory SMSJournal)) serverTests
+          --   before (pure (transport @WS, ASType SQSMemory SMSMemory)) serverTests
 #if defined(dbServerPostgres)
           describe "Notifications server (SMP server: memory store)" $
             ntfServerTests (transport @TLS, ASType SQSMemory SMSMemory)
-          -- xdescribe "Notifications server (SMP server: postgres+jornal store)" $
-          --   ntfServerTests (transport @TLS, ASType SQSPostgres SMSJournal)
           describe "Notifications server (SMP server: postgres-only store)" $
             ntfServerTests (transport @TLS, ASType SQSPostgres SMSPostgres)
-          -- xdescribe "SMP client agent, postgres+jornal message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSJournal)
           describe "SMP client agent, server postgres-only message store" $ agentTests (transport @TLS, ASType SQSPostgres SMSPostgres)
-          -- xdescribe "SMP proxy, postgres+jornal message store" $
-          --   before (pure $ ASType SQSPostgres SMSJournal) smpProxyTests
           describe "SMP proxy, postgres-only message store" $
             before (pure $ ASType SQSPostgres SMSPostgres) smpProxyTests
 #endif
-          -- xdescribe "SMP client agent, server jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal)
           describe "SMP client agent, server memory message store" $ agentTests (transport @TLS, ASType SQSMemory SMSMemory)
-          describe "SMP proxy, jornal message store" $
-            before (pure $ ASType SQSMemory SMSJournal) smpProxyTests
+          describe "SMP proxy, memory message store" $
+            before (pure $ ASType SQSMemory SMSMemory) smpProxyTests
           describe "XFTP" $ do
             describe "XFTP server" $
               before (pure $ AFSType SFSMemory) xftpServerTests
@@ -155,8 +145,6 @@ main = do
           describe "SMP server via TLS, postgres-only message store" $
             before (pure (transport @TLS, ASType SQSPostgres SMSPostgres)) $ describe "Timing of AUTH error" testTiming
 #endif
-          describe "SMP server via TLS, jornal message store" $
-            before (pure (transport @TLS, ASType SQSMemory SMSJournal)) $ describe "Timing of AUTH error" testTiming
           describe "SMP server via TLS, memory message store" $
             before (pure (transport @TLS, ASType SQSMemory SMSMemory)) $ describe "Timing of AUTH error" testTiming
 #if defined(dbServerPostgres)
@@ -169,8 +157,8 @@ main = do
           describe "SMP proxy capabilities, postgres-only message store" $
             before (pure $ ASType SQSPostgres SMSPostgres) smpProxyCapabilityTests
 #endif
-          describe "SMP proxy capabilities, jornal message store" $
-            before (pure $ ASType SQSMemory SMSJournal) smpProxyCapabilityTests
+          describe "SMP proxy capabilities, memory message store" $
+            before (pure $ ASType SQSMemory SMSMemory) smpProxyCapabilityTests
           describe "XFTP CLI (memory)" $
             before (pure $ AFSType SFSMemory) xftpCLIFileTests
 #if defined(dbServerPostgres)

From e91711c7d7405117e94808e1ae30eeff38907faf Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Thu, 15 Oct 2026 22:36:45 +0400
Subject: [PATCH 19/20] smp-server: remove journal store leftovers (#1946)

* smp-server: remove postgres queue cache

* smp-server: remove queue locks

* smp-server: simplify message store class

* smp-server: remove unused functions and exports

* tests: remove journal leftovers

* agent: remove unused lock exports

* fix

* fixes

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
---
 src/Simplex/Messaging/Agent/Client.hs         |   1 -
 src/Simplex/Messaging/Agent/Lock.hs           |   1 -
 src/Simplex/Messaging/Server.hs               |  49 ++--
 src/Simplex/Messaging/Server/Env/STM.hs       |   5 +-
 src/Simplex/Messaging/Server/Main.hs          |  13 +-
 .../Messaging/Server/MsgStore/Postgres.hs     |  87 ++-----
 src/Simplex/Messaging/Server/MsgStore/STM.hs  | 162 +++++++-----
 .../Messaging/Server/MsgStore/Types.hs        |  98 +-------
 src/Simplex/Messaging/Server/Prometheus.hs    |  10 +-
 .../Messaging/Server/QueueStore/Postgres.hs   | 233 ++++--------------
 .../Messaging/Server/QueueStore/STM.hs        |  12 +-
 .../Messaging/Server/QueueStore/Types.hs      |  16 +-
 .../Messaging/Server/StoreLog/ReadWrite.hs    |   4 +-
 tests/AgentTests/FunctionalAPITests.hs        |   2 +-
 tests/CoreTests/MsgStoreTests.hs              |  22 --
 tests/CoreTests/StoreLogTests.hs              |   2 +-
 tests/SMPProxyTests.hs                        |   4 -
 tests/ServerTests.hs                          |   2 +-
 18 files changed, 206 insertions(+), 517 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs
index 08eb64ea9..382608fde 100644
--- a/src/Simplex/Messaging/Agent/Client.hs
+++ b/src/Simplex/Messaging/Agent/Client.hs
@@ -34,7 +34,6 @@ module Simplex.Messaging.Agent.Client
     withInvLock,
     withLockMap,
     withLocksMap,
-    getMapLock,
     ipAddressProtected,
     closeAgentClient,
     closeProtocolServerClients,
diff --git a/src/Simplex/Messaging/Agent/Lock.hs b/src/Simplex/Messaging/Agent/Lock.hs
index 18a6f0985..081c53b68 100644
--- a/src/Simplex/Messaging/Agent/Lock.hs
+++ b/src/Simplex/Messaging/Agent/Lock.hs
@@ -6,7 +6,6 @@ module Simplex.Messaging.Agent.Lock
     withLock',
     withGetLock,
     withGetLocks,
-    getPutLock,
   )
 where
 
diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 8b49ef441..813b52fe1 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -33,9 +33,6 @@ module Simplex.Messaging.Server
   ( runSMPServer,
     runSMPServerBlocking,
     controlPortAuth,
-    importMessages,
-    exportMessages,
-    printMessageStats,
     disconnectTransport,
     verifyCmdAuthorization,
     dummyVerifyCmd,
@@ -115,6 +112,7 @@ import Simplex.Messaging.Server.NtfStore
 import Simplex.Messaging.Server.Prometheus
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.QueueStore.STM (withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.Stats
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
@@ -144,7 +142,7 @@ import GHC.Conc.Sync (threadLabel)
 #endif
 
 #if defined(dbServerPostgres)
-import Simplex.Messaging.Server.MsgStore.Postgres (exportDbMessages, getDbMessageStats)
+import Simplex.Messaging.Server.MsgStore.Postgres (getDbMessageStats)
 #endif
 
 -- | Runs an SMP server using passed configuration.
@@ -2346,34 +2344,27 @@ randomId = fmap EntityId . randomId'
 
 saveServerMessages :: Bool -> MsgStore s -> IO ()
 saveServerMessages drainMsgs ms = case ms of
-  StoreMemory STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-    Just f -> exportMessages False ms f drainMsgs
+  StoreMemory ms'@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
+    Just f -> exportMessages ms' f drainMsgs
     Nothing -> logNote "undelivered messages are not saved"
 #if defined(dbServerPostgres)
   StoreDatabase _ -> logNote "closed postgres message storage"
 #endif
 
-exportMessages :: forall s. MsgStoreClass s => Bool -> MsgStore s -> FilePath -> Bool -> IO ()
-exportMessages tty st f drainMsgs = do
+exportMessages :: STMMsgStore -> FilePath -> Bool -> IO ()
+exportMessages ms f drainMsgs = do
   logNote $ "saving messages to file " <> T.pack f
-  run $ case st of
-    StoreMemory ms -> exportMessages_ ms $ getMsgs ms
-#if defined(dbServerPostgres)
-    StoreDatabase ms -> exportDbMessages tty ms
-#endif
+  run $ fmap (\(Sum n) -> n) . withLoadedQueues (queueStore ms) . saveQueueMsgs
   where
-    exportMessages_ ms get = fmap (\(Sum n) -> n) . unsafeWithAllMsgQueues tty ms . saveQueueMsgs get
     run :: (Handle -> IO Int) -> IO ()
     run a = liftIO $ withFile f WriteMode $ tryAny . a >=> \case
       Right n -> logNote $ "messages saved: " <> tshow n
       Left e -> do
         logError $ "error exporting messages: " <> tshow e
         exitFailure
-    getMsgs :: MsgStoreClass s' => s' -> StoreQueue s' -> IO [Message]
-    getMsgs ms q = unsafeRunStore q "saveQueueMsgs" $ getQueueMessages_ drainMsgs q =<< getMsgQueue ms q False
-    saveQueueMsgs :: (StoreQueue s -> IO [Message]) -> Handle -> StoreQueue s -> IO (Sum Int)
-    saveQueueMsgs get h q = do
-      msgs <- get q
+    saveQueueMsgs :: Handle -> STMQueue -> IO (Sum Int)
+    saveQueueMsgs h q = do
+      msgs <- atomically $ getQueueMessages_ drainMsgs =<< getMsgQueue q
       unless (null msgs) $ BLD.hPutBuilder h $ encodeMessages (recipientId q) msgs
       pure $ Sum $ length msgs
     encodeMessages rId = mconcat . map (\msg -> BLD.byteString (strEncode $ MLRv3 rId msg) <> BLD.char8 '\n')
@@ -2391,7 +2382,7 @@ processServerMessages StartOptions {skipWarnings} = do
       processMessages old_ _ = \case
 #endif
         StoreMemory ms@STMMsgStore {storeConfig = STMStoreConfig {storePath}} -> case storePath of
-          Just f -> ifM (doesFileExist f) (Just <$> importMessages False ms f old_ skipWarnings) (pure Nothing)
+          Just f -> ifM (doesFileExist f) (Just <$> importMessages ms f old_ skipWarnings) (pure Nothing)
           Nothing -> pure Nothing
 #if defined(dbServerPostgres)
         StoreDatabase ms -> processDbMessages old_ expire ms
@@ -2406,18 +2397,17 @@ processServerMessages StartOptions {skipWarnings} = do
         | otherwise = logWarn "skipping message expiration" $> Nothing
 #endif
 
-importMessages :: forall s. MsgStoreClass s => Bool -> s -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
-importMessages tty ms f old_ skipWarnings  = do
+importMessages :: STMMsgStore -> FilePath -> Maybe Int64 -> Bool -> IO MessageStats
+importMessages ms f old_ skipWarnings  = do
   logNote $ "restoring messages from file " <> T.pack f
   (_, (storedMsgsCount, expiredMsgsCount, overQuota)) <-
-    foldLogLines tty f restoreMsg (Nothing, (0, 0, M.empty))
+    foldLogLines False f restoreMsg (Nothing, (0, 0, M.empty))
   renameFile f $ f <> ".bak"
   mapM_ setOverQuota_ overQuota
-  logQueueStates ms
-  EntityCounts {queueCount} <- liftIO $ getEntityCounts @(StoreQueue s) $ queueStore ms
+  EntityCounts {queueCount} <- liftIO $ getEntityCounts @STMQueue $ queueStore ms
   pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = queueCount}
   where
-    restoreMsg :: (Maybe (RecipientId, StoreQueue s), (Int, Int, Map RecipientId (StoreQueue s))) -> Bool -> ByteString -> IO (Maybe (RecipientId, StoreQueue s), (Int, Int, Map RecipientId (StoreQueue s)))
+    restoreMsg :: (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue)) -> Bool -> ByteString -> IO (Maybe (RecipientId, STMQueue), (Int, Int, Map RecipientId STMQueue))
     restoreMsg (q_, counts@(!stored, !expired, !overQuota)) eof s = case strDecode s of
       Right (MLRv3 rId msg) -> runExceptT (addToMsgQueue rId msg) >>= either (exitErr . tshow) pure
       Left e
@@ -2425,7 +2415,6 @@ importMessages tty ms f old_ skipWarnings  = do
         | otherwise -> exitErr $ parsingErr e
       where
         exitErr e = do
-          when tty $ putStrLn ""
           logError $ "error restoring messages: " <> e
           liftIO exitFailure
         parsingErr :: String -> Text
@@ -2438,7 +2427,6 @@ importMessages tty ms f old_ skipWarnings  = do
           case qOrErr of
             Right q -> addToQueue_ q rId msg
             Left AUTH -> liftIO $ do
-              when tty $ putStrLn ""
               warnOrExit $ "queue " <> safeDecodeUtf8 (encode $ unEntityId rId) <> " does not exist"
               pure (Nothing, counts)
             Left e -> throwE e
@@ -2449,7 +2437,6 @@ importMessages tty ms f old_ skipWarnings  = do
                   writeMsg ms q False msg >>= \case
                     Just _ -> pure (stored + 1, expired, overQuota)
                     Nothing -> liftIO $ do
-                      when tty $ putStrLn ""
                       logError $ decodeLatin1 $ "message queue " <> strEncode rId <> " is full, message not restored: " <> strEncode (messageId msg)
                       pure counts
               | otherwise -> pure (stored, expired + 1, overQuota)
@@ -2460,8 +2447,8 @@ importMessages tty ms f old_ skipWarnings  = do
               where
                 -- if the first message in queue head is "quota", remove it.
                 mergeQuotaMsgs =
-                  withPeekMsgQueue ms q "mergeQuotaMsgs" $ maybe (pure ()) $ \case
-                    (mq, MessageQuota {}) -> tryDeleteMsg_ q mq False
+                  withPeekMsgQueue q $ maybe (pure ()) $ \case
+                    (mq, MessageQuota {}) -> tryDeleteMsg_ mq
                     _ -> pure ()
         warnOrExit e
           | skipWarnings = logWarn e'
diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs
index 40000db9d..4c0b1d566 100644
--- a/src/Simplex/Messaging/Server/Env/STM.hs
+++ b/src/Simplex/Messaging/Server/Env/STM.hs
@@ -555,7 +555,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
     SSCMemory storePaths_ -> do
       let storePath = storeMsgsFile =<< storePaths_
       ms <- newMsgStore STMStoreConfig {storePath, quota = msgQueueQuota}
-      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms True) f $ queueStore ms
+      forM_ storePaths_ $ \StorePaths {storeLogFile = f} -> loadStoreLog (mkQueue ms) f $ queueStore ms
       pure $ StoreMemory ms
 #if defined(dbServerPostgres)
     SSCDatabase storeCfg -> do
@@ -614,8 +614,7 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
       Just f -> do
         logNote $ "compacting queues in file " <> T.pack f
         st <- newMsgStore STMStoreConfig {storePath = Nothing, quota = msgQueueQuota}
-        -- we don't need to have locks in the map
-        sl <- readWriteQueueStore False (mkQueue st False) f (queueStore st)
+        sl <- readWriteQueueStore False (mkQueue st) f (queueStore st)
         setStoreLog (queueStore st) sl
         closeMsgStore st
       Nothing -> do
diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs
index 53864c5bd..996624838 100644
--- a/src/Simplex/Messaging/Server/Main.hs
+++ b/src/Simplex/Messaging/Server/Main.hs
@@ -28,7 +28,6 @@ module Simplex.Messaging.Server.Main
     importMessagesToDatabase,
     exportDatabaseToStoreLog,
 #endif
-    storeMsgsJournalDir',
     getServerSourceCode,
     simplexmqSource,
     serverPublicInfo,
@@ -95,7 +94,7 @@ import Data.Semigroup (Sum (..))
 import Simplex.Messaging.Agent.Store.Postgres (checkSchemaExists)
 import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..))
 import Simplex.Messaging.Server.MsgStore.Postgres
-import Simplex.Messaging.Server.MsgStore.STM (STMQueue, STMStoreConfig (..))
+import Simplex.Messaging.Server.MsgStore.STM (STMStoreConfig (..))
 import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), newMsgStore)
 import Simplex.Messaging.Server.QueueStore.Postgres.Config
 import Simplex.Messaging.Server.QueueStore.Postgres (PostgresQueueStore, batchInsertQueues, batchInsertServices, foldQueueRecs, foldServiceRecs)
@@ -617,14 +616,14 @@ importStoreLogToDatabase :: FilePath -> DBOpts -> IO (Int64, Int64)
 importStoreLogToDatabase storeLogFile dbOpts = do
   ms <- newMsgStore STMStoreConfig {storePath = Nothing, quota = defaultMsgQueueQuota}
   let st = queueStore ms
-  sl <- readWriteQueueStore True (mkQueue ms False) storeLogFile st
+  sl <- readWriteQueueStore True (mkQueue ms) storeLogFile st
   closeStoreLog sl
-  queues <- readTVarIO $ loadedQueues st
+  qs <- readTVarIO $ queues st
   services' <- M.elems <$> readTVarIO (services st)
   let storeCfg = PostgresStoreCfg {dbOpts = dbOpts {createSchema = True}, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
   sCnt <- batchInsertServices services' ps
-  qCnt <- batchInsertQueues @STMQueue True queues ps
+  qCnt <- batchInsertQueues True qs ps
   closeQueueStore @PostgresQueue ps
   renameFile storeLogFile $ storeLogFile <> ".bak"
   pure (sCnt, qCnt)
@@ -647,7 +646,7 @@ importMessagesToDatabase msgsLogFile dbOpts = do
 exportDatabaseToStoreLog :: DBOpts -> FilePath -> IO (Int, Int)
 exportDatabaseToStoreLog dbOpts storeLogFilePath = do
   let storeCfg = PostgresStoreCfg {dbOpts, dbStoreLogPath = Nothing, confirmMigrations = MCConsole, deletedTTL = 86400 * defaultDeletedTTL}
-  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
+  ps :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
   sl <- openWriteStoreLog False storeLogFilePath
   Sum sCnt <- foldServiceRecs ps $ \sr -> logNewService sl sr $> Sum (1 :: Int)
   Sum qCnt <- foldQueueRecs True True ps $ \(rId, qr) -> logCreateQueue sl rId qr $> Sum (1 :: Int)
diff --git a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
index 821c5e7f2..b13d1e0a5 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Postgres.hs
@@ -29,7 +29,6 @@ where
 import Control.Concurrent.STM
 import qualified Control.Exception as E
 import Control.Monad
-import Control.Monad.Reader
 import Control.Monad.Trans.Except
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as BB
@@ -39,7 +38,6 @@ import Data.IORef
 import Data.Int (Int64)
 import Data.List (intersperse)
 import qualified Data.Map.Strict as M
-import Data.Text (Text)
 import Data.Time.Clock.System (SystemTime (..))
 import Database.PostgreSQL.Simple (Binary (..), In (..), Only (..), (:.) (..))
 import qualified Database.PostgreSQL.Simple as DB
@@ -56,7 +54,7 @@ import Simplex.Messaging.Server.QueueStore.Postgres
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog (foldLogLines)
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow', (<$$>))
+import Simplex.Messaging.Util (maybeFirstRow, maybeFirstRow')
 import System.IO (Handle, hFlush, stdout)
 
 data PostgresMsgStore = PostgresMsgStore
@@ -81,32 +79,20 @@ instance StoreQueueClass PostgresQueue where
   {-# INLINE recipientId #-}
   queueRec = queueRec'
   {-# INLINE queueRec #-}
-  withQueueLock PostgresQueue {} _ = id -- TODO [messages] maybe it's just transaction?
-  {-# INLINE withQueueLock #-}
-
-newtype DBTransaction = DBTransaction {dbConn :: DB.Connection}
-
-type DBStoreIO a = ReaderT DBTransaction IO a
 
 instance MsgStoreClass PostgresMsgStore where
-  type StoreMonad PostgresMsgStore = ReaderT DBTransaction IO
-  type MsgQueue PostgresMsgStore = ()
   type QueueStore PostgresMsgStore = PostgresQueueStore'
   type StoreQueue PostgresMsgStore = PostgresQueue
   type MsgStoreConfig PostgresMsgStore = PostgresMsgStoreCfg
 
   newMsgStore :: PostgresMsgStoreCfg -> IO PostgresMsgStore
   newMsgStore config = do
-    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config, False)
+    queueStore_ <- newQueueStore @PostgresQueue (queueStoreCfg config)
     pure PostgresMsgStore {config, queueStore_}
 
   closeMsgStore :: PostgresMsgStore -> IO ()
   closeMsgStore = closeQueueStore @PostgresQueue . queueStore_
 
-  withActiveMsgQueues _ _ = error "withActiveMsgQueues not used"
-
-  unsafeWithAllMsgQueues _ _ _ = error "unsafeWithAllMsgQueues not used"
-
   expireOldMessages :: Bool -> PostgresMsgStore -> Int64 -> Int64 -> IO MessageStats
   expireOldMessages _tty ms now ttl =
     maybeFirstRow' newMessageStats toMessageStats $ withConnection st $ \db ->
@@ -150,35 +136,16 @@ instance MsgStoreClass PostgresMsgStore where
             msg_ = toMaybeMessage mRow
          in f a rId $ Right ((qr,) <$> msg_)
 
-  logQueueStates _ = error "logQueueStates not used"
-
-  logQueueState _ = error "logQueueState not used"
-
   queueStore = queueStore_
   {-# INLINE queueStore #-}
 
   loadedQueueCounts :: PostgresMsgStore -> IO LoadedQueueCounts
-  loadedQueueCounts ms = do
-    loadedQueueCount <- M.size <$> readTVarIO queues
-    loadedNotifierCount <- M.size <$> readTVarIO notifiers
-    notifierLockCount <- M.size <$> readTVarIO notifierLocks
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, queueLockCount = 0, notifierLockCount}
-    where
-      PostgresQueueStore {queues, notifiers, notifierLocks} = queueStore_ ms
+  loadedQueueCounts _ = pure LoadedQueueCounts {loadedQueueCount = 0, loadedNotifierCount = 0}
 
-  mkQueue :: PostgresMsgStore -> Bool -> RecipientId -> QueueRec -> IO PostgresQueue
-  mkQueue _ _keepLock rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
+  mkQueue :: PostgresMsgStore -> RecipientId -> QueueRec -> IO PostgresQueue
+  mkQueue _ rId qr = PostgresQueue rId <$> newTVarIO (Just qr)
   {-# INLINE mkQueue #-}
 
-  getMsgQueue _ _ _ = pure ()
-  {-# INLINE getMsgQueue #-}
-
-  getPeekMsgQueue :: PostgresMsgStore -> PostgresQueue -> DBStoreIO (Maybe ((), Message))
-  getPeekMsgQueue _ q = ((),) <$$> tryPeekMsg_ q ()
-
-  withIdleMsgQueue :: Int64 -> PostgresMsgStore -> PostgresQueue -> (() -> DBStoreIO a) -> DBStoreIO (Maybe a, Int)
-  withIdleMsgQueue _ _ _ _ = error "withIdleMsgQueue not used"
-
   deleteQueue :: PostgresMsgStore -> PostgresQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms q = deleteStoreQueue (queueStore_ ms) q
   {-# INLINE deleteQueue #-}
@@ -189,8 +156,6 @@ instance MsgStoreClass PostgresMsgStore where
     qr <- ExceptT $ deleteStoreQueue (queueStore_ ms) q
     pure (qr, size)
 
-  getQueueMessages_ _ _ _ = error "getQueueMessages_ not used"
-
   writeMsg :: PostgresMsgStore -> PostgresQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms q _ msg =
     uninterruptibleMask_ $
@@ -209,43 +174,25 @@ instance MsgStoreClass PostgresMsgStore where
         [] -> Nothing
       PostgresMsgStore {config = PostgresMsgStoreCfg {quota}} = ms
 
-  setOverQuota_ :: PostgresQueue -> IO () -- can ONLY be used while restoring messages, not while server running
-  setOverQuota_ _ = error "TODO setOverQuota_" -- TODO [messages]
-
-  getQueueSize_ :: () -> DBStoreIO Int
-  getQueueSize_ _ = error "getQueueSize_ not used"
-
   getQueueSize :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO Int
   getQueueSize ms q =
     withDB' "getQueueSize" (queueStore_ ms) $ \db ->
       maybeFirstRow' 0 fromOnly $
         DB.query db "SELECT msg_queue_size FROM msg_queues WHERE recipient_id = ? AND deleted_at IS NULL" (Only (recipientId' q))
 
-  tryPeekMsg_ :: PostgresQueue -> () -> DBStoreIO (Maybe Message)
-  tryPeekMsg_ q _ = do
-    db <- asks dbConn
-    liftIO $ maybeFirstRow toMessage $
-      DB.query
-        db
-        [sql|
-          SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
-          FROM messages
-          WHERE recipient_id = ?
-          ORDER BY message_id ASC LIMIT 1
-        |]
-        (Only (recipientId' q))
-
-  tryDeleteMsg_ :: PostgresQueue -> () -> Bool -> DBStoreIO ()
-  tryDeleteMsg_ _q _ _ = error "tryDeleteMsg_ not used" -- do
-
-  isolateQueue :: PostgresMsgStore -> PostgresQueue -> Text -> DBStoreIO a -> ExceptT ErrorType IO a
-  isolateQueue ms _q op a = uninterruptibleMask_ $ withDB' op (queueStore_ ms) $ runReaderT a . DBTransaction
-
-  unsafeRunStore _ _ _ = error "unsafeRunStore not used"
-
   tryPeekMsg :: PostgresMsgStore -> PostgresQueue -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg ms q = isolateQueue ms q "tryPeekMsg" $ tryPeekMsg_ q ()
-  {-# INLINE tryPeekMsg #-}
+  tryPeekMsg ms q =
+    uninterruptibleMask_ $ withDB' "tryPeekMsg" (queueStore_ ms) $ \db ->
+      maybeFirstRow toMessage $
+        DB.query
+          db
+          [sql|
+            SELECT msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body
+            FROM messages
+            WHERE recipient_id = ?
+            ORDER BY message_id ASC LIMIT 1
+          |]
+          (Only (recipientId' q))
 
   tryPeekMsgs :: PostgresMsgStore -> [PostgresQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
   tryPeekMsgs _ms [] = pure M.empty
diff --git a/src/Simplex/Messaging/Server/MsgStore/STM.hs b/src/Simplex/Messaging/Server/MsgStore/STM.hs
index 0607ef8b5..1f9b7a256 100644
--- a/src/Simplex/Messaging/Server/MsgStore/STM.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/STM.hs
@@ -15,6 +15,11 @@ module Simplex.Messaging.Server.MsgStore.STM
   ( STMMsgStore (..),
     STMStoreConfig (..),
     STMQueue,
+    getMsgQueue,
+    withPeekMsgQueue,
+    getQueueMessages_,
+    setOverQuota_,
+    tryDeleteMsg_,
   )
 where
 
@@ -24,7 +29,8 @@ import Control.Monad.Trans.Except
 import Data.Functor (($>))
 import Data.Int (Int64)
 import qualified Data.Map.Strict as M
-import Data.Text (Text)
+import Data.Maybe (catMaybes)
+import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
@@ -61,12 +67,8 @@ instance StoreQueueClass STMQueue where
   {-# INLINE recipientId #-}
   queueRec = queueRec'
   {-# INLINE queueRec #-}
-  withQueueLock _ _ = id
-  {-# INLINE withQueueLock #-}
 
 instance MsgStoreClass STMMsgStore where
-  type StoreMonad STMMsgStore = STM
-  type MsgQueue STMMsgStore = STMMsgQueue
   type QueueStore STMMsgStore = STMQueueStore STMQueue
   type StoreQueue STMMsgStore = STMQueue
   type MsgStoreConfig STMMsgStore = STMStoreConfig
@@ -78,24 +80,16 @@ instance MsgStoreClass STMMsgStore where
 
   closeMsgStore = closeQueueStore @STMQueue . queueStore_
   {-# INLINE closeMsgStore #-}
-  withActiveMsgQueues = withLoadedQueues . queueStore_
-  {-# INLINE withActiveMsgQueues #-}
-  unsafeWithAllMsgQueues _ = withLoadedQueues . queueStore_
-  {-# INLINE unsafeWithAllMsgQueues #-}
 
   expireOldMessages :: Bool -> STMMsgStore -> Int64 -> Int64 -> IO MessageStats
   expireOldMessages _tty ms now ttl =
-    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs ms now (now - ttl)
+    withLoadedQueues (queueStore_ ms) $ atomically . expireQueueMsgs (now - ttl)
 
   foldRcvServiceMessages :: STMMsgStore -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
   foldRcvServiceMessages ms serviceId f = fmap Right . foldRcvServiceQueues (queueStore_ ms) serviceId f'
     where
       f' a (q, qr) = runExceptT (tryPeekMsg ms q) >>= f a (recipientId q) . ((qr,) <$$>)
 
-  logQueueStates _ = pure ()
-  {-# INLINE logQueueStates #-}
-  logQueueState _ = pure ()
-  {-# INLINE logQueueState #-}
   queueStore = queueStore_
   {-# INLINE queueStore #-}
 
@@ -103,34 +97,11 @@ instance MsgStoreClass STMMsgStore where
   loadedQueueCounts STMMsgStore {queueStore_ = st} = do
     loadedQueueCount <- M.size <$> readTVarIO (queues st)
     loadedNotifierCount <- M.size <$> readTVarIO (notifiers st)
-    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount, queueLockCount = 0, notifierLockCount = 0}
+    pure LoadedQueueCounts {loadedQueueCount, loadedNotifierCount}
 
-  mkQueue _ _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
+  mkQueue _ rId qr = STMQueue rId <$> newTVarIO (Just qr) <*> newTVarIO Nothing
   {-# INLINE mkQueue #-}
 
-  getMsgQueue :: STMMsgStore -> STMQueue -> Bool -> STM STMMsgQueue
-  getMsgQueue _ STMQueue {msgQueue'} _ = readTVar msgQueue' >>= maybe newQ pure
-    where
-      newQ = do
-        msgTQueue <- newTQueue
-        canWrite <- newTVar True
-        size <- newTVar 0
-        let q = STMMsgQueue {msgTQueue, canWrite, size}
-        writeTVar msgQueue' (Just q)
-        pure q
-
-  getPeekMsgQueue :: STMMsgStore -> 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 -> 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 -> STMQueue -> IO (Either ErrorType QueueRec)
   deleteQueue ms q = fst <$$> deleteQueue_ ms q
 
@@ -140,17 +111,9 @@ instance MsgStoreClass STMMsgStore where
     where
       getSize = maybe (pure 0) (\STMMsgQueue {size} -> readTVarIO size)
 
-  getQueueMessages_ :: Bool -> STMQueue -> STMMsgQueue -> STM [Message]
-  getQueueMessages_ drainMsgs _ = (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue
-    where
-      snapshotTQueue q = do
-        msgs <- flushTQueue q
-        mapM_ (writeTQueue q) msgs
-        pure msgs
-
   writeMsg :: STMMsgStore -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
   writeMsg ms q' _logState msg = liftIO $ atomically $ do
-    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue ms q' True
+    STMMsgQueue {msgTQueue = q, canWrite, size} <- getMsgQueue q'
     canWrt <- readTVar canWrite
     empty <- isEmptyTQueue q
     if canWrt || empty
@@ -166,29 +129,96 @@ instance MsgStoreClass STMMsgStore where
       STMMsgStore {storeConfig = STMStoreConfig {quota}} = ms
       msgQuota = MessageQuota {msgId = messageId msg, msgTs = messageTs msg}
 
-  setOverQuota_ :: STMQueue -> IO ()
-  setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
+  tryPeekMsg :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO (Maybe Message)
+  tryPeekMsg _ q = snd <$$> withPeekMsgQueue q pure
+  {-# INLINE tryPeekMsg #-}
 
-  getQueueSize_ :: STMMsgQueue -> STM Int
-  getQueueSize_ STMMsgQueue {size} = readTVar size
+  tryPeekMsgs :: STMMsgStore -> [STMQueue] -> ExceptT ErrorType IO (M.Map RecipientId Message)
+  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
 
-  tryPeekMsg_ :: STMQueue -> STMMsgQueue -> STM (Maybe Message)
-  tryPeekMsg_ _ = tryPeekTQueue . msgTQueue
-  {-# INLINE tryPeekMsg_ #-}
+  tryDelMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message)
+  tryDelMsg _ q msgId' =
+    withPeekMsgQueue q $
+      maybe (pure Nothing) $ \(mq, msg) ->
+        if messageId msg == msgId'
+          then tryDeleteMsg_ mq $> Just msg
+          else pure Nothing
 
-  tryDeleteMsg_ :: STMQueue -> STMMsgQueue -> Bool -> STM ()
-  tryDeleteMsg_ _ STMMsgQueue {msgTQueue = q, size} _logState =
-    tryReadTQueue q >>= \case
-      Just _ -> modifyTVar' size (subtract 1)
-      _ -> pure ()
+  tryDelPeekMsg :: STMMsgStore -> STMQueue -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
+  tryDelPeekMsg _ q msgId' =
+    withPeekMsgQueue q $
+      maybe (pure (Nothing, Nothing)) $ \(mq, msg) ->
+        if messageId msg == msgId'
+          then (Just msg,) <$> (tryDeleteMsg_ mq >> tryPeekMsg_ mq)
+          else pure (Nothing, Just msg)
 
-  isolateQueue :: STMMsgStore -> STMQueue -> Text -> STM a -> ExceptT ErrorType IO a
-  isolateQueue _ _ _ = liftIO . atomically
-  {-# INLINE isolateQueue #-}
+  deleteExpiredMsgs :: STMMsgStore -> STMQueue -> Int64 -> ExceptT ErrorType IO Int
+  deleteExpiredMsgs _ q old = liftIO $ atomically $ getMsgQueue q >>= deleteExpireMsgs_ old
 
-  unsafeRunStore :: STMQueue -> Text -> STM a -> IO a
-  unsafeRunStore _ _ = atomically
-  {-# INLINE unsafeRunStore #-}
+  getQueueSize :: STMMsgStore -> STMQueue -> ExceptT ErrorType IO Int
+  getQueueSize _ q = withPeekMsgQueue q $ maybe (pure 0) (getQueueSize_ . fst)
+  {-# INLINE getQueueSize #-}
+
+-- can ONLY be used while restoring messages, not while server running
+setOverQuota_ :: STMQueue -> IO ()
+setOverQuota_ q = readTVarIO (msgQueue' q) >>= mapM_ (\mq -> atomically $ writeTVar (canWrite mq) False)
+
+getQueueSize_ :: STMMsgQueue -> STM Int
+getQueueSize_ STMMsgQueue {size} = readTVar size
+
+tryPeekMsg_ :: STMMsgQueue -> STM (Maybe Message)
+tryPeekMsg_ = tryPeekTQueue . msgTQueue
+{-# INLINE tryPeekMsg_ #-}
+
+tryDeleteMsg_ :: STMMsgQueue -> STM ()
+tryDeleteMsg_ STMMsgQueue {msgTQueue = q, size} =
+  tryReadTQueue q >>= \case
+    Just _ -> modifyTVar' size (subtract 1)
+    _ -> pure ()
+
+getMsgQueue :: STMQueue -> STM STMMsgQueue
+getMsgQueue STMQueue {msgQueue'} = readTVar msgQueue' >>= maybe newQ pure
+  where
+    newQ = do
+      msgTQueue <- newTQueue
+      canWrite <- newTVar True
+      size <- newTVar 0
+      let q = STMMsgQueue {msgTQueue, canWrite, size}
+      writeTVar msgQueue' (Just q)
+      pure q
+
+-- The action is called with Nothing when it is known that the queue is empty
+withPeekMsgQueue :: STMQueue -> (Maybe (STMMsgQueue, Message) -> STM a) -> ExceptT ErrorType IO a
+withPeekMsgQueue STMQueue {msgQueue'} a =
+  liftIO $ atomically $ (readTVar msgQueue' $>>= \mq -> (mq,) <$$> tryPeekMsg_ mq) >>= a
+
+getQueueMessages_ :: Bool -> STMMsgQueue -> STM [Message]
+getQueueMessages_ drainMsgs = (if drainMsgs then flushTQueue else snapshotTQueue) . msgTQueue
+  where
+    snapshotTQueue q = do
+      msgs <- flushTQueue q
+      mapM_ (writeTQueue q) msgs
+      pure msgs
+
+-- does not create queue if it does not exist
+expireQueueMsgs :: Int64 -> STMQueue -> STM MessageStats
+expireQueueMsgs old STMQueue {msgQueue'} =
+  readTVar msgQueue' >>= \case
+    Just mq -> do
+      expiredMsgsCount <- deleteExpireMsgs_ old mq
+      storedMsgsCount <- getQueueSize_ mq
+      pure MessageStats {storedMsgsCount, expiredMsgsCount, storedQueues = 1}
+    Nothing -> pure newMessageStats {storedQueues = 1}
+
+deleteExpireMsgs_ :: Int64 -> STMMsgQueue -> STM Int
+deleteExpireMsgs_ old mq = loop 0
+  where
+    loop dc =
+      tryPeekMsg_ mq >>= \case
+        Just Message {msgTs}
+          | systemSeconds msgTs < old ->
+              tryDeleteMsg_ mq >> loop (dc + 1)
+        _ -> pure dc
 
 deleteQueue_ :: STMMsgStore -> STMQueue -> IO (Either ErrorType (QueueRec, Maybe STMMsgQueue))
 deleteQueue_ ms q = deleteStoreQueue (queueStore_ ms) q >>= mapM remove
diff --git a/src/Simplex/Messaging/Server/MsgStore/Types.hs b/src/Simplex/Messaging/Server/MsgStore/Types.hs
index dce3bc638..a689469d7 100644
--- a/src/Simplex/Messaging/Server/MsgStore/Types.hs
+++ b/src/Simplex/Messaging/Server/MsgStore/Types.hs
@@ -4,17 +4,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Redundant multi-way if" #-}
-
 module Simplex.Messaging.Server.MsgStore.Types
   ( MsgStoreClass (..),
     MSType (..),
@@ -30,99 +25,43 @@ module Simplex.Messaging.Server.MsgStore.Types
     getQueues,
     getQueueRecs,
     readQueueRec,
-    withPeekMsgQueue,
-    expireQueueMsgs,
-    deleteExpireMsgs_,
   ) where
 
 import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Trans.Except
-import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Kind
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Maybe (catMaybes, fromMaybe)
-import Data.Text (Text)
-import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.Types
-import Simplex.Messaging.Util ((<$$>), ($>>=))
+import Simplex.Messaging.Util (($>>=))
 
-class (Monad (StoreMonad s), QueueStoreClass (StoreQueue s) (QueueStore s)) => MsgStoreClass s where
-  type StoreMonad s = (m :: Type -> Type) | m -> s
+class QueueStoreClass (StoreQueue s) (QueueStore s) => MsgStoreClass s where
   type MsgStoreConfig s = c | c -> s
-  type MsgQueue s = q | q -> s
   type StoreQueue s = q | q -> s
   type QueueStore s = qs | qs -> s
   newMsgStore :: MsgStoreConfig s -> IO s
   closeMsgStore :: s -> IO ()
-  withActiveMsgQueues :: Monoid a => s -> (StoreQueue s -> IO a) -> IO a
-  -- This function can only be used in server CLI commands or before server is started.
-  -- tty, store
-  unsafeWithAllMsgQueues :: Monoid a => Bool -> s -> (StoreQueue s -> IO a) -> IO a
   -- tty, store, now, ttl
   expireOldMessages :: Bool -> s -> Int64 -> Int64 -> IO MessageStats
   foldRcvServiceMessages :: s -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO (Either ErrorType a)
-  logQueueStates :: s -> IO ()
-  logQueueState :: StoreQueue s -> StoreMonad s ()
   queueStore :: s -> QueueStore s
   loadedQueueCounts :: s -> IO LoadedQueueCounts
 
   -- message store methods
-  mkQueue :: s -> Bool -> RecipientId -> QueueRec -> IO (StoreQueue s)
-  getMsgQueue :: s -> StoreQueue s -> Bool -> StoreMonad s (MsgQueue s)
-  getPeekMsgQueue :: s -> StoreQueue s -> StoreMonad s (Maybe (MsgQueue s, Message))
-
-  -- the journal queue will be closed after action if it was initially closed or idle longer than interval in config
-  withIdleMsgQueue :: Int64 -> s -> StoreQueue s -> (MsgQueue s -> StoreMonad s a) -> StoreMonad s (Maybe a, Int)
+  mkQueue :: s -> RecipientId -> QueueRec -> IO (StoreQueue s)
   deleteQueue :: s -> StoreQueue s -> IO (Either ErrorType QueueRec)
   deleteQueueSize :: s -> StoreQueue s -> IO (Either ErrorType (QueueRec, Int))
-  getQueueMessages_ :: Bool -> StoreQueue s -> MsgQueue s -> StoreMonad s [Message]
   writeMsg :: s -> 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_ :: StoreQueue s -> MsgQueue s -> StoreMonad s (Maybe Message)
-  tryDeleteMsg_ :: StoreQueue s -> MsgQueue s -> Bool -> StoreMonad s ()
-  isolateQueue :: s -> StoreQueue s -> Text -> StoreMonad s a -> ExceptT ErrorType IO a
-  unsafeRunStore :: StoreQueue s -> Text -> StoreMonad s a -> IO a
-
-  -- default implementations are overridden for PostgreSQL storage of messages
   tryPeekMsg :: s -> StoreQueue s -> ExceptT ErrorType IO (Maybe Message)
-  tryPeekMsg st q = snd <$$> withPeekMsgQueue st q "tryPeekMsg" pure
-  {-# INLINE tryPeekMsg #-}
-  
   tryPeekMsgs :: s -> [StoreQueue s] -> ExceptT ErrorType IO (Map RecipientId Message)
-  tryPeekMsgs st qs = M.fromList . catMaybes <$> mapM (\q -> (recipientId q,) <$$> tryPeekMsg st q) qs
-
   tryDelMsg :: s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message)
-  tryDelMsg st q msgId' =
-    withPeekMsgQueue st q "tryDelMsg" $
-      maybe (pure Nothing) $ \(mq, msg) ->
-        if
-          | messageId msg == msgId' ->
-              tryDeleteMsg_ q mq True $> Just msg
-          | otherwise -> pure Nothing
-
   -- atomic delete (== read) last and peek next message if available
   tryDelPeekMsg :: s -> StoreQueue s -> MsgId -> ExceptT ErrorType IO (Maybe Message, Maybe Message)
-  tryDelPeekMsg st q msgId' =
-    withPeekMsgQueue st 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)
-
   deleteExpiredMsgs :: s -> StoreQueue s -> Int64 -> ExceptT ErrorType IO Int
-  deleteExpiredMsgs st q old =
-    isolateQueue st q "deleteExpiredMsgs" $
-      getMsgQueue st q False >>= deleteExpireMsgs_ old q
-
   getQueueSize :: s -> StoreQueue s -> ExceptT ErrorType IO Int
-  getQueueSize st q = withPeekMsgQueue st q "getQueueSize" $ maybe (pure 0) (getQueueSize_ . fst)
-  {-# INLINE getQueueSize #-}
 
 data MSType = MSMemory | MSPostgres
 
@@ -153,16 +92,14 @@ instance Semigroup MessageStats where
 
 data LoadedQueueCounts = LoadedQueueCounts
   { loadedQueueCount :: Int,
-    loadedNotifierCount :: Int,
-    queueLockCount :: Int,
-    notifierLockCount :: Int
+    loadedNotifierCount :: Int
   }
 
 newMessageStats :: MessageStats
 newMessageStats = MessageStats 0 0 0
 
 addQueue :: MsgStoreClass s => s -> RecipientId -> QueueRec -> IO (Either ErrorType (StoreQueue s))
-addQueue st = addQueue_ (queueStore st) (mkQueue st True)
+addQueue st = addQueue_ (queueStore st) (mkQueue st)
 {-# INLINE addQueue #-}
 
 getQueue :: (MsgStoreClass s, QueueParty p) => s -> SParty p -> QueueId -> IO (Either ErrorType (StoreQueue s))
@@ -182,28 +119,3 @@ getQueueRecs st party qIds = getQueues st party qIds >>= mapM (fmap join . mapM
 readQueueRec :: StoreQueueClass q => q -> IO (Either ErrorType (q, QueueRec))
 readQueueRec q = maybe (Left AUTH) (Right . (q,)) <$> readTVarIO (queueRec q)
 {-# INLINE readQueueRec #-}
-
--- The action is called with Nothing when it is known that the queue is empty
-withPeekMsgQueue :: MsgStoreClass s => s -> StoreQueue s -> Text -> (Maybe (MsgQueue s, Message) -> StoreMonad s a) -> ExceptT ErrorType IO a
-withPeekMsgQueue st q op a = isolateQueue st q op $ getPeekMsgQueue st q >>= a
-{-# INLINE withPeekMsgQueue #-}
-
--- not used with PostgreSQL message store
-expireQueueMsgs :: MsgStoreClass s => s -> Int64 -> Int64 -> StoreQueue s -> StoreMonad s MessageStats
-expireQueueMsgs st now old q = do
-  (expired_, stored) <- withIdleMsgQueue now st q $ deleteExpireMsgs_ old q
-  pure MessageStats {storedMsgsCount = stored, expiredMsgsCount = fromMaybe 0 expired_, storedQueues = 1}
-
--- not used with PostgreSQL message store
-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 =
-      tryPeekMsg_ q mq >>= \case
-        Just Message {msgTs}
-          | systemSeconds msgTs < old ->
-              tryDeleteMsg_ q mq False >> loop (dc + 1)
-        _ -> pure dc
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index b0ba2ea79..41ad5517b 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -592,15 +592,7 @@ prometheusMetrics sm rtm ts =
       \\n\
       \# HELP simplex_smp_loaded_queues_ntf_count Total loaded ntf credential references (all ntf credentials for memory storage)\n\
       \# TYPE simplex_smp_loaded_queues_ntf_count gauge\n\
-      \simplex_smp_loaded_queues_ntf_count " <> mshow (loadedNotifierCount loadedCounts) <> "\n# loadedCounts.loadedNotifierCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_queue_lock_count Total queue locks (0 for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_queue_lock_count gauge\n\
-      \simplex_smp_loaded_queues_queue_lock_count " <> mshow (queueLockCount loadedCounts) <> "\n# loadedCounts.queueLockCount\n\
-      \\n\
-      \# HELP simplex_smp_loaded_queues_ntf_lock_count Total notifier locks (0 for memory storage)\n\
-      \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
-      \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
+      \simplex_smp_loaded_queues_ntf_count " <> mshow (loadedNotifierCount loadedCounts) <> "\n# loadedCounts.loadedNotifierCount\n"
 
     showTimeBuckets :: Text -> IM.IntMap Int -> Text
     showTimeBuckets metric = T.concat . snd . mapAccumL accumBucket (0, 0) . IM.assocs
diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
index 2a879f8cb..23b90b100 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs
@@ -24,9 +24,7 @@ module Simplex.Messaging.Server.QueueStore.Postgres
     batchInsertServices,
     batchInsertQueues,
     foldServiceRecs,
-    foldRcvServiceQueueRecs,
     foldQueueRecs,
-    foldRecentQueueRecs,
     handleDuplicate,
     rowToQueueRec,
     withLog_,
@@ -43,13 +41,12 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
-import Data.Bifunctor (first)
 import Data.ByteString.Builder (Builder)
 import qualified Data.ByteString.Builder as BB
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Lazy as LB
 import Data.Bitraversable (bimapM)
-import Data.Either (fromRight, lefts)
+import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.List (foldl', intersperse, partition)
@@ -91,7 +88,7 @@ import Simplex.Messaging.SystemTime
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport (SMPServiceRole (..))
-import Simplex.Messaging.Util (eitherToMaybe, firstRow, ifM, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
+import Simplex.Messaging.Util (eitherToMaybe, firstRow, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
 import System.Exit (exitFailure)
 import System.IO (IOMode (..), hFlush, stdout)
 import UnliftIO.STM
@@ -103,35 +100,19 @@ import Simplex.Messaging.Encoding.String
 data PostgresQueueStore q = PostgresQueueStore
   { dbStore :: DBStore,
     dbStoreLog :: Maybe (StoreLog 'WriteMode),
-    -- this map caches all created and opened queues
-    queues :: TMap RecipientId q,
-    -- this map only cashes the queues that were attempted to send messages to,
-    senders :: TMap SenderId RecipientId,
-    links :: TMap LinkId RecipientId,
-    -- this map only cashes the queues that were attempted to be subscribed to,
-    notifiers :: TMap NotifierId RecipientId,
-    notifierLocks :: TMap NotifierId Lock,
     serviceLocks :: TMap CertFingerprint Lock,
-    deletedTTL :: Int64,
-    useCache :: Bool
+    deletedTTL :: Int64
   }
 
-type UseQueueCache = Bool
-
 instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
-  type QueueStoreCfg (PostgresQueueStore q) = (PostgresStoreCfg, UseQueueCache)
+  type QueueStoreCfg (PostgresQueueStore q) = PostgresStoreCfg
 
-  newQueueStore :: (PostgresStoreCfg, UseQueueCache)  -> IO (PostgresQueueStore q)
-  newQueueStore (PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL}, useCache) = do
+  newQueueStore :: PostgresStoreCfg -> IO (PostgresQueueStore q)
+  newQueueStore PostgresStoreCfg {dbOpts, dbStoreLogPath, confirmMigrations, deletedTTL} = do
     dbStore <- either err pure =<< createDBStore dbOpts serverMigrations (MigrationConfig confirmMigrations Nothing)
     dbStoreLog <- mapM (openWriteStoreLog True) dbStoreLogPath
-    queues <- TM.emptyIO
-    senders <- TM.emptyIO
-    links <- TM.emptyIO
-    notifiers <- TM.emptyIO
-    notifierLocks <- TM.emptyIO
     serviceLocks <- TM.emptyIO
-    pure PostgresQueueStore {dbStore, dbStoreLog, queues, senders, links, notifiers, notifierLocks, serviceLocks, deletedTTL, useCache}
+    pure PostgresQueueStore {dbStore, dbStoreLog, serviceLocks, deletedTTL}
     where
       err e = do
         logError $ "STORE: newQueueStore, error opening PostgreSQL database, " <> tshow e
@@ -142,9 +123,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     closeDBStore dbStore
     mapM_ closeStoreLog dbStoreLog
 
-  loadedQueues = queues
-  {-# INLINE loadedQueues #-}
-
   compactQueues :: PostgresQueueStore q -> IO Int64
   compactQueues st@PostgresQueueStore {deletedTTL} = do
     old <- subtract deletedTTL . systemSeconds <$> liftIO getSystemTime
@@ -170,131 +148,44 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
           (SRMessaging, SRNotifier)
       pure EntityCounts {queueCount, notifierCount, rcvServiceCount, ntfServiceCount, rcvServiceQueuesCount, ntfServiceQueuesCount}
 
-  -- this implementation assumes that the lock is already taken by addQueue
-  -- and relies on unique constraints in the database to prevent duplicate IDs.
+  -- this implementation relies on unique constraints in the database to prevent duplicate IDs.
   addQueue_ :: PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
   addQueue_ st mkQ rId qr = do
     sq <- mkQ rId qr
-    withQueueLock sq "addQueue_" $ E.uninterruptibleMask_ $ runExceptT $ do
+    E.uninterruptibleMask_ $ runExceptT $ do
       void $ withDB "addQueue_" st $ \db ->
         E.try (DB.execute db insertQueueQuery $ queueRecToRow (rId, qr))
           >>= bimapM handleDuplicate pure
-      when useCache $ do
-        atomically $ TM.insert rId sq queues
-        atomically $ TM.insert (senderId qr) rId senders
-        forM_ (notifier qr) $ \NtfCreds {notifierId = nId} -> atomically $ TM.insert nId rId notifiers
-        forM_ (queueData qr) $ \(lnkId, _) -> atomically $ TM.insert lnkId rId links
       withLog "addStoreQueue" st $ \s -> logCreateQueue s rId qr
       pure sq
-    where
-      PostgresQueueStore {queues, senders, links, notifiers, useCache} = st
-      -- Not doing duplicate checks in maps as the probability of duplicates is very low.
-      -- It needs to be reconsidered when IDs are supplied by the users.
-      -- hasId = anyM [TM.memberIO rId queues, TM.memberIO senderId senders, hasNotifier]
-      -- hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.memberIO notifierId notifiers) notifier
 
-  getQueue_ :: QueueParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueue_ st mkQ party qId
-    | useCache = case party of
-        SRecipient -> getRcvQueue qId
-        SSender -> TM.lookupIO qId senders >>= maybe (mask loadSndQueue) getRcvQueue
-        SSenderLink -> TM.lookupIO qId links >>= maybe (mask loadLinkQueue) getRcvQueue
-        -- loaded queue is deleted from notifiers map to reduce cache size after queue was subscribed to by ntf server
-        SNotifier -> TM.lookupIO qId notifiers >>= maybe (mask loadNtfQueue) (getRcvQueue >=> (atomically (TM.delete qId notifiers) $>))
-    | otherwise = case party of
-        SRecipient -> loadQueueNoCache " WHERE recipient_id = ?"
-        SSender -> loadQueueNoCache " WHERE sender_id = ?"
-        SSenderLink -> loadQueueNoCache " WHERE link_id = ?"
-        SNotifier -> loadQueueNoCache " WHERE notifier_id = ?"
+  getQueue_ :: QueueParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ st mkQ party qId = case party of
+    SRecipient -> loadQueue " WHERE recipient_id = ?"
+    SSender -> loadQueue " WHERE sender_id = ?"
+    SSenderLink -> loadQueue " WHERE link_id = ?"
+    SNotifier -> loadQueue " WHERE notifier_id = ?"
     where
-      PostgresQueueStore {queues, senders, links, notifiers, useCache} = st
-      getRcvQueue rId = TM.lookupIO rId queues >>= maybe (mask loadRcvQueue) (pure . Right)
-      loadRcvQueue = do
-        (rId, qRec) <- loadQueue " WHERE recipient_id = ?"
-        liftIO $ cacheQueue rId qRec $ \_ -> pure () -- recipient map already checked, not caching sender ref
-      loadSndQueue = loadSndQueue_ " WHERE sender_id = ?"
-      loadLinkQueue = loadSndQueue_ " WHERE link_id = ?"
-      loadNtfQueue = do
-        (rId, qRec) <- loadQueue " WHERE notifier_id = ?"
-        liftIO $
-          TM.lookupIO rId queues -- checking recipient map first, not creating lock in map, not caching queue
-            >>= maybe (mkQ False rId qRec) pure
-      loadSndQueue_ condition = do
-        (rId, qRec) <- loadQueue condition
-        liftIO $
-          TM.lookupIO rId queues -- checking recipient map first
-            >>= maybe (cacheQueue rId qRec cacheSender) (atomically (cacheSender rId) $>)
-      loadQueueNoCache cond = mask $ loadQueue cond >>= liftIO . uncurry (mkQ True)
+      loadQueue cond = mask $ loadQueueRec cond >>= liftIO . uncurry mkQ
       mask = E.uninterruptibleMask_ . runExceptT
-      cacheSender rId = TM.insert qId rId senders
-      loadQueue condition =
+      loadQueueRec condition =
         withDB "getQueue_" st $ \db -> firstRow rowToQueueRec AUTH $
           DB.query db (queueRecQuery <> condition <> " AND deleted_at IS NULL") (Only qId)
-      cacheQueue rId qRec insertRef = do
-        sq <- mkQ True rId qRec -- loaded queue
-        -- This lock prevents the scenario when the queue is added to cache,
-        -- while another thread is proccessing the same queue in withAllMsgQueues
-        -- without adding it to cache, possibly trying to open the same files twice.
-        -- Alse see comment in idleDeleteExpiredMsgs.
-        withQueueLock sq "getQueue_" $ atomically $
-          -- checking the cache again for concurrent reads,
-          -- use previously loaded queue if exists.
-          TM.lookup rId queues >>= \case
-            Just sq' -> pure sq'
-            Nothing -> do
-              insertRef rId
-              TM.insert rId sq queues
-              pure sq
 
-  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ :: forall p. BatchParty p => PostgresQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueues_ st mkQ party qIds
     | null qIds = pure []
-    | useCache = case party of
-        SRecipient -> do
-          qs <- readTVarIO queues
-          let qs' = map (\qId -> get qs qId qId) qIds
-          E.uninterruptibleMask_ $ loadQueues qs' " WHERE recipient_id IN ?" cacheRcvQueue
-        SNotifier -> do
-          ns <- readTVarIO notifiers
-          qs <- readTVarIO queues
-          let qs' = map (\qId -> get ns qId qId >>= get qs qId) qIds
-          E.uninterruptibleMask_ $ loadQueues qs' " WHERE notifier_id IN ?" $ \(rId, qRec) ->
-            forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> -- it is always Just with this query
-              (nId,) <$> maybe (mkQ False rId qRec) pure (M.lookup rId qs)
     | otherwise = E.uninterruptibleMask_ $ case party of
-        SRecipient -> loadQueuesNoCache " WHERE recipient_id IN ?" $ \(rId, qRec) ->
-          Just . (rId,) <$> mkQ False rId qRec
-        SNotifier -> loadQueuesNoCache " WHERE notifier_id IN ?" $ \(rId, qRec) ->
-          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ False rId qRec
+        SRecipient -> loadQueues " WHERE recipient_id IN ?" $ \(rId, qRec) ->
+          Just . (rId,) <$> mkQ rId qRec
+        SNotifier -> loadQueues " WHERE notifier_id IN ?" $ \(rId, qRec) ->
+          forM (notifier qRec) $ \NtfCreds {notifierId = nId} -> (nId,) <$> mkQ rId qRec
     where
-      PostgresQueueStore {queues, notifiers, useCache} = st
-      get :: M.Map QueueId a -> QueueId -> QueueId -> Either QueueId a
-      get m qId = maybe (Left qId) Right . (`M.lookup` m)
-      loadQueues :: [Either QueueId q] -> Query -> ((RecipientId, QueueRec) -> IO (Maybe (QueueId, q))) -> IO [Either ErrorType q]
-      loadQueues qs' cond mkCacheQueue = do
-        let qIds' = lefts qs'
-        if null qIds'
-          then pure $ map (first (const INTERNAL)) qs'
-          else do
-            qs_ <- dbLoadQueues qIds' cond mkCacheQueue
-            pure $ map (result qs_) qs'
-        where
-          result :: Either ErrorType (M.Map QueueId q) -> Either QueueId q -> Either ErrorType q
-          result _ (Right q) = Right q
-          result qs_ (Left qId) = maybe (Left AUTH) Right . M.lookup qId =<< qs_
       dbLoadQueues qIds' cond mkQueue' =
         runExceptT $ fmap M.fromList $
           withDB' "getQueues_" st (\db -> DB.query db (queueRecQuery <> cond <> " AND deleted_at IS NULL") (Only (In qIds')))
             >>= liftIO . fmap catMaybes . mapM (mkQueue' . rowToQueueRec)
-      cacheRcvQueue (rId, qRec) = do
-        sq <- mkQ True rId qRec
-        sq' <- withQueueLock sq "getQueue_" $ atomically $
-          -- checking the cache again for concurrent reads, use previously loaded queue if exists.
-          TM.lookup rId queues >>= \case
-            Just sq' -> pure sq'
-            Nothing -> sq <$ TM.insert rId sq queues
-        pure $ Just (rId, sq')
-      loadQueuesNoCache cond mkQueue' = do
+      loadQueues cond mkQueue' = do
         qs_ <- dbLoadQueues qIds cond mkQueue'
         pure $ map (result qs_) qIds
         where
@@ -312,7 +203,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   addQueueLinkData :: PostgresQueueStore q -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   addQueueLinkData st sq lnkId d =
-    withQueueRec sq "addQueueLinkData" $ \q -> case queueData q of
+    withQueueRec sq $ \q -> case queueData q of
       Nothing ->
         addLink q $ \db -> DB.execute db qry (d :. (lnkId, rId, QMContact))
       Just (lnkId', _) | lnkId' == lnkId ->
@@ -329,7 +220,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   deleteQueueLinkData :: PostgresQueueStore q -> q -> IO (Either ErrorType ())
   deleteQueueLinkData st sq =
-    withQueueRec sq "deleteQueueLinkData" $ \q -> case queueData q of
+    withQueueRec sq $ \q -> case queueData q of
       Just _ -> do
         assertUpdated $ withDB' "deleteQueueLinkData" st $ \db ->
           DB.execute db "UPDATE msg_queues SET link_id = NULL, fixed_data = NULL, user_data = NULL WHERE recipient_id = ? AND deleted_at IS NULL" (Only rId)
@@ -341,7 +232,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   secureQueue :: PostgresQueueStore q -> q -> SndPublicAuthKey -> IO (Either ErrorType ())
   secureQueue st sq sKey =
-    withQueueRec sq "secureQueue" $ \q -> do
+    withQueueRec sq $ \q -> do
       verify q
       assertUpdated $ withDB' "secureQueue" st $ \db ->
         DB.execute db "UPDATE msg_queues SET sender_key = ? WHERE recipient_id = ? AND deleted_at IS NULL AND (sender_key IS NULL OR sender_key = ?)" (sKey, rId, sKey)
@@ -355,7 +246,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   updateKeys :: PostgresQueueStore q -> q -> NonEmpty RcvPublicAuthKey -> IO (Either ErrorType ())
   updateKeys st sq rKeys =
-    withQueueRec sq "updateKeys" $ \q -> do
+    withQueueRec sq $ \q -> do
       assertUpdated $ withDB' "updateKeys" st $ \db ->
         DB.execute db "UPDATE msg_queues SET recipient_keys = ? WHERE recipient_id = ? AND deleted_at IS NULL" (rKeys, rId)
       atomically $ writeTVar (queueRec sq) $ Just q {recipientKeys = rKeys}
@@ -365,24 +256,14 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   addQueueNotifier :: PostgresQueueStore q -> q -> NtfCreds -> IO (Either ErrorType (Maybe NtfCreds))
   addQueueNotifier st sq ntfCreds@NtfCreds {notifierId = nId, notifierKey, rcvNtfDhSecret} =
-    withQueueRec sq "addQueueNotifier" $ \q ->
-      checkCachedNotifier $ do
-        assertUpdated $ withDB "addQueueNotifier" st $ \db ->
-          E.try (update db) >>= bimapM handleDuplicate pure
-        nc_ <- forM (notifier q) $ \nc@NtfCreds {notifierId} -> atomically (TM.delete notifierId notifiers) $> nc
-        let !q' = q {notifier = Just ntfCreds}
-        atomically $ writeTVar (queueRec sq) $ Just q'
-        when useCache $ do
-          atomically $ TM.insert nId rId notifiers
-        withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
-        pure nc_
+    withQueueRec sq $ \q -> do
+      assertUpdated $ withDB "addQueueNotifier" st $ \db ->
+        E.try (update db) >>= bimapM handleDuplicate pure
+      let !q' = q {notifier = Just ntfCreds}
+      atomically $ writeTVar (queueRec sq) $ Just q'
+      withLog "addQueueNotifier" st $ \s -> logAddNotifier s rId ntfCreds
+      pure $ notifier q
     where
-      checkCachedNotifier add
-        | useCache =
-            ExceptT $ withLockMap (notifierLocks st) nId "addQueueNotifier" $
-              ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $ runExceptT add
-        | otherwise = add
-      PostgresQueueStore {notifiers, useCache} = st
       rId = recipientId sq
       update db =
         DB.execute
@@ -396,18 +277,13 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   deleteQueueNotifier :: PostgresQueueStore q -> q -> IO (Either ErrorType (Maybe NtfCreds))
   deleteQueueNotifier st sq =
-    withQueueRec sq "deleteQueueNotifier" $ \q ->
-      ExceptT $ fmap sequence $ forM (notifier q) $ \nc@NtfCreds {notifierId = nId} ->
-        withNotifierLock nId $ runExceptT $ do
-          assertUpdated $ withDB' "deleteQueueNotifier" st update
-          when (useCache st) $ atomically $ TM.delete nId $ notifiers st
-          atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
-          withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
-          pure nc
+    withQueueRec sq $ \q ->
+      forM (notifier q) $ \nc -> do
+        assertUpdated $ withDB' "deleteQueueNotifier" st update
+        atomically $ writeTVar (queueRec sq) $ Just q {notifier = Nothing}
+        withLog "deleteQueueNotifier" st (`logDeleteNotifier` rId)
+        pure nc
     where
-      withNotifierLock nId
-        | useCache st = withLockMap (notifierLocks st) nId "deleteQueueNotifier"
-        | otherwise = id
       rId = recipientId sq
       update db =
         DB.execute
@@ -436,7 +312,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
 
   updateQueueTime :: PostgresQueueStore q -> q -> SystemDate -> IO (Either ErrorType QueueRec)
   updateQueueTime st sq t =
-    withQueueRec sq "updateQueueTime" $ \q@QueueRec {updatedAt} ->
+    withQueueRec sq $ \q@QueueRec {updatedAt} ->
       if updatedAt == Just t
         then pure q
         else do
@@ -449,7 +325,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     where
       rId = recipientId sq
 
-  -- this method is called from JournalMsgStore deleteQueue that already locks the queue
   deleteStoreQueue :: PostgresQueueStore q -> q -> IO (Either ErrorType QueueRec)
   deleteStoreQueue st sq = E.uninterruptibleMask_ $ runExceptT $ do
     q <- ExceptT $ readQueueRecIO qr
@@ -457,11 +332,6 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
     assertUpdated $ withDB' "deleteStoreQueue" st $ \db ->
       DB.execute db "UPDATE msg_queues SET deleted_at = ? WHERE recipient_id = ? AND deleted_at IS NULL" (ts, rId)
     atomically $ writeTVar qr Nothing
-    when (useCache st) $ do
-      atomically $ TM.delete (senderId q) $ senders st
-      forM_ (notifier q) $ \NtfCreds {notifierId} -> do
-        atomically $ TM.delete notifierId $ notifiers st
-        atomically $ TM.delete notifierId $ notifierLocks st
     withLog "deleteStoreQueue" st (`logDeleteQueue` rId)
     pure q
     where
@@ -484,7 +354,7 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
       pure serviceId
 
   setQueueService :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
-  setQueueService st sq party serviceId = withQueueRec sq "setQueueService" $ \q -> case party of
+  setQueueService st sq party serviceId = withQueueRec sq $ \q -> case party of
     SRecipientService
       | rcvServiceId q == serviceId -> pure ()
       | otherwise -> do
@@ -609,11 +479,6 @@ foldServiceRecs st f =
     DB.fold_ db "SELECT service_id, service_role, service_cert, service_cert_hash, created_at FROM services" mempty $
       \ !acc -> fmap (acc <>) . f . rowToServiceRec
 
-foldRcvServiceQueueRecs :: PostgresQueueStore q -> ServiceId -> (a -> (RecipientId, QueueRec) -> IO a) -> a -> IO (Either ErrorType a)
-foldRcvServiceQueueRecs st serviceId f acc =
-  runExceptT $ withDB' "foldRcvServiceQueueRecs" st $ \db ->
-    DB.fold db (queueRecQuery <> " WHERE rcv_service_id = ? AND deleted_at IS NULL") (Only serviceId) acc $ \a -> f a . rowToQueueRec
-
 foldQueueRecs :: Monoid a => Bool -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
 foldQueueRecs withData = foldQueueRecs_ foldRecs
   where
@@ -622,12 +487,6 @@ foldQueueRecs withData = foldQueueRecs_ foldRecs
       | otherwise = DB.fold_ db (queueRecQuery <> cond) acc $ \acc' -> f' acc' . rowToQueueRec
     cond = " WHERE deleted_at IS NULL ORDER BY recipient_id ASC"
 
-foldRecentQueueRecs :: Monoid a => Int64 -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
-foldRecentQueueRecs old = foldQueueRecs_ foldRecs
-  where
-    foldRecs db acc f' = DB.fold db (queueRecQuery <> cond) (Only old) acc $ \acc' -> f' acc' . rowToQueueRec
-    cond = " WHERE deleted_at IS NULL AND updated_at > ? ORDER BY recipient_id ASC"
-
 foldQueueRecs_ ::
   Monoid a =>
   (DB.Connection -> (Int, a) -> ((Int, a) -> (RecipientId, QueueRec) -> IO (Int, a)) -> IO (Int, a)) ->
@@ -751,15 +610,15 @@ rowToServiceRec (serviceId, serviceRole, serviceCert, Binary fp, serviceCreatedA
 
 setStatusDB :: StoreQueueClass q => Text -> PostgresQueueStore q -> q -> ServerEntityStatus -> ExceptT ErrorType IO () -> IO (Either ErrorType ())
 setStatusDB op st sq status writeLog =
-  withQueueRec sq op $ \q -> do
+  withQueueRec sq $ \q -> do
     assertUpdated $ withDB' op st $ \db ->
       DB.execute db "UPDATE msg_queues SET status = ? WHERE recipient_id = ? AND deleted_at IS NULL" (status, recipientId sq)
     atomically $ writeTVar (queueRec sq) $ Just q {status}
     writeLog
 
-withQueueRec :: StoreQueueClass q => q -> Text -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
-withQueueRec sq op action =
-  withQueueLock sq op $ E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action
+withQueueRec :: StoreQueueClass q => q -> (QueueRec -> ExceptT ErrorType IO a) -> IO (Either ErrorType a)
+withQueueRec sq action =
+  E.uninterruptibleMask_ $ runExceptT $ ExceptT (readQueueRecIO $ queueRec sq) >>= action
 
 assertUpdated :: ExceptT ErrorType IO Int64 -> ExceptT ErrorType IO ()
 assertUpdated = (>>= \n -> when (n == 0) (throwE AUTH))
diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 6e1a94802..1be389821 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -18,6 +18,7 @@ module Simplex.Messaging.Server.QueueStore.STM
   ( STMQueueStore (..),
     STMService (..),
     foldRcvServiceQueues,
+    withLoadedQueues,
     setStoreLog,
     withLog',
     readQueueRecIO,
@@ -91,8 +92,6 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
     atomically $ TM.clear senders
     atomically $ TM.clear notifiers
 
-  loadedQueues = queues
-  {-# INLINE loadedQueues #-}
   compactQueues _ = pure 0
   {-# INLINE compactQueues #-}
 
@@ -134,7 +133,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
       hasNotifier = maybe (pure False) (\NtfCreds {notifierId} -> TM.member notifierId notifiers) notifier
       hasLink = maybe (pure False) (\(lnkId, _) -> TM.member lnkId links) queueData
 
-  getQueue_ :: QueueParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueue_ :: QueueParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
   getQueue_ st _ party qId =
     maybe (Left AUTH) Right <$> case party of
       SRecipient -> TM.lookupIO qId queues
@@ -144,7 +143,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
     where
       STMQueueStore {queues, senders, notifiers, links} = st
 
-  getQueues_ :: BatchParty p => STMQueueStore q -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueues_ :: BatchParty p => STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueues_ st _ party qIds = case party of
     SRecipient -> do
       qs <- readTVarIO queues
@@ -379,6 +378,11 @@ foldRcvServiceQueues st serviceId f acc =
   where
     get rId = TM.lookupIO rId (queues st) $>>= \q -> (q,) <$$> readTVarIO (queueRec q)
 
+withLoadedQueues :: Monoid a => STMQueueStore q -> (q -> IO a) -> IO a
+withLoadedQueues st f = readTVarIO (queues st) >>= foldM run mempty
+  where
+    run !acc = fmap (acc <>) . f
+
 withQueueRec :: TVar (Maybe QueueRec) -> (QueueRec -> STM a) -> IO (Either ErrorType a)
 withQueueRec qr a = atomically $ readQueueRec qr >>= mapM a
 
diff --git a/src/Simplex/Messaging/Server/QueueStore/Types.hs b/src/Simplex/Messaging/Server/QueueStore/Types.hs
index 415a5f33c..e8d47751b 100644
--- a/src/Simplex/Messaging/Server/QueueStore/Types.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/Types.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -9,35 +8,29 @@ module Simplex.Messaging.Server.QueueStore.Types
   ( StoreQueueClass (..),
     QueueStoreClass (..),
     EntityCounts (..),
-    withLoadedQueues,
   ) where
 
 import Control.Concurrent.STM
-import Control.Monad
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
-import Data.Text (Text)
 import Simplex.Messaging.Protocol
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.SystemTime
-import Simplex.Messaging.TMap (TMap)
 
 class StoreQueueClass q where
   recipientId :: q -> RecipientId
   queueRec :: q -> TVar (Maybe QueueRec)
-  withQueueLock :: q -> Text -> IO a -> IO a
 
 class StoreQueueClass q => QueueStoreClass q s where
   type QueueStoreCfg s
   newQueueStore :: QueueStoreCfg s -> IO s
   closeQueueStore :: s -> IO ()
   getEntityCounts :: s -> IO EntityCounts
-  loadedQueues :: s -> TMap RecipientId q
   compactQueues :: s -> IO Int64
   addQueue_ :: s -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
-  getQueue_ :: QueueParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
-  getQueues_ :: BatchParty p => s -> (Bool -> RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
+  getQueue_ :: QueueParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> QueueId -> IO (Either ErrorType q)
+  getQueues_ :: BatchParty p => s -> (RecipientId -> QueueRec -> IO q) -> SParty p -> [QueueId] -> IO [Either ErrorType q]
   getQueueLinkData :: s -> q -> LinkId -> IO (Either ErrorType QueueLinkData)
   addQueueLinkData :: s -> q -> LinkId -> QueueLinkData -> IO (Either ErrorType ())
   deleteQueueLinkData :: s -> q -> IO (Either ErrorType ())
@@ -64,8 +57,3 @@ data EntityCounts = EntityCounts
     rcvServiceQueuesCount :: Int,
     ntfServiceQueuesCount :: Int
   }
-
-withLoadedQueues :: (Monoid a, QueueStoreClass q s) => s -> (q -> IO a) -> IO a
-withLoadedQueues st f = readTVarIO (loadedQueues st) >>= foldM run mempty
-  where
-    run !acc = fmap (acc <>) . f
diff --git a/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs b/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
index 6bf327f70..fb741d575 100644
--- a/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
+++ b/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
@@ -23,7 +23,7 @@ import Data.Text.Encoding (decodeLatin1)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (ASubscriberParty (..), ErrorType, RecipientId, SParty (..))
 import Simplex.Messaging.Server.QueueStore (QueueRec, ServiceRec (..))
-import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..))
+import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..), withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog
 import Simplex.Messaging.Util (tshow)
@@ -71,7 +71,7 @@ readQueueStore tty mkQ f st = readLogLines tty f $ \_ -> processLine
         withQueue qId op a = runExceptT go >>= qError qId op
           where
             go = do
-              q <- ExceptT $ getQueue_ st (\_ -> mkQ) SRecipient qId
+              q <- ExceptT $ getQueue_ st mkQ SRecipient qId
               liftIO (readTVarIO $ queueRec q) >>= \case
                 Nothing -> logWarn $ logPfx qId op <> "already deleted"
                 Just _ -> void $ ExceptT $ a q
diff --git a/tests/AgentTests/FunctionalAPITests.hs b/tests/AgentTests/FunctionalAPITests.hs
index 028de1ab3..65dcffadb 100644
--- a/tests/AgentTests/FunctionalAPITests.hs
+++ b/tests/AgentTests/FunctionalAPITests.hs
@@ -2035,7 +2035,7 @@ testOldContactQueueShortLink ps@(_, msType) = withAgentClients2 $ \a b -> do
     ASSCfg _ _ (SSCMemory sp_) -> mapM_ (\StorePaths {storeLogFile} -> updateStoreLog storeLogFile) sp_
 #if defined(dbServerPostgres)
     ASSCfg _ _ (SSCDatabase storeCfg) -> do
-      st :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue (storeCfg, False)
+      st :: PostgresQueueStore PostgresQueue <- newQueueStore @PostgresQueue storeCfg
       updateDbStore st
       closeQueueStore @PostgresQueue st
 #endif
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 558fbf96a..0cfcc8c49 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -9,9 +9,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
 
 module CoreTests.MsgStoreTests where
@@ -65,7 +63,6 @@ msgStoreTests = do
     someMsgStoreTests cfg = do
       it "should get queue and store/read messages" $ withMsgStore cfg testGetQueue
       it "should write/ack messages" $ withMsgStore cfg testWriteAckMessages
-      it "should not fail on EOF when changing read journal" $ withMsgStore cfg testChangeReadJournal
       it "should not add link data to secured messaging queue" $ withMsgStore cfg testLinkDataSecuredQueue
 
 -- TODO constrain to STM stores?
@@ -193,25 +190,6 @@ testWriteAckMessages ms = do
     void $ ExceptT $ deleteQueue ms q1
     void $ ExceptT $ deleteQueue ms q2
 
-testChangeReadJournal :: MsgStoreClass s => s -> IO ()
-testChangeReadJournal ms = do
-  g <- C.newRandom
-  (rId, qr) <- testNewQueueRec g QMMessaging
-  runRight_ $ do
-    q <- ExceptT $ addQueue ms rId qr
-    let write s = writeMsg ms q True =<< mkMessage s
-    Just (Message {msgId = mId1}, True) <- write "message 1"
-    (Msg "message 1", Nothing) <- tryDelPeekMsg ms q mId1
-    Just (Message {msgId = mId2}, True) <- write "message 2"
-    (Msg "message 2", Nothing) <- tryDelPeekMsg ms q mId2
-    Just (Message {msgId = mId3}, True) <- write "message 3"
-    (Msg "message 3", Nothing) <- tryDelPeekMsg ms q mId3
-    Just (Message {msgId = mId4}, True) <- write "message 4"
-    (Msg "message 4", Nothing) <- tryDelPeekMsg ms q mId4
-    Just (Message {msgId = mId5}, True) <- write "message 5"
-    (Msg "message 5", Nothing) <- tryDelPeekMsg ms q mId5
-    void $ ExceptT $ deleteQueue ms q
-
 testLinkDataSecuredQueue :: MsgStoreClass s => s -> IO ()
 testLinkDataSecuredQueue ms = do
   g <- C.newRandom
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index fc47ddca8..e0b8e16fc 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -189,7 +189,7 @@ testSMPStoreLog testSuite tests =
   where
     testReadWrite SLTC {compacted, state} = do
       st <- newMsgStore testSMTStoreConfig
-      l <- readWriteQueueStore True (mkQueue st True) testStoreLogFile $ queueStore st
+      l <- readWriteQueueStore True (mkQueue st) testStoreLogFile $ queueStore st
       storeState st `shouldReturn` state
       closeStoreLog l
       ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testStoreLogFile
diff --git a/tests/SMPProxyTests.hs b/tests/SMPProxyTests.hs
index e7fabf09b..467949878 100644
--- a/tests/SMPProxyTests.hs
+++ b/tests/SMPProxyTests.hs
@@ -406,12 +406,8 @@ agentViaProxyRetryOffline = do
   where
     withServer :: (ThreadId -> IO a) -> IO a
     withServer = withServer_ testStoreLogFile testStoreMsgsFile testStoreNtfsFile testPort
-    -- TODO [postgres]
-    -- withServer = withServer_ testStoreDBOpts testStoreMsgsDir testStoreNtfsFile testPort
     withServer2 :: (ThreadId -> IO a) -> IO a
     withServer2 = withServer_ testStoreLogFile2 testStoreMsgsFile2 testStoreNtfsFile2 testPort2
-    -- TODO [postgres]
-    -- withServer2 = withServer_ testStoreDBOpts2 testStoreMsgsDir2 testStoreNtfsFile2 testPort2
     withServer_ storeLog storeMsgs storeNtfs =
       let cfg' = updateCfg (memoryCfg proxyCfg storeLog storeMsgs) $ \cfg_ -> cfg_ {storeNtfsFile = Just storeNtfs}
        in withSmpServerConfigOn (transport @TLS) cfg'
diff --git a/tests/ServerTests.hs b/tests/ServerTests.hs
index 88554fcff..55fca1122 100644
--- a/tests/ServerTests.hs
+++ b/tests/ServerTests.hs
@@ -1226,7 +1226,7 @@ testRestoreExpireMessages =
           closeMsgStore ms'
         readWriteQueues = do
           ms <- newMsgStore testSMTStoreConfig
-          readWriteQueueStore True (mkQueue ms True) testStoreLogFile (queueStore ms) >>= closeStoreLog
+          readWriteQueueStore True (mkQueue ms) testStoreLogFile (queueStore ms) >>= closeStoreLog
           removeFileIfExists testStoreMsgsFile
           pure ms
 #else

From 4b8d31a4765ecd81060a92a3028a1c8a157e14c2 Mon Sep 17 00:00:00 2001
From: sh <37271604+shumvgolove@users.noreply.github.com>
Date: Fri, 16 Oct 2026 12:46:09 +0400
Subject: [PATCH 20/20] smp-server: remove deleted queues from store maps
 (#1947)

---
 .../Messaging/Server/QueueStore/STM.hs        |  4 +-
 .../Messaging/Server/StoreLog/ReadWrite.hs    | 13 +---
 tests/CoreTests/MsgStoreTests.hs              | 69 ++++++++++++++++++-
 tests/CoreTests/StoreLogTests.hs              | 12 ----
 4 files changed, 73 insertions(+), 25 deletions(-)

diff --git a/src/Simplex/Messaging/Server/QueueStore/STM.hs b/src/Simplex/Messaging/Server/QueueStore/STM.hs
index 1be389821..8d56897b5 100644
--- a/src/Simplex/Messaging/Server/QueueStore/STM.hs
+++ b/src/Simplex/Messaging/Server/QueueStore/STM.hs
@@ -277,9 +277,11 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
     where
       rId = recipientId sq
       qr = queueRec sq
-      delete q@QueueRec {senderId, rcvServiceId} = do
+      delete q@QueueRec {senderId, queueData, rcvServiceId} = do
         writeTVar qr Nothing
+        TM.delete rId $ queues st
         TM.delete senderId $ senders st
+        forM_ queueData $ \(lnkId, _) -> TM.delete lnkId $ links st
         mapM_ (removeServiceQueue st serviceRcvQueues rId) rcvServiceId
         mapM_ (removeNotifier st) $ notifier q
         pure q
diff --git a/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs b/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
index fb741d575..21a5470aa 100644
--- a/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
+++ b/src/Simplex/Messaging/Server/StoreLog/ReadWrite.hs
@@ -14,9 +14,6 @@ module Simplex.Messaging.Server.StoreLog.ReadWrite
 
 import Control.Concurrent.STM
 import Control.Logger.Simple
-import Control.Monad
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Except
 import qualified Data.ByteString.Char8 as B
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
@@ -26,7 +23,7 @@ import Simplex.Messaging.Server.QueueStore (QueueRec, ServiceRec (..))
 import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..), STMService (..), withLoadedQueues)
 import Simplex.Messaging.Server.QueueStore.Types
 import Simplex.Messaging.Server.StoreLog
-import Simplex.Messaging.Util (tshow)
+import Simplex.Messaging.Util (tshow, ($>>=))
 import System.IO
 
 writeQueueStore :: forall q. StoreQueueClass q => StoreLog 'WriteMode -> STMQueueStore q -> IO ()
@@ -68,13 +65,7 @@ readQueueStore tty mkQ f st = readLogLines tty f $ \_ -> processLine
         printError :: String -> IO ()
         printError e = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s
         withQueue :: forall a. RecipientId -> T.Text -> (q -> IO (Either ErrorType a)) -> IO ()
-        withQueue qId op a = runExceptT go >>= qError qId op
-          where
-            go = do
-              q <- ExceptT $ getQueue_ st mkQ SRecipient qId
-              liftIO (readTVarIO $ queueRec q) >>= \case
-                Nothing -> logWarn $ logPfx qId op <> "already deleted"
-                Just _ -> void $ ExceptT $ a q
+        withQueue qId op a = (getQueue_ st mkQ SRecipient qId $>>= a) >>= qError qId op
         qError qId op = \case
           Left e -> logError $ logPfx qId op <> tshow e
           Right _ -> pure ()
diff --git a/tests/CoreTests/MsgStoreTests.hs b/tests/CoreTests/MsgStoreTests.hs
index 0cfcc8c49..20914e6e1 100644
--- a/tests/CoreTests/MsgStoreTests.hs
+++ b/tests/CoreTests/MsgStoreTests.hs
@@ -23,6 +23,7 @@ import Control.Monad.Trans.Except
 import Crypto.Random (ChaChaDRG)
 import Data.ByteString.Char8 (ByteString)
 import Data.Int (Int64)
+import qualified Data.Map.Strict as M
 import Data.Time.Clock.System (getSystemTime)
 import Simplex.Messaging.Crypto (pattern MaxLenBS)
 import qualified Simplex.Messaging.Crypto as C
@@ -31,7 +32,9 @@ import Simplex.Messaging.Server.MsgStore.STM
 import Simplex.Messaging.Server.MsgStore.Types
 import Simplex.Messaging.Server.QueueStore
 import Simplex.Messaging.Server.QueueStore.QueueInfo
+import Simplex.Messaging.Server.QueueStore.STM (STMQueueStore (..))
 import Simplex.Messaging.Server.QueueStore.Types
+import Simplex.Messaging.TMap (TMap)
 import Test.Hspec hiding (fit, it)
 import Util
 
@@ -50,7 +53,9 @@ import SMPClient (testStoreDBOpts)
 
 msgStoreTests :: Spec
 msgStoreTests = do
-  describe "STM message store" $ someMsgStoreTests testSMTStoreConfig
+  describe "STM message store" $ do
+    someMsgStoreTests testSMTStoreConfig
+    it "should remove deleted queues from queue store maps" $ withMsgStore testSMTStoreConfig testDeleteQueueMaps
 #if defined(dbServerPostgres)
   describe "Postgres-only message store" $ do
     someMsgStoreTests testPostgresStoreConfig
@@ -126,6 +131,18 @@ testNewQueueRecData g qm queueData = do
   where
     rndId = atomically $ EntityId <$> C.randomBytes 24 g
 
+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,
+        ntfServiceId = Nothing
+      }
+
 testGetQueue :: MsgStoreClass s => s -> IO ()
 testGetQueue ms = do
   g <- C.newRandom
@@ -217,6 +234,56 @@ testLinkDataSecuredQueue ms = do
     void $ ExceptT $ deleteQueue ms q
     void $ ExceptT $ deleteQueue ms cq
 
+-- sizes of queues, senders, links and notifiers maps
+type QueueMapSizes = (Int, Int, Int, Int)
+
+queueMapSizes :: STMMsgStore -> IO QueueMapSizes
+queueMapSizes ms = (,,,) <$> size queues <*> size senders <*> size links <*> size notifiers
+  where
+    STMQueueStore {queues, senders, links, notifiers} = queueStore ms
+    size :: TMap k v -> IO Int
+    size = fmap M.size . readTVarIO
+
+testDeleteQueueMaps :: STMMsgStore -> IO ()
+testDeleteQueueMaps ms = do
+  g <- C.newRandom
+  ntfCreds <- testNtfCreds g
+  let newLinkId = atomically $ EntityId <$> C.randomBytes 24 g
+  lnkId1 <- newLinkId
+  lnkId2 <- newLinkId
+  lnkId3 <- newLinkId
+  (rId1, qr1) <- testNewQueueRec g QMMessaging
+  (rId2, qr2) <- testNewQueueRecData g QMContact (Just (lnkId1, testLinkData))
+  (rId3, qr3) <- testNewQueueRec g QMMessaging
+  (rId4, qr4) <- testNewQueueRec g QMMessaging
+  let rIds = [rId1, rId2, rId3, rId4] :: [RecipientId]
+      sIds = map senderId [qr1, qr2, qr3, qr4]
+      lnkIds = [lnkId1, lnkId2, lnkId3] :: [LinkId]
+  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
+  runRight_ $ do
+    q1 <- ExceptT $ addQueue ms rId1 qr1 {notifier = Just ntfCreds}
+    q2 <- ExceptT $ addQueue ms rId2 qr2
+    q3 <- ExceptT $ addQueue ms rId3 qr3
+    q4 <- ExceptT $ addQueue ms rId4 qr4
+    ExceptT $ addQueueLinkData (queueStore ms) q3 lnkId2 testLinkData
+    ExceptT $ addQueueLinkData (queueStore ms) q4 lnkId3 testLinkData
+    forM_ sIds $ void . ExceptT . getQueue ms SSender
+    forM_ lnkIds $ void . ExceptT . getQueue ms SSenderLink
+    liftIO $ queueMapSizes ms `shouldReturn` (4, 4, 3, 1)
+    ExceptT $ deleteQueueLinkData (queueStore ms) q3
+    liftIO $ queueMapSizes ms `shouldReturn` (4, 4, 2, 1)
+    forM_ ([q1, q2, q3, q4] :: [STMQueue]) $ void . ExceptT . deleteQueue ms
+  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
+  forM_ rIds $ \rId -> getQueue ms SRecipient rId >>= expectAuth
+  forM_ sIds $ \sId -> getQueue ms SSender sId >>= expectAuth
+  forM_ lnkIds $ \lnkId -> getQueue ms SSenderLink lnkId >>= expectAuth
+  queueMapSizes ms `shouldReturn` (0, 0, 0, 0)
+  where
+    expectAuth = either (`shouldBe` AUTH) (\_ -> expectationFailure "deleted queue is still found")
+
+testLinkData :: QueueLinkData
+testLinkData = (EncDataBytes "fixed data", EncDataBytes "user data")
+
 #if defined(dbServerPostgres)
 testUpdateMessageCounts :: PostgresMsgStore -> IO ()
 testUpdateMessageCounts ms = do
diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs
index e0b8e16fc..d34755d1e 100644
--- a/tests/CoreTests/StoreLogTests.hs
+++ b/tests/CoreTests/StoreLogTests.hs
@@ -48,18 +48,6 @@ import Simplex.Messaging.Server.Main
 testPublicAuthKey :: C.APublicAuthKey
 testPublicAuthKey = C.APublicAuthKey C.SEd25519 (C.publicKey "MC4CAQAwBQYDK2VwBCIEIDfEfevydXXfKajz3sRkcQ7RPvfWUPoq6pu1TYHV1DEe")
 
-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,
-        ntfServiceId = Nothing
-      }
-
 data StoreLogTestCase r s = SLTC {name :: String, saved :: [r], state :: s, compacted :: [r]}
 
 type SMPStoreLogTestCase = StoreLogTestCase StoreLogRecord (M.Map RecipientId QueueRec)