Add supportedProtocols field to mls feature config

changelog.d/0-release-notes/supported-protocols

@@ -0,0 +1,10 @@
+New field for Supported protocols in Galley's MLS feature config
+
+Galley will refuse to start if the list `supportedProtocols` does not contain
+the value of the field `defaultProtocol`. Galley will also refuse to start if
+MLS migration is enabled and MLS is not part of `supportedProtocols`.
+
+The default value for `supportedProtocols` is:
+```
+[proteus, mls]
+```

charts/galley/values.yaml

@@ -71,6 +71,7 @@ config:
             defaultProtocol: proteus
             allowedCipherSuites: [1]
             defaultCipherSuite: 1
+            supportedProtocols: [proteus, mls] # must contain defaultProtocol
       searchVisibilityInbound:
         defaults:
           status: disabled

libs/wire-api/src/Wire/API/Conversation/Protocol.hs

@@ -50,7 +50,7 @@ import Wire.API.MLS.SubConversation
 import Wire.Arbitrary
 
 data ProtocolTag = ProtocolProteusTag | ProtocolMLSTag | ProtocolMixedTag
-  deriving stock (Eq, Show, Enum, Bounded, Generic)
+  deriving stock (Eq, Show, Enum, Ord, Bounded, Generic)
   deriving (Arbitrary) via GenericUniform ProtocolTag
 
 data ConversationMLSData = ConversationMLSData

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

@@ -343,6 +343,7 @@ data TeamFeatureError
   | LegalHoldWhitelistedOnly
   | DisableSsoNotImplemented
   | FeatureLocked
+  | MLSProtocolMismatch
 
 instance IsSwaggerError TeamFeatureError where
   -- Do not display in Swagger
@@ -372,6 +373,8 @@ type instance
 
 type instance MapError 'FeatureLocked = 'StaticError 409 "feature-locked" "Feature config cannot be updated (e.g. because it is configured to be locked, or because you need to upgrade your plan)"
 
+type instance MapError 'MLSProtocolMismatch = 'StaticError 400 "mls-protocol-mismatch" "The default protocol needs to be part of the supported protocols"
+
 type instance ErrorEffect TeamFeatureError = Error TeamFeatureError
 
 instance Member (Error DynError) r => ServerEffect (Error TeamFeatureError) r where
@@ -381,6 +384,7 @@ instance Member (Error DynError) r => ServerEffect (Error TeamFeatureError) r wh
     LegalHoldWhitelistedOnly -> dynError @(MapError 'LegalHoldWhitelistedOnly)
     DisableSsoNotImplemented -> dynError @(MapError 'DisableSsoNotImplemented)
     FeatureLocked -> dynError @(MapError 'FeatureLocked)
+    MLSProtocolMismatch -> dynError @(MapError 'MLSProtocolMismatch)
 
 --------------------------------------------------------------------------------
 -- Proposal failure

libs/wire-api/src/Wire/API/Team/Feature.hs

@@ -114,7 +114,7 @@ import Imports
 import Servant (FromHttpApiData (..), ToHttpApiData (..))
 import Test.QuickCheck.Arbitrary (arbitrary)
 import Test.QuickCheck.Gen (suchThat)
-import Wire.API.Conversation.Protocol (ProtocolTag (ProtocolProteusTag))
+import Wire.API.Conversation.Protocol
 import Wire.API.MLS.CipherSuite (CipherSuiteTag (MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519))
 import Wire.API.Routes.Named (RenderableSymbol (renderSymbol))
 import Wire.Arbitrary (Arbitrary, GenericUniform (..))
@@ -912,7 +912,8 @@ data MLSConfig = MLSConfig
   { mlsProtocolToggleUsers :: [UserId],
     mlsDefaultProtocol :: ProtocolTag,
     mlsAllowedCipherSuites :: [CipherSuiteTag],
-    mlsDefaultCipherSuite :: CipherSuiteTag
+    mlsDefaultCipherSuite :: CipherSuiteTag,
+    mlsSupportedProtocols :: [ProtocolTag]
   }
   deriving stock (Eq, Show, Generic)
   deriving (Arbitrary) via (GenericUniform MLSConfig)
@@ -928,11 +929,18 @@ instance ToSchema MLSConfig where
         <*> mlsDefaultProtocol .= field "defaultProtocol" schema
         <*> mlsAllowedCipherSuites .= field "allowedCipherSuites" (array schema)
         <*> mlsDefaultCipherSuite .= field "defaultCipherSuite" schema
+        <*> mlsSupportedProtocols .= field "supportedProtocols" (array schema)
 
 instance IsFeatureConfig MLSConfig where
   type FeatureSymbol MLSConfig = "mls"
   defFeatureStatus =
-    let config = MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+    let config =
+          MLSConfig
+            []
+            ProtocolProteusTag
+            [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519]
+            MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519
+            [ProtocolProteusTag, ProtocolMLSTag]
      in withStatus FeatureStatusDisabled LockStatusUnlocked config FeatureTTLUnlimited
   featureSingleton = FeatureSingletonMLSConfig
   objectSchema = field "config" schema

services/galley/galley.cabal

@@ -595,6 +595,7 @@ executable galley-schema
     V82_MLSSubconversation
     V83_MLSDraft17
     V84_TeamFeatureMlsMigration
+    V85_TeamFeatureSupportedProtocols
 
   hs-source-dirs:     schema/src
   default-extensions: TemplateHaskell

services/galley/schema/src/Run.hs

@@ -87,6 +87,7 @@ import qualified V81_TeamFeatureMlsE2EIdUpdate
 import qualified V82_MLSSubconversation
 import qualified V83_MLSDraft17
 import qualified V84_TeamFeatureMlsMigration
+import qualified V85_TeamFeatureSupportedProtocols
 
 main :: IO ()
 main = do
@@ -159,7 +160,8 @@ main = do
       V81_TeamFeatureMlsE2EIdUpdate.migration,
       V82_MLSSubconversation.migration,
       V83_MLSDraft17.migration,
-      V84_TeamFeatureMlsMigration.migration
+      V84_TeamFeatureMlsMigration.migration,
+      V85_TeamFeatureSupportedProtocols.migration
       -- When adding migrations here, don't forget to update
       -- 'schemaVersion' in Galley.Cassandra
       -- (see also docs/developer/cassandra-interaction.md)

services/galley/schema/src/V85_TeamFeatureSupportedProtocols.hs

@@ -0,0 +1,33 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2023 Wire Swiss GmbH <opensource@wire.com>
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- 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/>.
+
+module V85_TeamFeatureSupportedProtocols
+  ( migration,
+  )
+where
+
+import Cassandra.Schema
+import Imports
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 85 "Add feature config for supported protocols" $ do
+  schema'
+    [r| ALTER TABLE team_features ADD (
+          mls_supported_protocols set<int>
+        )
+     |]

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

@@ -360,12 +360,32 @@ instance SetFeatureConfig SearchVisibilityInboundConfig where
     updateSearchVisibilityInbound $ toTeamStatus tid wsnl
     persistAndPushEvent tid wsnl
 
-instance SetFeatureConfig MLSConfig
+instance SetFeatureConfig MLSConfig where
+  type SetConfigForTeamConstraints MLSConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r)
+  setConfigForTeam tid wsnl = do
+    mlsMigrationConfig <- getConfigForTeam @MlsMigrationConfig tid
+    unless
+      ( -- default protocol needs to be included in supported protocols
+        mlsDefaultProtocol (wssConfig wsnl) `elem` mlsSupportedProtocols (wssConfig wsnl)
+          -- when MLS migration is enabled, MLS needs to be enabled as well
+          && (wsStatus mlsMigrationConfig == FeatureStatusDisabled || wssStatus wsnl == FeatureStatusEnabled)
+      )
+      $ throw MLSProtocolMismatch
+    persistAndPushEvent tid wsnl
 
 instance SetFeatureConfig ExposeInvitationURLsToTeamAdminConfig
 
 instance SetFeatureConfig OutlookCalIntegrationConfig
 
 instance SetFeatureConfig MlsE2EIdConfig
 
-instance SetFeatureConfig MlsMigrationConfig
+instance SetFeatureConfig MlsMigrationConfig where
+  type SetConfigForTeamConstraints MlsMigrationConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r)
+  setConfigForTeam tid wsnl = do
+    mlsConfig <- getConfigForTeam @MlsMigrationConfig tid
+    unless
+      ( -- when MLS migration is enabled, MLS needs to be enabled as well
+        wssStatus wsnl == FeatureStatusDisabled || wsStatus mlsConfig == FeatureStatusEnabled
+      )
+      $ throw MLSProtocolMismatch
+    persistAndPushEvent tid wsnl

services/galley/src/Galley/App.hs

@@ -107,9 +107,11 @@ import System.Logger.Class
 import qualified System.Logger.Extended as Logger
 import qualified UnliftIO.Exception as UnliftIO
 import Util.Options
+import Wire.API.Conversation.Protocol
 import Wire.API.Error
 import Wire.API.Federation.Error
 import Wire.API.Routes.FederationDomainConfig
+import Wire.API.Team.Feature
 import qualified Wire.Sem.Logger
 import Wire.Sem.Random.IO
 
@@ -157,6 +159,13 @@ validateOptions l o = do
     (Nothing, Just _) -> error "RabbitMQ config is specified and federator is not, please specify both or none"
     (Just _, Nothing) -> error "Federator is specified and RabbitMQ config is not, please specify both or none"
     _ -> pure ()
+  let mlsFlag = o ^. optSettings . setFeatureFlags . Teams.flagMLS . Teams.unDefaults . Teams.unImplicitLockStatus
+      mlsConfig = wsConfig mlsFlag
+      migrationStatus = wsStatus $ o ^. optSettings . setFeatureFlags . Teams.flagMlsMigration . Teams.unDefaults
+  when (migrationStatus == FeatureStatusEnabled && ProtocolMLSTag `notElem` mlsSupportedProtocols mlsConfig) $
+    error "For starting MLS migration, MLS must be included in the supportedProtocol list"
+  unless (mlsDefaultProtocol mlsConfig `elem` mlsSupportedProtocols mlsConfig) $
+    error "The list 'settings.featureFlags.mls.supportedProtocols' must include the value in the field 'settings.featureFlags.mls.defaultProtocol'"
 
 createEnv :: Metrics -> Opts -> Logger -> IORef FederationDomainConfigs -> IO Env
 createEnv m o l r = do

services/galley/src/Galley/Cassandra.hs

@@ -20,4 +20,4 @@ module Galley.Cassandra (schemaVersion) where
 import Imports
 
 schemaVersion :: Int32
-schemaVersion = 84
+schemaVersion = 85

services/galley/src/Galley/Cassandra/TeamFeatures.hs

@@ -105,21 +105,22 @@ getFeatureConfig FeatureSingletonMLSConfig tid = do
   m <- retry x1 $ query1 select (params LocalQuorum (Identity tid))
   pure $ case m of
     Nothing -> Nothing
-    Just (status, defaultProtocol, protocolToggleUsers, allowedCipherSuites, defaultCipherSuite) ->
+    Just (status, defaultProtocol, protocolToggleUsers, allowedCipherSuites, defaultCipherSuite, supportedProtocols) ->
       WithStatusNoLock
         <$> status
         <*> ( MLSConfig
                 <$> maybe (Just []) (Just . C.fromSet) protocolToggleUsers
                 <*> defaultProtocol
                 <*> maybe (Just []) (Just . C.fromSet) allowedCipherSuites
                 <*> defaultCipherSuite
+                <*> maybe (Just []) (Just . C.fromSet) supportedProtocols
             )
         <*> Just FeatureTTLUnlimited
   where
-    select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe ProtocolTag, Maybe (C.Set UserId), Maybe (C.Set CipherSuiteTag), Maybe CipherSuiteTag)
+    select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe ProtocolTag, Maybe (C.Set UserId), Maybe (C.Set CipherSuiteTag), Maybe CipherSuiteTag, Maybe (C.Set ProtocolTag))
     select =
       "select mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \
-      \mls_default_ciphersuite from team_features where team_id = ?"
+      \mls_default_ciphersuite, mls_supported_protocols from team_features where team_id = ?"
 getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = do
   let q = query1 select (params LocalQuorum (Identity tid))
   retry x1 q <&> \case
@@ -205,7 +206,7 @@ setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLo
 setFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock)
 setFeatureConfig FeatureSingletonMLSConfig tid statusNoLock = do
   let status = wssStatus statusNoLock
-  let MLSConfig protocolToggleUsers defaultProtocol allowedCipherSuites defaultCipherSuite = wssConfig statusNoLock
+  let MLSConfig protocolToggleUsers defaultProtocol allowedCipherSuites defaultCipherSuite supportedProtocols = wssConfig statusNoLock
   retry x5 $
     write
       insert
@@ -216,14 +217,15 @@ setFeatureConfig FeatureSingletonMLSConfig tid statusNoLock = do
             defaultProtocol,
             C.Set protocolToggleUsers,
             C.Set allowedCipherSuites,
-            defaultCipherSuite
+            defaultCipherSuite,
+            C.Set supportedProtocols
           )
       )
   where
-    insert :: PrepQuery W (TeamId, FeatureStatus, ProtocolTag, C.Set UserId, C.Set CipherSuiteTag, CipherSuiteTag) ()
+    insert :: PrepQuery W (TeamId, FeatureStatus, ProtocolTag, C.Set UserId, C.Set CipherSuiteTag, CipherSuiteTag, C.Set ProtocolTag) ()
     insert =
       "insert into team_features (team_id, mls_status, mls_default_protocol, \
-      \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite) values (?, ?, ?, ?, ?, ?)"
+      \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite, mls_supported_protocols) values (?, ?, ?, ?, ?, ?, ?)"
 setFeatureConfig FeatureSingletonMlsE2EIdConfig tid status = do
   let statusValue = wssStatus status
       vex = verificationExpiration . wssConfig $ status