diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 318fc210ee..e526540760 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -724,7 +724,9 @@ directoryServiceEvent st opts@DirectoryOpts {adminUsers, superUsers, serviceName gli_ <- join . eitherToMaybe <$> withDB' "getGroupLinkInfo" cc (\db -> getGroupLinkInfo db userId groupId) let role = if useMemberFilter image (makeObserver a) then GRObserver else maybe GRMember (\GroupLinkInfo {memberRole} -> memberRole) gli_ gmId = groupMemberId' m - sendChatCmd cc (APIAcceptMember groupId gmId role) >>= \case + -- screeningApproval = True: the bot's captcha approval may advance a member into admission + -- review but must never admit them past it - that is an explicit moderator/admin action + 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/plans/2026-06-29-fix-member-review-bypass-races.md b/plans/2026-06-29-fix-member-review-bypass-races.md new file mode 100644 index 0000000000..3bf45ea2dc --- /dev/null +++ b/plans/2026-06-29-fix-member-review-bypass-races.md @@ -0,0 +1,133 @@ +# Fix: directory bot admits members past admission review (`APIAcceptMember` intent conflation) + +Status: **root cause confirmed and fix validated.** The fix is a new +`screeningApproval` flag on `APIAcceptMember`; the regression test +`testScreeningApprovalKeepsReview` reproduces the bug (fails without the fix) and +passes with it. + +## 1. Problem (as reported) + +A plain **p2p** group has member admission `review = all`. A member joining via +the **SimpleX Directory** bot's invite link was **fully admitted without admin +review** — visible to everyone and able to send messages. It happened +**intermittently** (one member bypassed, the next were correctly held, then +another bypassed), **self-healed**, and stopped recently. Throughout, the group's +stored `member_admission` was **correctly `review=all`**, and the group had as few +as **one owner** on a current client. + +These facts jointly rule out any "`member_admission` was wiped" explanation (a +wipe would be permanent and affect everyone, not intermittent with the setting +staying correct). The setting was right; it simply wasn't *enforced* for some +approvals. + +## 2. Root cause (confirmed, file:line) + +`APIAcceptMember` (`Commands.hs`) performs **two different operations**, chosen +only by the member's **current** status: + +- `GSMemPendingApproval` (+ `GCInviteeMember`): apply the group's admission policy + — `review=all` ⇒ `introduceToModerators` + set `GSMemPendingReview` (advance to + admin review); no review ⇒ full admit. +- `GSMemPendingReview` (+ `GCInviteeMember`): `introduceToRemaining` + set + `GSMemConnected` — **full admission** (introduced to everyone → can send). This + is the explicit *moderator-approves-past-review* action. + +Authorization is only `assertUserGroupRole gInfo (max GRModerator role)`. The +**directory bot is a group admin**, so it is allowed to hit *either* branch. The +bot's `approvePendingMember` (`Directory/Service.hs`) calls the **same** +`APIAcceptMember` that human moderators use. The core re-reads the member fresh by +id, so if the member is **already `GSMemPendingReview`** at the instant the bot's +approval executes (e.g. a prior approval — the bot's own from a duplicate/queued +event, or a human owner's — already advanced them), the bot's *captcha* approval +silently runs the **full-admit branch**. + +This matches every reported fact: no wipe (setting stays `all`), p2p, one owner, +intermittent by timing, the **bot** is the actor, self-healing per member. + +Why it "stopped recently": upstream **#7180** added `--knocking`, which routes +joiners straight to `GSMemPendingReview` at join (`acceptMemberHook`), skipping the +`GSMemPendingApproval` stage — so the bot never issues the captcha approval that +could land on the full-admit branch. #7180 **masks** the defect operationally; it +does not fix the core conflation. + +## 3. The fix — intent separation + +Add `screeningApproval :: Bool` to `APIAcceptMember`: + +- **Bot passes `True`** (`Directory/Service.hs`). A screening approval may advance + a `GSMemPendingApproval` member per policy, but on a `GSMemPendingReview` member + it is a **no-op** — returns the member unchanged (still pending review). The bot + can therefore **never** admit past review. +- **Humans pass `False`** (CLI `/_accept member`, the `AcceptMember` shorthand, + the mobile/desktop apps). Full behaviour unchanged — a moderator can still admit + a pending-review member. + +Backward compatible: apps send `/_accept member #g m role` as a **string** +(`AppAPITypes.swift`), and the parser flag is optional (`screening=on`, default +off) — mirrors the existing `withMessages` pattern on `APIRemoveMembers`. + +Handler change (`Commands.hs`), one guarded alternative: +```haskell +GSMemPendingReview | screeningApproval -> pure $ CRMemberAccepted user gInfo m +GSMemPendingReview -> do ... -- unchanged full-admit for human moderators +``` + +This makes the bot **structurally incapable** of the bypass, independent of the +exact race that leaves a member at `GSMemPendingReview` before the bot's call, and +leaves human moderator approval untouched. + +## 4. Verification (done) + +`tests/ChatTests/Groups.hs` — `testScreeningApprovalKeepsReview`: a `review=all` +group, a joiner held pending review, then `/_accept member … screening=on`. +- **Fixed:** the member stays pending review — cannot send (`bad chat command: + not current member`) and is not introduced to the regular member (`bob`). `[✔]` +- **Reverted (guard removed):** the member is fully admitted — `bob` receives + `alice added eve to the group`, and the accept prints `eve accepted` instead of + `pending review`. `[✘]` — i.e. the test reproduces the reported bug. + +Then `/_accept member … ` (screening off) admits the member normally, confirming +the human path is unchanged. Existing review/accept flows +(`only moderators review`, `host approval then moderators review`, `introduces +member for moderator review`, `should hold captcha-passing member`) stay green. + +## 5. Files touched + +- `src/Simplex/Chat/Controller.hs` — `screeningApproval :: Bool` on `APIAcceptMember`. +- `src/Simplex/Chat/Library/Commands.hs` — handler guard on the pending-review + branch; `AcceptMember` shorthand passes `False`; parser adds optional + `screening=on` (default `False`). +- `apps/simplex-directory-service/src/Directory/Service.hs` — bot passes `True`. +- `tests/ChatTests/Groups.hs` — `testScreeningApprovalKeepsReview`. + +## 6. Investigation history — theories raised and ruled out + +Recorded so the reasoning isn't repeated. Each was proposed under partial evidence +and eliminated by a later fact: + +- **Command-path lost-update race** (concurrent profile edits clobber + `member_admission`). Real race; fix = `withGroupLock` on `APIAcceptMember` and + the profile-update commands (proven by `testConcurrentProfileUpdateKeepsReview` + via a test-only `groupProfileUpdateTestHook` seam). **Not this bug** — it would + wipe the setting permanently; the setting stayed correct. Kept as hardening. +- **Stale link-data overwrite** (`updateGroupFromLinkData` copying a stale link + snapshot over `member_admission`). Real for a *member* resolving another's stale + link; **ruled out for the bot** — the bot resolving its own link short-circuits + to `GLPOwnLink` and never calls `updateGroupFromLinkData`. Reverted. +- **Old-client owner clobber** (an owner on a pre-`groupKnockingVersion` client + broadcasting profiles without the field). Real gap; guarded in `xGrpInfo` + (`testOldOwnerCannotRevertReview`). **Ruled out for this incident** — one current + owner. Kept/dropped per PR scope. +- **Propagation lag / enable-time window.** Inherent to async messaging; one-time, + not recurring — doesn't match the intermittent pattern. + +## 7. Related, out of scope (separate work) + +- **TOB-35 (High): relay/channel pending-review subscribers receive history before + approval.** Same admission-enforcement area, different defect: the `useRelays'` + join branch (`Subscriber.hs`) runs `sendHistory` regardless of pending status. + Non-relay p2p is not affected (the p2p branch has explicit pending cases). + Separate security PR: guard `sendHistory` at the relay call site (and, + defensively, inside `sendHistory`, after reordering the approval-time callers). +- **Concurrent same-version owner edits** to the whole-profile blob remain + last-writer-wins (protocol-level field versioning, tracked separately). diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 48f4ec9eec..25090faae5 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -240,11 +240,14 @@ data ChatHooks = ChatHooks -- it is called before the event is sent to the user (or to the UI). eventHook :: Maybe (ChatController -> Either ChatError ChatEvent -> IO (Either ChatError ChatEvent)), -- acceptMember hook can be used to accept or reject member connecting via group link without API calls - acceptMember :: Maybe (GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))) + acceptMember :: Maybe (GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole))), + -- test-only seam run between the group profile read and write, used to widen + -- the lost-update window in concurrency tests; always Nothing in production. + groupProfileUpdateTestHook :: Maybe (IO ()) } defaultChatHooks :: ChatHooks -defaultChatHooks = ChatHooks Nothing Nothing Nothing Nothing Nothing +defaultChatHooks = ChatHooks Nothing Nothing Nothing Nothing Nothing Nothing data PresetServers = PresetServers { operators :: NonEmpty PresetOperator, @@ -435,7 +438,10 @@ data ChatCommand | APIGetConnNtfMessages (NonEmpty ConnMsgReq) | APIAddMember {groupId :: GroupId, contactId :: ContactId, memberRole :: GroupMemberRole} | APIJoinGroup {groupId :: GroupId, enableNtfs :: MsgFilter} - | APIAcceptMember {groupId :: GroupId, groupMemberId :: GroupMemberId, memberRole :: GroupMemberRole} + -- screeningApproval: a pre-review screening approval (e.g. directory bot captcha) - it may only + -- advance a pending-approval member per the group policy, never admit a member past admission review; + -- that (pending-review -> member) transition is an explicit moderator action (screeningApproval = False) + | 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 837317176f..a55b6209a6 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2721,7 +2721,7 @@ processChatCommand cxt nm = \case updateCIGroupInvitationStatus user g CIGISAccepted `catchAllErrors` eToView pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing Nothing -> throwChatError $ CEContactNotActive ct - APIAcceptMember groupId gmId role -> withUser $ \user@User {userId} -> do + APIAcceptMember groupId gmId role screeningApproval -> withUser $ \user@User {userId} -> withGroupLock "acceptMember" groupId $ do (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db cxt user groupId <*> getGroupMemberById db cxt user gmId assertUserGroupRole gInfo $ max GRModerator role case memberStatus m of @@ -2751,6 +2751,9 @@ processChatCommand cxt nm = \case createInternalChatItem user (CDGroupSnd gInfo' scopeInfo) (CISndGroupEvent gEvent) Nothing pure $ CRMemberAccepted user gInfo' m' Nothing -> throwChatError CEGroupMemberNotActive + -- a screening approval (e.g. directory bot) must not admit a member past admission review: + -- that is an explicit moderator action. Return the member unchanged (still pending review). + GSMemPendingReview | screeningApproval -> pure $ CRMemberAccepted user gInfo m GSMemPendingReview -> do let scope = Just $ GCSMemberSupport $ Just (groupMemberId' m) modMs <- withFastStore' $ \db -> getGroupModerators db cxt user gInfo @@ -3095,7 +3098,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 @@ -3129,7 +3132,7 @@ processChatCommand cxt nm = \case ListGroups cName_ search_ -> withUser $ \user@User {userId} -> do ct_ <- forM cName_ $ \cName -> withFastStore $ \db -> getContactByName db cxt user cName processChatCommand cxt nm $ APIListGroups userId (contactId' <$> ct_) search_ - APIUpdateGroupProfile groupId p' -> withUser $ \user -> do + APIUpdateGroupProfile groupId p' -> withUser $ \user -> withGroupLock "updateGroupProfile" groupId $ do gInfo <- withFastStore $ \db -> getGroupInfo db cxt user groupId runUpdateGroupProfile user gInfo p' UpdateGroupNames gName GroupProfile {displayName, fullName, shortDescr} -> @@ -3140,7 +3143,7 @@ processChatCommand cxt nm = \case updateGroupProfileByName gName $ \p -> p {description} ShowGroupDescription gName -> withUser $ \user -> CRGroupDescription user <$> withFastStore (\db -> getGroupInfoByName db cxt user gName) - APISetPublicGroupAccess gId access@PublicGroupAccess {groupDomainClaim = newClaim} -> withUser $ \user -> do + APISetPublicGroupAccess gId access@PublicGroupAccess {groupDomainClaim = newClaim} -> withUser $ \user -> withGroupLock "updateGroupProfile" gId $ do gInfo@GroupInfo {groupProfile = p@GroupProfile {publicGroup}} <- withStore $ \db -> getGroupInfo db cxt user gId case publicGroup of Just pg@PublicGroupProfile {groupLink, publicGroupAccess = existingAccess} -> do @@ -3993,9 +3996,14 @@ processChatCommand cxt nm = \case else markGroupCIsDeleted user gInfo chatScopeInfo items m deletedTs updateGroupProfileByName :: GroupName -> (GroupProfile -> GroupProfile) -> CM ChatResponse updateGroupProfileByName gName update = withUser $ \user -> do - gInfo@GroupInfo {groupProfile = p} <- withStore $ \db -> - getGroupIdByName db user gName >>= getGroupInfo db cxt user - runUpdateGroupProfile user gInfo $ update p + -- lock + read-modify-write in one critical section, otherwise a concurrent + -- profile update (another field edit, or inbound XGrpInfo) can clobber + -- fields like member_admission via lost update. + gId <- withStore $ \db -> getGroupIdByName db user gName + withGroupLock "updateGroupProfile" gId $ do + gInfo@GroupInfo {groupProfile = p} <- withStore $ \db -> getGroupInfo db cxt user gId + asks (groupProfileUpdateTestHook . chatHooks . config) >>= mapM_ liftIO + runUpdateGroupProfile user gInfo $ update p withCurrentCall :: ContactId -> (User -> Contact -> Call -> CM (Maybe Call)) -> CM ChatResponse withCurrentCall ctId action = do (user, ct) <- withStore $ \db -> do @@ -5357,7 +5365,7 @@ chatCommandP = "/_ntf conn messages " *> (APIGetConnNtfMessages <$> connMsgsP), "/_add #" *> (APIAddMember <$> 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 025bfe4f66..2b205d0c77 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -78,6 +78,7 @@ directoryServiceTests = do it "should require captcha in all groups with --always-captcha" testAlwaysCaptcha 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 @@ -1386,6 +1387,65 @@ testCapthaScreening ps = cath <## " Correct, you joined the group privacy" cath <## "#privacy: you joined the group" +-- Regression: group has member admission review = all (admins must review joiners), +-- AND the directory bot screens joiners with a captcha. After a member passes the captcha +-- the bot calls APIAcceptMember; the core must still hold them as pending review +-- (the bot's captcha approval must not bypass admin review). +testCaptchaWithReview :: HasCallStack => TestParams -> IO () +testCaptchaWithReview ps = + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + -- create group and enable admin review of all joiners BEFORE the bot joins, + -- so the bot never processes a profile change (avoids re-approval noise) + 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'" + welcomeWithLink <- groupAccepted bob "privacy" 1 + completeRegistration superUser bob "privacy" "Privacy" welcomeWithLink 1 + -- get group link + bob #> "@'SimpleX Directory' /role 1" + bob <# "'SimpleX Directory'> > /role 1" + bob <## " The initial member role for the group privacy is set to member" + bob <## "Send /'role 1 observer' to change it." + bob <## "" + note <- getTermLine bob + let groupLink = dropStrPrefix "Please note: it applies only to members joining via this link: " note + -- enable captcha + bob #> "@'SimpleX Directory' /filter 1 captcha" + bob <# "'SimpleX Directory'> > /filter 1 captcha" + -- captcha is enabled by default for new registrations, so this is a no-op confirm + bob <## " Spam filter settings for group privacy:" + bob <## "- reject long/inappropriate names: disabled" + bob <## "- pass captcha to join: enabled" + bob <## "" + bob <## "/'filter 1 name' - enable name filter" + bob <## "/'filter 1 name captcha' - enable both" + bob <## "/'filter 1 off' - disable filter" + -- cath joins, passes captcha + 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" + -- correct behavior: member is held for admin review, NOT fully admitted + cath <## "#privacy: 'SimpleX Directory' accepted you to the group, pending review" + cath <## "#privacy: member bob (Bob) is connected" -- connects to moderator (owner) for review + -- owner (bob) is prompted to review the member, confirming admin review applies + 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 18023ed12c..b7a8b356b5 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -29,7 +29,8 @@ import Data.Int (Int64) import Data.List (intercalate, isInfixOf, isSuffixOf) import qualified Data.Map.Strict as M import qualified Data.Text as T -import Simplex.Chat.Controller (ChatController (ChatController, smpAgent), ChatConfig (..), ChatHooks (..), ChatLogLevel (..), defaultChatHooks) +import Simplex.Chat.Controller (ChatCommand (SetGroupMemberAdmissionReview, ShowGroupProfile, UpdateGroupDescription), ChatController (ChatController, smpAgent), ChatConfig (..), ChatHooks (..), ChatLogLevel (..), ChatResponse (CRGroupProfile), defaultChatHooks) +import Simplex.Chat.Core (sendChatCmd) import Simplex.Chat.Library.Internal (uniqueMsgMentions, updatedMentionNames) import Simplex.Chat.Markdown (parseMaybeMarkdownList) import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId) @@ -129,6 +130,8 @@ 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 + it "concurrent profile updates keep member admission review (no lost update)" testConcurrentProfileUpdateKeepsReview describe "group link connection plan" $ do it "ok to connect; known group" testPlanGroupLinkKnown it "own group link" testPlanGroupLinkOwn @@ -3705,6 +3708,99 @@ testGLinkReviewIntroduce = eve #> "#team 5" [alice, bob, cath, dan] *<# "#team eve> 5" +-- Exercises the concurrency race the fix closes (Race A, lost update): two group +-- profile read-modify-writes run concurrently on one client — repeatedly enabling +-- member admission review, and repeatedly editing the description. Without the +-- group lock these interleave and a stale description write clobbers +-- member_admission, silently disabling review. With the lock they serialize and +-- review always survives. Deterministic on the fixed code; catches a missing lock. +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:" + bob <## "changed member admission rules", + do + cath <## "alice updated group #team:" + cath <## "changed member admission rules", + do + dan <## "alice updated group #team:" + 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" + ] + -- a screening approval (as the directory bot sends) must NOT admit past review: + -- eve stays pending review, is not introduced to regular members, and cannot send + 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" + +testConcurrentProfileUpdateKeepsReview :: HasCallStack => TestParams -> IO () +testConcurrentProfileUpdateKeepsReview = + testChatCfgOpts cfg testOpts aliceProfile $ \alice -> do + alice ##> "/g team" + alice <## "group #team is created" + alice <## "to add members use /a team or /create link #team" + let cc = chatController alice + -- Two group profile read-modify-writes race: enabling member admission review, + -- and editing the description. The test seam (groupProfileUpdateTestHook, a + -- 200ms delay between the profile read and write) makes the interleaving + -- deterministic: the review-set reads first; the description-update starts + -- 100ms later, reads the still-pre-review profile, and writes last. Without the + -- group lock that stale write clobbers member_admission (lost update); with the + -- lock the two serialize (the description-update blocks on the lock, re-reads + -- review=all, and preserves it), so review survives. + concurrently_ + (void $ sendChatCmd cc $ SetGroupMemberAdmissionReview "team" (Just MCAll)) + (threadDelay 100000 >> void (sendChatCmd cc $ UpdateGroupDescription "team" (Just "welcome"))) + Right (CRGroupProfile _ GroupInfo {groupProfile = GroupProfile {memberAdmission}}) <- + sendChatCmd cc $ ShowGroupProfile "team" + (memberAdmission >>= review) `shouldBe` Just MCAll + where + cfg = testCfg {chatHooks = defaultChatHooks {groupProfileUpdateTestHook = Just (threadDelay 200000)}} + testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO () testPlanGroupLinkKnown = testChat2 aliceProfile bobProfile $