From 60bfd9933a20a3f1ee0fa71a5ad72ab4b2b0f489 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 28 Apr 2025 06:28:40 +0000 Subject: [PATCH] core: correctly communicate group acceptance state (#5852) --- .../src/Directory/Service.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 4 +- src/Simplex/Chat/Library/Internal.hs | 15 ++++--- src/Simplex/Chat/Library/Subscriber.hs | 41 ++++++++++--------- src/Simplex/Chat/Protocol.hs | 6 +-- src/Simplex/Chat/Store/Groups.hs | 6 --- .../SQLite/Migrations/chat_query_plans.txt | 4 -- src/Simplex/Chat/Types.hs | 3 +- src/Simplex/Chat/Types/Shared.hs | 8 ++-- src/Simplex/Chat/View.hs | 5 ++- tests/ChatTests/Groups.hs | 12 +++--- 11 files changed, 53 insertions(+), 53 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index e547a1e982..21f6f463a3 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -167,7 +167,7 @@ acceptMemberHook when (useMemberFilter img $ rejectNames a) checkName pure $ if - | useMemberFilter img (passCaptcha a) -> (GAPending, GRMember) + | useMemberFilter img (passCaptcha a) -> (GAPendingApproval, GRMember) | useMemberFilter img (makeObserver a) -> (GAAccepted, GRObserver) | otherwise -> (GAAccepted, memberRole) where diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 90648305d5..8980a345c0 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2062,7 +2062,7 @@ processChatCommand' vr = \case let m' = m {memberStatus = GSMemPendingReview} pure $ CRMemberAccepted user gInfo m' Nothing -> do - let msg = XGrpLinkAcpt role (memberId' m) + let msg = XGrpLinkAcpt GAAccepted role (memberId' m) void $ sendDirectMemberMessage mConn msg groupId introduceToRemaining vr user gInfo m {memberRole = role} when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo m @@ -2073,7 +2073,7 @@ processChatCommand' vr = \case let scope = Just $ GCSMemberSupport $ Just (groupMemberId' m) modMs <- withFastStore' $ \db -> getGroupModerators db vr user gInfo let rcpModMs' = filter memberCurrent modMs - msg = XGrpLinkAcpt role (memberId' m) + msg = XGrpLinkAcpt GAAccepted role (memberId' m) void $ sendGroupMessage user gInfo scope ([m] <> rcpModMs') msg m' <- withFastStore' $ \db -> updateGroupMemberAccepted db user m newMemberStatus role pure $ CRMemberAccepted user gInfo m' diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 66cc5c1767..46e8177e8e 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -967,17 +967,16 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$> ExistingIncognito lp -> fromLocalProfile lp introduceToModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM () -introduceToModerators vr user gInfo@GroupInfo {groupId} m = do - when (maxVersion (memberChatVRange m) < groupKnockingVersion) $ sendPendingReviewMessage +introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do + forM_ (memberConn m) $ \mConn -> do + let msg = + if (maxVersion (memberChatVRange m) >= groupKnockingVersion) + then XGrpLinkAcpt GAPendingReview memberRole memberId + else XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing + void $ sendDirectMemberMessage mConn msg groupId modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo let rcpModMs = filter memberCurrent modMs introduceMember vr user gInfo m rcpModMs (Just $ MSMember $ memberId' m) - where - sendPendingReviewMessage = case memberConn m of - Just conn -> do - let event = XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing - sendGroupMemberMessages user conn [event] groupId - Nothing -> pure () introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM () introduceToAll vr user gInfo m = do diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 35b6a0b822..d44d11fb28 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -872,7 +872,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName XInfo p -> xInfoMember gInfo' m'' p brokerTs XGrpLinkMem p -> xGrpLinkMem gInfo' m'' conn' p - XGrpLinkAcpt role memberId -> xGrpLinkAcpt gInfo' m'' role memberId msg brokerTs + XGrpLinkAcpt acceptance role memberId -> xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs XGrpMemNew memInfo msgScope -> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo' m'' memInfo memRestrictions_ XGrpMemInv memId introInv -> xGrpMemInv gInfo' m'' memId introInv @@ -2083,8 +2083,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = probeMatchingMemberContact m' connectedIncognito else messageError "x.grp.link.mem error: invalid group link host profile update" - xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM () - xGrpLinkAcpt gInfo@GroupInfo {membership} m role memberId msg brokerTs + xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupAcceptance -> GroupMemberRole -> MemberId -> RcvMessage -> UTCTime -> CM () + xGrpLinkAcpt gInfo@GroupInfo {membership} m acceptance role memberId msg brokerTs | sameMemberId memberId membership = processUserAccepted | otherwise = withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case @@ -2102,16 +2102,24 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just c | connReady c -> GSMemConnected _ -> GSMemAnnounced where - processUserAccepted = do - membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemConnected role - let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing} - ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo scopeInfo m) msg brokerTs (CIRcvGroupEvent RGEUserAccepted) - groupMsgToView gInfo scopeInfo ci - toView $ CRUserJoinedGroup user gInfo {membership = membership'} m - let cd = CDGroupRcv gInfo Nothing m - createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing - createGroupFeatureItems user cd CIRcvGroupFeature gInfo - maybeCreateGroupDescrLocal gInfo m + processUserAccepted = case acceptance of + GAAccepted -> do + membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemConnected role + let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing} + ci <- saveRcvChatItemNoParse user (CDGroupRcv gInfo scopeInfo m) msg brokerTs (CIRcvGroupEvent RGEUserAccepted) + groupMsgToView gInfo scopeInfo ci + toView $ CRUserJoinedGroup user gInfo {membership = membership'} m + let cd = CDGroupRcv gInfo Nothing m + createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing + createGroupFeatureItems user cd CIRcvGroupFeature gInfo + maybeCreateGroupDescrLocal gInfo m + GAPendingReview -> do + membership' <- withStore' $ \db -> updateGroupMemberAccepted db user membership GSMemPendingReview role + let scopeInfo = Just $ GCSIMemberSupport {groupMember_ = Nothing} + createInternalChatItem user (CDGroupSnd gInfo scopeInfo) (CISndGroupEvent SGEUserPendingReview) Nothing + toView $ CRMemberAcceptedByOther user gInfo m membership' + GAPendingApproval -> + messageWarning "x.grp.link.acpt: unexpected group acceptance - pending approval" introduceToRemainingMembers acceptedMember = do introduceToRemaining vr user gInfo acceptedMember when (groupFeatureAllowed SGFHistory gInfo) $ sendHistory user gInfo acceptedMember @@ -2467,7 +2475,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = pure (announcedMember', Just scopeInfo) xGrpMemIntro :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MemberRestrictions -> CM () - xGrpMemIntro gInfo@GroupInfo {membership, chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do + xGrpMemIntro gInfo@GroupInfo {chatSettings} m@GroupMember {memberRole, localDisplayName = c} memInfo@(MemberInfo memId _ memChatVRange _) memRestrictions = do case memberCategory m of GCHostMember -> withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case @@ -2478,11 +2486,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> messageError "x.grp.mem.intro: member chat version range incompatible" Just (ChatVersionRange mcvr) | maxVersion mcvr >= groupDirectInvVersion -> do - memCount <- withStore' $ \db -> getGroupMembersCount db user gInfo - -- only create SGEUserPendingReview item on the first introduction - when only 2 members are user and host - when (memberPending membership && memCount == 2) $ do - (gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m - createInternalChatItem user (CDGroupSnd gInfo' scopeInfo) (CISndGroupEvent SGEUserPendingReview) Nothing subMode <- chatReadVar subscriptionMode -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second groupConnIds <- createConn subMode diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index e02a43f1cd..57383e7b11 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -346,7 +346,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json XGrpLinkMem :: Profile -> ChatMsgEvent 'Json - XGrpLinkAcpt :: GroupMemberRole -> MemberId -> ChatMsgEvent 'Json + XGrpLinkAcpt :: GroupAcceptance -> GroupMemberRole -> MemberId -> ChatMsgEvent 'Json XGrpMemNew :: MemberInfo -> Maybe MsgScope -> ChatMsgEvent 'Json XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json @@ -1099,7 +1099,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation" XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection" XGrpLinkMem_ -> XGrpLinkMem <$> p "profile" - XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "role" <*> p "memberId" + XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "acceptance" <*> p "role" <*> p "memberId" XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo" <*> opt "scope" XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions" XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro" @@ -1163,7 +1163,7 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @ XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv] XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct] XGrpLinkMem profile -> o ["profile" .= profile] - XGrpLinkAcpt role memberId -> o ["role" .= role, "memberId" .= memberId] + XGrpLinkAcpt acceptance role memberId -> o ["acceptance" .= acceptance, "role" .= role, "memberId" .= memberId] XGrpMemNew memInfo scope -> o $ ("scope" .=? scope) ["memberInfo" .= memInfo] XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo] XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro] diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 2e82b1dc27..24f598a7e6 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -56,7 +56,6 @@ module Simplex.Chat.Store.Groups getGroupMembers, getGroupModerators, getGroupMembersForExpiration, - getGroupMembersCount, getGroupCurrentMembersCount, deleteGroupChatItems, deleteGroupMembers, @@ -945,11 +944,6 @@ toContactMember :: VersionRangeChat -> User -> (GroupMemberRow :. MaybeConnectio toContactMember vr User {userContactId} (memberRow :. connRow) = (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection vr connRow} -getGroupMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int -getGroupMembersCount db User {userId} GroupInfo {groupId} = - fromOnly . head - <$> DB.query db "SELECT COUNT(1) FROM group_members WHERE group_id = ? AND user_id = ?" (groupId, userId) - getGroupCurrentMembersCount :: DB.Connection -> User -> GroupInfo -> IO Int getGroupCurrentMembersCount db User {userId} GroupInfo {groupId} = do statuses :: [GroupMemberStatus] <- diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 743bfc53bf..3b63f346d5 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -5650,10 +5650,6 @@ Query: SELECT COUNT(1) FROM contacts WHERE user_id = ? AND chat_item_ttl > 0 Plan: SEARCH contacts USING INDEX idx_contacts_chat_ts (user_id=?) -Query: SELECT COUNT(1) FROM group_members WHERE group_id = ? AND user_id = ? -Plan: -SEARCH group_members USING COVERING INDEX idx_group_members_group_id (user_id=? AND group_id=?) - Query: SELECT COUNT(1) FROM groups WHERE user_id = ? AND chat_item_ttl > 0 Plan: SEARCH groups USING INDEX idx_groups_chat_ts (user_id=?) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 60bd409067..da999b96bf 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1050,7 +1050,8 @@ instance ToJSON GroupMemberStatus where acceptanceToStatus :: Maybe GroupMemberAdmission -> GroupAcceptance -> GroupMemberStatus acceptanceToStatus memberAdmission groupAcceptance - | groupAcceptance == GAPending = GSMemPendingApproval + | groupAcceptance == GAPendingApproval = GSMemPendingApproval + | groupAcceptance == GAPendingReview = GSMemPendingReview | (memberAdmission >>= review) == Just MCAll = GSMemPendingReview | otherwise = GSMemAccepted diff --git a/src/Simplex/Chat/Types/Shared.hs b/src/Simplex/Chat/Types/Shared.hs index 832d877234..60ebe9d033 100644 --- a/src/Simplex/Chat/Types/Shared.hs +++ b/src/Simplex/Chat/Types/Shared.hs @@ -49,15 +49,17 @@ instance ToJSON GroupMemberRole where toJSON = strToJSON toEncoding = strToJEncoding -data GroupAcceptance = GAAccepted | GAPending deriving (Eq, Show) +data GroupAcceptance = GAAccepted | GAPendingApproval | GAPendingReview deriving (Eq, Show) instance StrEncoding GroupAcceptance where strEncode = \case GAAccepted -> "accepted" - GAPending -> "pending" + GAPendingApproval -> "pending" + GAPendingReview -> "pending_review" strDecode = \case "accepted" -> Right GAAccepted - "pending" -> Right GAPending + "pending" -> Right GAPendingApproval + "pending_review" -> Right GAPendingReview r -> Left $ "bad GroupAcceptance " <> B.unpack r strP = strDecode <$?> A.takeByteString diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 4864e273c3..8d2835541d 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1121,7 +1121,10 @@ viewMemberAccepted g m@GroupMember {memberStatus} = case memberStatus of _ -> [ttyGroup' g <> ": " <> ttyMember m <> " accepted"] viewMemberAcceptedByOther :: GroupInfo -> GroupMember -> GroupMember -> [StyledString] -viewMemberAcceptedByOther g acceptingMember m@GroupMember {memberCategory} = case memberCategory of +viewMemberAcceptedByOther g acceptingMember m@GroupMember {memberCategory, memberStatus} = case memberCategory of + GCUserMember -> case memberStatus of + GSMemPendingReview -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted you to the group, pending review"] + _ -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted you to the group [warning - unexpected]"] GCInviteeMember -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted " <> ttyMember m <> " to the group (will introduce remaining members)"] _ -> [ttyGroup' g <> ": " <> ttyMember acceptingMember <> " accepted " <> ttyMember m <> " to the group"] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 9bee2da58c..49acf71ecb 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -3032,7 +3032,7 @@ testGLinkApproveMember = cath #> "#team hi group" [alice, bob] *<# "#team cath> hi group" where - cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}} + cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}} testGLinkReviewMember :: HasCallStack => TestParams -> IO () testGLinkReviewMember = @@ -3062,7 +3062,8 @@ testGLinkReviewMember = concurrentlyN_ [ alice <## "#team: eve connected and pending review", eve - <### [ "#team: joining the group...", + <### [ "#team: alice accepted you to the group, pending review", + "#team: joining the group...", "#team: you joined the group, connecting to group moderators for admission to group", "#team: member cath (Catherine) is connected", "#team: member dan (Daniel) is connected" @@ -3219,7 +3220,8 @@ testGLinkApproveThenReviewMember = concurrentlyN_ [ alice <## "#team: eve accepted and pending review (will introduce moderators)", eve - <### [ "#team: member cath (Catherine) is connected", + <### [ "#team: alice accepted you to the group, pending review", + "#team: member cath (Catherine) is connected", "#team: member dan (Daniel) is connected" ], do @@ -3309,7 +3311,7 @@ testGLinkApproveThenReviewMember = eve #> "#team 19" [alice, bob, cath, dan] *<# "#team eve> 19" where - cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}} + cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}} testGLinkDeletePendingApprovalMember :: HasCallStack => TestParams -> IO () testGLinkDeletePendingApprovalMember = @@ -3334,7 +3336,7 @@ testGLinkDeletePendingApprovalMember = cath <## "#team: alice removed you from the group" cath <## "use /d #team to delete the group" where - cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPending, GRObserver))}} + cfg = testCfg {chatHooks = defaultChatHooks {acceptMember = Just (\_ _ _ -> pure $ Right (GAPendingApproval, GRObserver))}} testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO () testPlanGroupLinkKnown =