From df36fc8c4ac21e20d08a48ecead6a047bc42ab8a Mon Sep 17 00:00:00 2001 From: Narasimha-sc <166327228+Narasimha-sc@users.noreply.github.com> Date: Fri, 10 Jul 2026 11:50:12 +0000 Subject: [PATCH] core: directory bot must not admit members past admission review APIAcceptMember chose between "advance a pending member per group policy" and "a moderator admits a member past admission review" using only the member's current status. The directory bot is a group admin and called the same command, so when a member was already pending review at the moment the bot's approval ran (a prior approval by the bot itself, from a queued event, already advanced them), the bot's approval silently ran the full-admit branch - admitting the member past admission review (visible to everyone, able to send) in a plain p2p group with review still correctly enabled. Add screeningApproval to APIAcceptMember: the directory bot passes True and can only advance a pending-approval member per policy, never admit past review (a no-op on a pending-review member); human moderators (screeningApproval=False, the default; screening=on in the parser sets True) keep the full behaviour. Backward compatible - apps send /_accept member as a string command. --- .../src/Directory/Service.hs | 2 +- bots/src/API/Docs/Commands.hs | 2 +- src/Simplex/Chat/Controller.hs | 2 +- src/Simplex/Chat/Library/Commands.hs | 8 ++- tests/Bots/DirectoryTests.hs | 33 ++++++++++ tests/ChatTests/Groups.hs | 61 +++++++++++++++++++ 6 files changed, 102 insertions(+), 6 deletions(-) diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 76c3f43400..a0e1faa8ea 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -679,7 +679,7 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o gli_ <- join . eitherToMaybe <$> withDB' "getGroupLinkInfo" cc (\db -> getGroupLinkInfo db userId groupId) let role = if alwaysObserver || useMemberFilter image (makeObserver a) then GRObserver else maybe GRMember (\GroupLinkInfo {memberRole} -> memberRole) gli_ gmId = groupMemberId' m - sendChatCmd cc (APIAcceptMember groupId gmId role) >>= \case + sendChatCmd cc (APIAcceptMember groupId gmId role True) >>= \case Right CRMemberAccepted {member} -> do atomically $ TM.delete gmId $ pendingCaptchas env if memberStatus member == GSMemPendingReview diff --git a/bots/src/API/Docs/Commands.hs b/bots/src/API/Docs/Commands.hs index d13817c439..2978382e84 100644 --- a/bots/src/API/Docs/Commands.hs +++ b/bots/src/API/Docs/Commands.hs @@ -121,7 +121,7 @@ chatCommandsDocsData = [ ("APIAddMember", [], "Add contact to group. Requires bot to have Admin role.", ["CRSentGroupInvitation", "CRChatCmdError"], [], Just UNInteractive, "/_add #" <> Param "groupId" <> " " <> Param "contactId" <> " " <> Param "memberRole"), ("APIAddMemberViaGroup", [], "Add member of another group to group. Requires bot to have Admin role in the group, and direct messages allowed for its role in another group.", ["CRSentGroupInvitationViaGroup", "CRChatCmdError"], [TD "CEPeerChatVRangeIncompatible" "Member's client version is older than required"], Just UNInteractive, "/_add #" <> Param "groupId" <> " #" <> Param "viaGroupId" <> " " <> Param "groupMemberId" <> " " <> Param "memberRole"), ("APIJoinGroup", ["enableNtfs"], "Join group.", ["CRUserAcceptedGroupSent", "CRChatCmdError"], [], Just UNInteractive, "/_join #" <> Param "groupId"), - ("APIAcceptMember", [], "Accept group member. Requires Admin role.", ["CRMemberAccepted", "CRChatCmdError"], [TD "CEGroupMemberNotActive" "Member is not connected yet"], Just UNBackground, "/_accept member #" <> Param "groupId" <> " " <> Param "groupMemberId" <> " " <> Param "memberRole"), + ("APIAcceptMember", ["screeningApproval"], "Accept group member. Requires Admin role.", ["CRMemberAccepted", "CRChatCmdError"], [TD "CEGroupMemberNotActive" "Member is not connected yet"], Just UNBackground, "/_accept member #" <> Param "groupId" <> " " <> Param "groupMemberId" <> " " <> Param "memberRole"), ("APIMembersRole", [], "Set members role. Requires Admin role.", ["CRMembersRoleUser", "CRChatCmdError"], [], Just UNBackground, "/_member role #" <> Param "groupId" <> " " <> Join ',' "groupMemberIds" <> " " <> Param "memberRole"), ("APIBlockMembersForAll", [], "Block members. Requires Moderator role.", ["CRMembersBlockedForAllUser", "CRChatCmdError"], [], Just UNBackground, "/_block #" <> Param "groupId" <> " " <> Join ',' "groupMemberIds" <> OnOffParam "blocked" "blocked" Nothing), ("APIRemoveMembers", [], "Remove members. Requires Admin role.", ["CRUserDeletedMembers", "CRChatCmdError"], ["CEGroupMemberNotFound"], Just UNBackground, "/_remove #" <> Param "groupId" <> " " <> Join ',' "groupMemberIds" <> OnOffParam "messages" "withMessages" (Just False)), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index f74b0c5a78..0c85430e39 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -471,7 +471,7 @@ data ChatCommand | APIAddMember {groupId :: GroupId, contactId :: ContactId, memberRole :: GroupMemberRole} | APIAddMemberViaGroup {groupId :: GroupId, viaGroupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole} | APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter} - | APIAcceptMember {groupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole} + | APIAcceptMember {groupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole, screeningApproval :: Bool} | APIDeleteMemberSupportChat GroupId GroupMemberId | APIMembersRole {groupId :: GroupId, groupMemberIds :: NonEmpty GroupMemberId, memberRole :: GroupMemberRole} | APIBlockMembersForAll {groupId :: GroupId, groupMemberIds :: NonEmpty GroupMemberId, blocked :: Bool} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index fee1a8e4d9..e3f9d84fd9 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2919,7 +2919,7 @@ processChatCommand cxt nm = \case e -> eToView e pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing Left ct -> throwChatError $ CEContactNotActive ct - APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do + APIAcceptMember groupId gmId role screeningApproval -> withUser $ \user@User {userId} -> do (g@(GIK gInfo _), m) <- withFastStore $ \db -> (,) <$> getGroupInfoKeys db cxt user groupId <*> getGroupMemberById db cxt user gmId -- same rule as role change (moderators grant up to member); pending member's role is a stand-in, so treat it as member assertUserGroupRole gInfo $ roleRequiredToChange GRMember role @@ -2950,6 +2950,8 @@ processChatCommand cxt nm = \case createInternalChatItem user (CDGroupSnd gInfo' scopeInfo) (CISndGroupEvent gEvent) Nothing pure $ CRMemberAccepted user gInfo' m' Nothing -> throwChatError CEGroupMemberNotActive + -- admitting past review is a moderator decision, not a screening one (e.g. directory bot captcha) + GSMemPendingReview | screeningApproval -> pure $ CRMemberAccepted user gInfo m GSMemPendingReview -> do let scope = Just $ GCSMemberSupport $ Just (groupMemberId' m) modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo @@ -3300,7 +3302,7 @@ processChatCommand cxt nm = \case JoinGroup gName enableNtfs -> withUser $ \user -> do groupId <- withFastStore $ \db -> getGroupIdByName db user gName processChatCommand cxt nm $ APIJoinGroup groupId enableNtfs - AcceptMember gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIAcceptMember gId gMemberId memRole + AcceptMember gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIAcceptMember gId gMemberId memRole False MemberRole gName gMemberName memRole -> withMemberName gName gMemberName $ \gId gMemberId -> APIMembersRole gId [gMemberId] memRole BlockForAll gName gMemberName blocked -> withMemberName gName gMemberName $ \gId gMemberId -> APIBlockMembersForAll gId [gMemberId] blocked RemoveMembers gName gMemberNames withMessages -> withUser $ \user -> do @@ -6416,7 +6418,7 @@ chatCommandP = "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_add #" *> (APIAddMemberViaGroup <$> A.decimal <* " #" <*> A.decimal <* A.space <*> A.decimal <*> memberRole), "/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI - "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole), + "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole <*> (" screening=" *> onOffP <|> pure False)), "/_delete member chat #" *> (APIDeleteMemberSupportChat <$> A.decimal <* A.space <*> A.decimal), "/_member role #" *> (APIMembersRole <$> A.decimal <*> _strP <*> memberRole), "/_block #" *> (APIBlockMembersForAll <$> A.decimal <*> _strP <* " blocked=" <*> onOffP), diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 22d73f72ea..40a39ca73a 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -85,6 +85,7 @@ directoryServiceTests = do it "should make joining members observers in all groups with --always-observer" testAlwaysObserver it "should require admin review in all groups with --knocking" testKnocking it "should ask member to pass captcha screen" testCapthaScreening + it "should hold captcha-passing member for admin review when admission=all" testCaptchaWithReview it "should send voice captcha on /audio command" testVoiceCaptchaScreening it "should retry with voice captcha after switching to audio mode" testVoiceCaptchaRetry it "should send voice captcha when voice disabled but client supports v17" testVoiceCaptchaVoiceDisabled @@ -1433,6 +1434,38 @@ testCapthaScreening ps = cath <## " Correct, you joined the group privacy" cath <## "#privacy: you joined the group" +testCaptchaWithReview :: HasCallStack => TestParams -> IO () +testCaptchaWithReview ps = + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + bob ##> "/g privacy Privacy" + bob <## "group #privacy (Privacy) is created" + bob <## "to add members use /a privacy or /create link #privacy" + bob ##> "/set admission review #privacy all" + bob <## "changed member admission rules" + bob ##> "/a privacy 'SimpleX Directory' admin" + bob <## "invitation to join the group #privacy sent to 'SimpleX Directory'" + groupAccepted bob "privacy" 1 + welcomeWithLink <- completeRegistration superUser bob "privacy" "Privacy" 1 + let groupLink = dropStrPrefix "Link to join the group privacy: " welcomeWithLink + cath ##> ("/c " <> groupLink) + cath <## "connection request sent!" + cath <## "#privacy: joining the group..." + cath <## "#privacy: you joined the group, pending approval" + cath <# "#privacy (support) 'SimpleX Directory'> Captcha is generated by SimpleX Directory service." + cath <## "" + cath <## "Send captcha text to join the group privacy." + captcha <- dropStrPrefix "#privacy (support) 'SimpleX Directory'> " . dropTime <$> getTermLine cath + cath #> ("#privacy (support) " <> captcha) + cath <# ("#privacy (support) 'SimpleX Directory'!> > cath " <> captcha) + cath <## " Correct, you joined the group privacy" + cath <## "#privacy: 'SimpleX Directory' accepted you to the group, pending review" + cath <## "#privacy: member bob (Bob) is connected" + bob <## "#privacy: 'SimpleX Directory' added cath (Catherine) to the group (connecting and pending review...), use /_accept member #1 3 to accept member" + bob <## "#privacy: new member cath is connected and pending review, use /_accept member #1 3 to accept member" + testVoiceCaptchaScreening :: HasCallStack => TestParams -> IO () testVoiceCaptchaScreening ps@TestParams {tmpPath} = do let mockScript = tmpPath "mock_voice_gen.py" diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 521fc44d9a..98054244c9 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -141,6 +141,7 @@ chatGroupTests = do it "accept member - host approval, then moderators review" testGLinkApproveThenReviewMember it "delete pending approval member" testGLinkDeletePendingApprovalMember it "admin that joined via link introduces member for moderator review" testGLinkReviewIntroduce + it "screening approval does not admit member past review" testScreeningApprovalKeepsReview describe "group link connection plan" $ do it "ok to connect; known group" testPlanGroupLinkKnown it "own group link" testPlanGroupLinkOwn @@ -4135,6 +4136,66 @@ testGLinkReviewIntroduce = eve #> "#team 5" [alice, bob, cath, dan] *<# "#team eve> 5" +testScreeningApprovalKeepsReview :: HasCallStack => TestParams -> IO () +testScreeningApprovalKeepsReview = + testChat5 aliceProfile bobProfile cathProfile danProfile eveProfile $ + \alice bob cath dan eve -> do + createGroup4 "team" alice (bob, GRMember) (cath, GRModerator) (dan, GRModerator) + alice ##> "/set admission review #team all" + alice <## "changed member admission rules" + concurrentlyN_ + [ do + bob <## "alice updated group #team: (signed)" + bob <## "changed member admission rules", + do + cath <## "alice updated group #team: (signed)" + cath <## "changed member admission rules", + do + dan <## "alice updated group #team: (signed)" + dan <## "changed member admission rules" + ] + alice ##> "/create link #team" + gLink <- getGroupLink alice "team" GRMember True + eve ##> ("/c " <> gLink) + eve <## "connection request sent!" + alice <## "eve (Eve): accepting request to join group #team..." + concurrentlyN_ + [ alice <## "#team: eve connected and pending review", + eve + <### [ "#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" + ], + do + cath <## "#team: alice added eve (Eve) to the group (connecting and pending review...), use /_accept member #1 5 to accept member" + cath <## "#team: new member eve is connected and pending review, use /_accept member #1 5 to accept member", + do + dan <## "#team: alice added eve (Eve) to the group (connecting and pending review...), use /_accept member #1 5 to accept member" + dan <## "#team: new member eve is connected and pending review, use /_accept member #1 5 to accept member" + ] + alice ##> "/_accept member #1 5 member screening=on" + alice <## "#team: eve accepted and pending review (will introduce moderators)" + eve ##> "#team hi" + eve <## "bad chat command: not current member" + (bob "/_accept member #1 5 member" + concurrentlyN_ + [ alice <## "#team: eve accepted", + cath <## "#team: alice accepted eve to the group", + dan <## "#team: alice accepted eve to the group", + eve + <### [ "#team: you joined the group", + "#team: member bob (Bob) is connected" + ], + do + bob <## "#team: alice added eve (Eve) to the group (connecting...)" + bob <## "#team: new member eve is connected" + ] + eve #> "#team hello" + [alice, bob, cath, dan] *<# "#team eve> hello" + testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO () testPlanGroupLinkKnown = testChat2 aliceProfile bobProfile $