diff --git a/changelog.d/5-internal/feature-singletons b/changelog.d/5-internal/feature-singletons new file mode 100644 index 00000000000..656feededda --- /dev/null +++ b/changelog.d/5-internal/feature-singletons @@ -0,0 +1,2 @@ +Use feature singletons in TeamFeatureStore + diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 10d05e8d3f8..c656f810e69 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -58,6 +58,7 @@ module Wire.API.Team.Feature defFeatureStatusNoLock, computeFeatureConfigForTeamUser, IsFeatureConfig (..), + FeatureSingleton (..), FeatureTrivialConfig (..), HasDeprecatedFeatureName (..), LockStatusResponse (..), @@ -124,15 +125,16 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- 1. Add a data type for your feature's "config" part, naming convention: -- **Config**. If your feature doesn't have a config besides -- being enabled/disabled, locked/unlocked, then the config should be a unit --- type, e.g. **data MyFeatureConfig = MyFeatureConfig**. Implement type classes --- 'ToSchema', 'IsFeatureConfig' and 'Arbitrary'. If your feature doesn't have a --- config implement 'FeatureTrivialConfig'. +-- type, e.g. **data MyFeatureConfig = MyFeatureConfig**. Add a singleton for +-- the new data type. Implement type classes 'ToSchema', 'IsFeatureConfig' and +-- 'Arbitrary'. If your feature doesn't have a config implement +-- 'FeatureTrivialConfig'. -- -- 2. Add the config to to 'AllFeatureConfigs'. -- -- 3. If your feature is configurable on a per-team basis, add a schema --- migration in galley and add 'FeatureStatusCassandra' instance in --- Galley.Cassandra.TeamFeatures together with a schema migration +-- migration in galley and extend 'getFeatureStatus' and similar functions in +-- Galley.Cassandra.TeamFeatures -- -- 4. Add the feature to the config schema of galley in Galley.Types.Teams. -- and extend the Arbitrary instance of FeatureConfigs in the unit tests Test.Galley.Types @@ -167,6 +169,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) class IsFeatureConfig cfg where type FeatureSymbol cfg :: Symbol defFeatureStatus :: WithStatus cfg + featureSingleton :: FeatureSingleton cfg objectSchema :: -- | Should be "pure MyFeatureConfig" if the feature doesn't have config, @@ -174,6 +177,25 @@ class IsFeatureConfig cfg where -- omitted/ignored in the JSON encoder / parser. ObjectSchema SwaggerDoc cfg +data FeatureSingleton cfg where + FeatureSingletonGuestLinksConfig :: FeatureSingleton GuestLinksConfig + FeatureSingletonLegalholdConfig :: FeatureSingleton LegalholdConfig + FeatureSingletonSSOConfig :: FeatureSingleton SSOConfig + FeatureSingletonSearchVisibilityAvailableConfig :: FeatureSingleton SearchVisibilityAvailableConfig + FeatureSingletonValidateSAMLEmailsConfig :: FeatureSingleton ValidateSAMLEmailsConfig + FeatureSingletonDigitalSignaturesConfig :: FeatureSingleton DigitalSignaturesConfig + FeatureSingletonConferenceCallingConfig :: FeatureSingleton ConferenceCallingConfig + FeatureSingletonSndFactorPasswordChallengeConfig :: FeatureSingleton SndFactorPasswordChallengeConfig + FeatureSingletonSearchVisibilityInboundConfig :: FeatureSingleton SearchVisibilityInboundConfig + FeatureSingletonClassifiedDomainsConfig :: FeatureSingleton ClassifiedDomainsConfig + FeatureSingletonAppLockConfig :: FeatureSingleton AppLockConfig + FeatureSingletonSelfDeletingMessagesConfig :: FeatureSingleton SelfDeletingMessagesConfig + FeatureSingletonFileSharingConfig :: FeatureSingleton FileSharingConfig + FeatureSingletonMLSConfig :: FeatureSingleton MLSConfig + FeatureSingletonExposeInvitationURLsToTeamAdminConfig :: FeatureSingleton ExposeInvitationURLsToTeamAdminConfig + FeatureSingletonOutlookCalIntegrationConfig :: FeatureSingleton OutlookCalIntegrationConfig + FeatureSingletonMlsE2EIdConfig :: FeatureSingleton MlsE2EIdConfig + class FeatureTrivialConfig cfg where trivialConfig :: cfg @@ -552,6 +574,7 @@ instance ToSchema GuestLinksConfig where instance IsFeatureConfig GuestLinksConfig where type FeatureSymbol GuestLinksConfig = "conversationGuestLinks" defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonGuestLinksConfig objectSchema = pure GuestLinksConfig @@ -568,6 +591,7 @@ data LegalholdConfig = LegalholdConfig instance IsFeatureConfig LegalholdConfig where type FeatureSymbol LegalholdConfig = "legalhold" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonLegalholdConfig objectSchema = pure LegalholdConfig instance ToSchema LegalholdConfig where @@ -586,6 +610,7 @@ data SSOConfig = SSOConfig instance IsFeatureConfig SSOConfig where type FeatureSymbol SSOConfig = "sso" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonSSOConfig objectSchema = pure SSOConfig instance ToSchema SSOConfig where @@ -606,6 +631,7 @@ data SearchVisibilityAvailableConfig = SearchVisibilityAvailableConfig instance IsFeatureConfig SearchVisibilityAvailableConfig where type FeatureSymbol SearchVisibilityAvailableConfig = "searchVisibility" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonSearchVisibilityAvailableConfig objectSchema = pure SearchVisibilityAvailableConfig instance ToSchema SearchVisibilityAvailableConfig where @@ -630,6 +656,7 @@ instance ToSchema ValidateSAMLEmailsConfig where instance IsFeatureConfig ValidateSAMLEmailsConfig where type FeatureSymbol ValidateSAMLEmailsConfig = "validateSAMLemails" defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonValidateSAMLEmailsConfig objectSchema = pure ValidateSAMLEmailsConfig instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where @@ -648,6 +675,7 @@ data DigitalSignaturesConfig = DigitalSignaturesConfig instance IsFeatureConfig DigitalSignaturesConfig where type FeatureSymbol DigitalSignaturesConfig = "digitalSignatures" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonDigitalSignaturesConfig objectSchema = pure DigitalSignaturesConfig instance HasDeprecatedFeatureName DigitalSignaturesConfig where @@ -669,6 +697,7 @@ data ConferenceCallingConfig = ConferenceCallingConfig instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonConferenceCallingConfig objectSchema = pure ConferenceCallingConfig instance ToSchema ConferenceCallingConfig where @@ -690,6 +719,7 @@ instance ToSchema SndFactorPasswordChallengeConfig where instance IsFeatureConfig SndFactorPasswordChallengeConfig where type FeatureSymbol SndFactorPasswordChallengeConfig = "sndFactorPasswordChallenge" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonSndFactorPasswordChallengeConfig objectSchema = pure SndFactorPasswordChallengeConfig instance FeatureTrivialConfig SndFactorPasswordChallengeConfig where @@ -706,6 +736,7 @@ data SearchVisibilityInboundConfig = SearchVisibilityInboundConfig instance IsFeatureConfig SearchVisibilityInboundConfig where type FeatureSymbol SearchVisibilityInboundConfig = "searchVisibilityInbound" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonSearchVisibilityInboundConfig objectSchema = pure SearchVisibilityInboundConfig instance ToSchema SearchVisibilityInboundConfig where @@ -740,6 +771,7 @@ instance IsFeatureConfig ClassifiedDomainsConfig where LockStatusUnlocked (ClassifiedDomainsConfig []) FeatureTTLUnlimited + featureSingleton = FeatureSingletonClassifiedDomainsConfig objectSchema = field "config" schema ---------------------------------------------------------------------- @@ -769,6 +801,7 @@ instance IsFeatureConfig AppLockConfig where LockStatusUnlocked (AppLockConfig (EnforceAppLock False) 60) FeatureTTLUnlimited + featureSingleton = FeatureSingletonAppLockConfig objectSchema = field "config" schema newtype EnforceAppLock = EnforceAppLock Bool @@ -789,6 +822,7 @@ data FileSharingConfig = FileSharingConfig instance IsFeatureConfig FileSharingConfig where type FeatureSymbol FileSharingConfig = "fileSharing" defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonFileSharingConfig objectSchema = pure FileSharingConfig instance ToSchema FileSharingConfig where @@ -821,6 +855,7 @@ instance IsFeatureConfig SelfDeletingMessagesConfig where LockStatusUnlocked (SelfDeletingMessagesConfig 0) FeatureTTLUnlimited + featureSingleton = FeatureSingletonSelfDeletingMessagesConfig objectSchema = field "config" schema ---------------------------------------------------------------------- @@ -849,6 +884,7 @@ instance IsFeatureConfig MLSConfig where defFeatureStatus = let config = MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 in withStatus FeatureStatusDisabled LockStatusUnlocked config FeatureTTLUnlimited + featureSingleton = FeatureSingletonMLSConfig objectSchema = field "config" schema ---------------------------------------------------------------------- @@ -861,6 +897,7 @@ data ExposeInvitationURLsToTeamAdminConfig = ExposeInvitationURLsToTeamAdminConf instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where type FeatureSymbol ExposeInvitationURLsToTeamAdminConfig = "exposeInvitationURLsToTeamAdmin" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonExposeInvitationURLsToTeamAdminConfig objectSchema = pure ExposeInvitationURLsToTeamAdminConfig instance ToSchema ExposeInvitationURLsToTeamAdminConfig where @@ -881,6 +918,7 @@ data OutlookCalIntegrationConfig = OutlookCalIntegrationConfig instance IsFeatureConfig OutlookCalIntegrationConfig where type FeatureSymbol OutlookCalIntegrationConfig = "outlookCalIntegration" defFeatureStatus = withStatus FeatureStatusDisabled LockStatusLocked OutlookCalIntegrationConfig FeatureTTLUnlimited + featureSingleton = FeatureSingletonOutlookCalIntegrationConfig objectSchema = pure OutlookCalIntegrationConfig instance ToSchema OutlookCalIntegrationConfig where @@ -938,6 +976,7 @@ instance IsFeatureConfig MlsE2EIdConfig where defFeatureStatus = withStatus FeatureStatusDisabled LockStatusUnlocked defValue FeatureTTLUnlimited where defValue = MlsE2EIdConfig (fromIntegral @Int (60 * 60 * 24)) Nothing + featureSingleton = FeatureSingletonMlsE2EIdConfig objectSchema = field "config" schema ---------------------------------------------------------------------- diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index cef9264c171..b47ef74f886 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -50,7 +50,6 @@ import Galley.API.Teams.Features import qualified Galley.API.Update as Update import Galley.API.Util import Galley.App -import Galley.Cassandra.TeamFeatures import qualified Galley.Data.Conversation as Data import Galley.Effects import Galley.Effects.ClientStore @@ -139,80 +138,80 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler id (base tid) <@> mkNamedAPI @"get-team-name" (Teams.getTeamNameInternalH tid) <@> mkNamedAPI @"update-team-status" (Teams.updateTeamStatus tid) <@> hoistAPISegment - ( mkNamedAPI @"unchecked-add-team-member" (Teams.uncheckedAddTeamMember @Cassandra tid) + ( mkNamedAPI @"unchecked-add-team-member" (Teams.uncheckedAddTeamMember tid) <@> mkNamedAPI @"unchecked-get-team-members" (Teams.uncheckedGetTeamMembersH tid) <@> mkNamedAPI @"unchecked-get-team-member" (Teams.uncheckedGetTeamMember tid) - <@> mkNamedAPI @"can-user-join-team" (Teams.canUserJoinTeam @Cassandra tid) + <@> mkNamedAPI @"can-user-join-team" (Teams.canUserJoinTeam tid) <@> mkNamedAPI @"unchecked-update-team-member" (Teams.uncheckedUpdateTeamMember Nothing Nothing tid) ) <@> mkNamedAPI @"user-is-team-owner" (Teams.userIsTeamOwner tid) <@> hoistAPISegment ( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid) - <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @Cassandra @SearchVisibilityAvailableConfig) tid) + <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid) ) featureAPI :: API IFeatureAPI GalleyEffects featureAPI = - mkNamedAPI @'("iget", SSOConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SSOConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", SSOConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", LegalholdConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatusInternal @Cassandra))) - <@> mkNamedAPI @'("ipatch", LegalholdConfig) (callsFed (exposeAnnotations (patchFeatureStatusInternal @Cassandra))) - <@> mkNamedAPI @'("iget", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityAvailableConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", SearchVisibilityAvailableConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", ValidateSAMLEmailsConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", ValidateSAMLEmailsConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", DigitalSignaturesConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", DigitalSignaturesConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", DigitalSignaturesConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", AppLockConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", AppLockConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", AppLockConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", FileSharingConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", FileSharingConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", FileSharingConfig) (updateLockStatus @Cassandra @FileSharingConfig) - <@> mkNamedAPI @'("ipatch", FileSharingConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", ConferenceCallingConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", ConferenceCallingConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", ConferenceCallingConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", SelfDeletingMessagesConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SelfDeletingMessagesConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", SelfDeletingMessagesConfig) (updateLockStatus @Cassandra @SelfDeletingMessagesConfig) - <@> mkNamedAPI @'("ipatch", SelfDeletingMessagesConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", GuestLinksConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", GuestLinksConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", GuestLinksConfig) (updateLockStatus @Cassandra @GuestLinksConfig) - <@> mkNamedAPI @'("ipatch", GuestLinksConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", SndFactorPasswordChallengeConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SndFactorPasswordChallengeConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", SndFactorPasswordChallengeConfig) (updateLockStatus @Cassandra @SndFactorPasswordChallengeConfig) - <@> mkNamedAPI @'("ipatch", SndFactorPasswordChallengeConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("igetmulti", SearchVisibilityInboundConfig) (getFeatureStatusMulti @Cassandra) - <@> mkNamedAPI @'("iget", ClassifiedDomainsConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iget", MLSConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", MLSConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", MLSConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", ExposeInvitationURLsToTeamAdminConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("iget", OutlookCalIntegrationConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", OutlookCalIntegrationConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", OutlookCalIntegrationConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", OutlookCalIntegrationConfig) (updateLockStatus @Cassandra @OutlookCalIntegrationConfig) - <@> mkNamedAPI @'("iget", MlsE2EIdConfig) (getFeatureStatus @Cassandra DontDoAuth) - <@> mkNamedAPI @'("iput", MlsE2EIdConfig) (setFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ipatch", MlsE2EIdConfig) (patchFeatureStatusInternal @Cassandra) - <@> mkNamedAPI @'("ilock", MlsE2EIdConfig) (updateLockStatus @Cassandra @MlsE2EIdConfig) - <@> mkNamedAPI @"feature-configs-internal" (maybe getAllFeatureConfigsForServer (getAllFeatureConfigsForUser @Cassandra)) + mkNamedAPI @'("iget", SSOConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SSOConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", SSOConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", LegalholdConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", LegalholdConfig) (callsFed (exposeAnnotations setFeatureStatusInternal)) + <@> mkNamedAPI @'("ipatch", LegalholdConfig) (callsFed (exposeAnnotations patchFeatureStatusInternal)) + <@> mkNamedAPI @'("iget", SearchVisibilityAvailableConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SearchVisibilityAvailableConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", SearchVisibilityAvailableConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", ValidateSAMLEmailsConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", ValidateSAMLEmailsConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", ValidateSAMLEmailsConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", DigitalSignaturesConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", DigitalSignaturesConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", DigitalSignaturesConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", AppLockConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", AppLockConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", AppLockConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", FileSharingConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", FileSharingConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ilock", FileSharingConfig) (updateLockStatus @FileSharingConfig) + <@> mkNamedAPI @'("ipatch", FileSharingConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", ConferenceCallingConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", ConferenceCallingConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", ConferenceCallingConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", SelfDeletingMessagesConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SelfDeletingMessagesConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ilock", SelfDeletingMessagesConfig) (updateLockStatus @SelfDeletingMessagesConfig) + <@> mkNamedAPI @'("ipatch", SelfDeletingMessagesConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", GuestLinksConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", GuestLinksConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ilock", GuestLinksConfig) (updateLockStatus @GuestLinksConfig) + <@> mkNamedAPI @'("ipatch", GuestLinksConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", SndFactorPasswordChallengeConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SndFactorPasswordChallengeConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ilock", SndFactorPasswordChallengeConfig) (updateLockStatus @SndFactorPasswordChallengeConfig) + <@> mkNamedAPI @'("ipatch", SndFactorPasswordChallengeConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("igetmulti", SearchVisibilityInboundConfig) getFeatureStatusMulti + <@> mkNamedAPI @'("iget", ClassifiedDomainsConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iget", MLSConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", MLSConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", MLSConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", ExposeInvitationURLsToTeamAdminConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", ExposeInvitationURLsToTeamAdminConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", SearchVisibilityInboundConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", SearchVisibilityInboundConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", SearchVisibilityInboundConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("iget", OutlookCalIntegrationConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", OutlookCalIntegrationConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", OutlookCalIntegrationConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("ilock", OutlookCalIntegrationConfig) (updateLockStatus @OutlookCalIntegrationConfig) + <@> mkNamedAPI @'("iget", MlsE2EIdConfig) (getFeatureStatus DontDoAuth) + <@> mkNamedAPI @'("iput", MlsE2EIdConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ipatch", MlsE2EIdConfig) patchFeatureStatusInternal + <@> mkNamedAPI @'("ilock", MlsE2EIdConfig) (updateLockStatus @MlsE2EIdConfig) + <@> mkNamedAPI @"feature-configs-internal" (maybe getAllFeatureConfigsForServer getAllFeatureConfigsForUser) internalSitemap :: Routes a (Sem GalleyEffects) () internalSitemap = unsafeCallsFed @'Galley @"on-client-removed" $ unsafeCallsFed @'Galley @"on-mls-message-sent" $ do diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs index 78a319801db..0f8a9a8ceb8 100644 --- a/services/galley/src/Galley/API/LegalHold.hs +++ b/services/galley/src/Galley/API/LegalHold.hs @@ -86,25 +86,23 @@ import Wire.Sem.Paging import Wire.Sem.Paging.Cassandra assertLegalHoldEnabledForTeam :: - forall db r. + forall r. ( Member LegalHoldStore r, Member TeamStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (ErrorS 'LegalHoldNotEnabled) r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => TeamId -> Sem r () assertLegalHoldEnabledForTeam tid = - unlessM (isLegalHoldEnabledForTeam @db tid) $ + unlessM (isLegalHoldEnabledForTeam tid) $ throwS @'LegalHoldNotEnabled isLegalHoldEnabledForTeam :: - forall db r. + forall r. ( Member LegalHoldStore r, Member TeamStore r, - Member (TeamFeatureStore db) r, - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig + Member TeamFeatureStore r ) => TeamId -> Sem r Bool @@ -114,7 +112,7 @@ isLegalHoldEnabledForTeam tid = do pure False FeatureLegalHoldDisabledByDefault -> do statusValue <- - Public.wssStatus <$$> TeamFeatures.getFeatureConfig @db (Proxy @Public.LegalholdConfig) tid + Public.wssStatus <$$> TeamFeatures.getFeatureConfig Public.FeatureSingletonLegalholdConfig tid pure $ case statusValue of Just Public.FeatureStatusEnabled -> True Just Public.FeatureStatusDisabled -> False @@ -123,25 +121,24 @@ isLegalHoldEnabledForTeam tid = do LegalHoldData.isTeamLegalholdWhitelisted tid createSettings :: - forall db r. + forall r. ( Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'LegalHoldNotEnabled) r, Member (ErrorS 'LegalHoldServiceInvalidKey) r, Member (ErrorS 'LegalHoldServiceBadResponse) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r, Member P.TinyLog r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => Local UserId -> TeamId -> Public.NewLegalHoldService -> Sem r Public.ViewLegalHoldService createSettings lzusr tid newService = do let zusr = tUnqualified lzusr - assertLegalHoldEnabledForTeam @db tid + assertLegalHoldEnabledForTeam tid zusrMembership <- getTeamMember tid zusr -- let zothers = map (view userId) membs -- Log.debug $ @@ -157,13 +154,12 @@ createSettings lzusr tid newService = do pure . viewLegalHoldService $ service getSettings :: - forall db r. + forall r. ( Member (ErrorS 'NotATeamMember) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => Local UserId -> TeamId -> Sem r Public.ViewLegalHoldService @@ -171,7 +167,7 @@ getSettings lzusr tid = do let zusr = tUnqualified lzusr zusrMembership <- getTeamMember tid zusr void $ maybe (throwS @'NotATeamMember) pure zusrMembership - isenabled <- isLegalHoldEnabledForTeam @db tid + isenabled <- isLegalHoldEnabledForTeam tid mresult <- LegalHoldData.getSettings tid pure $ case (isenabled, mresult) of (False, _) -> Public.ViewLegalHoldServiceDisabled @@ -179,7 +175,7 @@ getSettings lzusr tid = do (True, Just result) -> viewLegalHoldService result removeSettingsInternalPaging :: - forall db r. + forall r. ( Member BotAccess r, Member BrigAccess r, Member CodeStore r, @@ -208,19 +204,18 @@ removeSettingsInternalPaging :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (TeamMemberStore InternalPaging) r, Member TeamStore r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => Local UserId -> TeamId -> Public.RemoveLegalHoldSettingsRequest -> Sem r () -removeSettingsInternalPaging lzusr = removeSettings @db @InternalPaging (tUnqualified lzusr) +removeSettingsInternalPaging lzusr = removeSettings @InternalPaging (tUnqualified lzusr) removeSettings :: - forall db p r. + forall p r. ( Paging p, Bounded (PagingBounds p TeamMember), ( Member BotAccess r, @@ -251,19 +246,18 @@ removeSettings :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (TeamMemberStore p) r, Member TeamStore r ) ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => UserId -> TeamId -> Public.RemoveLegalHoldSettingsRequest -> Sem r () removeSettings zusr tid (Public.RemoveLegalHoldSettingsRequest mPassword) = do assertNotWhitelisting - assertLegalHoldEnabledForTeam @db tid + assertLegalHoldEnabledForTeam tid zusrMembership <- getTeamMember tid zusr -- let zothers = map (view userId) membs -- Log.debug $ @@ -414,7 +408,7 @@ grantConsent lusr tid = do -- | Request to provision a device on the legal hold service for a user requestDevice :: - forall db r. + forall r. ( Member BrigAccess r, Member ConversationStore r, Member (Error FederationError) r, @@ -441,10 +435,9 @@ requestDevice :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => Local UserId -> TeamId -> UserId -> @@ -452,7 +445,7 @@ requestDevice :: requestDevice lzusr tid uid = do let zusr = tUnqualified lzusr luid <- qualifyLocal uid - assertLegalHoldEnabledForTeam @db tid + assertLegalHoldEnabledForTeam tid P.debug $ Log.field "targets" (toByteString (tUnqualified luid)) . Log.field "action" (Log.val "LegalHold.requestDevice") @@ -493,7 +486,7 @@ requestDevice lzusr tid uid = do -- it gets interupted. There's really no reason to delete them anyways -- since they are replaced if needed when registering new LH devices. approveDevice :: - forall db r. + forall r. ( Member BrigAccess r, Member ConversationStore r, Member (Error AuthenticationError) r, @@ -520,10 +513,9 @@ approveDevice :: Member MemberStore r, Member ProposalStore r, Member P.TinyLog r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - TeamFeatures.FeaturePersistentConstraint db Public.LegalholdConfig => Local UserId -> ConnId -> TeamId -> @@ -533,7 +525,7 @@ approveDevice :: approveDevice lzusr connId tid uid (Public.ApproveLegalHoldForUserRequest mPassword) = do let zusr = tUnqualified lzusr luid <- qualifyLocal uid - assertLegalHoldEnabledForTeam @db tid + assertLegalHoldEnabledForTeam tid P.debug $ Log.field "targets" (toByteString (tUnqualified luid)) . Log.field "action" (Log.val "LegalHold.approveDevice") diff --git a/services/galley/src/Galley/API/Public.hs b/services/galley/src/Galley/API/Public.hs index 0846c7e9cb5..68e47fede6c 100644 --- a/services/galley/src/Galley/API/Public.hs +++ b/services/galley/src/Galley/API/Public.hs @@ -26,10 +26,8 @@ import Data.Qualified import qualified Galley.API.Query as Query import qualified Galley.API.Teams.Features as Features import Galley.App -import Galley.Cassandra.TeamFeatures import Galley.Effects import qualified Galley.Effects as E -import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import Galley.Options import Imports hiding (head) import Network.Wai @@ -45,7 +43,6 @@ import Wire.API.Error import Wire.API.Error.Galley import qualified Wire.API.Event.Team as Public () import Wire.API.Routes.API -import Wire.API.Team.Feature -- These are all the errors that can be thrown by wai-routing handlers. -- We don't do any static checks on these errors, so we simply remap them to @@ -92,29 +89,28 @@ sitemap :: Routes () (Sem GalleyEffects) () sitemap = do -- Bot API ------------------------------------------------------------ - get "/bot/conversation" (continueE (getBotConversationH @Cassandra)) $ + get "/bot/conversation" (continueE getBotConversationH) $ zauth ZAuthBot .&> zauthBotId .&. zauthConvId .&. accept "application" "json" getBotConversationH :: - forall db r. + forall r. ( Member E.ConversationStore r, Member (Input (Local ())) r, Member (Input Opts) r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (ErrorS 'AccessDenied) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, - Member TeamStore r, - FeaturePersistentConstraint db SndFactorPasswordChallengeConfig + Member TeamStore r ) => BotId ::: ConvId ::: JSON -> Sem r Response getBotConversationH arg@(bid ::: cid ::: _) = - Features.guardSecondFactorDisabled @db (botUserId bid) cid (Query.getBotConversationH arg) + Features.guardSecondFactorDisabled (botUserId bid) cid (Query.getBotConversationH arg) type JSON = Media "application" "json" diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs index 73de6113d96..6ea0853f8ba 100644 --- a/services/galley/src/Galley/API/Public/Conversation.hs +++ b/services/galley/src/Galley/API/Public/Conversation.hs @@ -23,7 +23,6 @@ import Galley.API.MLS.Types import Galley.API.Query import Galley.API.Update import Galley.App -import Galley.Cassandra.TeamFeatures import Imports import Wire.API.Federation.API import Wire.API.Routes.API @@ -44,7 +43,7 @@ conversationAPI = <@> mkNamedAPI @"list-conversations@v1" (callsFed (exposeAnnotations listConversations)) <@> mkNamedAPI @"list-conversations@v2" (callsFed (exposeAnnotations listConversations)) <@> mkNamedAPI @"list-conversations" (callsFed (exposeAnnotations listConversations)) - <@> mkNamedAPI @"get-conversation-by-reusable-code" (getConversationByReusableCode @Cassandra) + <@> mkNamedAPI @"get-conversation-by-reusable-code" getConversationByReusableCode <@> mkNamedAPI @"create-group-conversation@v2" (callsFed (exposeAnnotations createGroupConversationUpToV3)) <@> mkNamedAPI @"create-group-conversation@v3" (callsFed (exposeAnnotations createGroupConversationUpToV3)) <@> mkNamedAPI @"create-group-conversation" (callsFed (exposeAnnotations createGroupConversation)) @@ -57,13 +56,13 @@ conversationAPI = <@> mkNamedAPI @"add-members-to-conversation-unqualified2" (callsFed addMembersUnqualifiedV2) <@> mkNamedAPI @"add-members-to-conversation" (callsFed addMembers) <@> mkNamedAPI @"join-conversation-by-id-unqualified" (callsFed joinConversationById) - <@> mkNamedAPI @"join-conversation-by-code-unqualified" (callsFed (joinConversationByReusableCode @Cassandra)) - <@> mkNamedAPI @"code-check" (checkReusableCode @Cassandra) - <@> mkNamedAPI @"create-conversation-code-unqualified@v3" (addCodeUnqualified @Cassandra Nothing) - <@> mkNamedAPI @"create-conversation-code-unqualified" (addCodeUnqualifiedWithReqBody @Cassandra) - <@> mkNamedAPI @"get-conversation-guest-links-status" (getConversationGuestLinksStatus @Cassandra) + <@> mkNamedAPI @"join-conversation-by-code-unqualified" (callsFed joinConversationByReusableCode) + <@> mkNamedAPI @"code-check" checkReusableCode + <@> mkNamedAPI @"create-conversation-code-unqualified@v3" (addCodeUnqualified Nothing) + <@> mkNamedAPI @"create-conversation-code-unqualified" addCodeUnqualifiedWithReqBody + <@> mkNamedAPI @"get-conversation-guest-links-status" getConversationGuestLinksStatus <@> mkNamedAPI @"remove-code-unqualified" rmCodeUnqualified - <@> mkNamedAPI @"get-code" (getCode @Cassandra) + <@> mkNamedAPI @"get-code" getCode <@> mkNamedAPI @"member-typing-unqualified" (callsFed (exposeAnnotations memberTypingUnqualified)) <@> mkNamedAPI @"member-typing-qualified" (callsFed (exposeAnnotations memberTyping)) <@> mkNamedAPI @"remove-member-unqualified" (callsFed (exposeAnnotations removeMemberUnqualified)) diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index 028c3cfc1a0..65fd370b2b4 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -20,7 +20,6 @@ module Galley.API.Public.Feature where import Galley.API.Teams import Galley.API.Teams.Features import Galley.App -import Galley.Cassandra.TeamFeatures import Imports import Wire.API.Federation.API import Wire.API.Routes.API @@ -29,53 +28,53 @@ import Wire.API.Team.Feature featureAPI :: API FeatureAPI GalleyEffects featureAPI = - mkNamedAPI @'("get", SSOConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatus @Cassandra . DoAuth))) - <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus @Cassandra . DoAuth) + mkNamedAPI @'("get", SSOConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", LegalholdConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", LegalholdConfig) (callsFed (exposeAnnotations (setFeatureStatus . DoAuth))) + <@> mkNamedAPI @'("get", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get-deprecated", SearchVisibilityAvailableConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put-deprecated", SearchVisibilityAvailableConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @"get-search-visibility" getSearchVisibility - <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam @Cassandra @SearchVisibilityAvailableConfig)) - <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", AppLockConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", AppLockConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", FileSharingConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", OutlookCalIntegrationConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", OutlookCalIntegrationConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("get", MlsE2EIdConfig) (getFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @'("put", MlsE2EIdConfig) (setFeatureStatus @Cassandra . DoAuth) - <@> mkNamedAPI @"get-all-feature-configs-for-user" (getAllFeatureConfigsForUser @Cassandra) - <@> mkNamedAPI @"get-all-feature-configs-for-team" (getAllFeatureConfigsForTeam @Cassandra) - <@> mkNamedAPI @'("get-config", LegalholdConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SSOConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SearchVisibilityAvailableConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ValidateSAMLEmailsConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", DigitalSignaturesConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", AppLockConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", FileSharingConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ClassifiedDomainsConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", ConferenceCallingConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SelfDeletingMessagesConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", GuestLinksConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", SndFactorPasswordChallengeConfig) (getFeatureStatusForUser @Cassandra) - <@> mkNamedAPI @'("get-config", MLSConfig) (getFeatureStatusForUser @Cassandra) + <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam @SearchVisibilityAvailableConfig)) + <@> mkNamedAPI @'("get", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get-deprecated", ValidateSAMLEmailsConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", DigitalSignaturesConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get-deprecated", DigitalSignaturesConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", AppLockConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", AppLockConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", FileSharingConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", GuestLinksConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", SndFactorPasswordChallengeConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", SndFactorPasswordChallengeConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", MLSConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", MLSConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", ExposeInvitationURLsToTeamAdminConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", ExposeInvitationURLsToTeamAdminConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", SearchVisibilityInboundConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", SearchVisibilityInboundConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", OutlookCalIntegrationConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", OutlookCalIntegrationConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @'("get", MlsE2EIdConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", MlsE2EIdConfig) (setFeatureStatus . DoAuth) + <@> mkNamedAPI @"get-all-feature-configs-for-user" getAllFeatureConfigsForUser + <@> mkNamedAPI @"get-all-feature-configs-for-team" getAllFeatureConfigsForTeam + <@> mkNamedAPI @'("get-config", LegalholdConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", SSOConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", SearchVisibilityAvailableConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", ValidateSAMLEmailsConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", DigitalSignaturesConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", AppLockConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", FileSharingConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", ClassifiedDomainsConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", ConferenceCallingConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", SelfDeletingMessagesConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", GuestLinksConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", SndFactorPasswordChallengeConfig) getFeatureStatusForUser + <@> mkNamedAPI @'("get-config", MLSConfig) getFeatureStatusForUser diff --git a/services/galley/src/Galley/API/Public/LegalHold.hs b/services/galley/src/Galley/API/Public/LegalHold.hs index ef64ab8e4f5..b313b84e972 100644 --- a/services/galley/src/Galley/API/Public/LegalHold.hs +++ b/services/galley/src/Galley/API/Public/LegalHold.hs @@ -19,18 +19,17 @@ module Galley.API.Public.LegalHold where import Galley.API.LegalHold import Galley.App -import Galley.Cassandra.TeamFeatures import Wire.API.Federation.API import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.LegalHold legalHoldAPI :: API LegalHoldAPI GalleyEffects legalHoldAPI = - mkNamedAPI @"create-legal-hold-settings" (createSettings @Cassandra) - <@> mkNamedAPI @"get-legal-hold-settings" (getSettings @Cassandra) - <@> mkNamedAPI @"delete-legal-hold-settings" (callsFed (exposeAnnotations (removeSettingsInternalPaging @Cassandra))) + mkNamedAPI @"create-legal-hold-settings" createSettings + <@> mkNamedAPI @"get-legal-hold-settings" getSettings + <@> mkNamedAPI @"delete-legal-hold-settings" (callsFed (exposeAnnotations removeSettingsInternalPaging)) <@> mkNamedAPI @"get-legal-hold" getUserStatus <@> mkNamedAPI @"consent-to-legal-hold" (callsFed (exposeAnnotations grantConsent)) - <@> mkNamedAPI @"request-legal-hold-device" (callsFed (exposeAnnotations (requestDevice @Cassandra))) + <@> mkNamedAPI @"request-legal-hold-device" (callsFed (exposeAnnotations requestDevice)) <@> mkNamedAPI @"disable-legal-hold-for-user" (callsFed (exposeAnnotations disableForUser)) - <@> mkNamedAPI @"approve-legal-hold-device" (callsFed (exposeAnnotations (approveDevice @Cassandra))) + <@> mkNamedAPI @"approve-legal-hold-device" (callsFed (exposeAnnotations approveDevice)) diff --git a/services/galley/src/Galley/API/Public/TeamMember.hs b/services/galley/src/Galley/API/Public/TeamMember.hs index af7e761c663..91956a21712 100644 --- a/services/galley/src/Galley/API/Public/TeamMember.hs +++ b/services/galley/src/Galley/API/Public/TeamMember.hs @@ -19,7 +19,6 @@ module Galley.API.Public.TeamMember where import Galley.API.Teams import Galley.App -import Galley.Cassandra.TeamFeatures import Wire.API.Routes.API import Wire.API.Routes.Public.Galley.TeamMember @@ -28,7 +27,7 @@ teamMemberAPI = mkNamedAPI @"get-team-members" getTeamMembers <@> mkNamedAPI @"get-team-member" getTeamMember <@> mkNamedAPI @"get-team-members-by-ids" bulkGetTeamMembers - <@> mkNamedAPI @"add-team-member" (addTeamMember @Cassandra) + <@> mkNamedAPI @"add-team-member" addTeamMember <@> mkNamedAPI @"delete-team-member" deleteTeamMember <@> mkNamedAPI @"delete-non-binding-team-member" deleteNonBindingTeamMember <@> mkNamedAPI @"update-team-member" updateTeamMember diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 5aa2733ec0d..218d7a12de8 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -67,7 +67,6 @@ import qualified Galley.Effects.ConversationStore as E import qualified Galley.Effects.FederatorAccess as E import qualified Galley.Effects.ListItems as E import qualified Galley.Effects.MemberStore as E -import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import qualified Galley.Effects.TeamFeatureStore as TeamFeatures import Galley.Env import Galley.Options @@ -620,7 +619,7 @@ getConversationMeta cnv = do pure Nothing getConversationByReusableCode :: - forall db r. + forall r. ( Member BrigAccess r, Member CodeStore r, Member ConversationStore r, @@ -631,9 +630,8 @@ getConversationByReusableCode :: Member (ErrorS 'GuestLinksDisabled) r, Member (ErrorS 'NotATeamMember) r, Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (Input Opts) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r, + Member (Input Opts) r ) => Local UserId -> Key -> @@ -643,7 +641,7 @@ getConversationByReusableCode lusr key value = do c <- verifyReusableCode False Nothing (ConversationCode key value Nothing) conv <- E.getConversation (codeConversation c) >>= noteS @'ConvNotFound ensureConversationAccess (tUnqualified lusr) conv CodeAccess - ensureGuestLinksEnabled @db (Data.convTeam conv) + ensureGuestLinksEnabled (Data.convTeam conv) pure $ coverView c conv where coverView :: Data.Code -> Data.Conversation -> ConversationCoverView @@ -655,27 +653,25 @@ getConversationByReusableCode lusr key value = do } ensureGuestLinksEnabled :: - forall db r. + forall r. ( Member (ErrorS 'GuestLinksDisabled) r, - Member (TeamFeatureStore db) r, - Member (Input Opts) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r, + Member (Input Opts) r ) => Maybe TeamId -> Sem r () ensureGuestLinksEnabled mbTid = - getConversationGuestLinksFeatureStatus @db mbTid >>= \ws -> case wsStatus ws of + getConversationGuestLinksFeatureStatus mbTid >>= \ws -> case wsStatus ws of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> throwS @'GuestLinksDisabled getConversationGuestLinksStatus :: - forall db r. + forall r. ( Member ConversationStore r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'ConvAccessDenied) r, Member (Input Opts) r, - Member (TeamFeatureStore db) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r ) => UserId -> ConvId -> @@ -683,13 +679,12 @@ getConversationGuestLinksStatus :: getConversationGuestLinksStatus uid convId = do conv <- E.getConversation convId >>= noteS @'ConvNotFound ensureConvAdmin (Data.convLocalMembers conv) uid - getConversationGuestLinksFeatureStatus @db (Data.convTeam conv) + getConversationGuestLinksFeatureStatus (Data.convTeam conv) getConversationGuestLinksFeatureStatus :: - forall db r. - ( Member (TeamFeatureStore db) r, - Member (Input Opts) r, - FeaturePersistentConstraint db GuestLinksConfig + forall r. + ( Member TeamFeatureStore r, + Member (Input Opts) r ) => Maybe TeamId -> Sem r (WithStatus GuestLinksConfig) @@ -698,8 +693,8 @@ getConversationGuestLinksFeatureStatus mbTid = do case mbTid of Nothing -> pure defaultStatus Just tid -> do - mbConfigNoLock <- TeamFeatures.getFeatureConfig @db (Proxy @GuestLinksConfig) tid - mbLockStatus <- TeamFeatures.getFeatureLockStatus @db (Proxy @GuestLinksConfig) tid + mbConfigNoLock <- TeamFeatures.getFeatureConfig FeatureSingletonGuestLinksConfig tid + mbLockStatus <- TeamFeatures.getFeatureLockStatus FeatureSingletonGuestLinksConfig tid pure $ computeFeatureConfigForTeamUser mbConfigNoLock mbLockStatus defaultStatus -- | The same as 'getMLSSelfConversation', but it throws an error in case the diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs index 1c8a93461c7..74467c1914d 100644 --- a/services/galley/src/Galley/API/Teams.hs +++ b/services/galley/src/Galley/API/Teams.hs @@ -101,7 +101,6 @@ import qualified Galley.Effects.MemberStore as E import qualified Galley.Effects.Queue as E import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData import qualified Galley.Effects.SparAccess as Spar -import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import qualified Galley.Effects.TeamMemberStore as E import qualified Galley.Effects.TeamStore as E import qualified Galley.Intra.Journal as Journal @@ -138,7 +137,6 @@ import qualified Wire.API.Team as Public import Wire.API.Team.Conversation import qualified Wire.API.Team.Conversation as Public import Wire.API.Team.Export (TeamExportUser (..)) -import Wire.API.Team.Feature import Wire.API.Team.Member import qualified Wire.API.Team.Member as Public import Wire.API.Team.Permission (Perm (..), Permissions (..), SPerm (..), copy, fullPermissions, self) @@ -701,7 +699,7 @@ uncheckedGetTeamMembers :: uncheckedGetTeamMembers = E.getTeamMembersWithLimit addTeamMember :: - forall db r. + forall r. ( Member BrigAccess r, Member GundeckAccess r, Member (ErrorS 'InvalidPermissions) r, @@ -716,11 +714,10 @@ addTeamMember :: Member (Input Opts) r, Member (Input UTCTime) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamNotificationStore r, Member TeamStore r, - Member P.TinyLog r, - FeaturePersistentConstraint db LegalholdConfig + Member P.TinyLog r ) => Local UserId -> ConnId -> @@ -743,13 +740,13 @@ addTeamMember lzusr zcon tid nmem = do ensureUnboundUsers [uid] ensureConnectedToLocals zusr [uid] (TeamSize sizeBeforeJoin) <- E.getSize tid - ensureNotTooLargeForLegalHold @db tid (fromIntegral sizeBeforeJoin + 1) + ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1) memList <- getTeamMembersForFanout tid void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem memList -- This function is "unchecked" because there is no need to check for user binding (invite only). uncheckedAddTeamMember :: - forall db r. + forall r. ( Member BrigAccess r, Member GundeckAccess r, Member (ErrorS 'TooManyTeamMembers) r, @@ -758,10 +755,9 @@ uncheckedAddTeamMember :: Member (Input UTCTime) r, Member LegalHoldStore r, Member P.TinyLog r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamNotificationStore r, - Member TeamStore r, - FeaturePersistentConstraint db LegalholdConfig + Member TeamStore r ) => TeamId -> NewTeamMember -> @@ -769,7 +765,7 @@ uncheckedAddTeamMember :: uncheckedAddTeamMember tid nmem = do mems <- getTeamMembersForFanout tid (TeamSize sizeBeforeJoin) <- E.getSize tid - ensureNotTooLargeForLegalHold @db tid (fromIntegral sizeBeforeJoin + 1) + ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1) (TeamSize sizeBeforeAdd) <- addTeamMemberInternal tid Nothing Nothing nmem mems billingUserIds <- Journal.getBillingUserIds tid $ Just $ newTeamMemberList (ntmNewTeamMember nmem : mems ^. teamMembers) (mems ^. teamMemberListType) Journal.teamUpdate tid (sizeBeforeAdd + 1) billingUserIds @@ -1236,18 +1232,17 @@ ensureNotTooLarge tid = do -- LegalHold off after activation. -- FUTUREWORK: Find a way around the fanout limit. ensureNotTooLargeForLegalHold :: - forall db r. + forall r. ( Member LegalHoldStore r, Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, - FeaturePersistentConstraint db LegalholdConfig + Member TeamFeatureStore r, + Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r ) => TeamId -> Int -> Sem r () ensureNotTooLargeForLegalHold tid teamSize = - whenM (isLegalHoldEnabledForTeam @db tid) $ + whenM (isLegalHoldEnabledForTeam tid) $ unlessM (teamSizeBelowLimit teamSize) $ throwS @'TooManyTeamMembersOnTeamWithLegalhold @@ -1374,21 +1369,20 @@ getBindingTeamMembers zusr = do -- thrown in IO, we could then refactor that to be thrown in `ExceptT -- RegisterError`. canUserJoinTeam :: - forall db r. + forall r. ( Member BrigAccess r, Member LegalHoldStore r, Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r, - FeaturePersistentConstraint db LegalholdConfig + Member TeamFeatureStore r, + Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r ) => TeamId -> Sem r () canUserJoinTeam tid = do - lhEnabled <- isLegalHoldEnabledForTeam @db tid + lhEnabled <- isLegalHoldEnabledForTeam tid when lhEnabled $ do (TeamSize sizeBeforeJoin) <- E.getSize tid - ensureNotTooLargeForLegalHold @db tid (fromIntegral sizeBeforeJoin + 1) + ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1) -- | Modify and get visibility type for a team (internal, no user permission checks) getSearchVisibilityInternal :: diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index 85d87da6601..9447f6dd0b8 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -41,7 +41,6 @@ import Data.Bifunctor (second) import Data.ByteString.Conversion (toByteString') import Data.Id import Data.Kind -import Data.Proxy (Proxy (Proxy)) import Data.Qualified (Local, tUnqualified) import Data.Schema import Data.String.Conversions (cs) @@ -86,27 +85,23 @@ import Wire.Sem.Paging.Cassandra data DoAuth = DoAuth UserId | DontDoAuth -- | Don't export methods of this typeclass -class GetFeatureConfig (db :: Type) cfg where - type GetConfigForTeamConstraints db cfg (r :: EffectRow) :: Constraint +class IsFeatureConfig cfg => GetFeatureConfig cfg where + type GetConfigForTeamConstraints cfg (r :: EffectRow) :: Constraint type - GetConfigForTeamConstraints db cfg (r :: EffectRow) = - ( FeaturePersistentConstraint db cfg, - ( Member (Input Opts) r, - Member (TeamFeatureStore db) r - ) + GetConfigForTeamConstraints cfg (r :: EffectRow) = + ( Member (Input Opts) r, + Member TeamFeatureStore r ) - type GetConfigForUserConstraints db cfg (r :: EffectRow) :: Constraint + type GetConfigForUserConstraints cfg (r :: EffectRow) :: Constraint type - GetConfigForUserConstraints db cfg (r :: EffectRow) = - ( FeaturePersistentConstraint db cfg, - ( Member (Input Opts) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r, - Member (TeamFeatureStore db) r - ) + GetConfigForUserConstraints cfg (r :: EffectRow) = + ( Member (Input Opts) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r, + Member TeamFeatureStore r ) getConfigForServer :: @@ -115,54 +110,48 @@ class GetFeatureConfig (db :: Type) cfg where -- only override if there is additional business logic for getting the feature config -- and/or if the feature flag is configured for the backend in 'FeatureFlags' for galley in 'Galley.Types.Teams' -- otherwise this will return the default config from wire-api - default getConfigForServer :: (IsFeatureConfig cfg) => Sem r (WithStatus cfg) + default getConfigForServer :: Sem r (WithStatus cfg) getConfigForServer = pure defFeatureStatus getConfigForTeam :: - GetConfigForTeamConstraints db cfg r => + GetConfigForTeamConstraints cfg r => TeamId -> Sem r (WithStatus cfg) default getConfigForTeam :: - ( FeaturePersistentConstraint db cfg, - ( Member (Input Opts) r, - Member (TeamFeatureStore db) r - ) + ( Member (Input Opts) r, + Member TeamFeatureStore r ) => TeamId -> Sem r (WithStatus cfg) - getConfigForTeam = genericGetConfigForTeam @db + getConfigForTeam = genericGetConfigForTeam getConfigForUser :: - GetConfigForUserConstraints db cfg r => + GetConfigForUserConstraints cfg r => UserId -> Sem r (WithStatus cfg) default getConfigForUser :: - ( FeaturePersistentConstraint db cfg, - ( Member (Input Opts) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r, - Member (TeamFeatureStore db) r - ) + ( Member (Input Opts) r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r, + Member TeamFeatureStore r ) => UserId -> Sem r (WithStatus cfg) - getConfigForUser = genericGetConfigForUser @db + getConfigForUser = genericGetConfigForUser -- | Don't export methods of this typeclass -class GetFeatureConfig (db :: Type) cfg => SetFeatureConfig (db :: Type) cfg where - type SetConfigForTeamConstraints db cfg (r :: EffectRow) :: Constraint - type SetConfigForTeamConstraints db cfg (r :: EffectRow) = () +class GetFeatureConfig cfg => SetFeatureConfig cfg where + type SetConfigForTeamConstraints cfg (r :: EffectRow) :: Constraint + type SetConfigForTeamConstraints cfg (r :: EffectRow) = () -- | This method should generate the side-effects of changing the feature and -- also (depending on the feature) persist the new setting to the database and -- push a event to clients (see 'persistAndPushEvent'). setConfigForTeam :: - ( SetConfigForTeamConstraints db cfg r, - GetConfigForTeamConstraints db cfg r, - FeaturePersistentConstraint db cfg, - ( Member (TeamFeatureStore db) r, + ( SetConfigForTeamConstraints cfg r, + GetConfigForTeamConstraints cfg r, + ( Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, Member GundeckAccess r, Member TeamStore r @@ -172,13 +161,11 @@ class GetFeatureConfig (db :: Type) cfg => SetFeatureConfig (db :: Type) cfg whe WithStatusNoLock cfg -> Sem r (WithStatus cfg) default setConfigForTeam :: - ( GetConfigForTeamConstraints db cfg r, - FeaturePersistentConstraint db cfg, - IsFeatureConfig cfg, + ( GetConfigForTeamConstraints cfg r, KnownSymbol (FeatureSymbol cfg), ToSchema cfg, Members - '[ TeamFeatureStore db, + '[ TeamFeatureStore, P.Logger (Log.Msg -> Log.Msg), GundeckAccess, TeamStore @@ -188,32 +175,12 @@ class GetFeatureConfig (db :: Type) cfg => SetFeatureConfig (db :: Type) cfg whe TeamId -> WithStatusNoLock cfg -> Sem r (WithStatus cfg) - setConfigForTeam tid wsnl = persistAndPushEvent @db tid wsnl - -type FeaturePersistentAllFeatures db = - ( FeaturePersistentConstraint db LegalholdConfig, - FeaturePersistentConstraint db SSOConfig, - FeaturePersistentConstraint db SearchVisibilityAvailableConfig, - FeaturePersistentConstraint db ValidateSAMLEmailsConfig, - FeaturePersistentConstraint db DigitalSignaturesConfig, - FeaturePersistentConstraint db AppLockConfig, - FeaturePersistentConstraint db FileSharingConfig, - FeaturePersistentConstraint db ClassifiedDomainsConfig, - FeaturePersistentConstraint db ConferenceCallingConfig, - FeaturePersistentConstraint db SelfDeletingMessagesConfig, - FeaturePersistentConstraint db GuestLinksConfig, - FeaturePersistentConstraint db SndFactorPasswordChallengeConfig, - FeaturePersistentConstraint db MLSConfig, - FeaturePersistentConstraint db SearchVisibilityInboundConfig, - FeaturePersistentConstraint db ExposeInvitationURLsToTeamAdminConfig, - FeaturePersistentConstraint db OutlookCalIntegrationConfig, - FeaturePersistentConstraint db MlsE2EIdConfig - ) + setConfigForTeam tid wsnl = persistAndPushEvent tid wsnl getFeatureStatus :: - forall db cfg r. - ( GetFeatureConfig db cfg, - GetConfigForTeamConstraints db cfg r, + forall cfg r. + ( GetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, ( Member (ErrorS OperationDenied) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, @@ -229,20 +196,18 @@ getFeatureStatus doauth tid = do getTeamMember tid uid >>= maybe (throwS @'NotATeamMember) (const $ pure ()) DontDoAuth -> assertTeamExists tid - getConfigForTeam @db @cfg tid + getConfigForTeam @cfg tid getFeatureStatusMulti :: - forall db cfg r. - ( GetFeatureConfig db cfg, - FeaturePersistentConstraint db cfg, - ( Member (Input Opts) r, - Member (TeamFeatureStore db) r - ) + forall cfg r. + ( GetFeatureConfig cfg, + Member (Input Opts) r, + Member TeamFeatureStore r ) => Multi.TeamFeatureNoConfigMultiRequest -> Sem r (Multi.TeamFeatureNoConfigMultiResponse cfg) getFeatureStatusMulti (Multi.TeamFeatureNoConfigMultiRequest tids) = do - cfgs <- genericGetConfigForMultiTeam @db @cfg tids + cfgs <- genericGetConfigForMultiTeam @cfg tids let xs = uncurry toTeamStatus . second forgetLock <$> cfgs pure $ Multi.TeamFeatureNoConfigMultiResponse xs @@ -250,29 +215,26 @@ toTeamStatus :: TeamId -> WithStatusNoLock cfg -> Multi.TeamStatus cfg toTeamStatus tid ws = Multi.TeamStatus tid (wssStatus ws) patchFeatureStatusInternal :: - forall db cfg r. - ( SetFeatureConfig db cfg, - GetConfigForTeamConstraints db cfg r, - SetConfigForTeamConstraints db cfg r, - FeaturePersistentConstraint db cfg, - ( Member (ErrorS 'NotATeamMember) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'TeamNotFound) r, - Member (Error TeamFeatureError) r, - Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, - Member GundeckAccess r - ) + forall cfg r. + ( SetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, + SetConfigForTeamConstraints cfg r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member GundeckAccess r ) => TeamId -> WithStatusPatch cfg -> Sem r (WithStatus cfg) patchFeatureStatusInternal tid patch = do - currentFeatureStatus <- getFeatureStatus @db @cfg DontDoAuth tid + currentFeatureStatus <- getFeatureStatus @cfg DontDoAuth tid let newFeatureStatus = applyPatch currentFeatureStatus - when (isJust $ wspLockStatus patch) $ void $ updateLockStatus @db @cfg tid (wsLockStatus newFeatureStatus) - setConfigForTeam @db @cfg tid (forgetLock newFeatureStatus) + when (isJust $ wspLockStatus patch) $ void $ updateLockStatus @cfg tid (wsLockStatus newFeatureStatus) + setConfigForTeam @cfg tid (forgetLock newFeatureStatus) where applyPatch :: WithStatus cfg -> WithStatus cfg applyPatch current = @@ -283,20 +245,18 @@ patchFeatureStatusInternal tid patch = do & setWsTTL (fromMaybe (wsTTL current) (wspTTL patch)) setFeatureStatus :: - forall db cfg r. - ( SetFeatureConfig db cfg, - GetConfigForTeamConstraints db cfg r, - SetConfigForTeamConstraints db cfg r, - FeaturePersistentConstraint db cfg, - ( Member (ErrorS 'NotATeamMember) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'TeamNotFound) r, - Member (Error TeamFeatureError) r, - Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, - Member GundeckAccess r - ) + forall cfg r. + ( SetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, + SetConfigForTeamConstraints cfg r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'TeamNotFound) r, + Member (Error TeamFeatureError) r, + Member TeamStore r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member GundeckAccess r ) => DoAuth -> TeamId -> @@ -309,34 +269,32 @@ setFeatureStatus doauth tid wsnl = do void $ permissionCheck ChangeTeamFeature zusrMembership DontDoAuth -> assertTeamExists tid - guardLockStatus . wsLockStatus =<< getConfigForTeam @db @cfg tid - setConfigForTeam @db @cfg tid wsnl + guardLockStatus . wsLockStatus =<< getConfigForTeam @cfg tid + setConfigForTeam @cfg tid wsnl setFeatureStatusInternal :: - forall db cfg r. - ( SetFeatureConfig db cfg, - GetConfigForTeamConstraints db cfg r, - SetConfigForTeamConstraints db cfg r, - FeaturePersistentConstraint db cfg, - ( Member (ErrorS 'NotATeamMember) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'TeamNotFound) r, - Member (Error TeamFeatureError) r, - Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, - Member GundeckAccess r - ) + forall cfg r. + ( SetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, + SetConfigForTeamConstraints cfg r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'TeamNotFound) r, + Member (Error TeamFeatureError) r, + Member TeamStore r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member GundeckAccess r ) => TeamId -> WithStatusNoLock cfg -> Sem r (WithStatus cfg) -setFeatureStatusInternal = setFeatureStatus @db @cfg DontDoAuth +setFeatureStatusInternal = setFeatureStatus @cfg DontDoAuth updateLockStatus :: - forall db cfg r. - ( FeaturePersistentConstraint db cfg, - Member (TeamFeatureStore db) r, + forall cfg r. + ( IsFeatureConfig cfg, + Member TeamFeatureStore r, Member TeamStore r, Member (ErrorS 'TeamNotFound) r ) => @@ -345,7 +303,7 @@ updateLockStatus :: Sem r LockStatusResponse updateLockStatus tid lockStatus = do assertTeamExists tid - TeamFeatures.setFeatureLockStatus @db (Proxy @cfg) tid lockStatus + TeamFeatures.setFeatureLockStatus (featureSingleton @cfg) tid lockStatus pure $ LockStatusResponse lockStatus -- | For individual users to get feature config for their account (personal or team). @@ -353,13 +311,13 @@ updateLockStatus tid lockStatus = do -- Here we explicitly return the team setting if the user is a team member. -- In `getConfigForUser` this is mostly also the case. But there are exceptions, e.g. `ConferenceCallingConfig` getFeatureStatusForUser :: - forall (db :: Type) cfg r. + forall cfg r. ( Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - GetConfigForTeamConstraints db cfg r, - GetConfigForUserConstraints db cfg r, - GetFeatureConfig db cfg + GetConfigForTeamConstraints cfg r, + GetConfigForUserConstraints cfg r, + GetFeatureConfig cfg ) => UserId -> Sem r (WithStatus cfg) @@ -367,25 +325,24 @@ getFeatureStatusForUser zusr = do mbTeam <- getOneUserTeam zusr case mbTeam of Nothing -> - getConfigForUser @db @cfg zusr + getConfigForUser @cfg zusr Just tid -> do zusrMembership <- getTeamMember tid zusr void $ maybe (throwS @'NotATeamMember) pure zusrMembership assertTeamExists tid - getConfigForTeam @db @cfg tid + getConfigForTeam @cfg tid getAllFeatureConfigsForUser :: - forall db r. + forall r. ( Member BrigAccess r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r, Member (Input Opts) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - FeaturePersistentAllFeatures db => UserId -> Sem r AllFeatureConfigs getAllFeatureConfigsForUser zusr = do @@ -395,26 +352,25 @@ getAllFeatureConfigsForUser zusr = do maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership case mbTeam of Just tid -> - getAllFeatureConfigsTeam @db tid + getAllFeatureConfigsTeam tid Nothing -> - getAllFeatureConfigsUser @db zusr + getAllFeatureConfigsUser zusr getAllFeatureConfigsForTeam :: - forall db r. + forall r. ( Member (ErrorS 'NotATeamMember) r, Member (Input Opts) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - FeaturePersistentAllFeatures db => Local UserId -> TeamId -> Sem r AllFeatureConfigs getAllFeatureConfigsForTeam luid tid = do zusrMembership <- getTeamMember tid (tUnqualified luid) maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership - getAllFeatureConfigsTeam @db tid + getAllFeatureConfigsTeam tid getAllFeatureConfigsForServer :: forall r. @@ -441,108 +397,103 @@ getAllFeatureConfigsForServer = <*> getConfigForServer @MlsE2EIdConfig getAllFeatureConfigsUser :: - forall db r. + forall r. ( Member BrigAccess r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member (ErrorS OperationDenied) r, Member (Input Opts) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - FeaturePersistentAllFeatures db => UserId -> Sem r AllFeatureConfigs getAllFeatureConfigsUser uid = AllFeatureConfigs - <$> getConfigForUser @db @LegalholdConfig uid - <*> getConfigForUser @db @SSOConfig uid - <*> getConfigForUser @db @SearchVisibilityAvailableConfig uid - <*> getConfigForUser @db @SearchVisibilityInboundConfig uid - <*> getConfigForUser @db @ValidateSAMLEmailsConfig uid - <*> getConfigForUser @db @DigitalSignaturesConfig uid - <*> getConfigForUser @db @AppLockConfig uid - <*> getConfigForUser @db @FileSharingConfig uid - <*> getConfigForUser @db @ClassifiedDomainsConfig uid - <*> getConfigForUser @db @ConferenceCallingConfig uid - <*> getConfigForUser @db @SelfDeletingMessagesConfig uid - <*> getConfigForUser @db @GuestLinksConfig uid - <*> getConfigForUser @db @SndFactorPasswordChallengeConfig uid - <*> getConfigForUser @db @MLSConfig uid - <*> getConfigForUser @db @ExposeInvitationURLsToTeamAdminConfig uid - <*> getConfigForUser @db @OutlookCalIntegrationConfig uid - <*> getConfigForUser @db @MlsE2EIdConfig uid + <$> getConfigForUser @LegalholdConfig uid + <*> getConfigForUser @SSOConfig uid + <*> getConfigForUser @SearchVisibilityAvailableConfig uid + <*> getConfigForUser @SearchVisibilityInboundConfig uid + <*> getConfigForUser @ValidateSAMLEmailsConfig uid + <*> getConfigForUser @DigitalSignaturesConfig uid + <*> getConfigForUser @AppLockConfig uid + <*> getConfigForUser @FileSharingConfig uid + <*> getConfigForUser @ClassifiedDomainsConfig uid + <*> getConfigForUser @ConferenceCallingConfig uid + <*> getConfigForUser @SelfDeletingMessagesConfig uid + <*> getConfigForUser @GuestLinksConfig uid + <*> getConfigForUser @SndFactorPasswordChallengeConfig uid + <*> getConfigForUser @MLSConfig uid + <*> getConfigForUser @ExposeInvitationURLsToTeamAdminConfig uid + <*> getConfigForUser @OutlookCalIntegrationConfig uid + <*> getConfigForUser @MlsE2EIdConfig uid getAllFeatureConfigsTeam :: - forall db r. + forall r. ( Member (Input Opts) r, Member LegalHoldStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member TeamStore r ) => - FeaturePersistentAllFeatures db => TeamId -> Sem r AllFeatureConfigs getAllFeatureConfigsTeam tid = AllFeatureConfigs - <$> getConfigForTeam @db @LegalholdConfig tid - <*> getConfigForTeam @db @SSOConfig tid - <*> getConfigForTeam @db @SearchVisibilityAvailableConfig tid - <*> getConfigForTeam @db @SearchVisibilityInboundConfig tid - <*> getConfigForTeam @db @ValidateSAMLEmailsConfig tid - <*> getConfigForTeam @db @DigitalSignaturesConfig tid - <*> getConfigForTeam @db @AppLockConfig tid - <*> getConfigForTeam @db @FileSharingConfig tid - <*> getConfigForTeam @db @ClassifiedDomainsConfig tid - <*> getConfigForTeam @db @ConferenceCallingConfig tid - <*> getConfigForTeam @db @SelfDeletingMessagesConfig tid - <*> getConfigForTeam @db @GuestLinksConfig tid - <*> getConfigForTeam @db @SndFactorPasswordChallengeConfig tid - <*> getConfigForTeam @db @MLSConfig tid - <*> getConfigForTeam @db @ExposeInvitationURLsToTeamAdminConfig tid - <*> getConfigForTeam @db @OutlookCalIntegrationConfig tid - <*> getConfigForTeam @db @MlsE2EIdConfig tid + <$> getConfigForTeam @LegalholdConfig tid + <*> getConfigForTeam @SSOConfig tid + <*> getConfigForTeam @SearchVisibilityAvailableConfig tid + <*> getConfigForTeam @SearchVisibilityInboundConfig tid + <*> getConfigForTeam @ValidateSAMLEmailsConfig tid + <*> getConfigForTeam @DigitalSignaturesConfig tid + <*> getConfigForTeam @AppLockConfig tid + <*> getConfigForTeam @FileSharingConfig tid + <*> getConfigForTeam @ClassifiedDomainsConfig tid + <*> getConfigForTeam @ConferenceCallingConfig tid + <*> getConfigForTeam @SelfDeletingMessagesConfig tid + <*> getConfigForTeam @GuestLinksConfig tid + <*> getConfigForTeam @SndFactorPasswordChallengeConfig tid + <*> getConfigForTeam @MLSConfig tid + <*> getConfigForTeam @ExposeInvitationURLsToTeamAdminConfig tid + <*> getConfigForTeam @OutlookCalIntegrationConfig tid + <*> getConfigForTeam @MlsE2EIdConfig tid -- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig genericGetConfigForTeam :: - forall db cfg r. - GetFeatureConfig db cfg => - FeaturePersistentConstraint db cfg => - Member (TeamFeatureStore db) r => + forall cfg r. + GetFeatureConfig cfg => + Member TeamFeatureStore r => Member (Input Opts) r => TeamId -> Sem r (WithStatus cfg) genericGetConfigForTeam tid = do computeFeatureConfigForTeamUser - <$> TeamFeatures.getFeatureConfig @db (Proxy @cfg) tid - <*> TeamFeatures.getFeatureLockStatus @db (Proxy @cfg) tid - <*> getConfigForServer @db + <$> TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid + <*> TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid + <*> getConfigForServer -- Note: this function assumes the feature cannot be locked genericGetConfigForMultiTeam :: - forall db cfg r. - GetFeatureConfig db cfg => - FeaturePersistentConstraint db cfg => - Member (TeamFeatureStore db) r => + forall cfg r. + GetFeatureConfig cfg => + Member TeamFeatureStore r => Member (Input Opts) r => [TeamId] -> Sem r [(TeamId, WithStatus cfg)] genericGetConfigForMultiTeam tids = do - def <- getConfigForServer @db + def <- getConfigForServer (\(tid, mwsnl) -> (tid, computeFeatureConfigForTeamUser mwsnl (Just LockStatusUnlocked) def)) - <$$> TeamFeatures.getFeatureConfigMulti @db (Proxy @cfg) tids + <$$> TeamFeatures.getFeatureConfigMulti (featureSingleton @cfg) tids -- | Note: this is an internal function which doesn't cover all features, e.g. conference calling genericGetConfigForUser :: - forall db cfg r. - FeaturePersistentConstraint db cfg => + forall cfg r. ( Member (Input Opts) r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - GetFeatureConfig db cfg + GetFeatureConfig cfg ) => UserId -> Sem r (WithStatus cfg) @@ -550,33 +501,30 @@ genericGetConfigForUser uid = do mbTeam <- getOneUserTeam uid case mbTeam of Nothing -> do - getConfigForServer @db + getConfigForServer Just tid -> do zusrMembership <- getTeamMember tid uid maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership assertTeamExists tid - genericGetConfigForTeam @db tid + genericGetConfigForTeam tid persistAndPushEvent :: - forall (db :: Type) cfg r. - ( IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), + forall cfg r. + ( KnownSymbol (FeatureSymbol cfg), ToSchema cfg, - GetFeatureConfig db cfg, - FeaturePersistentConstraint db cfg, - GetConfigForTeamConstraints db cfg r, - ( Member (TeamFeatureStore db) r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, - Member GundeckAccess r, - Member TeamStore r - ) + GetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member GundeckAccess r, + Member TeamStore r ) => TeamId -> WithStatusNoLock cfg -> Sem r (WithStatus cfg) persistAndPushEvent tid wsnl = do - setFeatureConfig @db (Proxy @cfg) tid wsnl - fs <- getConfigForTeam @db @cfg tid + setFeatureConfig (featureSingleton @cfg) tid wsnl + fs <- getConfigForTeam @cfg tid pushFeatureConfigEvent tid (Event.mkUpdateEvent fs) pure fs @@ -613,7 +561,7 @@ guardLockStatus = \case ------------------------------------------------------------------------------- -- GetFeatureConfig and SetFeatureConfig instances -instance GetFeatureConfig db SSOConfig where +instance GetFeatureConfig SSOConfig where getConfigForServer = do status <- inputs (view (optSettings . setFeatureFlags . flagSSO)) <&> \case @@ -621,18 +569,18 @@ instance GetFeatureConfig db SSOConfig where FeatureSSODisabledByDefault -> FeatureStatusDisabled pure $ setStatus status defFeatureStatus - getConfigForUser = genericGetConfigForUser @db + getConfigForUser = genericGetConfigForUser -instance SetFeatureConfig db SSOConfig where - type SetConfigForTeamConstraints db SSOConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) +instance SetFeatureConfig SSOConfig where + type SetConfigForTeamConstraints SSOConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) setConfigForTeam tid wsnl = do case wssStatus wsnl of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> throw DisableSsoNotImplemented - persistAndPushEvent @db tid wsnl + persistAndPushEvent tid wsnl -instance GetFeatureConfig db SearchVisibilityAvailableConfig where +instance GetFeatureConfig SearchVisibilityAvailableConfig where getConfigForServer = do status <- inputs (view (optSettings . setFeatureFlags . flagTeamSearchVisibility)) <&> \case @@ -640,92 +588,86 @@ instance GetFeatureConfig db SearchVisibilityAvailableConfig where FeatureTeamSearchVisibilityUnavailableByDefault -> FeatureStatusDisabled pure $ setStatus status defFeatureStatus -instance SetFeatureConfig db SearchVisibilityAvailableConfig where - type SetConfigForTeamConstraints db SearchVisibilityAvailableConfig (r :: EffectRow) = (Member SearchVisibilityStore r) +instance SetFeatureConfig SearchVisibilityAvailableConfig where + type SetConfigForTeamConstraints SearchVisibilityAvailableConfig (r :: EffectRow) = (Member SearchVisibilityStore r) setConfigForTeam tid wsnl = do case wssStatus wsnl of FeatureStatusEnabled -> pure () FeatureStatusDisabled -> SearchVisibilityData.resetSearchVisibility tid - persistAndPushEvent @db tid wsnl + persistAndPushEvent tid wsnl -instance GetFeatureConfig db ValidateSAMLEmailsConfig where +instance GetFeatureConfig ValidateSAMLEmailsConfig where getConfigForServer = inputs (view (optSettings . setFeatureFlags . flagsTeamFeatureValidateSAMLEmailsStatus . unDefaults . unImplicitLockStatus)) -instance SetFeatureConfig db ValidateSAMLEmailsConfig +instance SetFeatureConfig ValidateSAMLEmailsConfig -instance GetFeatureConfig db DigitalSignaturesConfig +instance GetFeatureConfig DigitalSignaturesConfig -instance SetFeatureConfig db DigitalSignaturesConfig +instance SetFeatureConfig DigitalSignaturesConfig -instance GetFeatureConfig db LegalholdConfig where +instance GetFeatureConfig LegalholdConfig where type - GetConfigForTeamConstraints db LegalholdConfig (r :: EffectRow) = - ( FeaturePersistentConstraint db LegalholdConfig, - ( Member (Input Opts) r, - Member (TeamFeatureStore db) r, - Member LegalHoldStore r, - Member TeamStore r - ) + GetConfigForTeamConstraints LegalholdConfig (r :: EffectRow) = + ( Member (Input Opts) r, + Member TeamFeatureStore r, + Member LegalHoldStore r, + Member TeamStore r ) type - GetConfigForUserConstraints db LegalholdConfig (r :: EffectRow) = - ( FeaturePersistentConstraint db LegalholdConfig, - ( Member (Input Opts) r, - Member (TeamFeatureStore db) r, - Member LegalHoldStore r, - Member TeamStore r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r - ) + GetConfigForUserConstraints LegalholdConfig (r :: EffectRow) = + ( Member (Input Opts) r, + Member TeamFeatureStore r, + Member LegalHoldStore r, + Member TeamStore r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r ) getConfigForTeam tid = do status <- - isLegalHoldEnabledForTeam @db tid <&> \case + isLegalHoldEnabledForTeam tid <&> \case True -> FeatureStatusEnabled False -> FeatureStatusDisabled pure $ setStatus status defFeatureStatus -instance SetFeatureConfig db LegalholdConfig where +instance SetFeatureConfig LegalholdConfig where type - SetConfigForTeamConstraints db LegalholdConfig (r :: EffectRow) = + SetConfigForTeamConstraints LegalholdConfig (r :: EffectRow) = ( Bounded (PagingBounds InternalPaging TeamMember), - ( Member BotAccess r, - Member BrigAccess r, - Member CodeStore r, - Member ConversationStore r, - Member (Error AuthenticationError) r, - Member (Error FederationError) r, - Member (Error InternalError) r, - Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r, - Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r, - Member (ErrorS 'NotATeamMember) r, - Member (Error TeamFeatureError) r, - Member (ErrorS 'LegalHoldNotEnabled) r, - Member (ErrorS 'LegalHoldDisableUnimplemented) r, - Member (ErrorS 'LegalHoldServiceNotRegistered) r, - Member (ErrorS 'UserLegalHoldIllegalOperation) r, - Member (ErrorS 'LegalHoldCouldNotBlockConnections) r, - Member ExternalAccess r, - Member FederatorAccess r, - Member FireAndForget r, - Member GundeckAccess r, - Member (Input (Local ())) r, - Member (Input Env) r, - Member (Input UTCTime) r, - Member LegalHoldStore r, - Member (ListItems LegacyPaging ConvId) r, - Member MemberStore r, - Member ProposalStore r, - Member (TeamFeatureStore db) r, - Member TeamStore r, - Member (TeamMemberStore InternalPaging) r, - Member P.TinyLog r - ), - FeaturePersistentConstraint db LegalholdConfig + Member BotAccess r, + Member BrigAccess r, + Member CodeStore r, + Member ConversationStore r, + Member (Error AuthenticationError) r, + Member (Error FederationError) r, + Member (Error InternalError) r, + Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r, + Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r, + Member (ErrorS 'NotATeamMember) r, + Member (Error TeamFeatureError) r, + Member (ErrorS 'LegalHoldNotEnabled) r, + Member (ErrorS 'LegalHoldDisableUnimplemented) r, + Member (ErrorS 'LegalHoldServiceNotRegistered) r, + Member (ErrorS 'UserLegalHoldIllegalOperation) r, + Member (ErrorS 'LegalHoldCouldNotBlockConnections) r, + Member ExternalAccess r, + Member FederatorAccess r, + Member FireAndForget r, + Member GundeckAccess r, + Member (Input (Local ())) r, + Member (Input Env) r, + Member (Input UTCTime) r, + Member LegalHoldStore r, + Member (ListItems LegacyPaging ConvId) r, + Member MemberStore r, + Member ProposalStore r, + Member TeamFeatureStore r, + Member TeamStore r, + Member (TeamMemberStore InternalPaging) r, + Member P.TinyLog r ) -- we're good to update the status now. @@ -745,42 +687,40 @@ instance SetFeatureConfig db LegalholdConfig where case wssStatus wsnl of FeatureStatusDisabled -> LegalHold.removeSettings' @InternalPaging tid FeatureStatusEnabled -> ensureNotTooLargeToActivateLegalHold tid - persistAndPushEvent @db tid wsnl + persistAndPushEvent tid wsnl -instance GetFeatureConfig db FileSharingConfig where +instance GetFeatureConfig FileSharingConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagFileSharing . unDefaults) -instance SetFeatureConfig db FileSharingConfig +instance SetFeatureConfig FileSharingConfig -instance GetFeatureConfig db AppLockConfig where +instance GetFeatureConfig AppLockConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagAppLockDefaults . unDefaults . unImplicitLockStatus) -instance SetFeatureConfig db AppLockConfig where - type SetConfigForTeamConstraints db AppLockConfig r = Member (Error TeamFeatureError) r +instance SetFeatureConfig AppLockConfig where + type SetConfigForTeamConstraints AppLockConfig r = Member (Error TeamFeatureError) r setConfigForTeam tid wsnl = do when ((applockInactivityTimeoutSecs . wssConfig $ wsnl) < 30) $ throw AppLockInactivityTimeoutTooLow - persistAndPushEvent @db tid wsnl + persistAndPushEvent tid wsnl -instance GetFeatureConfig db ClassifiedDomainsConfig where +instance GetFeatureConfig ClassifiedDomainsConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagClassifiedDomains . unImplicitLockStatus) -instance GetFeatureConfig db ConferenceCallingConfig where +instance GetFeatureConfig ConferenceCallingConfig where type - GetConfigForUserConstraints db ConferenceCallingConfig r = - ( FeaturePersistentConstraint db ConferenceCallingConfig, - ( Member (Input Opts) r, - Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r, - Member (TeamFeatureStore db) r, - Member BrigAccess r - ) + GetConfigForUserConstraints ConferenceCallingConfig r = + ( Member (Input Opts) r, + Member (ErrorS OperationDenied) r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r, + Member TeamFeatureStore r, + Member BrigAccess r ) getConfigForServer = @@ -790,46 +730,46 @@ instance GetFeatureConfig db ConferenceCallingConfig where wsnl <- getAccountConferenceCallingConfigClient uid pure $ withLockStatus (wsLockStatus (defFeatureStatus @ConferenceCallingConfig)) wsnl -instance SetFeatureConfig db ConferenceCallingConfig +instance SetFeatureConfig ConferenceCallingConfig -instance GetFeatureConfig db SelfDeletingMessagesConfig where +instance GetFeatureConfig SelfDeletingMessagesConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagSelfDeletingMessages . unDefaults) -instance SetFeatureConfig db SelfDeletingMessagesConfig +instance SetFeatureConfig SelfDeletingMessagesConfig -instance SetFeatureConfig db GuestLinksConfig +instance SetFeatureConfig GuestLinksConfig -instance GetFeatureConfig db GuestLinksConfig where +instance GetFeatureConfig GuestLinksConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagConversationGuestLinks . unDefaults) -instance SetFeatureConfig db SndFactorPasswordChallengeConfig +instance SetFeatureConfig SndFactorPasswordChallengeConfig -instance GetFeatureConfig db SndFactorPasswordChallengeConfig where +instance GetFeatureConfig SndFactorPasswordChallengeConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagTeamFeatureSndFactorPasswordChallengeStatus . unDefaults) -instance SetFeatureConfig db SearchVisibilityInboundConfig where - type SetConfigForTeamConstraints db SearchVisibilityInboundConfig (r :: EffectRow) = (Member BrigAccess r) +instance SetFeatureConfig SearchVisibilityInboundConfig where + type SetConfigForTeamConstraints SearchVisibilityInboundConfig (r :: EffectRow) = (Member BrigAccess r) setConfigForTeam tid wsnl = do updateSearchVisibilityInbound $ toTeamStatus tid wsnl - persistAndPushEvent @db tid wsnl + persistAndPushEvent tid wsnl -instance GetFeatureConfig db SearchVisibilityInboundConfig where +instance GetFeatureConfig SearchVisibilityInboundConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagTeamFeatureSearchVisibilityInbound . unDefaults . unImplicitLockStatus) -instance GetFeatureConfig db MLSConfig where +instance GetFeatureConfig MLSConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagMLS . unDefaults . unImplicitLockStatus) -instance SetFeatureConfig db MLSConfig +instance SetFeatureConfig MLSConfig -instance GetFeatureConfig db ExposeInvitationURLsToTeamAdminConfig where +instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where getConfigForTeam tid = do allowList <- input <&> view (optSettings . setExposeInvitationURLsTeamAllowlist . to (fromMaybe [])) - mbOldStatus <- TeamFeatures.getFeatureConfig @db (Proxy @ExposeInvitationURLsToTeamAdminConfig) tid <&> fmap wssStatus + mbOldStatus <- TeamFeatures.getFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid <&> fmap wssStatus let teamAllowed = tid `elem` allowList pure $ computeConfigForTeam teamAllowed (fromMaybe FeatureStatusDisabled mbOldStatus) where @@ -847,17 +787,17 @@ instance GetFeatureConfig db ExposeInvitationURLsToTeamAdminConfig where ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited -instance SetFeatureConfig db ExposeInvitationURLsToTeamAdminConfig +instance SetFeatureConfig ExposeInvitationURLsToTeamAdminConfig -instance SetFeatureConfig db OutlookCalIntegrationConfig +instance SetFeatureConfig OutlookCalIntegrationConfig -instance GetFeatureConfig db OutlookCalIntegrationConfig where +instance GetFeatureConfig OutlookCalIntegrationConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagOutlookCalIntegration . unDefaults) -instance SetFeatureConfig db MlsE2EIdConfig +instance SetFeatureConfig MlsE2EIdConfig -instance GetFeatureConfig db MlsE2EIdConfig where +instance GetFeatureConfig MlsE2EIdConfig where getConfigForServer = input <&> view (optSettings . setFeatureFlags . flagMlsE2EId . unDefaults) @@ -865,16 +805,15 @@ instance GetFeatureConfig db MlsE2EIdConfig where -- -- -- This function exists to resolve a cyclic dependency. guardSecondFactorDisabled :: - forall db r a. + forall r a. ( Member (Input Opts) r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (ErrorS 'AccessDenied) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - Member ConversationStore r, - FeaturePersistentConstraint db SndFactorPasswordChallengeConfig + Member ConversationStore r ) => UserId -> ConvId -> @@ -883,20 +822,20 @@ guardSecondFactorDisabled :: guardSecondFactorDisabled uid cid action = do mbCnvData <- ConversationStore.getConversationMetadata cid tf <- case mbCnvData >>= cnvmTeam of - Nothing -> getConfigForUser @db @SndFactorPasswordChallengeConfig uid + Nothing -> getConfigForUser @SndFactorPasswordChallengeConfig uid Just tid -> do teamExists <- isJust <$> getTeam tid if teamExists - then getConfigForTeam @db @SndFactorPasswordChallengeConfig tid - else getConfigForUser @db @SndFactorPasswordChallengeConfig uid + then getConfigForTeam @SndFactorPasswordChallengeConfig tid + else getConfigForUser @SndFactorPasswordChallengeConfig uid case wsStatus tf of FeatureStatusDisabled -> action FeatureStatusEnabled -> throwS @'AccessDenied featureEnabledForTeam :: - forall db cfg r. - ( GetFeatureConfig db cfg, - GetConfigForTeamConstraints db cfg r, + forall cfg r. + ( GetFeatureConfig cfg, + GetConfigForTeamConstraints cfg r, ( Member (ErrorS OperationDenied) r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, @@ -905,4 +844,4 @@ featureEnabledForTeam :: ) => TeamId -> Sem r Bool -featureEnabledForTeam tid = (==) FeatureStatusEnabled . wsStatus <$> getFeatureStatus @db @cfg DontDoAuth tid +featureEnabledForTeam tid = (==) FeatureStatusEnabled . wsStatus <$> getFeatureStatus @cfg DontDoAuth tid diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs index 2a36c40cfe8..b5e78b66f30 100644 --- a/services/galley/src/Galley/API/Update.hs +++ b/services/galley/src/Galley/API/Update.hs @@ -109,7 +109,6 @@ import qualified Galley.Effects.GundeckAccess as E import qualified Galley.Effects.MemberStore as E import Galley.Effects.ProposalStore import qualified Galley.Effects.ServiceStore as E -import Galley.Effects.TeamFeatureStore (FeaturePersistentConstraint) import Galley.Effects.WaiRoutes import Galley.Intra.Push import Galley.Options @@ -149,7 +148,6 @@ import Wire.API.Routes.Internal.Brig.Connection import Wire.API.Routes.Public.Galley.Messaging import Wire.API.Routes.Public.Util (UpdateResult (..)) import Wire.API.ServantProto (RawProto (..)) -import Wire.API.Team.Feature hiding (setStatus) import Wire.API.Team.Member import Wire.API.User.Client @@ -487,7 +485,7 @@ getUpdateResult :: Sem (Error NoChanges ': r) a -> Sem r (UpdateResult a) getUpdateResult = fmap (either (const Unchanged) Updated) . runError addCodeUnqualifiedWithReqBody :: - forall db r. + forall r. ( Member CodeStore r, Member ConversationStore r, Member (ErrorS 'ConvAccessDenied) r, @@ -500,18 +498,17 @@ addCodeUnqualifiedWithReqBody :: Member (Input UTCTime) r, Member (Embed IO) r, Member (Input Opts) r, - Member (TeamFeatureStore db) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r ) => UserId -> Maybe ConnId -> ConvId -> CreateConversationCodeRequest -> Sem r AddCodeResult -addCodeUnqualifiedWithReqBody usr mZcon cnv req = addCodeUnqualified @db (Just req) usr mZcon cnv +addCodeUnqualifiedWithReqBody usr mZcon cnv req = addCodeUnqualified (Just req) usr mZcon cnv addCodeUnqualified :: - forall db r. + forall r. ( Member CodeStore r, Member ConversationStore r, Member (ErrorS 'ConvAccessDenied) r, @@ -524,8 +521,7 @@ addCodeUnqualified :: Member (Input UTCTime) r, Member (Input Opts) r, Member (Embed IO) r, - Member (TeamFeatureStore db) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r ) => Maybe CreateConversationCodeRequest -> UserId -> @@ -535,10 +531,10 @@ addCodeUnqualified :: addCodeUnqualified mReq usr mZcon cnv = do lusr <- qualifyLocal usr lcnv <- qualifyLocal cnv - addCode @db lusr mZcon lcnv mReq + addCode lusr mZcon lcnv mReq addCode :: - forall db r. + forall r. ( Member CodeStore r, Member ConversationStore r, Member (ErrorS 'ConvNotFound) r, @@ -549,9 +545,8 @@ addCode :: Member GundeckAccess r, Member (Input UTCTime) r, Member (Input Opts) r, - Member (TeamFeatureStore db) r, - Member (Embed IO) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r, + Member (Embed IO) r ) => Local UserId -> Maybe ConnId -> @@ -560,7 +555,7 @@ addCode :: Sem r AddCodeResult addCode lusr mZcon lcnv mReq = do conv <- E.getConversation (tUnqualified lcnv) >>= noteS @'ConvNotFound - Query.ensureGuestLinksEnabled @db (Data.convTeam conv) + Query.ensureGuestLinksEnabled (Data.convTeam conv) Query.ensureConvAdmin (Data.convLocalMembers conv) (tUnqualified lusr) ensureAccess conv CodeAccess ensureGuestsOrNonTeamMembersAllowed conv @@ -638,7 +633,7 @@ rmCode lusr zcon lcnv = do pure event getCode :: - forall db r. + forall r. ( Member CodeStore r, Member ConversationStore r, Member (ErrorS 'CodeNotFound) r, @@ -646,8 +641,7 @@ getCode :: Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'GuestLinksDisabled) r, Member (Input Opts) r, - Member (TeamFeatureStore db) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r ) => Local UserId -> ConvId -> @@ -655,7 +649,7 @@ getCode :: getCode lusr cnv = do conv <- E.getConversation cnv >>= noteS @'ConvNotFound - Query.ensureGuestLinksEnabled @db (Data.convTeam conv) + Query.ensureGuestLinksEnabled (Data.convTeam conv) ensureAccess conv CodeAccess ensureConvMember (Data.convLocalMembers conv) (tUnqualified lusr) key <- E.makeKey cnv @@ -663,15 +657,14 @@ getCode lusr cnv = do mkConversationCodeInfo (isJust mPw) (codeKey c) (codeValue c) <$> E.getConversationCodeURI checkReusableCode :: - forall db r. + forall r. ( Member CodeStore r, Member ConversationStore r, - Member (TeamFeatureStore db) r, + Member TeamFeatureStore r, Member (ErrorS 'CodeNotFound) r, Member (ErrorS 'ConvNotFound) r, Member (ErrorS 'InvalidConversationPassword) r, - Member (Input Opts) r, - FeaturePersistentConstraint db GuestLinksConfig + Member (Input Opts) r ) => ConversationCode -> Sem r () @@ -679,10 +672,10 @@ checkReusableCode convCode = do code <- verifyReusableCode False Nothing convCode conv <- E.getConversation (codeConversation code) >>= noteS @'ConvNotFound mapErrorS @'GuestLinksDisabled @'CodeNotFound $ - Query.ensureGuestLinksEnabled @db (Data.convTeam conv) + Query.ensureGuestLinksEnabled (Data.convTeam conv) joinConversationByReusableCode :: - forall db r. + forall r. ( Member BrigAccess r, Member CodeStore r, Member ConversationStore r, @@ -702,9 +695,8 @@ joinConversationByReusableCode :: Member (Input UTCTime) r, Member MemberStore r, Member TeamStore r, - Member (TeamFeatureStore db) r, - Member (Logger (Msg -> Msg)) r, - FeaturePersistentConstraint db GuestLinksConfig + Member TeamFeatureStore r, + Member (Logger (Msg -> Msg)) r ) => Local UserId -> ConnId -> @@ -713,7 +705,7 @@ joinConversationByReusableCode :: joinConversationByReusableCode lusr zcon req = do c <- verifyReusableCode True req.password req.code conv <- E.getConversation (codeConversation c) >>= noteS @'ConvNotFound - Query.ensureGuestLinksEnabled @db (Data.convTeam conv) + Query.ensureGuestLinksEnabled (Data.convTeam conv) joinConversation lusr zcon conv CodeAccess joinConversationById :: diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 5bbd2af7769..f7ee605b4e7 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -17,8 +17,6 @@ module Galley.Cassandra.TeamFeatures ( interpretTeamFeatureStoreToCassandra, - Cassandra, - FeatureStatusCassandra (..), getFeatureConfigMulti, ) where @@ -28,7 +26,6 @@ import qualified Cassandra as C import Control.Monad.Trans.Maybe import Data.Id import Data.Misc (HttpsUrl) -import Data.Proxy import Data.Time (NominalDiffTime) import Galley.Cassandra.Instances () import Galley.Cassandra.Store @@ -41,32 +38,204 @@ import Wire.API.Conversation.Protocol (ProtocolTag) import Wire.API.MLS.CipherSuite import Wire.API.Team.Feature -data Cassandra - -type instance TFS.FeaturePersistentConstraint Cassandra = FeatureStatusCassandra - interpretTeamFeatureStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r ) => - Sem (TFS.TeamFeatureStore Cassandra ': r) a -> + Sem (TFS.TeamFeatureStore ': r) a -> Sem r a interpretTeamFeatureStoreToCassandra = interpret $ \case - TFS.GetFeatureConfig proxy tid -> embedClient $ getFeatureConfig proxy tid - TFS.GetFeatureConfigMulti proxy tids -> embedClient $ getFeatureConfigMulti proxy tids - TFS.SetFeatureConfig proxy tid wsnl -> embedClient $ setFeatureConfig proxy tid wsnl - TFS.GetFeatureLockStatus proxy tid -> embedClient $ getFeatureLockStatus proxy tid - TFS.SetFeatureLockStatus proxy tid ls -> embedClient $ setFeatureLockStatus proxy tid ls - -class FeatureStatusCassandra cfg where - getFeatureConfig :: MonadClient m => Proxy cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) - setFeatureConfig :: MonadClient m => Proxy cfg -> TeamId -> WithStatusNoLock cfg -> m () + TFS.GetFeatureConfig sing tid -> embedClient $ getFeatureConfig sing tid + TFS.GetFeatureConfigMulti sing tids -> embedClient $ getFeatureConfigMulti sing tids + TFS.SetFeatureConfig sing tid wsnl -> embedClient $ setFeatureConfig sing tid wsnl + TFS.GetFeatureLockStatus sing tid -> embedClient $ getFeatureLockStatus sing tid + TFS.SetFeatureLockStatus sing tid ls -> embedClient $ setFeatureLockStatus sing tid ls + +getFeatureConfig :: MonadClient m => FeatureSingleton cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) +getFeatureConfig FeatureSingletonLegalholdConfig tid = getTrivialConfigC "legalhold_status" tid +getFeatureConfig FeatureSingletonSSOConfig tid = getTrivialConfigC "sso_status" tid +getFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid = getTrivialConfigC "search_visibility_status" tid +getFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid = getTrivialConfigC "validate_saml_emails" tid +getFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid = pure Nothing -- TODO(fisx): what's this about? +getFeatureConfig FeatureSingletonDigitalSignaturesConfig tid = getTrivialConfigC "digital_signatures" tid +getFeatureConfig FeatureSingletonAppLockConfig tid = runMaybeT $ do + (mStatus, mEnforce, mTimeout) <- + MaybeT . retry x1 $ + query1 select (params LocalQuorum (Identity tid)) + maybe mzero pure $ + WithStatusNoLock + <$> mStatus + <*> (AppLockConfig <$> mEnforce <*> mTimeout) + <*> Just FeatureTTLUnlimited + where + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) + select = + "select app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs \ + \ from team_features where team_id = ?" +getFeatureConfig FeatureSingletonFileSharingConfig tid = getTrivialConfigC "file_sharing" tid +getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = runMaybeT $ do + (mEnabled, mTimeout) <- + MaybeT . retry x1 $ + query1 select (params LocalQuorum (Identity tid)) + maybe mzero pure $ + WithStatusNoLock + <$> mEnabled + <*> fmap SelfDeletingMessagesConfig mTimeout + <*> Just FeatureTTLUnlimited + where + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32) + select = + "select self_deleting_messages_status, self_deleting_messages_ttl\ + \ from team_features where team_id = ?" +getFeatureConfig FeatureSingletonConferenceCallingConfig tid = do + let q = query1 select (params LocalQuorum (Identity tid)) + retry x1 q <&> \case + Nothing -> Nothing + Just (Nothing, _) -> Nothing + Just (Just status, mTtl) -> Just . forgetLock . setStatus status . setWsTTL (fromMaybe FeatureTTLUnlimited mTtl) $ defFeatureStatus + where + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL) + select = + fromString $ + "select conference_calling, ttl(conference_calling) from team_features where team_id = ?" +getFeatureConfig FeatureSingletonGuestLinksConfig tid = getTrivialConfigC "guest_links_status" tid +getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getTrivialConfigC "snd_factor_password_challenge_status" tid +getFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid = getTrivialConfigC "search_visibility_status" tid +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) -> + WithStatusNoLock + <$> status + <*> ( MLSConfig + <$> maybe (Just []) (Just . C.fromSet) protocolToggleUsers + <*> defaultProtocol + <*> maybe (Just []) (Just . C.fromSet) allowedCipherSuites + <*> defaultCipherSuite + ) + <*> Just FeatureTTLUnlimited + where + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe ProtocolTag, Maybe (C.Set UserId), Maybe (C.Set CipherSuiteTag), Maybe CipherSuiteTag) + select = + "select mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ + \mls_default_ciphersuite from team_features where team_id = ?" +getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = do + let q = query1 select (params LocalQuorum (Identity tid)) + retry x1 q <&> \case + Nothing -> Nothing + Just (Nothing, _, _) -> Nothing + Just (Just fs, mGracePeriod, mUrl) -> + Just $ + WithStatusNoLock + fs + (MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl) + FeatureTTLUnlimited + where + toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime + toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral - -- default implementation: no lock status - getFeatureLockStatus :: MonadClient m => Proxy cfg -> TeamId -> m (Maybe LockStatus) - getFeatureLockStatus _ _tid = pure Nothing - setFeatureLockStatus :: MonadClient m => Proxy cfg -> TeamId -> LockStatus -> m () - setFeatureLockStatus _ _tid _status = pure () + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32, Maybe HttpsUrl) + select = + fromString $ + "select mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url from team_features where team_id = ?" +getFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid = getTrivialConfigC "expose_invitation_urls_to_team_admin" tid +getFeatureConfig FeatureSingletonOutlookCalIntegrationConfig tid = getTrivialConfigC "outlook_cal_integration_status" tid + +setFeatureConfig :: MonadClient m => FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> m () +setFeatureConfig FeatureSingletonLegalholdConfig tid statusNoLock = setFeatureStatusC "legalhold_status" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonSSOConfig tid statusNoLock = setFeatureStatusC "sso_status" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid statusNoLock = setFeatureStatusC "validate_saml_emails" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid _statusNoLock = pure () +setFeatureConfig FeatureSingletonDigitalSignaturesConfig tid statusNoLock = setFeatureStatusC "digital_signatures" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonAppLockConfig tid status = do + let enforce = applockEnforceAppLock (wssConfig status) + timeout = applockInactivityTimeoutSecs (wssConfig status) + + retry x5 $ write insert (params LocalQuorum (tid, wssStatus status, enforce, timeout)) + where + insert :: PrepQuery W (TeamId, FeatureStatus, EnforceAppLock, Int32) () + insert = + fromString $ + "insert into team_features (team_id, app_lock_status, app_lock_enforce,\ + \ app_lock_inactivity_timeout_secs) values (?, ?, ?, ?)" +setFeatureConfig FeatureSingletonFileSharingConfig tid statusNoLock = setFeatureStatusC "file_sharing" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid status = do + let statusValue = wssStatus status + timeout = sdmEnforcedTimeoutSeconds . wssConfig $ status + retry x5 $ write insert (params LocalQuorum (tid, statusValue, timeout)) + where + insert :: PrepQuery W (TeamId, FeatureStatus, Int32) () + insert = + "insert into team_features (team_id, self_deleting_messages_status,\ + \ self_deleting_messages_ttl) values (?, ?, ?)" +setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = + retry x5 $ write insert (params LocalQuorum (tid, wssStatus statusNoLock)) + where + renderFeatureTtl :: FeatureTTL -> String + renderFeatureTtl = \case + FeatureTTLSeconds d | d > 0 -> " using ttl " <> show d + _ -> " using ttl 0" -- 0 or unlimited (delete a column's existing TTL by setting its value to zero) + insert :: PrepQuery W (TeamId, FeatureStatus) () + insert = + fromString $ + "insert into team_features (team_id,conference_calling) values (?, ?)" + <> renderFeatureTtl (wssTTL statusNoLock) +setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = + setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) +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 + retry x5 $ + write + insert + ( params + LocalQuorum + ( tid, + status, + defaultProtocol, + C.Set protocolToggleUsers, + C.Set allowedCipherSuites, + defaultCipherSuite + ) + ) + where + insert :: PrepQuery W (TeamId, FeatureStatus, ProtocolTag, C.Set UserId, C.Set CipherSuiteTag, CipherSuiteTag) () + insert = + "insert into team_features (team_id, mls_status, mls_default_protocol, \ + \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite) values (?, ?, ?, ?, ?, ?)" +setFeatureConfig FeatureSingletonMlsE2EIdConfig tid status = do + let statusValue = wssStatus status + vex = verificationExpiration . wssConfig $ status + mUrl = acmeDiscoveryUrl . wssConfig $ status + retry x5 $ write insert (params LocalQuorum (tid, statusValue, truncate vex, mUrl)) + where + insert :: PrepQuery W (TeamId, FeatureStatus, Int32, Maybe HttpsUrl) () + insert = + "insert into team_features (team_id, mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url) values (?, ?, ?, ?)" +setFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid statusNoLock = setFeatureStatusC "expose_invitation_urls_to_team_admin" tid (wssStatus statusNoLock) +setFeatureConfig FeatureSingletonOutlookCalIntegrationConfig tid statusNoLock = setFeatureStatusC "outlook_cal_integration_status" tid (wssStatus statusNoLock) + +getFeatureLockStatus :: MonadClient m => FeatureSingleton cfg -> TeamId -> m (Maybe LockStatus) +getFeatureLockStatus FeatureSingletonFileSharingConfig tid = getLockStatusC "file_sharing_lock_status" tid +getFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid = getLockStatusC "self_deleting_messages_lock_status" tid +getFeatureLockStatus FeatureSingletonGuestLinksConfig tid = getLockStatusC "guest_links_lock_status" tid +getFeatureLockStatus FeatureSingletonSndFactorPasswordChallengeConfig tid = getLockStatusC "snd_factor_password_challenge_lock_status" tid +getFeatureLockStatus FeatureSingletonMlsE2EIdConfig tid = getLockStatusC "mls_e2eid_lock_status" tid +getFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid = getLockStatusC "outlook_cal_integration_lock_status" tid +getFeatureLockStatus _ _ = pure Nothing + +setFeatureLockStatus :: MonadClient m => FeatureSingleton cfg -> TeamId -> LockStatus -> m () +setFeatureLockStatus FeatureSingletonFileSharingConfig tid status = setLockStatusC "file_sharing_lock_status" tid status +setFeatureLockStatus FeatureSingletonSelfDeletingMessagesConfig tid status = setLockStatusC "self_deleting_messages_lock_status" tid status +setFeatureLockStatus FeatureSingletonGuestLinksConfig tid status = setLockStatusC "guest_links_lock_status" tid status +setFeatureLockStatus FeatureSingletonSndFactorPasswordChallengeConfig tid status = setLockStatusC "snd_factor_password_challenge_lock_status" tid status +setFeatureLockStatus FeatureSingletonMlsE2EIdConfig tid status = setLockStatusC "mls_e2eid_lock_status" tid status +setFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid status = setLockStatusC "outlook_cal_integration_lock_status" tid status +setFeatureLockStatus _ _tid _status = pure () getTrivialConfigC :: forall m cfg. @@ -136,229 +305,9 @@ setLockStatusC col tid status = do getFeatureConfigMulti :: forall cfg m. - (FeatureStatusCassandra cfg, MonadClient m, MonadUnliftIO m) => - Proxy cfg -> + (MonadClient m, MonadUnliftIO m) => + FeatureSingleton cfg -> [TeamId] -> m [(TeamId, Maybe (WithStatusNoLock cfg))] getFeatureConfigMulti proxy = pooledMapConcurrentlyN 8 (\tid -> getFeatureConfig proxy tid <&> (tid,)) - -instance FeatureStatusCassandra LegalholdConfig where - getFeatureConfig _ = getTrivialConfigC "legalhold_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "legalhold_status" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra SSOConfig where - getFeatureConfig _ = getTrivialConfigC "sso_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "sso_status" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra SearchVisibilityAvailableConfig where - getFeatureConfig _ = getTrivialConfigC "search_visibility_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra ValidateSAMLEmailsConfig where - getFeatureConfig _ = getTrivialConfigC "validate_saml_emails" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "validate_saml_emails" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra ClassifiedDomainsConfig where - getFeatureConfig _ _tid = pure Nothing -- TODO(fisx): what's this about? - setFeatureConfig _ _tid _statusNoLock = pure () - -instance FeatureStatusCassandra DigitalSignaturesConfig where - getFeatureConfig _ = getTrivialConfigC "digital_signatures" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "digital_signatures" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra AppLockConfig where - getFeatureConfig _ tid = runMaybeT $ do - (mStatus, mEnforce, mTimeout) <- - MaybeT . retry x1 $ - query1 select (params LocalQuorum (Identity tid)) - maybe mzero pure $ - WithStatusNoLock - <$> mStatus - <*> (AppLockConfig <$> mEnforce <*> mTimeout) - <*> Just FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) - select = - "select app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs \ - \ from team_features where team_id = ?" - - setFeatureConfig _ tid status = do - let enforce = applockEnforceAppLock (wssConfig status) - timeout = applockInactivityTimeoutSecs (wssConfig status) - - retry x5 $ write insert (params LocalQuorum (tid, wssStatus status, enforce, timeout)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, EnforceAppLock, Int32) () - insert = - fromString $ - "insert into team_features (team_id, app_lock_status, app_lock_enforce,\ - \ app_lock_inactivity_timeout_secs) values (?, ?, ?, ?)" - -instance FeatureStatusCassandra FileSharingConfig where - getFeatureConfig _ = getTrivialConfigC "file_sharing" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "file_sharing" tid (wssStatus statusNoLock) - getFeatureLockStatus _ = getLockStatusC "file_sharing_lock_status" - setFeatureLockStatus _ = setLockStatusC "file_sharing_lock_status" - -instance FeatureStatusCassandra SelfDeletingMessagesConfig where - getFeatureConfig _ tid = runMaybeT $ do - (mEnabled, mTimeout) <- - MaybeT . retry x1 $ - query1 select (params LocalQuorum (Identity tid)) - maybe mzero pure $ - WithStatusNoLock - <$> mEnabled - <*> fmap SelfDeletingMessagesConfig mTimeout - <*> Just FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32) - select = - "select self_deleting_messages_status, self_deleting_messages_ttl\ - \ from team_features where team_id = ?" - - setFeatureConfig _ tid status = do - let statusValue = wssStatus status - timeout = sdmEnforcedTimeoutSeconds . wssConfig $ status - retry x5 $ write insert (params LocalQuorum (tid, statusValue, timeout)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Int32) () - insert = - "insert into team_features (team_id, self_deleting_messages_status,\ - \ self_deleting_messages_ttl) values (?, ?, ?)" - - getFeatureLockStatus _ = getLockStatusC "self_deleting_messages_lock_status" - setFeatureLockStatus _ = setLockStatusC "self_deleting_messages_lock_status" - -instance FeatureStatusCassandra ConferenceCallingConfig where - getFeatureConfig _ tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - retry x1 q <&> \case - Nothing -> Nothing - Just (Nothing, _) -> Nothing - Just (Just status, mTtl) -> Just . forgetLock . setStatus status . setWsTTL (fromMaybe FeatureTTLUnlimited mTtl) $ defFeatureStatus - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL) - select = - fromString $ - "select conference_calling, ttl(conference_calling) from team_features where team_id = ?" - - setFeatureConfig _ tid statusNoLock = - retry x5 $ write insert (params LocalQuorum (tid, wssStatus statusNoLock)) - where - renderFeatureTtl :: FeatureTTL -> String - renderFeatureTtl = \case - FeatureTTLSeconds d | d > 0 -> " using ttl " <> show d - _ -> " using ttl 0" -- 0 or unlimited (delete a column's existing TTL by setting its value to zero) - insert :: PrepQuery W (TeamId, FeatureStatus) () - insert = - fromString $ - "insert into team_features (team_id,conference_calling) values (?, ?)" - <> renderFeatureTtl (wssTTL statusNoLock) - -instance FeatureStatusCassandra GuestLinksConfig where - getFeatureConfig _ = getTrivialConfigC "guest_links_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) - - getFeatureLockStatus _ = getLockStatusC "guest_links_lock_status" - setFeatureLockStatus _ = setLockStatusC "guest_links_lock_status" - -instance FeatureStatusCassandra SndFactorPasswordChallengeConfig where - getFeatureConfig _ = getTrivialConfigC "snd_factor_password_challenge_status" - setFeatureConfig _ tid statusNoLock = - setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) - - getFeatureLockStatus _ = getLockStatusC "snd_factor_password_challenge_lock_status" - setFeatureLockStatus _ = setLockStatusC "snd_factor_password_challenge_lock_status" - -instance FeatureStatusCassandra SearchVisibilityInboundConfig where - getFeatureConfig _ = getTrivialConfigC "search_visibility_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "search_visibility_status" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra MLSConfig where - getFeatureConfig _ tid = do - m <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure $ case m of - Nothing -> Nothing - Just (status, defaultProtocol, protocolToggleUsers, allowedCipherSuites, defaultCipherSuite) -> - WithStatusNoLock - <$> status - <*> ( MLSConfig - <$> maybe (Just []) (Just . C.fromSet) protocolToggleUsers - <*> defaultProtocol - <*> maybe (Just []) (Just . C.fromSet) allowedCipherSuites - <*> defaultCipherSuite - ) - <*> Just FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe ProtocolTag, Maybe (C.Set UserId), Maybe (C.Set CipherSuiteTag), Maybe CipherSuiteTag) - select = - "select mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ - \mls_default_ciphersuite from team_features where team_id = ?" - - setFeatureConfig _ tid statusNoLock = do - let status = wssStatus statusNoLock - let MLSConfig protocolToggleUsers defaultProtocol allowedCipherSuites defaultCipherSuite = wssConfig statusNoLock - retry x5 $ - write - insert - ( params - LocalQuorum - ( tid, - status, - defaultProtocol, - C.Set protocolToggleUsers, - C.Set allowedCipherSuites, - defaultCipherSuite - ) - ) - where - insert :: PrepQuery W (TeamId, FeatureStatus, ProtocolTag, C.Set UserId, C.Set CipherSuiteTag, CipherSuiteTag) () - insert = - "insert into team_features (team_id, mls_status, mls_default_protocol, \ - \mls_protocol_toggle_users, mls_allowed_ciphersuites, mls_default_ciphersuite) values (?, ?, ?, ?, ?, ?)" - -instance FeatureStatusCassandra MlsE2EIdConfig where - getFeatureConfig _ tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - retry x1 q <&> \case - Nothing -> Nothing - Just (Nothing, _, _) -> Nothing - Just (Just fs, mGracePeriod, mUrl) -> - Just $ - WithStatusNoLock - fs - (MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl) - FeatureTTLUnlimited - where - toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime - toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral - - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32, Maybe HttpsUrl) - select = - fromString $ - "select mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url from team_features where team_id = ?" - - setFeatureConfig _ tid status = do - let statusValue = wssStatus status - vex = verificationExpiration . wssConfig $ status - mUrl = acmeDiscoveryUrl . wssConfig $ status - retry x5 $ write insert (params LocalQuorum (tid, statusValue, truncate vex, mUrl)) - where - insert :: PrepQuery W (TeamId, FeatureStatus, Int32, Maybe HttpsUrl) () - insert = - "insert into team_features (team_id, mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url) values (?, ?, ?, ?)" - - getFeatureLockStatus _ = getLockStatusC "mls_e2eid_lock_status" - setFeatureLockStatus _ = setLockStatusC "mls_e2eid_lock_status" - -instance FeatureStatusCassandra ExposeInvitationURLsToTeamAdminConfig where - getFeatureConfig _ = getTrivialConfigC "expose_invitation_urls_to_team_admin" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "expose_invitation_urls_to_team_admin" tid (wssStatus statusNoLock) - -instance FeatureStatusCassandra OutlookCalIntegrationConfig where - getFeatureConfig _ = getTrivialConfigC "outlook_cal_integration_status" - setFeatureConfig _ tid statusNoLock = setFeatureStatusC "outlook_cal_integration_status" tid (wssStatus statusNoLock) - - getFeatureLockStatus _ = getLockStatusC "outlook_cal_integration_lock_status" - setFeatureLockStatus _ = setLockStatusC "outlook_cal_integration_lock_status" diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs index 05e4997e3c6..b6dd75eadbf 100644 --- a/services/galley/src/Galley/Effects.hs +++ b/services/galley/src/Galley/Effects.hs @@ -62,7 +62,6 @@ where import Data.Id import Data.Qualified import Data.Time.Clock -import Galley.Cassandra.TeamFeatures (Cassandra) import Galley.Effects.BotAccess import Galley.Effects.BrigAccess import Galley.Effects.ClientStore @@ -113,7 +112,7 @@ type GalleyEffects1 = MemberStore, SearchVisibilityStore, ServiceStore, - TeamFeatureStore Cassandra, + TeamFeatureStore, TeamNotificationStore, TeamStore, TeamMemberStore InternalPaging, diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index 86ea0ed352a..13a43eea34b 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -19,7 +19,6 @@ module Galley.Effects.TeamFeatureStore ( TeamFeatureStore (..), - FeaturePersistentConstraint, getFeatureConfig, getFeatureConfigMulti, setFeatureConfig, @@ -29,42 +28,32 @@ module Galley.Effects.TeamFeatureStore where import Data.Id -import Data.Kind -import Data.Proxy import Imports import Polysemy import Wire.API.Team.Feature -type family FeaturePersistentConstraint db :: Type -> Constraint - -data TeamFeatureStore db m a where - -- the proxy argument makes sure that makeSem below generates type-inference-friendly code +data TeamFeatureStore m a where GetFeatureConfig :: - FeaturePersistentConstraint db cfg => - Proxy cfg -> + FeatureSingleton cfg -> TeamId -> - TeamFeatureStore db m (Maybe (WithStatusNoLock cfg)) + TeamFeatureStore m (Maybe (WithStatusNoLock cfg)) GetFeatureConfigMulti :: - FeaturePersistentConstraint db cfg => - Proxy cfg -> + FeatureSingleton cfg -> [TeamId] -> - TeamFeatureStore db m [(TeamId, Maybe (WithStatusNoLock cfg))] + TeamFeatureStore m [(TeamId, Maybe (WithStatusNoLock cfg))] SetFeatureConfig :: - FeaturePersistentConstraint db cfg => - Proxy cfg -> + FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> - TeamFeatureStore db m () + TeamFeatureStore m () GetFeatureLockStatus :: - FeaturePersistentConstraint db cfg => - Proxy cfg -> + FeatureSingleton cfg -> TeamId -> - TeamFeatureStore db m (Maybe LockStatus) + TeamFeatureStore m (Maybe LockStatus) SetFeatureLockStatus :: - FeaturePersistentConstraint db cfg => - Proxy cfg -> + FeatureSingleton cfg -> TeamId -> LockStatus -> - TeamFeatureStore db m () + TeamFeatureStore m () makeSem ''TeamFeatureStore