core: improve database concurrency (#6541)

* core: improve database concurrency * tests: prints on timeouts (#6546) * update simplexmq * fix test * update simplexmq --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
2026-03-30 18:35:49 +00:00 · 2026-01-08 13:43:37 +00:00
parent d6eebd52fc
commit 3596c37275
10 changed files with 139 additions and 116 deletions
--- a/cabal.project
+++ b/cabal.project
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
    type: git
    location: https://github.com/simplex-chat/simplexmq.git
-    tag: c4b687ba644d8f0581a9f4317b6211c493a8d685
+    tag: 6aadcf1f3fc19cbc0c8be457556fbaaffb0bfc46

 source-repository-package
    type: git
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."c4b687ba644d8f0581a9f4317b6211c493a8d685" = "0s6wnmxjjr3fgfayyn0rdgwkqsg4z6da6ha0sq78mavvplwhg21m";
+  "https://github.com/simplex-chat/simplexmq.git"."6aadcf1f3fc19cbc0c8be457556fbaaffb0bfc46" = "1qlm542jnik48zid3zy7iys7ybjmlmj3mjhc5aplfk410a5qsb93";
  "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
  "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
  "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
--- a/src/Simplex/Chat/Library/Internal.hs
+++ b/src/Simplex/Chat/Library/Internal.hs
@@ -707,8 +707,8 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
      if
        | inline -> do
            -- accepting inline
-            ci <- withStore $ \db -> acceptRcvInlineFT db vr user fileId filePath
-            sharedMsgId <- withStore $ \db -> getSharedMsgIdByFileId db userId fileId
+            (ci, sharedMsgId) <- withStore $ \db ->
+              liftM2 (,) (acceptRcvInlineFT db vr user fileId filePath) (getSharedMsgIdByFileId db userId fileId)
            send $ XFileAcptInv sharedMsgId Nothing fName
            pure ci
        | fileInline == Just IFMSent -> throwChatError $ CEFileAlreadyReceiving fName
@@ -925,9 +925,11 @@ acceptGroupJoinRequestAsync
  incognitoProfile = do
    gVar <- asks random
    let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
-    (groupMemberId, memberId) <- withStore $ \db ->
-      createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus
-    currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
+    ((groupMemberId, memberId), currentMemCount) <- withStore $ \db ->
+      liftM2
+        (,)
+        (createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ welcomeMsgId_ gLinkMemRole initialStatus)
+        (liftIO $ getGroupCurrentMembersCount db user gInfo)
    let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
        GroupMember {memberRole = userRole, memberId = userMemberId} = membership
        msg =
@@ -1041,15 +1043,13 @@ introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRol

 introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
 introduceToAll vr user gInfo m = do
-  members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-  vector <- withStore (`getMemberRelationsVector` m)
+  (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
  let recipients = filter (shouldIntroduce m vector) members
  introduceMember user gInfo m recipients Nothing

 introduceToRemaining :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
 introduceToRemaining vr user gInfo m = do
-  members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-  vector <- withStore (`getMemberRelationsVector` m)
+  (members, vector) <- withStore $ \db -> liftM2 (,) (liftIO $ getGroupMembers db vr user gInfo) (getMemberRelationsVector db m)
  let recipients = filter (shouldIntroduce m vector) members
  introduceMember user gInfo m recipients Nothing

--- a/src/Simplex/Chat/Library/Subscriber.hs
+++ b/src/Simplex/Chat/Library/Subscriber.hs
@@ -691,9 +691,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
              -- TODO REMOVE LEGACY vvv
              -- [async agent commands] group link auto-accept continuation on receiving INV
              CFCreateConnGrpInv -> do
-                ct <- withStore $ \db -> getContactViaMember db vr user m
-                withStore' $ \db -> setNewContactMemberConnRequest db user m cReq
-                groupLinkId <- withStore' $ \db -> getGroupLinkId db user gInfo
+                (ct, groupLinkId) <- withStore $ \db -> do
+                  ct <- getContactViaMember db vr user m
+                  liftIO $ setNewContactMemberConnRequest db user m cReq
+                  liftIO $ (ct,) <$> getGroupLinkId db user gInfo
                sendGrpInvitation ct m groupLinkId
                toView $ CEvtSentGroupInvitation user gInfo ct m
                where
@@ -1814,8 +1815,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
        ts@(_, ft_) = msgContentTexts mc
        live = fromMaybe False live_
        updateRcvChatItem = do
-          cci <- withStore $ \db -> getGroupChatItemBySharedMsgId db user gInfo groupMemberId sharedMsgId
-          scopeInfo <- withStore $ \db -> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
+          (cci, scopeInfo) <- withStore $ \db -> do
+            cci <- getGroupChatItemBySharedMsgId db user gInfo groupMemberId sharedMsgId
+            (cci,) <$> getGroupChatScopeInfoForItem db vr user gInfo (cChatItemId cci)
          case cci of
            CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv m', meta = CIMeta {itemLive}, content = CIRcvMsgContent oldMC} ->
              if sameMemberId memberId m'
@@ -1948,8 +1950,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    xFileCancel :: Contact -> SharedMsgId -> CM ()
    xFileCancel Contact {contactId} sharedMsgId = do
-      fileId <- withStore $ \db -> getFileIdBySharedMsgId db userId contactId sharedMsgId
-      ft <- withStore (\db -> getRcvFileTransfer db user fileId)
+      (fileId, ft) <- withStore $ \db -> do
+        fileId <- getFileIdBySharedMsgId db userId contactId sharedMsgId
+        (fileId,) <$> getRcvFileTransfer db user fileId
      unless (rcvFileCompleteOrCancelled ft) $ do
        cancelRcvFileTransfer user ft
        ci <- withStore $ \db -> getChatItemByFileId db vr user fileId
@@ -1957,8 +1960,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    xFileAcptInv :: Contact -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM ()
    xFileAcptInv ct sharedMsgId fileConnReq_ fName = do
-      fileId <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId
-      (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId
+      (fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
+        fileId <- getDirectFileIdBySharedMsgId db user ct sharedMsgId
+        (fileId,) <$> getChatItemByFileId db vr user fileId
      assertSMPAcceptNotProhibited ci
      ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
      -- [async agent commands] no continuation needed, but command should be asynchronous for stability
@@ -2033,8 +2037,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
    xFileCancelGroup g@GroupInfo {groupId} GroupMember {memberId} sharedMsgId = do
      (fileId, aci) <- withStore $ \db -> do
        fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
-        aci <- getChatItemByFileId db vr user fileId
-        pure (fileId, aci)
+        (fileId,) <$> getChatItemByFileId db vr user fileId
      case aci of
        AChatItem SCTGroup SMDRcv (GroupChat _g scopeInfo) ChatItem {chatDir = CIGroupRcv m} -> do
          if sameMemberId memberId m
@@ -2051,8 +2054,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    xFileAcptInvGroup :: GroupInfo -> GroupMember -> SharedMsgId -> Maybe ConnReqInvitation -> String -> CM ()
    xFileAcptInvGroup GroupInfo {groupId} m@GroupMember {activeConn} sharedMsgId fileConnReq_ fName = do
-      fileId <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
-      (AChatItem _ _ _ ci) <- withStore $ \db -> getChatItemByFileId db vr user fileId
+      (fileId, AChatItem _ _ _ ci) <- withStore $ \db -> do
+        fileId <- getGroupFileIdBySharedMsgId db userId groupId sharedMsgId
+        (fileId,) <$> getChatItemByFileId db vr user fileId
      assertSMPAcceptNotProhibited ci
      -- TODO check that it's not already accepted
      ft@FileTransferMeta {fileName, fileSize, fileInline, cancelled} <- withStore (\db -> getFileTransferMeta db user fileId)
@@ -2123,8 +2127,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
    xDirectDel c msg msgMeta =
      if directOrUsed c
        then do
-          ct' <- withStore' $ \db -> updateContactStatus db user c CSDeleted
-          contactConns <- withStore' $ \db -> getContactConnections db vr userId ct'
+          (ct', contactConns) <- withStore' $ \db -> do
+            ct' <- updateContactStatus db user c CSDeleted
+            (ct',) <$> getContactConnections db vr userId ct'
          deleteAgentConnectionsAsync $ map aConnId contactConns
          forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted
          activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted}
@@ -2496,15 +2501,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    associateMemberWithContact :: Contact -> GroupMember -> CM Contact
    associateMemberWithContact c1 m2@GroupMember {groupId} = do
-      withStore' $ \db -> associateMemberWithContactRecord db user c1 m2
-      g <- withStore $ \db -> getGroupInfo db vr user groupId
+      g <- withStore $ \db -> do
+        liftIO $ associateMemberWithContactRecord db user c1 m2
+        getGroupInfo db vr user groupId
      toView $ CEvtContactAndMemberAssociated user c1 g m2 c1
      pure c1

    associateContactWithMember :: GroupMember -> Contact -> CM Contact
    associateContactWithMember m1@GroupMember {groupId} c2 = do
-      c2' <- withStore $ \db -> associateContactWithMemberRecord db vr user m1 c2
-      g <- withStore $ \db -> getGroupInfo db vr user groupId
+      (c2', g) <- withStore $ \db ->
+        liftM2 (,) (associateContactWithMemberRecord db vr user m1 c2) (getGroupInfo db vr user groupId)
      toView $ CEvtContactAndMemberAssociated user c2 g m1 c2'
      pure c2'

@@ -2622,19 +2628,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
    xGrpMemFwd gInfo@GroupInfo {membership, chatSettings} m memInfo@(MemberInfo memId memRole memChatVRange _) IntroInvitation {groupConnReq, directConnReq} = do
      let GroupMember {memberId = membershipMemId} = membership
      checkHostRole m memRole
-      toMember <-
-        withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
+      toMember <- withStore $ \db -> do
+        toMember <- getGroupMemberByMemberId db vr user gInfo memId
          -- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
          -- the situation when member does not exist is an error
          -- member receiving x.grp.mem.fwd should have also received x.grp.mem.new prior to that.
          -- For now, this branch compensates for the lack of delayed message delivery.
-          Left _ -> withStore $ \db -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
-          Right m' -> pure m'
-      -- TODO [knocking] separate pending statuses from GroupMemberStatus?
-      -- TODO            add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
-      -- TODO            keep as is? (GSMemIntroInvited has no purpose)
-      let newMemberStatus = if memberPending toMember then memberStatus toMember else GSMemIntroInvited
-      withStore' $ \db -> updateGroupMemberStatus db userId toMember newMemberStatus
+          `catchError` \case
+            SEGroupMemberNotFoundByMemberId _ -> createNewGroupMember db user gInfo m memInfo GCPostMember GSMemAnnounced
+            e -> throwError e
+        -- TODO [knocking] separate pending statuses from GroupMemberStatus?
+        -- TODO            add GSMemIntroInvitedPending, GSMemConnectedPending, etc.?
+        -- TODO            keep as is? (GSMemIntroInvited has no purpose)
+        let newMemberStatus = if memberPending toMember then memberStatus toMember else GSMemIntroInvited
+        liftIO $ updateGroupMemberStatus db userId toMember newMemberStatus
+        pure toMember
      subMode <- chatReadVar subscriptionMode
      -- [incognito] send membership incognito profile, create direct connection as incognito
      let membershipProfile = redactedMemberProfile allowSimplexLinks $ fromLocalProfile $ memberProfile membership
@@ -3021,14 +3029,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =

    updateGroupItemsStatus :: GroupInfo -> GroupMember -> Connection -> AgentMsgId -> GroupSndStatus -> Maybe Bool -> CM ()
    updateGroupItemsStatus gInfo@GroupInfo {groupId} GroupMember {groupMemberId} Connection {connId} msgId newMemStatus viaProxy_ = do
-      items <- withStore' (\db -> getGroupChatItemsByAgentMsgId db user groupId connId msgId)
-      cis <- catMaybes <$> withStore (\db -> mapM (updateItem db) items)
-      -- SENT and RCVD events are received for messages that may be batched in single scope,
-      -- so we can look up scope of first item
-      scopeInfo <- case cis of
-        (ci : _) -> withStore $ \db -> getGroupChatScopeInfoForItem db vr user gInfo (chatItemId' ci)
-        _ -> pure Nothing
-      let acis = map (gItem scopeInfo) cis
+      acis <- withStore $ \db -> do
+        items <- liftIO $ getGroupChatItemsByAgentMsgId db user groupId connId msgId
+        cis <- catMaybes <$> mapM (updateItem db) items
+        -- SENT and RCVD events are received for messages that may be batched in single scope,
+        -- so we can look up scope of first item
+        scopeInfo <- case cis of
+          (ci : _) -> getGroupChatScopeInfoForItem db vr user gInfo (chatItemId' ci)
+          _ -> pure Nothing
+        pure $ map (gItem scopeInfo) cis
      unless (null acis) $ toView $ CEvtChatItemsStatusesUpdated user acis
      where
        gItem scopeInfo ci = AChatItem SCTGroup SMDSnd (GroupChat gInfo scopeInfo) ci
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -1596,11 +1596,11 @@ setMemberVectorNewRelations db GroupMember {groupMemberId} relations = do
  v_ <- maybeFirstRow fromOnly $
    DB.query
      db
+      ( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
 #if defined(dbPostgres)
-      "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? FOR UPDATE"
-#else
-      "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
+          <> " FOR UPDATE"
 #endif
+      )
      (Only groupMemberId)
  let v' = setNewRelations relations $ fromMaybe B.empty v_
  currentTs <- getCurrentTime
@@ -1638,11 +1638,11 @@ setMemberVectorRelationConnected db GroupMember {groupMemberId} GroupMember {ind
    firstRow fromOnly (SEMemberRelationsVectorNotFound groupMemberId) $
      DB.query
        db
+        ( "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
 #if defined(dbPostgres)
-        "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL FOR UPDATE"
-#else
-        "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
+          <> " FOR UPDATE"
 #endif
+        )
        (Only groupMemberId)
  let v' = setRelationConnected indexInGroup newStatus v
  currentTs <- liftIO getCurrentTime
--- a/src/Simplex/Chat/Store/Messages.hs
+++ b/src/Simplex/Chat/Store/Messages.hs
@@ -52,7 +52,6 @@ module Simplex.Chat.Store.Messages
    getDirectChatItemLast,
    getAllChatItems,
    getAChatItem,
-    getAChatItemBySharedMsgId,
    updateDirectChatItem,
    updateDirectChatItem',
    addInitialAndNewCIVersions,
@@ -1235,13 +1234,17 @@ getDirectChatItemLast db user@User {userId} contactId = do
    ExceptT . firstRow fromOnly (SEChatItemNotFoundByContactId contactId) $
      DB.query
        db
-        [sql|
-          SELECT chat_item_id
-          FROM chat_items
-          WHERE user_id = ? AND contact_id = ?
-          ORDER BY created_at DESC, chat_item_id DESC
-          LIMIT 1
-        |]
+        ( [sql|
+            SELECT chat_item_id
+            FROM chat_items
+            WHERE user_id = ? AND contact_id = ?
+            ORDER BY created_at DESC, chat_item_id DESC
+            LIMIT 1
+          |]
+#if defined(dbPostgres)
+            <> " FOR UPDATE"
+#endif
+        )
        (userId, contactId)
  getDirectChatItem db user contactId chatItemId

@@ -1560,13 +1563,17 @@ getGroupMemberChatItemLast db user@User {userId} groupId groupMemberId = do
    ExceptT . firstRow fromOnly (SEChatItemNotFoundByGroupId groupId) $
      DB.query
        db
-        [sql|
-          SELECT chat_item_id
-          FROM chat_items
-          WHERE user_id = ? AND group_id = ? AND group_member_id = ?
-          ORDER BY item_ts DESC, chat_item_id DESC
-          LIMIT 1
-        |]
+        ( [sql|
+            SELECT chat_item_id
+            FROM chat_items
+            WHERE user_id = ? AND group_id = ? AND group_member_id = ?
+            ORDER BY item_ts DESC, chat_item_id DESC
+            LIMIT 1
+          |]
+#if defined(dbPostgres)
+          <> " FOR UPDATE"
+#endif
+        )
        (userId, groupId, groupMemberId)
  getGroupChatItem db user groupId chatItemId

@@ -3243,15 +3250,6 @@ getAChatItem db vr user (ChatRef cType chatId scope) itemId = do
    _ -> throwError $ SEChatItemNotFound itemId
  liftIO $ getACIReactions db aci

-getAChatItemBySharedMsgId :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> SharedMsgId -> ExceptT StoreError IO AChatItem
-getAChatItemBySharedMsgId db user cd sharedMsgId = case cd of
-  CDDirectRcv ct@Contact {contactId} -> do
-    (CChatItem msgDir ci) <- getDirectChatItemBySharedMsgId db user contactId sharedMsgId
-    pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci
-  CDGroupRcv g scopeInfo GroupMember {groupMemberId} -> do
-    (CChatItem msgDir ci) <- getGroupChatItemBySharedMsgId db user g groupMemberId sharedMsgId
-    pure $ AChatItem SCTGroup msgDir (GroupChat g scopeInfo) ci
-
 getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion]
 getChatItemVersions db itemId = do
  map toChatItemVersion
--- a/tests/Bots/DirectoryTests.hs
+++ b/tests/Bots/DirectoryTests.hs
@@ -1167,8 +1167,7 @@ testCapthaScreening ps =
        bob <## "/'filter 1 off' - disable filter"
        -- connect with captcha screen
        _ <- join cath groupLink
-        cath ##> "/_send #1(_support) text 123" -- sending incorrect captcha
-        cath <# "#privacy (support) 123"
+        cath #> "#privacy (support) 123" -- sending incorrect captcha
        cath <# "#privacy (support) 'SimpleX Directory'!> > cath 123"
        cath <## "      Incorrect text, please try again."
        captcha <- dropStrPrefix "#privacy (support) 'SimpleX Directory'> " . dropTime <$> getTermLine cath
@@ -1220,8 +1219,7 @@ testCapthaScreening ps =
      cath <## "Send captcha text to join the group privacy."
      dropStrPrefix "#privacy (support) 'SimpleX Directory'> " . dropTime <$> getTermLine cath
    sendCaptcha cath captcha = do
-      cath ##> ("/_send #1(_support) text " <> captcha)
-      cath <# ("#privacy (support) " <> captcha)
+      cath #> ("#privacy (support) " <> captcha)
      cath <# ("#privacy (support) 'SimpleX Directory'!> > cath " <> captcha)
      cath <## "      Correct, you joined the group privacy"
      cath <## "#privacy: you joined the group"
@@ -1411,8 +1409,10 @@ submitGroup u n fn = do

 groupAccepted :: TestCC -> String -> IO String
 groupAccepted u n = do
-  u <# ("'SimpleX Directory'> Joining the group " <> n <> "…")
-  u <## ("#" <> viewName n <> ": 'SimpleX Directory' joined the group")
+  u <###
+    [ WithTime ("'SimpleX Directory'> Joining the group " <> n <> "…"),
+      ConsoleString ("#" <> viewName n <> ": 'SimpleX Directory' joined the group")
+    ]
  u <# ("'SimpleX Directory'> Joined the group " <> n <> ", creating the link…")
  u <# "'SimpleX Directory'> Created the public link to join the group via this directory service that is always online."
  u <## ""
--- a/tests/ChatClient.hs
+++ b/tests/ChatClient.hs
@@ -84,7 +84,7 @@ schemaDumpDBOpts =
  DBOpts
    { connstr = B.pack testDBConnstr,
      schema = "test_chat_schema",
-      poolSize = 3,
+      poolSize = 10,
      createSchema = True
    }

@@ -131,7 +131,7 @@ testCoreOpts =
          -- dbSchemaPrefix is not used in tests (except bot tests where it's redefined),
          -- instead different schema prefix is passed per client so that single test database is used
          dbSchemaPrefix = "",
-          dbPoolSize = 1,
+          dbPoolSize = 10,
          dbCreateSchema = True
 #else
        { dbFilePrefix = "./simplex_v1", -- dbFilePrefix is not used in tests (except bot tests where it's redefined)
@@ -424,7 +424,10 @@ testChatN cfg opts ps test params =
 (<//) cc t = timeout t (getTermLine cc) `shouldReturn` Nothing

 getTermLine :: HasCallStack => TestCC -> IO String
-getTermLine cc@TestCC {printOutput} =
+getTermLine = getTermLine' Nothing
+
+getTermLine' :: HasCallStack => Maybe String -> TestCC -> IO String
+getTermLine' expected cc@TestCC {printOutput} =
  5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case
    Just s -> do
      -- remove condition to always echo virtual terminal
@@ -433,7 +436,12 @@ getTermLine cc@TestCC {printOutput} =
        name <- userName cc
        putStrLn $ name <> ": " <> s
      pure s
-    _ -> error "no output for 5 seconds"
+    Nothing -> do
+      name <- userName cc
+      let expectedMsg = case expected of
+            Just e -> ", expected: " <> show e
+            Nothing -> ""
+      error $ name <> ": no output for 5 seconds" <> expectedMsg

 userName :: TestCC -> IO [Char]
 userName (TestCC ChatController {currentUser} _ _ _ _ _) =
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -2071,11 +2071,8 @@ testSharedMessageBody ps' =
            ]
          bob <# "#team alice> hello"
          cath <# "#team alice> hello"
-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body
-#if !defined(dbPostgres)
          threadDelay 500000
          checkMsgBodyCount alice 0
-#endif

    alice <## "disconnected 4 connections on server localhost"
  where
@@ -2130,10 +2127,7 @@ testSharedBatchBody ps =
            concurrently_
              (bob <# ("#team alice> message " <> show i))
              (cath <# ("#team alice> message " <> show i))
-- because of PostgreSQL concurrency deleteSndMsgDelivery fails to delete message body
-#if !defined(dbPostgres)          
          checkMsgBodyCount alice 0
-#endif

    alice <## "disconnected 4 connections on server localhost"
  where
--- a/tests/ChatTests/Utils.hs
+++ b/tests/ChatTests/Utils.hs
@@ -171,7 +171,8 @@ cc ?#> cmd = do
 (#$>) :: (Eq a, Show a, HasCallStack) => TestCC -> (String, String -> a, a) -> Expectation
 cc #$> (cmd, f, res) = do
  cc ##> cmd
-  (f <$> getTermLine cc) `shouldReturn` res
+  let expected = "result of " <> cmd <> ": " <> show res
+  (f <$> getTermLine' (Just expected) cc) `shouldReturn` res

 -- / PQ combinators

@@ -345,7 +346,7 @@ chats = mapChats . read
 getChats :: HasCallStack => (Eq a, Show a) => ([(String, String, Maybe ConnStatus)] -> [a]) -> TestCC -> [a] -> Expectation
 getChats f cc res = do
  cc ##> "/_get chats 1 pcc=on"
-  line <- getTermLine cc
+  line <- getTermLine' (Just "chat list") cc
  f (read line) `shouldMatchList` res

 send :: TestCC -> String -> IO ()
@@ -353,41 +354,41 @@ send TestCC {chatController = cc} cmd = atomically $ writeTBQueue (inputQ cc) cm

 (<##) :: HasCallStack => TestCC -> String -> Expectation
 cc <## line = do
-  l <- getTermLine cc
+  l <- getTermLine' (Just line) cc
  when (l /= line) $ print ("expected: " <> line, ", got: " <> l)
  l `shouldBe` line

 (<##.) :: HasCallStack => TestCC -> String -> Expectation
 cc <##. line = do
-  l <- getTermLine cc
+  l <- getTermLine' (Just $ "prefix: " <> line) cc
  let prefix = line `isPrefixOf` l
  unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
  prefix `shouldBe` True

 (.<##) :: HasCallStack => TestCC -> String -> Expectation
 cc .<## line = do
-  l <- getTermLine cc
+  l <- getTermLine' (Just $ "suffix: " <> line) cc
  let suffix = line `isSuffixOf` l
  unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
  suffix `shouldBe` True

 (<#.) :: HasCallStack => TestCC -> String -> Expectation
 cc <#. line = do
-  l <- dropTime <$> getTermLine cc
+  l <- dropTime <$> getTermLine' (Just $ "prefix: " <> line) cc
  let prefix = line `isPrefixOf` l
  unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
  prefix `shouldBe` True

 (.<#) :: HasCallStack => TestCC -> String -> Expectation
 cc .<# line = do
-  l <- dropTime <$> getTermLine cc
+  l <- dropTime <$> getTermLine' (Just $ "suffix: " <> line) cc
  let suffix = line `isSuffixOf` l
  unless suffix $ print ("expected to end with: " <> line, ", got: " <> l)
  suffix `shouldBe` True

 (<##..) :: HasCallStack => TestCC -> [String] -> Expectation
 cc <##.. ls = do
-  l <- getTermLine cc
+  l <- getTermLine' (Just $ "one of prefixes: " <> show ls) cc
  let prefix = any (`isPrefixOf` l) ls
  unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
  prefix `shouldBe` True
@@ -395,7 +396,8 @@ cc <##.. ls = do
 (>*) :: HasCallStack => TestCC -> String -> IO ()
 cc >* note = do
  cc `send` ("/* " <> note)
-  (dropTime <$> getTermLine cc) `shouldReturn` ("* " <> note)
+  let expected = "* " <> note
+  (dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected

 data ConsoleResponse
  = ConsoleString String
@@ -404,13 +406,21 @@ data ConsoleResponse
  | StartsWith String
  | Predicate (String -> Bool)

+instance Show ConsoleResponse where
+  show (ConsoleString s) = show s
+  show (WithTime s) = "WithTime " <> show s
+  show (EndsWith s) = "EndsWith " <> show s
+  show (StartsWith s) = "StartsWith " <> show s
+  show (Predicate _) = "<predicate>"
+
 instance IsString ConsoleResponse where fromString = ConsoleString

 -- this assumes that the string can only match one option
 getInAnyOrder :: HasCallStack => (String -> String) -> TestCC -> [ConsoleResponse] -> Expectation
 getInAnyOrder _ _ [] = pure ()
 getInAnyOrder f cc ls = do
-  line <- f <$> getTermLine cc
+  let expectedDesc = "one of " <> show (length ls) <> " responses: " <> show ls
+  line <- f <$> getTermLine' (Just expectedDesc) cc
  let rest = filterFirst (expected line) ls
  if length rest < length ls
    then getInAnyOrder f cc rest
@@ -436,25 +446,27 @@ getInAnyOrder f cc ls = do
 (<##?) = getInAnyOrder dropTime

 (<#) :: HasCallStack => TestCC -> String -> Expectation
-cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line
+cc <# line = (dropTime <$> getTermLine' (Just line) cc) `shouldReturn` line

 (*<#) :: HasCallStack => [TestCC] -> String -> Expectation
 ccs *<# line = mapConcurrently_ (<# line) ccs

 (?<#) :: HasCallStack => TestCC -> String -> Expectation
-cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line
+cc ?<# line = do
+  let expected = "i " <> line
+  (dropTime <$> getTermLine' (Just expected) cc) `shouldReturn` expected

 ($<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
-(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line
+(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine' (Just $ "for user " <> uName <> ": " <> line) cc) `shouldReturn` line

 (^<#) :: HasCallStack => (TestCC, String) -> String -> Expectation
-(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine cc) `shouldReturn` line
+(cc, p) ^<# line = (dropTime . dropStrPrefix p <$> getTermLine' (Just $ "without prefix " <> p <> ": " <> line) cc) `shouldReturn` line

 (⩗) :: HasCallStack => TestCC -> String -> Expectation
-cc ⩗ line = (dropTime . dropReceipt <$> getTermLine cc) `shouldReturn` line
+cc ⩗ line = (dropTime . dropReceipt <$> getTermLine' (Just $ "receipt: " <> line) cc) `shouldReturn` line

 (%) :: HasCallStack => TestCC -> String -> Expectation
-cc % line = (dropTime . dropPartialReceipt <$> getTermLine cc) `shouldReturn` line
+cc % line = (dropTime . dropPartialReceipt <$> getTermLine' (Just $ "partial receipt: " <> line) cc) `shouldReturn` line

 (</) :: HasCallStack => TestCC -> Expectation
 (</) = (<// 500000)
@@ -527,7 +539,7 @@ getInvitations :: HasCallStack => TestCC -> IO (String, String)
 getInvitations cc = do
  shortInv <- getInvitation_ cc
  cc <##. "The invitation link for old clients:"
-  fullInv <- getTermLine cc
+  fullInv <- getTermLine' (Just "full invitation link") cc
  pure (shortInv, fullInv)

 getInvitationNoShortLink :: HasCallStack => TestCC -> IO String
@@ -537,7 +549,7 @@ getInvitation_ :: HasCallStack => TestCC -> IO String
 getInvitation_ cc = do
  cc <## "pass this invitation link to your contact (via another channel):"
  cc <## ""
-  inv <- getTermLine cc
+  inv <- getTermLine' (Just "invitation link") cc
  cc <## ""
  cc <## "and ask them to connect: /c <invitation_link_above>"
  pure inv
@@ -550,7 +562,8 @@ getContactLink cc created = do
 getContactLinks :: HasCallStack => TestCC -> Bool -> IO (String, String)
 getContactLinks cc created = do
  shortLink <- getContactLink_ cc created
-  fullLink <- dropLinePrefix "The contact link for old clients: " =<< getTermLine cc
+  line <- getTermLine' (Just "full contact link line") cc
+  fullLink <- dropLinePrefix "The contact link for old clients: " line
  pure (shortLink, fullLink)

 getContactLinkNoShortLink :: HasCallStack => TestCC -> Bool -> IO String
@@ -560,7 +573,7 @@ getContactLink_ :: HasCallStack => TestCC -> Bool -> IO String
 getContactLink_ cc created = do
  cc <## if created then "Your new chat address is created!" else "Your chat address:"
  cc <## ""
-  link <- getTermLine cc
+  link <- getTermLine' (Just "contact link") cc
  cc <## ""
  cc <## "Anybody can send you contact requests with: /c <contact_link_above>"
  cc <## "to show it again: /sa"
@@ -581,7 +594,8 @@ getGroupLink cc gName mRole created = do
 getGroupLinks :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO (String, String)
 getGroupLinks cc gName mRole created = do
  shortLink <- getGroupLink_ cc gName mRole created
-  fullLink <- dropLinePrefix "The group link for old clients: " =<< getTermLine cc
+  line <- getTermLine' (Just "full group link line") cc
+  fullLink <- dropLinePrefix "The group link for old clients: " line
  pure (shortLink, fullLink)

 getGroupLinkNoShortLink :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool -> IO String
@@ -591,7 +605,7 @@ getGroupLink_ :: HasCallStack => TestCC -> String -> GroupMemberRole -> Bool ->
 getGroupLink_ cc gName mRole created = do
  cc <## if created then "Group link is created!" else "Group link:"
  cc <## ""
-  link <- getTermLine cc
+  link <- getTermLine' (Just $ "group link for " <> gName) cc
  cc <## ""
  cc <## ("Anybody can connect to you and join group as " <> T.unpack (textEncode mRole) <> " with: /c <group_link_above>")
  cc <## ("to show it again: /show link #" <> gName)
@@ -669,7 +683,7 @@ getTestCCContact cc contactId = do
 lastItemId :: HasCallStack => TestCC -> IO String
 lastItemId cc = do
  cc ##> "/last_item_id"
-  getTermLine cc
+  getTermLine' (Just "last item id") cc

 showActiveUser :: HasCallStack => TestCC -> String -> Expectation
 showActiveUser cc name = do