diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index bf91e5ed23..ac4b50ed9f 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -741,7 +741,7 @@ data ChatResponse | CRNetworkStatuses {user_ :: Maybe User, networkStatuses :: [ConnNetworkStatus]} | CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost} | CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost} - | CRGroupInvitation {user :: User, groupInfo :: GroupInfo} + | CRGroupInvitation {user :: User, shortGroupInfo :: ShortGroupInfo} | CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, fromMemberRole :: GroupMemberRole, memberRole :: GroupMemberRole} | CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember} | CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} @@ -757,8 +757,7 @@ data ChatResponse | CRUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember} | CRUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember} | CRUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember} - | CRGroupEmpty {user :: User, groupInfo :: GroupInfo} - | CRGroupRemoved {user :: User, groupInfo :: GroupInfo} + | CRGroupEmpty {user :: User, shortGroupInfo :: ShortGroupInfo} | CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember} | CRGroupProfile {user :: User, groupInfo :: GroupInfo} @@ -773,9 +772,9 @@ 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, shortGroupInfo :: ShortGroupInfo, memberToSubscribe :: ShortGroupMember, chatError :: ChatError} | CRMemberSubSummary {user :: User, memberSubscriptions :: [MemberSubStatus]} - | CRGroupSubscribed {user :: User, groupInfo :: GroupInfo} + | CRGroupSubscribed {user :: User, shortGroupInfo :: ShortGroupInfo} | CRPendingSubSummary {user :: User, pendingSubscriptions :: [PendingSubStatus]} | CRSndFileSubError {user :: User, sndFileTransfer :: SndFileTransfer, chatError :: ChatError} | CRRcvFileSubError {user :: User, rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError} @@ -1051,7 +1050,7 @@ data ContactSubStatus = ContactSubStatus deriving (Show) data MemberSubStatus = MemberSubStatus - { member :: GroupMember, + { member :: ShortGroupMember, memberError :: Maybe ChatError } deriving (Show) diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index b8bf879caa..bf568f7946 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -3347,17 +3347,17 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do rs <- withAgent $ \a -> agentBatchSubscribe a conns -- send connection events to view contactSubsToView rs cts ce - -- TODO possibly, we could either disable these events or replace with less noisy for API - contactLinkSubsToView rs ucs - groupSubsToView rs gs ms ce - sndFileSubsToView rs sfts - rcvFileSubsToView rs rfts - pendingConnSubsToView rs pcs + unlessM (asks $ coreApi . config) $ do + contactLinkSubsToView rs ucs + groupSubsToView rs gs ms ce + sndFileSubsToView rs sfts + rcvFileSubsToView rs rfts + pendingConnSubsToView rs pcs where 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 Nothing -> let pcs' = addConn c (toPCC 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' = addConn c (toShortMember m 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) RcvFileConnection c rft -> let rfts' = addConn 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) @@ -3377,6 +3377,13 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do createdAt, updatedAt = createdAt } + toShortMember GroupMember {groupMemberId, groupId, localDisplayName} Connection {agentConnId} = + ShortGroupMember + { groupMemberId, + groupId, + memberName = localDisplayName, + connId = agentConnId + } getContactConns :: CM ([ConnId], Map ConnId Contact) getContactConns = do cts <- withStore_ (`getUserContacts` vr) @@ -3387,11 +3394,13 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do (cs, ucs) <- unzip <$> withStore_ (`getUserContactLinks` vr) let connIds = map aConnId cs pure (connIds, M.fromList $ zip connIds ucs) - getGroupMemberConns :: CM ([Group], [ConnId], Map ConnId GroupMember) + getGroupMemberConns :: CM ([ShortGroup], [ConnId], Map ConnId ShortGroupMember) getGroupMemberConns = do - gs <- withStore_ (`getUserGroups` vr) - let mPairs = concatMap (\(Group _ ms) -> mapMaybe (\m -> (,m) <$> memberConnId m) (filter (not . memberRemoved) ms)) gs + gs <- withStore_ getUserGroupsToSubscribe + let mPairs = concatMap (\(ShortGroup _ ms) -> map (\m -> (shortMemConnId m, m)) ms) gs pure (gs, map fst mPairs, M.fromList mPairs) + where + shortMemConnId ShortGroupMember{connId = AgentConnId acId} = acId getSndFileTransferConns :: CM ([ConnId], Map ConnId SndFileTransfer) getSndFileTransferConns = do sfts <- withStore_ getLiveSndFileTransfers @@ -3435,30 +3444,27 @@ subscribeUserConnections vr onlyNeeded agentBatchSubscribe user = do -- TODO possibly below could be replaced with less noisy events for API contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> CM () contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs - groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> CM () + groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [ShortGroup] -> Map ConnId ShortGroupMember -> Bool -> CM () groupSubsToView rs gs ms ce = do mapM_ groupSub $ - sortOn (\(Group GroupInfo {localDisplayName = g} _) -> g) gs + sortOn (\(ShortGroup ShortGroupInfo {groupName = g} _) -> g) gs toView . CRMemberSubSummary user $ map (uncurry MemberSubStatus) mRs where mRs = resultsFor rs ms - groupSub :: Group -> CM () - groupSub (Group g@GroupInfo {membership, groupId = gId} members) = do + groupSub :: ShortGroup -> CM () + groupSub (ShortGroup g@ShortGroupInfo {groupId = gId, membershipStatus} members) = do when ce $ mapM_ (toView . uncurry (CRMemberSubError user g)) mErrors toView groupEvent where - mErrors :: [(GroupMember, ChatError)] + mErrors :: [(ShortGroupMember, ChatError)] mErrors = - sortOn (\(GroupMember {localDisplayName = n}, _) -> n) + sortOn (\(ShortGroupMember {memberName = n}, _) -> n) . filterErrors - $ filter (\(GroupMember {groupId}, _) -> groupId == gId) mRs + $ filter (\(ShortGroupMember {groupId}, _) -> groupId == gId) mRs groupEvent :: ChatResponse groupEvent - | memberStatus membership == GSMemInvited = CRGroupInvitation user g - | all (\GroupMember {activeConn} -> isNothing activeConn) members = - if memberActive membership - then CRGroupEmpty user g - else CRGroupRemoved user g + | membershipStatus == GSMemInvited = CRGroupInvitation user g + | null members = CRGroupEmpty user g | otherwise = CRGroupSubscribed user g sndFileSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId SndFileTransfer -> CM () sndFileSubsToView rs sfts = do diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 589e220690..1d1a715b78 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -57,6 +57,7 @@ module Simplex.Chat.Store.Groups deleteGroupItemsAndMembers, deleteGroup, getUserGroups, + getUserGroupsToSubscribe, getUserGroupDetails, getUserGroupsWithSummary, getGroupSummary, @@ -588,6 +589,51 @@ getGroup db vr user groupId = do members <- liftIO $ getGroupMembers db vr user gInfo pure $ Group gInfo members +getGroupToSubscribe :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO ShortGroup +getGroupToSubscribe db User {userId, userContactId} groupId = do + shortInfo <- getGroupInfoToSubscribe + members <- liftIO getGroupMembersToSubscribe + pure $ ShortGroup shortInfo members + where + getGroupInfoToSubscribe :: ExceptT StoreError IO ShortGroupInfo + getGroupInfoToSubscribe = ExceptT $ do + firstRow toInfo (SEGroupNotFound groupId) $ + DB.query + db + [sql| + SELECT g.local_display_name, mu.member_status + FROM groups g + JOIN group_members mu ON mu.group_id = g.group_id + WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ? + AND mu.member_status NOT IN (?,?,?) + |] + (groupId, userId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted) + where + toInfo :: (GroupName, GroupMemberStatus) -> ShortGroupInfo + toInfo (groupName, membershipStatus) = + ShortGroupInfo groupId groupName membershipStatus + getGroupMembersToSubscribe :: IO [ShortGroupMember] + getGroupMembersToSubscribe = do + map toShortMember + <$> DB.query + db + [sql| + SELECT m.group_member_id, m.local_display_name, 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.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) + AND m.member_status NOT IN (?,?,?) + |] + (userId, userId, groupId, userContactId, GSMemRemoved, GSMemLeft, GSMemGroupDeleted) + where + toShortMember :: (GroupMemberId, ContactName, AgentConnId) -> ShortGroupMember + toShortMember (groupMemberId, localDisplayName, agentConnId) = + ShortGroupMember groupMemberId groupId localDisplayName agentConnId + deleteGroupConnectionsAndFiles :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO () deleteGroupConnectionsAndFiles db User {userId} GroupInfo {groupId} members = do forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId' m) @@ -642,6 +688,11 @@ 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 +getUserGroupsToSubscribe :: DB.Connection -> User -> IO [ShortGroup] +getUserGroupsToSubscribe db user@User {userId} = do + groupIds <- map fromOnly <$> DB.query db "SELECT group_id FROM groups WHERE user_id = ?" (Only userId) + rights <$> mapM (runExceptT . getGroupToSubscribe db user) groupIds + getUserGroupDetails :: DB.Connection -> VersionRangeChat -> User -> Maybe ContactId -> Maybe String -> IO [GroupInfo] getUserGroupDetails db vr User {userId, userContactId} _contactId_ search_ = do g_ <- diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 11587694cb..d137e54d23 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -373,6 +373,26 @@ optionalFullName displayName fullName | T.null fullName || displayName == fullName = "" | otherwise = " (" <> fullName <> ")" +data ShortGroup = ShortGroup + { shortInfo :: ShortGroupInfo, + members :: [ShortGroupMember] + } + +data ShortGroupInfo = ShortGroupInfo + { groupId :: GroupId, + groupName :: GroupName, + membershipStatus :: GroupMemberStatus + } + deriving (Eq, Show) + +data ShortGroupMember = ShortGroupMember + { groupMemberId :: GroupMemberId, + groupId :: GroupId, + memberName :: ContactName, + connId :: AgentConnId + } + deriving (Show) + data Group = Group {groupInfo :: GroupInfo, members :: [GroupMember]} deriving (Eq, Show) @@ -1812,3 +1832,7 @@ $(JQ.deriveJSON defaultJSON ''ContactRef) $(JQ.deriveJSON defaultJSON ''NoteFolder) $(JQ.deriveJSON defaultJSON ''ChatTag) + +$(JQ.deriveJSON defaultJSON ''ShortGroupInfo) + +$(JQ.deriveJSON defaultJSON ''ShortGroupMember) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 84cb561396..1d578dea24 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -292,7 +292,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe (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] + CRGroupInvitation u g -> ttyUser u [groupInvitationSub g] CRReceivedGroupInvitation {user = u, groupInfo = g, contact = c, memberRole = r} -> ttyUser u $ viewReceivedGroupInvitation g c r CRUserJoinedGroup u g _ -> ttyUser u $ viewUserJoinedGroup g CRJoinedGroupMember u g m -> ttyUser u $ viewJoinedGroupMember g m @@ -307,8 +307,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe 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 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"] + CRGroupEmpty u ShortGroupInfo {groupName = g} -> ttyUser u [ttyGroup g <> ": group is empty"] CRGroupDeleted u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> viewGroupName 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 @@ -323,9 +322,9 @@ 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 ShortGroupInfo {groupName = g} ShortGroupMember {memberName = n} e -> ttyUser u [ttyGroup g <> " member " <> ttyContact n <> " error: " <> sShow e] CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors" - CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g + CRGroupSubscribed u ShortGroupInfo {groupName = 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] @@ -571,8 +570,8 @@ viewUsersList us = <> ["muted" | not showNtfs] <> [plain ("unread: " <> show count) | count /= 0] -viewGroupSubscribed :: GroupInfo -> [StyledString] -viewGroupSubscribed g = [membershipIncognito g <> ttyFullGroup g <> ": connected to server(s)"] +viewGroupSubscribed :: GroupName -> [StyledString] +viewGroupSubscribed g = [ttyGroup g <> ": connected to server(s)"] showSMPServer :: SMPServer -> String showSMPServer ProtocolServer {host} = B.unpack $ strEncode host @@ -1216,6 +1215,15 @@ groupInvitation' g@GroupInfo {localDisplayName = ldn, groupProfile = GroupProfil Just mp -> " to join as " <> incognitoProfile' (fromLocalProfile mp) <> ", " Nothing -> " to join, " +groupInvitationSub :: ShortGroupInfo -> StyledString +groupInvitationSub ShortGroupInfo {groupName = ldn} = + highlight ("#" <> viewName ldn) + <> " - you are invited (" + <> highlight ("/j " <> viewName ldn) + <> " to join, " + <> highlight ("/d #" <> viewName ldn) + <> " to delete invitation)" + viewContactsMerged :: Contact -> Contact -> Contact -> [StyledString] viewContactsMerged c1 c2 ct' = [ "contact " <> ttyContact' c2 <> " is merged into " <> ttyContact' c1, diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 6cb11f3f93..7a0ae79ccc 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -923,13 +923,13 @@ testRestoreDirectory tmp = do withTestChat tmp "cath" $ \cath -> do bob <## "2 contacts connected (use /cs for the list)" bob - <### [ "#privacy (Privacy): connected to server(s)", - "#security (Security): connected to server(s)" + <### [ "#privacy: connected to server(s)", + "#security: connected to server(s)" ] cath <## "2 contacts connected (use /cs for the list)" cath - <### [ "#privacy (Privacy): connected to server(s)", - "#anonymity (Anonymity): connected to server(s)" + <### [ "#privacy: connected to server(s)", + "#anonymity: connected to server(s)" ] listGroups superUser bob cath groupFoundN 3 bob "privacy" diff --git a/tests/MobileTests.hs b/tests/MobileTests.hs index 5c4ab29c60..e99b61dd5c 100644 --- a/tests/MobileTests.hs +++ b/tests/MobileTests.hs @@ -169,7 +169,6 @@ testChatApi tmp = do chatSendCmd cc "/create user alice Alice" `shouldReturn` activeUserExists chatSendCmd cc "/_start" `shouldReturn` chatStarted chatRecvMsg cc `shouldReturn` networkStatuses - chatRecvMsg cc `shouldReturn` userContactSubSummary chatRecvMsgWait cc 10000 `shouldReturn` "" chatParseMarkdown "hello" `shouldBe` "{}" chatParseMarkdown "*hello*" `shouldBe` parsedMarkdown