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.

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

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)),

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}

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),

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 <name> 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 <role> to accept member"
+        bob <## "#privacy: new member cath is connected and pending review, use /_accept member #1 3 <role> to accept member"
+
 testVoiceCaptchaScreening :: HasCallStack => TestParams -> IO ()
 testVoiceCaptchaScreening ps@TestParams {tmpPath} = do
   let mockScript = tmpPath </> "mock_voice_gen.py"

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 <role> to accept member"
+            cath <## "#team: new member eve is connected and pending review, use /_accept member #1 5 <role> to accept member",
+          do
+            dan <## "#team: alice added eve (Eve) to the group (connecting and pending review...), use /_accept member #1 5 <role> to accept member"
+            dan <## "#team: new member eve is connected and pending review, use /_accept member #1 5 <role> 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 </)
+      alice ##> "/_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 $