From 39c3e5715048cee79938b55dd4077fa856ba27a7 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 16 Apr 2024 14:52:19 +0000 Subject: [PATCH 1/9] [wip] legalhold config tests --- integration/test/API/Galley.hs | 19 +++++++++++++++++++ integration/test/API/GalleyInternal.hs | 2 +- integration/test/Test/Demo.hs | 4 ++-- integration/test/Test/FeatureFlags.hs | 26 ++++++++++++++++++++++---- integration/test/Test/User.hs | 8 ++++---- 5 files changed, 48 insertions(+), 11 deletions(-) diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index 5def97cc126..424ee03286b 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -677,3 +677,22 @@ putLegalholdStatus tid usr status = do baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"]) >>= submit "PUT" . addJSONObject ["status" .= status, "ttl" .= "unlimited"] + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_feature_configs +getFeatureConfigs :: (HasCallStack, MakesValue user) => user -> App Response +getFeatureConfigs user = do + req <- baseRequest user Galley Versioned "/feature-configs" + submit "GET" req + +-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__features +getTeamFeatures :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response +getTeamFeatures user tid = do + tidStr <- asString tid + req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features"]) + submit "GET" req + +getTeamFeature :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> String -> App Response +getTeamFeature user tid featureName = do + tidStr <- asString tid + req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) + submit "GET" req diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index f3b2ef1a135..33923b31d90 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -33,7 +33,7 @@ putTeamMember user team perms = do req getTeamFeature :: (HasCallStack, MakesValue domain_) => domain_ -> String -> String -> App Response -getTeamFeature domain_ featureName tid = do +getTeamFeature domain_ tid featureName = do req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "GET" $ req diff --git a/integration/test/Test/Demo.hs b/integration/test/Test/Demo.hs index 824af5a7d2c..8b255f1c0d2 100644 --- a/integration/test/Test/Demo.hs +++ b/integration/test/Test/Demo.hs @@ -37,7 +37,7 @@ testModifiedGalley = do let getFeatureStatus :: (MakesValue domain) => domain -> String -> App Value getFeatureStatus domain team = do - bindResponse (GalleyI.getTeamFeature domain "searchVisibility" team) $ \res -> do + bindResponse (GalleyI.getTeamFeature domain team "searchVisibility") $ \res -> do res.status `shouldMatchInt` 200 res.json %. "status" @@ -75,7 +75,7 @@ testModifiedServices = do withModifiedBackend serviceMap $ \domain -> do (_user, tid, _) <- createTeam domain 1 - bindResponse (GalleyI.getTeamFeature domain "searchVisibility" tid) $ \res -> do + bindResponse (GalleyI.getTeamFeature domain tid "searchVisibility") $ \res -> do res.status `shouldMatchInt` 200 res.json %. "status" `shouldMatch` "enabled" diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index f31e1ed4250..bfe85a26ee4 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -17,7 +17,8 @@ module Test.FeatureFlags where -import API.GalleyInternal +import qualified API.Galley as Public +import qualified API.GalleyInternal as Internal import SetupHelpers import Testlib.Prelude @@ -26,10 +27,27 @@ testLimitedEventFanout = do let featureName = "limitedEventFanout" (_alice, team, _) <- createTeam OwnDomain 1 -- getTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus OwnDomain team featureName "enabled" - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" + bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" + +testLegalhold :: HasCallStack => App () +testLegalhold = do + (owner, tid, _) <- createTeam OwnDomain 1 + let expected = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] + bindResponse (Internal.getTeamFeature OwnDomain tid "legalhold") $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected + bindResponse (Public.getFeatureConfigs owner) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "legalhold" `shouldMatch` expected + bindResponse (Public.getTeamFeatures owner tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. "legalhold" `shouldMatch` expected + bindResponse (Public.getTeamFeature owner tid "legalhold") $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 2c5df564377..89af540d2eb 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -63,11 +63,11 @@ testUpdateHandle = do mem1id <- asString $ mem1 %. "id" let featureName = "mlsE2EId" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" setTeamFeatureStatus owner team featureName "enabled" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -126,11 +126,11 @@ testUpdateSelf (MkTagged mode) = do (owner, team, [mem1]) <- createTeam OwnDomain 2 let featureName = "mlsE2EId" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" setTeamFeatureStatus owner team featureName "enabled" - bindResponse (getTeamFeature owner featureName team) $ \resp -> do + bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" From 9c8e0236e3bf4dbcd47638a816207bdac76fa8a4 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 16 Apr 2024 16:21:17 +0000 Subject: [PATCH 2/9] wip tests, todo: allow listed config --- integration/test/API/GalleyInternal.hs | 6 +++- integration/test/Test/FeatureFlags.hs | 49 +++++++++++++++++++++----- 2 files changed, 46 insertions(+), 9 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 33923b31d90..75c46e1d8d4 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -39,10 +39,14 @@ getTeamFeature domain_ tid featureName = do setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureStatus domain team featureName status = do + setTeamFeatureStatusExpectHttpStatus domain team featureName status 200 + +setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> Int -> App () +setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do tid <- asString team req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] res <- submit "PATCH" $ req & addJSONObject ["status" .= status] - res.status `shouldMatchInt` 200 + res.status `shouldMatchInt` httpStatus setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureLockStatus domain team featureName status = do diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index bfe85a26ee4..4f3166e2236 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -35,19 +35,52 @@ testLimitedEventFanout = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" -testLegalhold :: HasCallStack => App () -testLegalhold = do - (owner, tid, _) <- createTeam OwnDomain 1 - let expected = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] - bindResponse (Internal.getTeamFeature OwnDomain tid "legalhold") $ \resp -> do +disabled :: Value +disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] + +enabled :: Value +enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] + +checkLegalholdStatus :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkLegalholdStatus domain user tid expected = do + tidStr <- asString tid + bindResponse (Internal.getTeamFeature domain tidStr "legalhold") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json `shouldMatch` expected - bindResponse (Public.getFeatureConfigs owner) $ \resp -> do + bindResponse (Public.getFeatureConfigs user) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "legalhold" `shouldMatch` expected - bindResponse (Public.getTeamFeatures owner tid) $ \resp -> do + bindResponse (Public.getTeamFeatures user tid) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "legalhold" `shouldMatch` expected - bindResponse (Public.getTeamFeature owner tid "legalhold") $ \resp -> do + bindResponse (Public.getTeamFeature user tid "legalhold") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json `shouldMatch` expected + +-- always disabled +testLegalholdDisabledPermanently :: HasCallStack => App () +testLegalholdDisabledPermanently = do + withModifiedBackend + (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-permanently"}) + $ \domain -> do + (owner, tid, _) <- createTeam domain 1 + let expected = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] + checkLegalholdStatus domain owner tid expected + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + +-- can be enabled for a team, disabled if unset +testLegalholdDisabledByDefault :: HasCallStack => App () +testLegalholdDisabledByDefault = do + withModifiedBackend + (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"}) + $ \domain -> do + (owner, tid, _) <- createTeam domain 1 + checkLegalholdStatus domain owner tid disabled + Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" + checkLegalholdStatus domain owner tid enabled + Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" + checkLegalholdStatus domain owner tid disabled + +-- enabled if team is allow listed, disabled in any other case +testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () +testLegalholdWhitelistTeamsAndImplicitConsent = undefined From b0177522f5ee615637b10af5cb85efcb8aac76b5 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:42:12 +0200 Subject: [PATCH 3/9] Failing test for legalhold --- integration/test/Test/FeatureFlags.hs | 41 +++++++++++++++++++++------ 1 file changed, 32 insertions(+), 9 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4f3166e2236..a509115d180 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -19,8 +19,11 @@ module Test.FeatureFlags where import qualified API.Galley as Public import qualified API.GalleyInternal as Internal +import Control.Monad.Codensity (Codensity (runCodensity)) +import Control.Monad.Reader import SetupHelpers import Testlib.Prelude +import Testlib.ResourcePool (acquireResources) testLimitedEventFanout :: HasCallStack => App () testLimitedEventFanout = do @@ -60,13 +63,33 @@ checkLegalholdStatus domain user tid expected = do -- always disabled testLegalholdDisabledPermanently :: HasCallStack => App () testLegalholdDisabledPermanently = do - withModifiedBackend - (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-permanently"}) - $ \domain -> do + let cfgLhDisabledPermanently = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-permanently" + } + cfgLhDisabledByDefault = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default" + } + withModifiedBackend cfgLhDisabledPermanently $ \domain -> do + (owner, tid, _) <- createTeam domain 1 + checkLegalholdStatus domain owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + + -- Let's see if it works even if the feature flags table thinks LH is enabled, + -- but galley config says its disabled permanently. + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do (owner, tid, _) <- createTeam domain 1 - let expected = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] - checkLegalholdStatus domain owner tid expected - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + checkLegalholdStatus domain owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200 + checkLegalholdStatus domain owner tid enabled + pure (owner, tid) + + runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do + checkLegalholdStatus domain owner tid disabled -- can be enabled for a team, disabled if unset testLegalholdDisabledByDefault :: HasCallStack => App () @@ -81,6 +104,6 @@ testLegalholdDisabledByDefault = do Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" checkLegalholdStatus domain owner tid disabled --- enabled if team is allow listed, disabled in any other case -testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () -testLegalholdWhitelistTeamsAndImplicitConsent = undefined +-- -- enabled if team is allow listed, disabled in any other case +-- testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () +-- testLegalholdWhitelistTeamsAndImplicitConsent = undefined From 9dee21e3d3d8905e7b6c980d68da9ba682496dd8 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:59:17 +0200 Subject: [PATCH 4/9] Add test for legalhold whitelist team and implicit consent --- integration/test/Test/FeatureFlags.hs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index a509115d180..c9a0b311286 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -104,6 +104,17 @@ testLegalholdDisabledByDefault = do Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" checkLegalholdStatus domain owner tid disabled --- -- enabled if team is allow listed, disabled in any other case --- testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () --- testLegalholdWhitelistTeamsAndImplicitConsent = undefined +-- enabled if team is allow listed, disabled in any other case +testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () +testLegalholdWhitelistTeamsAndImplicitConsent = do + withModifiedBackend + (def {galleyCfg = setField "settings.featureFlags.legalhold" "whitelist-teams-and-implicit-consent"}) + $ \domain -> do + (owner, tid, _) <- createTeam domain 1 + checkLegalholdStatus domain owner tid disabled + Internal.legalholdWhitelistTeam tid owner >>= assertSuccess + checkLegalholdStatus domain owner tid enabled + + -- Disabling it doesn't work + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 + checkLegalholdStatus domain owner tid enabled From 149973454847bd7128ce98d89eb438d2824e95f9 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:59:48 +0200 Subject: [PATCH 5/9] Better errors --- integration/test/API/GalleyInternal.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 75c46e1d8d4..877c6db2df5 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -45,15 +45,15 @@ setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesV setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do tid <- asString team req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] - res <- submit "PATCH" $ req & addJSONObject ["status" .= status] - res.status `shouldMatchInt` httpStatus + bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res -> + res.status `shouldMatchInt` httpStatus setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureLockStatus domain team featureName status = do tid <- asString team req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status] - res <- submit "PUT" $ req - res.status `shouldMatchInt` 200 + bindResponse (submit "PUT" $ req) $ \res -> + res.status `shouldMatchInt` 200 getFederationStatus :: ( HasCallStack, From 63717f01e7bb68267ef4b58695a1205d954e4f0b Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 11:08:54 +0200 Subject: [PATCH 6/9] Slightly faster test --- integration/test/Test/FeatureFlags.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index c9a0b311286..f25adfdae7c 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -71,16 +71,18 @@ testLegalholdDisabledPermanently = do def { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default" } - withModifiedBackend cfgLhDisabledPermanently $ \domain -> do - (owner, tid, _) <- createTeam domain 1 - checkLegalholdStatus domain owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 - - -- Let's see if it works even if the feature flags table thinks LH is enabled, - -- but galley config says its disabled permanently. resourcePool <- asks (.resourcePool) runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do let domain = testBackend.berDomain + + -- Happy case: DB has no config for the team + runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkLegalholdStatus domain owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + + -- Inteteresting case: The team had LH enabled before backend config was + -- changed to disabled-permanently (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do (owner, tid, _) <- createTeam domain 1 checkLegalholdStatus domain owner tid disabled From 3cbec668b9e50ba54fb544d9f563d3553df3991f Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 11:14:41 +0200 Subject: [PATCH 7/9] More complete test for LH setting being "whitelist-teams-and-implicit-consent" --- integration/test/Test/FeatureFlags.hs | 29 ++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index f25adfdae7c..1d3d5cd58b8 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -109,9 +109,20 @@ testLegalholdDisabledByDefault = do -- enabled if team is allow listed, disabled in any other case testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () testLegalholdWhitelistTeamsAndImplicitConsent = do - withModifiedBackend - (def {galleyCfg = setField "settings.featureFlags.legalhold" "whitelist-teams-and-implicit-consent"}) - $ \domain -> do + let cfgLhWhitelistTeamsAndImplicitConsent = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "whitelist-teams-and-implicit-consent" + } + cfgLhDisabledByDefault = + def + { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default" + } + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + + -- Happy case: DB has no config for the team + (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do (owner, tid, _) <- createTeam domain 1 checkLegalholdStatus domain owner tid disabled Internal.legalholdWhitelistTeam tid owner >>= assertSuccess @@ -120,3 +131,15 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do -- Disabling it doesn't work Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 checkLegalholdStatus domain owner tid enabled + pure (owner, tid) + + -- Inteteresting case: The team had LH disabled before backend config was + -- changed to "whitelist-teams-and-implicit-consent". It should still show + -- enabled when the config gets changed. + runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do + checkLegalholdStatus domain owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 + checkLegalholdStatus domain owner tid disabled + + runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do + checkLegalholdStatus domain owner tid enabled From 89df08d03722fb9e8f04560a70ed8ed841275de1 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 12:02:23 +0200 Subject: [PATCH 8/9] WIP: TeamFeatures.testExposeInvitationURLsToTeamAdminConfig --- integration/test/Test/FeatureFlags.hs | 96 +++++++++++++++++++-------- 1 file changed, 67 insertions(+), 29 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 1d3d5cd58b8..4c72a37364c 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -41,25 +41,12 @@ testLimitedEventFanout = do disabled :: Value disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"] +disabledLocked :: Value +disabledLocked = object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited"] + enabled :: Value enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] -checkLegalholdStatus :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () -checkLegalholdStatus domain user tid expected = do - tidStr <- asString tid - bindResponse (Internal.getTeamFeature domain tidStr "legalhold") $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json `shouldMatch` expected - bindResponse (Public.getFeatureConfigs user) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. "legalhold" `shouldMatch` expected - bindResponse (Public.getTeamFeatures user tid) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. "legalhold" `shouldMatch` expected - bindResponse (Public.getTeamFeature user tid "legalhold") $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json `shouldMatch` expected - -- always disabled testLegalholdDisabledPermanently :: HasCallStack => App () testLegalholdDisabledPermanently = do @@ -78,20 +65,20 @@ testLegalholdDisabledPermanently = do -- Happy case: DB has no config for the team runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do (owner, tid, _) <- createTeam domain 1 - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 -- Inteteresting case: The team had LH enabled before backend config was -- changed to disabled-permanently (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do (owner, tid, _) <- createTeam domain 1 - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200 - checkLegalholdStatus domain owner tid enabled + checkFeature "legalhold" owner tid enabled pure (owner, tid) runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled -- can be enabled for a team, disabled if unset testLegalholdDisabledByDefault :: HasCallStack => App () @@ -100,11 +87,11 @@ testLegalholdDisabledByDefault = do (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"}) $ \domain -> do (owner, tid, _) <- createTeam domain 1 - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" - checkLegalholdStatus domain owner tid enabled + checkFeature "legalhold" owner tid enabled Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled -- enabled if team is allow listed, disabled in any other case testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () @@ -124,22 +111,73 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do -- Happy case: DB has no config for the team (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do (owner, tid, _) <- createTeam domain 1 - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled Internal.legalholdWhitelistTeam tid owner >>= assertSuccess - checkLegalholdStatus domain owner tid enabled + checkFeature "legalhold" owner tid enabled -- Disabling it doesn't work Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 - checkLegalholdStatus domain owner tid enabled + checkFeature "legalhold" owner tid enabled pure (owner, tid) -- Inteteresting case: The team had LH disabled before backend config was -- changed to "whitelist-teams-and-implicit-consent". It should still show -- enabled when the config gets changed. runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 - checkLegalholdStatus domain owner tid disabled + checkFeature "legalhold" owner tid disabled runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do - checkLegalholdStatus domain owner tid enabled + checkFeature "legalhold" owner tid enabled + +testExposeInvitationURLsToTeamAdminConfig :: HasCallStack => App () +testExposeInvitationURLsToTeamAdminConfig = do + let cfgExposeInvitationURLsTeamAllowlist tids = + def + { galleyCfg = setField "settings.exposeInvitationURLsTeamAllowlist" tids + } + resourcePool <- asks (.resourcePool) + runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do + let domain = testBackend.berDomain + + -- Happy case: DB has no config for the team + runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist ([] :: [String])) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked + +-- Internal.legalholdWhitelistTeam tid owner >>= assertSuccess +-- checkFeature "legalhold" owner tid enabled + +-- -- Disabling it doesn't work +-- Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 +-- checkFeature "legalhold" owner tid enabled +-- pure (owner, tid) + +-- -- Inteteresting case: The team had LH disabled before backend config was +-- -- changed to "whitelist-teams-and-implicit-consent". It should still show +-- -- enabled when the config gets changed. +-- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do +-- checkFeature "legalhold" owner tid disabled +-- Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 +-- checkFeature "legalhold" owner tid disabled + +-- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do +-- checkFeature "legalhold" owner tid enabled + +checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkFeature feature user tid expected = do + tidStr <- asString tid + domain <- objDomain user + bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected + bindResponse (Public.getFeatureConfigs user) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch` expected + bindResponse (Public.getTeamFeatures user tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch` expected + bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json `shouldMatch` expected From 6feabb28a3ade48e66ef845fd17bd47c40b7e5cb Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 17 Apr 2024 13:02:25 +0000 Subject: [PATCH 9/9] tests for expose invitation url feature flag --- integration/test/Test/FeatureFlags.hs | 46 +++++++++---------- .../src/Galley/API/Teams/Features/Get.hs | 1 + 2 files changed, 24 insertions(+), 23 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4c72a37364c..7d522b61320 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -120,7 +120,7 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do checkFeature "legalhold" owner tid enabled pure (owner, tid) - -- Inteteresting case: The team had LH disabled before backend config was + -- Interesting case: The team had LH disabled before backend config was -- changed to "whitelist-teams-and-implicit-consent". It should still show -- enabled when the config gets changed. runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do @@ -142,28 +142,28 @@ testExposeInvitationURLsToTeamAdminConfig = do let domain = testBackend.berDomain -- Happy case: DB has no config for the team - runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist ([] :: [String])) $ \_ -> do - (owner, tid, _) <- createTeam domain 1 - checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked - --- Internal.legalholdWhitelistTeam tid owner >>= assertSuccess --- checkFeature "legalhold" owner tid enabled - --- -- Disabling it doesn't work --- Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 --- checkFeature "legalhold" owner tid enabled --- pure (owner, tid) - --- -- Inteteresting case: The team had LH disabled before backend config was --- -- changed to "whitelist-teams-and-implicit-consent". It should still show --- -- enabled when the config gets changed. --- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do --- checkFeature "legalhold" owner tid disabled --- Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 --- checkFeature "legalhold" owner tid disabled - --- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do --- checkFeature "legalhold" owner tid enabled + let testNoAllowlistEntry = runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist ([] :: [String])) $ \_ -> do + (owner, tid, _) <- createTeam domain 1 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked + -- here we get a response with HTTP status 200 and feature status unchanged (disabled), which we find weird, but we're just testing the current behavior + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + pure (owner, tid) + + (owner, tid) <- testNoAllowlistEntry + + -- Interesting case: The team is in the allow list + runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist [tid]) $ \_ -> do + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled + Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled + + -- Interesting case: The team had the feature enabled but is not in allow list + void testNoAllowlistEntry checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () checkFeature feature user tid expected = do diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index c0ca2b2c9c4..640a60b1d7e 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -473,6 +473,7 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where computeConfigForTeam teamAllowed teamDbStatus = if teamAllowed then makeConfig LockStatusUnlocked teamDbStatus + -- FUTUREWORK: use default feature status instead else makeConfig LockStatusLocked FeatureStatusDisabled makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig