block bot whitelist if protocol is MLS

integration/integration.cabal

@@ -136,6 +136,7 @@ library
     Test.MLS.Message
     Test.MLS.Notifications
     Test.MLS.One2One
+    Test.MLS.Services
     Test.MLS.SubConversation
     Test.MLS.Unreachable
     Test.Notifications

integration/test/API/Brig.hs

@@ -820,3 +820,26 @@ upgradePersonalToTeam :: (HasCallStack, MakesValue user) => user -> String -> Ap
 upgradePersonalToTeam user name = do
   req <- baseRequest user Brig Versioned $ joinHttpPath ["upgrade-personal-to-team"]
   submit "POST" $ req & addJSONObject ["name" .= name, "icon" .= "default"]
+
+postServiceWhitelist ::
+  ( HasCallStack,
+    MakesValue user,
+    MakesValue tid,
+    MakesValue update
+  ) =>
+  user ->
+  tid ->
+  update ->
+  App Response
+postServiceWhitelist user tid update = do
+  tidStr <- asString tid
+  updateJson <- make update
+  req <-
+    baseRequest user Brig Versioned $
+      joinHttpPath
+        [ "teams",
+          tidStr,
+          "services",
+          "whitelist"
+        ]
+  submit "POST" (addJSON updateJson req)

integration/test/Test/MLS/Services.hs

@@ -0,0 +1,95 @@
+module Test.MLS.Services where
+
+import API.Brig
+import API.Common
+import API.GalleyInternal (patchTeamFeatureConfig)
+import SetupHelpers
+import Testlib.JSON
+import Testlib.Prelude
+
+testWhitelistUpdatePermissions :: (HasCallStack) => App ()
+testWhitelistUpdatePermissions = do
+  -- Create a team
+  (owner, tid, []) <- createTeam OwnDomain 1
+
+  -- Create a team admin
+  admin <- createTeamMemberWithRole owner tid "admin"
+
+  -- Create a service
+  email <- randomEmail
+  provider <- make <$> setupProvider owner def {newProviderEmail = email}
+  providerId <- provider %. "id" & asString
+  service <- make <$> newService OwnDomain providerId def
+
+  do
+    -- Check that a random user can't add the service to the whitelist
+    uid <- randomUser OwnDomain def
+    serviceId <- service %. "id" & asString
+    np <-
+      make
+        $ object
+          [ "id" .= serviceId,
+            "provider" .= providerId,
+            "whitelisted" .= True
+          ]
+    bindResponse (postServiceWhitelist uid tid np) $ \resp -> do
+      resp.status `shouldMatchInt` 403
+      (resp.jsonBody %. "label") `shouldMatch` Just "insufficient-permissions"
+
+  do
+    -- Check that a admin can add the service to the whitelist
+    serviceId <- service %. "id" & asString
+    np <-
+      make
+        $ object
+          [ "id" .= serviceId,
+            "provider" .= providerId,
+            "whitelisted" .= True
+          ]
+    postServiceWhitelist admin tid np >>= assertStatus 200
+
+  -- set team's defaultProtocol to MLS
+  mlsConfig <-
+    make
+      $ object
+        [ "config"
+            .= object
+              [ "allowedCipherSuites" .= [1 :: Int],
+                "defaultCipherSuite" .= (1 :: Int),
+                "defaultProtocol" .= "mls",
+                "protocolToggleUsers" .= ([] :: [String]),
+                "supportedProtocols" .= ["mls", "proteus"]
+              ],
+          "status" .= "enabled",
+          "ttl" .= "unlimited"
+        ]
+  patchTeamFeatureConfig OwnDomain tid "mls" mlsConfig >>= assertStatus 200
+
+  do
+    -- Check that a random user can't add the service to the whitelist
+    uid <- randomUser OwnDomain def
+    serviceId <- service %. "id" & asString
+    np <-
+      make
+        $ object
+          [ "id" .= serviceId,
+            "provider" .= providerId,
+            "whitelisted" .= True
+          ]
+    bindResponse (postServiceWhitelist uid tid np) $ \resp -> do
+      resp.status `shouldMatchInt` 409
+      (resp.jsonBody %. "label") `shouldMatch` Just "mls-services-not-allowed"
+
+  do
+    -- Check that a admin can't add the service to the whitelist
+    serviceId <- service %. "id" & asString
+    np <-
+      make
+        $ object
+          [ "id" .= serviceId,
+            "provider" .= providerId,
+            "whitelisted" .= True
+          ]
+    postServiceWhitelist admin tid np >>= \resp -> do
+      resp.status `shouldMatchInt` 409
+      (resp.jsonBody %. "label") `shouldMatch` Just "mls-services-not-allowed"

libs/wire-api/src/Wire/API/Error/Brig.hs

@@ -100,6 +100,7 @@ data BrigError
   | PropertyKeyTooLarge
   | PropertyValueTooLarge
   | UserAlreadyInATeam
+  | MLSServicesNotAllowed
 
 instance (Typeable (MapError e), KnownError (MapError e)) => IsSwaggerError (e :: BrigError) where
   addToOpenApi = addStaticErrorToSwagger @(MapError e)
@@ -298,3 +299,5 @@ type instance MapError 'PropertyKeyTooLarge = 'StaticError 403 "property-key-too
 type instance MapError 'PropertyValueTooLarge = 'StaticError 403 "property-value-too-large" "The property value is too large"
 
 type instance MapError 'UserAlreadyInATeam = 'StaticError 403 "user-already-in-a-team" "Switching teams is not allowed"
+
+type instance MapError 'MLSServicesNotAllowed = 'StaticError 409 "mls-services-not-allowed" "Services not allowed in MLS"

libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs

@@ -17,6 +17,7 @@ data UserSubsystemError
   | UserSubsystemInvalidHandle
   | UserSubsystemProfileNotFound
   | UserSubsystemInsufficientTeamPermissions
+  | UserSubsystemMLSServicesNotAllowed
   deriving (Eq, Show)
 
 userSubsystemErrorToHttpError :: UserSubsystemError -> HttpError
@@ -29,6 +30,7 @@ userSubsystemErrorToHttpError =
     UserSubsystemHandleExists -> errorToWai @E.HandleExists
     UserSubsystemInvalidHandle -> errorToWai @E.InvalidHandle
     UserSubsystemHandleManagedByScim -> errorToWai @E.HandleManagedByScim
-    UserSubsystemInsufficientTeamPermissions -> errorToWai @'E.InsufficientTeamPermissions
+    UserSubsystemInsufficientTeamPermissions -> errorToWai @E.InsufficientTeamPermissions
+    UserSubsystemMLSServicesNotAllowed -> errorToWai @E.MLSServicesNotAllowed
 
 instance Exception UserSubsystemError

services/brig/src/Brig/Provider/API.hs

@@ -88,6 +88,7 @@ import UnliftIO.Async (pooledMapConcurrentlyN_)
 import Wire.API.Conversation hiding (Member)
 import Wire.API.Conversation.Bot
 import Wire.API.Conversation.Bot qualified as Public
+import Wire.API.Conversation.Protocol
 import Wire.API.Conversation.Role
 import Wire.API.Error
 import Wire.API.Error.Brig qualified as E
@@ -289,6 +290,7 @@ beginPasswordReset (Public.PasswordReset target) = do
   let gen = mkVerificationCodeGen target
   (lift . liftSem $ createCode gen VerificationCode.PasswordReset (Retries 3) (Timeout 3600) (Just (toUUID pid))) >>= \case
     Left (CodeAlreadyExists code) ->
+      -- FUTUREWORK: use subsystem error
       throwE $ pwResetError (PasswordResetInProgress $ Just code.codeTTL)
     Right code ->
       lift $ sendPasswordResetMail target (code.codeKey) (code.codeValue)
@@ -609,11 +611,12 @@ updateServiceWhitelist ::
   Public.UpdateServiceWhitelist ->
   (Handler r) UpdateServiceWhitelistResp
 updateServiceWhitelist uid con tid upd = do
+  -- Preconditions
   guardSecondFactorDisabled (Just uid)
+  guardMLSNotDefault
   let pid = updateServiceWhitelistProvider upd
       sid = updateServiceWhitelistService upd
       newWhitelisted = updateServiceWhitelistStatus upd
-  -- Preconditions
   lift . liftSem $ ensurePermissions uid tid (Set.toList serviceWhitelistPermissions)
   _ <- wrapClientE (DB.lookupService pid sid) >>= maybeServiceNotFound
   -- Add to various tables
@@ -640,6 +643,14 @@ updateServiceWhitelist uid con tid upd = do
             )
       wrapClientE $ DB.deleteServiceWhitelist (Just tid) pid sid
       pure UpdateServiceWhitelistRespChanged
+  where
+    guardMLSNotDefault = lift . liftSem $ do
+      feat <- GalleyAPIAccess.getFeatureConfigForTeam @_ @Feature.MLSConfig tid
+      let defProtocol = feat.config.mlsDefaultProtocol
+      case defProtocol of
+        ProtocolProteusTag -> pure ()
+        ProtocolMLSTag -> throw UserSubsystemMLSServicesNotAllowed
+        ProtocolMixedTag -> throw UserSubsystemMLSServicesNotAllowed
 
 --------------------------------------------------------------------------------
 -- Bot API

services/brig/test/integration/API/Provider.hs

@@ -891,16 +891,18 @@ testWhitelistUpdatePermissions config db brig galley = do
   new <- defNewService config
   sid <- serviceId <$> addGetService brig pid new
   enableService brig pid sid
-  -- Check that a random user can't add it to the whitelist
-  _uid <- userId <$> randomUser brig
-  updateServiceWhitelist brig _uid tid (UpdateServiceWhitelist pid sid True) !!! do
-    const 403 === statusCode
-    const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe
-  -- Check that a member who's not a team admin also can't add it to the whitelist
-  _uid <- userId <$> Team.createTeamMember brig galley owner tid noPermissions
-  updateServiceWhitelist brig _uid tid (UpdateServiceWhitelist pid sid True) !!! do
-    const 403 === statusCode
-    const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe
+  do
+    -- Check that a random user can't add it to the whitelist
+    uid <- userId <$> randomUser brig
+    updateServiceWhitelist brig uid tid (UpdateServiceWhitelist pid sid True) !!! do
+      const 403 === statusCode
+      const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe
+  do
+    -- Check that a member who's not a team admin also can't add it to the whitelist
+    uid <- userId <$> Team.createTeamMember brig galley owner tid noPermissions
+    updateServiceWhitelist brig uid tid (UpdateServiceWhitelist pid sid True) !!! do
+      const 403 === statusCode
+      const (Just "insufficient-permissions") === fmap Error.label . responseJsonMaybe
   -- Check that a team admin can add and remove from the whitelist
   whitelistService brig admin tid pid sid
   dewhitelistService brig admin tid pid sid