Allow Legalhold for large teams (>2000)

services/galley/src/Galley/API/Error.hs

@@ -153,7 +153,7 @@ tooManyTeamMembers :: Error
 tooManyTeamMembers = Error status403 "too-many-team-members" "Maximum number of members per team reached"
 
 tooManyTeamMembersOnTeamWithLegalhold :: Error
-tooManyTeamMembersOnTeamWithLegalhold = Error status403 "too-many-members-for-legalhold" "cannot add more members to team legalhold service is enabled."
+tooManyTeamMembersOnTeamWithLegalhold = Error status403 "too-many-members-for-legalhold" "cannot add more members to team when legalhold service is enabled."
 
 teamMemberNotFound :: Error
 teamMemberNotFound = Error status404 "no-team-member" "team member not found"
@@ -206,6 +206,9 @@ legalHoldFeatureFlagNotEnabled = Error status403 "legalhold-not-enabled" "legal
 legalHoldNotEnabled :: Error
 legalHoldNotEnabled = Error status403 "legalhold-not-enabled" "legal hold is not enabled for this team"
 
+legalHoldDisableUnimplemented :: Error
+legalHoldDisableUnimplemented = Error status403 "legalhold-disable-unimplemented" "legal hold cannot be disabled for whitelisted teams"
+
 userLegalHoldAlreadyEnabled :: Error
 userLegalHoldAlreadyEnabled = Error status409 "legalhold-already-enabled" "legal hold is already enabled for this user"
 

services/galley/src/Galley/API/LegalHold.hs

@@ -133,6 +133,7 @@ removeSettingsH (zusr ::: tid ::: req ::: _) = do
 
 removeSettings :: UserId -> TeamId -> Public.RemoveLegalHoldSettingsRequest -> Galley ()
 removeSettings zusr tid (Public.RemoveLegalHoldSettingsRequest mPassword) = do
+  assertNotWhitelisting
   assertLegalHoldEnabledForTeam tid
   zusrMembership <- Data.teamMember tid zusr
   -- let zothers = map (view userId) membs
@@ -142,6 +143,14 @@ removeSettings zusr tid (Public.RemoveLegalHoldSettingsRequest mPassword) = do
   void $ permissionCheck ChangeLegalHoldTeamSettings zusrMembership
   ensureReAuthorised zusr mPassword
   removeSettings' tid
+  where
+    assertNotWhitelisting :: Galley ()
+    assertNotWhitelisting = do
+      view (options . Opts.optSettings . Opts.setFeatureFlags . flagLegalHold) >>= \case
+        FeatureLegalHoldDisabledPermanently -> pure ()
+        FeatureLegalHoldDisabledByDefault -> pure ()
+        FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do
+          throwM legalHoldDisableUnimplemented
 
 -- | Remove legal hold settings from team; also disabling for all users and removing LH devices
 removeSettings' ::

services/galley/src/Galley/API/Teams.hs

@@ -53,6 +53,8 @@ module Galley.API.Teams
     canUserJoinTeamH,
     internalDeleteBindingTeamWithOneMemberH,
     internalDeleteBindingTeamWithOneMember,
+    ensureNotTooLargeForLegalHold,
+    ensureNotTooLargeToActivateLegalHold,
   )
 where
 
@@ -94,6 +96,7 @@ import qualified Galley.Intra.Spar as Spar
 import qualified Galley.Intra.Team as BrigTeam
 import Galley.Intra.User
 import Galley.Options
+import qualified Galley.Options as Opts
 import qualified Galley.Queue as Q
 import Galley.Types (UserIdList (UserIdList))
 import qualified Galley.Types as Conv
@@ -572,9 +575,9 @@ addTeamMember zusr zcon tid nmem = do
   ensureNonBindingTeam tid
   ensureUnboundUsers [uid]
   ensureConnectedToLocals zusr [uid]
+  (TeamSize sizeBeforeJoin) <- BrigTeam.getSize tid
+  ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
   memList <- Data.teamMembersForFanout tid
-  -- FUTUREWORK: We cannot enable legalhold on large teams right now
-  ensureNotTooLargeForLegalHold tid memList
   void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem memList
 
 -- This function is "unchecked" because there is no need to check for user binding (invite only).
@@ -587,8 +590,8 @@ uncheckedAddTeamMemberH (tid ::: req ::: _) = do
 uncheckedAddTeamMember :: TeamId -> NewTeamMember -> Galley ()
 uncheckedAddTeamMember tid nmem = do
   mems <- Data.teamMembersForFanout tid
-  -- FUTUREWORK: We cannot enable legalhold on large teams right now
-  ensureNotTooLargeForLegalHold tid mems
+  (TeamSize sizeBeforeJoin) <- BrigTeam.getSize tid
+  ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
   (TeamSize sizeBeforeAdd) <- addTeamMemberInternal tid Nothing Nothing nmem mems
   billingUserIds <- Journal.getBillingUserIds tid $ Just $ newTeamMemberList ((nmem ^. ntmNewTeamMember) : mems ^. teamMembers) (mems ^. teamMemberListType)
   Journal.teamUpdate tid (sizeBeforeAdd + 1) billingUserIds
@@ -856,16 +859,38 @@ ensureNotTooLarge tid = do
     throwM tooManyTeamMembers
   return $ TeamSize size
 
--- FUTUREWORK: Large teams cannot have legalhold enabled, needs rethinking
---             due to the expensive operation of removing settings
-ensureNotTooLargeForLegalHold :: TeamId -> TeamMemberList -> Galley ()
-ensureNotTooLargeForLegalHold tid mems = do
-  limit <- fromIntegral . fromRange <$> fanoutLimit
-  when (length (mems ^. teamMembers) >= limit) $ do
-    lhEnabled <- isLegalHoldEnabledForTeam tid
-    when lhEnabled $
+-- | Ensure that a team doesn't exceed the member count limit for the LegalHold
+-- feature. A team with more members than the fanout limit is too large, because
+-- the fanout limit would prevent turning LegalHold feature _off_ again (for
+-- details see 'Galley.API.LegalHold.removeSettings').
+--
+-- If LegalHold is configured for whitelisted teams only we consider the team
+-- size unlimited, because we make the assumption that these teams won't turn
+-- LegalHold off after activation.
+-- FUTUREWORK: Find a way around the fanout limit.
+ensureNotTooLargeForLegalHold :: TeamId -> Int -> Galley ()
+ensureNotTooLargeForLegalHold tid teamSize = do
+  whenM (isLegalHoldEnabledForTeam tid) $ do
+    unlessM (teamSizeBelowLimit teamSize) $ do
       throwM tooManyTeamMembersOnTeamWithLegalhold
 
+ensureNotTooLargeToActivateLegalHold :: TeamId -> Galley ()
+ensureNotTooLargeToActivateLegalHold tid = do
+  (TeamSize teamSize) <- BrigTeam.getSize tid
+  unlessM (teamSizeBelowLimit (fromIntegral teamSize)) $ do
+    throwM cannotEnableLegalHoldServiceLargeTeam
+
+teamSizeBelowLimit :: Int -> Galley Bool
+teamSizeBelowLimit teamSize = do
+  limit <- fromIntegral . fromRange <$> fanoutLimit
+  let withinLimit = teamSize <= limit
+  view (options . Opts.optSettings . Opts.setFeatureFlags . flagLegalHold) >>= \case
+    FeatureLegalHoldDisabledPermanently -> pure withinLimit
+    FeatureLegalHoldDisabledByDefault -> pure withinLimit
+    FeatureLegalHoldWhitelistTeamsAndImplicitConsent ->
+      -- unlimited, see docs of 'ensureNotTooLargeForLegalHold'
+      pure True
+
 addTeamMemberInternal :: TeamId -> Maybe UserId -> Maybe ConnId -> NewTeamMember -> TeamMemberList -> Galley TeamSize
 addTeamMemberInternal tid origin originConn (view ntmNewTeamMember -> new) memList = do
   Log.debug $
@@ -956,15 +981,9 @@ canUserJoinTeamH tid = canUserJoinTeam tid >> pure empty
 canUserJoinTeam :: TeamId -> Galley ()
 canUserJoinTeam tid = do
   lhEnabled <- isLegalHoldEnabledForTeam tid
-  when (lhEnabled) $
-    checkTeamSize
-  where
-    checkTeamSize = do
-      (TeamSize size) <- BrigTeam.getSize tid
-      limit <- fromIntegral . fromRange <$> fanoutLimit
-      -- Teams larger than fanout limit cannot use legalhold
-      when (size >= limit) $ do
-        throwM tooManyTeamMembersOnTeamWithLegalhold
+  when lhEnabled $ do
+    (TeamSize sizeBeforeJoin) <- BrigTeam.getSize tid
+    ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
 
 getTeamSearchVisibilityAvailableInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
 getTeamSearchVisibilityAvailableInternal tid = do

services/galley/src/Galley/API/Teams/Features.hs

@@ -35,22 +35,20 @@ module Galley.API.Teams.Features
   )
 where
 
-import Brig.Types.Team (TeamSize (..))
 import Control.Lens
 import Control.Monad.Catch
 import qualified Data.Aeson as Aeson
 import Data.ByteString.Conversion hiding (fromList)
 import Data.Id
-import Data.Range as Range
 import Data.String.Conversions (cs)
 import Galley.API.Error as Galley
 import Galley.API.LegalHold
+import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold)
 import Galley.API.Util
 import Galley.App
 import qualified Galley.Data as Data
 import qualified Galley.Data.SearchVisibility as SearchVisibilityData
 import qualified Galley.Data.TeamFeatures as TeamFeatures
-import qualified Galley.Intra.Team as BrigTeam
 import Galley.Options
 import Galley.Types.Teams hiding (newTeam)
 import Imports
@@ -204,15 +202,9 @@ setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do
         throwM legalHoldWhitelistedOnly
   case statusValue of
     Public.TeamFeatureDisabled -> removeSettings' tid
-    -- FUTUREWORK: We cannot enable legalhold on large teams right now
-    Public.TeamFeatureEnabled -> checkTeamSize
+    Public.TeamFeatureEnabled -> do
+      ensureNotTooLargeToActivateLegalHold tid
   TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status
-  where
-    checkTeamSize = do
-      (TeamSize size) <- BrigTeam.getSize tid
-      limit <- fromIntegral . fromRange <$> fanoutLimit
-      when (size > limit) $ do
-        throwM cannotEnableLegalHoldServiceLargeTeam
 
 getAppLockInternal :: TeamId -> Galley (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock)
 getAppLockInternal tid = do

services/galley/test/integration/API/Teams/LegalHold.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
-
 -- This file is part of the Wire Server implementation.
 --
 -- Copyright (C) 2020 Wire Swiss GmbH <[email protected]>
@@ -18,6 +17,7 @@
 --
 -- You should have received a copy of the GNU Affero General Public License along
 -- with this program. If not, see <https://www.gnu.org/licenses/>.
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 module API.Teams.LegalHold
   ( tests,
@@ -111,6 +111,26 @@ onlyIfLhEnabled action = do
         "`FeatureLegalHoldWhitelistTeamsAndImplicitConsent` requires setting up a mock galley \
         \with `withLHWhitelist`; don't call `onlyIfLhEnabled` if you do that, that's redundant."
 
+onlyIfLhWhitelisted :: TestM () -> TestM ()
+onlyIfLhWhitelisted action = do
+  featureLegalHold <- view (tsGConf . optSettings . setFeatureFlags . flagLegalHold)
+  case featureLegalHold of
+    FeatureLegalHoldDisabledPermanently ->
+      liftIO $
+        hPutStrLn
+          stderr
+          "*** skipping test. This test only works if you manually adjust the server config files\
+          \(the 'withLHWhitelist' trick does not work because it does not allow \
+          \brig to talk to the dynamically spawned galley)."
+    FeatureLegalHoldDisabledByDefault ->
+      liftIO $
+        hPutStrLn
+          stderr
+          "*** skipping test. This test only works if you manually adjust the server config files\
+          \(the 'withLHWhitelist' trick does not work because it does not allow \
+          \brig to talk to the dynamically spawned galley)."
+    FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> action
+
 tests :: IO TestSetup -> TestTree
 tests s =
   -- See also Client Tests in Brig; where behaviour around deleting/adding LH clients is tested
@@ -132,7 +152,9 @@ tests s =
       -- behavior of existing end-points
       test s "POST /clients" (onlyIfLhEnabled testCannotCreateLegalHoldDeviceOldAPI),
       test s "GET /teams/{tid}/members" (onlyIfLhEnabled testGetTeamMembersIncludesLHStatus),
-      test s "POST /register - cannot add team members with LH - too large" (onlyIfLhEnabled testAddTeamUserTooLargeWithLegalhold),
+      test s "POST /register - cannot add team members above fanout limit" (onlyIfLhEnabled testAddTeamUserTooLargeWithLegalhold),
+      -- test s "POST /register - Enable this to create a test team for next test" (testAddTeamUserTooLargeWithLegalholdWhitelisted Nothing),
+      -- test s "POST /register - can add team members above fanout limit when whitelisting is enabled" (testAddTeamUserTooLargeWithLegalholdWhitelisted (Just (read "86bd1ba6-6c29-4d3b-af54-579c5e9b1fa3", read "310b550d-3832-47cc-b6dc-50d979879985"))),
       test s "GET legalhold status in user profile" testGetLegalholdStatus,
       {- TODO:
           conversations/{cnv}/otr/messages - possibly show the legal hold device (if missing) as a different device type (or show that on device level, depending on how client teams prefer)
@@ -642,7 +664,9 @@ testEnablePerTeamTooLarge :: TestM ()
 testEnablePerTeamTooLarge = do
   o <- view tsGConf
   let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimit o
-  (tid, _owner, _others) <- createBindingTeamWithMembers (fanoutLimit + 1)
+  -- TODO: it is impossible in this test to create teams bigger than the fanout limit.
+  -- Change the +1 to anything else and look at the logs
+  (tid, _owner, _others) <- createBindingTeamWithMembers (fanoutLimit + 5)
 
   status :: Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold <- responseJsonUnsafe <$> (getEnabled tid <!! testResponse 200 Nothing)
   let statusValue = Public.tfwoStatus status
@@ -667,6 +691,44 @@ testAddTeamUserTooLargeWithLegalhold = do
     const 403 === statusCode
     const (Just "too-many-members-for-legalhold") === fmap Error.label . responseJsonMaybe
 
+-- | This test only works if you manually adjust the server config files (the 'withLHWhitelist' trick does not work because it does not allow brig to talk to the dynamically spawned galley).
+-- This test is weird: we can't use 'withLHWhitelist', since we need brig to call the galley with the changed settings; and we wan't even run it fully after updating the galley settings, but we need to add the team id of a team we create to the settings in between.
+--
+-- So the test consists of two parts: (1) create and populate a team and return owner id and team id; (2) take owner id and team id as arguments and run the test with galley restarted on the changed settings.
+--
+-- As a consequence, this test needs to be stay disabled in the automatic integration tests, but it can do its things with a little bit of manual work:
+--
+-- (a) run the first phase
+-- (b) change services/brig/brig.integration.yaml as follows
+-- -  setMaxTeamSize: 32
+-- +  setMaxTeamSize: 100000
+--     change services/galley/galley.integration.yaml as follows:
+-- @@ settings:
+-- -  maxTeamSize: 32
+-- +  maxTeamSize: 100000
+-- +  legalHoldTeamsWhitelist: [<team id generate in (1)>]
+-- +
+-- -    legalhold: disabled-by-default
+-- +    legalhold: whitelist-teams-and-implicit-consent
+-- (c) run the second phase with the arguemnts returned in the first phase.
+testAddTeamUserTooLargeWithLegalholdWhitelisted :: HasCallStack => Maybe (UserId, TeamId) -> TestM ()
+testAddTeamUserTooLargeWithLegalholdWhitelisted Nothing = do
+  o <- view tsGConf
+  (owner, tid) <- createBindingTeam
+  let fanoutLimit = fromIntegral @_ @Integer . fromRange $ Galley.currentFanoutLimit o
+  forM_ [2 .. fanoutLimit] $ \_n -> do
+    addUserToTeam' owner tid !!! do
+      const 201 === statusCode
+  error $
+    ( "**** testAddTeamUserTooLargeWithLegalholdWhitelisted. Created (owner, tid):  " <> show (owner, tid)
+        <> " Use these values to run the test."
+    )
+testAddTeamUserTooLargeWithLegalholdWhitelisted (Just (owner, tid)) = onlyIfLhWhitelisted $ do
+  replicateM_ 40 $ do
+    addUserToTeam' owner tid !!! do
+      const 201 === statusCode
+  ensureQueueEmpty
+
 testCannotCreateLegalHoldDeviceOldAPI :: TestM ()
 testCannotCreateLegalHoldDeviceOldAPI = do
   member <- randomUser