diff --git a/changelog.d/2-features/new-teams-mls b/changelog.d/2-features/new-teams-mls new file mode 100644 index 00000000000..97480b3bcc0 --- /dev/null +++ b/changelog.d/2-features/new-teams-mls @@ -0,0 +1 @@ +Add `initialConfig` setting for the `mls` feature flag diff --git a/docs/src/developer/reference/config-options.md b/docs/src/developer/reference/config-options.md index e6dc72bfa62..9808bfec21e 100644 --- a/docs/src/developer/reference/config-options.md +++ b/docs/src/developer/reference/config-options.md @@ -307,6 +307,19 @@ mls: This default configuration can be overriden on a per-team basis through the [feature config API](../developer/features.md) +This flag also supports setting an `initialConfig` value, which is applied when a team is created: + +```yaml +# galley.yaml +mls: + initialConfig: + protocolToggleUsers: [] + defaultProtocol: mls + supportedProtocols: [proteus, mls] # must contain defaultProtocol + allowedCipherSuites: [1] + defaultCipherSuite: 1 +``` + ### MLS End-to-End Identity The MLS end-to-end identity team feature adds an extra level of security and practicability. If turned on, automatic device authentication ensures that team members know they are communicating with people using authenticated devices. Team members get a certificate on all their devices. diff --git a/integration/integration.cabal b/integration/integration.cabal index 0688089db8c..a3989f28e76 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -130,6 +130,7 @@ library Test.FeatureFlags.EnforceFileDownloadLocation Test.FeatureFlags.FileSharing Test.FeatureFlags.GuestLinks + Test.FeatureFlags.Initialisation Test.FeatureFlags.LegalHold Test.FeatureFlags.Mls Test.FeatureFlags.MlsE2EId diff --git a/integration/test/SetupHelpers.hs b/integration/test/SetupHelpers.hs index 1502844ac41..43851fd04d7 100644 --- a/integration/test/SetupHelpers.hs +++ b/integration/test/SetupHelpers.hs @@ -41,8 +41,7 @@ deleteUser user = bindResponse (API.Brig.deleteUser user) $ \resp -> do -- | returns (owner, team id, members) createTeam :: (HasCallStack, MakesValue domain) => domain -> Int -> App (Value, String, [Value]) createTeam domain memberCount = do - res <- createUser domain def {team = True} - owner <- res.json + owner <- createUser domain def {team = True} >>= getJSON 201 tid <- owner %. "team" & asString members <- for [2 .. memberCount] $ \_ -> createTeamMember owner tid pure (owner, tid, members) diff --git a/integration/test/Test/FeatureFlags/Initialisation.hs b/integration/test/Test/FeatureFlags/Initialisation.hs new file mode 100644 index 00000000000..ac84a57ac91 --- /dev/null +++ b/integration/test/Test/FeatureFlags/Initialisation.hs @@ -0,0 +1,68 @@ +module Test.FeatureFlags.Initialisation where + +import API.GalleyInternal +import Control.Monad.Codensity +import Control.Monad.Extra +import Control.Monad.Reader +import SetupHelpers +import Testlib.Prelude +import Testlib.ResourcePool + +testMLSInitialisation :: (HasCallStack) => App () +testMLSInitialisation = do + let override = + def + { galleyCfg = + setField + "settings.featureFlags.mls" + ( object + [ "initialConfig" + .= object + [ "protocolToggleUsers" .= ([] :: [Int]), + "defaultProtocol" .= "mls", + "allowedCipherSuites" .= [1, 2 :: Int], + "defaultCipherSuite" .= (1 :: Int), + "supportedProtocols" .= ["mls", "proteus"] + ] + ] + ) + >=> removeField "settings.featureFlags.mlsMigration" + } + + pool <- asks (.resourcePool) + lowerCodensity do + [resource] <- acquireResources 1 pool + + (alice, aliceTeam) <- lift $ lowerCodensity do + -- start a dynamic backend with default configuration + domain <- startDynamicBackend resource def + + -- create a team + lift do + (alice, tid, _) <- createTeam domain 0 + feat <- getTeamFeature alice tid "mls" >>= getJSON 200 + feat %. "config.defaultProtocol" `shouldMatch` "proteus" + pure (alice, tid) + + lift $ lowerCodensity do + -- now start the backend again, this time with an initial mls + -- configuration set + domain <- startDynamicBackend resource override + + -- a pre-existing team should get the default configuration + lift do + feat <- getTeamFeature alice aliceTeam "mls" >>= getJSON 200 + feat %. "config.defaultProtocol" `shouldMatch` "proteus" + + -- a new team should get the initial mls configuration + lift do + (bob, tid, _) <- createTeam domain 0 + feat <- getTeamFeature bob tid "mls" >>= getJSON 200 + feat %. "config.defaultProtocol" `shouldMatch` "mls" + + -- if the mls feature is locked, the config reverts back to default + void + $ patchTeamFeature bob tid "mls" (object ["lockStatus" .= "locked"]) + >>= getJSON 200 + feat' <- getTeamFeature bob tid "mls" >>= getJSON 200 + feat' %. "config.defaultProtocol" `shouldMatch` "proteus" diff --git a/integration/test/Testlib/ModService.hs b/integration/test/Testlib/ModService.hs index 385a410b10b..379547c4d2b 100644 --- a/integration/test/Testlib/ModService.hs +++ b/integration/test/Testlib/ModService.hs @@ -124,11 +124,14 @@ startDynamicBackends beOverrides k = when (Prelude.length beOverrides > 3) $ lift $ failApp "Too many backends. Currently only 3 are supported." pool <- asks (.resourcePool) resources <- acquireResources (Prelude.length beOverrides) pool - void $ traverseConcurrentlyCodensity (uncurry startDynamicBackend) (zip resources beOverrides) + void $ + traverseConcurrentlyCodensity + (void . uncurry startDynamicBackend) + (zip resources beOverrides) pure $ map (.berDomain) resources k -startDynamicBackend :: BackendResource -> ServiceOverrides -> Codensity App () +startDynamicBackend :: BackendResource -> ServiceOverrides -> Codensity App String startDynamicBackend resource beOverrides = do let overrides = mconcat @@ -141,6 +144,7 @@ startDynamicBackend resource beOverrides = do beOverrides ] startBackend resource overrides + pure resource.berDomain where setAwsConfigs :: ServiceOverrides setAwsConfigs = diff --git a/integration/test/Testlib/RunServices.hs b/integration/test/Testlib/RunServices.hs index e4641a21983..c2ee022185a 100644 --- a/integration/test/Testlib/RunServices.hs +++ b/integration/test/Testlib/RunServices.hs @@ -57,6 +57,6 @@ main = do $ do _modifyEnv <- traverseConcurrentlyCodensity - (\r -> startDynamicBackend r mempty) + (\r -> void $ startDynamicBackend r mempty) [backendA, backendB] liftIO run diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 4edd7e398d8..05f50010a65 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -16,6 +16,7 @@ , lens , lib , memory +, schema-profunctor , sop-core , text , types-common @@ -39,6 +40,7 @@ mkDerivation { imports lens memory + schema-profunctor sop-core text types-common diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index eb99c1afbb8..a3c6cea0cfe 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -80,6 +80,7 @@ library , imports , lens >=4.12 , memory + , schema-profunctor , sop-core , text >=0.11 , types-common >=0.16 diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 5e50181ecd7..28be18a4b0a 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -29,6 +29,8 @@ module Galley.Types.Teams GetFeatureDefaults (..), FeatureDefaults (..), FeatureFlags, + DefaultsInitial (..), + initialFeature, featureDefaults, notTeamMember, findTeamMember, @@ -47,6 +49,7 @@ import Data.ByteString.UTF8 qualified as UTF8 import Data.Default import Data.Id (UserId) import Data.SOP +import Data.Schema qualified as S import Data.Set qualified as Set import Imports import Wire.API.Team.Feature @@ -214,10 +217,10 @@ newtype instance FeatureDefaults SndFactorPasswordChallengeConfig deriving (FromJSON) via Defaults (LockableFeature SndFactorPasswordChallengeConfig) deriving (ParseFeatureDefaults) via OptionalField SndFactorPasswordChallengeConfig -newtype instance FeatureDefaults MLSConfig = MLSDefaults (LockableFeature MLSConfig) +newtype instance FeatureDefaults MLSConfig = MLSDefaults (DefaultsInitial MLSConfig) deriving stock (Eq, Show) deriving newtype (Default, GetFeatureDefaults) - deriving (FromJSON) via Defaults (LockableFeature MLSConfig) + deriving (FromJSON) via DefaultsInitial MLSConfig deriving (ParseFeatureDefaults) via OptionalField MLSConfig data instance FeatureDefaults ExposeInvitationURLsToTeamAdminConfig @@ -328,6 +331,31 @@ instance (FromJSON a) => FromJSON (Defaults a) where parseJSON = withObject "default object" $ \ob -> Defaults <$> (ob .: "defaults") +data DefaultsInitial cfg = DefaultsInitial + { defFeature :: LockableFeature cfg, + initial :: cfg + } + deriving (Eq, Show) + +instance (IsFeatureConfig cfg) => Default (DefaultsInitial cfg) where + def = DefaultsInitial def def + +type instance ConfigOf (DefaultsInitial cfg) = cfg + +instance GetFeatureDefaults (DefaultsInitial cfg) where + featureDefaults1 = defFeature + +instance (IsFeatureConfig cfg) => FromJSON (DefaultsInitial cfg) where + parseJSON = withObject "default with initial" $ \ob -> do + feat <- ob .:? "defaults" .!= def + mc <- + fromMaybe feat.config + <$> A.explicitParseFieldMaybe S.schemaParseJSON ob "initialConfig" + pure $ DefaultsInitial feat mc + +initialFeature :: DefaultsInitial cfg -> LockableFeature cfg +initialFeature d = d.defFeature {config = d.initial} + makeLenses ''TeamCreationTime notTeamMember :: [UserId] -> [TeamMember] -> [UserId] diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index a8e7953feb3..b59465923af 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -86,6 +86,7 @@ import Data.Time.Clock (UTCTime) import Galley.API.Action import Galley.API.Error as Galley import Galley.API.LegalHold.Team +import Galley.API.Teams.Features import Galley.API.Teams.Features.Get import Galley.API.Teams.Notifications qualified as APITeamQueue import Galley.API.Update qualified as API @@ -239,6 +240,8 @@ createNonBindingTeamH _ _ _ = do createBindingTeam :: ( Member NotificationSubsystem r, Member (Input UTCTime) r, + Member (Input Opts) r, + Member TeamFeatureStore r, Member TeamStore r ) => TeamId -> @@ -249,7 +252,13 @@ createBindingTeam tid zusr body = do let owner = Public.mkTeamMember zusr fullPermissions Nothing LH.defUserLegalHoldStatus team <- E.createTeam (Just tid) zusr body.newTeamName body.newTeamIcon body.newTeamIconKey Binding - finishCreateTeam team owner [] Nothing + initialiseTeamFeatures tid + + E.createTeamMember tid owner + now <- input + let e = newEvent tid now (EdTeamCreate team) + pushNotifications + [newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| [])] pure tid updateTeamStatus :: @@ -1313,28 +1322,6 @@ addTeamMemberInternal tid origin originConn (ntmNewTeamMember -> new) = do APITeamQueue.pushTeamEvent tid e pure sizeBeforeAdd -finishCreateTeam :: - ( Member NotificationSubsystem r, - Member (Input UTCTime) r, - Member TeamStore r - ) => - Team -> - TeamMember -> - [TeamMember] -> - Maybe ConnId -> - Sem r () -finishCreateTeam team owner others zcon = do - let zusr = owner ^. userId - for_ (owner : others) $ - E.createTeamMember (team ^. teamId) - now <- input - let e = newEvent (team ^. teamId) now (EdTeamCreate team) - let r = membersToRecipients Nothing others - pushNotifications - [ newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| r) - & pushConn .~ zcon - ] - getBindingTeamMembers :: ( Member (ErrorS 'TeamNotFound) r, Member (ErrorS 'NonBindingTeam) r, diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 940b754bd73..56c2ceaddd0 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -30,6 +30,7 @@ module Galley.API.Teams.Features guardSecondFactorDisabled, featureEnabledForTeam, guardMlsE2EIdConfig, + initialiseTeamFeatures, ) where @@ -43,7 +44,7 @@ import Data.Qualified (Local) import Data.Time (UTCTime) import Galley.API.Error (InternalError) import Galley.API.LegalHold qualified as LegalHold -import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold) +import Galley.API.LegalHold.Team qualified as LegalHold import Galley.API.Teams.Features.Get import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, membersToRecipients, permissionCheck) import Galley.App @@ -243,6 +244,21 @@ setFeatureForTeam tid feat = do pushFeatureEvent tid (mkUpdateEvent newFeat) pure newFeat +initialiseTeamFeatures :: + ( Member (Input Opts) r, + Member TeamFeatureStore r + ) => + TeamId -> + Sem r () +initialiseTeamFeatures tid = do + flags :: FeatureFlags <- inputs $ view (settings . featureFlags) + + -- set MLS initial config + let MLSDefaults fdef = npProject flags + let feat = initialFeature fdef + setDbFeature tid feat + pure () + ------------------------------------------------------------------------------- -- SetFeatureConfig instances @@ -349,7 +365,7 @@ instance SetFeatureConfig LegalholdConfig where case feat.status of FeatureStatusDisabled -> LegalHold.removeSettings' @InternalPaging tid - FeatureStatusEnabled -> ensureNotTooLargeToActivateLegalHold tid + FeatureStatusEnabled -> LegalHold.ensureNotTooLargeToActivateLegalHold tid pure feat instance SetFeatureConfig FileSharingConfig