core: subscribe all users (#1743)

This commit is contained in:
JRoberts
2023-01-14 15:45:13 +04:00
committed by GitHub
parent 9290fcc6b2
commit e452edb781
4 changed files with 68 additions and 54 deletions
+14 -14
View File
@@ -395,12 +395,12 @@ data ChatResponse
| CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CRContactsDisconnected {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactSubError {contact :: Contact, chatError :: ChatError}
| CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]}
| CRContactSubError {contact :: Contact, chatError :: ChatError} -- TODO delete
| CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
| CRGroupInvitation {groupInfo :: GroupInfo}
| CRGroupInvitation {user :: User, groupInfo :: GroupInfo}
| CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
| CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
@@ -411,8 +411,8 @@ data ChatResponse
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupEmpty {groupInfo :: GroupInfo}
| CRGroupRemoved {groupInfo :: GroupInfo}
| CRGroupEmpty {user :: User, groupInfo :: GroupInfo}
| CRGroupRemoved {user :: User, groupInfo :: GroupInfo}
| CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
| CRGroupProfile {user :: User, groupInfo :: GroupInfo}
@@ -420,20 +420,20 @@ data ChatResponse
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
| CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
| CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
| CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]}
| CRGroupSubscribed {groupInfo :: GroupInfo}
| CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]}
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
| CRMemberSubError {user :: User, groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
| CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]}
| CRGroupSubscribed {user :: User, groupInfo :: GroupInfo}
| CRPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]}
| CRSndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
| CRRcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
| CRCallInvitation {user :: User, callInvitation :: RcvCallInvitation}
| CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
| CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
| CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
| CRCallEnded {user :: User, contact :: Contact}
| CRCallInvitations {user :: User, callInvitations :: [RcvCallInvitation]}
| CRUserContactLinkSubscribed
| CRUserContactLinkSubError {chatError :: ChatError}
| CRUserContactLinkSubscribed -- TODO delete
| CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
| CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode}
| CRNtfMessages {user :: User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
+18 -17
View File
@@ -146,7 +146,7 @@ responseToView user_ testView liveItems ts = \case
CRSndFileComplete u _ ft -> ttyUser u $ sendingFile_ "completed" ft
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} ->
ttyUser u $ [ttyContact c <> " cancelled receiving " <> sndFile ft]
ttyUser u [ttyContact c <> " cancelled receiving " <> sndFile ft]
CRContactConnecting u _ -> ttyUser u []
CRContactConnected u ct userCustomProfile -> ttyUser u $ viewContactConnected ct userCustomProfile testView
CRContactAnotherClient u c -> ttyUser u [ttyContact' c <> ": contact is connected to another client"]
@@ -154,18 +154,19 @@ responseToView user_ testView liveItems ts = \case
CRContactsDisconnected u srv cs -> ttyUser u [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed u srv cs -> ttyUser u [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubSummary summary ->
[sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
CRContactSubSummary u summary ->
ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where
(errors, subscribed) = partition (isJust . contactError) summary
CRUserContactSubSummary summary ->
map addressSS addresses
<> ([sShow (length groupLinksSubscribed) <> " group links active" | not (null groupLinksSubscribed)] <> viewErrorsSummary groupLinkErrors " group link errors")
CRUserContactSubSummary u summary ->
ttyUser u $
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
CRGroupInvitation g -> [groupInvitation' g]
CRGroupInvitation u g -> ttyUser u [groupInvitation' g]
CRReceivedGroupInvitation u g c role -> ttyUser u $ viewReceivedGroupInvitation g c role
CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g
CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m
@@ -178,8 +179,8 @@ responseToView user_ testView liveItems ts = \case
CRDeletedMemberUser u g by -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
CRDeletedMember u g by m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
CRLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"]
CRGroupEmpty u g -> ttyUser u [ttyFullGroup g <> ": group is empty"]
CRGroupRemoved u g -> ttyUser u [ttyFullGroup g <> ": you are no longer a member or group deleted"]
CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"]
CRGroupUpdated u g g' m -> ttyUser u $ viewGroupUpdated g g' m
CRGroupProfile u g -> ttyUser u $ viewGroupProfile g
@@ -187,14 +188,14 @@ responseToView user_ testView liveItems ts = \case
CRGroupLink u g cReq -> ttyUser u $ groupLink_ "Group link:" g cReq
CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g
CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed g -> viewGroupSubscribed g
CRPendingSubSummary _ -> []
CRSndFileSubError SndFileTransfer {fileId, fileName} e ->
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
CRPendingSubSummary u _ -> ttyUser u []
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 ->
ttyUser u ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
CRCallInvitation u RcvCallInvitation {contact, callType, sharedKey} -> ttyUser u $ viewCallInvitation contact callType sharedKey
CRCallOffer {user = u, contact, callType, offer, sharedKey} -> ttyUser u $ viewCallOffer contact callType offer sharedKey
CRCallAnswer {user = u, contact, answer} -> ttyUser u $ viewCallAnswer contact answer