From 2ef27b5b148018d592212126d0c80b3876b3362f Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 10:51:47 +0200 Subject: [PATCH 01/43] Restore weeded-out wsPatch --- libs/wire-api/src/Wire/API/Team/Feature.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index c9f24b7b158..0231bfac213 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -39,6 +39,7 @@ module Wire.API.Team.Feature setTTL, setWsTTL, WithStatusPatch, + wsPatch, wspStatus, wspLockStatus, wspConfig, @@ -317,6 +318,9 @@ deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch deriving via (Schema (WithStatusPatch cfg)) instance (ToSchema (WithStatusPatch cfg), Typeable cfg) => S.ToSchema (WithStatusPatch cfg) +wsPatch :: Maybe FeatureStatus -> Maybe LockStatus -> Maybe cfg -> Maybe FeatureTTL -> WithStatusPatch cfg +wsPatch = WithStatusBase + wspStatus :: WithStatusPatch cfg -> Maybe FeatureStatus wspStatus = wsbStatus From cd59a39428d9b689d92f8f88b58455aaa9903def Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 19 Jul 2024 15:42:35 +0200 Subject: [PATCH 02/43] Add field to ConferenceCallingConfig --- libs/wire-api/src/Wire/API/Team/Feature.hs | 14 +++++++++----- .../API/Golden/Generated/WithStatusNoLock_team.hs | 2 +- .../API/Golden/Generated/WithStatusPatch_team.hs | 2 +- .../Wire/API/Golden/Generated/WithStatus_team.hs | 2 +- services/brig/test/integration/API/Internal.hs | 5 +++-- .../Galley/Cassandra/GetAllTeamFeatureConfigs.hs | 8 +++++++- 6 files changed, 22 insertions(+), 11 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 0231bfac213..5117e6d2530 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -726,24 +726,28 @@ instance FeatureTrivialConfig DigitalSignaturesConfig where -- ConferenceCalling feature data ConferenceCallingConfig = ConferenceCallingConfig + { sftForOne2One :: Bool + } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConferenceCallingConfig) +instance Default ConferenceCallingConfig where + def = ConferenceCallingConfig {sftForOne2One = False} + instance RenderableSymbol ConferenceCallingConfig where renderSymbol = "ConferenceCallingConfig" instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited + defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked def FeatureTTLUnlimited featureSingleton = FeatureSingletonConferenceCallingConfig - objectSchema = pure ConferenceCallingConfig + objectSchema = + ConferenceCallingConfig + <$> sftForOne2One .= (fromMaybe False <$> optField "useSFTForOneToOneCalls" schema) instance ToSchema ConferenceCallingConfig where schema = object "ConferenceCallingConfig" objectSchema -instance FeatureTrivialConfig ConferenceCallingConfig where - trivialConfig = ConferenceCallingConfig - -------------------------------------------------------------------------------- -- SndFactorPasswordChallenge feature diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs index e2babe794aa..6fc948b1c27 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs @@ -63,7 +63,7 @@ testObject_WithStatusNoLock_team_13 :: WithStatusNoLock DigitalSignaturesConfig testObject_WithStatusNoLock_team_13 = WithStatusNoLock FeatureStatusEnabled DigitalSignaturesConfig FeatureTTLUnlimited testObject_WithStatusNoLock_team_14 :: WithStatusNoLock ConferenceCallingConfig -testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled ConferenceCallingConfig FeatureTTLUnlimited +testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled (ConferenceCallingConfig True) FeatureTTLUnlimited testObject_WithStatusNoLock_team_15 :: WithStatusNoLock GuestLinksConfig testObject_WithStatusNoLock_team_15 = WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs index d4bb69801a7..f668a32c157 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs @@ -63,7 +63,7 @@ testObject_WithStatusPatch_team_13 :: WithStatusPatch DigitalSignaturesConfig testObject_WithStatusPatch_team_13 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just DigitalSignaturesConfig) testObject_WithStatusPatch_team_14 :: WithStatusPatch ConferenceCallingConfig -testObject_WithStatusPatch_team_14 = withStatus Nothing (Just LockStatusUnlocked) (Just ConferenceCallingConfig) +testObject_WithStatusPatch_team_14 = withStatus Nothing (Just LockStatusUnlocked) (Just (ConferenceCallingConfig True)) testObject_WithStatusPatch_team_15 :: WithStatusPatch GuestLinksConfig testObject_WithStatusPatch_team_15 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just GuestLinksConfig) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs index 78523389109..cbf44775e71 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs @@ -66,7 +66,7 @@ testObject_WithStatus_team_13 :: WithStatus DigitalSignaturesConfig testObject_WithStatus_team_13 = withStatus FeatureStatusEnabled LockStatusLocked DigitalSignaturesConfig testObject_WithStatus_team_14 :: WithStatus ConferenceCallingConfig -testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked ConferenceCallingConfig +testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig True) testObject_WithStatus_team_15 :: WithStatus GuestLinksConfig testObject_WithStatus_team_15 = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index f3b65f6b37c..87ff22e9c02 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -160,8 +160,9 @@ testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig . (^?! Aeson.key "conferenceCalling") . responseJsonUnsafe @Aeson.Value - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusEnabled ApiFt.ConferenceCallingConfig ApiFt.FeatureTTLUnlimited - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusDisabled ApiFt.ConferenceCallingConfig ApiFt.FeatureTTLUnlimited + -- TODO + check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusEnabled (ApiFt.ConferenceCallingConfig False) ApiFt.FeatureTTLUnlimited + check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusDisabled (ApiFt.ConferenceCallingConfig False) ApiFt.FeatureTTLUnlimited check' testGetMlsClients :: Brig -> Http () diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 282e9d916c2..b26ecfd936e 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -199,7 +199,7 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT row.conferenceCalling Nothing (fromMaybe FeatureTTLUnlimited row.conferenceCallingTtl) - (Just ConferenceCallingConfig) + conferenceCallingConfig serverConfigs.afcConferenceCalling, afcSelfDeletingMessages = computeConfig @@ -314,6 +314,12 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT downloadLocationConfig = Just $ EnforceFileDownloadLocationConfig row.enforceDownloadLocation_Location + conferenceCallingConfig = + Just $ + ConferenceCallingConfig + { sftForOne2One = False + } + -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! exposeInvitationURLsComputeFeatureStatus :: Maybe FeatureStatus -> From 021cdfd91b45dabd3b4eb8f98f9510d7cdfe3d26 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 Jul 2024 10:20:20 +0200 Subject: [PATCH 03/43] Use patch endpoint to set feature status in stern --- tools/stern/src/Stern/API.hs | 13 ++---- tools/stern/src/Stern/Intra.hs | 73 ++++++++++++++++++++++------------ 2 files changed, 51 insertions(+), 35 deletions(-) diff --git a/tools/stern/src/Stern/API.hs b/tools/stern/src/Stern/API.hs index 8b071b59b45..b95aa15c989 100644 --- a/tools/stern/src/Stern/API.hs +++ b/tools/stern/src/Stern/API.hs @@ -328,11 +328,6 @@ mkFeaturePutRoute :: mkFeaturePutRoute tid payload = NoContent <$ Intra.setTeamFeatureFlag @cfg tid payload type MkFeaturePutConstraints cfg = - ( MkFeaturePutLockConstraints cfg, - FeatureTrivialConfig cfg - ) - -type MkFeaturePutLockConstraints cfg = ( IsFeatureConfig cfg, KnownSymbol (FeatureSymbol cfg), ToSchema cfg, @@ -346,7 +341,7 @@ mkFeaturePutRouteTrivialConfigNoTTL :: mkFeaturePutRouteTrivialConfigNoTTL tid status = mkFeaturePutRouteTrivialConfig @cfg tid status Nothing mkFeatureLockUnlockRouteTrivialConfigNoTTL :: - forall cfg. (MkFeaturePutLockConstraints cfg) => TeamId -> LockStatus -> Handler NoContent + forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> LockStatus -> Handler NoContent mkFeatureLockUnlockRouteTrivialConfigNoTTL tid lstat = NoContent <$ Intra.setTeamFeatureLockStatus @cfg tid lstat mkFeaturePutRouteTrivialConfigWithTTL :: @@ -355,9 +350,9 @@ mkFeaturePutRouteTrivialConfigWithTTL tid status = mkFeaturePutRouteTrivialConfi mkFeaturePutRouteTrivialConfig :: forall cfg. (MkFeaturePutConstraints cfg) => TeamId -> FeatureStatus -> Maybe FeatureTTLDays -> Handler NoContent -mkFeaturePutRouteTrivialConfig tid status (maybe FeatureTTLUnlimited convertFeatureTTLDaysToSeconds -> ttl) = do - let fullStatus = WithStatusNoLock status trivialConfig ttl - NoContent <$ Intra.setTeamFeatureFlag @cfg tid fullStatus +mkFeaturePutRouteTrivialConfig tid status (fmap convertFeatureTTLDaysToSeconds -> ttl) = do + let patch = wsPatch (Just status) Nothing Nothing ttl + NoContent <$ Intra.patchTeamFeatureFlag @cfg tid patch getSearchVisibility :: TeamId -> Handler TeamSearchVisibilityView getSearchVisibility = Intra.getSearchVisibility diff --git a/tools/stern/src/Stern/Intra.hs b/tools/stern/src/Stern/Intra.hs index 326f5ebf821..3019d235585 100644 --- a/tools/stern/src/Stern/Intra.hs +++ b/tools/stern/src/Stern/Intra.hs @@ -45,6 +45,7 @@ module Stern.Intra setBlacklistStatus, getTeamFeatureFlag, setTeamFeatureFlag, + patchTeamFeatureFlag, setTeamFeatureLockStatus, getTeamData, getSearchVisibility, @@ -69,7 +70,7 @@ module Stern.Intra ) where -import Bilge hiding (head, options, path, paths, requestId) +import Bilge hiding (head, options, patch, path, paths, requestId) import Bilge qualified import Bilge.RPC import Brig.Types.Intra @@ -551,38 +552,58 @@ setTeamFeatureFlag :: setTeamFeatureFlag tid status = do info $ msg "Setting team feature status" checkDaysLimit (wssTTL status) + galleyRpc $ + method PUT + . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . Bilge.json status + . contentJson + +patchTeamFeatureFlag :: + forall cfg. + ( ToJSON (Public.WithStatusPatch cfg), + KnownSymbol (Public.FeatureSymbol cfg) + ) => + TeamId -> + Public.WithStatusPatch cfg -> + Handler () +patchTeamFeatureFlag tid patch = do + info $ msg "Patching team feature status" + for_ (wspTTL patch) $ \ttl -> checkDaysLimit ttl + galleyRpc $ + method PATCH + . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] + . Bilge.json patch + . contentJson + +galleyRpc :: (Bilge.Request -> Bilge.Request) -> Handler () +galleyRpc req = do gly <- view galley - let req = - method PUT - . Bilge.paths ["i", "teams", toByteString' tid, "features", Public.featureNameBS @cfg] - . Bilge.json status - . contentJson resp <- catchRpcErrors $ rpc' "galley" gly req case statusCode resp of 200 -> pure () 404 -> throwE (mkError status404 "bad-upstream" "team does not exist") - 403 -> throwE (mkError status403 "bad-upstream" "legal hold config cannot be changed") + 403 -> throwE (mkError status403 "bad-upstream" "config cannot be changed") _ -> throwE (mkError status502 "bad-upstream" (errorMessage resp)) - where - checkDaysLimit :: FeatureTTL -> Handler () - checkDaysLimit = \case - FeatureTTLUnlimited -> pure () - FeatureTTLSeconds ((`div` (60 * 60 * 24)) -> days) -> do - unless (days <= daysLimit) $ do - throwE - ( mkError - status400 - "bad-data" - ( LT.pack $ - "ttl limit is " - <> show daysLimit - <> " days; I got " - <> show days - <> "." - ) + +checkDaysLimit :: FeatureTTL -> Handler () +checkDaysLimit = \case + FeatureTTLUnlimited -> pure () + FeatureTTLSeconds ((`div` (60 * 60 * 24)) -> days) -> do + unless (days <= daysLimit) $ do + throwE + ( mkError + status400 + "bad-data" + ( LT.pack $ + "ttl limit is " + <> show daysLimit + <> " days; I got " + <> show days + <> "." ) - where - daysLimit = 2000 + ) + where + daysLimit = 2000 setTeamFeatureLockStatus :: forall cfg. From 42020fa9aefce2efe5f71f1b787f460e091981c3 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 Jul 2024 10:32:28 +0200 Subject: [PATCH 04/43] Remove FeatureTrivialConfig class --- libs/wire-api/src/Wire/API/Team/Feature.hs | 43 +------------------ .../Test/Spar/Scim/AuthSpec.hs | 2 +- services/spar/test-integration/Util/Core.hs | 4 +- services/spar/test-integration/Util/Email.hs | 2 +- tools/stern/src/Stern/API/Routes.hs | 26 +++++------ 5 files changed, 18 insertions(+), 59 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 5117e6d2530..d3e2b55018e 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -58,7 +58,6 @@ module Wire.API.Team.Feature computeFeatureConfigForTeamUser, IsFeatureConfig (..), FeatureSingleton (..), - FeatureTrivialConfig (..), HasDeprecatedFeatureName (..), LockStatusResponse (..), -- Features @@ -134,8 +133,7 @@ import Wire.Arbitrary (Arbitrary, GenericUniform (..)) -- being enabled/disabled, locked/unlocked, then the config should be a unit -- type, e.g. **data MyFeatureConfig = MyFeatureConfig**. Add a singleton for -- the new data type. Implement type classes 'RenderableSymbol', 'ToSchema', --- 'IsFeatureConfig' and 'Arbitrary'. If your feature doesn't have a config --- implement 'FeatureTrivialConfig'. +-- 'IsFeatureConfig' and 'Arbitrary'. -- -- 2. Add the config to 'AllFeatureConfigs'. -- @@ -216,9 +214,6 @@ data FeatureSingleton cfg where FeatureSingletonEnforceFileDownloadLocationConfig :: FeatureSingleton EnforceFileDownloadLocationConfig FeatureSingletonLimitedEventFanoutConfig :: FeatureSingleton LimitedEventFanoutConfig -class FeatureTrivialConfig cfg where - trivialConfig :: cfg - class HasDeprecatedFeatureName cfg where type DeprecatedFeatureName cfg :: Symbol @@ -598,9 +593,6 @@ instance IsFeatureConfig GuestLinksConfig where objectSchema = pure GuestLinksConfig -instance FeatureTrivialConfig GuestLinksConfig where - trivialConfig = GuestLinksConfig - -------------------------------------------------------------------------------- -- Legalhold feature @@ -620,9 +612,6 @@ instance IsFeatureConfig LegalholdConfig where instance ToSchema LegalholdConfig where schema = object "LegalholdConfig" objectSchema -instance FeatureTrivialConfig LegalholdConfig where - trivialConfig = LegalholdConfig - -------------------------------------------------------------------------------- -- SSO feature @@ -642,9 +631,6 @@ instance IsFeatureConfig SSOConfig where instance ToSchema SSOConfig where schema = object "SSOConfig" objectSchema -instance FeatureTrivialConfig SSOConfig where - trivialConfig = SSOConfig - -------------------------------------------------------------------------------- -- SearchVisibility available feature @@ -666,9 +652,6 @@ instance IsFeatureConfig SearchVisibilityAvailableConfig where instance ToSchema SearchVisibilityAvailableConfig where schema = object "SearchVisibilityAvailableConfig" objectSchema -instance FeatureTrivialConfig SearchVisibilityAvailableConfig where - trivialConfig = SearchVisibilityAvailableConfig - instance HasDeprecatedFeatureName SearchVisibilityAvailableConfig where type DeprecatedFeatureName SearchVisibilityAvailableConfig = "search-visibility" @@ -694,9 +677,6 @@ instance IsFeatureConfig ValidateSAMLEmailsConfig where instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where type DeprecatedFeatureName ValidateSAMLEmailsConfig = "validate-saml-emails" -instance FeatureTrivialConfig ValidateSAMLEmailsConfig where - trivialConfig = ValidateSAMLEmailsConfig - -------------------------------------------------------------------------------- -- DigitalSignatures feature @@ -719,9 +699,6 @@ instance HasDeprecatedFeatureName DigitalSignaturesConfig where instance ToSchema DigitalSignaturesConfig where schema = object "DigitalSignaturesConfig" objectSchema -instance FeatureTrivialConfig DigitalSignaturesConfig where - trivialConfig = DigitalSignaturesConfig - -------------------------------------------------------------------------------- -- ConferenceCalling feature @@ -767,9 +744,6 @@ instance IsFeatureConfig SndFactorPasswordChallengeConfig where featureSingleton = FeatureSingletonSndFactorPasswordChallengeConfig objectSchema = pure SndFactorPasswordChallengeConfig -instance FeatureTrivialConfig SndFactorPasswordChallengeConfig where - trivialConfig = SndFactorPasswordChallengeConfig - -------------------------------------------------------------------------------- -- SearchVisibilityInbound feature @@ -790,9 +764,6 @@ instance IsFeatureConfig SearchVisibilityInboundConfig where instance ToSchema SearchVisibilityInboundConfig where schema = object "SearchVisibilityInboundConfig" objectSchema -instance FeatureTrivialConfig SearchVisibilityInboundConfig where - trivialConfig = SearchVisibilityInboundConfig - ---------------------------------------------------------------------- -- ClassifiedDomains feature @@ -885,9 +856,6 @@ instance IsFeatureConfig FileSharingConfig where instance ToSchema FileSharingConfig where schema = object "FileSharingConfig" objectSchema -instance FeatureTrivialConfig FileSharingConfig where - trivialConfig = FileSharingConfig - ---------------------------------------------------------------------- -- SelfDeletingMessagesConfig @@ -977,9 +945,6 @@ instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where instance ToSchema ExposeInvitationURLsToTeamAdminConfig where schema = object "ExposeInvitationURLsToTeamAdminConfig" objectSchema -instance FeatureTrivialConfig ExposeInvitationURLsToTeamAdminConfig where - trivialConfig = ExposeInvitationURLsToTeamAdminConfig - ---------------------------------------------------------------------- -- OutlookCalIntegrationConfig @@ -1001,9 +966,6 @@ instance IsFeatureConfig OutlookCalIntegrationConfig where instance ToSchema OutlookCalIntegrationConfig where schema = object "OutlookCalIntegrationConfig" objectSchema -instance FeatureTrivialConfig OutlookCalIntegrationConfig where - trivialConfig = OutlookCalIntegrationConfig - ---------------------------------------------------------------------- -- MlsE2EId @@ -1151,9 +1113,6 @@ instance IsFeatureConfig LimitedEventFanoutConfig where instance ToSchema LimitedEventFanoutConfig where schema = object "LimitedEventFanoutConfig" objectSchema -instance FeatureTrivialConfig LimitedEventFanoutConfig where - trivialConfig = LimitedEventFanoutConfig - ---------------------------------------------------------------------- -- FeatureStatus diff --git a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs index 9247594fe87..0d9ace470ec 100644 --- a/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs +++ b/services/spar/test-integration/Test/Spar/Scim/AuthSpec.hs @@ -147,7 +147,7 @@ unlockFeature galley tid = setSndFactorPasswordChallengeStatus :: GalleyReq -> TeamId -> Public.FeatureStatus -> TestSpar () setSndFactorPasswordChallengeStatus galley tid status = do - let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock @Public.SndFactorPasswordChallengeConfig status Public.trivialConfig Public.FeatureTTLUnlimited + let js = RequestBodyLBS $ encode $ Public.WithStatusNoLock @Public.SndFactorPasswordChallengeConfig status Public.SndFactorPasswordChallengeConfig Public.FeatureTTLUnlimited call $ put (galley . paths ["i", "teams", toByteString' tid, "features", featureNameBS @Public.SndFactorPasswordChallengeConfig] . contentJson . body js) !!! const 200 === statusCode diff --git a/services/spar/test-integration/Util/Core.hs b/services/spar/test-integration/Util/Core.hs index e0b1233bf5d..30e18ed8cfa 100644 --- a/services/spar/test-integration/Util/Core.hs +++ b/services/spar/test-integration/Util/Core.hs @@ -196,7 +196,7 @@ import Util.Types import qualified Web.Cookie as Web import Wire.API.Team (Icon (..)) import qualified Wire.API.Team as Galley -import Wire.API.Team.Feature (FeatureStatus (..), FeatureTTL' (..), FeatureTrivialConfig (trivialConfig), SSOConfig, WithStatusNoLock (WithStatusNoLock)) +import Wire.API.Team.Feature import qualified Wire.API.Team.Invitation as TeamInvitation import Wire.API.Team.Member (NewTeamMember, TeamMemberList, rolePermissions) import qualified Wire.API.Team.Member as Member @@ -385,7 +385,7 @@ putSSOEnabledInternal gly tid enabled = do void . put $ gly . paths ["i", "teams", toByteString' tid, "features", "sso"] - . json (WithStatusNoLock @SSOConfig enabled trivialConfig FeatureTTLUnlimited) + . json (WithStatusNoLock @SSOConfig enabled SSOConfig FeatureTTLUnlimited) . expect2xx -- | cloned from `/services/brig/test/integration/API/Team/Util.hs`. diff --git a/services/spar/test-integration/Util/Email.hs b/services/spar/test-integration/Util/Email.hs index 49a6ca62690..0a1910127fe 100644 --- a/services/spar/test-integration/Util/Email.hs +++ b/services/spar/test-integration/Util/Email.hs @@ -110,6 +110,6 @@ activate brig (k, c) = setSamlEmailValidation :: (HasCallStack) => TeamId -> Feature.FeatureStatus -> TestSpar () setSamlEmailValidation tid status = do galley <- view teGalley - let req = put $ galley . paths p . json (Feature.WithStatusNoLock @Feature.ValidateSAMLEmailsConfig status Feature.trivialConfig Feature.FeatureTTLUnlimited) + let req = put $ galley . paths p . json (Feature.WithStatusNoLock @Feature.ValidateSAMLEmailsConfig status Feature.ValidateSAMLEmailsConfig Feature.FeatureTTLUnlimited) p = ["/i/teams", toByteString' tid, "features", Feature.featureNameBS @Feature.ValidateSAMLEmailsConfig] call req !!! const 200 === statusCode diff --git a/tools/stern/src/Stern/API/Routes.hs b/tools/stern/src/Stern/API/Routes.hs index b52d262f142..1dac0d82082 100644 --- a/tools/stern/src/Stern/API/Routes.hs +++ b/tools/stern/src/Stern/API/Routes.hs @@ -253,20 +253,20 @@ type SternAPI = :> Get '[JSON] TeamAdminInfo ) :<|> Named "get-route-legalhold-config" (MkFeatureGetRoute LegalholdConfig) - :<|> Named "put-route-legalhold-config" (MkFeaturePutRouteTrivialConfigNoTTL LegalholdConfig) + :<|> Named "put-route-legalhold-config" (MkFeaturePutRouteNoTTL LegalholdConfig) :<|> Named "get-route-sso-config" (MkFeatureGetRoute SSOConfig) - :<|> Named "put-route-sso-config" (MkFeaturePutRouteTrivialConfigNoTTL SSOConfig) + :<|> Named "put-route-sso-config" (MkFeaturePutRouteNoTTL SSOConfig) :<|> Named "get-route-search-visibility-available-config" (MkFeatureGetRoute SearchVisibilityAvailableConfig) - :<|> Named "put-route-search-visibility-available-config" (MkFeaturePutRouteTrivialConfigNoTTL SearchVisibilityAvailableConfig) + :<|> Named "put-route-search-visibility-available-config" (MkFeaturePutRouteNoTTL SearchVisibilityAvailableConfig) :<|> Named "get-route-validate-saml-emails-config" (MkFeatureGetRoute ValidateSAMLEmailsConfig) - :<|> Named "put-route-validate-saml-emails-config" (MkFeaturePutRouteTrivialConfigNoTTL ValidateSAMLEmailsConfig) + :<|> Named "put-route-validate-saml-emails-config" (MkFeaturePutRouteNoTTL ValidateSAMLEmailsConfig) :<|> Named "get-route-digital-signatures-config" (MkFeatureGetRoute DigitalSignaturesConfig) - :<|> Named "put-route-digital-signatures-config" (MkFeaturePutRouteTrivialConfigNoTTL DigitalSignaturesConfig) + :<|> Named "put-route-digital-signatures-config" (MkFeaturePutRouteNoTTL DigitalSignaturesConfig) :<|> Named "get-route-file-sharing-config" (MkFeatureGetRoute FileSharingConfig) - :<|> Named "put-route-file-sharing-config" (MkFeaturePutRouteTrivialConfigNoTTL FileSharingConfig) + :<|> Named "put-route-file-sharing-config" (MkFeaturePutRouteNoTTL FileSharingConfig) :<|> Named "get-route-classified-domains-config" (MkFeatureGetRoute ClassifiedDomainsConfig) :<|> Named "get-route-conference-calling-config" (MkFeatureGetRoute ConferenceCallingConfig) - :<|> Named "put-route-conference-calling-config" (MkFeaturePutRouteTrivialConfigWithTTL ConferenceCallingConfig) + :<|> Named "put-route-conference-calling-config" (MkFeaturePutRouteWithTTL ConferenceCallingConfig) :<|> Named "get-route-applock-config" (MkFeatureGetRoute AppLockConfig) :<|> Named "put-route-applock-config" (MkFeaturePutRoute AppLockConfig) :<|> Named "get-route-mls-config" (MkFeatureGetRoute MLSConfig) @@ -297,8 +297,8 @@ type SternAPI = :> Put '[JSON] NoContent ) :<|> Named "get-route-outlook-cal-config" (MkFeatureGetRoute OutlookCalIntegrationConfig) - :<|> Named "lock-unlock-route-outlook-cal-config" (MkFeatureLockUnlockRouteTrivialConfigNoTTL OutlookCalIntegrationConfig) - :<|> Named "put-route-outlook-cal-config" (MkFeaturePutRouteTrivialConfigNoTTL OutlookCalIntegrationConfig) + :<|> Named "lock-unlock-route-outlook-cal-config" (MkFeatureLockUnlockRouteNoTTL OutlookCalIntegrationConfig) + :<|> Named "put-route-outlook-cal-config" (MkFeaturePutRouteNoTTL OutlookCalIntegrationConfig) :<|> Named "get-route-enforce-file-download-location" ( Description @@ -309,7 +309,7 @@ type SternAPI = "lock-unlock-route-enforce-file-download-location" ( Description "

Custom feature: only supported for some decidated on-prem systems.

" - :> MkFeatureLockUnlockRouteTrivialConfigNoTTL EnforceFileDownloadLocationConfig + :> MkFeatureLockUnlockRouteNoTTL EnforceFileDownloadLocationConfig ) :<|> Named "put-route-enforce-file-download-location" @@ -495,7 +495,7 @@ type MkFeatureGetRoute (feature :: Type) = :> FeatureSymbol feature :> Get '[JSON] (WithStatus feature) -type MkFeaturePutRouteTrivialConfigNoTTL (feature :: Type) = +type MkFeaturePutRouteNoTTL (feature :: Type) = Summary "Disable / enable status for a given feature / team" :> "teams" :> Capture "tid" TeamId @@ -504,7 +504,7 @@ type MkFeaturePutRouteTrivialConfigNoTTL (feature :: Type) = :> QueryParam' [Required, Strict] "status" FeatureStatus :> Put '[JSON] NoContent -type MkFeaturePutRouteTrivialConfigWithTTL (feature :: Type) = +type MkFeaturePutRouteWithTTL (feature :: Type) = Summary "Disable / enable status for a given feature / team" :> Description "team feature time to live, given in days, or 'unlimited' (default). only available on *some* features!" :> "teams" @@ -515,7 +515,7 @@ type MkFeaturePutRouteTrivialConfigWithTTL (feature :: Type) = :> QueryParam' [Required, Strict, Description "team feature time to live, given in days, or 'unlimited' (default)."] "ttl" FeatureTTLDays :> Put '[JSON] NoContent -type MkFeatureLockUnlockRouteTrivialConfigNoTTL (feature :: Type) = +type MkFeatureLockUnlockRouteNoTTL (feature :: Type) = Summary "Lock / unlock status for a given feature / team (en-/disable should happen in team settings)" :> "teams" :> Capture "tid" TeamId From b0da9236e06f0e64f7bfe34ee1bb032fa363269d Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 Jul 2024 10:40:50 +0200 Subject: [PATCH 05/43] Add migration to add conference calling sft flag --- services/galley/galley.cabal | 1 + services/galley/src/Galley/Schema/Run.hs | 4 +++- .../Schema/V93_ConferenceCallingSftForOneToOne.hs | 14 ++++++++++++++ 3 files changed, 18 insertions(+), 1 deletion(-) create mode 100644 services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 64bb0d69b4f..58f9f6c9fab 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -272,6 +272,7 @@ library Galley.Schema.V90_EnforceFileDownloadLocationConfig Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout Galley.Schema.V92_MlsE2EIdConfig + Galley.Schema.V93_ConferenceCallingSftForOneToOne Galley.Types.Clients Galley.Types.ToUserRole Galley.Types.UserList diff --git a/services/galley/src/Galley/Schema/Run.hs b/services/galley/src/Galley/Schema/Run.hs index 5039676a3fa..45417b188f8 100644 --- a/services/galley/src/Galley/Schema/Run.hs +++ b/services/galley/src/Galley/Schema/Run.hs @@ -93,6 +93,7 @@ import Galley.Schema.V89_MlsLockStatus qualified as V89_MlsLockStatus import Galley.Schema.V90_EnforceFileDownloadLocationConfig qualified as V90_EnforceFileDownloadLocationConfig import Galley.Schema.V91_TeamMemberDeletedLimitedEventFanout qualified as V91_TeamMemberDeletedLimitedEventFanout import Galley.Schema.V92_MlsE2EIdConfig qualified as V92_MlsE2EIdConfig +import Galley.Schema.V93_ConferenceCallingSftForOneToOne qualified as V93_ConferenceCallingSftForOneToOne import Imports import Options.Applicative import System.Logger.Extended qualified as Log @@ -186,7 +187,8 @@ migrations = V89_MlsLockStatus.migration, V90_EnforceFileDownloadLocationConfig.migration, V91_TeamMemberDeletedLimitedEventFanout.migration, - V92_MlsE2EIdConfig.migration + V92_MlsE2EIdConfig.migration, + V93_ConferenceCallingSftForOneToOne.migration -- FUTUREWORK: once #1726 has made its way to master/production, -- the 'message' field in connections table can be dropped. -- See also https://github.com/wireapp/wire-server/pull/1747/files diff --git a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs new file mode 100644 index 00000000000..22c479176ae --- /dev/null +++ b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs @@ -0,0 +1,14 @@ +module Galley.Schema.V93_ConferenceCallingSftForOneToOne where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + Migration 93 "Add conference_calling_sft_for_one_to_one to team_features" $ + schema' + [r| ALTER TABLE team_features ADD ( + conference_calling_sft_for_one_to_one boolean + ) + |] From ee0f55d84997d8ecf127863ab16b1f42eac15ff7 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 Jul 2024 11:10:19 +0200 Subject: [PATCH 06/43] Implement get/set conference calling feature flag --- .../Cassandra/GetAllTeamFeatureConfigs.hs | 6 +++-- .../src/Galley/Cassandra/TeamFeatures.hs | 24 +++++++++---------- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index b26ecfd936e..dfd210585a1 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -40,6 +40,7 @@ data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow -- conference calling conferenceCalling :: Maybe FeatureStatus, conferenceCallingTtl :: Maybe FeatureTTL, + conferenceCallingSftForOne2One :: Maybe Bool, -- guest links guestLinks :: Maybe FeatureStatus, guestLinksLock :: Maybe LockStatus, @@ -100,6 +101,7 @@ emptyRow = selfDeletingMessagesLock = Nothing, conferenceCalling = Nothing, conferenceCallingTtl = Nothing, + conferenceCallingSftForOne2One = Nothing, guestLinks = Nothing, guestLinksLock = Nothing, sndFactor = Nothing, @@ -317,7 +319,7 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT conferenceCallingConfig = Just $ ConferenceCallingConfig - { sftForOne2One = False + { sftForOne2One = fromMaybe False row.conferenceCallingSftForOne2One } -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! @@ -373,7 +375,7 @@ getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitL \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ \file_sharing, file_sharing_lock_status, \ \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ - \conference_calling, ttl(conference_calling), \ + \conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one, \ \guest_links_status, guest_links_lock_status, \ \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ \\ diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 618b242efaf..82805973b4f 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -129,18 +129,18 @@ 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 + Just (Nothing, _, _) -> Nothing + Just (Just status, mTtl, mSft) -> + Just $ + WithStatusNoLock + status + (ConferenceCallingConfig {sftForOne2One = fromMaybe False mSft}) + (fromMaybe FeatureTTLUnlimited mTtl) where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL) + select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL, Maybe Bool) select = fromString $ - "select conference_calling, ttl(conference_calling) from team_features where team_id = ?" + "select conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one 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 @@ -251,16 +251,16 @@ setFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid status = do "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)) + retry x5 $ write insert (params LocalQuorum (tid, statusNoLock.wssStatus, statusNoLock.wssConfig.sftForOne2One)) 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 :: PrepQuery W (TeamId, FeatureStatus, Bool) () insert = fromString $ - "insert into team_features (team_id,conference_calling) values (?, ?)" + "insert into team_features (team_id,conference_calling,conference_calling_sft_for_one_to_one) values (?, ?, ?)" <> renderFeatureTtl (wssTTL statusNoLock) setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = From d701da5b13b1c5ad7d4cc0958175e5690c9a0106 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 22 Jul 2024 14:59:01 +0200 Subject: [PATCH 07/43] Fix golden tests --- libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs | 5 ++++- .../golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs | 2 +- .../test/golden/fromJSON/testObject_WithStatus_team_14.json | 5 +++++ .../test/golden/testObject_WithStatusNoLock_team_14.json | 3 ++- .../test/golden/testObject_WithStatusPatch_team_14.json | 4 +++- libs/wire-api/test/golden/testObject_WithStatus_team_14.json | 3 ++- 6 files changed, 17 insertions(+), 5 deletions(-) create mode 100644 libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs index 1294ca9bd06..e999ab389a2 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/FromJSON.hs @@ -25,6 +25,7 @@ import Test.Wire.API.Golden.Generated.MemberUpdateData_user import Test.Wire.API.Golden.Generated.NewOtrMessage_user import Test.Wire.API.Golden.Generated.RmClient_user import Test.Wire.API.Golden.Generated.SimpleMember_user +import Test.Wire.API.Golden.Generated.WithStatus_team import Test.Wire.API.Golden.Runner import Wire.API.Conversation (Conversation, MemberUpdate, OtherMemberUpdate) import Wire.API.User (NewUser, NewUserPublic) @@ -88,5 +89,7 @@ tests = testFromJSONFailureWithMsg @NewUserPublic (Just "only managed-by-Wire users can be created here.") "testObject_NewUserPublic_user_1-3.json" - ] + ], + testCase "WithStatus_ConferenceCallingConfig" $ + testFromJSONObject testObject_WithStatus_team_14 "testObject_WithStatus_team_14.json" ] diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs index cbf44775e71..020c1f979ca 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs @@ -66,7 +66,7 @@ testObject_WithStatus_team_13 :: WithStatus DigitalSignaturesConfig testObject_WithStatus_team_13 = withStatus FeatureStatusEnabled LockStatusLocked DigitalSignaturesConfig testObject_WithStatus_team_14 :: WithStatus ConferenceCallingConfig -testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig True) +testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig False) testObject_WithStatus_team_15 :: WithStatus GuestLinksConfig testObject_WithStatus_team_15 = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig diff --git a/libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json b/libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json new file mode 100644 index 00000000000..e304622641b --- /dev/null +++ b/libs/wire-api/test/golden/fromJSON/testObject_WithStatus_team_14.json @@ -0,0 +1,5 @@ +{ + "lockStatus": "unlocked", + "status": "disabled", + "ttl": "unlimited" +} diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json b/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json index e5482fe80cd..3645829fa89 100644 --- a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json +++ b/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json @@ -1,4 +1,5 @@ { "status": "disabled", - "ttl": "unlimited" + "ttl": "unlimited", + "useSFTForOneToOneCalls": true } diff --git a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json b/libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json index d9c772e591c..da8c2395e05 100644 --- a/libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json +++ b/libs/wire-api/test/golden/testObject_WithStatusPatch_team_14.json @@ -1,5 +1,7 @@ { - "config": {}, + "config": { + "useSFTForOneToOneCalls": true + }, "lockStatus": "unlocked", "ttl": "unlimited" } diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_14.json b/libs/wire-api/test/golden/testObject_WithStatus_team_14.json index e304622641b..1d731cfcc43 100644 --- a/libs/wire-api/test/golden/testObject_WithStatus_team_14.json +++ b/libs/wire-api/test/golden/testObject_WithStatus_team_14.json @@ -1,5 +1,6 @@ { "lockStatus": "unlocked", "status": "disabled", - "ttl": "unlimited" + "ttl": "unlimited", + "useSFTForOneToOneCalls": false } From b7f2ea136b9d0358471d4387f98241a40ceb00c8 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 22 Jul 2024 15:46:24 +0200 Subject: [PATCH 08/43] Add endpoint to put ConferenceCallingConfig. --- libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs | 1 + services/galley/src/Galley/API/Public/Feature.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs index 654f79657a2..4aba788fcf5 100644 --- a/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs +++ b/libs/wire-api/src/Wire/API/Routes/Public/Galley/Feature.hs @@ -73,6 +73,7 @@ type FeatureAPI = :<|> FeatureStatusPut '[] '() FileSharingConfig :<|> FeatureStatusGet ClassifiedDomainsConfig :<|> FeatureStatusGet ConferenceCallingConfig + :<|> FeatureStatusPut '[] '() ConferenceCallingConfig :<|> FeatureStatusGet SelfDeletingMessagesConfig :<|> FeatureStatusPut '[] '() SelfDeletingMessagesConfig :<|> FeatureStatusGet GuestLinksConfig diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs index 3e9d3f68a54..02b880f1bbe 100644 --- a/services/galley/src/Galley/API/Public/Feature.hs +++ b/services/galley/src/Galley/API/Public/Feature.hs @@ -47,6 +47,7 @@ featureAPI = <@> mkNamedAPI @'("put", FileSharingConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", ClassifiedDomainsConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", ConferenceCallingConfig) (getFeatureStatus . DoAuth) + <@> mkNamedAPI @'("put", ConferenceCallingConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", SelfDeletingMessagesConfig) (getFeatureStatus . DoAuth) <@> mkNamedAPI @'("put", SelfDeletingMessagesConfig) (setFeatureStatus . DoAuth) <@> mkNamedAPI @'("get", GuestLinksConfig) (getFeatureStatus . DoAuth) From 40f18d9ab67e45d1b7a4c4b5d61a6f6357675f73 Mon Sep 17 00:00:00 2001 From: Igor Ranieri Date: Mon, 22 Jul 2024 17:06:12 +0200 Subject: [PATCH 09/43] Added lock status to conf. calling. WIP: Tests need fixing sinnce it's no longer a SimpleFlag. --- changelog.d/1-api-changes/wpb-10235 | 1 + integration/test/Test/FeatureFlags.hs | 44 ++++++++++++++++--- integration/test/Test/FeatureFlags/Util.hs | 2 +- .../src/Wire/API/Routes/Internal/Galley.hs | 1 + libs/wire-api/src/Wire/API/Team/Feature.hs | 9 ++-- services/galley/src/Galley/API/Internal.hs | 1 + .../Cassandra/GetAllTeamFeatureConfigs.hs | 6 ++- .../src/Galley/Cassandra/TeamFeatures.hs | 2 + .../V93_ConferenceCallingSftForOneToOne.hs | 5 ++- 9 files changed, 57 insertions(+), 14 deletions(-) create mode 100644 changelog.d/1-api-changes/wpb-10235 diff --git a/changelog.d/1-api-changes/wpb-10235 b/changelog.d/1-api-changes/wpb-10235 new file mode 100644 index 00000000000..d1e63075f11 --- /dev/null +++ b/changelog.d/1-api-changes/wpb-10235 @@ -0,0 +1 @@ +Adds useSFTForOneToOneCalls as a config option for the Conference Calling feature flag. diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index e0943931f9e..c120c4bd9d5 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -424,18 +424,20 @@ testClassifiedDomainsDisabled = do testAllFeatures :: (HasCallStack) => App () testAllFeatures = do (_, tid, m : _) <- createTeam OwnDomain 2 - let expected = + let defEnabledObj :: Value -> Value + defEnabledObj conf = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= conf] + expected = object $ [ "legalhold" .= disabled, "sso" .= disabled, "searchVisibility" .= disabled, "validateSAMLemails" .= enabled, "digitalSignatures" .= disabled, - "appLock" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]], + "appLock" .= defEnabledObj (object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]), "fileSharing" .= enabled, - "classifiedDomains" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["domains" .= ["example.com"]]], - "conferenceCalling" .= enabled, - "selfDeletingMessages" .= object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]], + "classifiedDomains" .= defEnabledObj (object ["domains" .= ["example.com"]]), + "conferenceCalling" .= defEnabledObj (object ["useSFTForOneToOneCalls" .= A.Bool False]), + "selfDeletingMessages" .= defEnabledObj (object ["enforcedTimeoutSeconds" .= A.Number 0]), "conversationGuestLinks" .= enabled, "sndFactorPasswordChallenge" .= disabledLocked, "mls" @@ -787,6 +789,34 @@ testMLSE2EIdInternal = do cfg2 invalidCfg' +testConferenceCalling :: (HasCallStack) => App () +testConferenceCalling = do + _testLockStatusWithConfig + "conferenceCalling" + Public.setTeamFeatureConfig + (confCallingDef False) + (confCallingDef' True) + (confCallingDef' False) + (confCallingDef' (0 :: Int)) + where + confCallingDef :: (ToJSON a) => a -> Value + confCallingDef arg = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object ["useSFTForOneToOneCalls" .= toJSON arg] + ] + + confCallingDef' :: (ToJSON a) => a -> Value + confCallingDef' arg = + object + [ "status" .= "enabled", + "config" + .= object ["useSFTForOneToOneCalls" .= toJSON arg] + ] + _testLockStatusWithConfig :: (HasCallStack) => String -> @@ -835,6 +865,10 @@ _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConf -- lock the feature Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + bindResponse (Public.getTeamFeature owner tid featureName) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "lockStatus" `shouldMatch` "locked" + assertStatus 409 =<< setTeamFeatureConfig owner tid featureName config1 Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index 92426fd5f4f..412812cac0e 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -34,7 +34,7 @@ enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "u checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () checkFeature = checkFeatureWith shouldMatch -checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => (App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () +checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => ((HasCallStack) => App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () checkFeatureWith shouldMatch' feature user tid expected = do tidStr <- asString tid domain <- objDomain user diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs index 8e7a8991d31..44afc4e627a 100644 --- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs +++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs @@ -117,6 +117,7 @@ type IFeatureAPI = -- ConferenceCallingConfig :<|> IFeatureStatusGet ConferenceCallingConfig :<|> IFeatureStatusPut '[] '() ConferenceCallingConfig + :<|> IFeatureStatusLockStatusPut ConferenceCallingConfig :<|> IFeatureStatusPatch '[] '() ConferenceCallingConfig -- SelfDeletingMessagesConfig :<|> IFeatureStatusGet SelfDeletingMessagesConfig diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index d3e2b55018e..fd27a170f69 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -718,12 +718,13 @@ instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked def FeatureTTLUnlimited featureSingleton = FeatureSingletonConferenceCallingConfig - objectSchema = - ConferenceCallingConfig - <$> sftForOne2One .= (fromMaybe False <$> optField "useSFTForOneToOneCalls" schema) + objectSchema = fromMaybe def <$> optField "config" schema instance ToSchema ConferenceCallingConfig where - schema = object "ConferenceCallingConfig" objectSchema + schema = + object "ConferenceCallingConfig" $ + ConferenceCallingConfig + <$> sftForOne2One .= (fromMaybe False <$> optField "useSFTForOneToOneCalls" schema) -------------------------------------------------------------------------------- -- SndFactorPasswordChallenge feature diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs index 3cf4708fa8b..92a176a4dea 100644 --- a/services/galley/src/Galley/API/Internal.hs +++ b/services/galley/src/Galley/API/Internal.hs @@ -257,6 +257,7 @@ featureAPI = <@> mkNamedAPI @'("ipatch", FileSharingConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("iget", ConferenceCallingConfig) (getFeatureStatus DontDoAuth) <@> mkNamedAPI @'("iput", ConferenceCallingConfig) setFeatureStatusInternal + <@> mkNamedAPI @'("ilock", ConferenceCallingConfig) (updateLockStatus @ConferenceCallingConfig) <@> mkNamedAPI @'("ipatch", ConferenceCallingConfig) patchFeatureStatusInternal <@> mkNamedAPI @'("iget", SelfDeletingMessagesConfig) (getFeatureStatus DontDoAuth) <@> mkNamedAPI @'("iput", SelfDeletingMessagesConfig) setFeatureStatusInternal diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index dfd210585a1..a20ee8a792f 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -41,6 +41,7 @@ data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow conferenceCalling :: Maybe FeatureStatus, conferenceCallingTtl :: Maybe FeatureTTL, conferenceCallingSftForOne2One :: Maybe Bool, + conferenceCallingLock :: Maybe LockStatus, -- guest links guestLinks :: Maybe FeatureStatus, guestLinksLock :: Maybe LockStatus, @@ -102,6 +103,7 @@ emptyRow = conferenceCalling = Nothing, conferenceCallingTtl = Nothing, conferenceCallingSftForOne2One = Nothing, + conferenceCallingLock = Nothing, guestLinks = Nothing, guestLinksLock = Nothing, sndFactor = Nothing, @@ -199,7 +201,7 @@ allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasT afcConferenceCalling = computeConfig row.conferenceCalling - Nothing + row.conferenceCallingLock (fromMaybe FeatureTTLUnlimited row.conferenceCallingTtl) conferenceCallingConfig serverConfigs.afcConferenceCalling, @@ -375,7 +377,7 @@ getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitL \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ \file_sharing, file_sharing_lock_status, \ \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ - \conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one, \ + \conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one, conference_calling_lock_status, \ \guest_links_status, guest_links_lock_status, \ \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ \\ diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 82805973b4f..0caf71f1092 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -332,6 +332,7 @@ getFeatureLockStatus FeatureSingletonMlsMigration tid = getLockStatusC "mls_migr getFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid = getLockStatusC "outlook_cal_integration_lock_status" tid getFeatureLockStatus FeatureSingletonMLSConfig tid = getLockStatusC "mls_lock_status" tid getFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid = getLockStatusC "enforce_file_download_location_lock_status" tid +getFeatureLockStatus FeatureSingletonConferenceCallingConfig tid = getLockStatusC "conference_calling_lock_status" tid getFeatureLockStatus _ _ = pure Nothing setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockStatus -> m () @@ -344,6 +345,7 @@ setFeatureLockStatus FeatureSingletonMlsMigration tid status = setLockStatusC "m setFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid status = setLockStatusC "outlook_cal_integration_lock_status" tid status setFeatureLockStatus FeatureSingletonMLSConfig tid status = setLockStatusC "mls_lock_status" tid status setFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid status = setLockStatusC "enforce_file_download_location_lock_status" tid status +setFeatureLockStatus FeatureSingletonConferenceCallingConfig tid status = setLockStatusC "conference_calling_lock_status" tid status setFeatureLockStatus _ _tid _status = pure () getTrivialConfigC :: diff --git a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs index 22c479176ae..d43b0b5b30b 100644 --- a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs +++ b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs @@ -6,9 +6,10 @@ import Text.RawString.QQ migration :: Migration migration = - Migration 93 "Add conference_calling_sft_for_one_to_one to team_features" $ + Migration 93 "Add conference_calling_sft_for_one_to_one and its lock_status to team_features" $ schema' [r| ALTER TABLE team_features ADD ( - conference_calling_sft_for_one_to_one boolean + conference_calling_sft_for_one_to_one boolean, + conference_calling_lock_status int ) |] From 33ed08ea0240c23247c3d89de30faebe07ec0157 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 06:45:01 +0200 Subject: [PATCH 10/43] Fix golden test cases --- .../test/golden/testObject_WithStatusNoLock_team_14.json | 4 +++- libs/wire-api/test/golden/testObject_WithStatus_team_14.json | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json b/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json index 3645829fa89..9148fb4871f 100644 --- a/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json +++ b/libs/wire-api/test/golden/testObject_WithStatusNoLock_team_14.json @@ -1,5 +1,7 @@ { "status": "disabled", "ttl": "unlimited", - "useSFTForOneToOneCalls": true + "config": { + "useSFTForOneToOneCalls": true + } } diff --git a/libs/wire-api/test/golden/testObject_WithStatus_team_14.json b/libs/wire-api/test/golden/testObject_WithStatus_team_14.json index 1d731cfcc43..648c75ec1cd 100644 --- a/libs/wire-api/test/golden/testObject_WithStatus_team_14.json +++ b/libs/wire-api/test/golden/testObject_WithStatus_team_14.json @@ -2,5 +2,7 @@ "lockStatus": "unlocked", "status": "disabled", "ttl": "unlimited", - "useSFTForOneToOneCalls": false + "config": { + "useSFTForOneToOneCalls": false + } } From 74a425d49eba93e155cfa70337944f43dbcb1424 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 10:15:28 +0200 Subject: [PATCH 11/43] Update conference call ttl test --- integration/test/Test/FeatureFlags.hs | 198 +++++++++++++------------- 1 file changed, 101 insertions(+), 97 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index c120c4bd9d5..1ca3ad64ce1 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-ambiguous-fields #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2023 Wire Swiss GmbH @@ -26,7 +28,6 @@ import qualified Data.Aeson as A import qualified Data.Aeson.Key as A import qualified Data.Aeson.KeyMap as KM import qualified Data.Set as Set -import Data.String.Conversions (cs) import Notifications import SetupHelpers import Test.FeatureFlags.Util @@ -295,9 +296,6 @@ testDigitalSignaturesInternal = _testSimpleFlag "digitalSignatures" Internal.set testValidateSAMLEmailsInternal :: (HasCallStack) => App () testValidateSAMLEmailsInternal = _testSimpleFlag "validateSAMLemails" Internal.setTeamFeatureConfig True -testConferenceCallingInternal :: (HasCallStack) => App () -testConferenceCallingInternal = _testSimpleFlag "conferenceCalling" Internal.setTeamFeatureConfig True - testSearchVisibilityInboundInternal :: (HasCallStack) => App () testSearchVisibilityInboundInternal = _testSimpleFlag "searchVisibilityInbound" Internal.setTeamFeatureConfig False @@ -313,16 +311,16 @@ _testSimpleFlag featureName setFeatureConfig featureEnabledByDefault = do assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName checkFeature featureName m tid defaultValue -- should receive an event - void $ withWebSockets [m] $ \wss -> do + void $ withWebSocket m $ \ws -> do assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) - for_ wss $ \ws -> do + do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` featureName notif %. "payload.0.data" `shouldMatch` otherValue checkFeature featureName m tid otherValue assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= defaultStatus]) - for_ wss $ \ws -> do + do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` featureName notif %. "payload.0.data" `shouldMatch` defaultValue @@ -376,12 +374,11 @@ _testSimpleFlagWithLockStatus featureName setFeatureConfig featureEnabledByDefau -- change the status let otherValue = if featureEnabledByDefault then disabled else enabled - void $ withWebSockets [m] $ \wss -> do + void $ withWebSocket m $ \ws -> do assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) - for_ wss $ \ws -> do - notif <- awaitMatch isFeatureConfigUpdateNotif ws - notif %. "payload.0.name" `shouldMatch` featureName - notif %. "payload.0.data" `shouldMatch` otherValue + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` otherValue checkFeature featureName m tid otherValue @@ -625,6 +622,32 @@ mlsInvalidConfig = ] ] +data ConfCalling = ConfCalling + { lockStatus :: Maybe String, + ttl :: Maybe Value, + status :: String, + sft :: Value + } + +instance Default ConfCalling where + def = + ConfCalling + { lockStatus = Nothing, + ttl = Nothing, + status = "enabled", + sft = toJSON False + } + +confCalling :: ConfCalling -> Value +confCalling args = + object + $ ["lockStatus" .= s | s <- toList args.lockStatus] + <> ["ttl" .= s | s <- toList args.ttl] + <> [ "status" .= args.status, + "config" + .= object ["useSFTForOneToOneCalls" .= args.sft] + ] + testEnforceDownloadLocation :: (HasCallStack) => App () testEnforceDownloadLocation = _testLockStatusWithConfig @@ -794,28 +817,35 @@ testConferenceCalling = do _testLockStatusWithConfig "conferenceCalling" Public.setTeamFeatureConfig - (confCallingDef False) - (confCallingDef' True) - (confCallingDef' False) - (confCallingDef' (0 :: Int)) - where - confCallingDef :: (ToJSON a) => a -> Value - confCallingDef arg = - object - [ "lockStatus" .= "unlocked", - "status" .= "enabled", - "ttl" .= "unlimited", - "config" - .= object ["useSFTForOneToOneCalls" .= toJSON arg] - ] + (confCalling def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")}) + (confCalling def {sft = toJSON True}) + (confCalling def) + (confCalling def {sft = toJSON (0 :: Int)}) - confCallingDef' :: (ToJSON a) => a -> Value - confCallingDef' arg = - object - [ "status" .= "enabled", - "config" - .= object ["useSFTForOneToOneCalls" .= toJSON arg] - ] +testConferenceCallingInternal :: (HasCallStack) => App () +testConferenceCallingInternal = do + let defaultArgs = def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")} + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid "conferenceCalling" + checkFeature "conferenceCalling" m tid (confCalling defaultArgs) + + -- should receive an event + void $ withWebSocket m $ \ws -> do + assertSuccess =<< Internal.setTeamFeatureConfig owner tid "conferenceCalling" (confCalling def {status = "disabled"}) + do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` "conferenceCalling" + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "disabled"}) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs {status = "disabled"}) + + assertSuccess =<< Internal.setTeamFeatureConfig owner tid "conferenceCalling" (confCalling def) + do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` "conferenceCalling" + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs) _testLockStatusWithConfig :: (HasCallStack) => @@ -872,12 +902,11 @@ _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConf assertStatus 409 =<< setTeamFeatureConfig owner tid featureName config1 Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" - void $ withWebSockets [m] $ \wss -> do + void $ withWebSocket m $ \ws -> do assertSuccess =<< setTeamFeatureConfig owner tid featureName config1 - for_ wss $ \ws -> do - notif <- awaitMatch isFeatureConfigUpdateNotif ws - notif %. "payload.0.name" `shouldMatch` featureName - notif %. "payload.0.data" `shouldMatch` (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") @@ -885,18 +914,17 @@ _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConf checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultFeatureConfig Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" - void $ withWebSockets [m] $ \wss -> do + void $ withWebSocket m $ \ws -> do assertStatus 400 =<< setTeamFeatureConfig owner tid featureName invalidConfig - for_ wss $ assertNoEvent 2 + assertNoEvent 2 ws checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") - void $ withWebSockets [m] $ \wss -> do + void $ withWebSocket m $ \ws -> do assertSuccess =<< setTeamFeatureConfig owner tid featureName config2 - for_ wss $ \ws -> do - notif <- awaitMatch isFeatureConfigUpdateNotif ws - notif %. "payload.0.name" `shouldMatch` featureName - notif %. "payload.0.data" `shouldMatch` (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") checkFeature featureName m tid =<< (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") @@ -913,63 +941,39 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do length statuses `shouldMatchInt` 2 statuses `shouldMatchSet` [object ["team" .= team1, "status" .= "disabled"], object ["team" .= team2, "status" .= "enabled"]] -testConferenceCallingTTLIncreaseToUnlimited :: (HasCallStack) => App () -testConferenceCallingTTLIncreaseToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) Nothing +testConferenceCallingTTLOverride :: (HasCallStack) => App () +testConferenceCallingTTLOverride = do + (owner, tid, _) <- createTeam OwnDomain 0 + let defArgs = def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")} + featureName = "conferenceCalling" + ttl1 = Just (toJSON (2 :: Int)) + ttl2 = Just (toJSON (5 :: Int)) -testConferenceCallingTTLIncrease :: (HasCallStack) => App () -testConferenceCallingTTLIncrease = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) (Just 4) + checkFeature featureName owner tid (confCalling defArgs) -testConferenceCallingTTLReduceFromUnlimited :: (HasCallStack) => App () -testConferenceCallingTTLReduceFromUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing (Just 2) + -- set a small ttl + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) -testConferenceCallingTTLReduce :: (HasCallStack) => App () -testConferenceCallingTTLReduce = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 5) (Just 2) + -- wait less than expiration, override and recheck + liftIO $ threadDelay 500000 -- waiting half of TTL + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) -testConferenceCallingTTLUnlimitedToUnlimited :: (HasCallStack) => App () -testConferenceCallingTTLUnlimitedToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing Nothing + -- override ttl with a larger value + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl2}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl2}) -_testSimpleFlagTTLOverride :: (HasCallStack) => String -> Bool -> Maybe Int -> Maybe Int -> App () -_testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do - let ttl = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtl - let ttlAfter = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtlAfter - (owner, tid, _) <- createTeam OwnDomain 0 - let (defaultValue, otherValue) = if enabledByDefault then ("enabled", "disabled") else ("disabled", "enabled") - - -- Initial value should be the default value - let defFeatureStatus = object ["status" .= defaultValue, "ttl" .= "unlimited", "lockStatus" .= "unlocked"] - checkFeature featureName owner tid defFeatureStatus - - -- Setting should work - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) - checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) - - case (mTtl, mTtlAfter) of - (Just d, Just d') -> do - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL - -- setFlagInternal otherValue ttlAfter - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) - -- value is still correct - checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) - - liftIO $ threadDelay (d' * 1000000) -- waiting for new TTL - checkFeatureLenientTtl featureName owner tid defFeatureStatus - (Just d, Nothing) -> do - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) - -- value is still correct - checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) - (Nothing, Nothing) -> do - -- overriding in this case should have no effect. - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) - checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) - (Nothing, Just d) -> do - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) - checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) - liftIO $ threadDelay (d * 1000000) -- waiting it out - -- value reverts back - checkFeatureLenientTtl featureName owner tid defFeatureStatus + -- set it back to unlimited + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = Just (toJSON "unlimited")}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = Just (toJSON "unlimited")}) + + -- set it again to ttl1 + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) + + -- wait it out fully and check that the status reverted + liftIO $ threadDelay 2000000 + checkFeatureLenientTtl featureName owner tid (confCalling defArgs) -------------------------------------------------------------------------------- -- Simple flags with implicit lock status From df96f2d71a206e184a7229a06dc5f0e2a5e24663 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 10:22:15 +0200 Subject: [PATCH 12/43] Fix conference calling patch test --- integration/test/Test/FeatureFlags.hs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 1ca3ad64ce1..f7921efa578 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -987,9 +987,6 @@ testPatchValidateSAMLEmails = _testPatch "validateSAMLemails" False enabled disa testPatchDigitalSignatures :: (HasCallStack) => App () testPatchDigitalSignatures = _testPatch "digitalSignatures" False disabled enabled -testPatchConferenceCalling :: (HasCallStack) => App () -testPatchConferenceCalling = _testPatch "conferenceCalling" False enabled disabled - -------------------------------------------------------------------------------- -- Simple flags with explicit lock status @@ -1026,6 +1023,19 @@ testPatchAppLock = do -------------------------------------------------------------------------------- -- Flags with config & explicit lock status +testPatchConferenceCalling :: (HasCallStack) => App () +testPatchConferenceCalling = do + let defCfg = + confCalling + def + { lockStatus = Just "unlocked", + ttl = Just (toJSON "unlimited") + } + _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "conferenceCalling" True defCfg (object ["status" .= "disabled"]) + _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["useSFTForOneToOneCalls" .= toJSON True]]) + testPatchSelfDeletingMessages :: (HasCallStack) => App () testPatchSelfDeletingMessages = do let defCfg = From 694ce7cd3217d48dbf71312550b15303bcbbf175 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 10:27:24 +0200 Subject: [PATCH 13/43] Update CHANGELOG entry --- changelog.d/1-api-changes/wpb-10235 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changelog.d/1-api-changes/wpb-10235 b/changelog.d/1-api-changes/wpb-10235 index d1e63075f11..6940f53c09a 100644 --- a/changelog.d/1-api-changes/wpb-10235 +++ b/changelog.d/1-api-changes/wpb-10235 @@ -1 +1 @@ -Adds useSFTForOneToOneCalls as a config option for the Conference Calling feature flag. +Adds useSFTForOneToOneCalls as a config option for the Conference Calling feature flag and made lock status explicit. From 64f0d3c3f96e20754f8ab82dc4325f96d28fb203 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 14:22:06 +0200 Subject: [PATCH 14/43] Fix assertions in conferenceCalling TTL test --- integration/test/Test/FeatureFlags.hs | 20 ++++++++++---------- libs/wire-api/src/Wire/API/Team/Feature.hs | 3 +++ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index f7921efa578..64d5a23e752 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -952,28 +952,28 @@ testConferenceCallingTTLOverride = do checkFeature featureName owner tid (confCalling defArgs) -- set a small ttl - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1, sft = toJSON True}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) -- wait less than expiration, override and recheck liftIO $ threadDelay 500000 -- waiting half of TTL - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) -- override ttl with a larger value - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl2}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl2}) + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl2, sft = toJSON True}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl2, sft = toJSON True}) -- set it back to unlimited - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = Just (toJSON "unlimited")}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = Just (toJSON "unlimited")}) + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = Just (toJSON "unlimited"), sft = toJSON True}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = Just (toJSON "unlimited"), sft = toJSON True}) -- set it again to ttl1 - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1}) + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1, sft = toJSON True}) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) -- wait it out fully and check that the status reverted liftIO $ threadDelay 2000000 - checkFeatureLenientTtl featureName owner tid (confCalling defArgs) + checkFeatureLenientTtl featureName owner tid (confCalling defArgs {sft = toJSON True}) -------------------------------------------------------------------------------- -- Simple flags with implicit lock status diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index fd27a170f69..3416aaade94 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -359,6 +359,9 @@ instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (WithStatusPatch cfg) -- if we switch to `unlocked`, we auto-enable the feature, and if we switch to locked, we -- auto-disable it. But we need to change the API to force clients to use `lockStatus` -- instead of `status`, current behavior is just wrong. +-- +-- FUTUREWORK(paolo): why delete this type? it's used as the request body of +-- the public API for setting features data WithStatusNoLock (cfg :: Type) = WithStatusNoLock { wssStatus :: FeatureStatus, wssConfig :: cfg, From 74c4724e4c88248b7a473abf41dd8a9d119d916a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 23 Jul 2024 15:16:56 +0200 Subject: [PATCH 15/43] Move user feature test to integration Also remove its dependency on Cassandra, simplify logic and expand its scope to include team users. --- integration/integration.cabal | 1 + integration/test/API/Brig.hs | 2 +- integration/test/API/BrigInternal.hs | 29 ++++++- integration/test/API/Galley.hs | 4 + integration/test/Test/FeatureFlags.hs | 26 ------- integration/test/Test/FeatureFlags/User.hs | 70 +++++++++++++++++ integration/test/Test/FeatureFlags/Util.hs | 43 +++++++++-- .../brig/test/integration/API/Internal.hs | 75 +------------------ 8 files changed, 142 insertions(+), 108 deletions(-) create mode 100644 integration/test/Test/FeatureFlags/User.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index 9a212d87b2a..d87c87a1f7e 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -123,6 +123,7 @@ library Test.Errors Test.ExternalPartner Test.FeatureFlags + Test.FeatureFlags.User Test.FeatureFlags.Util Test.Federation Test.Federator diff --git a/integration/test/API/Brig.hs b/integration/test/API/Brig.hs index d88cafb9187..898afda288e 100644 --- a/integration/test/API/Brig.hs +++ b/integration/test/API/Brig.hs @@ -657,7 +657,7 @@ getCallsConfigV2 user = do req <- baseRequest user Brig Versioned $ joinHttpPath ["calls", "config", "v2"] submit "GET" req -addBot :: (MakesValue user) => user -> String -> String -> String -> App Response +addBot :: (HasCallStack, MakesValue user) => user -> String -> String -> String -> App Response addBot user providerId serviceId convId = do req <- baseRequest user Brig Versioned $ joinHttpPath ["conversations", convId, "bots"] submit "POST" $ diff --git a/integration/test/API/BrigInternal.hs b/integration/test/API/BrigInternal.hs index cb5be7d48c0..ccdeb10224c 100644 --- a/integration/test/API/BrigInternal.hs +++ b/integration/test/API/BrigInternal.hs @@ -244,10 +244,37 @@ getEJPDInfo dom handles mode = do bad -> error $ show bad submit "POST" $ req & addJSONObject ["EJPDRequest" .= handles] & addQueryParams query --- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_ +-- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__verification_code__action_ getVerificationCode :: (HasCallStack, MakesValue user) => user -> String -> App Response getVerificationCode user action = do uid <- objId user domain <- objDomain user req <- baseRequest domain Brig Unversioned $ joinHttpPath ["i", "users", uid, "verification-code", action] submit "GET" req + +-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/get_i_users__uid__features_conferenceCalling +getFeatureForUser :: (HasCallStack, MakesValue user) => user -> String -> App Response +getFeatureForUser user featureName = do + uid <- objId user + req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName] + submit "GET" req + +-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/put_i_users__uid__features_conferenceCalling +putFeatureForUser :: + (HasCallStack, MakesValue user, MakesValue config) => + user -> + String -> + config -> + App Response +putFeatureForUser user featureName config = do + uid <- objId user + req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName] + configValue <- make config + submit "PUT" $ req & addJSON configValue + +-- | http://staging-nginz-https.zinfra.io/api-internal/swagger-ui/brig/#/brig/delete_i_users__uid__features_conferenceCalling +deleteFeatureForUser :: (HasCallStack, MakesValue user) => user -> String -> App Response +deleteFeatureForUser user featureName = do + uid <- objId user + req <- baseRequest user Brig Unversioned $ joinHttpPath ["i", "users", uid, "features", featureName] + submit "DELETE" req diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 14861a26f04..4b04bb65bbf 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -705,3 +705,7 @@ setTeamFeatureConfigVersioned versioned user team featureName payload = do p <- make payload req <- baseRequest user Galley versioned $ joinHttpPath ["teams", tid, "features", fn] submit "PUT" $ req & addJSON p + +-- | http://staging-nginz-https.zinfra.io/v6/api/swagger-ui/#/default/get_feature_configs +getFeaturesForUser :: (HasCallStack, MakesValue user) => user -> App Response +getFeaturesForUser user = baseRequest user Galley Versioned "feature-configs" >>= submit "GET" diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 64d5a23e752..76a41429ed7 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -622,32 +622,6 @@ mlsInvalidConfig = ] ] -data ConfCalling = ConfCalling - { lockStatus :: Maybe String, - ttl :: Maybe Value, - status :: String, - sft :: Value - } - -instance Default ConfCalling where - def = - ConfCalling - { lockStatus = Nothing, - ttl = Nothing, - status = "enabled", - sft = toJSON False - } - -confCalling :: ConfCalling -> Value -confCalling args = - object - $ ["lockStatus" .= s | s <- toList args.lockStatus] - <> ["ttl" .= s | s <- toList args.ttl] - <> [ "status" .= args.status, - "config" - .= object ["useSFTForOneToOneCalls" .= args.sft] - ] - testEnforceDownloadLocation :: (HasCallStack) => App () testEnforceDownloadLocation = _testLockStatusWithConfig diff --git a/integration/test/Test/FeatureFlags/User.hs b/integration/test/Test/FeatureFlags/User.hs new file mode 100644 index 00000000000..5cdfe42f5b4 --- /dev/null +++ b/integration/test/Test/FeatureFlags/User.hs @@ -0,0 +1,70 @@ +module Test.FeatureFlags.User where + +import qualified API.BrigInternal as I +import API.Galley +import qualified API.GalleyInternal as I +import SetupHelpers +import Test.FeatureFlags.Util +import Testlib.Prelude + +testFeatureConferenceCallingForUser :: App () +testFeatureConferenceCallingForUser = do + (alice, tid, _) <- createTeam OwnDomain 0 -- team user + bob <- randomUser OwnDomain def -- non-team user + let featureName = "conferenceCalling" + ttl = Just (toJSON (360000 :: Int)) + + -- set initial value at the team level + let initial = + confCalling + def + { status = "enabled", + ttl = ttl, + sft = toJSON True + } + assertSuccess =<< I.setTeamFeatureConfig OwnDomain tid featureName initial + + -- set user value for both users + for_ [alice, bob] $ \u -> do + void $ I.putFeatureForUser u featureName (object ["status" .= "disabled"]) >>= getBody 200 + config <- I.getFeatureForUser u featureName >>= getJSON 200 + config %. "status" `shouldMatch` "disabled" + config %. "ttl" `shouldMatch` "unlimited" + + -- this config is just made up by brig, it does not reflect the actual value + -- that will be returned to the user + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False + + -- alice + do + features <- getFeaturesForUser alice >>= getJSON 200 + config <- features %. featureName + -- alice is a team user, so her config reflects that of the team + config %. "status" `shouldMatch` "enabled" + checkTtl (config %. "ttl") (360000 :: Int) + config %. "config.useSFTForOneToOneCalls" `shouldMatch` True + + do + void $ I.deleteFeatureForUser alice featureName >>= getBody 200 + features <- getFeaturesForUser alice >>= getJSON 200 + config <- features %. featureName + config %. "status" `shouldMatch` "enabled" + checkTtl (config %. "ttl") (360000 :: Int) + config %. "config.useSFTForOneToOneCalls" `shouldMatch` True + + -- bob + do + features <- getFeaturesForUser bob >>= getJSON 200 + config <- features %. featureName + -- bob is not in a team, so we get his own personal settings here + config %. "status" `shouldMatch` "disabled" + -- but only for status, ttl and config are the server defaults + config %. "ttl" `shouldMatch` "unlimited" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False + do + void $ I.deleteFeatureForUser bob featureName >>= getBody 200 + features <- getFeaturesForUser bob >>= getJSON 200 + config <- features %. featureName + config %. "status" `shouldMatch` "enabled" + config %. "ttl" `shouldMatch` "unlimited" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index 412812cac0e..0ea4d625196 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -67,13 +67,18 @@ checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl actualTtl <- actual %. "ttl" checkTtl actualTtl expectedTtl - checkTtl :: Value -> Value -> App () - checkTtl (A.String a) (A.String b) = do +checkTtl :: (MakesValue a, MakesValue b) => a -> b -> App () +checkTtl x y = do + vx <- make x + vy <- make y + check vx vy + where + check (A.String a) (A.String b) = do a `shouldMatch` "unlimited" b `shouldMatch` "unlimited" - checkTtl _ (A.String _) = assertFailure "expected the actual ttl to be unlimited, but it was limited" - checkTtl (A.String _) _ = assertFailure "expected the actual ttl to be limited, but it was unlimited" - checkTtl (A.Number actualTtl) (A.Number expectedTtl) = do + check _ (A.String _) = assertFailure "expected the actual ttl to be unlimited, but it was limited" + check (A.String _) _ = assertFailure "expected the actual ttl to be limited, but it was unlimited" + check (A.Number actualTtl) (A.Number expectedTtl) = do assertBool ("expected the actual TTL to be greater than 0 and equal to or no more than 2 seconds less than " <> show expectedTtl <> ", but it was " <> show actualTtl) ( actualTtl @@ -83,7 +88,33 @@ checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl && abs (actualTtl - expectedTtl) <= 2 ) - checkTtl _ _ = assertFailure "unexpected ttl value(s)" + check _ _ = assertFailure "unexpected ttl value(s)" assertForbidden :: (HasCallStack) => Response -> App () assertForbidden = assertLabel 403 "no-team-member" + +data ConfCalling = ConfCalling + { lockStatus :: Maybe String, + ttl :: Maybe Value, + status :: String, + sft :: Value + } + +instance Default ConfCalling where + def = + ConfCalling + { lockStatus = Nothing, + ttl = Nothing, + status = "enabled", + sft = toJSON False + } + +confCalling :: ConfCalling -> Value +confCalling args = + object + $ ["lockStatus" .= s | s <- toList args.lockStatus] + <> ["ttl" .= s | s <- toList args.ttl] + <> [ "status" .= args.status, + "config" + .= object ["useSFTForOneToOneCalls" .= args.sft] + ] diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index 87ff22e9c02..d3b5d17bdd3 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -57,9 +57,7 @@ tests :: Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Gundeck tests opts mgr db brig brigep _gundeck galley = do pure $ testGroup "api/internal" $ - [ test mgr "account features: conferenceCalling" $ - testFeatureConferenceCallingByAccount opts mgr db brig brigep galley, - test mgr "suspend and unsuspend user" $ testSuspendUser db brig, + [ test mgr "suspend and unsuspend user" $ testSuspendUser db brig, test mgr "suspend non existing user and verify no db entry" $ testSuspendNonExistingUser db brig, test mgr "mls/clients" $ testGetMlsClients brig, @@ -94,77 +92,6 @@ setAccountStatus brig u s = . json (AccountStatusUpdate s) ) -testFeatureConferenceCallingByAccount :: forall m. (TestConstraints m) => Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Galley -> m () -testFeatureConferenceCallingByAccount (Opt.optSettings -> settings) mgr db brig brigep galley = do - let check :: (HasCallStack) => ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig -> m () - check status = do - uid <- userId <$> createUser "joe" brig - _ <- - aFewTimes 12 (putAccountConferenceCallingConfigClient brigep mgr uid status) isRight - >>= either (liftIO . throwIO . ErrorCall . ("putAccountConferenceCallingConfigClient: " <>) . show) pure - - mbStatus' <- getAccountConferenceCallingConfigClient brigep mgr uid - liftIO $ assertEqual "GET /i/users/:uid/features/conferenceCalling" (Right status) mbStatus' - - featureConfigs <- getAllFeatureConfigs galley uid - liftIO $ assertEqual "GET /feature-configs" status (ApiFt.forgetLock $ readFeatureConfigs featureConfigs) - - featureConfigsConfCalling <- getFeatureConfig @ApiFt.ConferenceCallingConfig galley uid - liftIO $ assertEqual "GET /feature-configs/conferenceCalling" status (responseJsonUnsafe featureConfigsConfCalling) - - check' :: m () - check' = do - uid <- userId <$> createUser "joe" brig - let defaultIfNull :: ApiFt.WithStatus ApiFt.ConferenceCallingConfig - defaultIfNull = settings ^. Opt.getAfcConferenceCallingDefNull - - defaultIfNewRaw :: Maybe (ApiFt.WithStatus ApiFt.ConferenceCallingConfig) - defaultIfNewRaw = - -- tested manually: whether we remove `defaultForNew` from `brig.yaml` or set it - -- to `enabled` or `disabled`, this test always passes. - settings ^. Opt.getAfcConferenceCallingDefNewMaybe - - do - cassandraResp :: Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) <- - aFewTimes - 12 - (Cass.runClient db (lookupFeatureConferenceCalling uid)) - isJust - liftIO $ assertEqual mempty (ApiFt.forgetLock <$> defaultIfNewRaw) cassandraResp - - _ <- - aFewTimes 12 (deleteAccountConferenceCallingConfigClient brigep mgr uid) isRight - >>= either (liftIO . throwIO . ErrorCall . ("deleteAccountConferenceCallingConfigClient: " <>) . show) pure - - do - cassandraResp :: Maybe (ApiFt.WithStatusNoLock ApiFt.ConferenceCallingConfig) <- - aFewTimes - 12 - (Cass.runClient db (lookupFeatureConferenceCalling uid)) - isJust - liftIO $ assertEqual mempty Nothing cassandraResp - - mbStatus' <- getAccountConferenceCallingConfigClient brigep mgr uid - liftIO $ assertEqual "GET /i/users/:uid/features/conferenceCalling" (Right (ApiFt.forgetLock defaultIfNull)) mbStatus' - - featureConfigs <- getAllFeatureConfigs galley uid - liftIO $ assertEqual "GET /feature-configs" defaultIfNull (readFeatureConfigs featureConfigs) - - featureConfigsConfCalling <- getFeatureConfig @ApiFt.ConferenceCallingConfig galley uid - liftIO $ assertEqual "GET /feature-configs/conferenceCalling" defaultIfNull (responseJsonUnsafe featureConfigsConfCalling) - - readFeatureConfigs :: (HasCallStack) => ResponseLBS -> ApiFt.WithStatus ApiFt.ConferenceCallingConfig - readFeatureConfigs = - either (error . show) id - . Aeson.parseEither Aeson.parseJSON - . (^?! Aeson.key "conferenceCalling") - . responseJsonUnsafe @Aeson.Value - - -- TODO - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusEnabled (ApiFt.ConferenceCallingConfig False) ApiFt.FeatureTTLUnlimited - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusDisabled (ApiFt.ConferenceCallingConfig False) ApiFt.FeatureTTLUnlimited - check' - testGetMlsClients :: Brig -> Http () testGetMlsClients brig = do qusr <- userQualifiedId <$> randomUser brig From 2fd5dbe3789c96ac4f1a8a989eaefda8f6f260c4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 24 Jul 2024 09:15:52 +0200 Subject: [PATCH 16/43] Remove dead code --- services/brig/test/integration/API/Internal.hs | 18 +----------------- 1 file changed, 1 insertion(+), 17 deletions(-) diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index d3b5d17bdd3..0f304d3ada5 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -27,29 +27,21 @@ import API.Internal.Util import API.MLS.Util import Bilge import Bilge.Assert -import Brig.Data.User (lookupFeatureConferenceCalling, userExists) +import Brig.Data.User import Brig.Options qualified as Opt import Cassandra qualified as C import Cassandra qualified as Cass import Cassandra.Util -import Control.Exception (ErrorCall (ErrorCall), throwIO) -import Control.Lens ((^.), (^?!)) -import Data.Aeson qualified as Aeson -import Data.Aeson.Lens qualified as Aeson -import Data.Aeson.Types qualified as Aeson import Data.ByteString.Conversion (toByteString') import Data.Default import Data.Id import Data.Qualified -import GHC.TypeLits (KnownSymbol) import Imports import System.IO.Temp import Test.Tasty import Test.Tasty.HUnit import Util import Util.Options (Endpoint) -import Wire.API.Team.Feature -import Wire.API.Team.Feature qualified as ApiFt import Wire.API.User import Wire.API.User.Client @@ -126,14 +118,6 @@ createClient brig u i = (defNewClient PermanentClientType [somePrekeys !! i] (someLastPrekeys !! i)) (Request -> Request) -> UserId -> m ResponseLBS -getFeatureConfig galley uid = do - get $ apiVersion "v1" . galley . paths ["feature-configs", featureNameBS @cfg] . zUser uid - -getAllFeatureConfigs :: (MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS -getAllFeatureConfigs galley uid = do - get $ galley . paths ["feature-configs"] . zUser uid - testWritetimeRepresentation :: forall m. (TestConstraints m) => Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Galley -> m () testWritetimeRepresentation _ _mgr db brig _brigep _galley = do quid <- userQualifiedId <$> randomUser brig From 64512928850cc3cc593035ab11cb92d4e8da68e3 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 24 Jul 2024 09:17:43 +0200 Subject: [PATCH 17/43] Update cassandra schema file --- cassandra-schema.cql | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cassandra-schema.cql b/cassandra-schema.cql index f34be3f2041..80e7b4de7ba 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1170,6 +1170,8 @@ CREATE TABLE galley_test.team_features ( app_lock_inactivity_timeout_secs int, app_lock_status int, conference_calling int, + conference_calling_lock_status int, + conference_calling_sft_for_one_to_one boolean, digital_signatures int, enforce_file_download_location text, enforce_file_download_location_lock_status int, From 4405f1593860ad2d419ad7a104e1eec9f98ee931 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 24 Jul 2024 14:19:15 +0200 Subject: [PATCH 18/43] Change how conferenceCalling is stored and loaded --- integration/test/Test/FeatureFlags/Util.hs | 2 +- .../src/Galley/Cassandra/TeamFeatures.hs | 25 +++++++++++-------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index 0ea4d625196..1624f908a8f 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -54,7 +54,7 @@ checkFeatureWith shouldMatch' feature user tid expected = do checkFeatureLenientTtl :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl where - shouldMatchLenientTtl :: App Value -> Value -> App () + shouldMatchLenientTtl :: (HasCallStack) => App Value -> Value -> App () shouldMatchLenientTtl actual expected = do expectedLockStatus <- expected %. "lockStatus" actual %. "lockStatus" `shouldMatch` expectedLockStatus diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 0caf71f1092..6407f4a07dd 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -250,18 +250,21 @@ setFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid status = do 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, statusNoLock.wssStatus, statusNoLock.wssConfig.sftForOne2One)) +setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery insertStatus (tid, statusNoLock.wssStatus, ttlValue (statusNoLock.wssTTL)) + addPrepQuery insertConfig (tid, statusNoLock.wssConfig.sftForOne2One) 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, Bool) () - insert = - fromString $ - "insert into team_features (team_id,conference_calling,conference_calling_sft_for_one_to_one) values (?, ?, ?)" - <> renderFeatureTtl (wssTTL statusNoLock) + ttlValue :: FeatureTTL -> Int32 + ttlValue (FeatureTTLSeconds d) = fromIntegral d + ttlValue FeatureTTLUnlimited = 0 + + insertStatus :: PrepQuery W (TeamId, FeatureStatus, Int32) () + insertStatus = "insert into team_features (team_id, conference_calling) values (?, ?) using ttl ?" + insertConfig :: PrepQuery W (TeamId, Bool) () + insertConfig = "insert into team_features (team_id, conference_calling_sft_for_one_to_one) values (?, ?)" setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) From c25f044b88119c74aa06dbc84954ff8fd69a496e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 25 Jul 2024 09:17:31 +0200 Subject: [PATCH 19/43] Add general AllFeatures for any type constructor --- libs/wire-api/src/Wire/API/Team/Feature.hs | 67 +++++++++++-------- services/brig/src/Brig/Calling/API.hs | 2 +- .../src/Galley/API/Teams/Features/Get.hs | 4 +- .../Cassandra/GetAllTeamFeatureConfigs.hs | 2 +- 4 files changed, 43 insertions(+), 32 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 3416aaade94..d9dcb15d16f 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -81,7 +81,8 @@ module Wire.API.Team.Feature MlsMigrationConfig (..), EnforceFileDownloadLocationConfig (..), LimitedEventFanoutConfig (..), - AllFeatureConfigs (..), + AllFeatures (..), + AllFeatureConfigs, unImplicitLockStatus, ImplicitLockStatus (..), ) @@ -271,7 +272,7 @@ setTTL ttl (WithStatusBase s ls c _) = WithStatusBase s ls c (pure ttl) setWsTTL :: FeatureTTL -> WithStatus cfg -> WithStatus cfg setWsTTL = setTTL -type WithStatus (cfg :: Type) = WithStatusBase Identity cfg +type WithStatus = WithStatusBase Identity deriving instance (Eq cfg) => Eq (WithStatus cfg) @@ -1180,34 +1181,34 @@ instance Cass.Cql FeatureStatus where defFeatureStatusNoLock :: (IsFeatureConfig cfg) => WithStatusNoLock cfg defFeatureStatusNoLock = forgetLock defFeatureStatus -data AllFeatureConfigs = AllFeatureConfigs - { afcLegalholdStatus :: WithStatus LegalholdConfig, - afcSSOStatus :: WithStatus SSOConfig, - afcTeamSearchVisibilityAvailable :: WithStatus SearchVisibilityAvailableConfig, - afcSearchVisibilityInboundConfig :: WithStatus SearchVisibilityInboundConfig, - afcValidateSAMLEmails :: WithStatus ValidateSAMLEmailsConfig, - afcDigitalSignatures :: WithStatus DigitalSignaturesConfig, - afcAppLock :: WithStatus AppLockConfig, - afcFileSharing :: WithStatus FileSharingConfig, - afcClassifiedDomains :: WithStatus ClassifiedDomainsConfig, - afcConferenceCalling :: WithStatus ConferenceCallingConfig, - afcSelfDeletingMessages :: WithStatus SelfDeletingMessagesConfig, - afcGuestLink :: WithStatus GuestLinksConfig, - afcSndFactorPasswordChallenge :: WithStatus SndFactorPasswordChallengeConfig, - afcMLS :: WithStatus MLSConfig, - afcExposeInvitationURLsToTeamAdmin :: WithStatus ExposeInvitationURLsToTeamAdminConfig, - afcOutlookCalIntegration :: WithStatus OutlookCalIntegrationConfig, - afcMlsE2EId :: WithStatus MlsE2EIdConfig, - afcMlsMigration :: WithStatus MlsMigrationConfig, - afcEnforceFileDownloadLocation :: WithStatus EnforceFileDownloadLocationConfig, - afcLimitedEventFanout :: WithStatus LimitedEventFanoutConfig +data AllFeatures f = AllFeatures + { afcLegalholdStatus :: f LegalholdConfig, + afcSSOStatus :: f SSOConfig, + afcTeamSearchVisibilityAvailable :: f SearchVisibilityAvailableConfig, + afcSearchVisibilityInboundConfig :: f SearchVisibilityInboundConfig, + afcValidateSAMLEmails :: f ValidateSAMLEmailsConfig, + afcDigitalSignatures :: f DigitalSignaturesConfig, + afcAppLock :: f AppLockConfig, + afcFileSharing :: f FileSharingConfig, + afcClassifiedDomains :: f ClassifiedDomainsConfig, + afcConferenceCalling :: f ConferenceCallingConfig, + afcSelfDeletingMessages :: f SelfDeletingMessagesConfig, + afcGuestLink :: f GuestLinksConfig, + afcSndFactorPasswordChallenge :: f SndFactorPasswordChallengeConfig, + afcMLS :: f MLSConfig, + afcExposeInvitationURLsToTeamAdmin :: f ExposeInvitationURLsToTeamAdminConfig, + afcOutlookCalIntegration :: f OutlookCalIntegrationConfig, + afcMlsE2EId :: f MlsE2EIdConfig, + afcMlsMigration :: f MlsMigrationConfig, + afcEnforceFileDownloadLocation :: f EnforceFileDownloadLocationConfig, + afcLimitedEventFanout :: f LimitedEventFanoutConfig } - deriving stock (Eq, Show) - deriving (FromJSON, ToJSON, S.ToSchema) via (Schema AllFeatureConfigs) + +type AllFeatureConfigs = AllFeatures WithStatus instance Default AllFeatureConfigs where def = - AllFeatureConfigs + AllFeatures { afcLegalholdStatus = defFeatureStatus, afcSSOStatus = defFeatureStatus, afcTeamSearchVisibilityAvailable = defFeatureStatus, @@ -1233,7 +1234,7 @@ instance Default AllFeatureConfigs where instance ToSchema AllFeatureConfigs where schema = object "AllFeatureConfigs" $ - AllFeatureConfigs + AllFeatures <$> afcLegalholdStatus .= featureField <*> afcSSOStatus .= featureField <*> afcTeamSearchVisibilityAvailable .= featureField @@ -1263,7 +1264,7 @@ instance ToSchema AllFeatureConfigs where instance Arbitrary AllFeatureConfigs where arbitrary = - AllFeatureConfigs + AllFeatures <$> arbitrary <*> arbitrary <*> arbitrary @@ -1286,3 +1287,13 @@ instance Arbitrary AllFeatureConfigs where <*> arbitrary makeLenses ''ImplicitLockStatus + +deriving instance Show AllFeatureConfigs + +deriving instance Eq AllFeatureConfigs + +deriving via (Schema AllFeatureConfigs) instance (FromJSON AllFeatureConfigs) + +deriving via (Schema AllFeatureConfigs) instance (ToJSON AllFeatureConfigs) + +deriving via (Schema AllFeatureConfigs) instance (S.ToSchema AllFeatureConfigs) diff --git a/services/brig/src/Brig/Calling/API.hs b/services/brig/src/Brig/Calling/API.hs index ec4f823a4a0..e1e71eb74d0 100644 --- a/services/brig/src/Brig/Calling/API.hs +++ b/services/brig/src/Brig/Calling/API.hs @@ -60,7 +60,7 @@ import Polysemy import Polysemy.Error qualified as Polysemy import System.Logger.Class qualified as Log import Wire.API.Call.Config qualified as Public -import Wire.API.Team.Feature (AllFeatureConfigs (afcConferenceCalling), FeatureStatus (FeatureStatusDisabled, FeatureStatusEnabled), wsStatus) +import Wire.API.Team.Feature import Wire.Error import Wire.GalleyAPIAccess (GalleyAPIAccess, getAllFeatureConfigsForUser) import Wire.Network.DNS.SRV (srvTarget) diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 685266b3ea1..818cf49d02f 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -216,7 +216,7 @@ getAllFeatureConfigsForServer :: (Member (Input Opts) r) => Sem r AllFeatureConfigs getAllFeatureConfigsForServer = - AllFeatureConfigs + AllFeatures <$> getConfigForServer @LegalholdConfig <*> getConfigForServer @SSOConfig <*> getConfigForServer @SearchVisibilityAvailableConfig @@ -252,7 +252,7 @@ getAllFeatureConfigsUser :: UserId -> Sem r AllFeatureConfigs getAllFeatureConfigsUser uid = - AllFeatureConfigs + AllFeatures <$> getConfigForUser @LegalholdConfig uid <*> getConfigForUser @SSOConfig uid <*> getConfigForUser @SearchVisibilityAvailableConfig uid diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index a20ee8a792f..0ecc30684f3 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -145,7 +145,7 @@ allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatureConfigs allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs row = - AllFeatureConfigs + AllFeatures { afcLegalholdStatus = legalholdComputeFeatureStatus row.legalhold, afcSSOStatus = computeConfig From 7ce939f76c458caa85ebce83104ece9fcc2b9dc9 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 25 Jul 2024 15:17:52 +0200 Subject: [PATCH 20/43] Return Maybe values from FeatureStore --- libs/wire-api/src/Wire/API/Team/Feature.hs | 1 + .../src/Galley/API/Teams/Features/Get.hs | 9 +- .../Cassandra/GetAllTeamFeatureConfigs.hs | 308 ++++++------------ .../src/Galley/Cassandra/TeamFeatures.hs | 17 +- .../src/Galley/Effects/TeamFeatureStore.hs | 2 +- 5 files changed, 105 insertions(+), 232 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index d9dcb15d16f..abf8f5d746a 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -25,6 +25,7 @@ module Wire.API.Team.Feature featureName, featureNameBS, LockStatus (..), + WithStatusBase (..), WithStatus, withStatus, withStatus', diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 818cf49d02f..7e016ff63ea 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -193,7 +193,7 @@ getAllFeatureConfigsForUser zusr = do maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership case mbTeam of Just tid -> - TeamFeatures.getAllFeatureConfigs tid + getAllFeatureConfigs tid Nothing -> getAllFeatureConfigsUser zusr @@ -209,7 +209,12 @@ getAllFeatureConfigsForTeam :: getAllFeatureConfigsForTeam luid tid = do zusrMembership <- getTeamMember tid (tUnqualified luid) maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership - TeamFeatures.getAllFeatureConfigs tid + getAllFeatureConfigs tid + +getAllFeatureConfigs :: (Member TeamFeatureStore r) => TeamId -> Sem r AllFeatureConfigs +getAllFeatureConfigs tid = do + _features <- TeamFeatures.getAllFeatureConfigs tid + error "TODO" getAllFeatureConfigsForServer :: forall r. diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 0ecc30684f3..edf635922cf 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -9,7 +9,6 @@ import Data.Misc (HttpsUrl) import Data.Time import Database.CQL.Protocol import Galley.Cassandra.Instances () -import Galley.Types.Teams (FeatureLegalHold (..)) import Imports import Wire.API.Conversation.Protocol (ProtocolTag) import Wire.API.MLS.CipherSuite @@ -134,233 +133,116 @@ emptyRow = limitEventFanout = Nothing } -allFeatureConfigsFromRow :: - -- id of team of which we want to see the feature - TeamId -> - -- team id list is from "settings.exposeInvitationURLsTeamAllowlist" - Maybe [TeamId] -> - FeatureLegalHold -> - Bool -> - AllFeatureConfigs -> - AllTeamFeatureConfigsRow -> - AllFeatureConfigs -allFeatureConfigsFromRow ourteam allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs row = +mkFeatureWithStatus :: Maybe FeatureStatus -> WithStatusBase Maybe cfg +mkFeatureWithStatus s = defFeatureWithStatus {wsbStatus = s} + +defFeatureWithStatus :: WithStatusBase Maybe cfg +defFeatureWithStatus = + WithStatusBase + { wsbStatus = Nothing, + wsbLockStatus = Nothing, + wsbConfig = Nothing, + wsbTTL = Nothing + } + +allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures (WithStatusBase Maybe) +allFeatureConfigsFromRow row = AllFeatures - { afcLegalholdStatus = legalholdComputeFeatureStatus row.legalhold, - afcSSOStatus = - computeConfig - row.sso - Nothing - FeatureTTLUnlimited - (Just SSOConfig) - serverConfigs.afcSSOStatus, - afcTeamSearchVisibilityAvailable = - computeConfig - row.searchVisibility - Nothing - FeatureTTLUnlimited - (Just SearchVisibilityAvailableConfig) - serverConfigs.afcTeamSearchVisibilityAvailable, - afcSearchVisibilityInboundConfig = - computeConfig - row.searchVisibility - Nothing - FeatureTTLUnlimited - (Just SearchVisibilityInboundConfig) - serverConfigs.afcSearchVisibilityInboundConfig, - afcValidateSAMLEmails = - computeConfig - row.validateSamlEmails - Nothing - FeatureTTLUnlimited - (Just ValidateSAMLEmailsConfig) - serverConfigs.afcValidateSAMLEmails, - afcDigitalSignatures = - computeConfig - row.digitalSignatures - Nothing - FeatureTTLUnlimited - (Just DigitalSignaturesConfig) - serverConfigs.afcDigitalSignatures, + { afcLegalholdStatus = mkFeatureWithStatus row.legalhold, + afcSSOStatus = mkFeatureWithStatus row.sso, + afcTeamSearchVisibilityAvailable = mkFeatureWithStatus row.searchVisibility, + afcSearchVisibilityInboundConfig = mkFeatureWithStatus row.searchVisibility, + afcValidateSAMLEmails = mkFeatureWithStatus row.validateSamlEmails, + afcDigitalSignatures = mkFeatureWithStatus row.digitalSignatures, afcAppLock = - computeConfig - row.appLock - Nothing - FeatureTTLUnlimited - appLockConfig - serverConfigs.afcAppLock, + defFeatureWithStatus + { wsbStatus = row.appLock, + wsbConfig = + AppLockConfig <$> row.appLockEnforce <*> row.appLockInactivityTimeoutSecs + }, afcFileSharing = - computeConfig - row.fileSharing - row.fileSharingLock - FeatureTTLUnlimited - (Just FileSharingConfig) - serverConfigs.afcFileSharing, - afcClassifiedDomains = - computeConfig Nothing Nothing FeatureTTLUnlimited Nothing serverConfigs.afcClassifiedDomains, + defFeatureWithStatus + { wsbStatus = row.fileSharing, + wsbLockStatus = row.fileSharingLock + }, + afcClassifiedDomains = mkFeatureWithStatus Nothing, afcConferenceCalling = - computeConfig - row.conferenceCalling - row.conferenceCallingLock - (fromMaybe FeatureTTLUnlimited row.conferenceCallingTtl) - conferenceCallingConfig - serverConfigs.afcConferenceCalling, + WithStatusBase + { wsbStatus = row.conferenceCalling, + wsbLockStatus = row.conferenceCallingLock, + wsbTTL = row.conferenceCallingTtl, + wsbConfig = ConferenceCallingConfig <$> row.conferenceCallingSftForOne2One + }, afcSelfDeletingMessages = - computeConfig - row.selfDeletingMessages - row.selfDeletingMessagesLock - FeatureTTLUnlimited - selfDeletingMessagesConfig - serverConfigs.afcSelfDeletingMessages, + defFeatureWithStatus + { wsbStatus = row.selfDeletingMessages, + wsbLockStatus = row.selfDeletingMessagesLock, + wsbConfig = SelfDeletingMessagesConfig <$> row.selfDeletingMessagesTtl + }, afcGuestLink = - computeConfig - row.guestLinks - row.guestLinksLock - FeatureTTLUnlimited - (Just GuestLinksConfig) - serverConfigs.afcGuestLink, + defFeatureWithStatus + { wsbStatus = row.guestLinks, + wsbLockStatus = row.guestLinksLock + }, afcSndFactorPasswordChallenge = - computeConfig - row.sndFactor - row.sndFactorLock - FeatureTTLUnlimited - (Just SndFactorPasswordChallengeConfig) - serverConfigs.afcSndFactorPasswordChallenge, + defFeatureWithStatus + { wsbStatus = row.sndFactor, + wsbLockStatus = row.sndFactorLock + }, afcMLS = - computeConfig - row.mls - row.mlsLock - FeatureTTLUnlimited - mlsConfig - serverConfigs.afcMLS, - afcExposeInvitationURLsToTeamAdmin = exposeInvitationURLsComputeFeatureStatus row.exposeInvitationUrls, + defFeatureWithStatus + { wsbStatus = row.mls, + wsbLockStatus = row.mlsLock, + wsbConfig = + MLSConfig + <$> fmap C.fromSet row.mlsToggleUsers + <*> row.mlsDefaultProtocol + <*> fmap C.fromSet row.mlsAllowedCipherSuites + <*> row.mlsDefaultCipherSuite + <*> fmap C.fromSet row.mlsSupportedProtocols + }, + afcExposeInvitationURLsToTeamAdmin = mkFeatureWithStatus row.exposeInvitationUrls, afcOutlookCalIntegration = - computeConfig - row.outlookCalIntegration - row.outlookCalIntegrationLock - FeatureTTLUnlimited - (Just OutlookCalIntegrationConfig) - serverConfigs.afcOutlookCalIntegration, + defFeatureWithStatus + { wsbStatus = row.outlookCalIntegration, + wsbLockStatus = row.outlookCalIntegrationLock + }, afcMlsE2EId = - computeConfig - row.mlsE2eid - row.mlsE2eidLock - FeatureTTLUnlimited - mlsE2eidConfig - serverConfigs.afcMlsE2EId, + defFeatureWithStatus + { wsbStatus = row.mlsE2eid, + wsbLockStatus = row.mlsE2eidLock, + wsbConfig = + MlsE2EIdConfig + <$> fmap fromIntegral row.mlsE2eidGracePeriod + <*> pure row.mlsE2eidAcmeDiscoverUrl + <*> pure row.mlsE2eidMaybeCrlProxy + <*> row.mlsE2eidMaybeUseProxyOnMobile + }, afcMlsMigration = - computeConfig - row.mlsMigration - row.mlsMigrationLock - FeatureTTLUnlimited - mlsMigrationConfig - serverConfigs.afcMlsMigration, + defFeatureWithStatus + { wsbStatus = row.mlsMigration, + wsbLockStatus = row.mlsMigrationLock, + wsbConfig = + Just $ + MlsMigrationConfig + row.mlsMigrationStartTime + row.mlsMigrationFinalizeRegardlessAfter + }, afcEnforceFileDownloadLocation = - computeConfig - row.enforceDownloadLocation - row.enforceDownloadLocationLock - FeatureTTLUnlimited - downloadLocationConfig - serverConfigs.afcEnforceFileDownloadLocation, - afcLimitedEventFanout = - computeConfig - row.limitEventFanout - Nothing - FeatureTTLUnlimited - (Just LimitedEventFanoutConfig) - serverConfigs.afcLimitedEventFanout - } - where - computeConfig :: Maybe FeatureStatus -> Maybe LockStatus -> FeatureTTL -> Maybe cfg -> WithStatus cfg -> WithStatus cfg - computeConfig mDbStatus mDbLock dbTtl mDbCfg serverCfg = - let withStatusNoLock = case (mDbStatus, mDbCfg) of - (Just dbStatus, Just dbCfg) -> + defFeatureWithStatus + { wsbStatus = row.enforceDownloadLocation, + wsbLockStatus = row.enforceDownloadLocationLock, + wsbConfig = Just $ - WithStatusNoLock - { wssTTL = dbTtl, - wssStatus = dbStatus, - wssConfig = dbCfg - } - _ -> Nothing - in computeFeatureConfigForTeamUser withStatusNoLock mDbLock serverCfg - - -- FUTUREWORK: the following lines are duplicated in - -- "Galley.Cassandra.TeamFeatures"; make sure the pairs don't diverge! - appLockConfig = AppLockConfig <$> row.appLockEnforce <*> row.appLockInactivityTimeoutSecs - - selfDeletingMessagesConfig = SelfDeletingMessagesConfig <$> row.selfDeletingMessagesTtl - - mlsConfig = - MLSConfig - <$> maybe (Just []) (Just . C.fromSet) row.mlsToggleUsers - <*> row.mlsDefaultProtocol - <*> maybe (Just []) (Just . C.fromSet) row.mlsAllowedCipherSuites - <*> row.mlsDefaultCipherSuite - <*> maybe (Just []) (Just . C.fromSet) row.mlsSupportedProtocols - - mlsE2eidConfig = - Just $ - MlsE2EIdConfig - (toGracePeriodOrDefault row.mlsE2eidGracePeriod) - row.mlsE2eidAcmeDiscoverUrl - row.mlsE2eidMaybeCrlProxy - (fromMaybe (useProxyOnMobile . wsConfig $ defFeatureStatus) row.mlsE2eidMaybeUseProxyOnMobile) - where - toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime - toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral - - mlsMigrationConfig = - Just $ - MlsMigrationConfig - { startTime = row.mlsMigrationStartTime, - finaliseRegardlessAfter = row.mlsMigrationFinalizeRegardlessAfter - } - - downloadLocationConfig = Just $ EnforceFileDownloadLocationConfig row.enforceDownloadLocation_Location - - conferenceCallingConfig = - Just $ - ConferenceCallingConfig - { sftForOne2One = fromMaybe False row.conferenceCallingSftForOne2One - } - - -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! - exposeInvitationURLsComputeFeatureStatus :: - Maybe FeatureStatus -> - WithStatus ExposeInvitationURLsToTeamAdminConfig - exposeInvitationURLsComputeFeatureStatus mFeatureStatus = - if ourteam `elem` fromMaybe [] allowListForExposeInvitationURLs - then - serverConfigs.afcExposeInvitationURLsToTeamAdmin - & maybe id setStatus mFeatureStatus - & setLockStatus LockStatusUnlocked - else serverConfigs.afcExposeInvitationURLsToTeamAdmin - - -- FUTUREWORK: this duplicates logic hidden elsewhere for the other getters and setters. do not change lightly! - legalholdComputeFeatureStatus :: Maybe FeatureStatus -> WithStatus LegalholdConfig - legalholdComputeFeatureStatus mStatusValue = setStatus status defFeatureStatus - where - status = - if isLegalHoldEnabledForTeam - then FeatureStatusEnabled - else FeatureStatusDisabled - isLegalHoldEnabledForTeam = - case featureLH of - FeatureLegalHoldDisabledPermanently -> False - FeatureLegalHoldDisabledByDefault -> maybe False ((==) FeatureStatusEnabled) mStatusValue - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> hasTeamImplicitLegalhold + EnforceFileDownloadLocationConfig row.enforceDownloadLocation_Location + }, + afcLimitedEventFanout = mkFeatureWithStatus row.limitEventFanout + } -getAllFeatureConfigs :: (MonadClient m) => Maybe [TeamId] -> FeatureLegalHold -> Bool -> AllFeatureConfigs -> TeamId -> m AllFeatureConfigs -getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs tid = do +getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures (WithStatusBase Maybe)) +getAllFeatureConfigs tid = do mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure - $ allFeatureConfigsFromRow - tid - allowListForExposeInvitationURLs - featureLH - hasTeamImplicitLegalhold - serverConfigs - $ maybe emptyRow asRecord mRow + pure $ allFeatureConfigsFromRow $ maybe emptyRow asRecord mRow where select :: PrepQuery diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 6407f4a07dd..55e3832738f 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -33,10 +33,7 @@ import Galley.Cassandra.GetAllTeamFeatureConfigs import Galley.Cassandra.Instances () import Galley.Cassandra.Store import Galley.Cassandra.Util -import Galley.Effects (LegalHoldStore) -import Galley.Effects.LegalHoldStore qualified as LH import Galley.Effects.TeamFeatureStore qualified as TFS -import Galley.Types.Teams (FeatureLegalHold) import Imports import Polysemy import Polysemy.Input @@ -49,9 +46,6 @@ import Wire.API.Team.Feature interpretTeamFeatureStoreToCassandra :: ( Member (Embed IO) r, Member (Input ClientState) r, - Member (Input AllFeatureConfigs) r, - Member (Input (Maybe [TeamId], FeatureLegalHold)) r, - Member LegalHoldStore r, Member TinyLog r ) => Sem (TFS.TeamFeatureStore ': r) a -> @@ -74,16 +68,7 @@ interpretTeamFeatureStoreToCassandra = interpret $ \case embedClient $ setFeatureLockStatus sing tid ls TFS.GetAllFeatureConfigs tid -> do logEffect "TeamFeatureStore.GetAllFeatureConfigs" - serverConfigs <- input - (allowListForExposeInvitationURLs, featureLH) <- input - hasTeamImplicitLegalhold <- LH.isTeamLegalholdWhitelisted tid - embedClient $ - getAllFeatureConfigs - allowListForExposeInvitationURLs - featureLH - hasTeamImplicitLegalhold - serverConfigs - tid + embedClient $ getAllFeatureConfigs tid getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (Maybe (WithStatusNoLock cfg)) getFeatureConfig FeatureSingletonLegalholdConfig tid = getTrivialConfigC "legalhold_status" tid diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index 5011d72a3ce..36e79017a72 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -49,6 +49,6 @@ data TeamFeatureStore m a where TeamFeatureStore m () GetAllFeatureConfigs :: TeamId -> - TeamFeatureStore m AllFeatureConfigs + TeamFeatureStore m (AllFeatures (WithStatusBase Maybe)) makeSem ''TeamFeatureStore From 3e640d91e2e23ca85eae6dfc6744e2466e26b816 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 25 Jul 2024 16:52:50 +0200 Subject: [PATCH 21/43] Compute feature values in a uniform manner --- libs/wire-api/src/Wire/API/Team/Feature.hs | 15 ++ .../galley/src/Galley/API/LegalHold/Team.hs | 36 ++-- .../galley/src/Galley/API/Teams/Features.hs | 51 +++--- .../src/Galley/API/Teams/Features/Get.hs | 155 +++++++++--------- 4 files changed, 146 insertions(+), 111 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index abf8f5d746a..a0baf198968 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -56,6 +56,7 @@ module Wire.API.Team.Feature convertFeatureTTLDaysToSeconds, EnforceAppLock (..), defFeatureStatusNoLock, + genericComputeFeature, computeFeatureConfigForTeamUser, IsFeatureConfig (..), FeatureSingleton (..), @@ -565,6 +566,20 @@ instance (IsFeatureConfig a, ToSchema a) => ToJSON (ImplicitLockStatus a) where instance (IsFeatureConfig a, ToSchema a) => FromJSON (ImplicitLockStatus a) where parseJSON v = ImplicitLockStatus . withLockStatus (wsLockStatus $ defFeatureStatus @a) <$> A.parseJSON v +-- | Convert a feature coming from the database to its public form. This can be +-- overridden on a feature basis by implementing the `computeFeature` method of +-- the `GetFeatureConfig` class. +genericComputeFeature :: WithStatus cfg -> WithStatusBase Maybe cfg -> WithStatus cfg +genericComputeFeature defFeature dbFeature = + case fromMaybe (wsLockStatus defFeature) (wsbLockStatus dbFeature) of + LockStatusLocked -> setLockStatus LockStatusLocked defFeature + LockStatusUnlocked -> + withStatus + (fromMaybe (wsStatus defFeature) (wsbStatus dbFeature)) + LockStatusUnlocked + (fromMaybe (wsConfig defFeature) (wsbConfig dbFeature)) + (fromMaybe (wsTTL defFeature) (wsbTTL dbFeature)) + -- | This contains the pure business logic for users from teams computeFeatureConfigForTeamUser :: Maybe (WithStatusNoLock cfg) -> Maybe LockStatus -> WithStatus cfg -> WithStatus cfg computeFeatureConfigForTeamUser mStatusDb mLockStatusDb defStatus = diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 6fbc8f3bfd6..50144b50387 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -17,6 +17,7 @@ module Galley.API.LegalHold.Team ( isLegalHoldEnabledForTeam, + computeLegalHoldFeatureStatus, assertLegalHoldEnabledForTeam, ensureNotTooLargeToActivateLegalHold, teamSizeBelowLimit, @@ -35,7 +36,7 @@ import Imports import Polysemy import Wire.API.Error import Wire.API.Error.Galley -import Wire.API.Team.Feature qualified as Public +import Wire.API.Team.Feature import Wire.API.Team.Size assertLegalHoldEnabledForTeam :: @@ -51,6 +52,24 @@ assertLegalHoldEnabledForTeam tid = unlessM (isLegalHoldEnabledForTeam tid) $ throwS @'LegalHoldNotEnabled +computeLegalHoldFeatureStatus :: + ( Member TeamStore r, + Member LegalHoldStore r + ) => + TeamId -> + Maybe FeatureStatus -> + Sem r FeatureStatus +computeLegalHoldFeatureStatus tid dbStatus = + getLegalHoldFlag >>= \case + FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled + FeatureLegalHoldDisabledByDefault -> pure $ case dbStatus of + Just FeatureStatusEnabled -> FeatureStatusEnabled + Just FeatureStatusDisabled -> FeatureStatusDisabled + Nothing -> FeatureStatusDisabled + FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do + wl <- LegalHoldData.isTeamLegalholdWhitelisted tid + pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled + isLegalHoldEnabledForTeam :: forall r. ( Member LegalHoldStore r, @@ -60,18 +79,9 @@ isLegalHoldEnabledForTeam :: TeamId -> Sem r Bool isLegalHoldEnabledForTeam tid = do - getLegalHoldFlag >>= \case - FeatureLegalHoldDisabledPermanently -> do - pure False - FeatureLegalHoldDisabledByDefault -> do - statusValue <- - Public.wssStatus <$$> TeamFeatures.getFeatureConfig Public.FeatureSingletonLegalholdConfig tid - pure $ case statusValue of - Just Public.FeatureStatusEnabled -> True - Just Public.FeatureStatusDisabled -> False - Nothing -> False - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> - LegalHoldData.isTeamLegalholdWhitelisted tid + dbStatus <- wssStatus <$$> TeamFeatures.getFeatureConfig FeatureSingletonLegalholdConfig tid + status <- computeLegalHoldFeatureStatus tid dbStatus + pure $ status == FeatureStatusEnabled ensureNotTooLargeToActivateLegalHold :: ( Member BrigAccess r, diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs index aa65a594ed4..bf5d9b6bf53 100644 --- a/services/galley/src/Galley/API/Teams/Features.hs +++ b/services/galley/src/Galley/API/Teams/Features.hs @@ -58,6 +58,7 @@ import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData import Galley.Effects.TeamFeatureStore import Galley.Effects.TeamFeatureStore qualified as TeamFeatures import Galley.Effects.TeamStore (getLegalHoldFlag, getTeamMember) +import Galley.Options import Galley.Types.Teams import Imports import Polysemy @@ -79,10 +80,11 @@ import Wire.Sem.Paging.Cassandra patchFeatureStatusInternal :: forall cfg r. ( SetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, + ComputeFeatureConstraints cfg r, SetConfigForTeamConstraints cfg r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, + Member (Input Opts) r, Member TeamStore r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, @@ -111,12 +113,13 @@ patchFeatureStatusInternal tid patch = do setFeatureStatus :: forall cfg r. ( SetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, + ComputeFeatureConstraints cfg r, SetConfigForTeamConstraints cfg r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r, Member (Error TeamFeatureError) r, + Member (Input Opts) r, Member TeamStore r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, @@ -139,12 +142,13 @@ setFeatureStatus doauth tid wsnl = do setFeatureStatusInternal :: forall cfg r. ( SetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, + ComputeFeatureConstraints cfg r, SetConfigForTeamConstraints cfg r, Member (ErrorS 'NotATeamMember) r, Member (ErrorS OperationDenied) r, Member (ErrorS 'TeamNotFound) r, Member (Error TeamFeatureError) r, + Member (Input Opts) r, Member TeamStore r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, @@ -175,7 +179,8 @@ persistAndPushEvent :: ( KnownSymbol (FeatureSymbol cfg), ToSchema cfg, GetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, + ComputeFeatureConstraints cfg r, + Member (Input Opts) r, Member TeamFeatureStore r, Member (P.Logger (Log.Msg -> Log.Msg)) r, Member NotificationSubsystem r, @@ -235,27 +240,25 @@ class (GetFeatureConfig cfg) => SetFeatureConfig cfg where -- push a event to clients (see 'persistAndPushEvent'). setConfigForTeam :: ( SetConfigForTeamConstraints cfg r, - GetConfigForTeamConstraints cfg r, - ( Member TeamFeatureStore r, - Member (P.Logger (Log.Msg -> Log.Msg)) r, - Member NotificationSubsystem r, - Member TeamStore r - ) + ComputeFeatureConstraints cfg r, + Member (Input Opts) r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member NotificationSubsystem r, + Member TeamStore r ) => TeamId -> WithStatusNoLock cfg -> Sem r (WithStatus cfg) default setConfigForTeam :: - ( GetConfigForTeamConstraints cfg r, + ( ComputeFeatureConstraints cfg r, KnownSymbol (FeatureSymbol cfg), ToSchema cfg, - Members - '[ TeamFeatureStore, - P.Logger (Log.Msg -> Log.Msg), - NotificationSubsystem, - TeamStore - ] - r + Member (Input Opts) r, + Member TeamFeatureStore r, + Member (P.Logger (Log.Msg -> Log.Msg)) r, + Member NotificationSubsystem r, + Member TeamStore r ) => TeamId -> WithStatusNoLock cfg -> @@ -263,7 +266,11 @@ class (GetFeatureConfig cfg) => SetFeatureConfig cfg where setConfigForTeam tid wsnl = persistAndPushEvent tid wsnl instance SetFeatureConfig SSOConfig where - type SetConfigForTeamConstraints SSOConfig (r :: EffectRow) = (Member (Error TeamFeatureError) r) + type + SetConfigForTeamConstraints SSOConfig (r :: EffectRow) = + ( Member (Input Opts) r, + Member (Error TeamFeatureError) r + ) setConfigForTeam tid wsnl = do case wssStatus wsnl of @@ -272,7 +279,11 @@ instance SetFeatureConfig SSOConfig where persistAndPushEvent tid wsnl instance SetFeatureConfig SearchVisibilityAvailableConfig where - type SetConfigForTeamConstraints SearchVisibilityAvailableConfig (r :: EffectRow) = (Member SearchVisibilityStore r) + type + SetConfigForTeamConstraints SearchVisibilityAvailableConfig (r :: EffectRow) = + ( Member SearchVisibilityStore r, + Member (Input Opts) r + ) setConfigForTeam tid wsnl = do case wssStatus wsnl of diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 7e016ff63ea..30ef17c55de 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -23,6 +23,7 @@ module Galley.API.Teams.Features.Get getAllFeatureConfigsForTeam, getAllFeatureConfigsForUser, GetFeatureConfig (..), + getConfigForTeam, guardSecondFactorDisabled, DoAuth (..), featureEnabledForTeam, @@ -35,7 +36,7 @@ import Data.Bifunctor (second) import Data.Id import Data.Kind import Data.Qualified (Local, tUnqualified) -import Galley.API.LegalHold.Team (isLegalHoldEnabledForTeam) +import Galley.API.LegalHold.Team import Galley.API.Util import Galley.Effects import Galley.Effects.BrigAccess (getAccountConferenceCallingConfigClient) @@ -57,13 +58,6 @@ data DoAuth = DoAuth UserId | DontDoAuth -- | Don't export methods of this typeclass class (IsFeatureConfig cfg) => GetFeatureConfig cfg where - type GetConfigForTeamConstraints cfg (r :: EffectRow) :: Constraint - type - GetConfigForTeamConstraints cfg (r :: EffectRow) = - ( Member (Input Opts) r, - Member TeamFeatureStore r - ) - type GetConfigForUserConstraints cfg (r :: EffectRow) :: Constraint type GetConfigForUserConstraints cfg (r :: EffectRow) = @@ -75,6 +69,9 @@ class (IsFeatureConfig cfg) => GetFeatureConfig cfg where Member TeamFeatureStore r ) + type ComputeFeatureConstraints cfg (r :: EffectRow) :: Constraint + type ComputeFeatureConstraints cfg r = () + getConfigForServer :: (Member (Input Opts) r) => Sem r (WithStatus cfg) @@ -84,18 +81,6 @@ class (IsFeatureConfig cfg) => GetFeatureConfig cfg where default getConfigForServer :: Sem r (WithStatus cfg) getConfigForServer = pure defFeatureStatus - getConfigForTeam :: - (GetConfigForTeamConstraints cfg r) => - TeamId -> - Sem r (WithStatus cfg) - default getConfigForTeam :: - ( Member (Input Opts) r, - Member TeamFeatureStore r - ) => - TeamId -> - Sem r (WithStatus cfg) - getConfigForTeam = genericGetConfigForTeam - getConfigForUser :: (GetConfigForUserConstraints cfg r) => UserId -> @@ -105,20 +90,37 @@ class (IsFeatureConfig cfg) => GetFeatureConfig cfg where Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - Member TeamFeatureStore r + Member TeamFeatureStore r, + ComputeFeatureConstraints cfg r ) => UserId -> Sem r (WithStatus cfg) getConfigForUser = genericGetConfigForUser + computeFeature :: + (ComputeFeatureConstraints cfg r) => + TeamId -> + WithStatus cfg -> + WithStatusBase Maybe cfg -> + Sem r (WithStatus cfg) + default computeFeature :: + TeamId -> + WithStatus cfg -> + WithStatusBase Maybe cfg -> + Sem r (WithStatus cfg) + computeFeature _tid defFeature dbFeature = + pure $ + genericComputeFeature @cfg defFeature dbFeature + getFeatureStatus :: forall cfg r. ( GetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, - ( Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r - ) + ComputeFeatureConstraints cfg r, + Member (Input Opts) r, + Member TeamFeatureStore r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r ) => DoAuth -> TeamId -> @@ -153,11 +155,13 @@ toTeamStatus tid ws = Multi.TeamStatus tid (wssStatus ws) -- In `getConfigForUser` this is mostly also the case. But there are exceptions, e.g. `ConferenceCallingConfig` getFeatureStatusForUser :: forall cfg r. - ( Member (ErrorS 'NotATeamMember) r, + ( Member (Input Opts) r, + Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, + Member TeamFeatureStore r, Member TeamStore r, - GetConfigForTeamConstraints cfg r, GetConfigForUserConstraints cfg r, + ComputeFeatureConstraints cfg r, GetFeatureConfig cfg ) => UserId -> @@ -279,19 +283,27 @@ getAllFeatureConfigsUser uid = <*> getConfigForUser @EnforceFileDownloadLocationConfig uid <*> getConfigForUser @LimitedEventFanoutConfig uid --- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig -genericGetConfigForTeam :: +getConfigForTeam :: forall cfg r. - (GetFeatureConfig cfg) => - (Member TeamFeatureStore r) => - (Member (Input Opts) r) => + ( GetFeatureConfig cfg, + ComputeFeatureConstraints cfg r, + Member (Input Opts) r, + Member TeamFeatureStore r + ) => TeamId -> Sem r (WithStatus cfg) -genericGetConfigForTeam tid = do - computeFeatureConfigForTeamUser - <$> TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid - <*> TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid - <*> getConfigForServer +getConfigForTeam tid = do + dbFeature <- TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid + lockStatus <- TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid + defFeature <- getConfigForServer + -- TODO + computeFeature @cfg tid defFeature $ + WithStatusBase + { wsbStatus = fmap wssStatus dbFeature, + wsbLockStatus = lockStatus, + wsbTTL = fmap wssTTL dbFeature, + wsbConfig = fmap wssConfig dbFeature + } -- Note: this function assumes the feature cannot be locked genericGetConfigForMultiTeam :: @@ -314,7 +326,8 @@ genericGetConfigForUser :: Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r, Member TeamStore r, - GetFeatureConfig cfg + GetFeatureConfig cfg, + ComputeFeatureConstraints cfg r ) => UserId -> Sem r (WithStatus cfg) @@ -327,7 +340,7 @@ genericGetConfigForUser uid = do zusrMembership <- getTeamMember tid uid maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership assertTeamExists tid - genericGetConfigForTeam tid + getConfigForTeam tid ------------------------------------------------------------------------------- -- GetFeatureConfig instances @@ -357,13 +370,6 @@ instance GetFeatureConfig ValidateSAMLEmailsConfig where instance GetFeatureConfig DigitalSignaturesConfig instance GetFeatureConfig LegalholdConfig where - type - GetConfigForTeamConstraints LegalholdConfig (r :: EffectRow) = - ( Member (Input Opts) r, - Member TeamFeatureStore r, - Member LegalHoldStore r, - Member TeamStore r - ) type GetConfigForUserConstraints LegalholdConfig (r :: EffectRow) = ( Member (Input Opts) r, @@ -374,13 +380,13 @@ instance GetFeatureConfig LegalholdConfig where Member (ErrorS 'NotATeamMember) r, Member (ErrorS 'TeamNotFound) r ) + type + ComputeFeatureConstraints LegalholdConfig r = + (Member TeamStore r, Member LegalHoldStore r) - getConfigForTeam tid = do - status <- - isLegalHoldEnabledForTeam tid <&> \case - True -> FeatureStatusEnabled - False -> FeatureStatusDisabled - pure $ setStatus status defFeatureStatus + computeFeature tid defFeature dbFeature = do + status <- computeLegalHoldFeatureStatus tid (wsbStatus dbFeature) + pure $ setStatus status defFeature instance GetFeatureConfig FileSharingConfig where getConfigForServer = @@ -434,26 +440,16 @@ instance GetFeatureConfig MLSConfig where input <&> view (settings . featureFlags . flagMLS . unDefaults) instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where - getConfigForTeam tid = do + type + ComputeFeatureConstraints ExposeInvitationURLsToTeamAdminConfig r = + (Member (Input Opts) r) + + -- the lock status of this feature is calculated from the allow list, not the database + computeFeature tid defFeature dbFeature = do allowList <- input <&> view (settings . exposeInvitationURLsTeamAllowlist . to (fromMaybe [])) - mbOldStatus <- TeamFeatures.getFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid <&> fmap wssStatus let teamAllowed = tid `elem` allowList - pure $ computeConfigForTeam teamAllowed (fromMaybe FeatureStatusDisabled mbOldStatus) - where - computeConfigForTeam :: Bool -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig - computeConfigForTeam teamAllowed teamDbStatus = - if teamAllowed - then makeConfig LockStatusUnlocked teamDbStatus - else -- FUTUREWORK: use default feature status instead - makeConfig LockStatusLocked FeatureStatusDisabled - - makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig - makeConfig lockStatus status = - withStatus - status - lockStatus - ExposeInvitationURLsToTeamAdminConfig - FeatureTTLUnlimited + lockStatus = if teamAllowed then LockStatusUnlocked else LockStatusLocked + pure $ genericComputeFeature defFeature dbFeature {wsbLockStatus = Just lockStatus} instance GetFeatureConfig OutlookCalIntegrationConfig where getConfigForServer = @@ -511,13 +507,16 @@ guardSecondFactorDisabled uid cid action = do featureEnabledForTeam :: forall cfg r. ( GetFeatureConfig cfg, - GetConfigForTeamConstraints cfg r, - ( Member (ErrorS OperationDenied) r, - Member (ErrorS 'NotATeamMember) r, - Member (ErrorS 'TeamNotFound) r, - Member TeamStore r - ) + Member (Input Opts) r, + Member (ErrorS 'NotATeamMember) r, + Member (ErrorS 'TeamNotFound) r, + Member TeamStore r, + Member TeamFeatureStore r, + ComputeFeatureConstraints cfg r ) => TeamId -> Sem r Bool -featureEnabledForTeam tid = (==) FeatureStatusEnabled . wsStatus <$> getFeatureStatus @cfg DontDoAuth tid +featureEnabledForTeam tid = + (==) FeatureStatusEnabled + . wsStatus + <$> getFeatureStatus @cfg DontDoAuth tid From b3b17307cee497358c6fe1c1d04f96a3de3e602c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 26 Jul 2024 10:48:47 +0200 Subject: [PATCH 22/43] Unify logic for fetching features from db --- .../galley/src/Galley/API/LegalHold/Team.hs | 2 +- services/galley/src/Galley/API/Query.hs | 13 +- .../src/Galley/API/Teams/Features/Get.hs | 37 ++- .../Cassandra/GetAllTeamFeatureConfigs.hs | 307 +++++++++++++----- .../src/Galley/Cassandra/TeamFeatures.hs | 204 ++++-------- .../src/Galley/Effects/TeamFeatureStore.hs | 5 +- 6 files changed, 306 insertions(+), 262 deletions(-) diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 50144b50387..3250534e838 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -79,7 +79,7 @@ isLegalHoldEnabledForTeam :: TeamId -> Sem r Bool isLegalHoldEnabledForTeam tid = do - dbStatus <- wssStatus <$$> TeamFeatures.getFeatureConfig FeatureSingletonLegalholdConfig tid + dbStatus <- wsbStatus <$> TeamFeatures.getFeatureConfig FeatureSingletonLegalholdConfig tid status <- computeLegalHoldFeatureStatus tid dbStatus pure $ status == FeatureStatusEnabled diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs index 8facb7f7b76..29073e71bbc 100644 --- a/services/galley/src/Galley/API/Query.hs +++ b/services/galley/src/Galley/API/Query.hs @@ -63,6 +63,7 @@ import Galley.API.MLS.Types import Galley.API.Mapping import Galley.API.Mapping qualified as Mapping import Galley.API.One2One +import Galley.API.Teams.Features.Get import Galley.API.Util import Galley.Data.Conversation qualified as Data import Galley.Data.Conversation.Types qualified as Data @@ -73,11 +74,9 @@ import Galley.Effects.ConversationStore qualified as E import Galley.Effects.FederatorAccess qualified as E import Galley.Effects.ListItems qualified as E import Galley.Effects.MemberStore qualified as E -import Galley.Effects.TeamFeatureStore qualified as TeamFeatures import Galley.Env import Galley.Options import Galley.Types.Conversations.Members -import Galley.Types.Teams import Imports import Polysemy import Polysemy.Error @@ -681,14 +680,8 @@ getConversationGuestLinksFeatureStatus :: ) => Maybe TeamId -> Sem r (WithStatus GuestLinksConfig) -getConversationGuestLinksFeatureStatus mbTid = do - defaultStatus :: WithStatus GuestLinksConfig <- input <&> view (settings . featureFlags . flagConversationGuestLinks . unDefaults) - case mbTid of - Nothing -> pure defaultStatus - Just tid -> do - mbConfigNoLock <- TeamFeatures.getFeatureConfig FeatureSingletonGuestLinksConfig tid - mbLockStatus <- TeamFeatures.getFeatureLockStatus FeatureSingletonGuestLinksConfig tid - pure $ computeFeatureConfigForTeamUser mbConfigNoLock mbLockStatus defaultStatus +getConversationGuestLinksFeatureStatus Nothing = getConfigForServer @GuestLinksConfig +getConversationGuestLinksFeatureStatus (Just tid) = getConfigForTeam @GuestLinksConfig tid -- | The same as 'getMLSSelfConversation', but it throws an error in case the -- backend is not configured for MLS (the proxy for it being the existance of diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 30ef17c55de..0b02d6c66d7 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -136,13 +136,14 @@ getFeatureStatus doauth tid = do getFeatureStatusMulti :: forall cfg r. ( GetFeatureConfig cfg, + ComputeFeatureConstraints cfg r, Member (Input Opts) r, Member TeamFeatureStore r ) => Multi.TeamFeatureNoConfigMultiRequest -> Sem r (Multi.TeamFeatureNoConfigMultiResponse cfg) getFeatureStatusMulti (Multi.TeamFeatureNoConfigMultiRequest tids) = do - cfgs <- genericGetConfigForMultiTeam @cfg tids + cfgs <- getConfigForMultiTeam @cfg tids let xs = uncurry toTeamStatus . second forgetLock <$> cfgs pure $ Multi.TeamFeatureNoConfigMultiResponse xs @@ -296,27 +297,31 @@ getConfigForTeam tid = do dbFeature <- TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid lockStatus <- TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid defFeature <- getConfigForServer - -- TODO - computeFeature @cfg tid defFeature $ - WithStatusBase - { wsbStatus = fmap wssStatus dbFeature, - wsbLockStatus = lockStatus, - wsbTTL = fmap wssTTL dbFeature, - wsbConfig = fmap wssConfig dbFeature + -- TODO: check that all cascading logic has been preserved + computeFeature @cfg + tid + defFeature + dbFeature + { wsbLockStatus = lockStatus } -- Note: this function assumes the feature cannot be locked -genericGetConfigForMultiTeam :: +getConfigForMultiTeam :: forall cfg r. - (GetFeatureConfig cfg) => - (Member TeamFeatureStore r) => - (Member (Input Opts) r) => + ( GetFeatureConfig cfg, + ComputeFeatureConstraints cfg r, + Member TeamFeatureStore r, + Member (Input Opts) r + ) => [TeamId] -> Sem r [(TeamId, WithStatus cfg)] -genericGetConfigForMultiTeam tids = do - def <- getConfigForServer - (\(tid, mwsnl) -> (tid, computeFeatureConfigForTeamUser mwsnl (Just LockStatusUnlocked) def)) - <$$> TeamFeatures.getFeatureConfigMulti (featureSingleton @cfg) tids +getConfigForMultiTeam tids = do + defFeature <- getConfigForServer + features <- TeamFeatures.getFeatureConfigMulti (featureSingleton @cfg) tids + for features $ \(tid, dbFeature) -> do + let unlocked = dbFeature {wsbLockStatus = Just LockStatusUnlocked} + feat <- computeFeature @cfg tid defFeature unlocked + pure (tid, feat) -- | Note: this is an internal function which doesn't cover all features, e.g. conference calling genericGetConfigForUser :: diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index edf635922cf..b4dfa322af6 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -133,9 +133,6 @@ emptyRow = limitEventFanout = Nothing } -mkFeatureWithStatus :: Maybe FeatureStatus -> WithStatusBase Maybe cfg -mkFeatureWithStatus s = defFeatureWithStatus {wsbStatus = s} - defFeatureWithStatus :: WithStatusBase Maybe cfg defFeatureWithStatus = WithStatusBase @@ -148,95 +145,68 @@ defFeatureWithStatus = allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures (WithStatusBase Maybe) allFeatureConfigsFromRow row = AllFeatures - { afcLegalholdStatus = mkFeatureWithStatus row.legalhold, - afcSSOStatus = mkFeatureWithStatus row.sso, - afcTeamSearchVisibilityAvailable = mkFeatureWithStatus row.searchVisibility, - afcSearchVisibilityInboundConfig = mkFeatureWithStatus row.searchVisibility, - afcValidateSAMLEmails = mkFeatureWithStatus row.validateSamlEmails, - afcDigitalSignatures = mkFeatureWithStatus row.digitalSignatures, - afcAppLock = - defFeatureWithStatus - { wsbStatus = row.appLock, - wsbConfig = - AppLockConfig <$> row.appLockEnforce <*> row.appLockInactivityTimeoutSecs - }, - afcFileSharing = - defFeatureWithStatus - { wsbStatus = row.fileSharing, - wsbLockStatus = row.fileSharingLock - }, - afcClassifiedDomains = mkFeatureWithStatus Nothing, + { afcLegalholdStatus = mkFeature row.legalhold, + afcSSOStatus = mkFeature row.sso, + afcTeamSearchVisibilityAvailable = mkFeature row.searchVisibility, + afcSearchVisibilityInboundConfig = mkFeature row.searchVisibility, + afcValidateSAMLEmails = mkFeature row.validateSamlEmails, + afcDigitalSignatures = mkFeature row.digitalSignatures, + afcAppLock = mkFeature (row.appLock, row.appLockEnforce, row.appLockInactivityTimeoutSecs), + afcFileSharing = mkFeatureWithLock row.fileSharingLock row.fileSharing, + afcClassifiedDomains = mkFeature Nothing, afcConferenceCalling = - WithStatusBase - { wsbStatus = row.conferenceCalling, - wsbLockStatus = row.conferenceCallingLock, - wsbTTL = row.conferenceCallingTtl, - wsbConfig = ConferenceCallingConfig <$> row.conferenceCallingSftForOne2One - }, + mkFeatureWithLock + row.conferenceCallingLock + ( row.conferenceCalling, + row.conferenceCallingTtl, + row.conferenceCallingSftForOne2One + ), afcSelfDeletingMessages = - defFeatureWithStatus - { wsbStatus = row.selfDeletingMessages, - wsbLockStatus = row.selfDeletingMessagesLock, - wsbConfig = SelfDeletingMessagesConfig <$> row.selfDeletingMessagesTtl - }, - afcGuestLink = - defFeatureWithStatus - { wsbStatus = row.guestLinks, - wsbLockStatus = row.guestLinksLock - }, - afcSndFactorPasswordChallenge = - defFeatureWithStatus - { wsbStatus = row.sndFactor, - wsbLockStatus = row.sndFactorLock - }, + mkFeatureWithLock + row.selfDeletingMessagesLock + ( row.selfDeletingMessages, + row.selfDeletingMessagesTtl + ), + afcGuestLink = mkFeatureWithLock row.guestLinksLock row.guestLinks, + afcSndFactorPasswordChallenge = mkFeatureWithLock row.sndFactorLock row.sndFactor, afcMLS = - defFeatureWithStatus - { wsbStatus = row.mls, - wsbLockStatus = row.mlsLock, - wsbConfig = - MLSConfig - <$> fmap C.fromSet row.mlsToggleUsers - <*> row.mlsDefaultProtocol - <*> fmap C.fromSet row.mlsAllowedCipherSuites - <*> row.mlsDefaultCipherSuite - <*> fmap C.fromSet row.mlsSupportedProtocols - }, - afcExposeInvitationURLsToTeamAdmin = mkFeatureWithStatus row.exposeInvitationUrls, + mkFeatureWithLock + row.mlsLock + ( row.mls, + row.mlsDefaultProtocol, + row.mlsToggleUsers, + row.mlsAllowedCipherSuites, + row.mlsDefaultCipherSuite, + row.mlsSupportedProtocols + ), + afcExposeInvitationURLsToTeamAdmin = mkFeature row.exposeInvitationUrls, afcOutlookCalIntegration = - defFeatureWithStatus - { wsbStatus = row.outlookCalIntegration, - wsbLockStatus = row.outlookCalIntegrationLock - }, + mkFeatureWithLock + row.outlookCalIntegrationLock + row.outlookCalIntegration, afcMlsE2EId = - defFeatureWithStatus - { wsbStatus = row.mlsE2eid, - wsbLockStatus = row.mlsE2eidLock, - wsbConfig = - MlsE2EIdConfig - <$> fmap fromIntegral row.mlsE2eidGracePeriod - <*> pure row.mlsE2eidAcmeDiscoverUrl - <*> pure row.mlsE2eidMaybeCrlProxy - <*> row.mlsE2eidMaybeUseProxyOnMobile - }, + mkFeatureWithLock + row.mlsE2eidLock + ( row.mlsE2eid, + row.mlsE2eidGracePeriod, + row.mlsE2eidAcmeDiscoverUrl, + row.mlsE2eidMaybeCrlProxy, + row.mlsE2eidMaybeUseProxyOnMobile + ), afcMlsMigration = - defFeatureWithStatus - { wsbStatus = row.mlsMigration, - wsbLockStatus = row.mlsMigrationLock, - wsbConfig = - Just $ - MlsMigrationConfig - row.mlsMigrationStartTime - row.mlsMigrationFinalizeRegardlessAfter - }, + mkFeatureWithLock + row.mlsMigrationLock + ( row.mlsMigration, + row.mlsMigrationStartTime, + row.mlsMigrationFinalizeRegardlessAfter + ), afcEnforceFileDownloadLocation = - defFeatureWithStatus - { wsbStatus = row.enforceDownloadLocation, - wsbLockStatus = row.enforceDownloadLocationLock, - wsbConfig = - Just $ - EnforceFileDownloadLocationConfig row.enforceDownloadLocation_Location - }, - afcLimitedEventFanout = mkFeatureWithStatus row.limitEventFanout + mkFeatureWithLock + row.enforceDownloadLocationLock + ( row.enforceDownloadLocation, + row.enforceDownloadLocation_Location + ), + afcLimitedEventFanout = mkFeature row.limitEventFanout } getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures (WithStatusBase Maybe)) @@ -276,3 +246,170 @@ getAllFeatureConfigs tid = do \enforce_file_download_location_status, enforce_file_download_location, enforce_file_download_location_lock_status, \ \limited_event_fanout_status \ \from team_features where team_id = ?" + +class (Tuple (FeatureRow cfg), HasRowType (FeatureRow cfg)) => MakeFeature cfg where + type FeatureRow cfg + type FeatureRow cfg = Identity (Maybe FeatureStatus) + + mkFeature :: RowType (FeatureRow cfg) -> WithStatusBase Maybe cfg + default mkFeature :: + (FeatureRow cfg ~ Identity (Maybe FeatureStatus)) => + RowType (FeatureRow cfg) -> + WithStatusBase Maybe cfg + mkFeature s = defFeatureWithStatus {wsbStatus = s} + +mkFeatureWithLock :: + (MakeFeature cfg) => + Maybe LockStatus -> + RowType (FeatureRow cfg) -> + WithStatusBase Maybe cfg +mkFeatureWithLock lockStatus row = (mkFeature row) {wsbLockStatus = lockStatus} + +-- | Used to remove the annoying Identity wrapper around single-element rows. +type family RowType a where + RowType (Identity a) = a + RowType tuple = tuple + +class HasRowType a where + fromRowType :: RowType a -> a + default fromRowType :: (RowType a ~ a) => RowType a -> a + fromRowType = id + + toRowType :: a -> RowType a + default toRowType :: (RowType a ~ a) => a -> RowType a + toRowType = id + +instance HasRowType (a, b) + +instance HasRowType (a, b, c) + +instance HasRowType (a, b, c, d) + +instance HasRowType (a, b, c, d, e) + +instance HasRowType (a, b, c, d, e, f) + +instance HasRowType (Identity a) where + fromRowType = Identity + toRowType = runIdentity + +instance MakeFeature LegalholdConfig + +instance MakeFeature SSOConfig + +instance MakeFeature SearchVisibilityAvailableConfig + +instance MakeFeature SearchVisibilityInboundConfig + +instance MakeFeature ValidateSAMLEmailsConfig + +instance MakeFeature DigitalSignaturesConfig + +instance MakeFeature AppLockConfig where + type FeatureRow AppLockConfig = (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) + + mkFeature (status, enforce, timeout) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = AppLockConfig <$> enforce <*> timeout + } + +instance MakeFeature FileSharingConfig + +instance MakeFeature ClassifiedDomainsConfig + +instance MakeFeature ConferenceCallingConfig where + type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe Bool) + + mkFeature (status, ttl, sftForOneToOne) = + defFeatureWithStatus + { wsbStatus = status, + wsbTTL = ttl, + wsbConfig = ConferenceCallingConfig <$> sftForOneToOne + } + +instance MakeFeature SelfDeletingMessagesConfig where + type FeatureRow SelfDeletingMessagesConfig = (Maybe FeatureStatus, Maybe Int32) + + mkFeature (status, ttl) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = SelfDeletingMessagesConfig <$> ttl + } + +instance MakeFeature GuestLinksConfig + +instance MakeFeature SndFactorPasswordChallengeConfig + +instance MakeFeature ExposeInvitationURLsToTeamAdminConfig + +instance MakeFeature OutlookCalIntegrationConfig + +instance MakeFeature MLSConfig where + type + FeatureRow MLSConfig = + ( Maybe FeatureStatus, + Maybe ProtocolTag, + Maybe (C.Set UserId), + Maybe (C.Set CipherSuiteTag), + Maybe CipherSuiteTag, + Maybe (C.Set ProtocolTag) + ) + + mkFeature (status, defProto, toggleUsers, ciphersuites, defCiphersuite, supportedProtos) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = + MLSConfig + <$> fmap C.fromSet toggleUsers + <*> defProto + <*> fmap C.fromSet ciphersuites + <*> defCiphersuite + <*> fmap C.fromSet supportedProtos + } + +instance MakeFeature MlsE2EIdConfig where + type + FeatureRow MlsE2EIdConfig = + ( Maybe FeatureStatus, + Maybe Int32, + Maybe HttpsUrl, + Maybe HttpsUrl, + Maybe Bool + ) + + mkFeature (status, gracePeriod, acmeDiscovery, crlProxy, proxyOnMobile) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = + MlsE2EIdConfig + <$> fmap fromIntegral gracePeriod + <*> pure acmeDiscovery + <*> pure crlProxy + <*> proxyOnMobile + } + +instance MakeFeature MlsMigrationConfig where + type + FeatureRow MlsMigrationConfig = + ( Maybe FeatureStatus, + Maybe UTCTime, + Maybe UTCTime + ) + + mkFeature (status, startTime, finalizeAfter) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = Just $ MlsMigrationConfig startTime finalizeAfter + } + +instance MakeFeature EnforceFileDownloadLocationConfig where + type FeatureRow EnforceFileDownloadLocationConfig = (Maybe FeatureStatus, Maybe Text) + + mkFeature (status, location) = + defFeatureWithStatus + { wsbStatus = status, + wsbConfig = Just (EnforceFileDownloadLocationConfig location) + } + +instance MakeFeature LimitedEventFanoutConfig diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 55e3832738f..35a89711baf 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -24,7 +24,6 @@ where import Cassandra import Cassandra qualified as C -import Control.Monad.Trans.Maybe import Data.Id import Data.Misc (HttpsUrl) import Data.Time @@ -70,142 +69,54 @@ interpretTeamFeatureStoreToCassandra = interpret $ \case logEffect "TeamFeatureStore.GetAllFeatureConfigs" embedClient $ getAllFeatureConfigs tid -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) - -- FUTUREWORK: the above line is duplicated in - -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - <*> 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 - -- FUTUREWORK: the above line is duplicated in - -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - <*> 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, mSft) -> - Just $ - WithStatusNoLock - status - (ConferenceCallingConfig {sftForOne2One = fromMaybe False mSft}) - (fromMaybe FeatureTTLUnlimited mTtl) - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL, Maybe Bool) - select = - fromString $ - "select conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one 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, supportedProtocols) -> - WithStatusNoLock - <$> status - <*> ( -- FUTUREWORK: this block is duplicated in - -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - MLSConfig - <$> maybe (Just []) (Just . C.fromSet) protocolToggleUsers - <*> defaultProtocol - <*> maybe (Just []) (Just . C.fromSet) allowedCipherSuites - <*> defaultCipherSuite - <*> maybe (Just []) (Just . C.fromSet) supportedProtocols - ) - <*> Just FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe ProtocolTag, Maybe (C.Set UserId), Maybe (C.Set CipherSuiteTag), Maybe CipherSuiteTag, Maybe (C.Set ProtocolTag)) - select = - "select mls_status, mls_default_protocol, mls_protocol_toggle_users, mls_allowed_ciphersuites, \ - \mls_default_ciphersuite, mls_supported_protocols from team_features where team_id = ?" -getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - retry x1 q <&> \case - Nothing -> Nothing - Just (Nothing, _, _, _, _) -> Nothing - Just (Just fs, mGracePeriod, mUrl, mCrlProxy, mUseProxyOnMobile) -> - Just $ - WithStatusNoLock - fs - ( -- FUTUREWORK: this block is duplicated in - -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - MlsE2EIdConfig (toGracePeriodOrDefault mGracePeriod) mUrl mCrlProxy (fromMaybe (useProxyOnMobile . wsConfig $ defFeatureStatus @MlsE2EIdConfig) mUseProxyOnMobile) - ) - FeatureTTLUnlimited - where - toGracePeriodOrDefault :: Maybe Int32 -> NominalDiffTime - toGracePeriodOrDefault = maybe (verificationExpiration $ wsConfig defFeatureStatus) fromIntegral - - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Int32, Maybe HttpsUrl, Maybe HttpsUrl, Maybe Bool) - select = - fromString $ - "select mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile from team_features where team_id = ?" -getFeatureConfig FeatureSingletonMlsMigration tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - retry x1 q <&> \case - Nothing -> Nothing - Just (Nothing, _, _) -> Nothing - Just (Just fs, startTime, finaliseRegardlessAfter) -> - Just $ - WithStatusNoLock - fs - -- FUTUREWORK: the following expression is duplicated in - -- "Galley.Cassandra.GetAllTeamFeatureConfigs"; make sure the two don't diverge! - MlsMigrationConfig - { startTime = startTime, - finaliseRegardlessAfter = finaliseRegardlessAfter - } - FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe UTCTime, Maybe UTCTime) - select = "select mls_migration_status, mls_migration_start_time, mls_migration_finalise_regardless_after 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 -getFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - retry x1 q <&> \case - Nothing -> Nothing - Just (Nothing, _) -> Nothing - Just (Just fs, mbLocation) -> - Just $ WithStatusNoLock fs (EnforceFileDownloadLocationConfig mbLocation) FeatureTTLUnlimited - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe Text) - select = "select enforce_file_download_location_status, enforce_file_download_location from team_features where team_id = ?" +getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (WithStatusBase Maybe cfg) +getFeatureConfig FeatureSingletonLegalholdConfig tid = getFeature "legalhold_status" tid +getFeatureConfig FeatureSingletonSSOConfig tid = getFeature "sso_status" tid +getFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid = getFeature "search_visibility_status" tid +getFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid = getFeature "validate_saml_emails" tid +getFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid = pure defFeatureWithStatus +getFeatureConfig FeatureSingletonDigitalSignaturesConfig tid = getFeature "digital_signatures" tid +getFeatureConfig FeatureSingletonAppLockConfig tid = + getFeature + "app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs" + tid +getFeatureConfig FeatureSingletonFileSharingConfig tid = getFeature "file_sharing" tid +getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = + getFeature + "self_deleting_messages_status, self_deleting_messages_ttl" + tid +getFeatureConfig FeatureSingletonConferenceCallingConfig tid = + getFeature + "conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one" + tid +getFeatureConfig FeatureSingletonGuestLinksConfig tid = getFeature "guest_links_status" tid +getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getFeature "snd_factor_password_challenge_status" tid +getFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid = getFeature "search_visibility_status" tid +getFeatureConfig FeatureSingletonMLSConfig tid = + getFeature + "mls_status, mls_default_protocol, mls_protocol_toggle_users, \ + \mls_allowed_ciphersuites, mls_default_ciphersuite, mls_supported_protocols" + tid +getFeatureConfig FeatureSingletonMlsE2EIdConfig tid = + getFeature + "mls_e2eid_status, mls_e2eid_grace_period, mls_e2eid_acme_discovery_url, \ + \mls_e2eid_crl_proxy, mls_e2eid_use_proxy_on_mobile" + tid +getFeatureConfig FeatureSingletonMlsMigration tid = + getFeature + "mls_migration_status, mls_migration_start_time, \ + \mls_migration_finalise_regardless_after" + tid +getFeatureConfig FeatureSingletonExposeInvitationURLsToTeamAdminConfig tid = + getFeature "expose_invitation_urls_to_team_admin" tid +getFeatureConfig FeatureSingletonOutlookCalIntegrationConfig tid = + getFeature "outlook_cal_integration_status" tid +getFeatureConfig FeatureSingletonEnforceFileDownloadLocationConfig tid = + getFeature + "enforce_file_download_location_status, enforce_file_download_location" + tid getFeatureConfig FeatureSingletonLimitedEventFanoutConfig tid = - getTrivialConfigC "limited_event_fanout_status" tid + getFeature "limited_event_fanout_status" tid setFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> WithStatusNoLock cfg -> m () setFeatureConfig FeatureSingletonLegalholdConfig tid statusNoLock = setFeatureStatusC "legalhold_status" tid (wssStatus statusNoLock) @@ -336,24 +247,21 @@ setFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid statu setFeatureLockStatus FeatureSingletonConferenceCallingConfig tid status = setLockStatusC "conference_calling_lock_status" tid status setFeatureLockStatus _ _tid _status = pure () -getTrivialConfigC :: +getFeature :: forall m cfg. - (MonadClient m, IsFeatureConfig cfg) => + (MonadClient m, MakeFeature cfg) => String -> TeamId -> - m (Maybe (WithStatusNoLock cfg)) -getTrivialConfigC statusCol tid = do - let q = query1 select (params LocalQuorum (Identity tid)) - mFeatureStatus <- (>>= runIdentity) <$> retry x1 q - pure $ case mFeatureStatus of - Nothing -> Nothing - Just status -> Just . forgetLock $ setStatus status defFeatureStatus + m (WithStatusBase Maybe cfg) +getFeature columns tid = do + row <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) + pure $ maybe defFeatureWithStatus (mkFeature . toRowType) row where - select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureStatus)) + select :: PrepQuery R (Identity TeamId) (FeatureRow cfg) select = fromString $ "select " - <> statusCol + <> columns <> " from team_features where team_id = ?" setFeatureStatusC :: @@ -407,6 +315,6 @@ getFeatureConfigMulti :: (MonadClient m, MonadUnliftIO m) => FeatureSingleton cfg -> [TeamId] -> - m [(TeamId, Maybe (WithStatusNoLock cfg))] + m [(TeamId, WithStatusBase Maybe cfg)] getFeatureConfigMulti proxy = pooledMapConcurrentlyN 8 (\tid -> getFeatureConfig proxy tid <&> (tid,)) diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index 36e79017a72..f1eb83c907a 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -25,14 +25,15 @@ import Polysemy import Wire.API.Team.Feature data TeamFeatureStore m a where + -- | Returns all stored feature values excluding lock status. GetFeatureConfig :: FeatureSingleton cfg -> TeamId -> - TeamFeatureStore m (Maybe (WithStatusNoLock cfg)) + TeamFeatureStore m (WithStatusBase Maybe cfg) GetFeatureConfigMulti :: FeatureSingleton cfg -> [TeamId] -> - TeamFeatureStore m [(TeamId, Maybe (WithStatusNoLock cfg))] + TeamFeatureStore m [(TeamId, WithStatusBase Maybe cfg)] SetFeatureConfig :: FeatureSingleton cfg -> TeamId -> From f433ec8a0fe5039ff95516c1fa8fc0a6a8d88e1a Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 26 Jul 2024 13:39:02 +0200 Subject: [PATCH 23/43] Use adhoc DbFeature type instead of WithStatusBase --- libs/wire-api/src/Wire/API/Team/Feature.hs | 53 +++++++-- .../galley/src/Galley/API/LegalHold/Team.hs | 17 ++- .../src/Galley/API/Teams/Features/Get.hs | 24 ++-- .../Cassandra/GetAllTeamFeatureConfigs.hs | 104 ++++++++---------- .../src/Galley/Cassandra/TeamFeatures.hs | 10 +- .../src/Galley/Effects/TeamFeatureStore.hs | 6 +- 6 files changed, 116 insertions(+), 98 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index a0baf198968..18aa6d6de11 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -26,6 +26,12 @@ module Wire.API.Team.Feature featureNameBS, LockStatus (..), WithStatusBase (..), + DbFeature (..), + DbFeatureWithLock (..), + dbFeatureStatus, + dbFeatureTTL, + dbFeatureConfig, + dbFeatureModConfig, WithStatus, withStatus, withStatus', @@ -237,6 +243,36 @@ data WithStatusBase (m :: Type -> Type) (cfg :: Type) = WithStatusBase } deriving stock (Generic, Typeable, Functor) +-------------------------------------------------------------------------------- +-- DbFeature + +-- | Feature data stored in the database, as a function of its default values. +newtype DbFeature cfg = DbFeature + {unDbFeature :: WithStatusNoLock cfg -> WithStatusNoLock cfg} + +instance Semigroup (DbFeature cfg) where + DbFeature f <> DbFeature g = DbFeature (f . g) + +instance Monoid (DbFeature cfg) where + mempty = DbFeature id + +dbFeatureStatus :: FeatureStatus -> DbFeature cfg +dbFeatureStatus s = DbFeature $ \w -> w {wssStatus = s} + +dbFeatureTTL :: FeatureTTL -> DbFeature cfg +dbFeatureTTL ttl = DbFeature $ \w -> w {wssTTL = ttl} + +dbFeatureConfig :: cfg -> DbFeature cfg +dbFeatureConfig c = DbFeature $ \w -> w {wssConfig = c} + +dbFeatureModConfig :: (cfg -> cfg) -> DbFeature cfg +dbFeatureModConfig f = DbFeature $ \w -> w {wssConfig = f (wssConfig w)} + +data DbFeatureWithLock cfg = DbFeatureWithLock + { lockStatus :: Maybe LockStatus, + feature :: DbFeature cfg + } + ---------------------------------------------------------------------- -- WithStatus @@ -569,16 +605,15 @@ instance (IsFeatureConfig a, ToSchema a) => FromJSON (ImplicitLockStatus a) wher -- | Convert a feature coming from the database to its public form. This can be -- overridden on a feature basis by implementing the `computeFeature` method of -- the `GetFeatureConfig` class. -genericComputeFeature :: WithStatus cfg -> WithStatusBase Maybe cfg -> WithStatus cfg -genericComputeFeature defFeature dbFeature = - case fromMaybe (wsLockStatus defFeature) (wsbLockStatus dbFeature) of +genericComputeFeature :: + WithStatus cfg -> + Maybe LockStatus -> + DbFeature cfg -> + WithStatus cfg +genericComputeFeature defFeature lockStatus dbFeature = + case fromMaybe (wsLockStatus defFeature) lockStatus of LockStatusLocked -> setLockStatus LockStatusLocked defFeature - LockStatusUnlocked -> - withStatus - (fromMaybe (wsStatus defFeature) (wsbStatus dbFeature)) - LockStatusUnlocked - (fromMaybe (wsConfig defFeature) (wsbConfig dbFeature)) - (fromMaybe (wsTTL defFeature) (wsbTTL dbFeature)) + LockStatusUnlocked -> withUnlocked $ unDbFeature dbFeature (forgetLock defFeature) -- | This contains the pure business logic for users from teams computeFeatureConfigForTeamUser :: Maybe (WithStatusNoLock cfg) -> Maybe LockStatus -> WithStatus cfg -> WithStatus cfg diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 3250534e838..c7052c2d8bc 100644 --- a/services/galley/src/Galley/API/LegalHold/Team.hs +++ b/services/galley/src/Galley/API/LegalHold/Team.hs @@ -29,7 +29,7 @@ import Data.Range import Galley.Effects import Galley.Effects.BrigAccess import Galley.Effects.LegalHoldStore qualified as LegalHoldData -import Galley.Effects.TeamFeatureStore qualified as TeamFeatures +import Galley.Effects.TeamFeatureStore import Galley.Effects.TeamStore import Galley.Types.Teams as Team import Imports @@ -57,15 +57,14 @@ computeLegalHoldFeatureStatus :: Member LegalHoldStore r ) => TeamId -> - Maybe FeatureStatus -> + DbFeature LegalholdConfig -> Sem r FeatureStatus -computeLegalHoldFeatureStatus tid dbStatus = +computeLegalHoldFeatureStatus tid dbFeature = getLegalHoldFlag >>= \case FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled - FeatureLegalHoldDisabledByDefault -> pure $ case dbStatus of - Just FeatureStatusEnabled -> FeatureStatusEnabled - Just FeatureStatusDisabled -> FeatureStatusDisabled - Nothing -> FeatureStatusDisabled + FeatureLegalHoldDisabledByDefault -> + pure . wssStatus $ + unDbFeature dbFeature defFeatureStatusNoLock FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do wl <- LegalHoldData.isTeamLegalholdWhitelisted tid pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled @@ -79,8 +78,8 @@ isLegalHoldEnabledForTeam :: TeamId -> Sem r Bool isLegalHoldEnabledForTeam tid = do - dbStatus <- wsbStatus <$> TeamFeatures.getFeatureConfig FeatureSingletonLegalholdConfig tid - status <- computeLegalHoldFeatureStatus tid dbStatus + dbFeature <- getFeatureConfig FeatureSingletonLegalholdConfig tid + status <- computeLegalHoldFeatureStatus tid dbFeature pure $ status == FeatureStatusEnabled ensureNotTooLargeToActivateLegalHold :: diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 0b02d6c66d7..39ab658e5e7 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -101,16 +101,18 @@ class (IsFeatureConfig cfg) => GetFeatureConfig cfg where (ComputeFeatureConstraints cfg r) => TeamId -> WithStatus cfg -> - WithStatusBase Maybe cfg -> + Maybe LockStatus -> + DbFeature cfg -> Sem r (WithStatus cfg) default computeFeature :: TeamId -> WithStatus cfg -> - WithStatusBase Maybe cfg -> + Maybe LockStatus -> + DbFeature cfg -> Sem r (WithStatus cfg) - computeFeature _tid defFeature dbFeature = + computeFeature _tid defFeature lockStatus dbFeature = pure $ - genericComputeFeature @cfg defFeature dbFeature + genericComputeFeature @cfg defFeature lockStatus dbFeature getFeatureStatus :: forall cfg r. @@ -301,9 +303,8 @@ getConfigForTeam tid = do computeFeature @cfg tid defFeature + lockStatus dbFeature - { wsbLockStatus = lockStatus - } -- Note: this function assumes the feature cannot be locked getConfigForMultiTeam :: @@ -319,8 +320,7 @@ getConfigForMultiTeam tids = do defFeature <- getConfigForServer features <- TeamFeatures.getFeatureConfigMulti (featureSingleton @cfg) tids for features $ \(tid, dbFeature) -> do - let unlocked = dbFeature {wsbLockStatus = Just LockStatusUnlocked} - feat <- computeFeature @cfg tid defFeature unlocked + feat <- computeFeature @cfg tid defFeature (Just LockStatusUnlocked) dbFeature pure (tid, feat) -- | Note: this is an internal function which doesn't cover all features, e.g. conference calling @@ -389,8 +389,8 @@ instance GetFeatureConfig LegalholdConfig where ComputeFeatureConstraints LegalholdConfig r = (Member TeamStore r, Member LegalHoldStore r) - computeFeature tid defFeature dbFeature = do - status <- computeLegalHoldFeatureStatus tid (wsbStatus dbFeature) + computeFeature tid defFeature _lockStatus dbFeature = do + status <- computeLegalHoldFeatureStatus tid dbFeature pure $ setStatus status defFeature instance GetFeatureConfig FileSharingConfig where @@ -450,11 +450,11 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where (Member (Input Opts) r) -- the lock status of this feature is calculated from the allow list, not the database - computeFeature tid defFeature dbFeature = do + computeFeature tid defFeature _lockStatus dbFeature = do allowList <- input <&> view (settings . exposeInvitationURLsTeamAllowlist . to (fromMaybe [])) let teamAllowed = tid `elem` allowList lockStatus = if teamAllowed then LockStatusUnlocked else LockStatusLocked - pure $ genericComputeFeature defFeature dbFeature {wsbLockStatus = Just lockStatus} + pure $ genericComputeFeature defFeature (Just lockStatus) dbFeature instance GetFeatureConfig OutlookCalIntegrationConfig where getConfigForServer = diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index b4dfa322af6..e8c73ad8c92 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -133,27 +133,21 @@ emptyRow = limitEventFanout = Nothing } -defFeatureWithStatus :: WithStatusBase Maybe cfg -defFeatureWithStatus = - WithStatusBase - { wsbStatus = Nothing, - wsbLockStatus = Nothing, - wsbConfig = Nothing, - wsbTTL = Nothing - } - -allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures (WithStatusBase Maybe) +allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures DbFeatureWithLock allFeatureConfigsFromRow row = AllFeatures - { afcLegalholdStatus = mkFeature row.legalhold, - afcSSOStatus = mkFeature row.sso, - afcTeamSearchVisibilityAvailable = mkFeature row.searchVisibility, - afcSearchVisibilityInboundConfig = mkFeature row.searchVisibility, - afcValidateSAMLEmails = mkFeature row.validateSamlEmails, - afcDigitalSignatures = mkFeature row.digitalSignatures, - afcAppLock = mkFeature (row.appLock, row.appLockEnforce, row.appLockInactivityTimeoutSecs), + { afcLegalholdStatus = mkFeatureWithLock Nothing row.legalhold, + afcSSOStatus = mkFeatureWithLock Nothing row.sso, + afcTeamSearchVisibilityAvailable = mkFeatureWithLock Nothing row.searchVisibility, + afcSearchVisibilityInboundConfig = mkFeatureWithLock Nothing row.searchVisibility, + afcValidateSAMLEmails = mkFeatureWithLock Nothing row.validateSamlEmails, + afcDigitalSignatures = mkFeatureWithLock Nothing row.digitalSignatures, + afcAppLock = + mkFeatureWithLock + Nothing + (row.appLock, row.appLockEnforce, row.appLockInactivityTimeoutSecs), afcFileSharing = mkFeatureWithLock row.fileSharingLock row.fileSharing, - afcClassifiedDomains = mkFeature Nothing, + afcClassifiedDomains = mkFeatureWithLock Nothing Nothing, afcConferenceCalling = mkFeatureWithLock row.conferenceCallingLock @@ -179,7 +173,7 @@ allFeatureConfigsFromRow row = row.mlsDefaultCipherSuite, row.mlsSupportedProtocols ), - afcExposeInvitationURLsToTeamAdmin = mkFeature row.exposeInvitationUrls, + afcExposeInvitationURLsToTeamAdmin = mkFeatureWithLock Nothing row.exposeInvitationUrls, afcOutlookCalIntegration = mkFeatureWithLock row.outlookCalIntegrationLock @@ -206,10 +200,10 @@ allFeatureConfigsFromRow row = ( row.enforceDownloadLocation, row.enforceDownloadLocation_Location ), - afcLimitedEventFanout = mkFeature row.limitEventFanout + afcLimitedEventFanout = mkFeatureWithLock Nothing row.limitEventFanout } -getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures (WithStatusBase Maybe)) +getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures DbFeatureWithLock) getAllFeatureConfigs tid = do mRow <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) pure $ allFeatureConfigsFromRow $ maybe emptyRow asRecord mRow @@ -251,19 +245,19 @@ class (Tuple (FeatureRow cfg), HasRowType (FeatureRow cfg)) => MakeFeature cfg w type FeatureRow cfg type FeatureRow cfg = Identity (Maybe FeatureStatus) - mkFeature :: RowType (FeatureRow cfg) -> WithStatusBase Maybe cfg + mkFeature :: RowType (FeatureRow cfg) -> DbFeature cfg default mkFeature :: (FeatureRow cfg ~ Identity (Maybe FeatureStatus)) => RowType (FeatureRow cfg) -> - WithStatusBase Maybe cfg - mkFeature s = defFeatureWithStatus {wsbStatus = s} + DbFeature cfg + mkFeature = foldMap dbFeatureStatus mkFeatureWithLock :: (MakeFeature cfg) => Maybe LockStatus -> RowType (FeatureRow cfg) -> - WithStatusBase Maybe cfg -mkFeatureWithLock lockStatus row = (mkFeature row) {wsbLockStatus = lockStatus} + DbFeatureWithLock cfg +mkFeatureWithLock lockStatus row = DbFeatureWithLock lockStatus (mkFeature row) -- | Used to remove the annoying Identity wrapper around single-element rows. type family RowType a where @@ -309,10 +303,8 @@ instance MakeFeature AppLockConfig where type FeatureRow AppLockConfig = (Maybe FeatureStatus, Maybe EnforceAppLock, Maybe Int32) mkFeature (status, enforce, timeout) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = AppLockConfig <$> enforce <*> timeout - } + foldMap dbFeatureStatus status + <> foldMap dbFeatureConfig (AppLockConfig <$> enforce <*> timeout) instance MakeFeature FileSharingConfig @@ -322,20 +314,16 @@ instance MakeFeature ConferenceCallingConfig where type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe Bool) mkFeature (status, ttl, sftForOneToOne) = - defFeatureWithStatus - { wsbStatus = status, - wsbTTL = ttl, - wsbConfig = ConferenceCallingConfig <$> sftForOneToOne - } + foldMap dbFeatureStatus status + <> foldMap dbFeatureTTL ttl + <> foldMap (dbFeatureConfig . ConferenceCallingConfig) sftForOneToOne instance MakeFeature SelfDeletingMessagesConfig where type FeatureRow SelfDeletingMessagesConfig = (Maybe FeatureStatus, Maybe Int32) mkFeature (status, ttl) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = SelfDeletingMessagesConfig <$> ttl - } + foldMap dbFeatureStatus status + <> foldMap (dbFeatureConfig . SelfDeletingMessagesConfig) ttl instance MakeFeature GuestLinksConfig @@ -357,16 +345,16 @@ instance MakeFeature MLSConfig where ) mkFeature (status, defProto, toggleUsers, ciphersuites, defCiphersuite, supportedProtos) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = - MLSConfig - <$> fmap C.fromSet toggleUsers + foldMap dbFeatureStatus status + <> foldMap + dbFeatureConfig + ( MLSConfig + <$> pure (foldMap C.fromSet toggleUsers) <*> defProto - <*> fmap C.fromSet ciphersuites + <*> pure (foldMap C.fromSet ciphersuites) <*> defCiphersuite - <*> fmap C.fromSet supportedProtos - } + <*> pure (foldMap C.fromSet supportedProtos) + ) instance MakeFeature MlsE2EIdConfig where type @@ -379,15 +367,15 @@ instance MakeFeature MlsE2EIdConfig where ) mkFeature (status, gracePeriod, acmeDiscovery, crlProxy, proxyOnMobile) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = - MlsE2EIdConfig + foldMap dbFeatureStatus status + <> foldMap + dbFeatureConfig + ( MlsE2EIdConfig <$> fmap fromIntegral gracePeriod <*> pure acmeDiscovery <*> pure crlProxy <*> proxyOnMobile - } + ) instance MakeFeature MlsMigrationConfig where type @@ -398,18 +386,14 @@ instance MakeFeature MlsMigrationConfig where ) mkFeature (status, startTime, finalizeAfter) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = Just $ MlsMigrationConfig startTime finalizeAfter - } + foldMap dbFeatureStatus status + <> dbFeatureConfig (MlsMigrationConfig startTime finalizeAfter) instance MakeFeature EnforceFileDownloadLocationConfig where type FeatureRow EnforceFileDownloadLocationConfig = (Maybe FeatureStatus, Maybe Text) mkFeature (status, location) = - defFeatureWithStatus - { wsbStatus = status, - wsbConfig = Just (EnforceFileDownloadLocationConfig location) - } + foldMap dbFeatureStatus status + <> dbFeatureConfig (EnforceFileDownloadLocationConfig location) instance MakeFeature LimitedEventFanoutConfig diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 35a89711baf..107005440b7 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -69,12 +69,12 @@ interpretTeamFeatureStoreToCassandra = interpret $ \case logEffect "TeamFeatureStore.GetAllFeatureConfigs" embedClient $ getAllFeatureConfigs tid -getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (WithStatusBase Maybe cfg) +getFeatureConfig :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (DbFeature cfg) getFeatureConfig FeatureSingletonLegalholdConfig tid = getFeature "legalhold_status" tid getFeatureConfig FeatureSingletonSSOConfig tid = getFeature "sso_status" tid getFeatureConfig FeatureSingletonSearchVisibilityAvailableConfig tid = getFeature "search_visibility_status" tid getFeatureConfig FeatureSingletonValidateSAMLEmailsConfig tid = getFeature "validate_saml_emails" tid -getFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid = pure defFeatureWithStatus +getFeatureConfig FeatureSingletonClassifiedDomainsConfig _tid = pure mempty getFeatureConfig FeatureSingletonDigitalSignaturesConfig tid = getFeature "digital_signatures" tid getFeatureConfig FeatureSingletonAppLockConfig tid = getFeature @@ -252,10 +252,10 @@ getFeature :: (MonadClient m, MakeFeature cfg) => String -> TeamId -> - m (WithStatusBase Maybe cfg) + m (DbFeature cfg) getFeature columns tid = do row <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure $ maybe defFeatureWithStatus (mkFeature . toRowType) row + pure $ foldMap (mkFeature . toRowType) row where select :: PrepQuery R (Identity TeamId) (FeatureRow cfg) select = @@ -315,6 +315,6 @@ getFeatureConfigMulti :: (MonadClient m, MonadUnliftIO m) => FeatureSingleton cfg -> [TeamId] -> - m [(TeamId, WithStatusBase Maybe cfg)] + m [(TeamId, DbFeature cfg)] getFeatureConfigMulti proxy = pooledMapConcurrentlyN 8 (\tid -> getFeatureConfig proxy tid <&> (tid,)) diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs index f1eb83c907a..0d24a1821af 100644 --- a/services/galley/src/Galley/Effects/TeamFeatureStore.hs +++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs @@ -29,11 +29,11 @@ data TeamFeatureStore m a where GetFeatureConfig :: FeatureSingleton cfg -> TeamId -> - TeamFeatureStore m (WithStatusBase Maybe cfg) + TeamFeatureStore m (DbFeature cfg) GetFeatureConfigMulti :: FeatureSingleton cfg -> [TeamId] -> - TeamFeatureStore m [(TeamId, WithStatusBase Maybe cfg)] + TeamFeatureStore m [(TeamId, DbFeature cfg)] SetFeatureConfig :: FeatureSingleton cfg -> TeamId -> @@ -50,6 +50,6 @@ data TeamFeatureStore m a where TeamFeatureStore m () GetAllFeatureConfigs :: TeamId -> - TeamFeatureStore m (AllFeatures (WithStatusBase Maybe)) + TeamFeatureStore m (AllFeatures DbFeatureWithLock) makeSem ''TeamFeatureStore From 6189811d76f4dfe60e949dddab6aced8c574833e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 26 Jul 2024 13:49:56 +0200 Subject: [PATCH 24/43] Fix default logic of MlsE2EI flag --- .../src/Galley/API/Teams/Features/Get.hs | 1 - .../Cassandra/GetAllTeamFeatureConfigs.hs | 18 ++++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 39ab658e5e7..25a1b11d34b 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -299,7 +299,6 @@ getConfigForTeam tid = do dbFeature <- TeamFeatures.getFeatureConfig (featureSingleton @cfg) tid lockStatus <- TeamFeatures.getFeatureLockStatus (featureSingleton @cfg) tid defFeature <- getConfigForServer - -- TODO: check that all cascading logic has been preserved computeFeature @cfg tid defFeature diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index e8c73ad8c92..5e9a7dbe0a8 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -366,15 +366,17 @@ instance MakeFeature MlsE2EIdConfig where Maybe Bool ) - mkFeature (status, gracePeriod, acmeDiscovery, crlProxy, proxyOnMobile) = + mkFeature (status, gracePeriod, acmeDiscoveryUrl, crlProxy, useProxyOnMobile) = foldMap dbFeatureStatus status - <> foldMap - dbFeatureConfig - ( MlsE2EIdConfig - <$> fmap fromIntegral gracePeriod - <*> pure acmeDiscovery - <*> pure crlProxy - <*> proxyOnMobile + <> dbFeatureModConfig + ( \defCfg -> + defCfg + { verificationExpiration = + maybe defCfg.verificationExpiration fromIntegral gracePeriod, + acmeDiscoveryUrl = acmeDiscoveryUrl, + crlProxy = crlProxy, + useProxyOnMobile = fromMaybe defCfg.useProxyOnMobile useProxyOnMobile + } ) instance MakeFeature MlsMigrationConfig where From f190fd8eb35570fd96940e265174af4021c7090b Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 26 Jul 2024 14:32:04 +0200 Subject: [PATCH 25/43] Implement getAllFeatureConfigs --- libs/wire-api/src/Wire/API/Team/Feature.hs | 2 + .../src/Galley/API/Teams/Features/Get.hs | 66 +++++++++++++++++-- 2 files changed, 64 insertions(+), 4 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 18aa6d6de11..b56f83ccb60 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} @@ -1232,6 +1233,7 @@ instance Cass.Cql FeatureStatus where defFeatureStatusNoLock :: (IsFeatureConfig cfg) => WithStatusNoLock cfg defFeatureStatusNoLock = forgetLock defFeatureStatus +-- FUTUREWORK: rewrite using SOP data AllFeatures f = AllFeatures { afcLegalholdStatus :: f LegalholdConfig, afcSSOStatus :: f SSOConfig, diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 25a1b11d34b..fb892219b56 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + -- This file is part of the Wire Server implementation. -- -- Copyright (C) 2022 Wire Swiss GmbH @@ -206,7 +208,9 @@ getAllFeatureConfigsForUser zusr = do getAllFeatureConfigsForTeam :: forall r. - ( Member (ErrorS 'NotATeamMember) r, + ( Member (Input Opts) r, + Member (ErrorS 'NotATeamMember) r, + Member LegalHoldStore r, Member TeamFeatureStore r, Member TeamStore r ) => @@ -218,10 +222,64 @@ getAllFeatureConfigsForTeam luid tid = do maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership getAllFeatureConfigs tid -getAllFeatureConfigs :: (Member TeamFeatureStore r) => TeamId -> Sem r AllFeatureConfigs +getAllFeatureConfigs :: + ( Member (Input Opts) r, + Member LegalHoldStore r, + Member TeamFeatureStore r, + Member TeamStore r + ) => + TeamId -> + Sem r AllFeatureConfigs getAllFeatureConfigs tid = do - _features <- TeamFeatures.getAllFeatureConfigs tid - error "TODO" + features <- TeamFeatures.getAllFeatureConfigs tid + defFeatures <- getAllFeatureConfigsForServer + biTraverseAllFeatures (computeFeatureWithLock tid) defFeatures features + +computeFeatureWithLock :: + forall cfg r. + (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => + TeamId -> + WithStatus cfg -> + DbFeatureWithLock cfg -> + Sem r (WithStatus cfg) +computeFeatureWithLock tid defFeature feat = + computeFeature @cfg tid defFeature feat.lockStatus feat.feature + +-- | One of a number of possible combinators. This is the only one we happen to need. +biTraverseAllFeatures :: + ( Member (Input Opts) r, + Member TeamStore r, + Member LegalHoldStore r + ) => + ( forall cfg. + (GetFeatureConfig cfg, ComputeFeatureConstraints cfg r) => + f cfg -> + g cfg -> + Sem r (h cfg) + ) -> + (AllFeatures f -> AllFeatures g -> Sem r (AllFeatures h)) +biTraverseAllFeatures phi features1 features2 = do + afcLegalholdStatus <- phi (afcLegalholdStatus features1) (afcLegalholdStatus features2) + afcSSOStatus <- phi (afcSSOStatus features1) (afcSSOStatus features2) + afcTeamSearchVisibilityAvailable <- phi (afcTeamSearchVisibilityAvailable features1) (afcTeamSearchVisibilityAvailable features2) + afcSearchVisibilityInboundConfig <- phi (afcSearchVisibilityInboundConfig features1) (afcSearchVisibilityInboundConfig features2) + afcValidateSAMLEmails <- phi (afcValidateSAMLEmails features1) (afcValidateSAMLEmails features2) + afcDigitalSignatures <- phi (afcDigitalSignatures features1) (afcDigitalSignatures features2) + afcAppLock <- phi (afcAppLock features1) (afcAppLock features2) + afcFileSharing <- phi (afcFileSharing features1) (afcFileSharing features2) + afcClassifiedDomains <- phi (afcClassifiedDomains features1) (afcClassifiedDomains features2) + afcConferenceCalling <- phi (afcConferenceCalling features1) (afcConferenceCalling features2) + afcSelfDeletingMessages <- phi (afcSelfDeletingMessages features1) (afcSelfDeletingMessages features2) + afcGuestLink <- phi (afcGuestLink features1) (afcGuestLink features2) + afcSndFactorPasswordChallenge <- phi (afcSndFactorPasswordChallenge features1) (afcSndFactorPasswordChallenge features2) + afcMLS <- phi (afcMLS features1) (afcMLS features2) + afcExposeInvitationURLsToTeamAdmin <- phi (afcExposeInvitationURLsToTeamAdmin features1) (afcExposeInvitationURLsToTeamAdmin features2) + afcOutlookCalIntegration <- phi (afcOutlookCalIntegration features1) (afcOutlookCalIntegration features2) + afcMlsE2EId <- phi (afcMlsE2EId features1) (afcMlsE2EId features2) + afcMlsMigration <- phi (afcMlsMigration features1) (afcMlsMigration features2) + afcEnforceFileDownloadLocation <- phi (afcEnforceFileDownloadLocation features1) (afcEnforceFileDownloadLocation features2) + afcLimitedEventFanout <- phi (afcLimitedEventFanout features1) (afcLimitedEventFanout features2) + pure AllFeatures {..} getAllFeatureConfigsForServer :: forall r. From a560f055f0593d122b720491a2c8a8dc03c3596c Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Fri, 26 Jul 2024 16:14:30 +0200 Subject: [PATCH 26/43] Lint --- .../galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 5e9a7dbe0a8..340e73fb7f1 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -348,9 +348,8 @@ instance MakeFeature MLSConfig where foldMap dbFeatureStatus status <> foldMap dbFeatureConfig - ( MLSConfig - <$> pure (foldMap C.fromSet toggleUsers) - <*> defProto + ( MLSConfig (foldMap C.fromSet toggleUsers) + <$> defProto <*> pure (foldMap C.fromSet ciphersuites) <*> defCiphersuite <*> pure (foldMap C.fromSet supportedProtos) From d70c97fe77ff4a8003e4569ae1c53b60c16e6092 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 29 Jul 2024 15:02:21 +0200 Subject: [PATCH 27/43] Change conference option from boolean to int --- cassandra-schema.cql | 2 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 35 ++++++++++++++++--- .../Golden/Generated/WithStatusNoLock_team.hs | 2 +- .../Golden/Generated/WithStatusPatch_team.hs | 2 +- .../API/Golden/Generated/WithStatus_team.hs | 2 +- .../Cassandra/GetAllTeamFeatureConfigs.hs | 10 +++--- .../src/Galley/Cassandra/TeamFeatures.hs | 8 ++--- .../V93_ConferenceCallingSftForOneToOne.hs | 4 +-- 8 files changed, 46 insertions(+), 19 deletions(-) diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 80e7b4de7ba..11de7fa36fb 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1171,7 +1171,7 @@ CREATE TABLE galley_test.team_features ( app_lock_status int, conference_calling int, conference_calling_lock_status int, - conference_calling_sft_for_one_to_one boolean, + conference_calling_one_to_one int, digital_signatures int, enforce_file_download_location text, enforce_file_download_location_lock_status int, diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index b56f83ccb60..961dd18d0ed 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -69,6 +69,7 @@ module Wire.API.Team.Feature FeatureSingleton (..), HasDeprecatedFeatureName (..), LockStatusResponse (..), + One2OneCalls (..), -- Features LegalholdConfig (..), SSOConfig (..), @@ -758,14 +759,37 @@ instance ToSchema DigitalSignaturesConfig where -------------------------------------------------------------------------------- -- ConferenceCalling feature +data One2OneCalls = One2OneCallsTurn | One2OneCallsSft + deriving stock (Eq, Show, Generic) + deriving (Arbitrary) via (GenericUniform One2OneCalls) + +one2OneCallsFromUseSftFlag :: Bool -> One2OneCalls +one2OneCallsFromUseSftFlag False = One2OneCallsTurn +one2OneCallsFromUseSftFlag True = One2OneCallsSft + +instance Default One2OneCalls where + def = One2OneCallsTurn + +instance Cass.Cql One2OneCalls where + ctype = Cass.Tagged Cass.IntColumn + + fromCql (Cass.CqlInt n) = case n of + 0 -> pure One2OneCallsTurn + 1 -> pure One2OneCallsSft + _ -> Left "fromCql: Invalid One2OneCalls" + fromCql _ = Left "fromCql: One2OneCalls: CqlInt expected" + + toCql One2OneCallsTurn = Cass.CqlInt 0 + toCql One2OneCallsSft = Cass.CqlInt 1 + data ConferenceCallingConfig = ConferenceCallingConfig - { sftForOne2One :: Bool + { one2OneCalls :: One2OneCalls } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConferenceCallingConfig) instance Default ConferenceCallingConfig where - def = ConferenceCallingConfig {sftForOne2One = False} + def = ConferenceCallingConfig {one2OneCalls = def} instance RenderableSymbol ConferenceCallingConfig where renderSymbol = "ConferenceCallingConfig" @@ -780,7 +804,10 @@ instance ToSchema ConferenceCallingConfig where schema = object "ConferenceCallingConfig" $ ConferenceCallingConfig - <$> sftForOne2One .= (fromMaybe False <$> optField "useSFTForOneToOneCalls" schema) + <$> ((== One2OneCallsSft) . one2OneCalls) + .= ( fromMaybe def . fmap one2OneCallsFromUseSftFlag + <$> optField "useSFTForOneToOneCalls" schema + ) -------------------------------------------------------------------------------- -- SndFactorPasswordChallenge feature @@ -1066,7 +1093,7 @@ instance ToSchema MlsE2EIdConfig where description ?~ "When a client first tries to fetch or renew a certificate, \ \they may need to login to an identity provider (IdP) depending on their IdP domain authentication policy. \ - \The user may have a grace period during which they can “snooze” this login. \ + \The user may have a grace period during which they can \"snooze\" this login. \ \The duration of this grace period (in seconds) is set in the `verificationDuration` parameter, \ \which is enforced separately by each client. \ \After the grace period has expired, the client will not allow the user to use the application \ diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs index 6fc948b1c27..efc0c52b7d5 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs @@ -63,7 +63,7 @@ testObject_WithStatusNoLock_team_13 :: WithStatusNoLock DigitalSignaturesConfig testObject_WithStatusNoLock_team_13 = WithStatusNoLock FeatureStatusEnabled DigitalSignaturesConfig FeatureTTLUnlimited testObject_WithStatusNoLock_team_14 :: WithStatusNoLock ConferenceCallingConfig -testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled (ConferenceCallingConfig True) FeatureTTLUnlimited +testObject_WithStatusNoLock_team_14 = WithStatusNoLock FeatureStatusDisabled (ConferenceCallingConfig One2OneCallsSft) FeatureTTLUnlimited testObject_WithStatusNoLock_team_15 :: WithStatusNoLock GuestLinksConfig testObject_WithStatusNoLock_team_15 = WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs index f668a32c157..a5dd2c94955 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusPatch_team.hs @@ -63,7 +63,7 @@ testObject_WithStatusPatch_team_13 :: WithStatusPatch DigitalSignaturesConfig testObject_WithStatusPatch_team_13 = withStatus (Just FeatureStatusEnabled) (Just LockStatusLocked) (Just DigitalSignaturesConfig) testObject_WithStatusPatch_team_14 :: WithStatusPatch ConferenceCallingConfig -testObject_WithStatusPatch_team_14 = withStatus Nothing (Just LockStatusUnlocked) (Just (ConferenceCallingConfig True)) +testObject_WithStatusPatch_team_14 = withStatus Nothing (Just LockStatusUnlocked) (Just (ConferenceCallingConfig One2OneCallsSft)) testObject_WithStatusPatch_team_15 :: WithStatusPatch GuestLinksConfig testObject_WithStatusPatch_team_15 = withStatus (Just FeatureStatusEnabled) (Just LockStatusUnlocked) (Just GuestLinksConfig) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs index 020c1f979ca..6acd1c8f634 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatus_team.hs @@ -66,7 +66,7 @@ testObject_WithStatus_team_13 :: WithStatus DigitalSignaturesConfig testObject_WithStatus_team_13 = withStatus FeatureStatusEnabled LockStatusLocked DigitalSignaturesConfig testObject_WithStatus_team_14 :: WithStatus ConferenceCallingConfig -testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig False) +testObject_WithStatus_team_14 = withStatus FeatureStatusDisabled LockStatusUnlocked (ConferenceCallingConfig One2OneCallsTurn) testObject_WithStatus_team_15 :: WithStatus GuestLinksConfig testObject_WithStatus_team_15 = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 340e73fb7f1..e907c02d222 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -39,7 +39,7 @@ data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow -- conference calling conferenceCalling :: Maybe FeatureStatus, conferenceCallingTtl :: Maybe FeatureTTL, - conferenceCallingSftForOne2One :: Maybe Bool, + conferenceCallingOne2One :: Maybe One2OneCalls, conferenceCallingLock :: Maybe LockStatus, -- guest links guestLinks :: Maybe FeatureStatus, @@ -101,7 +101,7 @@ emptyRow = selfDeletingMessagesLock = Nothing, conferenceCalling = Nothing, conferenceCallingTtl = Nothing, - conferenceCallingSftForOne2One = Nothing, + conferenceCallingOne2One = Nothing, conferenceCallingLock = Nothing, guestLinks = Nothing, guestLinksLock = Nothing, @@ -153,7 +153,7 @@ allFeatureConfigsFromRow row = row.conferenceCallingLock ( row.conferenceCalling, row.conferenceCallingTtl, - row.conferenceCallingSftForOne2One + row.conferenceCallingOne2One ), afcSelfDeletingMessages = mkFeatureWithLock @@ -223,7 +223,7 @@ getAllFeatureConfigs tid = do \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ \file_sharing, file_sharing_lock_status, \ \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ - \conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one, conference_calling_lock_status, \ + \conference_calling, ttl(conference_calling), conference_calling_one_to_one, conference_calling_lock_status, \ \guest_links_status, guest_links_lock_status, \ \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ \\ @@ -311,7 +311,7 @@ instance MakeFeature FileSharingConfig instance MakeFeature ClassifiedDomainsConfig instance MakeFeature ConferenceCallingConfig where - type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe Bool) + type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe One2OneCalls) mkFeature (status, ttl, sftForOneToOne) = foldMap dbFeatureStatus status diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 107005440b7..370b456cd2c 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -87,7 +87,7 @@ getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = tid getFeatureConfig FeatureSingletonConferenceCallingConfig tid = getFeature - "conference_calling, ttl(conference_calling), conference_calling_sft_for_one_to_one" + "conference_calling, ttl(conference_calling), conference_calling_one_to_one" tid getFeatureConfig FeatureSingletonGuestLinksConfig tid = getFeature "guest_links_status" tid getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getFeature "snd_factor_password_challenge_status" tid @@ -151,7 +151,7 @@ setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do setType BatchLogged setConsistency LocalQuorum addPrepQuery insertStatus (tid, statusNoLock.wssStatus, ttlValue (statusNoLock.wssTTL)) - addPrepQuery insertConfig (tid, statusNoLock.wssConfig.sftForOne2One) + addPrepQuery insertConfig (tid, statusNoLock.wssConfig.one2OneCalls) where ttlValue :: FeatureTTL -> Int32 ttlValue (FeatureTTLSeconds d) = fromIntegral d @@ -159,8 +159,8 @@ setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do insertStatus :: PrepQuery W (TeamId, FeatureStatus, Int32) () insertStatus = "insert into team_features (team_id, conference_calling) values (?, ?) using ttl ?" - insertConfig :: PrepQuery W (TeamId, Bool) () - insertConfig = "insert into team_features (team_id, conference_calling_sft_for_one_to_one) values (?, ?)" + insertConfig :: PrepQuery W (TeamId, One2OneCalls) () + insertConfig = "insert into team_features (team_id, conference_calling_one_to_one) values (?, ?)" setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) diff --git a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs index d43b0b5b30b..d531bd69945 100644 --- a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs +++ b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs @@ -6,10 +6,10 @@ import Text.RawString.QQ migration :: Migration migration = - Migration 93 "Add conference_calling_sft_for_one_to_one and its lock_status to team_features" $ + Migration 93 "Add conference_calling_one_to_one and its lock_status to team_features" $ schema' [r| ALTER TABLE team_features ADD ( - conference_calling_sft_for_one_to_one boolean, + conference_calling_one_to_one int, conference_calling_lock_status int ) |] From 6167ddc588c1c340e9213b6f09e8a8c2cba51626 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 29 Jul 2024 15:12:02 +0200 Subject: [PATCH 28/43] Repurpose conference_calling column for lock status Also add a new column to hold the feature status --- .../src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs | 2 +- services/galley/src/Galley/Cassandra/TeamFeatures.hs | 8 ++++---- .../Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs | 5 +++-- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index e907c02d222..c55808c7823 100644 --- a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs +++ b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs @@ -223,7 +223,7 @@ getAllFeatureConfigs tid = do \app_lock_status, app_lock_enforce, app_lock_inactivity_timeout_secs, \ \file_sharing, file_sharing_lock_status, \ \self_deleting_messages_status, self_deleting_messages_ttl, self_deleting_messages_lock_status, \ - \conference_calling, ttl(conference_calling), conference_calling_one_to_one, conference_calling_lock_status, \ + \conference_calling_status, ttl(conference_calling_status), conference_calling_one_to_one, conference_calling, \ \guest_links_status, guest_links_lock_status, \ \snd_factor_password_challenge_status, snd_factor_password_challenge_lock_status, \ \\ diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 370b456cd2c..9d88e19f91c 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -87,7 +87,7 @@ getFeatureConfig FeatureSingletonSelfDeletingMessagesConfig tid = tid getFeatureConfig FeatureSingletonConferenceCallingConfig tid = getFeature - "conference_calling, ttl(conference_calling), conference_calling_one_to_one" + "conference_calling_status, ttl(conference_calling_status), conference_calling_one_to_one" tid getFeatureConfig FeatureSingletonGuestLinksConfig tid = getFeature "guest_links_status" tid getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getFeature "snd_factor_password_challenge_status" tid @@ -158,7 +158,7 @@ setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do ttlValue FeatureTTLUnlimited = 0 insertStatus :: PrepQuery W (TeamId, FeatureStatus, Int32) () - insertStatus = "insert into team_features (team_id, conference_calling) values (?, ?) using ttl ?" + insertStatus = "insert into team_features (team_id, conference_calling_status) values (?, ?) using ttl ?" insertConfig :: PrepQuery W (TeamId, One2OneCalls) () insertConfig = "insert into team_features (team_id, conference_calling_one_to_one) values (?, ?)" setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) @@ -231,7 +231,7 @@ getFeatureLockStatus FeatureSingletonMlsMigration tid = getLockStatusC "mls_migr getFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid = getLockStatusC "outlook_cal_integration_lock_status" tid getFeatureLockStatus FeatureSingletonMLSConfig tid = getLockStatusC "mls_lock_status" tid getFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid = getLockStatusC "enforce_file_download_location_lock_status" tid -getFeatureLockStatus FeatureSingletonConferenceCallingConfig tid = getLockStatusC "conference_calling_lock_status" tid +getFeatureLockStatus FeatureSingletonConferenceCallingConfig tid = getLockStatusC "conference_calling" tid getFeatureLockStatus _ _ = pure Nothing setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockStatus -> m () @@ -244,7 +244,7 @@ setFeatureLockStatus FeatureSingletonMlsMigration tid status = setLockStatusC "m setFeatureLockStatus FeatureSingletonOutlookCalIntegrationConfig tid status = setLockStatusC "outlook_cal_integration_lock_status" tid status setFeatureLockStatus FeatureSingletonMLSConfig tid status = setLockStatusC "mls_lock_status" tid status setFeatureLockStatus FeatureSingletonEnforceFileDownloadLocationConfig tid status = setLockStatusC "enforce_file_download_location_lock_status" tid status -setFeatureLockStatus FeatureSingletonConferenceCallingConfig tid status = setLockStatusC "conference_calling_lock_status" tid status +setFeatureLockStatus FeatureSingletonConferenceCallingConfig tid status = setLockStatusC "conference_calling" tid status setFeatureLockStatus _ _tid _status = pure () getFeature :: diff --git a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs index d531bd69945..f93f63d70f9 100644 --- a/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs +++ b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs @@ -6,10 +6,11 @@ import Text.RawString.QQ migration :: Migration migration = - Migration 93 "Add conference_calling_one_to_one and its lock_status to team_features" $ + Migration 93 "Add conference_calling_one_to_one and status to team_features" $ + -- the existing field `conference_calling` is now repurposed to represent the lock status schema' [r| ALTER TABLE team_features ADD ( conference_calling_one_to_one int, - conference_calling_lock_status int + conference_calling_status int ) |] From d460a8143dbe1fe96b24418114638f7550fda426 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 29 Jul 2024 15:25:01 +0200 Subject: [PATCH 29/43] Ignore TTL for conferenceCalling Now the TTL field is completely ignored when writing for all feature flags. We will get rid of the TTL code in a future refactoring. --- services/galley/src/Galley/Cassandra/TeamFeatures.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs index 9d88e19f91c..a751060e668 100644 --- a/services/galley/src/Galley/Cassandra/TeamFeatures.hs +++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs @@ -150,15 +150,11 @@ setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do retry x5 . batch $ do setType BatchLogged setConsistency LocalQuorum - addPrepQuery insertStatus (tid, statusNoLock.wssStatus, ttlValue (statusNoLock.wssTTL)) + addPrepQuery insertStatus (tid, statusNoLock.wssStatus) addPrepQuery insertConfig (tid, statusNoLock.wssConfig.one2OneCalls) where - ttlValue :: FeatureTTL -> Int32 - ttlValue (FeatureTTLSeconds d) = fromIntegral d - ttlValue FeatureTTLUnlimited = 0 - - insertStatus :: PrepQuery W (TeamId, FeatureStatus, Int32) () - insertStatus = "insert into team_features (team_id, conference_calling_status) values (?, ?) using ttl ?" + insertStatus :: PrepQuery W (TeamId, FeatureStatus) () + insertStatus = "insert into team_features (team_id, conference_calling_status) values (?, ?)" insertConfig :: PrepQuery W (TeamId, One2OneCalls) () insertConfig = "insert into team_features (team_id, conference_calling_one_to_one) values (?, ?)" setFeatureConfig FeatureSingletonGuestLinksConfig tid statusNoLock = setFeatureStatusC "guest_links_status" tid (wssStatus statusNoLock) From 1efa0b534db49001258da617168aa4e6af2310e5 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 30 Jul 2024 09:49:51 +0200 Subject: [PATCH 30/43] Add default logic for conference calling --- .../src/Galley/API/Teams/Features/Get.hs | 20 +++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index fb892219b56..075cb58fbac 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -462,6 +462,16 @@ instance GetFeatureConfig ClassifiedDomainsConfig where getConfigForServer = input <&> view (settings . featureFlags . flagClassifiedDomains . unImplicitLockStatus) +-- | Conference calling gets enabled automatically once unlocked. To achieve +-- that, the default feature status in the unlocked case is forced to be +-- "enabled" before the database data is applied. +-- +-- Previously, we were assuming that this feature would be left as "unlocked", +-- and the clients were simply setting the status field. Now, the pre-existing +-- status field is reinterpreted as the lock status, which means that the +-- status will be NULL in many cases. The defaulting logic in 'computeFeature' +-- here makes sure that the status is aligned with the lock status in those +-- situations. instance GetFeatureConfig ConferenceCallingConfig where type GetConfigForUserConstraints ConferenceCallingConfig r = @@ -481,6 +491,16 @@ instance GetFeatureConfig ConferenceCallingConfig where wsnl <- getAccountConferenceCallingConfigClient uid pure $ withLockStatus (wsLockStatus (defFeatureStatus @ConferenceCallingConfig)) wsnl + computeFeature _tid defFeature lockStatus dbFeature = + pure $ case fromMaybe (wsLockStatus defFeature) lockStatus of + LockStatusLocked -> setLockStatus LockStatusLocked defFeature + LockStatusUnlocked -> + withUnlocked $ + (unDbFeature dbFeature) + (forgetLock defFeature) + { wssStatus = FeatureStatusEnabled + } + instance GetFeatureConfig SelfDeletingMessagesConfig where getConfigForServer = input <&> view (settings . featureFlags . flagSelfDeletingMessages . unDefaults) From bcd39a8a6204be92b86b32551f1bf05e95161875 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 30 Jul 2024 09:51:35 +0200 Subject: [PATCH 31/43] Remove feature ttl tests --- integration/test/Test/FeatureFlags.hs | 34 ---------------------- integration/test/Test/FeatureFlags/User.hs | 9 +----- 2 files changed, 1 insertion(+), 42 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 76a41429ed7..dbf45419264 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -915,40 +915,6 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do length statuses `shouldMatchInt` 2 statuses `shouldMatchSet` [object ["team" .= team1, "status" .= "disabled"], object ["team" .= team2, "status" .= "enabled"]] -testConferenceCallingTTLOverride :: (HasCallStack) => App () -testConferenceCallingTTLOverride = do - (owner, tid, _) <- createTeam OwnDomain 0 - let defArgs = def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")} - featureName = "conferenceCalling" - ttl1 = Just (toJSON (2 :: Int)) - ttl2 = Just (toJSON (5 :: Int)) - - checkFeature featureName owner tid (confCalling defArgs) - - -- set a small ttl - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1, sft = toJSON True}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) - - -- wait less than expiration, override and recheck - liftIO $ threadDelay 500000 -- waiting half of TTL - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) - - -- override ttl with a larger value - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl2, sft = toJSON True}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl2, sft = toJSON True}) - - -- set it back to unlimited - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = Just (toJSON "unlimited"), sft = toJSON True}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = Just (toJSON "unlimited"), sft = toJSON True}) - - -- set it again to ttl1 - assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (confCalling def {status = "disabled", ttl = ttl1, sft = toJSON True}) - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {status = "disabled", ttl = ttl1, sft = toJSON True}) - - -- wait it out fully and check that the status reverted - liftIO $ threadDelay 2000000 - checkFeatureLenientTtl featureName owner tid (confCalling defArgs {sft = toJSON True}) - -------------------------------------------------------------------------------- -- Simple flags with implicit lock status diff --git a/integration/test/Test/FeatureFlags/User.hs b/integration/test/Test/FeatureFlags/User.hs index 5cdfe42f5b4..fc16ad04017 100644 --- a/integration/test/Test/FeatureFlags/User.hs +++ b/integration/test/Test/FeatureFlags/User.hs @@ -12,14 +12,12 @@ testFeatureConferenceCallingForUser = do (alice, tid, _) <- createTeam OwnDomain 0 -- team user bob <- randomUser OwnDomain def -- non-team user let featureName = "conferenceCalling" - ttl = Just (toJSON (360000 :: Int)) -- set initial value at the team level let initial = confCalling def { status = "enabled", - ttl = ttl, sft = toJSON True } assertSuccess =<< I.setTeamFeatureConfig OwnDomain tid featureName initial @@ -29,7 +27,6 @@ testFeatureConferenceCallingForUser = do void $ I.putFeatureForUser u featureName (object ["status" .= "disabled"]) >>= getBody 200 config <- I.getFeatureForUser u featureName >>= getJSON 200 config %. "status" `shouldMatch` "disabled" - config %. "ttl" `shouldMatch` "unlimited" -- this config is just made up by brig, it does not reflect the actual value -- that will be returned to the user @@ -41,7 +38,6 @@ testFeatureConferenceCallingForUser = do config <- features %. featureName -- alice is a team user, so her config reflects that of the team config %. "status" `shouldMatch` "enabled" - checkTtl (config %. "ttl") (360000 :: Int) config %. "config.useSFTForOneToOneCalls" `shouldMatch` True do @@ -49,7 +45,6 @@ testFeatureConferenceCallingForUser = do features <- getFeaturesForUser alice >>= getJSON 200 config <- features %. featureName config %. "status" `shouldMatch` "enabled" - checkTtl (config %. "ttl") (360000 :: Int) config %. "config.useSFTForOneToOneCalls" `shouldMatch` True -- bob @@ -58,13 +53,11 @@ testFeatureConferenceCallingForUser = do config <- features %. featureName -- bob is not in a team, so we get his own personal settings here config %. "status" `shouldMatch` "disabled" - -- but only for status, ttl and config are the server defaults - config %. "ttl" `shouldMatch` "unlimited" + -- but only for status, config is the server defaults config %. "config.useSFTForOneToOneCalls" `shouldMatch` False do void $ I.deleteFeatureForUser bob featureName >>= getBody 200 features <- getFeaturesForUser bob >>= getJSON 200 config <- features %. featureName config %. "status" `shouldMatch` "enabled" - config %. "ttl" `shouldMatch` "unlimited" config %. "config.useSFTForOneToOneCalls" `shouldMatch` False From 1eab35ee61bddb9e52027d07446a71d923bf21d7 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Tue, 30 Jul 2024 09:54:36 +0200 Subject: [PATCH 32/43] Add CHANGELOG entry about TTL --- changelog.d/1-api-changes/ttl | 1 + changelog.d/1-api-changes/wpb-10235 | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) create mode 100644 changelog.d/1-api-changes/ttl diff --git a/changelog.d/1-api-changes/ttl b/changelog.d/1-api-changes/ttl new file mode 100644 index 00000000000..5a9d4711e68 --- /dev/null +++ b/changelog.d/1-api-changes/ttl @@ -0,0 +1 @@ +Remove the ability to set the TTL of a feature flag. Existing TTLs are still retrieved and returned as before. Note that this only applies to the conferenceCalling feature, as none of the others supported TTL anyway. diff --git a/changelog.d/1-api-changes/wpb-10235 b/changelog.d/1-api-changes/wpb-10235 index 6940f53c09a..0dce921d998 100644 --- a/changelog.d/1-api-changes/wpb-10235 +++ b/changelog.d/1-api-changes/wpb-10235 @@ -1 +1 @@ -Adds useSFTForOneToOneCalls as a config option for the Conference Calling feature flag and made lock status explicit. +Add useSFTForOneToOneCalls as a config option for the Conference Calling feature flag and make its lock status explicit. From c6f4e2d95c1077e6dda94c64060aa4db645b02b2 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 08:27:28 +0200 Subject: [PATCH 33/43] Add note about unsettable features --- libs/wire-api/src/Wire/API/Team/Feature.hs | 36 +++++++++++++++------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index 961dd18d0ed..f2e7ee3407f 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -278,6 +278,24 @@ data DbFeatureWithLock cfg = DbFeatureWithLock ---------------------------------------------------------------------- -- WithStatus +-- [Note: unsettable features] +-- +-- Some feature flags (e.g. sso) don't have a lock status stored in the +-- database. Instead, they are considered unlocked by default, but behave as if +-- they were locked, since they lack a public PUT endpoint. +-- +-- This trick has caused a lot of confusion in the past, and cannot be extended +-- to flags that have non-trivial configuration. For this reason, we are in the +-- process of changing this mechanism to make it work like every other feature. +-- +-- That means that such features will afterwards be toggled by setting their +-- lock status instead. And we'll have some logic in place to make the default +-- status when unlocked be enabled. This achieves a similar behaviour but with +-- fewer exceptional code paths. +-- +-- See the implementation of 'computeFeature' for 'ConferenceCallingConfig' for +-- an example of this mechanism in practice. + -- FUTUREWORK: use lenses, maybe? wsStatus :: WithStatus cfg -> FeatureStatus wsStatus = runIdentity . wsbStatus @@ -392,17 +410,6 @@ instance (Arbitrary cfg, IsFeatureConfig cfg) => Arbitrary (WithStatusPatch cfg) ---------------------------------------------------------------------- -- WithStatusNoLock --- FUTUREWORK(fisx): remove this type. we want all features to have fields `lockStatus` and --- `status`, and we want them to have the same semantics everywhere. currently we have --- eg. conf calling, which was introduced before `lockStatus`, and where `status` means --- `lockStatus`. TTL always refers to `lockStatus`, not `status`. In order to keep current --- (desired) behavior, consider eg. conf calling: let's only allow setting `lockStatus`, but --- if we switch to `unlocked`, we auto-enable the feature, and if we switch to locked, we --- auto-disable it. But we need to change the API to force clients to use `lockStatus` --- instead of `status`, current behavior is just wrong. --- --- FUTUREWORK(paolo): why delete this type? it's used as the request body of --- the public API for setting features data WithStatusNoLock (cfg :: Type) = WithStatusNoLock { wssStatus :: FeatureStatus, wssConfig :: cfg, @@ -672,6 +679,7 @@ instance ToSchema LegalholdConfig where -------------------------------------------------------------------------------- -- SSO feature +-- | This feature does not have a PUT endpoint. See [Note: unsettable features]. data SSOConfig = SSOConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform SSOConfig) @@ -715,6 +723,7 @@ instance HasDeprecatedFeatureName SearchVisibilityAvailableConfig where -------------------------------------------------------------------------------- -- ValidateSAMLEmails feature +-- | This feature does not have a PUT endpoint. See [Note: unsettable features]. data ValidateSAMLEmailsConfig = ValidateSAMLEmailsConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ValidateSAMLEmailsConfig) @@ -737,6 +746,7 @@ instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where -------------------------------------------------------------------------------- -- DigitalSignatures feature +-- | This feature does not have a PUT endpoint. See [Note: unsettable features]. data DigitalSignaturesConfig = DigitalSignaturesConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform DigitalSignaturesConfig) @@ -851,6 +861,9 @@ instance ToSchema SearchVisibilityInboundConfig where ---------------------------------------------------------------------- -- ClassifiedDomains feature +-- | This feature is quite special, in that it does not have any database +-- state. Its value cannot be updated dynamically, and is always set to the +-- server default taken from the backend configuration. data ClassifiedDomainsConfig = ClassifiedDomainsConfig { classifiedDomainsDomains :: [Domain] } @@ -1181,6 +1194,7 @@ instance IsFeatureConfig EnforceFileDownloadLocationConfig where -- months of its introduction, namely once all clients get a chance to adapt to -- a limited event fanout. +-- | This feature does not have a PUT endpoint. See [Note: unsettable features]. data LimitedEventFanoutConfig = LimitedEventFanoutConfig deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform LimitedEventFanoutConfig) From 40ce55172eeac0d4776a1a3a8b331372f4414d66 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 08:29:39 +0200 Subject: [PATCH 34/43] Lint --- libs/wire-api/src/Wire/API/Team/Feature.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index f2e7ee3407f..e24bebcc79b 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -815,7 +815,7 @@ instance ToSchema ConferenceCallingConfig where object "ConferenceCallingConfig" $ ConferenceCallingConfig <$> ((== One2OneCallsSft) . one2OneCalls) - .= ( fromMaybe def . fmap one2OneCallsFromUseSftFlag + .= ( maybe def one2OneCallsFromUseSftFlag <$> optField "useSFTForOneToOneCalls" schema ) From 9c705f95960d5b5081a1d2c7e78c8223e662c040 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 08:30:26 +0200 Subject: [PATCH 35/43] Conference calling flag should be locked by default --- integration/test/API/GalleyInternal.hs | 8 ++++ integration/test/Test/FeatureFlags.hs | 45 ++++++++++++------- integration/test/Test/FeatureFlags/User.hs | 28 +++++++----- integration/test/Test/FeatureFlags/Util.hs | 6 +-- libs/galley-types/src/Galley/Types/Teams.hs | 4 +- .../test/unit/Test/Galley/Types.hs | 2 +- libs/wire-api/src/Wire/API/Team/Feature.hs | 2 +- services/brig/brig.integration.yaml | 5 +++ services/brig/src/Brig/Options.hs | 6 +-- services/galley/galley.integration.yaml | 3 +- .../src/Galley/API/Teams/Features/Get.hs | 2 +- 11 files changed, 72 insertions(+), 39 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index ef0f773d426..de6f5c21c47 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -106,6 +106,14 @@ setTeamFeatureConfig domain team featureName payload = do req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] submit "PUT" $ req & addJSON p +patchTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +patchTeamFeatureConfig domain team featureName payload = do + tid <- asString team + fn <- asString featureName + p <- make payload + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] + submit "PATCH" $ req & addJSON p + -- https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/post_i_features_multi_teams_searchVisibilityInbound getFeatureStatusMulti :: (HasCallStack, MakesValue domain, MakesValue featureName) => domain -> featureName -> [String] -> App Response getFeatureStatusMulti domain featureName tids = do diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index dbf45419264..a0d274b9a2e 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -21,7 +21,6 @@ module Test.FeatureFlags where import qualified API.Galley as Public import qualified API.GalleyInternal as Internal -import Control.Concurrent (threadDelay) import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Reader import qualified Data.Aeson as A @@ -433,8 +432,9 @@ testAllFeatures = do "appLock" .= defEnabledObj (object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60]), "fileSharing" .= enabled, "classifiedDomains" .= defEnabledObj (object ["domains" .= ["example.com"]]), - "conferenceCalling" .= defEnabledObj (object ["useSFTForOneToOneCalls" .= A.Bool False]), - "selfDeletingMessages" .= defEnabledObj (object ["enforcedTimeoutSeconds" .= A.Number 0]), + "conferenceCalling" .= confCalling def {lockStatus = Just "locked"}, + "selfDeletingMessages" + .= defEnabledObj (object ["enforcedTimeoutSeconds" .= A.Number 0]), "conversationGuestLinks" .= enabled, "sndFactorPasswordChallenge" .= disabledLocked, "mls" @@ -791,34 +791,52 @@ testConferenceCalling = do _testLockStatusWithConfig "conferenceCalling" Public.setTeamFeatureConfig - (confCalling def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")}) + (confCalling def {lockStatus = Just "locked"}) (confCalling def {sft = toJSON True}) (confCalling def) (confCalling def {sft = toJSON (0 :: Int)}) testConferenceCallingInternal :: (HasCallStack) => App () testConferenceCallingInternal = do - let defaultArgs = def {lockStatus = Just "unlocked", ttl = Just (toJSON "unlimited")} + let defaultArgs = def {lockStatus = Just "locked"} (owner, tid, m : _) <- createTeam OwnDomain 2 nonTeamMember <- randomUser OwnDomain def assertForbidden =<< Public.getTeamFeature nonTeamMember tid "conferenceCalling" checkFeature "conferenceCalling" m tid (confCalling defaultArgs) - -- should receive an event void $ withWebSocket m $ \ws -> do + -- unlock and enable + assertSuccess =<< Internal.patchTeamFeatureConfig owner tid "conferenceCalling" (object ["status" .= "enabled", "lockStatus" .= "unlocked"]) + do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` "conferenceCalling" + -- TODO: the patch event is currently wrong, and does not reflect the update + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "disabled", lockStatus = Just "locked"}) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs {status = "enabled", lockStatus = Just "unlocked"}) + + -- just disable assertSuccess =<< Internal.setTeamFeatureConfig owner tid "conferenceCalling" (confCalling def {status = "disabled"}) do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` "conferenceCalling" - notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "disabled"}) - checkFeature "conferenceCalling" m tid (confCalling defaultArgs {status = "disabled"}) + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "disabled", lockStatus = Just "unlocked"}) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs {lockStatus = Just "unlocked"}) - assertSuccess =<< Internal.setTeamFeatureConfig owner tid "conferenceCalling" (confCalling def) + -- re-enable + assertSuccess =<< Internal.setTeamFeatureConfig owner tid "conferenceCalling" (confCalling def {status = "enabled"}) do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` "conferenceCalling" - notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs) + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {status = "enabled", lockStatus = Just "unlocked"}) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs {status = "enabled", lockStatus = Just "unlocked"}) + + -- restore initial state + assertSuccess =<< Internal.patchTeamFeatureConfig owner tid "conferenceCalling" (object ["status" .= "disabled", "lockStatus" .= "locked"]) + do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` "conferenceCalling" + notif %. "payload.0.data" `shouldMatch` (confCalling defaultArgs {lockStatus = Just "unlocked"}) checkFeature "conferenceCalling" m tid (confCalling defaultArgs) _testLockStatusWithConfig :: @@ -965,12 +983,7 @@ testPatchAppLock = do testPatchConferenceCalling :: (HasCallStack) => App () testPatchConferenceCalling = do - let defCfg = - confCalling - def - { lockStatus = Just "unlocked", - ttl = Just (toJSON "unlimited") - } + let defCfg = confCalling def {lockStatus = Just "locked"} _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "locked"]) _testPatch "conferenceCalling" True defCfg (object ["status" .= "disabled"]) _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) diff --git a/integration/test/Test/FeatureFlags/User.hs b/integration/test/Test/FeatureFlags/User.hs index fc16ad04017..6aaf02ef1ea 100644 --- a/integration/test/Test/FeatureFlags/User.hs +++ b/integration/test/Test/FeatureFlags/User.hs @@ -4,7 +4,6 @@ import qualified API.BrigInternal as I import API.Galley import qualified API.GalleyInternal as I import SetupHelpers -import Test.FeatureFlags.Util import Testlib.Prelude testFeatureConferenceCallingForUser :: App () @@ -14,17 +13,26 @@ testFeatureConferenceCallingForUser = do let featureName = "conferenceCalling" -- set initial value at the team level - let initial = - confCalling - def - { status = "enabled", - sft = toJSON True - } - assertSuccess =<< I.setTeamFeatureConfig OwnDomain tid featureName initial + let patch = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "config" .= object ["useSFTForOneToOneCalls" .= True] + ] + + assertSuccess =<< I.patchTeamFeatureConfig OwnDomain tid featureName patch -- set user value for both users for_ [alice, bob] $ \u -> do - void $ I.putFeatureForUser u featureName (object ["status" .= "disabled"]) >>= getBody 200 + void + $ I.putFeatureForUser + u + featureName + ( object + [ "status" .= "disabled" + ] + ) + >>= getBody 200 config <- I.getFeatureForUser u featureName >>= getJSON 200 config %. "status" `shouldMatch` "disabled" @@ -59,5 +67,5 @@ testFeatureConferenceCallingForUser = do void $ I.deleteFeatureForUser bob featureName >>= getBody 200 features <- getFeaturesForUser bob >>= getJSON 200 config <- features %. featureName - config %. "status" `shouldMatch` "enabled" + config %. "status" `shouldMatch` "disabled" config %. "config.useSFTForOneToOneCalls" `shouldMatch` False diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index 1624f908a8f..ddcfbdac758 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -95,7 +95,6 @@ assertForbidden = assertLabel 403 "no-team-member" data ConfCalling = ConfCalling { lockStatus :: Maybe String, - ttl :: Maybe Value, status :: String, sft :: Value } @@ -104,8 +103,7 @@ instance Default ConfCalling where def = ConfCalling { lockStatus = Nothing, - ttl = Nothing, - status = "enabled", + status = "disabled", sft = toJSON False } @@ -113,7 +111,7 @@ confCalling :: ConfCalling -> Value confCalling args = object $ ["lockStatus" .= s | s <- toList args.lockStatus] - <> ["ttl" .= s | s <- toList args.ttl] + <> ["ttl" .= "unlimited"] <> [ "status" .= args.status, "config" .= object ["useSFTForOneToOneCalls" .= args.sft] diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 6dbba074972..631c715b179 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -85,7 +85,7 @@ data FeatureFlags = FeatureFlags _flagAppLockDefaults :: !(Defaults (ImplicitLockStatus AppLockConfig)), _flagClassifiedDomains :: !(ImplicitLockStatus ClassifiedDomainsConfig), _flagFileSharing :: !(Defaults (WithStatus FileSharingConfig)), - _flagConferenceCalling :: !(Defaults (ImplicitLockStatus ConferenceCallingConfig)), + _flagConferenceCalling :: !(Defaults (WithStatus ConferenceCallingConfig)), _flagSelfDeletingMessages :: !(Defaults (WithStatus SelfDeletingMessagesConfig)), _flagConversationGuestLinks :: !(Defaults (WithStatus GuestLinksConfig)), _flagsTeamFeatureValidateSAMLEmailsStatus :: !(Defaults (ImplicitLockStatus ValidateSAMLEmailsConfig)), @@ -139,7 +139,7 @@ instance FromJSON FeatureFlags where <*> withImplicitLockStatusOrDefault obj "appLock" <*> (fromMaybe (ImplicitLockStatus (defFeatureStatus @ClassifiedDomainsConfig)) <$> (obj .:? "classifiedDomains")) <*> (fromMaybe (Defaults (defFeatureStatus @FileSharingConfig)) <$> (obj .:? "fileSharing")) - <*> withImplicitLockStatusOrDefault obj "conferenceCalling" + <*> (fromMaybe (Defaults (defFeatureStatus @ConferenceCallingConfig)) <$> (obj .:? "conferenceCalling")) <*> (fromMaybe (Defaults (defFeatureStatus @SelfDeletingMessagesConfig)) <$> (obj .:? "selfDeletingMessages")) <*> (fromMaybe (Defaults (defFeatureStatus @GuestLinksConfig)) <$> (obj .:? "conversationGuestLinks")) <*> withImplicitLockStatusOrDefault obj "validateSAMLEmails" diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs index aa2c03a1411..e9f33059fce 100644 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ b/libs/galley-types/test/unit/Test/Galley/Types.hs @@ -42,7 +42,7 @@ instance Arbitrary FeatureFlags where <*> fmap (fmap unlocked) arbitrary <*> fmap unlocked arbitrary <*> arbitrary - <*> fmap (fmap unlocked) arbitrary + <*> arbitrary <*> arbitrary <*> arbitrary <*> fmap (fmap unlocked) arbitrary diff --git a/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index e24bebcc79b..f5083f5c87f 100644 --- a/libs/wire-api/src/Wire/API/Team/Feature.hs +++ b/libs/wire-api/src/Wire/API/Team/Feature.hs @@ -806,7 +806,7 @@ instance RenderableSymbol ConferenceCallingConfig where instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked def FeatureTTLUnlimited + defFeatureStatus = withStatus FeatureStatusEnabled LockStatusLocked def FeatureTTLUnlimited featureSingleton = FeatureSingletonConferenceCallingConfig objectSchema = fromMaybe def <$> optField "config" schema diff --git a/services/brig/brig.integration.yaml b/services/brig/brig.integration.yaml index e0c76b082ca..265eca6cfc9 100644 --- a/services/brig/brig.integration.yaml +++ b/services/brig/brig.integration.yaml @@ -198,6 +198,11 @@ optSettings: # Remember to keep it the same in Galley. setFederationDomain: example.com setFeatureFlags: # see #RefConfigOptions in `/docs/reference` + conferenceCalling: + defaultForNew: + status: disabled + defaultForNull: + status: disabled setFederationDomainConfigsUpdateFreq: 1 setFederationStrategy: allowAll setFederationDomainConfigs: diff --git a/services/brig/src/Brig/Options.hs b/services/brig/src/Brig/Options.hs index 96a1c81341b..1222226432e 100644 --- a/services/brig/src/Brig/Options.hs +++ b/services/brig/src/Brig/Options.hs @@ -705,10 +705,10 @@ data AccountFeatureConfigs = AccountFeatureConfigs deriving (Show, Eq, Generic) instance Arbitrary AccountFeatureConfigs where - arbitrary = AccountFeatureConfigs <$> fmap unlocked arbitrary <*> fmap unlocked arbitrary + arbitrary = AccountFeatureConfigs <$> fmap locked arbitrary <*> fmap locked arbitrary where - unlocked :: Public.ImplicitLockStatus a -> Public.ImplicitLockStatus a - unlocked = Public.ImplicitLockStatus . Public.setLockStatus Public.LockStatusUnlocked . Public._unImplicitLockStatus + locked :: Public.ImplicitLockStatus a -> Public.ImplicitLockStatus a + locked = Public.ImplicitLockStatus . Public.setLockStatus Public.LockStatusLocked . Public._unImplicitLockStatus instance FromJSON AccountFeatureConfigs where parseJSON = diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index 465d807cec3..5c025935607 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -81,7 +81,8 @@ settings: lockStatus: unlocked conferenceCalling: defaults: - status: enabled + status: disabled + lockStatus: locked outlookCalIntegration: defaults: status: disabled diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 075cb58fbac..4cec1f5f047 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -485,7 +485,7 @@ instance GetFeatureConfig ConferenceCallingConfig where ) getConfigForServer = - input <&> view (settings . featureFlags . flagConferenceCalling . unDefaults . unImplicitLockStatus) + input <&> view (settings . featureFlags . flagConferenceCalling . unDefaults) getConfigForUser uid = do wsnl <- getAccountConferenceCallingConfigClient uid From 4b5d14085992d9542629b755d968a283dc0fcc3e Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 15:05:47 +0200 Subject: [PATCH 36/43] Make lockStatus field optional in galley's conf It used to be implicit before, now it is a normal flag, so we need to make this field optional to preserve compatibility with older configuration files. --- libs/galley-types/src/Galley/Types/Teams.hs | 18 +++++++++++++++--- services/galley/galley.integration.yaml | 1 - 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 631c715b179..5d39f80d8ad 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -104,9 +104,12 @@ newtype Defaults a = Defaults {_unDefaults :: a} deriving (Eq, Ord, Show, Enum, Bounded, Generic, Functor) deriving newtype (Arbitrary) +parseJSONDefaults :: (Value -> A.Parser a) -> Value -> A.Parser (Defaults a) +parseJSONDefaults p = withObject "default object" $ \ob -> + Defaults <$> A.explicitParseField p ob "defaults" + instance (FromJSON a) => FromJSON (Defaults a) where - parseJSON = withObject "default object" $ \ob -> - Defaults <$> (ob .: "defaults") + parseJSON = parseJSONDefaults parseJSON instance (ToJSON a) => ToJSON (Defaults a) where toJSON (Defaults x) = @@ -139,7 +142,7 @@ instance FromJSON FeatureFlags where <*> withImplicitLockStatusOrDefault obj "appLock" <*> (fromMaybe (ImplicitLockStatus (defFeatureStatus @ClassifiedDomainsConfig)) <$> (obj .:? "classifiedDomains")) <*> (fromMaybe (Defaults (defFeatureStatus @FileSharingConfig)) <$> (obj .:? "fileSharing")) - <*> (fromMaybe (Defaults (defFeatureStatus @ConferenceCallingConfig)) <$> (obj .:? "conferenceCalling")) + <*> A.explicitParseField (parseJSONDefaults parseDefaultLockStatus) obj "conferenceCalling" <*> (fromMaybe (Defaults (defFeatureStatus @SelfDeletingMessagesConfig)) <$> (obj .:? "selfDeletingMessages")) <*> (fromMaybe (Defaults (defFeatureStatus @GuestLinksConfig)) <$> (obj .:? "conversationGuestLinks")) <*> withImplicitLockStatusOrDefault obj "validateSAMLEmails" @@ -152,6 +155,15 @@ instance FromJSON FeatureFlags where <*> (fromMaybe (Defaults (defFeatureStatus @EnforceFileDownloadLocationConfig)) <$> (obj .:? "enforceFileDownloadLocation")) <*> withImplicitLockStatusOrDefault obj "limitedEventFanout" where + parseDefaultLockStatus :: + forall cfg. + (IsFeatureConfig cfg, Schema.ToSchema cfg) => + Value -> + A.Parser (WithStatus cfg) + parseDefaultLockStatus x = + let defLockStatus = wsLockStatus (defFeatureStatus @cfg) + in withLockStatus defLockStatus <$> parseJSON x + withImplicitLockStatusOrDefault :: forall cfg. (IsFeatureConfig cfg, Schema.ToSchema cfg) => Object -> Key -> A.Parser (Defaults (ImplicitLockStatus cfg)) withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus (defFeatureStatus @cfg))) <$> obj .:? fieldName diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index 5c025935607..5ec1487fdb9 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -82,7 +82,6 @@ settings: conferenceCalling: defaults: status: disabled - lockStatus: locked outlookCalIntegration: defaults: status: disabled From 6f49b90ae376e1fe2f6240065af9054237a2f0a4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 15:46:58 +0200 Subject: [PATCH 37/43] Remove unused ToJSON instance --- libs/galley-types/galley-types.cabal | 71 ------------------- libs/galley-types/src/Galley/Types/Teams.hs | 43 ----------- libs/galley-types/test/unit/Main.hs | 28 -------- .../test/unit/Test/Galley/Roundtrip.hs | 36 ---------- .../test/unit/Test/Galley/Types.hs | 59 --------------- 5 files changed, 237 deletions(-) delete mode 100644 libs/galley-types/test/unit/Main.hs delete mode 100644 libs/galley-types/test/unit/Test/Galley/Roundtrip.hs delete mode 100644 libs/galley-types/test/unit/Test/Galley/Types.hs diff --git a/libs/galley-types/galley-types.cabal b/libs/galley-types/galley-types.cabal index 04201486276..f1fae8db830 100644 --- a/libs/galley-types/galley-types.cabal +++ b/libs/galley-types/galley-types.cabal @@ -88,74 +88,3 @@ library , wire-api default-language: GHC2021 - -test-suite galley-types-tests - type: exitcode-stdio-1.0 - main-is: Main.hs - - -- cabal-fmt: expand test - other-modules: - Paths_galley_types - Test.Galley.Roundtrip - Test.Galley.Types - - hs-source-dirs: test/unit - default-extensions: - AllowAmbiguousTypes - BangPatterns - ConstraintKinds - DataKinds - DefaultSignatures - DeriveFunctor - DeriveGeneric - DeriveLift - DeriveTraversable - DerivingStrategies - DerivingVia - DuplicateRecordFields - EmptyCase - FlexibleContexts - FlexibleInstances - FunctionalDependencies - GADTs - InstanceSigs - KindSignatures - LambdaCase - MultiParamTypeClasses - MultiWayIf - NamedFieldPuns - NoImplicitPrelude - OverloadedRecordDot - OverloadedStrings - PackageImports - PatternSynonyms - PolyKinds - QuasiQuotes - RankNTypes - ScopedTypeVariables - StandaloneDeriving - TupleSections - TypeApplications - TypeFamilies - TypeFamilyDependencies - TypeOperators - UndecidableInstances - ViewPatterns - - ghc-options: - -O2 -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates - -Wpartial-fields -fwarn-tabs -optP-Wno-nonportable-include-path - -threaded -with-rtsopts=-N -Wredundant-constraints - -Wunused-packages - - build-depends: - aeson - , base - , galley-types - , imports - , QuickCheck - , tasty - , tasty-quickcheck - , wire-api - - default-language: GHC2021 diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index 5d39f80d8ad..a413fe8ce1a 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -167,49 +167,6 @@ instance FromJSON FeatureFlags where withImplicitLockStatusOrDefault :: forall cfg. (IsFeatureConfig cfg, Schema.ToSchema cfg) => Object -> Key -> A.Parser (Defaults (ImplicitLockStatus cfg)) withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus (defFeatureStatus @cfg))) <$> obj .:? fieldName -instance ToJSON FeatureFlags where - toJSON - ( FeatureFlags - sso - legalhold - searchVisibility - appLock - classifiedDomains - fileSharing - conferenceCalling - selfDeletingMessages - guestLinks - validateSAMLEmails - sndFactorPasswordChallenge - searchVisibilityInbound - mls - outlookCalIntegration - mlsE2EId - mlsMigration - enforceFileDownloadLocation - teamMemberDeletedLimitedEventFanout - ) = - object - [ "sso" .= sso, - "legalhold" .= legalhold, - "teamSearchVisibility" .= searchVisibility, - "appLock" .= appLock, - "classifiedDomains" .= classifiedDomains, - "fileSharing" .= fileSharing, - "conferenceCalling" .= conferenceCalling, - "selfDeletingMessages" .= selfDeletingMessages, - "conversationGuestLinks" .= guestLinks, - "validateSAMLEmails" .= validateSAMLEmails, - "sndFactorPasswordChallenge" .= sndFactorPasswordChallenge, - "searchVisibilityInbound" .= searchVisibilityInbound, - "mls" .= mls, - "outlookCalIntegration" .= outlookCalIntegration, - "mlsE2EId" .= mlsE2EId, - "mlsMigration" .= mlsMigration, - "enforceFileDownloadLocation" .= enforceFileDownloadLocation, - "limitedEventFanout" .= teamMemberDeletedLimitedEventFanout - ] - instance FromJSON FeatureSSO where parseJSON (String "enabled-by-default") = pure FeatureSSOEnabledByDefault parseJSON (String "disabled-by-default") = pure FeatureSSODisabledByDefault diff --git a/libs/galley-types/test/unit/Main.hs b/libs/galley-types/test/unit/Main.hs deleted file mode 100644 index 90b692813d3..00000000000 --- a/libs/galley-types/test/unit/Main.hs +++ /dev/null @@ -1,28 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Main - ( main, - ) -where - -import Imports -import Test.Galley.Types qualified -import Test.Tasty - -main :: IO () -main = defaultMain $ testGroup "Tests" [Test.Galley.Types.tests] diff --git a/libs/galley-types/test/unit/Test/Galley/Roundtrip.hs b/libs/galley-types/test/unit/Test/Galley/Roundtrip.hs deleted file mode 100644 index b9d1fcc8568..00000000000 --- a/libs/galley-types/test/unit/Test/Galley/Roundtrip.hs +++ /dev/null @@ -1,36 +0,0 @@ --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Galley.Roundtrip where - -import Data.Aeson (FromJSON, ToJSON, parseJSON, toJSON) -import Data.Aeson.Types (parseEither) -import Imports -import Test.Tasty (TestTree) -import Test.Tasty.QuickCheck (Arbitrary, counterexample, testProperty, (===)) -import Type.Reflection (typeRep) - -testRoundTrip :: - forall a. - (Arbitrary a, Typeable a, ToJSON a, FromJSON a, Eq a, Show a) => - TestTree -testRoundTrip = testProperty msg trip - where - msg = show (typeRep @a) - trip (v :: a) = - counterexample (show $ toJSON v) $ - Right v === (parseEither parseJSON . toJSON) v diff --git a/libs/galley-types/test/unit/Test/Galley/Types.hs b/libs/galley-types/test/unit/Test/Galley/Types.hs deleted file mode 100644 index e9f33059fce..00000000000 --- a/libs/galley-types/test/unit/Test/Galley/Types.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-incomplete-uni-patterns #-} - --- This file is part of the Wire Server implementation. --- --- Copyright (C) 2022 Wire Swiss GmbH --- --- This program is free software: you can redistribute it and/or modify it under --- the terms of the GNU Affero General Public License as published by the Free --- Software Foundation, either version 3 of the License, or (at your option) any --- later version. --- --- This program is distributed in the hope that it will be useful, but WITHOUT --- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more --- details. --- --- You should have received a copy of the GNU Affero General Public License along --- with this program. If not, see . - -module Test.Galley.Types where - -import Galley.Types.Teams -import Imports -import Test.Galley.Roundtrip (testRoundTrip) -import Test.QuickCheck qualified as QC -import Test.Tasty -import Test.Tasty.QuickCheck -import Wire.API.Team.Feature as Public - -tests :: TestTree -tests = testGroup "Tests" [testRoundTrip @FeatureFlags] - -instance Arbitrary FeatureFlags where - arbitrary = - FeatureFlags - <$> QC.elements [minBound ..] - <*> QC.elements [minBound ..] - <*> QC.elements [minBound ..] - -- the default lock status is implicitly added on deserialization and ignored on serialization, therefore we need to fix it to the default here - -- we will be able to remove this once the lock status is explicitly included in the config - <*> fmap (fmap unlocked) arbitrary - <*> fmap unlocked arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> fmap (fmap unlocked) arbitrary - <*> arbitrary - <*> fmap (fmap unlocked) arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> arbitrary - <*> fmap (fmap unlocked) arbitrary - where - unlocked :: ImplicitLockStatus a -> ImplicitLockStatus a - unlocked = ImplicitLockStatus . Public.setLockStatus Public.LockStatusUnlocked . _unImplicitLockStatus From ae08ff6eca0b967ec4127480bdd8462a8b32c2de Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Wed, 31 Jul 2024 16:27:07 +0200 Subject: [PATCH 38/43] Lint --- libs/galley-types/default.nix | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/libs/galley-types/default.nix b/libs/galley-types/default.nix index 5a6070c01a4..c67ae7c7cb1 100644 --- a/libs/galley-types/default.nix +++ b/libs/galley-types/default.nix @@ -17,8 +17,6 @@ , memory , QuickCheck , schema-profunctor -, tasty -, tasty-quickcheck , text , types-common , utf8-string @@ -48,14 +46,5 @@ mkDerivation { uuid wire-api ]; - testHaskellDepends = [ - aeson - base - imports - QuickCheck - tasty - tasty-quickcheck - wire-api - ]; license = lib.licenses.agpl3Only; } From 8eda3999510dc0bbfe48ad2e885e28856a9629e4 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 1 Aug 2024 08:55:52 +0200 Subject: [PATCH 39/43] Align conferenceCalling setting in CI --- hack/helm_vars/wire-server/values.yaml.gotmpl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/hack/helm_vars/wire-server/values.yaml.gotmpl b/hack/helm_vars/wire-server/values.yaml.gotmpl index 5ca735fe38e..2ed14739f79 100644 --- a/hack/helm_vars/wire-server/values.yaml.gotmpl +++ b/hack/helm_vars/wire-server/values.yaml.gotmpl @@ -115,6 +115,12 @@ brig: setMaxConvSize: 16 # See helmfile for the real value setFederationDomain: integration.example.com + setFeatureFlags: + conferenceCalling: + defaultForNew: + status: disabled + defaultForNull: + status: disabled setFederationStrategy: allowAll setFederationDomainConfigsUpdateFreq: 10 setDisabledAPIVersions: [] @@ -256,6 +262,9 @@ galley: sso: disabled-by-default # this needs to be the default; tests can enable it when needed. legalhold: whitelist-teams-and-implicit-consent teamSearchVisibility: disabled-by-default + conferenceCalling: + defaults: + status: disabled classifiedDomains: status: enabled config: From 515a6b389044a10a545f6e6a1e5752e2c0099038 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Thu, 1 Aug 2024 11:16:06 +0200 Subject: [PATCH 40/43] Fix stern integration tests --- tools/stern/test/integration/API.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/tools/stern/test/integration/API.hs b/tools/stern/test/integration/API.hs index 69b351cabdb..b35aadcf554 100644 --- a/tools/stern/test/integration/API.hs +++ b/tools/stern/test/integration/API.hs @@ -85,7 +85,7 @@ tests s = test s "/teams/:tid/features/validateSamlEmails" $ testFeatureStatus @ValidateSAMLEmailsConfig, test s "/teams/:tid/features/digitalSignatures" $ testFeatureStatus @DigitalSignaturesConfig, test s "/teams/:tid/features/fileSharing" $ testFeatureStatus @FileSharingConfig, - test s "/teams/:tid/features/conference-calling" $ testFeatureStatusOptTtl @ConferenceCallingConfig (Just FeatureTTLUnlimited), + test s "/teams/:tid/features/conference-calling" $ testFeatureStatusOptTtl defConfCalling (Just FeatureTTLUnlimited), test s "/teams/:tid/searchVisibility" $ testFeatureStatus @SearchVisibilityAvailableConfig, test s "/teams/:tid/features/appLock" $ testFeatureConfig @AppLockConfig, test s "/teams/:tid/features/mls" $ testFeatureConfig @MLSConfig, @@ -105,6 +105,9 @@ tests s = -- - `POST /teams/:tid/billing` ] +defConfCalling :: WithStatus ConferenceCallingConfig +defConfCalling = setStatus FeatureStatusDisabled defFeatureStatus + testRudSsoDomainRedirect :: TestM () testRudSsoDomainRedirect = do testGet 1 Nothing @@ -307,7 +310,7 @@ testFeatureStatus :: Show cfg ) => TestM () -testFeatureStatus = testFeatureStatusOptTtl @cfg Nothing +testFeatureStatus = testFeatureStatusOptTtl (defFeatureStatus @cfg) Nothing testFeatureStatusOptTtl :: forall cfg. @@ -318,12 +321,13 @@ testFeatureStatusOptTtl :: Eq cfg, Show cfg ) => + WithStatus cfg -> Maybe FeatureTTL -> TestM () -testFeatureStatusOptTtl mTtl = do +testFeatureStatusOptTtl defValue mTtl = do (_, tid, _) <- createTeamWithNMembers 10 cfg <- getFeatureConfig @cfg tid - liftIO $ cfg @?= defFeatureStatus @cfg + liftIO $ cfg @?= defValue when (wsLockStatus cfg == LockStatusLocked) $ unlockFeature @cfg tid let newStatus = if wsStatus cfg == FeatureStatusEnabled then FeatureStatusDisabled else FeatureStatusEnabled putFeatureStatus @cfg tid newStatus mTtl !!! const 200 === statusCode From 6c6c13323862f57abb67081156bf5cf6c8bfc4bc Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 5 Aug 2024 10:11:15 +0200 Subject: [PATCH 41/43] Update cassandra schema --- cassandra-schema.cql | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cassandra-schema.cql b/cassandra-schema.cql index 11de7fa36fb..fbc45dc57bb 100644 --- a/cassandra-schema.cql +++ b/cassandra-schema.cql @@ -1170,8 +1170,8 @@ CREATE TABLE galley_test.team_features ( app_lock_inactivity_timeout_secs int, app_lock_status int, conference_calling int, - conference_calling_lock_status int, conference_calling_one_to_one int, + conference_calling_status int, digital_signatures int, enforce_file_download_location text, enforce_file_download_location_lock_status int, From 7899f01b19066269919ace389857eff881e50727 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 5 Aug 2024 10:11:26 +0200 Subject: [PATCH 42/43] Use bindResponse in tests --- integration/test/Test/FeatureFlags/User.hs | 55 ++++++++++++---------- 1 file changed, 31 insertions(+), 24 deletions(-) diff --git a/integration/test/Test/FeatureFlags/User.hs b/integration/test/Test/FeatureFlags/User.hs index 6aaf02ef1ea..a6ebffbb25c 100644 --- a/integration/test/Test/FeatureFlags/User.hs +++ b/integration/test/Test/FeatureFlags/User.hs @@ -33,39 +33,46 @@ testFeatureConferenceCallingForUser = do ] ) >>= getBody 200 - config <- I.getFeatureForUser u featureName >>= getJSON 200 - config %. "status" `shouldMatch` "disabled" + I.getFeatureForUser u featureName `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json + config %. "status" `shouldMatch` "disabled" - -- this config is just made up by brig, it does not reflect the actual value - -- that will be returned to the user - config %. "config.useSFTForOneToOneCalls" `shouldMatch` False + -- this config is just made up by brig, it does not reflect the actual value + -- that will be returned to the user + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False -- alice do - features <- getFeaturesForUser alice >>= getJSON 200 - config <- features %. featureName - -- alice is a team user, so her config reflects that of the team - config %. "status" `shouldMatch` "enabled" - config %. "config.useSFTForOneToOneCalls" `shouldMatch` True + getFeaturesForUser alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + + -- alice is a team user, so her config reflects that of the team + config %. "status" `shouldMatch` "enabled" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` True do void $ I.deleteFeatureForUser alice featureName >>= getBody 200 - features <- getFeaturesForUser alice >>= getJSON 200 - config <- features %. featureName - config %. "status" `shouldMatch` "enabled" - config %. "config.useSFTForOneToOneCalls" `shouldMatch` True + getFeaturesForUser alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + config %. "status" `shouldMatch` "enabled" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` True -- bob do - features <- getFeaturesForUser bob >>= getJSON 200 - config <- features %. featureName - -- bob is not in a team, so we get his own personal settings here - config %. "status" `shouldMatch` "disabled" - -- but only for status, config is the server defaults - config %. "config.useSFTForOneToOneCalls" `shouldMatch` False + getFeaturesForUser bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + -- bob is not in a team, so we get his own personal settings here + config %. "status" `shouldMatch` "disabled" + -- but only for status, config is the server defaults + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False do void $ I.deleteFeatureForUser bob featureName >>= getBody 200 - features <- getFeaturesForUser bob >>= getJSON 200 - config <- features %. featureName - config %. "status" `shouldMatch` "disabled" - config %. "config.useSFTForOneToOneCalls" `shouldMatch` False + getFeaturesForUser bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + config %. "status" `shouldMatch` "disabled" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` False From 5f3cdc25bc44107880363beba84641876ed199f8 Mon Sep 17 00:00:00 2001 From: Paolo Capriotti Date: Mon, 5 Aug 2024 10:12:47 +0200 Subject: [PATCH 43/43] Revert default lock status when parsing feature Instead of hardcoding an unlocked status when parsing the conferenceCalling default configuration, set the default in the helm chart. --- charts/galley/values.yaml | 1 + libs/galley-types/src/Galley/Types/Teams.hs | 18 +++--------------- services/galley/galley.integration.yaml | 1 + 3 files changed, 5 insertions(+), 15 deletions(-) diff --git a/charts/galley/values.yaml b/charts/galley/values.yaml index 1d170d39883..f6bda0eb643 100644 --- a/charts/galley/values.yaml +++ b/charts/galley/values.yaml @@ -80,6 +80,7 @@ config: conferenceCalling: defaults: status: enabled + lockStatus: locked conversationGuestLinks: defaults: lockStatus: unlocked diff --git a/libs/galley-types/src/Galley/Types/Teams.hs b/libs/galley-types/src/Galley/Types/Teams.hs index a413fe8ce1a..47ae6d8a516 100644 --- a/libs/galley-types/src/Galley/Types/Teams.hs +++ b/libs/galley-types/src/Galley/Types/Teams.hs @@ -104,12 +104,9 @@ newtype Defaults a = Defaults {_unDefaults :: a} deriving (Eq, Ord, Show, Enum, Bounded, Generic, Functor) deriving newtype (Arbitrary) -parseJSONDefaults :: (Value -> A.Parser a) -> Value -> A.Parser (Defaults a) -parseJSONDefaults p = withObject "default object" $ \ob -> - Defaults <$> A.explicitParseField p ob "defaults" - instance (FromJSON a) => FromJSON (Defaults a) where - parseJSON = parseJSONDefaults parseJSON + parseJSON = withObject "default object" $ \ob -> + Defaults <$> (ob .: "defaults") instance (ToJSON a) => ToJSON (Defaults a) where toJSON (Defaults x) = @@ -142,7 +139,7 @@ instance FromJSON FeatureFlags where <*> withImplicitLockStatusOrDefault obj "appLock" <*> (fromMaybe (ImplicitLockStatus (defFeatureStatus @ClassifiedDomainsConfig)) <$> (obj .:? "classifiedDomains")) <*> (fromMaybe (Defaults (defFeatureStatus @FileSharingConfig)) <$> (obj .:? "fileSharing")) - <*> A.explicitParseField (parseJSONDefaults parseDefaultLockStatus) obj "conferenceCalling" + <*> (fromMaybe (Defaults (defFeatureStatus @ConferenceCallingConfig)) <$> (obj .:? "conferenceCalling")) <*> (fromMaybe (Defaults (defFeatureStatus @SelfDeletingMessagesConfig)) <$> (obj .:? "selfDeletingMessages")) <*> (fromMaybe (Defaults (defFeatureStatus @GuestLinksConfig)) <$> (obj .:? "conversationGuestLinks")) <*> withImplicitLockStatusOrDefault obj "validateSAMLEmails" @@ -155,15 +152,6 @@ instance FromJSON FeatureFlags where <*> (fromMaybe (Defaults (defFeatureStatus @EnforceFileDownloadLocationConfig)) <$> (obj .:? "enforceFileDownloadLocation")) <*> withImplicitLockStatusOrDefault obj "limitedEventFanout" where - parseDefaultLockStatus :: - forall cfg. - (IsFeatureConfig cfg, Schema.ToSchema cfg) => - Value -> - A.Parser (WithStatus cfg) - parseDefaultLockStatus x = - let defLockStatus = wsLockStatus (defFeatureStatus @cfg) - in withLockStatus defLockStatus <$> parseJSON x - withImplicitLockStatusOrDefault :: forall cfg. (IsFeatureConfig cfg, Schema.ToSchema cfg) => Object -> Key -> A.Parser (Defaults (ImplicitLockStatus cfg)) withImplicitLockStatusOrDefault obj fieldName = fromMaybe (Defaults (ImplicitLockStatus (defFeatureStatus @cfg))) <$> obj .:? fieldName diff --git a/services/galley/galley.integration.yaml b/services/galley/galley.integration.yaml index 5ec1487fdb9..5c025935607 100644 --- a/services/galley/galley.integration.yaml +++ b/services/galley/galley.integration.yaml @@ -82,6 +82,7 @@ settings: conferenceCalling: defaults: status: disabled + lockStatus: locked outlookCalIntegration: defaults: status: disabled