From e287bd8e1ded9208b19ce873940b41dbfaf2b747 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 20 Sep 2024 10:23:36 +0200 Subject: [PATCH 1/8] Add initialConfig to mls flag configuration --- libs/galley-types/galley-types.cabal | 1 + libs/galley-types/src/Galley/Types/Teams.hs | 25 +++++++++++++++++++-- 2 files changed, 24 insertions(+), 2 deletions(-) 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..a3753ea3024 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -47,6 +47,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 +215,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 +329,26 @@ 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 -> + DefaultsInitial + <$> ob .: "defaults" + <*> A.explicitParseField S.schemaParseJSON ob "initialConfig" + makeLenses ''TeamCreationTime notTeamMember :: [UserId] -> [TeamMember] -> [UserId] From 763bbb117c4eaed6524d1f63f0eb9505073b07ea Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 20 Sep 2024 10:42:15 +0200 Subject: [PATCH 2/8] Simplify createBindingTeam --- services/galley/src/Galley/API/Teams.hs | 28 +++++-------------------- 1 file changed, 5 insertions(+), 23 deletions(-) diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index f6105cc46f1..461e4d1a48a 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -250,7 +250,11 @@ 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 + E.createTeamMember tid owner + now <- input + let e = newEvent tid now (EdTeamCreate team) + pushNotifications + [newPushLocal1 zusr (toJSONObject e) (userRecipient zusr :| [])] pure tid updateTeamStatus :: @@ -1314,28 +1318,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, From 22ca11a82674a38b882d02fd77f83a6a39744f0d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 20 Sep 2024 13:12:46 +0200 Subject: [PATCH 3/8] Initialise MLS feature flag for new teams --- libs/galley-types/src/Galley/Types/Teams.hs | 5 +++++ services/galley/src/Galley/API/Teams.hs | 5 +++++ .../galley/src/Galley/API/Teams/Features.hs | 20 +++++++++++++++++-- 3 files changed, 28 insertions(+), 2 deletions(-) diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index a3753ea3024..c26e9631db4 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, @@ -349,6 +351,9 @@ instance (IsFeatureConfig cfg) => FromJSON (DefaultsInitial cfg) where <$> ob .: "defaults" <*> A.explicitParseField S.schemaParseJSON ob "initialConfig" +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 461e4d1a48a..9f151443929 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -87,6 +87,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 @@ -240,6 +241,8 @@ createNonBindingTeamH _ _ _ = do createBindingTeam :: ( Member NotificationSubsystem r, Member (Input UTCTime) r, + Member (Input Opts) r, + Member TeamFeatureStore r, Member TeamStore r ) => TeamId -> @@ -250,6 +253,8 @@ 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 + initialiseTeamFeatures tid + E.createTeamMember tid owner now <- input let e = newEvent tid now (EdTeamCreate team) 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 From 1adfa5819a782292bb1e556363de4d7a32ef1253 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 20 Sep 2024 14:52:23 +0200 Subject: [PATCH 4/8] Test mls flag initialisation --- integration/integration.cabal | 1 + integration/test/SetupHelpers.hs | 3 +- .../test/Test/FeatureFlags/Initialisation.hs | 60 +++++++++++++++++++ integration/test/Testlib/ModService.hs | 8 ++- integration/test/Testlib/RunServices.hs | 2 +- libs/galley-types/src/Galley/Types/Teams.hs | 10 ++-- 6 files changed, 75 insertions(+), 9 deletions(-) create mode 100644 integration/test/Test/FeatureFlags/Initialisation.hs 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..6132b0b9040 --- /dev/null +++ b/integration/test/Test/FeatureFlags/Initialisation.hs @@ -0,0 +1,60 @@ +module Test.FeatureFlags.Initialisation where + +import API.Galley +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"] + ] + ] + ) + } + + 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, aliceTeam, _) <- createTeam domain 0 + feat <- getTeamFeature alice aliceTeam "mls" >>= getJSON 200 + feat %. "config.defaultProtocol" `shouldMatch` "proteus" + pure (alice, aliceTeam) + + 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, bobTeam, _) <- createTeam domain 0 + feat <- getTeamFeature bob bobTeam "mls" >>= getJSON 200 + feat %. "config.defaultProtocol" `shouldMatch` "mls" 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/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index c26e9631db4..28be18a4b0a 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -346,10 +346,12 @@ instance GetFeatureDefaults (DefaultsInitial cfg) where featureDefaults1 = defFeature instance (IsFeatureConfig cfg) => FromJSON (DefaultsInitial cfg) where - parseJSON = withObject "default with initial" $ \ob -> - DefaultsInitial - <$> ob .: "defaults" - <*> A.explicitParseField S.schemaParseJSON ob "initialConfig" + 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} From 98af191975ebc2e021d40d0de9855edd7a9aeaae Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 23 Sep 2024 08:39:48 +0200 Subject: [PATCH 5/8] Document initialConfig for mls feature flag --- docs/src/developer/reference/config-options.md | 13 +++++++++++++ 1 file changed, 13 insertions(+) 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. From bfbb60ec13f9c8497690bd4cfc144ece699790f0 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 23 Sep 2024 08:56:06 +0200 Subject: [PATCH 6/8] Test mls initial configuration when locked --- .../test/Test/FeatureFlags/Initialisation.hs | 20 +++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/integration/test/Test/FeatureFlags/Initialisation.hs b/integration/test/Test/FeatureFlags/Initialisation.hs index 6132b0b9040..ac84a57ac91 100644 --- a/integration/test/Test/FeatureFlags/Initialisation.hs +++ b/integration/test/Test/FeatureFlags/Initialisation.hs @@ -1,6 +1,6 @@ module Test.FeatureFlags.Initialisation where -import API.Galley +import API.GalleyInternal import Control.Monad.Codensity import Control.Monad.Extra import Control.Monad.Reader @@ -26,6 +26,7 @@ testMLSInitialisation = do ] ] ) + >=> removeField "settings.featureFlags.mlsMigration" } pool <- asks (.resourcePool) @@ -38,10 +39,10 @@ testMLSInitialisation = do -- create a team lift do - (alice, aliceTeam, _) <- createTeam domain 0 - feat <- getTeamFeature alice aliceTeam "mls" >>= getJSON 200 + (alice, tid, _) <- createTeam domain 0 + feat <- getTeamFeature alice tid "mls" >>= getJSON 200 feat %. "config.defaultProtocol" `shouldMatch` "proteus" - pure (alice, aliceTeam) + pure (alice, tid) lift $ lowerCodensity do -- now start the backend again, this time with an initial mls @@ -55,6 +56,13 @@ testMLSInitialisation = do -- a new team should get the initial mls configuration lift do - (bob, bobTeam, _) <- createTeam domain 0 - feat <- getTeamFeature bob bobTeam "mls" >>= getJSON 200 + (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" From e46f0f2cc9449c2b8819f660830eafe409f1ab66 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 23 Sep 2024 08:57:27 +0200 Subject: [PATCH 7/8] Add CHANGELOG entry --- changelog.d/2-features/new-teams-mls | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/2-features/new-teams-mls 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 From c79fba49ef6050fb04d98d34a057c133044fbbea Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 23 Sep 2024 17:00:43 +0200 Subject: [PATCH 8/8] Regenerate nix packages --- libs/galley-types/default.nix | 2 ++ 1 file changed, 2 insertions(+) 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