directory: option to set observer role by default (#7501)

* directory: set role

* role

* option

* shorter help

---------

Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>

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
       }

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

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