core: use batched subscriptions (#818)

* core: use batched subscriptions

* update simplexmq

* remove comments

* clean up

* refactor

* remove todo

* revert change

* revert change

* remove comment

* add delay to the async group test

* add more delay in test

cabal.project

@@ -5,7 +5,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: e75846aa38dd26fa70e3faa38ec780edf245e022
+    tag: a6f401041ac82c1ba94a8fea21339acb33904ad0
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."e75846aa38dd26fa70e3faa38ec780edf245e022" = "1mjr5bpjnz6pw9w4qy2r548xlgw89rxbmj36zb4vwq4jghj3gmcz";
+  "https://github.com/simplex-chat/simplexmq.git"."a6f401041ac82c1ba94a8fea21339acb33904ad0" = "1q4wah7mwrbp98gv5z7vvdyyf6sgw4af26b220yimvkjam6l5mx5";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
   "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
   "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";

src/Simplex/Chat.hs

@@ -31,12 +31,13 @@ import Data.Either (fromRight)
 import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (find, isSuffixOf)
+import Data.List (find, isSuffixOf, sortBy)
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
-import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
+import Data.Ord (comparing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDiffTimeToSeconds)
@@ -54,7 +55,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store
 import Simplex.Chat.Types
 import Simplex.Chat.Util (safeDecodeUtf8, uncurry3)
-import Simplex.Messaging.Agent
+import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), defaultAgentConfig)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
@@ -64,7 +65,7 @@ import Simplex.Messaging.Parsers (base64P, parseAll)
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer)
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (ifM, liftEitherError, tryError, unlessM, whenM, (<$?>))
+import Simplex.Messaging.Util
 import System.Exit (exitFailure, exitSuccess)
 import System.FilePath (combine, splitExtensions, takeFileName)
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
@@ -157,7 +158,7 @@ startChatController user subConns = do
       a1 <- async $ race_ notificationSubscriber agentSubscriber
       a2 <-
         if subConns
-          then Just <$> async (subscribeUserConnections subscribeConnection user)
+          then Just <$> async (void . runExceptT $ subscribeUserConnections Agent.subscribeConnections user)
           else pure Nothing
       atomically . writeTVar s $ Just (a1, a2)
       pure a1
@@ -218,7 +219,7 @@ processChatCommand = \case
     withUser $ \user -> restoreCalls user
     withAgent activateAgent $> CRCmdOk
   APISuspendChat t -> withAgent (`suspendAgent` t) $> CRCmdOk
-  ResubscribeAllConnections -> withUser (subscribeUserConnections resubscribeConnection) $> CRCmdOk
+  ResubscribeAllConnections -> withUser (subscribeUserConnections Agent.resubscribeConnections) $> CRCmdOk
   SetFilesFolder filesFolder' -> do
     createDirectoryIfMissing True filesFolder'
     ff <- asks filesFolder
@@ -582,7 +583,7 @@ processChatCommand = \case
     (NotificationInfo {ntfConnId, ntfMsgMeta}, msgs) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
     let ntfMessages = map (\SMP.SMPMsgMeta {msgTs, msgFlags} -> NtfMsgInfo {msgTs = systemToUTCTime msgTs, msgFlags}) msgs
         msgTs' = systemToUTCTime . (SMP.msgTs :: SMP.NMsgMeta -> SystemTime) <$> ntfMsgMeta
-    connEntity <- withStore (\db -> Just <$> getConnectionEntity db user ntfConnId) `catchError` \_ -> pure Nothing
+    connEntity <- withStore (\db -> Just <$> getConnectionEntity db user (AgentConnId ntfConnId)) `catchError` \_ -> pure Nothing
     pure CRNtfMessages {connEntity, msgTs = msgTs', ntfMessages}
   GetUserSMPServers -> CRUserSMPServers <$> withUser (\user -> withStore' (`getSMPServers` user))
   SetUserSMPServers smpServers -> withUser $ \user -> withChatLock $ do
@@ -618,12 +619,12 @@ processChatCommand = \case
     (connId, cReq) <- withAgent (`createConnection` SCMContact)
     withStore $ \db -> createUserContactLink db userId connId cReq
     pure $ CRUserContactLinkCreated cReq
-  DeleteMyAddress -> withUser $ \User {userId} -> withChatLock $ do
-    conns <- withStore (`getUserContactLinkConnections` userId)
+  DeleteMyAddress -> withUser $ \user -> withChatLock $ do
+    conns <- withStore (`getUserContactLinkConnections` user)
     procCmd $ do
       withAgent $ \a -> forM_ conns $ \conn ->
         deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure ()
-      withStore' (`deleteUserContactLink` userId)
+      withStore' (`deleteUserContactLink` user)
       pure CRUserContactLinkDeleted
   ShowMyAddress -> withUser $ \User {userId} ->
     uncurry3 CRUserContactLink <$> withStore (`getUserContactLink` userId)
@@ -1076,85 +1077,120 @@ agentSubscriber = do
     withLock l . void . runExceptT $
       processAgentMessage u connId msg `catchError` (toView . CRChatError)
 
-subscribeUserConnections ::
-  (MonadUnliftIO m, MonadReader ChatController m) =>
-  (forall m'. ChatMonad m' => AgentClient -> ConnId -> ExceptT AgentErrorType m' ()) ->
-  User ->
-  m ()
-subscribeUserConnections agentSubscribe user@User {userId} = do
-  n <- asks $ subscriptionConcurrency . config
+type AgentBatchSubscribe m = AgentClient -> [ConnId] -> ExceptT AgentErrorType m (Map ConnId (Either AgentErrorType ()))
+
+subscribeUserConnections :: forall m. ChatMonad m => AgentBatchSubscribe m -> User -> m ()
+subscribeUserConnections agentBatchSubscribe user = do
+  -- get user connections
   ce <- asks $ subscriptionEvents . config
-  void . runExceptT $ do
-    catchErr $ subscribeContacts n ce
-    catchErr $ subscribeUserContactLink n
-    catchErr $ subscribeGroups n ce
-    catchErr $ subscribeFiles n
-    catchErr $ subscribePendingConnections n
+  (ctConns, cts) <- getContactConns
+  (ucConns, ucs) <- getUserContactLinkConns
+  (gs, mConns, ms) <- getGroupMemberConns
+  (sftConns, sfts) <- getSndFileTransferConns
+  (rftConns, rfts) <- getRcvFileTransferConns
+  (pcConns, pcs) <- getPendingContactConns
+  -- subscribe using batched commands
+  rs <- withAgent (`agentBatchSubscribe` concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns])
+  -- send connection events to view
+  contactSubsToView rs cts
+  contactLinkSubsToView rs ucs
+  groupSubsToView rs gs ms ce
+  sndFileSubsToView rs sfts
+  rcvFileSubsToView rs rfts
+  pendingConnSubsToView rs pcs
   where
-    catchErr a = a `catchError` \_ -> pure ()
-    subscribeContacts n ce = do
-      contacts <- withStore' (`getUserContacts` user)
-      toView . CRContactSubSummary =<< pooledForConcurrentlyN n contacts (\ct -> ContactSubStatus ct <$> subscribeContact ce ct)
-    subscribeContact ce ct =
-      (subscribe (contactConnId ct) $> Nothing)
-        `catchError` (\e -> when ce (toView $ CRContactSubError ct e) $> Just e)
-    subscribeGroups n ce = do
-      groups <- withStore' (`getUserGroups` user)
-      toView . CRMemberSubErrors . mconcat =<< forM groups (subscribeGroup n ce)
-    subscribeGroup n ce (Group g@GroupInfo {membership} members) = do
-      let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members
-      if memberStatus membership == GSMemInvited
-        then do
-          toView $ CRGroupInvitation g
-          pure []
-        else
-          if null connectedMembers
-            then do
-              if memberActive membership
-                then toView $ CRGroupEmpty g
-                else toView $ CRGroupRemoved g
-              pure []
-            else do
-              ms <- pooledForConcurrentlyN n connectedMembers $ \(m@GroupMember {localDisplayName = c}, cId) ->
-                (m,) <$> ((subscribe cId $> Nothing) `catchError` (\e -> when ce (toView $ CRMemberSubError g c e) $> Just e))
-              toView $ CRGroupSubscribed g
-              pure $ mapMaybe (\(m, e) -> (Just . MemberSubError m) =<< e) ms
-    subscribeFiles n = do
-      sndFileTransfers <- withStore' (`getLiveSndFileTransfers` user)
-      pooledForConcurrentlyN_ n sndFileTransfers $ \sft -> subscribeSndFile sft
-      rcvFileTransfers <- withStore' (`getLiveRcvFileTransfers` user)
-      pooledForConcurrentlyN_ n rcvFileTransfers $ \rft -> subscribeRcvFile rft
+    getContactConns :: m ([ConnId], Map ConnId Contact)
+    getContactConns = do
+      cts <- withStore_ getUserContacts
+      let connIds = map contactConnId cts
+      pure (connIds, M.fromList $ zip connIds cts)
+    getUserContactLinkConns :: m ([ConnId], Map ConnId UserContact)
+    getUserContactLinkConns = do
+      (cs, ucs) <- unzip <$> withStore_ getUserContactLinks
+      let connIds = map aConnId cs
+      pure (connIds, M.fromList $ zip connIds ucs)
+    getGroupMemberConns :: m ([Group], [ConnId], Map ConnId GroupMember)
+    getGroupMemberConns = do
+      gs <- withStore_ getUserGroups
+      let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) ms) gs
+      pure (gs, map fst mPairs, M.fromList mPairs)
+    getSndFileTransferConns :: m ([ConnId], Map ConnId SndFileTransfer)
+    getSndFileTransferConns = do
+      sfts <- withStore_ getLiveSndFileTransfers
+      let connIds = map sndFileTransferConnId sfts
+      pure (connIds, M.fromList $ zip connIds sfts)
+    getRcvFileTransferConns :: m ([ConnId], Map ConnId RcvFileTransfer)
+    getRcvFileTransferConns = do
+      rfts <- withStore_ getLiveRcvFileTransfers
+      let rftPairs = mapMaybe (\ft -> (,ft) <$> liveRcvFileTransferConnId ft) rfts
+      pure (map fst rftPairs, M.fromList rftPairs)
+    getPendingContactConns :: m ([ConnId], Map ConnId PendingContactConnection)
+    getPendingContactConns = do
+      pcs <- withStore_ getPendingContactConnections
+      let connIds = map aConnId' pcs
+      pure (connIds, M.fromList $ zip connIds pcs)
+    contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> m ()
+    contactSubsToView rs = toView . CRContactSubSummary . map (uncurry ContactSubStatus) . resultsFor rs
+    contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m ()
+    contactLinkSubsToView rs ucs = case resultsFor rs ucs of
+      [] -> pure ()
+      ((_, Just e) : _) -> toView $ CRUserContactLinkSubError e
+      _ -> toView CRUserContactLinkSubscribed
+    groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
+    groupSubsToView rs gs ms ce = do
+      mapM_ groupSub $
+        sortBy (comparing $ \(Group GroupInfo {localDisplayName = g} _) -> g) gs
+      toView . CRMemberSubSummary $ map (uncurry MemberSubStatus) mRs
       where
-        subscribeSndFile ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId cId} = do
-          subscribe cId `catchError` (toView . CRSndFileSubError ft)
-          void . forkIO $ do
-            threadDelay 1000000
-            l <- asks chatLock
-            a <- asks smpAgent
-            when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) $
-              withAgentLock a . withLock l $
-                sendFileChunk user ft
-        subscribeRcvFile ft@RcvFileTransfer {fileStatus} =
-          case fileStatus of
-            RFSAccepted fInfo -> resume fInfo
-            RFSConnected fInfo -> resume fInfo
-            _ -> pure ()
+        mRs = resultsFor rs ms
+        groupSub :: Group -> m ()
+        groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do
+          when ce $ mapM_ (toView . uncurry (CRMemberSubError g)) mErrors
+          toView groupEvent
           where
-            resume RcvFileInfo {agentConnId = AgentConnId cId} =
-              subscribe cId `catchError` (toView . CRRcvFileSubError ft)
-    subscribePendingConnections n = do
-      cs <- withStore' (`getPendingConnections` user)
-      summary <- pooledForConcurrentlyN n cs $ \Connection {agentConnId = acId@(AgentConnId cId)} ->
-        PendingSubStatus acId <$> ((subscribe cId $> Nothing) `catchError` (pure . Just))
-      toView $ CRPendingSubSummary summary
-    subscribeUserContactLink n = do
-      cs <- withStore (`getUserContactLinkConnections` userId)
-      (subscribeConns n cs >> toView CRUserContactLinkSubscribed)
-        `catchError` (toView . CRUserContactLinkSubError)
-    subscribe cId = withAgent (`agentSubscribe` cId)
-    subscribeConns n conns =
-      withAgent $ \a ->
-        pooledForConcurrentlyN_ n conns $ \c -> agentSubscribe a (aConnId c)
+            mErrors :: [(GroupMember, ChatError)]
+            mErrors =
+              sortBy (comparing (\(GroupMember {localDisplayName = n}, _) -> n))
+                . filterErrors
+                $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs
+            groupEvent :: ChatResponse
+            groupEvent
+              | memberStatus membership == GSMemInvited = CRGroupInvitation g
+              | all (\GroupMember {activeConn} -> isNothing activeConn) members =
+                if memberActive membership
+                  then CRGroupEmpty g
+                  else CRGroupRemoved g
+              | otherwise = CRGroupSubscribed g
+    sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> m ()
+    sndFileSubsToView rs sfts = do
+      let sftRs = resultsFor rs sfts
+      forM_ sftRs $ \(ft@SndFileTransfer {fileId, fileStatus}, err_) -> do
+        forM_ err_ $ toView . CRSndFileSubError ft
+        void . forkIO $ do
+          threadDelay 1000000
+          l <- asks chatLock
+          a <- asks smpAgent
+          when (fileStatus == FSConnected) . unlessM (isFileActive fileId sndFiles) $
+            withAgentLock a . withLock l $
+              sendFileChunk user ft
+    rcvFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId RcvFileTransfer -> m ()
+    rcvFileSubsToView rs = mapM_ (toView . uncurry CRRcvFileSubError) . filterErrors . resultsFor rs
+    pendingConnSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId PendingContactConnection -> m ()
+    pendingConnSubsToView rs = toView . CRPendingSubSummary . map (uncurry PendingSubStatus) . resultsFor rs
+    withStore_ :: (DB.Connection -> User -> IO [a]) -> m [a]
+    withStore_ a = withStore' (`a` user) `catchError` \_ -> pure []
+    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 = (:) . (,err)
+          where
+            err = case M.lookup connId rs of
+              Just (Left e) -> Just $ ChatErrorAgent e
+              Just _ -> Nothing
+              _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId
 
 processAgentMessage :: forall m. ChatMonad m => Maybe User -> ConnId -> ACommand 'Agent -> m ()
 processAgentMessage Nothing _ _ = throwChatError CENoActiveUser
@@ -1169,7 +1205,7 @@ processAgentMessage (Just User {userId}) "" agentMessage = case agentMessage of
       toView $ event srv cs
       showToast ("server " <> str) (safeDecodeUtf8 . strEncode $ SrvLoc host port)
 processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage =
-  (withStore (\db -> getConnectionEntity db user agentConnId) >>= updateConnStatus) >>= \case
+  (withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus) >>= \case
     RcvDirectMsgConnection conn contact_ ->
       processDirectMessage agentMessage conn contact_
     RcvGroupMsgConnection conn gInfo m ->

src/Simplex/Chat/Controller.hs

@@ -270,10 +270,10 @@ data ChatResponse
   | CRGroupEmpty {groupInfo :: GroupInfo}
   | CRGroupRemoved {groupInfo :: GroupInfo}
   | CRGroupDeleted {groupInfo :: GroupInfo, member :: GroupMember}
-  | CRMemberSubError {groupInfo :: GroupInfo, contactName :: ContactName, chatError :: ChatError} -- TODO Contact?  or GroupMember?
-  | CRMemberSubErrors {memberSubErrors :: [MemberSubError]}
+  | CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
+  | CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]}
   | CRGroupSubscribed {groupInfo :: GroupInfo}
-  | CRPendingSubSummary {pendingSubStatus :: [PendingSubStatus]}
+  | CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]}
   | CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
   | CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
   | CRCallInvitation {callInvitation :: RcvCallInvitation}
@@ -311,17 +311,18 @@ instance ToJSON ContactSubStatus where
   toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
   toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
-data MemberSubError = MemberSubError
+data MemberSubStatus = MemberSubStatus
   { member :: GroupMember,
-    memberError :: ChatError
+    memberError :: Maybe ChatError
   }
   deriving (Show, Generic)
 
-instance ToJSON MemberSubError where
-  toEncoding = J.genericToEncoding J.defaultOptions
+instance ToJSON MemberSubStatus where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
 
 data PendingSubStatus = PendingSubStatus
-  { connId :: AgentConnId,
+  { connection :: PendingContactConnection,
     connError :: Maybe ChatError
   }
   deriving (Show, Generic)
@@ -396,6 +397,7 @@ data ChatErrorType
   | CECallContact {contactId :: Int64}
   | CECallState {currentCallState :: CallStateTag}
   | CEAgentVersion
+  | CEAgentNoSubResult {agentConnId :: AgentConnId}
   | CECommandError {message :: String}
   deriving (Show, Exception, Generic)
 

src/Simplex/Chat/Store.hs

@@ -40,6 +40,7 @@ module Simplex.Chat.Store
     getUserContacts,
     createUserContactLink,
     getUserContactLinkConnections,
+    getUserContactLinks,
     deleteUserContactLink,
     getUserContactLink,
     getUserContactLinkById,
@@ -52,7 +53,7 @@ module Simplex.Chat.Store
     getLiveSndFileTransfers,
     getLiveRcvFileTransfers,
     getPendingSndChunks,
-    getPendingConnections,
+    getPendingContactConnections,
     getContactConnections,
     getConnectionEntity,
     getConnectionsContacts,
@@ -330,7 +331,7 @@ createConnReqConnection db userId acId cReqHash xContactId = do
     |]
     (userId, acId, pccConnStatus, ConnContact, createdAt, createdAt, cReqHash, xContactId)
   pccConnId <- insertedRowId db
-  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, createdAt, updatedAt = createdAt}
+  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = True, viaUserContactLink = Nothing, createdAt, updatedAt = createdAt}
 
 getConnReqContactXContactId :: DB.Connection -> UserId -> ConnReqUriHash -> IO (Maybe Contact, Maybe XContactId)
 getConnReqContactXContactId db userId cReqHash = do
@@ -377,7 +378,7 @@ createDirectConnection db userId acId pccConnStatus = do
     |]
     (userId, acId, pccConnStatus, ConnContact, createdAt, createdAt)
   pccConnId <- insertedRowId db
-  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, createdAt, updatedAt = createdAt}
+  pure PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = False, viaUserContactLink = Nothing, createdAt, updatedAt = createdAt}
 
 createMemberContactConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> UTCTime -> IO Connection
 createMemberContactConnection_ db userId agentConnId viaContact = createConnection_ db userId ConnContact Nothing agentConnId viaContact Nothing
@@ -578,28 +579,33 @@ createUserContactLink db userId agentConnId cReq =
     userContactLinkId <- insertedRowId db
     void $ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing Nothing 0 currentTs
 
-getUserContactLinkConnections :: DB.Connection -> UserId -> ExceptT StoreError IO [Connection]
-getUserContactLinkConnections db userId =
-  connections =<< liftIO getConnections
-  where
-    getConnections =
-      DB.queryNamed
-        db
-        [sql|
-          SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link,
-            c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
-          FROM connections c
-          JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
-          WHERE c.user_id = :user_id
-            AND uc.user_id = :user_id
-            AND uc.local_display_name = ''
-        |]
-        [":user_id" := userId]
-    connections [] = throwError SEUserContactLinkNotFound
-    connections rows = pure $ map toConnection rows
+getUserContactLinkConnections :: DB.Connection -> User -> ExceptT StoreError IO [Connection]
+getUserContactLinkConnections db user = do
+  cs <- liftIO $ getUserContactLinks db user
+  if null cs then throwError SEUserContactLinkNotFound else pure $ map fst cs
 
-deleteUserContactLink :: DB.Connection -> UserId -> IO ()
-deleteUserContactLink db userId = do
+getUserContactLinks :: DB.Connection -> User -> IO [(Connection, UserContact)]
+getUserContactLinks db User {userId} =
+  map toResult
+    <$> DB.queryNamed
+      db
+      [sql|
+        SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link,
+          c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at,
+          uc.user_contact_link_id, uc.conn_req_contact
+        FROM connections c
+        JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
+        WHERE c.user_id = :user_id
+          AND uc.user_id = :user_id
+          AND uc.local_display_name = ''
+      |]
+      [":user_id" := userId]
+  where
+    toResult :: (ConnectionRow :. (Int64, ConnReqContact)) -> (Connection, UserContact)
+    toResult (connRow :. (userContactLinkId, connReqContact)) = (toConnection connRow, UserContact {userContactLinkId, connReqContact})
+
+deleteUserContactLink :: DB.Connection -> User -> IO ()
+deleteUserContactLink db User {userId} = do
   DB.execute
     db
     [sql|
@@ -896,14 +902,13 @@ getPendingSndChunks db fileId connId =
       |]
       (fileId, connId)
 
-getPendingConnections :: DB.Connection -> User -> IO [Connection]
-getPendingConnections db User {userId} =
-  map toConnection
+getPendingContactConnections :: DB.Connection -> User -> IO [PendingContactConnection]
+getPendingContactConnections db User {userId} = do
+  map toPendingContactConnection
     <$> DB.queryNamed
       db
       [sql|
-        SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link,
-          conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
+        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, created_at, updated_at
         FROM connections
         WHERE user_id = :user_id
           AND conn_type = :conn_type
@@ -1091,7 +1096,7 @@ mergeContactRecords db userId Contact {contactId = toContactId} Contact {contact
   DB.execute db "DELETE FROM contacts WHERE contact_id = ? AND user_id = ?" (fromContactId, userId)
   DB.execute db "DELETE FROM display_names WHERE local_display_name = ? AND user_id = ?" (localDisplayName, userId)
 
-getConnectionEntity :: DB.Connection -> User -> ConnId -> ExceptT StoreError IO ConnectionEntity
+getConnectionEntity :: DB.Connection -> User -> AgentConnId -> ExceptT StoreError IO ConnectionEntity
 getConnectionEntity db user@User {userId, userContactId} agentConnId = do
   c@Connection {connType, entityId} <- getConnection_
   case entityId of
@@ -1109,8 +1114,8 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
   where
     getConnection_ :: ExceptT StoreError IO Connection
     getConnection_ = ExceptT $ do
-      connection
-        <$> DB.query
+      firstRow toConnection (SEConnectionNotFound agentConnId) $
+        DB.query
           db
           [sql|
             SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link,
@@ -1119,9 +1124,6 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
             WHERE user_id = ? AND agent_conn_id = ?
           |]
           (userId, agentConnId)
-    connection :: [ConnectionRow] -> Either StoreError Connection
-    connection (connRow : _) = Right $ toConnection connRow
-    connection _ = Left . SEConnectionNotFound $ AgentConnId agentConnId
     getContactRec_ :: Int64 -> Connection -> ExceptT StoreError IO Contact
     getContactRec_ contactId c = ExceptT $ do
       toContact' contactId c
@@ -1173,8 +1175,8 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
     getConnSndFileTransfer_ :: Int64 -> Connection -> ExceptT StoreError IO SndFileTransfer
     getConnSndFileTransfer_ fileId Connection {connId} =
       ExceptT $
-        sndFileTransfer_ fileId connId
-          <$> DB.query
+        firstRow' (sndFileTransfer_ fileId connId) (SESndFileNotFound fileId) $
+          DB.query
             db
             [sql|
               SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, cs.local_display_name, m.local_display_name
@@ -1185,12 +1187,11 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
               WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
             |]
             (userId, fileId, connId)
-    sndFileTransfer_ :: Int64 -> Int64 -> [(FileStatus, String, Integer, Integer, FilePath, Maybe ContactName, Maybe ContactName)] -> Either StoreError SndFileTransfer
-    sndFileTransfer_ fileId connId [(fileStatus, fileName, fileSize, chunkSize, filePath, contactName_, memberName_)] =
+    sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
+    sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, contactName_, memberName_) =
       case contactName_ <|> memberName_ of
-        Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, recipientDisplayName, connId, agentConnId = AgentConnId agentConnId}
+        Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, recipientDisplayName, connId, agentConnId}
         Nothing -> Left $ SESndFileInvalid fileId
-    sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
     getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
     getUserContact_ userContactLinkId = ExceptT $ do
       userContact_
@@ -2700,13 +2701,13 @@ getContactConnectionChatPreviews_ db User {userId} _ =
     <$> DB.query
       db
       [sql|
-        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, created_at, updated_at
+        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, created_at, updated_at
         FROM connections
         WHERE user_id = ? AND conn_type = ? AND contact_id IS NULL AND conn_level = 0 AND via_contact IS NULL
       |]
       (userId, ConnContact)
   where
-    toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime, UTCTime) -> AChat
+    toContactConnectionChatPreview :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, UTCTime, UTCTime) -> AChat
     toContactConnectionChatPreview connRow =
       let conn = toPendingContactConnection connRow
           stats = ChatStats {unreadCount = 0, minUnreadItemId = 0}
@@ -2718,7 +2719,7 @@ getPendingContactConnection db userId connId = do
     DB.query
       db
       [sql|
-        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, created_at, updated_at
+        SELECT connection_id, agent_conn_id, conn_status, via_contact_uri_hash, via_user_contact_link, created_at, updated_at
         FROM connections
         WHERE user_id = ?
           AND connection_id = ?
@@ -2744,9 +2745,9 @@ deletePendingContactConnection db userId connId =
     |]
     (userId, connId, ConnContact)
 
-toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, UTCTime, UTCTime) -> PendingContactConnection
-toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, createdAt, updatedAt) =
-  PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, createdAt, updatedAt}
+toPendingContactConnection :: (Int64, ConnId, ConnStatus, Maybe ByteString, Maybe Int64, UTCTime, UTCTime) -> PendingContactConnection
+toPendingContactConnection (pccConnId, acId, pccConnStatus, connReqHash, viaUserContactLink, createdAt, updatedAt) =
+  PendingContactConnection {pccConnId, pccAgentConnId = AgentConnId acId, pccConnStatus, viaContactUri = isJust connReqHash, viaUserContactLink, createdAt, updatedAt}
 
 getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> ExceptT StoreError IO (Chat 'CTDirect)
 getDirectChat db user contactId pagination = do

src/Simplex/Chat/Types.hs

@@ -541,6 +541,9 @@ data SndFileTransfer = SndFileTransfer
 
 instance ToJSON SndFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
 
+sndFileTransferConnId :: SndFileTransfer -> ConnId
+sndFileTransferConnId SndFileTransfer {agentConnId = AgentConnId acId} = acId
+
 type FileTransferId = Int64
 
 data FileInvitation = FileInvitation
@@ -586,6 +589,14 @@ data RcvFileInfo = RcvFileInfo
 
 instance ToJSON RcvFileInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
+liveRcvFileTransferConnId :: RcvFileTransfer -> Maybe ConnId
+liveRcvFileTransferConnId RcvFileTransfer {fileStatus} = case fileStatus of
+  RFSAccepted fi -> acId fi
+  RFSConnected fi -> acId fi
+  _ -> Nothing
+  where
+    acId RcvFileInfo {agentConnId = AgentConnId cId} = Just cId
+
 newtype AgentConnId = AgentConnId ConnId
   deriving (Eq, Show)
 
@@ -703,6 +714,7 @@ data PendingContactConnection = PendingContactConnection
     pccAgentConnId :: AgentConnId,
     pccConnStatus :: ConnStatus,
     viaContactUri :: Bool,
+    viaUserContactLink :: Maybe Int64,
     createdAt :: UTCTime,
     updatedAt :: UTCTime
   }

src/Simplex/Chat/View.hs

@@ -144,8 +144,8 @@ responseToView testView = \case
   CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
   CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
   CRGroupDeleted g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
-  CRMemberSubError g c e -> [ttyGroup' g <> " member " <> ttyContact c <> " error: " <> sShow e]
-  CRMemberSubErrors summary -> viewErrorsSummary summary " group member errors"
+  CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
+  CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
   CRGroupSubscribed g -> [ttyFullGroup g <> ": connected to server(s)"]
   CRPendingSubSummary _ -> []
   CRSndFileSubError SndFileTransfer {fileId, fileName} e ->
@@ -772,6 +772,7 @@ viewChatError = \case
     CECallContact _ -> []
     CECallState _ -> []
     CEAgentVersion -> ["unsupported agent version"]
+    CEAgentNoSubResult connId -> ["no subscription result for connection: " <> sShow connId]
     CECommandError e -> ["bad chat command: " <> plain e]
   -- e -> ["chat error: " <> sShow e]
   ChatErrorStore err -> case err of

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: e75846aa38dd26fa70e3faa38ec780edf245e022
+    commit: a6f401041ac82c1ba94a8fea21339acb33904ad0
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7

tests/ChatClient.hs

@@ -274,7 +274,8 @@ serverCfg =
       certificateFile = "tests/fixtures/tls/server.crt",
       logStatsInterval = Just 86400,
       logStatsStartTime = 0,
-      serverStatsFile = Nothing,
+      serverStatsLogFile = "tests/smp-server-stats.daily.log",
+      serverStatsBackupFile = Nothing,
       smpServerVRange = supportedSMPServerVRange
     }
 

tests/ChatTests.hs

@@ -1095,6 +1095,7 @@ testGroupAsync = withTmpFiles $ do
         [ bob <## "#team: dan joined the group",
           dan <## "#team: you joined the group"
         ]
+      threadDelay 500000
   print (4 :: Integer)
   withTestChat "alice" $ \alice -> do
     withTestChat "cath" $ \cath -> do
@@ -1116,6 +1117,7 @@ testGroupAsync = withTmpFiles $ do
               dan <## "#team: member alice (Alice) is connected"
               dan <## "#team: member cath (Catherine) is connected"
           ]
+        threadDelay 500000
   print (5 :: Integer)
   withTestChat "alice" $ \alice -> do
     withTestChat "bob" $ \bob -> do
@@ -1706,9 +1708,9 @@ testGroupSendImageWithTextAndQuote =
       alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")])
       alice @@@ [("#team", "hey bob"), ("@bob", "sent invitation to join group team as admin"), ("@cath", "sent invitation to join group team as admin")]
       bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")])
-      bob @@@ [("#team", "hey bob"), ("@alice","received invitation to join group team as admin")]
+      bob @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
       cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
-      cath @@@ [("#team", "hey bob"), ("@alice","received invitation to join group team as admin")]
+      cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
 
 testUserContactLink :: Spec
 testUserContactLink = versionTestMatrix3 $ \alice bob cath -> do

tests/MobileTests.hs

@@ -50,18 +50,18 @@ contactSubSummary = "{\"resp\":{\"contactSubSummary\":{\"contactSubscriptions\":
 contactSubSummary = "{\"resp\":{\"type\":\"contactSubSummary\",\"contactSubscriptions\":[]}}"
 #endif
 
-memberSubErrors :: String
+memberSubSummary :: String
 #if defined(darwin_HOST_OS) && defined(swiftJSON)
-memberSubErrors = "{\"resp\":{\"memberSubErrors\":{\"memberSubErrors\":[]}}}"
+memberSubSummary = "{\"resp\":{\"memberSubSummary\":{\"memberSubscriptions\":[]}}}"
 #else
-memberSubErrors = "{\"resp\":{\"type\":\"memberSubErrors\",\"memberSubErrors\":[]}}"
+memberSubSummary = "{\"resp\":{\"type\":\"memberSubSummary\",\"memberSubscriptions\":[]}}"
 #endif
 
 pendingSubSummary :: String
 #if defined(darwin_HOST_OS) && defined(swiftJSON)
-pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{\"pendingSubStatus\":[]}}}"
+pendingSubSummary = "{\"resp\":{\"pendingSubSummary\":{\"pendingSubscriptions\":[]}}}"
 #else
-pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\",\"pendingSubStatus\":[]}}"
+pendingSubSummary = "{\"resp\":{\"type\":\"pendingSubSummary\",\"pendingSubscriptions\":[]}}"
 #endif
 
 parsedMarkdown :: String
@@ -89,7 +89,7 @@ testChatApi = withTmpFiles $ do
   chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists
   chatSendCmd cc "/_start" `shouldReturn` chatStarted
   chatRecvMsg cc `shouldReturn` contactSubSummary
-  chatRecvMsg cc `shouldReturn` memberSubErrors
+  chatRecvMsg cc `shouldReturn` memberSubSummary
   chatRecvMsgWait cc 10000 `shouldReturn` pendingSubSummary
   chatRecvMsgWait cc 10000 `shouldReturn` ""
   chatParseMarkdown "hello" `shouldBe` "{}"