diff --git a/cassandra-schema.cql b/cassandra-schema.cql index f34be3f2041..fbc45dc57bb 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_one_to_one int, + conference_calling_status int, digital_signatures int, enforce_file_download_location text, enforce_file_download_location_lock_status int, 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 new file mode 100644 index 00000000000..0dce921d998 --- /dev/null +++ b/changelog.d/1-api-changes/wpb-10235 @@ -0,0 +1 @@ +Add useSFTForOneToOneCalls as a config option for the Conference Calling feature flag and make its lock status explicit. 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/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: 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/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 e0943931f9e..a0d274b9a2e 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 @@ -19,14 +21,12 @@ 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 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 +295,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 +310,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 +373,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 @@ -424,18 +420,21 @@ 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" .= confCalling def {lockStatus = Just "locked"}, + "selfDeletingMessages" + .= defEnabledObj (object ["enforcedTimeoutSeconds" .= A.Number 0]), "conversationGuestLinks" .= enabled, "sndFactorPasswordChallenge" .= disabledLocked, "mls" @@ -787,6 +786,59 @@ testMLSE2EIdInternal = do cfg2 invalidCfg' +testConferenceCalling :: (HasCallStack) => App () +testConferenceCalling = do + _testLockStatusWithConfig + "conferenceCalling" + Public.setTeamFeatureConfig + (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 "locked"} + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid "conferenceCalling" + checkFeature "conferenceCalling" m tid (confCalling defaultArgs) + + 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", lockStatus = Just "unlocked"}) + checkFeature "conferenceCalling" m tid (confCalling defaultArgs {lockStatus = Just "unlocked"}) + + -- 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 {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 :: (HasCallStack) => String -> @@ -835,15 +887,18 @@ _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" - 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") @@ -851,18 +906,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") @@ -879,64 +933,6 @@ 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 - -testConferenceCallingTTLIncrease :: (HasCallStack) => App () -testConferenceCallingTTLIncrease = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) (Just 4) - -testConferenceCallingTTLReduceFromUnlimited :: (HasCallStack) => App () -testConferenceCallingTTLReduceFromUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing (Just 2) - -testConferenceCallingTTLReduce :: (HasCallStack) => App () -testConferenceCallingTTLReduce = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 5) (Just 2) - -testConferenceCallingTTLUnlimitedToUnlimited :: (HasCallStack) => App () -testConferenceCallingTTLUnlimitedToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing Nothing - -_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 - -------------------------------------------------------------------------------- -- Simple flags with implicit lock status @@ -949,9 +945,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 @@ -988,6 +981,14 @@ testPatchAppLock = do -------------------------------------------------------------------------------- -- Flags with config & explicit lock status +testPatchConferenceCalling :: (HasCallStack) => App () +testPatchConferenceCalling = do + 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"]) + _testPatch "conferenceCalling" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["useSFTForOneToOneCalls" .= toJSON True]]) + testPatchSelfDeletingMessages :: (HasCallStack) => App () testPatchSelfDeletingMessages = do let defCfg = diff --git a/integration/test/Test/FeatureFlags/User.hs b/integration/test/Test/FeatureFlags/User.hs new file mode 100644 index 00000000000..a6ebffbb25c --- /dev/null +++ b/integration/test/Test/FeatureFlags/User.hs @@ -0,0 +1,78 @@ +module Test.FeatureFlags.User where + +import qualified API.BrigInternal as I +import API.Galley +import qualified API.GalleyInternal as I +import SetupHelpers +import Testlib.Prelude + +testFeatureConferenceCallingForUser :: App () +testFeatureConferenceCallingForUser = do + (alice, tid, _) <- createTeam OwnDomain 0 -- team user + bob <- randomUser OwnDomain def -- non-team user + let featureName = "conferenceCalling" + + -- set initial value at the team level + 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 + 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 + + -- alice + do + 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 + getFeaturesForUser alice `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + config %. "status" `shouldMatch` "enabled" + config %. "config.useSFTForOneToOneCalls" `shouldMatch` True + + -- bob + do + 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 + getFeaturesForUser bob `bindResponse` \resp -> do + resp.status `shouldMatchInt` 200 + config <- resp.json %. featureName + 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 92426fd5f4f..ddcfbdac758 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 @@ -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 @@ -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,31 @@ 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, + status :: String, + sft :: Value + } + +instance Default ConfCalling where + def = + ConfCalling + { lockStatus = Nothing, + status = "disabled", + sft = toJSON False + } + +confCalling :: ConfCalling -> Value +confCalling args = + object + $ ["lockStatus" .= s | s <- toList args.lockStatus] + <> ["ttl" .= "unlimited"] + <> [ "status" .= args.status, + "config" + .= object ["useSFTForOneToOneCalls" .= args.sft] + ] 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; } 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 6dbba074972..47ae6d8a516 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" @@ -155,49 +155,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 aa2c03a1411..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 - <*> fmap (fmap unlocked) 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 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/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/libs/wire-api/src/Wire/API/Team/Feature.hs b/libs/wire-api/src/Wire/API/Team/Feature.hs index c9f24b7b158..f5083f5c87f 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 #-} @@ -25,6 +26,13 @@ module Wire.API.Team.Feature featureName, featureNameBS, LockStatus (..), + WithStatusBase (..), + DbFeature (..), + DbFeatureWithLock (..), + dbFeatureStatus, + dbFeatureTTL, + dbFeatureConfig, + dbFeatureModConfig, WithStatus, withStatus, withStatus', @@ -39,6 +47,7 @@ module Wire.API.Team.Feature setTTL, setWsTTL, WithStatusPatch, + wsPatch, wspStatus, wspLockStatus, wspConfig, @@ -54,12 +63,13 @@ module Wire.API.Team.Feature convertFeatureTTLDaysToSeconds, EnforceAppLock (..), defFeatureStatusNoLock, + genericComputeFeature, computeFeatureConfigForTeamUser, IsFeatureConfig (..), FeatureSingleton (..), - FeatureTrivialConfig (..), HasDeprecatedFeatureName (..), LockStatusResponse (..), + One2OneCalls (..), -- Features LegalholdConfig (..), SSOConfig (..), @@ -81,7 +91,8 @@ module Wire.API.Team.Feature MlsMigrationConfig (..), EnforceFileDownloadLocationConfig (..), LimitedEventFanoutConfig (..), - AllFeatureConfigs (..), + AllFeatures (..), + AllFeatureConfigs, unImplicitLockStatus, ImplicitLockStatus (..), ) @@ -133,8 +144,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'. -- @@ -215,9 +225,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 @@ -238,9 +245,57 @@ 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 +-- [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 @@ -275,7 +330,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) @@ -317,6 +372,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 @@ -352,14 +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. data WithStatusNoLock (cfg :: Type) = WithStatusNoLock { wssStatus :: FeatureStatus, wssConfig :: cfg, @@ -561,6 +611,19 @@ 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 -> + Maybe LockStatus -> + DbFeature cfg -> + WithStatus cfg +genericComputeFeature defFeature lockStatus dbFeature = + case fromMaybe (wsLockStatus defFeature) lockStatus of + LockStatusLocked -> setLockStatus LockStatusLocked defFeature + 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 computeFeatureConfigForTeamUser mStatusDb mLockStatusDb defStatus = @@ -594,9 +657,6 @@ instance IsFeatureConfig GuestLinksConfig where objectSchema = pure GuestLinksConfig -instance FeatureTrivialConfig GuestLinksConfig where - trivialConfig = GuestLinksConfig - -------------------------------------------------------------------------------- -- Legalhold feature @@ -616,12 +676,10 @@ instance IsFeatureConfig LegalholdConfig where instance ToSchema LegalholdConfig where schema = object "LegalholdConfig" objectSchema -instance FeatureTrivialConfig LegalholdConfig where - trivialConfig = LegalholdConfig - -------------------------------------------------------------------------------- -- 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) @@ -638,9 +696,6 @@ instance IsFeatureConfig SSOConfig where instance ToSchema SSOConfig where schema = object "SSOConfig" objectSchema -instance FeatureTrivialConfig SSOConfig where - trivialConfig = SSOConfig - -------------------------------------------------------------------------------- -- SearchVisibility available feature @@ -662,15 +717,13 @@ 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" -------------------------------------------------------------------------------- -- 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) @@ -690,12 +743,10 @@ instance IsFeatureConfig ValidateSAMLEmailsConfig where instance HasDeprecatedFeatureName ValidateSAMLEmailsConfig where type DeprecatedFeatureName ValidateSAMLEmailsConfig = "validate-saml-emails" -instance FeatureTrivialConfig ValidateSAMLEmailsConfig where - trivialConfig = ValidateSAMLEmailsConfig - -------------------------------------------------------------------------------- -- 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) @@ -715,30 +766,58 @@ instance HasDeprecatedFeatureName DigitalSignaturesConfig where instance ToSchema DigitalSignaturesConfig where schema = object "DigitalSignaturesConfig" objectSchema -instance FeatureTrivialConfig DigitalSignaturesConfig where - trivialConfig = DigitalSignaturesConfig - -------------------------------------------------------------------------------- -- 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 + { one2OneCalls :: One2OneCalls + } deriving stock (Eq, Show, Generic) deriving (Arbitrary) via (GenericUniform ConferenceCallingConfig) +instance Default ConferenceCallingConfig where + def = ConferenceCallingConfig {one2OneCalls = def} + instance RenderableSymbol ConferenceCallingConfig where renderSymbol = "ConferenceCallingConfig" instance IsFeatureConfig ConferenceCallingConfig where type FeatureSymbol ConferenceCallingConfig = "conferenceCalling" - defFeatureStatus = withStatus FeatureStatusEnabled LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited + defFeatureStatus = withStatus FeatureStatusEnabled LockStatusLocked def FeatureTTLUnlimited featureSingleton = FeatureSingletonConferenceCallingConfig - objectSchema = pure ConferenceCallingConfig + objectSchema = fromMaybe def <$> optField "config" schema instance ToSchema ConferenceCallingConfig where - schema = object "ConferenceCallingConfig" objectSchema - -instance FeatureTrivialConfig ConferenceCallingConfig where - trivialConfig = ConferenceCallingConfig + schema = + object "ConferenceCallingConfig" $ + ConferenceCallingConfig + <$> ((== One2OneCallsSft) . one2OneCalls) + .= ( maybe def one2OneCallsFromUseSftFlag + <$> optField "useSFTForOneToOneCalls" schema + ) -------------------------------------------------------------------------------- -- SndFactorPasswordChallenge feature @@ -759,9 +838,6 @@ instance IsFeatureConfig SndFactorPasswordChallengeConfig where featureSingleton = FeatureSingletonSndFactorPasswordChallengeConfig objectSchema = pure SndFactorPasswordChallengeConfig -instance FeatureTrivialConfig SndFactorPasswordChallengeConfig where - trivialConfig = SndFactorPasswordChallengeConfig - -------------------------------------------------------------------------------- -- SearchVisibilityInbound feature @@ -782,12 +858,12 @@ instance IsFeatureConfig SearchVisibilityInboundConfig where instance ToSchema SearchVisibilityInboundConfig where schema = object "SearchVisibilityInboundConfig" objectSchema -instance FeatureTrivialConfig SearchVisibilityInboundConfig where - trivialConfig = SearchVisibilityInboundConfig - ---------------------------------------------------------------------- -- 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] } @@ -877,9 +953,6 @@ instance IsFeatureConfig FileSharingConfig where instance ToSchema FileSharingConfig where schema = object "FileSharingConfig" objectSchema -instance FeatureTrivialConfig FileSharingConfig where - trivialConfig = FileSharingConfig - ---------------------------------------------------------------------- -- SelfDeletingMessagesConfig @@ -969,9 +1042,6 @@ instance IsFeatureConfig ExposeInvitationURLsToTeamAdminConfig where instance ToSchema ExposeInvitationURLsToTeamAdminConfig where schema = object "ExposeInvitationURLsToTeamAdminConfig" objectSchema -instance FeatureTrivialConfig ExposeInvitationURLsToTeamAdminConfig where - trivialConfig = ExposeInvitationURLsToTeamAdminConfig - ---------------------------------------------------------------------- -- OutlookCalIntegrationConfig @@ -993,9 +1063,6 @@ instance IsFeatureConfig OutlookCalIntegrationConfig where instance ToSchema OutlookCalIntegrationConfig where schema = object "OutlookCalIntegrationConfig" objectSchema -instance FeatureTrivialConfig OutlookCalIntegrationConfig where - trivialConfig = OutlookCalIntegrationConfig - ---------------------------------------------------------------------- -- MlsE2EId @@ -1039,7 +1106,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 \ @@ -1127,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) @@ -1143,9 +1211,6 @@ instance IsFeatureConfig LimitedEventFanoutConfig where instance ToSchema LimitedEventFanoutConfig where schema = object "LimitedEventFanoutConfig" objectSchema -instance FeatureTrivialConfig LimitedEventFanoutConfig where - trivialConfig = LimitedEventFanoutConfig - ---------------------------------------------------------------------- -- FeatureStatus @@ -1209,34 +1274,35 @@ 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 +-- FUTUREWORK: rewrite using SOP +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, @@ -1262,7 +1328,7 @@ instance Default AllFeatureConfigs where instance ToSchema AllFeatureConfigs where schema = object "AllFeatureConfigs" $ - AllFeatureConfigs + AllFeatures <$> afcLegalholdStatus .= featureField <*> afcSSOStatus .= featureField <*> afcTeamSearchVisibilityAvailable .= featureField @@ -1292,7 +1358,7 @@ instance ToSchema AllFeatureConfigs where instance Arbitrary AllFeatureConfigs where arbitrary = - AllFeatureConfigs + AllFeatures <$> arbitrary <*> arbitrary <*> arbitrary @@ -1315,3 +1381,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/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/WithStatusNoLock_team.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Generated/WithStatusNoLock_team.hs index e2babe794aa..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 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 d4bb69801a7..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) +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 78523389109..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 +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/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..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,4 +1,7 @@ { "status": "disabled", - "ttl": "unlimited" + "ttl": "unlimited", + "config": { + "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..648c75ec1cd 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,8 @@ { "lockStatus": "unlocked", "status": "disabled", - "ttl": "unlimited" + "ttl": "unlimited", + "config": { + "useSFTForOneToOneCalls": false + } } 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/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/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/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index f3b65f6b37c..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 @@ -57,9 +49,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,76 +84,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 - - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusEnabled ApiFt.ConferenceCallingConfig ApiFt.FeatureTTLUnlimited - check $ ApiFt.WithStatusNoLock ApiFt.FeatureStatusDisabled ApiFt.ConferenceCallingConfig ApiFt.FeatureTTLUnlimited - check' - testGetMlsClients :: Brig -> Http () testGetMlsClients brig = do qusr <- userQualifiedId <$> randomUser brig @@ -198,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 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/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/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/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs index 6fbc8f3bfd6..c7052c2d8bc 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, @@ -28,14 +29,14 @@ 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 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,23 @@ assertLegalHoldEnabledForTeam tid = unlessM (isLegalHoldEnabledForTeam tid) $ throwS @'LegalHoldNotEnabled +computeLegalHoldFeatureStatus :: + ( Member TeamStore r, + Member LegalHoldStore r + ) => + TeamId -> + DbFeature LegalholdConfig -> + Sem r FeatureStatus +computeLegalHoldFeatureStatus tid dbFeature = + getLegalHoldFlag >>= \case + FeatureLegalHoldDisabledPermanently -> pure FeatureStatusDisabled + FeatureLegalHoldDisabledByDefault -> + pure . wssStatus $ + unDbFeature dbFeature defFeatureStatusNoLock + FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do + wl <- LegalHoldData.isTeamLegalholdWhitelisted tid + pure $ if wl then FeatureStatusEnabled else FeatureStatusDisabled + isLegalHoldEnabledForTeam :: forall r. ( Member LegalHoldStore r, @@ -60,18 +78,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 + dbFeature <- getFeatureConfig FeatureSingletonLegalholdConfig tid + status <- computeLegalHoldFeatureStatus tid dbFeature + pure $ status == FeatureStatusEnabled ensureNotTooLargeToActivateLegalHold :: ( Member BrigAccess r, 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) 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.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 685266b3ea1..4cec1f5f047 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 @@ -23,6 +25,7 @@ module Galley.API.Teams.Features.Get getAllFeatureConfigsForTeam, getAllFeatureConfigsForUser, GetFeatureConfig (..), + getConfigForTeam, guardSecondFactorDisabled, DoAuth (..), featureEnabledForTeam, @@ -35,7 +38,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 +60,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 +71,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 +83,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 +92,39 @@ 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 -> + Maybe LockStatus -> + DbFeature cfg -> + Sem r (WithStatus cfg) + default computeFeature :: + TeamId -> + WithStatus cfg -> + Maybe LockStatus -> + DbFeature cfg -> + Sem r (WithStatus cfg) + computeFeature _tid defFeature lockStatus dbFeature = + pure $ + genericComputeFeature @cfg defFeature lockStatus 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 -> @@ -134,13 +140,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 @@ -153,11 +160,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 -> @@ -193,13 +202,15 @@ getAllFeatureConfigsForUser zusr = do maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership case mbTeam of Just tid -> - TeamFeatures.getAllFeatureConfigs tid + getAllFeatureConfigs tid Nothing -> getAllFeatureConfigsUser zusr getAllFeatureConfigsForTeam :: forall r. - ( Member (ErrorS 'NotATeamMember) r, + ( Member (Input Opts) r, + Member (ErrorS 'NotATeamMember) r, + Member LegalHoldStore r, Member TeamFeatureStore r, Member TeamStore r ) => @@ -209,14 +220,73 @@ getAllFeatureConfigsForTeam :: getAllFeatureConfigsForTeam luid tid = do zusrMembership <- getTeamMember tid (tUnqualified luid) maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership - TeamFeatures.getAllFeatureConfigs tid + getAllFeatureConfigs tid + +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 + 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. (Member (Input Opts) r) => Sem r AllFeatureConfigs getAllFeatureConfigsForServer = - AllFeatureConfigs + AllFeatures <$> getConfigForServer @LegalholdConfig <*> getConfigForServer @SSOConfig <*> getConfigForServer @SearchVisibilityAvailableConfig @@ -252,7 +322,7 @@ getAllFeatureConfigsUser :: UserId -> Sem r AllFeatureConfigs getAllFeatureConfigsUser uid = - AllFeatureConfigs + AllFeatures <$> getConfigForUser @LegalholdConfig uid <*> getConfigForUser @SSOConfig uid <*> getConfigForUser @SearchVisibilityAvailableConfig uid @@ -274,32 +344,41 @@ 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 + computeFeature @cfg + tid + defFeature + lockStatus + dbFeature -- 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 + 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 genericGetConfigForUser :: @@ -309,7 +388,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) @@ -322,7 +402,7 @@ genericGetConfigForUser uid = do zusrMembership <- getTeamMember tid uid maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership assertTeamExists tid - genericGetConfigForTeam tid + getConfigForTeam tid ------------------------------------------------------------------------------- -- GetFeatureConfig instances @@ -352,13 +432,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, @@ -369,13 +442,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 _lockStatus dbFeature = do + status <- computeLegalHoldFeatureStatus tid dbFeature + pure $ setStatus status defFeature instance GetFeatureConfig FileSharingConfig where getConfigForServer = @@ -389,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 = @@ -402,12 +485,22 @@ instance GetFeatureConfig ConferenceCallingConfig where ) getConfigForServer = - input <&> view (settings . featureFlags . flagConferenceCalling . unDefaults . unImplicitLockStatus) + input <&> view (settings . featureFlags . flagConferenceCalling . unDefaults) getConfigForUser uid = do 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) @@ -429,26 +522,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 _lockStatus 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 (Just lockStatus) dbFeature instance GetFeatureConfig OutlookCalIntegrationConfig where getConfigForServer = @@ -506,13 +589,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 diff --git a/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs b/services/galley/src/Galley/Cassandra/GetAllTeamFeatureConfigs.hs index 282e9d916c2..c55808c7823 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 @@ -40,6 +39,8 @@ data AllTeamFeatureConfigsRow = AllTeamFeatureConfigsRow -- conference calling conferenceCalling :: Maybe FeatureStatus, conferenceCallingTtl :: Maybe FeatureTTL, + conferenceCallingOne2One :: Maybe One2OneCalls, + conferenceCallingLock :: Maybe LockStatus, -- guest links guestLinks :: Maybe FeatureStatus, guestLinksLock :: Maybe LockStatus, @@ -100,6 +101,8 @@ emptyRow = selfDeletingMessagesLock = Nothing, conferenceCalling = Nothing, conferenceCallingTtl = Nothing, + conferenceCallingOne2One = Nothing, + conferenceCallingLock = Nothing, guestLinks = Nothing, guestLinksLock = Nothing, sndFactor = Nothing, @@ -130,227 +133,80 @@ 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 = - AllFeatureConfigs - { 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, +allFeatureConfigsFromRow :: AllTeamFeatureConfigsRow -> AllFeatures DbFeatureWithLock +allFeatureConfigsFromRow row = + AllFeatures + { 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 = - computeConfig - row.appLock + mkFeatureWithLock Nothing - FeatureTTLUnlimited - appLockConfig - serverConfigs.afcAppLock, - afcFileSharing = - computeConfig - row.fileSharing - row.fileSharingLock - FeatureTTLUnlimited - (Just FileSharingConfig) - serverConfigs.afcFileSharing, - afcClassifiedDomains = - computeConfig Nothing Nothing FeatureTTLUnlimited Nothing serverConfigs.afcClassifiedDomains, + (row.appLock, row.appLockEnforce, row.appLockInactivityTimeoutSecs), + afcFileSharing = mkFeatureWithLock row.fileSharingLock row.fileSharing, + afcClassifiedDomains = mkFeatureWithLock Nothing Nothing, afcConferenceCalling = - computeConfig - row.conferenceCalling - Nothing - (fromMaybe FeatureTTLUnlimited row.conferenceCallingTtl) - (Just ConferenceCallingConfig) - serverConfigs.afcConferenceCalling, + mkFeatureWithLock + row.conferenceCallingLock + ( row.conferenceCalling, + row.conferenceCallingTtl, + row.conferenceCallingOne2One + ), afcSelfDeletingMessages = - computeConfig - row.selfDeletingMessages + mkFeatureWithLock row.selfDeletingMessagesLock - FeatureTTLUnlimited - selfDeletingMessagesConfig - serverConfigs.afcSelfDeletingMessages, - afcGuestLink = - computeConfig - row.guestLinks - row.guestLinksLock - FeatureTTLUnlimited - (Just GuestLinksConfig) - serverConfigs.afcGuestLink, - afcSndFactorPasswordChallenge = - computeConfig - row.sndFactor - row.sndFactorLock - FeatureTTLUnlimited - (Just SndFactorPasswordChallengeConfig) - serverConfigs.afcSndFactorPasswordChallenge, + ( row.selfDeletingMessages, + row.selfDeletingMessagesTtl + ), + afcGuestLink = mkFeatureWithLock row.guestLinksLock row.guestLinks, + afcSndFactorPasswordChallenge = mkFeatureWithLock row.sndFactorLock row.sndFactor, afcMLS = - computeConfig - row.mls + mkFeatureWithLock row.mlsLock - FeatureTTLUnlimited - mlsConfig - serverConfigs.afcMLS, - afcExposeInvitationURLsToTeamAdmin = exposeInvitationURLsComputeFeatureStatus row.exposeInvitationUrls, + ( row.mls, + row.mlsDefaultProtocol, + row.mlsToggleUsers, + row.mlsAllowedCipherSuites, + row.mlsDefaultCipherSuite, + row.mlsSupportedProtocols + ), + afcExposeInvitationURLsToTeamAdmin = mkFeatureWithLock Nothing row.exposeInvitationUrls, afcOutlookCalIntegration = - computeConfig - row.outlookCalIntegration + mkFeatureWithLock row.outlookCalIntegrationLock - FeatureTTLUnlimited - (Just OutlookCalIntegrationConfig) - serverConfigs.afcOutlookCalIntegration, + row.outlookCalIntegration, afcMlsE2EId = - computeConfig - row.mlsE2eid + mkFeatureWithLock row.mlsE2eidLock - FeatureTTLUnlimited - mlsE2eidConfig - serverConfigs.afcMlsE2EId, + ( row.mlsE2eid, + row.mlsE2eidGracePeriod, + row.mlsE2eidAcmeDiscoverUrl, + row.mlsE2eidMaybeCrlProxy, + row.mlsE2eidMaybeUseProxyOnMobile + ), afcMlsMigration = - computeConfig - row.mlsMigration + mkFeatureWithLock row.mlsMigrationLock - FeatureTTLUnlimited - mlsMigrationConfig - serverConfigs.afcMlsMigration, + ( row.mlsMigration, + row.mlsMigrationStartTime, + row.mlsMigrationFinalizeRegardlessAfter + ), afcEnforceFileDownloadLocation = - computeConfig - row.enforceDownloadLocation + mkFeatureWithLock row.enforceDownloadLocationLock - FeatureTTLUnlimited - downloadLocationConfig - serverConfigs.afcEnforceFileDownloadLocation, - afcLimitedEventFanout = - computeConfig - row.limitEventFanout - Nothing - FeatureTTLUnlimited - (Just LimitedEventFanoutConfig) - serverConfigs.afcLimitedEventFanout + ( row.enforceDownloadLocation, + row.enforceDownloadLocation_Location + ), + afcLimitedEventFanout = mkFeatureWithLock Nothing row.limitEventFanout } - 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) -> - 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 - - -- 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 - -getAllFeatureConfigs :: (MonadClient m) => Maybe [TeamId] -> FeatureLegalHold -> Bool -> AllFeatureConfigs -> TeamId -> m AllFeatureConfigs -getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitLegalhold serverConfigs tid = do + +getAllFeatureConfigs :: (MonadClient m) => TeamId -> m (AllFeatures DbFeatureWithLock) +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 @@ -367,7 +223,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_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, \ \\ @@ -384,3 +240,161 @@ getAllFeatureConfigs allowListForExposeInvitationURLs featureLH hasTeamImplicitL \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) -> DbFeature cfg + default mkFeature :: + (FeatureRow cfg ~ Identity (Maybe FeatureStatus)) => + RowType (FeatureRow cfg) -> + DbFeature cfg + mkFeature = foldMap dbFeatureStatus + +mkFeatureWithLock :: + (MakeFeature cfg) => + Maybe LockStatus -> + RowType (FeatureRow cfg) -> + 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 + 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) = + foldMap dbFeatureStatus status + <> foldMap dbFeatureConfig (AppLockConfig <$> enforce <*> timeout) + +instance MakeFeature FileSharingConfig + +instance MakeFeature ClassifiedDomainsConfig + +instance MakeFeature ConferenceCallingConfig where + type FeatureRow ConferenceCallingConfig = (Maybe FeatureStatus, Maybe FeatureTTL, Maybe One2OneCalls) + + mkFeature (status, ttl, 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) = + foldMap dbFeatureStatus status + <> foldMap (dbFeatureConfig . 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) = + foldMap dbFeatureStatus status + <> foldMap + dbFeatureConfig + ( MLSConfig (foldMap C.fromSet toggleUsers) + <$> defProto + <*> pure (foldMap C.fromSet ciphersuites) + <*> defCiphersuite + <*> pure (foldMap C.fromSet supportedProtos) + ) + +instance MakeFeature MlsE2EIdConfig where + type + FeatureRow MlsE2EIdConfig = + ( Maybe FeatureStatus, + Maybe Int32, + Maybe HttpsUrl, + Maybe HttpsUrl, + Maybe Bool + ) + + mkFeature (status, gracePeriod, acmeDiscoveryUrl, crlProxy, useProxyOnMobile) = + foldMap dbFeatureStatus status + <> dbFeatureModConfig + ( \defCfg -> + defCfg + { verificationExpiration = + maybe defCfg.verificationExpiration fromIntegral gracePeriod, + acmeDiscoveryUrl = acmeDiscoveryUrl, + crlProxy = crlProxy, + useProxyOnMobile = fromMaybe defCfg.useProxyOnMobile useProxyOnMobile + } + ) + +instance MakeFeature MlsMigrationConfig where + type + FeatureRow MlsMigrationConfig = + ( Maybe FeatureStatus, + Maybe UTCTime, + Maybe UTCTime + ) + + mkFeature (status, startTime, finalizeAfter) = + foldMap dbFeatureStatus status + <> dbFeatureConfig (MlsMigrationConfig startTime finalizeAfter) + +instance MakeFeature EnforceFileDownloadLocationConfig where + type FeatureRow EnforceFileDownloadLocationConfig = (Maybe FeatureStatus, Maybe Text) + + mkFeature (status, 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 618b242efaf..a751060e668 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 @@ -33,10 +32,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 +45,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,153 +67,56 @@ 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 -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) -> - Just - . forgetLock - . setStatus status - . setWsTTL (fromMaybe FeatureTTLUnlimited mTtl) - $ defFeatureStatus - where - select :: PrepQuery R (Identity TeamId) (Maybe FeatureStatus, Maybe FeatureTTL) - select = - fromString $ - "select conference_calling, ttl(conference_calling) from team_features where team_id = ?" -getFeatureConfig FeatureSingletonGuestLinksConfig tid = getTrivialConfigC "guest_links_status" tid -getFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid = getTrivialConfigC "snd_factor_password_challenge_status" tid -getFeatureConfig FeatureSingletonSearchVisibilityInboundConfig tid = getTrivialConfigC "search_visibility_status" tid -getFeatureConfig FeatureSingletonMLSConfig tid = do - m <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) - pure $ case m of - Nothing -> Nothing - Just (status, defaultProtocol, protocolToggleUsers, allowedCipherSuites, defaultCipherSuite, 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 (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 mempty +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_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 +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) @@ -250,18 +146,17 @@ 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, wssStatus statusNoLock)) +setFeatureConfig FeatureSingletonConferenceCallingConfig tid statusNoLock = do + retry x5 . batch $ do + setType BatchLogged + setConsistency LocalQuorum + addPrepQuery insertStatus (tid, statusNoLock.wssStatus) + addPrepQuery insertConfig (tid, statusNoLock.wssConfig.one2OneCalls) where - renderFeatureTtl :: FeatureTTL -> String - renderFeatureTtl = \case - FeatureTTLSeconds d | d > 0 -> " using ttl " <> show d - _ -> " using ttl 0" -- 0 or unlimited (delete a column's existing TTL by setting its value to zero) - insert :: PrepQuery W (TeamId, FeatureStatus) () - insert = - fromString $ - "insert into team_features (team_id,conference_calling) values (?, ?)" - <> renderFeatureTtl (wssTTL statusNoLock) + 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) setFeatureConfig FeatureSingletonSndFactorPasswordChallengeConfig tid statusNoLock = setFeatureStatusC "snd_factor_password_challenge_status" tid (wssStatus statusNoLock) @@ -332,6 +227,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" tid getFeatureLockStatus _ _ = pure Nothing setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockStatus -> m () @@ -344,26 +240,24 @@ 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" 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 (DbFeature cfg) +getFeature columns tid = do + row <- retry x1 $ query1 select (params LocalQuorum (Identity tid)) + pure $ foldMap (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 :: @@ -417,6 +311,6 @@ getFeatureConfigMulti :: (MonadClient m, MonadUnliftIO m) => FeatureSingleton cfg -> [TeamId] -> - m [(TeamId, Maybe (WithStatusNoLock 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 5011d72a3ce..0d24a1821af 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 (DbFeature cfg) GetFeatureConfigMulti :: FeatureSingleton cfg -> [TeamId] -> - TeamFeatureStore m [(TeamId, Maybe (WithStatusNoLock cfg))] + TeamFeatureStore m [(TeamId, DbFeature cfg)] SetFeatureConfig :: FeatureSingleton cfg -> TeamId -> @@ -49,6 +50,6 @@ data TeamFeatureStore m a where TeamFeatureStore m () GetAllFeatureConfigs :: TeamId -> - TeamFeatureStore m AllFeatureConfigs + TeamFeatureStore m (AllFeatures DbFeatureWithLock) makeSem ''TeamFeatureStore 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..f93f63d70f9 --- /dev/null +++ b/services/galley/src/Galley/Schema/V93_ConferenceCallingSftForOneToOne.hs @@ -0,0 +1,16 @@ +module Galley.Schema.V93_ConferenceCallingSftForOneToOne where + +import Cassandra.Schema +import Imports +import Text.RawString.QQ + +migration :: Migration +migration = + 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_status int + ) + |] 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.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/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 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. 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