diff --git a/apps/simplex-directory-service/src/Directory/Options.hs b/apps/simplex-directory-service/src/Directory/Options.hs index 89709e66d9..03f4d7bb0c 100644 --- a/apps/simplex-directory-service/src/Directory/Options.hs +++ b/apps/simplex-directory-service/src/Directory/Options.hs @@ -41,6 +41,7 @@ data DirectoryOpts = DirectoryOpts linkCheckInterval :: Int, prohibitedToObserver :: Bool, alwaysCaptcha :: Bool, + alwaysObserver :: Bool, knocking :: Bool, testing :: Bool } @@ -170,6 +171,11 @@ directoryOpts appDir defaultDbName = do ( long "always-captcha" <> help "Require a captcha from joining members in all groups, regardless of per-group filter settings" ) + alwaysObserver <- + switch + ( long "always-observer" + <> help "Make joining members observers in all groups, regardless of per-group setting in directory" + ) knocking <- switch ( long "knocking" @@ -197,6 +203,7 @@ directoryOpts appDir defaultDbName = do linkCheckInterval, prohibitedToObserver, alwaysCaptcha, + alwaysObserver, knocking, testing = False } diff --git a/apps/simplex-directory-service/src/Directory/Service.hs b/apps/simplex-directory-service/src/Directory/Service.hs index 61ed7e66af..b2a42c1eb2 100644 --- a/apps/simplex-directory-service/src/Directory/Service.hs +++ b/apps/simplex-directory-service/src/Directory/Service.hs @@ -268,7 +268,7 @@ directoryService opts cfg = do acceptMemberHook :: DirectoryOpts -> ServiceState -> GroupInfo -> GroupLinkInfo -> Profile -> IO (Either GroupRejectionReason (GroupAcceptance, GroupMemberRole)) acceptMemberHook - DirectoryOpts {profileNameLimit, alwaysCaptcha, knocking} + DirectoryOpts {profileNameLimit, alwaysCaptcha, alwaysObserver, knocking} ServiceState {blockedWordsCfg} g GroupLinkInfo {memberRole} @@ -279,7 +279,7 @@ acceptMemberHook if | knocking -> (GAPendingReview, memberRole) | alwaysCaptcha || useMemberFilter img (passCaptcha a) -> (GAPendingApproval, GRMember) - | useMemberFilter img (makeObserver a) -> (GAAccepted, GRObserver) + | alwaysObserver || useMemberFilter img (makeObserver a) -> (GAAccepted, GRObserver) | otherwise -> (GAAccepted, memberRole) where checkName :: ExceptT GroupRejectionReason IO () @@ -314,7 +314,7 @@ readBlockedWordsConfig DirectoryOpts {blockedFragmentsFile, blockedWordsFile, na pure BlockedWordsConfig {blockedFragments, blockedWords, extensionRules, spelling} directoryServiceEvent :: DirectoryOpts -> ServiceState -> User -> ChatController -> DirectoryEvent -> IO () -directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults, prohibitedToObserver, alwaysCaptcha} env@ServiceState {searchRequests} user@User {userId} cc = \case +directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, ownersGroup, searchResults, prohibitedToObserver, alwaysCaptcha, alwaysObserver} env@ServiceState {searchRequests} user@User {userId} cc = \case DEContactConnected ct -> deContactConnected ct DEGroupInvitation {contact = ct, groupInfo = g, fromMemberRole, memberRole} -> deGroupInvitation ct g fromMemberRole memberRole DEServiceJoinedGroup ctId g owner -> deServiceJoinedGroup ctId g owner @@ -678,7 +678,7 @@ directoryServiceEvent opts@DirectoryOpts {adminUsers, superUsers, serviceName, o approvePendingMember :: DirectoryMemberAcceptance -> GroupInfo -> GroupMember -> IO () approvePendingMember a g@GroupInfo {groupId} m@GroupMember {memberProfile = LocalProfile {displayName, image}} = do 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_ + 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 Right CRMemberAccepted {member} -> do diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index af92195f79..28b4e0d1bf 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -78,6 +78,7 @@ directoryServiceTests = do describe "member admission" $ do it "should require captcha by default for new groups" testCaptchaByDefault it "should require captcha in all groups with --always-captcha" testAlwaysCaptcha + 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 send voice captcha on /audio command" testVoiceCaptchaScreening @@ -144,6 +145,7 @@ mkDirectoryOpts TestParams {tmpPath = ps} superUsers ownersGroup webFolder = linkCheckInterval = 0, prohibitedToObserver = False, alwaysCaptcha = False, + alwaysObserver = False, knocking = False, testing = True } @@ -1258,6 +1260,34 @@ testAlwaysCaptcha ps = bob <## "#privacy: 'SimpleX Directory' added cath (Catherine) to the group (connecting...)" bob <## "#privacy: new member cath is connected" +testAlwaysObserver :: HasCallStack => TestParams -> IO () +testAlwaysObserver ps = + withDirectoryServiceOpts ps (\o -> o {alwaysObserver = True}) $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + bob `connectVia` dsLink + submitGroup bob "privacy" "Privacy" + 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: you joined the group" + cath <## "#privacy: member bob (Bob) is connected" + bob <## "#privacy: 'SimpleX Directory' added cath (Catherine) to the group (connecting...)" + bob <## "#privacy: new member cath is connected" + cath ##> "#privacy hello" + cath <## "#privacy: you don't have permission to send messages" + testKnocking :: HasCallStack => TestParams -> IO () testKnocking ps = withDirectoryServiceOpts ps (\o -> o {knocking = True}) $ \superUser dsLink ->