From 0415dfd0b0cff9f29ac00d29da4700b521ce121e Mon Sep 17 00:00:00 2001 From: Stefan Berthold Date: Mon, 23 Sep 2024 15:24:35 +0000 Subject: [PATCH] block bot whitelist if protocol is MLS --- integration/integration.cabal | 1 + integration/test/API/Brig.hs | 23 +++++ integration/test/Test/MLS/Services.hs | 95 +++++++++++++++++++ libs/wire-api/src/Wire/API/Error/Brig.hs | 3 + .../src/Wire/UserSubsystem/Error.hs | 4 +- services/brig/src/Brig/Provider/API.hs | 13 ++- .../brig/test/integration/API/Provider.hs | 22 +++-- 7 files changed, 149 insertions(+), 12 deletions(-) create mode 100644 integration/test/Test/MLS/Services.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index a4351796175..0310aea8db3 100644 --- a/integration/integration.cabal +++ b/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 diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index a40dddd3bd9..00349a1cfeb 100644 --- a/integration/test/API/Brig.hs +++ b/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) diff --git a/integration/test/Test/MLS/Services.hs b/integration/test/Test/MLS/Services.hs new file mode 100644 index 00000000000..5a1e7c616b7 --- /dev/null +++ b/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" diff --git a/libs/wire-api/src/Wire/API/Error/Brig.hs b/libs/wire-api/src/Wire/API/Error/Brig.hs index 7846f5c51f5..15ecfabe55c 100644 --- a/libs/wire-api/src/Wire/API/Error/Brig.hs +++ b/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" diff --git a/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs b/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs index 22b1a8e44ec..9166fbc4b73 100644 --- a/libs/wire-subsystems/src/Wire/UserSubsystem/Error.hs +++ b/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 diff --git a/services/brig/src/Brig/Provider/API.hs b/services/brig/src/Brig/Provider/API.hs index fcc674600f8..43ed62940b3 100644 --- a/services/brig/src/Brig/Provider/API.hs +++ b/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 diff --git a/services/brig/test/integration/API/Provider.hs b/services/brig/test/integration/API/Provider.hs index 275fee81150..8866a8c8b29 100644 --- a/services/brig/test/integration/API/Provider.hs +++ b/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