Merge branch 'master' into ab/async-subs

docs/rfcs/2024-05-28-optimized-subscription.md

@@ -0,0 +1,43 @@
+# Optimized subscription
+
+## Problem
+
+The `subscribeUserConnections` function has a few problems that affect UX on app start:
+
+1. It loads entity data that isn't used until result processing. This produces a memory spike and takes CPU time to parse all the data.
+2. Subscription results are processed synchronously after the agent finishes all the batches for user. The app wouldn't see connections as active until the slowest server responds or timeouts.
+3. User subscriptions are processed sequentially. A currently active user is given a first round of subs, but the remaining are blocked. If a user profile is switched right away, the new user may start receiving updates with even more lag.
+
+## Solution
+
+Functions that fetch connections and entities are reduced to return only connection IDs. The filters should be moved from Haskell into specialized SQL queries that only return `[ConnId]`.
+
+With the connection list on hands the agent subscriber thread forks off to do its thing and process batch results. This allows outer loop to start collecting connections for the remaining users.
+
+Successful results are communicated with a new `UP srv conns` message emitted from agent when a batch finishes its processing. The `conns` payload would be a list of connections that actually have just switched subs from "pending" to "active". The UP handling machinery processes status updates just as it would in a server reconnect event. This would update connection state in chat apps as soon as the server responds, keeping app and core in tighter sync.
+
+`reconnectSMPClient` should stop sending UPs to prevent double processing of the same result. The `okConns` membership test it currently uses is the same "did not belong to an active connection" that the batch result would use.
+
+Sending results with UP allows to reduce summary responses to a bunch of counters so no entity data would be needed for CLI here:
+
+```haskell
+| CRContactSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+| CRUserGroupLinksSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+| CRMemberSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+| CRPendingSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+```
+
+Subscription errors are reported to API as `CRNetworkStatuses` as ususal, but the active subs are removed from the list as they are already handled by `UP`.
+
+Subscription errors for CLI (when connection error reporting is enabled) are reported with the types reduced to a textual name:
+
+```haskell
+| CRContactSubError {user :: User, contactName :: ContactName, chatError :: ChatError}
+| CRMemberSubError {user :: User, groupName :: GroupName, contactName :: ContactName, chatError :: ChatError}
+| CRSndFileSubError {user :: User, sndFileTransfer :: Text, chatError :: ChatError}
+| CRRcvFileSubError {user :: User, rcvFileTransfer :: Text, chatError :: ChatError}
+```
+
+> A generic constructor could be used instead, but then it would contain extra fields to form a message in View if matching the current output is desired.
+
+The textual names for connections can be requested for the subset of all connections that needs them with the same procedure that's used in `UP` handling.

simplex-chat.cabal

@@ -146,6 +146,7 @@ library
       Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
       Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
       Simplex.Chat.Migrations.M20240528_quota_err_counter
+      Simplex.Chat.Migrations.M20240530_user_contact_links_user_id
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared

src/Simplex/Chat.hs

@@ -3400,71 +3400,55 @@ subscribeUserConnections :: VersionRangeChat -> Bool -> AgentBatchSubscribe -> U
 subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
   -- get user connections
   ce <- asks $ subscriptionEvents . config
-  (conns, cts, ucs, gs, ms, sfts, rfts, pcs) <-
+  (conns, ctConns, ucs, gs, mConns, sfts, rfts, pcConns) <-
     if onlyNeeded
       then do
-        (conns, entities) <- withStore' (`getConnectionsToSubscribe` vr)
+        (conns, entities) <- withStore' $ \db -> getConnectionsToSubscribe db vr user
-        let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity (M.empty, M.empty, M.empty, M.empty, M.empty, M.empty) entities
+        let (cts, ucs, ms, sfts, rfts, pcs) = foldl' addEntity ([], [], [], M.empty, M.empty, []) entities
         pure (conns, cts, ucs, [], ms, sfts, rfts, pcs)
       else do
-        withStore' unsetConnectionToSubscribe
+        withStore' (`unsetConnectionToSubscribe` user)
-        (ctConns, cts) <- getContactConns
+        ctConns <- getContactConns
         (ucConns, ucs) <- getUserContactLinkConns
-        (gs, mConns, ms) <- getGroupMemberConns
+        (gs, mConns) <- getGroupMemberConns
         (sftConns, sfts) <- getSndFileTransferConns
         (rftConns, rfts) <- getRcvFileTransferConns
-        (pcConns, pcs) <- getPendingContactConns
+        pcConns <- getPendingContactConns
         let conns = concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns]
-        pure (conns, cts, ucs, gs, ms, sfts, rfts, pcs)
+        pure (conns, ctConns, ucs, gs, mConns, sfts, rfts, pcConns)
-  -- subscribe using batched commands
+  -- detach subscription and result processing
-  rs <- withAgent $ \a -> agentBatchSubscribe a conns
+  void . lift . forkIO . runSubscriber $ do
-  -- send connection events to view
+    -- subscribe using batched commands
-  contactSubsToView rs cts ce
+    rs <- withAgent $ \a -> agentBatchSubscribe a conns
-  -- TODO possibly, we could either disable these events or replace with less noisy for API
+    let (errs, _oks) = M.mapEither id rs
-  contactLinkSubsToView rs ucs
+    refs <- if ce then withStore' $ \db -> getConnectionsContacts db (M.keys errs) else pure []
-  groupSubsToView rs gs ms ce
+    let connRefs = M.fromList $ map (\ContactRef {agentConnId = AgentConnId acId, localDisplayName} -> (acId, localDisplayName)) refs
-  sndFileSubsToView rs sfts
+    contactSubsToView errs ctConns connRefs ce
-  rcvFileSubsToView rs rfts
+    contactLinkSubsToView errs ucs
-  pendingConnSubsToView rs pcs
+    groupSubsToView errs gs mConns connRefs ce
+    sndFileSubsToView errs sfts
+    rcvFileSubsToView errs rfts
+    pendingConnSubsToView errs pcConns
   where
+    runSubscriber :: CM () -> CM' ()
+    runSubscriber action = tryAllErrors' mkChatError action >>= either (logError . tshow) pure
     addEntity (cts, ucs, ms, sfts, rfts, pcs) = \case
-      RcvDirectMsgConnection c (Just ct) -> let cts' = addConn c ct cts in (cts', ucs, ms, sfts, rfts, pcs)
+      RcvDirectMsgConnection c (Just _ct) -> let cts' = aConnId c : cts in (cts', ucs, ms, sfts, rfts, pcs)
-      RcvDirectMsgConnection c Nothing -> let pcs' = addConn c (toPCC c) pcs in (cts, ucs, ms, sfts, rfts, pcs')
+      RcvDirectMsgConnection c Nothing -> let pcs' = aConnId c : pcs in (cts, ucs, ms, sfts, rfts, pcs')
-      RcvGroupMsgConnection c _g m -> let ms' = addConn c m ms in (cts, ucs, ms', sfts, rfts, pcs)
+      RcvGroupMsgConnection c _g _m -> let ms' = aConnId c : ms in (cts, ucs, ms', sfts, rfts, pcs)
-      SndFileConnection c sft -> let sfts' = addConn c sft sfts in (cts, ucs, ms, sfts', rfts, pcs)
+      SndFileConnection c sft -> let sfts' = M.insert (aConnId c) sft sfts in (cts, ucs, ms, sfts', rfts, pcs)
-      RcvFileConnection c rft -> let rfts' = addConn c rft rfts in (cts, ucs, ms, sfts, rfts', pcs)
+      RcvFileConnection c rft -> let rfts' = M.insert (aConnId c) rft rfts in (cts, ucs, ms, sfts, rfts', pcs)
-      UserContactConnection c uc -> let ucs' = addConn c uc ucs in (cts, ucs', ms, sfts, rfts, pcs)
+      UserContactConnection c uc -> let ucs' = (aConnId c, isNothing $ userContactGroupId uc) : ucs in (cts, ucs', ms, sfts, rfts, pcs)
-    addConn :: Connection -> a -> Map ConnId a -> Map ConnId a
+    getContactConns :: CM [ConnId]
-    addConn = M.insert . aConnId
+    getContactConns = withStore_ getUserContactConnIds
-    toPCC Connection {connId, agentConnId, connStatus, viaUserContactLink, groupLinkId, customUserProfileId, localAlias, createdAt} =
+    getUserContactLinkConns :: CM ([ConnId], [(ConnId, Bool)])
-      PendingContactConnection
-        { pccConnId = connId,
-          pccAgentConnId = agentConnId,
-          pccConnStatus = connStatus,
-          viaContactUri = False,
-          viaUserContactLink,
-          groupLinkId,
-          customUserProfileId,
-          connReqInv = Nothing,
-          localAlias,
-          createdAt,
-          updatedAt = createdAt
-        }
-    getContactConns :: CM ([ConnId], Map ConnId Contact)
-    getContactConns = do
-      cts <- withStore_ (`getUserContacts` vr)
-      let cts' = mapMaybe (\ct -> (,ct) <$> contactConnId ct) $ filter contactActive cts
-      pure (map fst cts', M.fromList cts')
-    getUserContactLinkConns :: CM ([ConnId], Map ConnId UserContact)
     getUserContactLinkConns = do
-      (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr)
+      ucs <- withStore_ getUserContactLinks
-      let connIds = map aConnId cs
+      pure (map fst ucs, ucs)
-      pure (connIds, M.fromList $ zip connIds ucs)
+    getGroupMemberConns :: CM ([(GroupInfo, [ConnId])], [ConnId])
-    getGroupMemberConns :: CM ([Group], [ConnId], Map ConnId GroupMember)
     getGroupMemberConns = do
-      gs <- withStore_ (`getUserGroups` vr)
+      gs <- withStore_ (`getUserGroupMemberConnIds` vr)
-      let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs
+      pure (gs, concatMap snd gs)
-      pure (gs, map fst mPairs, M.fromList mPairs)
     getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer)
     getSndFileTransferConns = do
       sfts <- withStore_ getLiveSndFileTransfers
@@ -3475,92 +3459,81 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do
       rfts <- withStore_ getLiveRcvFileTransfers
       let rftPairs = mapMaybe (\ft -> (,ft) <$> liveRcvFileTransferConnId ft) rfts
       pure (map fst rftPairs, M.fromList rftPairs)
-    getPendingContactConns :: CM ([ConnId], Map ConnId PendingContactConnection)
+    getPendingContactConns :: CM [ConnId]
-    getPendingContactConns = do
+    getPendingContactConns = withStore_ getPendingContactConnections
-      pcs <- withStore_ getPendingContactConnections
+    contactSubsToView :: Map ConnId AgentErrorType -> [ConnId] -> Map ConnId ContactName -> Bool -> CM ()
-      let connIds = map aConnId' pcs
+    contactSubsToView errs cts names ce = ifM (asks $ coreApi . config) notifyAPI notifyCLI
-      pure (connIds, M.fromList $ zip connIds pcs)
-    contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> CM ()
-    contactSubsToView rs cts ce = do
-      chatModifyVar connNetworkStatuses $ M.union (M.fromList statuses)
-      ifM (asks $ coreApi . config) (notifyAPI statuses) notifyCLI
       where
+        conns = S.fromList cts
+        errConns = M.restrictKeys errs conns
         notifyCLI = do
-          let cRs = resultsFor rs cts
+          toView CRContactSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
-              cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs
+          when ce $ forM_ (M.assocs errConns) $ \(acId, err) ->
-          toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs
+            forM_ (M.lookup acId names) $ \contactName ->
-          when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors
+              toView CRContactSubError {user, contactName, chatError = ChatErrorAgent err Nothing}
-        notifyAPI = toView . CRNetworkStatuses (Just user) . map (uncurry ConnNetworkStatus)
+        notifyAPI = unless (M.null errConns) $ toView $ CRNetworkStatuses (Just user) $ map status (M.assocs errConns)
-        statuses = M.foldrWithKey' addStatus [] cts
           where
-            addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)]
+            status (connId, err) = ConnNetworkStatus (AgentConnId connId) $ NSError (errorNetworkStatus err)
-            addStatus _ Contact {activeConn = Nothing} nss = nss
+            errorNetworkStatus :: AgentErrorType -> String
-            addStatus connId Contact {activeConn = Just Connection {agentConnId}} nss =
-              let ns = (agentConnId, netStatus $ resultErr connId rs)
-               in ns : nss
-            netStatus :: Maybe ChatError -> NetworkStatus
-            netStatus = maybe NSConnected $ NSError . errorNetworkStatus
-            errorNetworkStatus :: ChatError -> String
             errorNetworkStatus = \case
-              ChatErrorAgent (BROKER _ NETWORK) _ -> "network"
+              BROKER _ NETWORK -> "network"
-              ChatErrorAgent (SMP _ SMP.AUTH) _ -> "contact deleted"
+              SMP _ SMP.AUTH -> "contact deleted"
               e -> show e
-    -- TODO possibly below could be replaced with less noisy events for API
+    contactLinkSubsToView :: Map ConnId AgentErrorType -> [(ConnId, Bool)] -> CM ()
-    contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM ()
+    contactLinkSubsToView errs ucs = do
-    contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
+      let (addresses, groupLinks) = partition snd ucs
-    groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> CM ()
+      forM_ addresses $ \(acId, _uc) -> toView $ CRUserAddrSubStatus {user, userContactError = (`ChatErrorAgent` Nothing) <$> M.lookup acId errs}
-    groupSubsToView rs gs ms ce = do
+      let groups = S.fromList $ map fst groupLinks
-      mapM_ groupSub $
+          errGroups = M.restrictKeys errs groups
-        sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs
+      unless (S.null groups) $ toView CRUserGroupLinksSubSummary
-      toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs
+        { user,
+          okSubs = S.size groups - M.size errGroups,
+          errSubs = M.size errGroups
+        }
+    groupSubsToView :: Map ConnId AgentErrorType -> [(GroupInfo, [ConnId])] -> [ConnId] -> Map ConnId ContactName -> Bool -> CM ()
+    groupSubsToView errs gs allMembers names ce = do
+      mapM_ (uncurry groupSub) gs
+      toView CRMemberSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
       where
-        mRs = resultsFor rs ms
+        conns = S.fromList allMembers
-        groupSub :: Group -> CM ()
+        errConns = M.restrictKeys errs conns
-        groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do
+        groupSub :: GroupInfo -> [ConnId] -> CM ()
-          when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors
+        groupSub g@GroupInfo {membership} groupMembers = do
+          when ce $ mapM_ (toView . uncurry (CRMemberSubError user g) ) mErrors
           toView groupEvent
           where
-            mErrors :: [(GroupMember, ChatError)]
+            mErrors :: [(ContactName, ChatError)]
-            mErrors =
+            mErrors = sortOn fst $ mapMaybe mError groupMembers
-              sortOn (\(GroupMember {localDisplayName = n}, _) -> n)
+            mError :: ConnId -> Maybe (ContactName, ChatError)
-                . filterErrors
+            mError mConnId = do
-                $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs
+              mErr <- M.lookup mConnId errConns
+              name <- M.lookup mConnId names
+              Just (name, ChatErrorAgent mErr Nothing)
             groupEvent :: ChatResponse
             groupEvent
               | memberStatus membership == GSMemInvited = CRGroupInvitation user g
-              | all (\GroupMember {activeConn} -> isNothing activeConn) members =
+              | null groupMembers =
                   if memberActive membership
                     then CRGroupEmpty user g
                     else CRGroupRemoved user g
               | otherwise = CRGroupSubscribed user g
-    sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM ()
+    sndFileSubsToView :: Map ConnId AgentErrorType -> Map ConnId SndFileTransfer -> CM ()
-    sndFileSubsToView rs sfts = do
+    sndFileSubsToView errs sfts =
-      let sftRs = resultsFor rs sfts
+      forM_ (M.assocs sfts) $ \(acId, ft@SndFileTransfer {fileId, fileStatus}) -> do
-      forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do
+        forM_ (M.lookup acId errs) $ toView . CRSndFileSubError user ft . (`ChatErrorAgent` Nothing)
-        forM_ err_ $ toView . CRSndFileSubError user ft
         void . forkIO $ do
           threadDelay 1000000
           when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) . withChatLock "subscribe sendFileChunk" $
             sendFileChunk user ft
-    rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> CM ()
+    rcvFileSubsToView :: Map ConnId AgentErrorType -> Map ConnId RcvFileTransfer -> CM ()
-    rcvFileSubsToView rs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . filterErrors . resultsFor rs
+    rcvFileSubsToView errs = mapM_ (toView . uncurry (CRRcvFileSubError user)) . M.mapMaybeWithKey (\acId rft -> (\e -> (rft, ChatErrorAgent e Nothing)) <$> M.lookup acId errs)
-    pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> CM ()
+    pendingConnSubsToView :: Map ConnId AgentErrorType -> [ConnId] -> CM () -- XXX: ignored by View
-    pendingConnSubsToView rs = toView . CRPendingSubSummary user . map (uncurry PendingSubStatus) . resultsFor rs
+    pendingConnSubsToView errs pcs = toView CRPendingSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
+      where
+        conns = S.fromList pcs
+        errConns = M.restrictKeys errs conns
     withStore_ :: (DB.Connection -> User -> IO [a]) -> CM [a]
     withStore_ a = withStore' (`a` user) `catchChatError` \e -> toView (CRChatError (Just user) e) $> []
-    filterErrors :: [(a, Maybe ChatError)] -> [(a, ChatError)]
-    filterErrors = mapMaybe (\(a, e_) -> (a,) <$> e_)
-    resultsFor :: Map ConnId (Either AgentErrorType ()) -> Map ConnId a -> [(a, Maybe ChatError)]
-    resultsFor rs = M.foldrWithKey' addResult []
-      where
-        addResult :: ConnId -> a -> [(a, Maybe ChatError)] -> [(a, Maybe ChatError)]
-        addResult connId = (:) . (,resultErr connId rs)
-    resultErr :: ConnId -> Map ConnId (Either AgentErrorType ()) -> Maybe ChatError
-    resultErr connId rs = case M.lookup connId rs of
-      Just (Left e) -> Just $ ChatErrorAgent e Nothing
-      Just _ -> Nothing
-      _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId
-
 cleanupManager :: CM ()
 cleanupManager = do
   interval <- asks (cleanupManagerInterval . config)
@@ -3746,7 +3719,7 @@ processAgentMessageNoConn = \case
       where
         connIds = map AgentConnId conns
         notifyAPI = toView . CRNetworkStatus nsStatus
-        notifyCLI = do
+        notifyCLI = whenM (asks $ subscriptionEvents . config) $ do
           cs <- withStore' (`getConnectionsContacts` conns)
           toView $ event srv cs
 

src/Simplex/Chat/Controller.hs

@@ -680,9 +680,10 @@ data ChatResponse
   | CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
   | CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
   | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
-  | CRContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
+  | CRContactSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
-  | CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
+  | CRContactSubError {user :: User, contactName :: ContactName, chatError :: ChatError}
-  | CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
+  | CRUserAddrSubStatus {user :: User, userContactError :: Maybe ChatError}
+  | CRUserGroupLinksSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
   | CRNetworkStatus {networkStatus :: NetworkStatus, connections :: [AgentConnId]}
   | CRNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]}
   | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
@@ -719,10 +720,10 @@ data ChatResponse
   | CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
   | CRNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember}
   | CRContactAndMemberAssociated {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember, updatedContact :: Contact}
-  | CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
+  | CRMemberSubError {user :: User, groupInfo :: GroupInfo, contactName :: ContactName, chatError :: ChatError}
-  | CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
+  | CRMemberSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
   | CRGroupSubscribed {user :: User, groupInfo :: GroupInfo}
-  | CRPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]}
+  | CRPendingSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
   | CRSndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
   | CRRcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
   | CRCallInvitation {callInvitation :: RcvCallInvitation}
@@ -731,8 +732,6 @@ data ChatResponse
   | CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
   | CRCallEnded {user :: User, contact :: Contact}
   | CRCallInvitations {callInvitations :: [RcvCallInvitation]}
-  | CRUserContactLinkSubscribed -- TODO delete
-  | CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
   | CRNtfTokenStatus {status :: NtfTknStatus}
   | CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode, ntfServer :: NtfServer}
   | CRNtfMessages {user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}

src/Simplex/Chat/Migrations/M20240530_user_contact_links_user_id.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20240530_user_contact_links_user_id where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20240530_user_contact_links_user_id :: Query
+m20240530_user_contact_links_user_id =
+  [sql|
+CREATE INDEX idx_user_contact_links_user_id ON user_contact_links(user_id);
+|]
+
+down_m20240530_user_contact_links_user_id :: Query
+down_m20240530_user_contact_links_user_id =
+  [sql|
+DROP INDEX idx_user_contact_links_user_id;
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -882,3 +882,4 @@ CREATE INDEX idx_chat_items_fwd_from_group_id ON chat_items(fwd_from_group_id);
 CREATE INDEX idx_chat_items_fwd_from_chat_item_id ON chat_items(
   fwd_from_chat_item_id
 );
+CREATE INDEX idx_user_contact_links_user_id ON user_contact_links(user_id);

src/Simplex/Chat/Store/Connections.hs

@@ -19,7 +19,7 @@ module Simplex.Chat.Store.Connections
 where
 
 import Control.Applicative ((<|>))
-import Control.Monad
+import Control.Monad (forM)
 import Control.Monad.Except
 import Data.Int (Int64)
 import Data.Maybe (catMaybes, fromMaybe)
@@ -28,7 +28,6 @@ import Database.SQLite.Simple.QQ (sql)
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store.Files
 import Simplex.Chat.Store.Groups
-import Simplex.Chat.Store.Profiles
 import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (ConnId)
@@ -213,19 +212,17 @@ getContactConnEntityByConnReqHash db vr user@User {userId} (cReqHash1, cReqHash2
         (userId, cReqHash1, cReqHash2, ConnDeleted)
   maybe (pure Nothing) (fmap eitherToMaybe . runExceptT . getConnectionEntity db vr user) connId_
 
-getConnectionsToSubscribe :: DB.Connection -> VersionRangeChat -> IO ([ConnId], [ConnectionEntity])
+getConnectionsToSubscribe :: DB.Connection -> VersionRangeChat -> User -> IO ([ConnId], [ConnectionEntity])
-getConnectionsToSubscribe db vr = do
+getConnectionsToSubscribe db vr user@User {userId} = do
-  aConnIds <- map fromOnly <$> DB.query_ db "SELECT agent_conn_id FROM connections where to_subscribe = 1"
+  aConnIds <- map fromOnly <$> DB.query db "SELECT agent_conn_id FROM connections WHERE to_subscribe = 1 AND user_id = ?" (Only userId)
-  entities <- forM aConnIds $ \acId -> do
+  entities <- forM aConnIds $ \acId ->
-    getUserByAConnId db acId >>= \case
+    eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)
-      Just user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)
+  unsetConnectionToSubscribe db user
-      Nothing -> pure Nothing
-  unsetConnectionToSubscribe db
   let connIds = map (\(AgentConnId connId) -> connId) aConnIds
   pure (connIds, catMaybes entities)
 
-unsetConnectionToSubscribe :: DB.Connection -> IO ()
+unsetConnectionToSubscribe :: DB.Connection -> User -> IO ()
-unsetConnectionToSubscribe db = DB.execute_ db "UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1"
+unsetConnectionToSubscribe db User {userId} = DB.execute db "UPDATE connections SET to_subscribe = 0 WHERE user_id = ? AND to_subscribe = 1" (Only userId)
 
 deleteConnectionRecord :: DB.Connection -> User -> Int64 -> IO ()
 deleteConnectionRecord db User {userId} cId = do

src/Simplex/Chat/Store/Direct.hs

@@ -56,6 +56,7 @@ module Simplex.Chat.Store.Direct
     incQuotaErrCounter,
     setQuotaErrCounter,
     getUserContacts,
+    getUserContactConnIds,
     createOrUpdateContactRequest,
     getContactRequest',
     getContactRequest,
@@ -839,19 +840,9 @@ getUserByContactRequestId db contactRequestId =
   ExceptT . firstRow toUser (SEUserNotFoundByContactRequestId contactRequestId) $
     DB.query db (userQuery <> " JOIN contact_requests cr ON cr.user_id = u.user_id WHERE cr.contact_request_id = ?") (Only contactRequestId)
 
-getPendingContactConnections :: DB.Connection -> User -> IO [PendingContactConnection]
+getPendingContactConnections :: DB.Connection -> User -> IO [ConnId]
-getPendingContactConnections db User {userId} = do
+getPendingContactConnections db User {userId} =
-  map toPendingContactConnection
+  map fromOnly <$> DB.query db "SELECT agent_conn_id FROM connections WHERE user_id = ? AND conn_type = ? AND contact_id IS NULL" (userId, ConnContact)
-    <$> DB.queryNamed
-      db
-      [sql|
-        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, group_link_id, custom_user_profile_id, conn_req_inv, local_alias, created_at, updated_at
-        FROM connections
-        WHERE user_id = :user_id
-          AND conn_type = :conn_type
-          AND contact_id IS NULL
-      |]
-      [":user_id" := userId, ":conn_type" := ConnContact]
 
 getContactConnections :: DB.Connection -> VersionRangeChat -> UserId -> Contact -> IO [Connection]
 getContactConnections db vr userId Contact {contactId} =
@@ -873,6 +864,33 @@ getContactConnections db vr userId Contact {contactId} =
     connections [] = pure []
     connections rows = pure $ map (toConnection vr) rows
 
+getUserContactConnIds :: DB.Connection -> User -> IO [ConnId]
+getUserContactConnIds db User {userId} =
+  map fromOnly
+    <$> DB.query
+        db
+        [sql|
+          SELECT c.agent_conn_id
+          FROM contacts ct
+          LEFT JOIN connections c ON c.contact_id = ct.contact_id
+          WHERE ct.user_id = ?
+            AND ct.contact_status = ?
+            AND ct.deleted = 0
+            AND
+              c.connection_id = (
+                SELECT cc_connection_id FROM (
+                  SELECT
+                    cc.connection_id AS cc_connection_id,
+                    cc.created_at AS cc_created_at
+                  FROM connections cc
+                  WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id
+                  ORDER BY cc_created_at DESC
+                  LIMIT 1
+                )
+              )
+        |]
+        (userId, CSActive)
+
 getConnectionById :: DB.Connection -> VersionRangeChat -> User -> Int64 -> ExceptT StoreError IO Connection
 getConnectionById db vr User {userId} connId = ExceptT $ do
   firstRow (toConnection vr) (SEConnectionNotFoundById connId) $

src/Simplex/Chat/Store/Groups.hs

@@ -52,6 +52,7 @@ module Simplex.Chat.Store.Groups
     deleteGroupItemsAndMembers,
     deleteGroup,
     getUserGroups,
+    getUserGroupMemberConnIds,
     getUserGroupDetails,
     getUserGroupsWithSummary,
     getGroupSummary,
@@ -628,6 +629,14 @@ getUserGroups db vr user@User {userId} = do
   groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId)
   rights <$> mapM (runExceptT . getGroup db vr user) groupIds
 
+getUserGroupMemberConnIds :: DB.Connection -> VersionRangeChat -> User -> IO [(GroupInfo, [ConnId])]
+getUserGroupMemberConnIds db vr user@User {userId} = do
+  groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ? ORDER BY local_display_name" (Only userId)
+  fmap rights . forM groupIds $ \groupId -> runExceptT $ do
+    gInfo <- getGroupInfo db vr user groupId
+    members <- liftIO $ getGroupMemberConnIds db user gInfo
+    pure (gInfo, members)
+
 getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo]
 getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ =
   map (toGroupInfo vr userContactId)
@@ -748,6 +757,26 @@ getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
       (groupMemberQuery <> " WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
       (userId, groupId, userId, userContactId)
 
+getGroupMemberConnIds :: DB.Connection -> User -> GroupInfo -> IO [ConnId]
+getGroupMemberConnIds db User {userId, userContactId} GroupInfo {groupId} = do
+  map fromOnly
+    <$> DB.query
+      db
+      [sql|
+        SELECT c.agent_conn_id
+        FROM group_members m
+        JOIN connections c ON c.connection_id = (
+          SELECT max(cc.connection_id)
+          FROM connections cc
+          WHERE cc.user_id = ? AND cc.group_member_id = m.group_member_id
+        )
+        WHERE m.group_id = ?
+          AND m.user_id = ?
+          AND (m.contact_id IS NULL OR m.contact_id != ?)
+          AND m.member_status NOT IN (?, ?, ?, ?)
+      |]
+      (userId, groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted, GSMemUnknown)
+
 getGroupMembersForExpiration :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
 getGroupMembersForExpiration db vr user@User {userId, userContactId} GroupInfo {groupId} = do
   map (toContactMember vr user)

src/Simplex/Chat/Store/Migrations.hs

@@ -110,6 +110,7 @@ import Simplex.Chat.Migrations.M20240501_chat_deleted
 import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
 import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
 import Simplex.Chat.Migrations.M20240528_quota_err_counter
+import Simplex.Chat.Migrations.M20240530_user_contact_links_user_id
 import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
 
 schemaMigrations :: [(String, Query, Maybe Query)]
@@ -219,7 +220,8 @@ schemaMigrations =
     ("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted),
     ("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy),
     ("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays),
-    ("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter)
+    ("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter),
+    ("20240530_user_contact_links_user_id", m20240530_user_contact_links_user_id, Just down_m20240530_user_contact_links_user_id)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Chat/Store/Profiles.hs

@@ -350,25 +350,17 @@ getUserAddressConnections db vr User {userId} = do
           |]
           (userId, userId)
 
-getUserContactLinks :: DB.Connection -> VersionRangeChat -> User -> IO [(Connection, UserContact)]
+getUserContactLinks :: DB.Connection -> User -> IO [(ConnId, Bool)]
-getUserContactLinks db vr User {userId} =
+getUserContactLinks db User {userId} =
-  map toUserContactConnection
+  DB.query
-    <$> DB.query
+    db
-      db
+    [sql|
-      [sql|
+      SELECT c.agent_conn_id, uc.group_id IS NULL
-        SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
+      FROM connections c
-          c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
+      JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
-          c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
+      WHERE c.user_id = ? AND uc.user_id = ?
-          c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
+    |]
-          uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
+    (userId, userId)
-        FROM connections c
-        JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
-        WHERE c.user_id = ? AND uc.user_id = ?
-      |]
-      (userId, userId)
-  where
-    toUserContactConnection :: (ConnectionRow :. (Int64, ConnReqContact, Maybe GroupId)) -> (Connection, UserContact)
-    toUserContactConnection (connRow :. (userContactLinkId, connReqContact, groupId)) = (toConnection vr connRow, UserContact {userContactLinkId, connReqContact, groupId})
 
 deleteUserAddress :: DB.Connection -> User -> IO ()
 deleteUserAddress db user@User {userId} = do

src/Simplex/Chat/View.hs

@@ -18,7 +18,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Char (isSpace, toUpper)
 import Data.Function (on)
 import Data.Int (Int64)
-import Data.List (groupBy, intercalate, intersperse, partition, sortOn)
+import Data.List (groupBy, intercalate, intersperse, sortOn)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
@@ -238,19 +238,13 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
      in ttyUser u [sShow connId <> ": END"]
   CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
   CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
-  CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e]
+  CRContactSubError u c e -> ttyUser u [ttyContact c <> ": contact error " <> sShow e]
-  CRContactSubSummary u summary ->
+  CRContactSubSummary {user, okSubs, errSubs} -> ttyUser user $ [sShow okSubs <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | okSubs > 0] <> viewErrorsSummary errSubs " contact errors"
-    ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
+  CRUserAddrSubStatus {user, userContactError} -> ttyUser user [maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError]
-    where
+  CRUserGroupLinksSubSummary {user, okSubs, errSubs} ->
-      (errors, subscribed) = partition (isJust . contactError) summary
+    ttyUser user $
-  CRUserContactSubSummary u summary ->
+      [sShow okSubs <> " group links active" | okSubs > 0]
-    ttyUser u $
+        <> viewErrorsSummary errSubs " group link errors"
-      map addressSS addresses
-        <> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
-    where
-      (addresses, groupLinks) = partition (\UserContactSubStatus {userContact} -> isNothing . userContactGroupId $ userContact) summary
-      addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError
-      (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
   CRNetworkStatus status conns -> if testView then [plain $ show (length conns) <> " connections " <> netStatusStr status] else []
   CRNetworkStatuses u statuses -> if testView then ttyUser' u $ viewNetworkStatuses statuses else []
   CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
@@ -284,10 +278,10 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m]
   CRNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"]
   CRContactAndMemberAssociated u ct g m ct' -> ttyUser u $ viewContactAndMemberAssociated ct g m ct'
-  CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
+  CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyContact m <> " error: " <> sShow e]
-  CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
+  CRMemberSubSummary {user, errSubs} -> ttyUser user $ viewErrorsSummary errSubs " group member errors"
   CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
-  CRPendingSubSummary u _ -> ttyUser u []
+  CRPendingSubSummary {user} -> ttyUser user [] -- XXX: ???
   CRSndFileSubError u SndFileTransfer {fileId, fileName} e ->
     ttyUser u ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
   CRRcvFileSubError u RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
@@ -298,8 +292,6 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   CRCallExtraInfo {user = u, contact} -> ttyUser u ["call extra info from " <> ttyContact' contact]
   CRCallEnded {user = u, contact} -> ttyUser u ["call with " <> ttyContact' contact <> " ended"]
   CRCallInvitations _ -> []
-  CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
-  CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
   CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> ttyUser u ["connection :" <> sShow pccConnId <> " deleted"]
   CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
   CRNtfToken _ status mode srv -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode) <> ", server: " <> sShow srv]
@@ -458,8 +450,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
     testViewItem (CChatItem _ ci@ChatItem {meta = CIMeta {itemText}}) membership_ =
       let deleted_ = maybe "" (\t -> " [" <> t <> "]") (chatItemDeletedText ci membership_)
        in itemText <> deleted_
-    viewErrorsSummary :: [a] -> StyledString -> [StyledString]
+    viewErrorsSummary :: Int -> StyledString -> [StyledString]
-    viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)]
+    viewErrorsSummary numErrors s = [ttyError (tshow numErrors) <> s <> " (run with -c option to show each error)" | numErrors > 0]
     contactList :: [ContactRef] -> String
     contactList cs = T.unpack . T.intercalate ", " $ map (\ContactRef {localDisplayName = n} -> "@" <> n) cs
     unmuted :: User -> ChatInfo c -> ChatItem c d -> [StyledString] -> [StyledString]

tests/ChatTests/Direct.hs

@@ -1448,6 +1448,7 @@ testUsersSubscribeAfterRestart :: HasCallStack => FilePath -> IO ()
 testUsersSubscribeAfterRestart tmp = do
   withNewTestChat tmp "bob" bobProfile $ \bob -> do
     withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+      threadDelay 100000
       connectUsers alice bob
       alice <##> bob
 
@@ -1458,8 +1459,7 @@ testUsersSubscribeAfterRestart tmp = do
 
     withTestChat tmp "alice" $ \alice -> do
       -- second user is active
-      alice <## "1 contacts connected (use /cs for the list)"
+      alice <### ["1 contacts connected (use /cs for the list)", "[user: alice] 1 contacts connected (use /cs for the list)"]
-      alice <## "[user: alice] 1 contacts connected (use /cs for the list)"
 
       -- second user receives message
       alice <##> bob
@@ -1793,8 +1793,7 @@ testUsersRestartCIExpiration tmp = do
       showActiveUser alice "alice (Alice)"
 
     withTestChatCfg tmp cfg "alice" $ \alice -> do
-      alice <## "1 contacts connected (use /cs for the list)"
+      alice <### ["1 contacts connected (use /cs for the list)", "[user: alisa] 1 contacts connected (use /cs for the list)"]
-      alice <## "[user: alisa] 1 contacts connected (use /cs for the list)"
 
       -- first user messages
       alice ##> "/user alice"
@@ -1892,8 +1891,7 @@ testEnableCIExpirationOnlyForOneUser tmp = do
       alice #$> ("/_get chat @4 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
 
     withTestChatCfg tmp cfg "alice" $ \alice -> do
-      alice <## "1 contacts connected (use /cs for the list)"
+      alice <### ["1 contacts connected (use /cs for the list)", "[user: alice] 1 contacts connected (use /cs for the list)"]
-      alice <## "[user: alice] 1 contacts connected (use /cs for the list)"
 
       -- messages are not deleted for second user after restart
       alice #$> ("/_get chat @4 count=100", chat, chatFeatures <> [(1, "alisa 1"), (0, "alisa 2"), (1, "alisa 3"), (0, "alisa 4")])
@@ -1948,8 +1946,7 @@ testDisableCIExpirationOnlyForOneUser tmp = do
       alice #$> ("/_get chat @4 count=100", chat, [])
 
     withTestChatCfg tmp cfg "alice" $ \alice -> do
-      alice <## "1 contacts connected (use /cs for the list)"
+      alice <### ["1 contacts connected (use /cs for the list)", "[user: alice] 1 contacts connected (use /cs for the list)"]
-      alice <## "[user: alice] 1 contacts connected (use /cs for the list)"
 
       -- second user still has ttl configured after restart
       alice #$> ("/ttl", id, "old messages are set to be deleted after: 1 second(s)")
@@ -2055,8 +2052,10 @@ testUsersTimedMessages tmp = do
       alice <# "bob> alisa 4"
 
     withTestChat tmp "alice" $ \alice -> do
-      alice <## "1 contacts connected (use /cs for the list)"
+      alice
-      alice <## "[user: alice] 1 contacts connected (use /cs for the list)"
+        <### [ "1 contacts connected (use /cs for the list)",
+               "[user: alice] 1 contacts connected (use /cs for the list)"
+             ]
 
       alice ##> "/user alice"
       showActiveUser alice "alice (Alice)"

tests/ChatTests/Groups.hs

@@ -2590,6 +2590,7 @@ testPlanGroupLinkConnecting :: HasCallStack => FilePath -> IO ()
 testPlanGroupLinkConnecting tmp = do
   -- gLink <- withNewTestChatCfg tmp cfg "alice" aliceProfile $ \alice -> do
   gLink <- withNewTestChatCfg tmp cfg "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do
+    threadDelay 100000
     alice ##> "/g team"
     alice <## "group #team is created"
     alice <## "to add members use /a team <name> or /create link #team"
@@ -3200,6 +3201,7 @@ testPlanGroupLinkNoContactKnown =
 testPlanGroupLinkNoContactConnecting :: HasCallStack => FilePath -> IO ()
 testPlanGroupLinkNoContactConnecting tmp = do
   gLink <- withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+    threadDelay 100000
     alice ##> "/g team"
     alice <## "group #team is created"
     alice <## "to add members use /a team <name> or /create link #team"

tests/MobileTests.hs

@@ -136,10 +136,10 @@ networkStatuses =
 #endif
 
 networkStatusesSwift :: LB.ByteString
-networkStatusesSwift = "{\"resp\":{\"_owsf\":true,\"networkStatuses\":{\"user_\":" <> userJSON <> ",\"networkStatuses\":[]}}}"
+networkStatusesSwift = "{\"resp\":{\"_owsf\":true,\"networkStatuses\":{\"networkStatuses\":[]}}}"
 
 networkStatusesTagged :: LB.ByteString
-networkStatusesTagged = "{\"resp\":{\"type\":\"networkStatuses\",\"user_\":" <> userJSON <> ",\"networkStatuses\":[]}}"
+networkStatusesTagged = "{\"resp\":{\"type\":\"networkStatuses\",\"networkStatuses\":[]}}"
 
 memberSubSummary :: LB.ByteString
 memberSubSummary =
@@ -222,8 +222,7 @@ testChatApi tmp = do
   chatSendCmd cc "/u" `shouldReturn` activeUser
   chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUserExists
   chatSendCmd cc "/_start" `shouldReturn` chatStarted
-  chatRecvMsg cc `shouldReturn` networkStatuses
+  chatSendCmd cc "/_network_statuses" `shouldReturn` networkStatuses
-  chatRecvMsg cc `shouldReturn` userContactSubSummary
   chatRecvMsgWait cc 10000 `shouldReturn` ""
   chatParseMarkdown "hello" `shouldBe` "{}"
   chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown