process user links

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

@@ -21,7 +21,8 @@ Successful results are communicated with a new `UP srv conns` message emitted fr
 Sending results with UP allows to reduce summary responses to a generic structure with counters so no entity data would be needed for CLI here:
 
 ```haskell
-| CRConnectionSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+| CRConnectionSubSummary {user :: User, okSubs :: Int, errSubs :: Int} -- XXX: add label :: Text ?
+| CRGroupSubSummary {user :: User, groupName :: GroupName, okSubs :: Int, errSubs :: Int} -- XXX: needs group name as group reports
 ```
 
 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`.
@@ -30,7 +31,7 @@ Subscription errors for CLI (when connection error reporting is enabled) are rep
 
 ```haskell
 | CRContactSubError {user :: User, contactName :: ContactName, chatError :: ChatError}
-| CRMemberSubError {user :: User, groupInfo :: GroupName, member :: 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}
 ```

src/Simplex/Chat.hs

@@ -3414,7 +3414,7 @@ subscribeUserConnections vr onlyNeeded user = do
         conns = S.fromList cts
         errConns = M.restrictKeys errs conns
         notifyCLI = do
-          toView CRConnectionSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
+          toView CRContactSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
           when (ce && not (M.null errConns)) $ forM_ (M.assocs errConns) $ \(acId, err) ->
             forM_ (M.lookup acId connRefs) $ \ContactRef {localDisplayName} ->
               toView CRContactSubError {user, contactName = localDisplayName, chatError = ChatErrorAgent err Nothing}
@@ -3429,15 +3429,22 @@ subscribeUserConnections vr onlyNeeded user = do
               e -> show e
     contactLinkSubsToView :: Map ConnId AgentErrorType -> [ConnId] -> CM ()
     contactLinkSubsToView errs ucConns = do
-      toView CRConnectionSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns}
-      where
-        conns = S.fromList ucConns
-        errConns = M.restrictKeys errs conns
+      let conns = S.fromList ucConns
+      links <- withStore_ (`getUserContactLinks` vr)
+      let (addresses, groupLinks) = partition (\(_, uc) -> isNothing $ userContactGroupId uc) $ filter (\(c, _) -> S.member (aConnId c) conns) links -- TODO: move into query
+      forM_ addresses $ \(conn, _uc) -> toView $ CRUserAddrSubStatus {user, userContactError = (`ChatErrorAgent` Nothing) <$> M.lookup (aConnId conn) errs}
+      let groups = S.fromList $ map (aConnId . fst) groupLinks
+          errGroups = M.restrictKeys errs groups
+      unless (S.null groups) $ toView CRUserGroupLinksSubSummary
+        { user,
+          okSubs = S.size groups - M.size errGroups,
+          errSubs = M.size errGroups
+        }
     groupSubsToView :: Map ConnId AgentErrorType -> [Group] -> [ConnId] -> Map ConnId ContactRef -> Bool -> CM ()
     groupSubsToView errs gs ms connRefs ce = do
       mapM_ groupSub $
         sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs
-      toView CRConnectionSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns} -- XXX: add label?
+      toView CRMemberSubSummary {user, okSubs = S.size conns - M.size errConns, errSubs = M.size errConns} -- XXX: add label?
       where
         conns = S.fromList ms
         errConns = M.restrictKeys errs conns

src/Simplex/Chat/Controller.hs

@@ -668,9 +668,11 @@ data ChatResponse
   | CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
   | CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
   | CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
-  | CRConnectionSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
+  | CRContactSubSummary {user :: User, okSubs :: Int, errSubs :: Int}
   | CRContactSubError {user :: User, contactName :: ContactName, chatError :: ChatError}
-  | CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
+  -- | CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]} -- XXX: weirs status/subSummary/subError hybrid
+  | 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}
@@ -708,9 +710,9 @@ data ChatResponse
   | 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, 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}

src/Simplex/Chat/View.hs

@@ -230,17 +230,12 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   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]
-  CRConnectionSubSummary {user, okSubs, errSubs} ->
-  -- CRContactSubSummary u summary ->
-    ttyUser user $ [sShow okSubs <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | okSubs > 0] <> viewErrorsSummary errSubs " contact errors"
-  CRUserContactSubSummary u summary ->
-    ttyUser u $
-      map addressSS addresses
-        <> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary (length 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
+  CRContactSubSummary {user, okSubs, errSubs} -> ttyUser user $ [sShow okSubs <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | okSubs > 0] <> viewErrorsSummary errSubs " 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]
+  CRUserGroupLinksSubSummary {user, okSubs, errSubs} ->
+    ttyUser user $
+      [sShow okSubs <> " group links active" | okSubs > 0]
+        <> viewErrorsSummary errSubs " group link errors"
   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]
@@ -275,9 +270,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
   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 " <> ttyContact m <> " error: " <> sShow e]
-  CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (length $ filter (isJust . memberError) summary) " group member errors" -- TODO: use generic summary? trim to counter?
+  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 ->