diff --git a/changelog.d/5-internal/WPB-22959 b/changelog.d/5-internal/WPB-22959 index 8515eb0fbc..c073df6a25 100644 --- a/changelog.d/5-internal/WPB-22959 +++ b/changelog.d/5-internal/WPB-22959 @@ -1 +1,3 @@ -Generalized the migration lock for better reuse +- Generalized the migration lock for better reuse +- Move logic from `TeamFeatureStore` interpreter to `FeatureConfigSubsystem` +(#4982, #4983) diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs index 8d0e802d9f..d8824e685c 100644 --- a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs @@ -23,26 +23,15 @@ import Data.Id (TeamId, UserId) import Data.Qualified (Local) import Imports import Polysemy -import Wire.API.Team.Feature (AllTeamFeatures, LockableFeature) +import Wire.API.Team.Feature (AllTeamFeatures, DbFeature, LockableFeature) import Wire.FeaturesConfigSubsystem.Types data FeaturesConfigSubsystem m a where - GetFeature :: - forall cfg m. - (GetFeatureConfig cfg) => - UserId -> TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) - GetFeatureForTeam :: - forall cfg m. - (GetFeatureConfig cfg) => - TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) - GetFeatureForServer :: - forall cfg m. - (GetFeatureConfig cfg) => - FeaturesConfigSubsystem m (LockableFeature cfg) - GetFeatureForTeamUser :: - forall cfg m. - (GetFeatureConfig cfg) => - UserId -> Maybe TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetDbFeatureRawInternal :: forall cfg m. (GetFeatureConfig cfg) => TeamId -> FeaturesConfigSubsystem m (DbFeature cfg) + GetFeature :: forall cfg m. (GetFeatureConfig cfg) => UserId -> TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForTeam :: forall cfg m. (GetFeatureConfig cfg) => TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForServer :: forall cfg m. (GetFeatureConfig cfg) => FeaturesConfigSubsystem m (LockableFeature cfg) + GetFeatureForTeamUser :: forall cfg m. (GetFeatureConfig cfg) => UserId -> Maybe TeamId -> FeaturesConfigSubsystem m (LockableFeature cfg) GetAllTeamFeaturesForTeamMember :: Local UserId -> TeamId -> FeaturesConfigSubsystem m AllTeamFeatures GetAllTeamFeaturesForTeam :: TeamId -> FeaturesConfigSubsystem m AllTeamFeatures GetAllTeamFeaturesForServer :: FeaturesConfigSubsystem m AllTeamFeatures diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs index e82d02a1d7..852e4d57c8 100644 --- a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs +++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs @@ -1,14 +1,19 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-ambiguous-fields #-} module Wire.FeaturesConfigSubsystem.Interpreter where +import Data.Aeson.Types qualified as A import Data.Id import Data.Qualified (tUnqualified) import Data.SOP +import Data.Text.Lazy qualified as LT import Galley.Types.Teams import Imports import Polysemy +import Polysemy.Error import Polysemy.Input import Wire.API.Error import Wire.API.Error.Galley @@ -20,77 +25,108 @@ import Wire.TeamFeatureStore import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem +data TeamFeatureStoreError = TeamFeatureStoreErrorInternalError LText + runFeaturesConfigSubsystem :: forall r a. ( Member TeamFeatureStore r, Member TeamSubsystem r, + Member (Error TeamFeatureStoreError) r, Member (ErrorS 'NotATeamMember) r, GetFeatureConfigEffects r ) => Sem (FeaturesConfigSubsystem : r) a -> Sem r a runFeaturesConfigSubsystem = interpret $ \case + GetDbFeatureRawInternal tid -> getDbFeatureRawInternalImpl tid GetFeature uid tid -> do void $ TeamSubsystem.internalGetTeamMember uid tid >>= noteS @'NotATeamMember - doGetFeatureForTeam tid + getFeatureForTeamImpl tid GetFeatureForTeam tid -> - doGetFeatureForTeam tid + getFeatureForTeamImpl tid GetFeatureForServer -> resolveServerFeature GetFeatureForTeamUser uid mTid -> - doGetFeatureForTeamUser uid mTid + getFeatureForTeamUserImpl uid mTid GetAllTeamFeaturesForTeamMember luid tid -> do void $ TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid >>= noteS @'NotATeamMember - doGetAllTeamFeatures tid + getAllTeamFeaturesImpl tid GetAllTeamFeaturesForTeam tid -> - doGetAllTeamFeatures tid + getAllTeamFeaturesImpl tid GetAllTeamFeaturesForServer -> - doGetAllTeamFeaturesForServer + getAllTeamFeaturesForServerImpl -- Internal helpers -doGetFeatureForTeam :: +getFeatureForTeamImpl :: forall cfg r. ( GetFeatureConfig cfg, Member TeamFeatureStore r, + Member (Error TeamFeatureStoreError) r, GetFeatureConfigEffects r ) => TeamId -> Sem r (LockableFeature cfg) -doGetFeatureForTeam tid = do - dbFeature <- getDbFeature tid +getFeatureForTeamImpl tid = do + dbFeature <- getDbFeatureRawInternalImpl tid defFeature <- resolveServerFeature computeFeature tid defFeature dbFeature -doGetFeatureForTeamUser :: +getFeatureForTeamUserImpl :: forall cfg r. ( GetFeatureConfig cfg, Member TeamFeatureStore r, + Member (Error TeamFeatureStoreError) r, GetFeatureConfigEffects r ) => UserId -> Maybe TeamId -> Sem r (LockableFeature cfg) -doGetFeatureForTeamUser uid Nothing = getFeatureForUser uid -doGetFeatureForTeamUser _uid (Just tid) = doGetFeatureForTeam tid +getFeatureForTeamUserImpl uid Nothing = getFeatureForUser uid +getFeatureForTeamUserImpl _uid (Just tid) = getFeatureForTeamImpl tid -doGetAllTeamFeatures :: +getAllTeamFeaturesImpl :: forall r. ( Member TeamFeatureStore r, + Member (Error TeamFeatureStoreError) r, GetFeatureConfigEffects r ) => TeamId -> Sem r AllTeamFeatures -doGetAllTeamFeatures tid = do +getAllTeamFeaturesImpl tid = do features <- getAllDbFeatures tid - defFeatures <- doGetAllTeamFeaturesForServer + defFeatures <- getAllTeamFeaturesForServerImpl hsequence' $ hcliftA2 (Proxy @(GetAllFeaturesForServerConstraints r)) compute defFeatures features where - compute :: forall p. (GetFeatureConfig p) => LockableFeature p -> DbFeature p -> (Sem r :.: LockableFeature) p - compute defFeature feat = Comp $ computeFeature tid defFeature feat + compute :: forall p. (GetFeatureConfig p) => LockableFeature p -> K (Maybe DbFeaturePatch) p -> (Sem r :.: LockableFeature) p + compute defFeature (K mPatch) = Comp $ do + dbFeature <- fromMaybe mempty <$> traverse parseDbFeatureOrThrow mPatch + computeFeature tid defFeature dbFeature -doGetAllTeamFeaturesForServer :: forall r. (Member (Input FeatureFlags) r) => Sem r AllTeamFeatures -doGetAllTeamFeaturesForServer = +getAllTeamFeaturesForServerImpl :: forall r. (Member (Input FeatureFlags) r) => Sem r AllTeamFeatures +getAllTeamFeaturesForServerImpl = hsequence' $ hcpure (Proxy @GetFeatureConfig) $ Comp resolveServerFeature + +getDbFeatureRawInternalImpl :: + forall cfg r. + ( IsFeatureConfig cfg, + Member (Error TeamFeatureStoreError) r, + Member TeamFeatureStore r + ) => + TeamId -> Sem r (DbFeature cfg) +getDbFeatureRawInternalImpl tid = + fromMaybe mempty <$> (getDbFeature @cfg tid >>= traverse parseDbFeatureOrThrow) + +parseDbFeatureOrThrow :: + forall cfg r. + ( IsFeatureConfig cfg, + Member (Error TeamFeatureStoreError) r + ) => + DbFeaturePatch -> + Sem r (DbFeature cfg) +parseDbFeatureOrThrow feat = + mapError (TeamFeatureStoreErrorInternalError . LT.pack) + . fromEither + $ A.parseEither (const (parseDbFeature feat)) () diff --git a/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs b/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs index 7be546ed65..3da95cbd4e 100644 --- a/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs +++ b/libs/wire-subsystems/src/Wire/TeamFeatureStore.hs @@ -14,19 +14,24 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . - module Wire.TeamFeatureStore where import Data.Id +import Data.SOP (K (..)) +import Imports import Polysemy import Wire.API.Team.Feature +type DbFeaturePatch = LockableFeaturePatch DbConfig + +type AllDbFeaturePatches = AllFeatures (K (Maybe DbFeaturePatch)) + data TeamFeatureStore m a where -- | Returns all stored feature values excluding lock status. GetDbFeature :: FeatureSingleton cfg -> TeamId -> - TeamFeatureStore m (DbFeature cfg) + TeamFeatureStore m (Maybe DbFeaturePatch) SetDbFeature :: FeatureSingleton cfg -> TeamId -> @@ -44,27 +49,30 @@ data TeamFeatureStore m a where TeamFeatureStore m () GetAllDbFeatures :: TeamId -> - TeamFeatureStore m (AllFeatures DbFeature) + TeamFeatureStore m AllDbFeaturePatches getDbFeature :: + forall cfg r. (Member TeamFeatureStore r, IsFeatureConfig cfg) => TeamId -> - Sem r (DbFeature cfg) -getDbFeature tid = send (GetDbFeature featureSingleton tid) + Sem r (Maybe DbFeaturePatch) +getDbFeature tid = send (GetDbFeature (featureSingleton @cfg) tid) setDbFeature :: + forall cfg r. (Member TeamFeatureStore r, IsFeatureConfig cfg) => TeamId -> LockableFeature cfg -> Sem r () -setDbFeature tid feat = send (SetDbFeature featureSingleton tid feat) +setDbFeature tid feat = send (SetDbFeature (featureSingleton @cfg) tid feat) patchDbFeature :: + forall cfg r. (Member TeamFeatureStore r, IsFeatureConfig cfg) => TeamId -> (LockableFeaturePatch cfg) -> Sem r () -patchDbFeature tid featPatch = send (PatchDbFeature featureSingleton tid featPatch) +patchDbFeature tid featPatch = send (PatchDbFeature (featureSingleton @cfg) tid featPatch) setFeatureLockStatus :: forall cfg r. @@ -75,5 +83,5 @@ setFeatureLockStatus :: setFeatureLockStatus tid lockStatus = send (SetFeatureLockStatus (featureSingleton @cfg) tid lockStatus) -getAllDbFeatures :: (Member TeamFeatureStore r) => TeamId -> Sem r (AllFeatures DbFeature) +getAllDbFeatures :: (Member TeamFeatureStore r) => TeamId -> Sem r AllDbFeaturePatches getAllDbFeatures tid = send (GetAllDbFeatures tid) diff --git a/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs index 2a897bc6b3..29ed1db7f2 100644 --- a/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs +++ b/libs/wire-subsystems/src/Wire/TeamFeatureStore/Cassandra.hs @@ -17,65 +17,60 @@ -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . -module Wire.TeamFeatureStore.Cassandra (interpretTeamFeatureStoreToCassandra, TeamFeatureStoreError (..)) where +module Wire.TeamFeatureStore.Cassandra (interpretTeamFeatureStoreToCassandra) where import Cassandra -import Data.Aeson.Types qualified as A import Data.Constraint import Data.Id import Data.Map qualified as M -import Data.Text.Lazy qualified as LT +import Data.Proxy +import Data.SOP (K (..), hcpure) +import Data.SOP.Constraint qualified as SOP import Imports import Polysemy -import Polysemy.Error import Polysemy.Input import Wire.API.Team.Feature import Wire.API.Team.Feature.TH import Wire.ConversationStore.Cassandra.Instances () -import Wire.TeamFeatureStore (TeamFeatureStore (..)) +import Wire.TeamFeatureStore (AllDbFeaturePatches, DbFeaturePatch, TeamFeatureStore (..)) import Wire.Util -data TeamFeatureStoreError = TeamFeatureStoreErrorInternalError LText - interpretTeamFeatureStoreToCassandra :: ( Member (Embed IO) r, - Member (Input ClientState) r, - Member (Error TeamFeatureStoreError) r + Member (Input ClientState) r ) => Sem (TeamFeatureStore ': r) a -> Sem r a interpretTeamFeatureStoreToCassandra = interpret $ \case GetDbFeature sing tid -> do - getDbFeatureDyn sing tid + getDbFeatureImpl sing tid SetDbFeature sing tid feat -> do - setDbFeatureDyn sing tid feat + setDbFeatureImpl sing tid feat SetFeatureLockStatus sing tid lock -> do - setFeatureLockStatusDyn sing tid (Tagged lock) + setFeatureLockStatusImpl sing tid (Tagged lock) GetAllDbFeatures tid -> do - getAllDbFeaturesDyn tid + getAllDbFeaturesImpl tid PatchDbFeature sing tid feat -> do - patchDbFeatureDyn sing tid feat + patchDbFeatureImpl sing tid feat -getDbFeatureDyn :: +getDbFeatureImpl :: forall cfg r. ( Member (Input ClientState) r, - Member (Embed IO) r, - Member (Error TeamFeatureStoreError) r + Member (Embed IO) r ) => FeatureSingleton cfg -> TeamId -> - Sem r (DbFeature cfg) -getDbFeatureDyn sing tid = case featureSingIsFeature sing of + Sem r (Maybe DbFeaturePatch) +getDbFeatureImpl sing tid = case featureSingIsFeature sing of Dict -> do let q :: PrepQuery R (TeamId, Text) (Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig) q = "select status, lock_status, config from team_features_dyn where team = ? and feature = ?" (embedClientInput (retry x1 $ query1 q (params LocalQuorum (tid, featureName @cfg)))) >>= \case - Nothing -> pure mempty + Nothing -> pure Nothing Just (status, lockStatus, config) -> - runFeatureParser . parseDbFeature $ - LockableFeaturePatch {..} + pure $ Just LockableFeaturePatch {..} -setDbFeatureDyn :: +setDbFeatureImpl :: forall cfg r. ( Member (Input ClientState) r, Member (Embed IO) r @@ -84,8 +79,8 @@ setDbFeatureDyn :: TeamId -> LockableFeature cfg -> Sem r () -setDbFeatureDyn sing tid feat = - patchDbFeatureDyn +setDbFeatureImpl sing tid feat = + patchDbFeatureImpl sing tid ( LockableFeaturePatch @@ -95,7 +90,7 @@ setDbFeatureDyn sing tid feat = } ) -patchDbFeatureDyn :: +patchDbFeatureImpl :: forall cfg r. ( Member (Input ClientState) r, Member (Embed IO) r @@ -104,7 +99,7 @@ patchDbFeatureDyn :: TeamId -> LockableFeaturePatch cfg -> Sem r () -patchDbFeatureDyn sing tid patch = case featureSingIsFeature sing of +patchDbFeatureImpl sing tid patch = case featureSingIsFeature sing of Dict -> embedClientInput $ do retry x5 . batch $ do setType BatchLogged @@ -122,7 +117,7 @@ patchDbFeatureDyn sing tid patch = case featureSingIsFeature sing of writeConfig :: PrepQuery W (DbConfig, TeamId, Text) () writeConfig = "update team_features_dyn set config = ? where team = ? and feature = ?" -setFeatureLockStatusDyn :: +setFeatureLockStatusImpl :: forall cfg r. ( Member (Input ClientState) r, Member (Embed IO) r @@ -131,7 +126,7 @@ setFeatureLockStatusDyn :: TeamId -> Tagged cfg LockStatus -> Sem r () -setFeatureLockStatusDyn sing tid (Tagged lockStatus) = case featureSingIsFeature sing of +setFeatureLockStatusImpl sing tid (Tagged lockStatus) = case featureSingIsFeature sing of Dict -> do let q :: PrepQuery W (LockStatus, TeamId, Text) () q = "update team_features_dyn set lock_status = ? where team = ? and feature = ?" @@ -139,28 +134,26 @@ setFeatureLockStatusDyn sing tid (Tagged lockStatus) = case featureSingIsFeature retry x5 $ write q (params LocalQuorum (lockStatus, tid, featureName @cfg)) -getAllDbFeaturesDyn :: +getAllDbFeaturesImpl :: ( Member (Embed IO) r, - Member (Input ClientState) r, - Member (Error TeamFeatureStoreError) r + Member (Input ClientState) r ) => TeamId -> - Sem r (AllFeatures DbFeature) -getAllDbFeaturesDyn tid = do + Sem r AllDbFeaturePatches +getAllDbFeaturesImpl tid = do let q :: PrepQuery R (Identity TeamId) (Text, Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig) q = "select feature, status, lock_status, config from team_features_dyn where team = ?" rows <- embedClientInput $ retry x1 $ query q (params LocalQuorum (Identity tid)) let m = M.fromList $ do (name, status, lockStatus, config) <- rows pure (name, LockableFeaturePatch {..}) - runFeatureParser $ mkAllFeatures m + pure $ mkAllDbFeaturePatches m -runFeatureParser :: - forall r a. - (Member (Error TeamFeatureStoreError) r) => - A.Parser a -> - Sem r a -runFeatureParser p = - mapError (TeamFeatureStoreErrorInternalError . LT.pack) - . fromEither - $ A.parseEither (const p) () +mkAllDbFeaturePatches :: + (SOP.All IsFeatureConfig Features) => + M.Map Text DbFeaturePatch -> + AllDbFeaturePatches +mkAllDbFeaturePatches m = hcpure (Proxy @IsFeatureConfig) get + where + get :: forall cfg. (IsFeatureConfig cfg) => K (Maybe DbFeaturePatch) cfg + get = K (M.lookup (featureName @cfg) m) diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 2aa4a48088..6faadb492e 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -80,6 +80,7 @@ import Wire.BrigAPIAccess import Wire.ConversationStore import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) +import Wire.FeaturesConfigSubsystem import Wire.FireAndForget import Wire.LegalHoldStore qualified as LegalHoldData import Wire.NotificationSubsystem @@ -101,10 +102,10 @@ createSettings :: Member (ErrorS 'LegalHoldServiceInvalidKey) r, Member (ErrorS 'LegalHoldServiceBadResponse) r, Member LegalHoldStore r, - Member TeamFeatureStore r, Member P.TinyLog r, Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r ) => Local UserId -> TeamId -> @@ -131,9 +132,9 @@ getSettings :: forall r. ( Member (ErrorS 'NotATeamMember) r, Member LegalHoldStore r, - Member TeamFeatureStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r ) => Local UserId -> TeamId -> @@ -177,7 +178,6 @@ removeSettingsInternalPaging :: Member ProposalStore r, Member P.TinyLog r, Member Random r, - Member TeamFeatureStore r, Member (TeamMemberStore InternalPaging) r, Member TeamStore r, Member (Embed IO) r, @@ -185,7 +185,8 @@ removeSettingsInternalPaging :: Member MLSCommitLockStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Local UserId -> TeamId -> @@ -197,7 +198,6 @@ removeSettings :: forall p r. ( Paging p, Bounded (PagingBounds p TeamMember), - Member TeamFeatureStore r, Member (TeamMemberStore p) r, Member TeamStore r, Member BackendNotificationQueueAccess r, @@ -231,7 +231,8 @@ removeSettings :: Member MLSCommitLockStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => UserId -> TeamId -> @@ -388,14 +389,14 @@ requestDevice :: Member ProposalStore r, Member P.TinyLog r, Member Random r, - Member TeamFeatureStore r, Member TeamStore r, Member (Embed IO) r, Member TeamCollaboratorsSubsystem r, Member MLSCommitLockStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Local UserId -> TeamId -> @@ -485,14 +486,14 @@ approveDevice :: Member ProposalStore r, Member P.TinyLog r, Member Random r, - Member TeamFeatureStore r, Member TeamStore r, Member (Embed IO) r, Member TeamCollaboratorsSubsystem r, Member MLSCommitLockStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, Member TeamSubsystem r, - Member (Input ConversationSubsystemConfig) r + Member (Input ConversationSubsystemConfig) r, + Member FeaturesConfigSubsystem r ) => Local UserId -> ConnId -> diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 977fcfb291..92f1eac3fb 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -37,15 +37,15 @@ import Wire.API.Error.Galley import Wire.API.Team.Feature import Wire.API.Team.Size import Wire.BrigAPIAccess +import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getDbFeatureRawInternal) import Wire.LegalHold -import Wire.TeamFeatureStore assertLegalHoldEnabledForTeam :: forall r. ( Member LegalHoldStore r, - Member TeamFeatureStore r, Member (Input (FeatureDefaults LegalholdConfig)) r, - Member (ErrorS 'LegalHoldNotEnabled) r + Member (ErrorS 'LegalHoldNotEnabled) r, + Member FeaturesConfigSubsystem r ) => TeamId -> Sem r () @@ -56,13 +56,13 @@ assertLegalHoldEnabledForTeam tid = isLegalHoldEnabledForTeam :: forall r. ( Member LegalHoldStore r, - Member TeamFeatureStore r, + Member FeaturesConfigSubsystem r, Member (Input (FeatureDefaults LegalholdConfig)) r ) => TeamId -> Sem r Bool isLegalHoldEnabledForTeam tid = do - dbFeature <- getDbFeature tid + dbFeature <- getDbFeatureRawInternal tid status <- computeLegalHoldFeatureStatus tid dbFeature pure $ status == FeatureStatusEnabled diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 2ac4938634..32539143f4 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -526,13 +526,13 @@ addTeamMember :: Member (Input Opts) r, Member Now r, Member LegalHoldStore r, - Member TeamFeatureStore r, Member TeamNotificationStore r, Member TeamStore r, Member P.TinyLog r, Member (Input FanoutLimit) r, Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamSubsystem r + Member TeamSubsystem r, + Member FeaturesConfigSubsystem r ) => Local UserId -> ConnId -> @@ -570,12 +570,12 @@ uncheckedAddTeamMember :: Member Now r, Member LegalHoldStore r, Member P.TinyLog r, - Member TeamFeatureStore r, Member TeamNotificationStore r, Member TeamStore r, Member (Input FanoutLimit) r, Member (Input (FeatureDefaults LegalholdConfig)) r, - Member TeamJournal r + Member TeamJournal r, + Member FeaturesConfigSubsystem r ) => TeamId -> NewTeamMember -> @@ -1115,10 +1115,10 @@ ensureNotTooLarge tid = do ensureNotTooLargeForLegalHold :: forall r. ( Member LegalHoldStore r, - Member TeamFeatureStore r, Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, Member (Input FanoutLimit) r, - Member (Input (FeatureDefaults LegalholdConfig)) r + Member (Input (FeatureDefaults LegalholdConfig)) r, + Member FeaturesConfigSubsystem r ) => TeamId -> Int -> @@ -1204,10 +1204,10 @@ canUserJoinTeam :: forall r. ( Member BrigAPIAccess r, Member LegalHoldStore r, - Member TeamFeatureStore r, Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, Member (Input FanoutLimit) r, - Member (Input (FeatureDefaults LegalholdConfig)) r + Member (Input (FeatureDefaults LegalholdConfig)) r, + Member FeaturesConfigSubsystem r ) => TeamId -> Sem r () diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 4c9bf4b979..d16588f9d2 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -71,7 +71,7 @@ import Wire.CodeStore import Wire.ConversationStore (MLSCommitLockStore) import Wire.ConversationSubsystem import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig) -import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem) +import Wire.FeaturesConfigSubsystem import Wire.FeaturesConfigSubsystem.Types (GetFeatureConfigEffects) import Wire.FeaturesConfigSubsystem.Utils (resolveServerFeature) import Wire.NotificationSubsystem @@ -104,8 +104,8 @@ patchFeatureInternal :: Sem r (LockableFeature cfg) patchFeatureInternal tid patch = do assertTeamExists tid - dbFeature <- getDbFeature tid - (defFeature :: LockableFeature cfg) <- resolveServerFeature + dbFeature <- getDbFeatureRawInternal tid + defFeature :: LockableFeature cfg <- resolveServerFeature let dbFeatureWithDefaults = dbFeature.applyDbFeature defFeature let patchedFeature = applyPatch dbFeatureWithDefaults prepareFeature tid patchedFeature diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index ece1922543..0c2dd6ddd3 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -50,11 +50,11 @@ import Wire.API.Team.Feature import Wire.ConversationStore as ConversationStore import Wire.FeaturesConfigSubsystem import Wire.FeaturesConfigSubsystem.Types -import Wire.TeamFeatureStore import Wire.TeamStore qualified as TeamStore import Wire.TeamSubsystem (TeamSubsystem) import Wire.TeamSubsystem qualified as TeamSubsystem +-- FUTUREWORK: everything in this module should be moved to the FeatureConfigSubsystem data DoAuth = DoAuth UserId | DontDoAuth getFeatureInternal :: @@ -90,29 +90,15 @@ getTeamAndCheckMembership uid = do getAllTeamFeatures :: forall r. - ( Member TeamFeatureStore r, - Member FeaturesConfigSubsystem r, - GetFeatureConfigEffects r - ) => + (Member FeaturesConfigSubsystem r) => TeamId -> Sem r AllTeamFeatures -getAllTeamFeatures tid = do - features <- getAllDbFeatures tid - defFeatures <- getAllTeamFeaturesForServer - hsequence' $ hcliftA2 (Proxy @(GetAllFeaturesForServerConstraints r)) compute defFeatures features - where - compute :: - (GetFeatureConfig p) => - LockableFeature p -> - DbFeature p -> - (Sem r :.: LockableFeature) p - compute defFeature feat = Comp $ computeFeature tid defFeature feat +getAllTeamFeatures tid = getAllTeamFeaturesForTeam tid getAllTeamFeaturesForUser :: forall r. ( Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, - Member TeamFeatureStore r, Member TeamStore r, Member TeamSubsystem r, Member FeaturesConfigSubsystem r, diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs index 2035a64c1c..9f7798f85d 100644 --- a/services/galley/src/Galley/App.hs +++ b/services/galley/src/Galley/App.hs @@ -115,7 +115,7 @@ import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemConfig (..), import Wire.Error import Wire.ExternalAccess.External import Wire.FeaturesConfigSubsystem -import Wire.FeaturesConfigSubsystem.Interpreter (runFeaturesConfigSubsystem) +import Wire.FeaturesConfigSubsystem.Interpreter import Wire.FeaturesConfigSubsystem.Types (ExposeInvitationURLsAllowlist (..)) import Wire.FederationAPIAccess.Interpreter import Wire.FireAndForget