From a1216d86fd95efd76b7e6a34bd301ac783290eb6 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Wed, 29 May 2024 12:38:46 +0300 Subject: [PATCH] process user links --- .../rfcs/2024-05-28-optimized-subscription.md | 5 +++-- src/Simplex/Chat.hs | 19 +++++++++++------ src/Simplex/Chat/Controller.hs | 10 +++++---- src/Simplex/Chat/View.hs | 21 +++++++------------ 4 files changed, 30 insertions(+), 25 deletions(-) diff --git a/docs/rfcs/2024-05-28-optimized-subscription.md b/docs/rfcs/2024-05-28-optimized-subscription.md index 434691119b..02d56b0ff8 100644 --- a/docs/rfcs/2024-05-28-optimized-subscription.md +++ b/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} ``` diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 10ccb0e1ae..f9fdf0f5f7 100644 --- a/src/Simplex/Chat.hs +++ b/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 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 8da6877fd1..2ec679555b 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/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} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index dd2d9687b0..5b03d20c04 100644 --- a/src/Simplex/Chat/View.hs +++ b/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 ->