From 02cb09646756c324eeb66346b412b6d5ef57b5b6 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 16 Apr 2024 14:52:19 +0000 Subject: [PATCH 01/12] [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 ede00ec53d1a0e4a6f9fa9c0ca0f8e3f95506580 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 16 Apr 2024 16:21:17 +0000 Subject: [PATCH 02/12] 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 00f76c1d3784bd5191fb9adaea367504b5da02a1 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:42:12 +0200 Subject: [PATCH 03/12] 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 05d545a08a068faff1234966194286cab5144a70 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:59:17 +0200 Subject: [PATCH 04/12] 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 5465e92f1ffd1d26fc4fdf4385efd65c2a1b8ee5 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 10:59:48 +0200 Subject: [PATCH 05/12] 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 4dbae6f9561621bfc4d948083d28ce0ab5ccb6cf Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 11:08:54 +0200 Subject: [PATCH 06/12] 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 6b6649fe3521319c3ea28e94fd1755148ab14871 Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 11:14:41 +0200 Subject: [PATCH 07/12] 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 4287ded2826cc8eb994d520baf620709d87622ed Mon Sep 17 00:00:00 2001 From: Akshay Mankar Date: Wed, 17 Apr 2024 12:02:23 +0200 Subject: [PATCH 08/12] 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 0d753d6127cb4f39ce6110d70b4096354cc078de Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 17 Apr 2024 13:02:25 +0000 Subject: [PATCH 09/12] 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 From 36d05df18a9d069fb5906f13aa8a0271b39cf16a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 17 Apr 2024 13:18:06 +0000 Subject: [PATCH 10/12] changelog --- changelog.d/5-internal/WPB-8713 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/WPB-8713 diff --git a/changelog.d/5-internal/WPB-8713 b/changelog.d/5-internal/WPB-8713 new file mode 100644 index 00000000000..cc48758e176 --- /dev/null +++ b/changelog.d/5-internal/WPB-8713 @@ -0,0 +1 @@ +Integration test cases for strangely behaving feature config settings. From 3bd3b22c2e199f836642ba1a92d8f5bdf96d91ca Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 17 Apr 2024 13:28:41 +0000 Subject: [PATCH 11/12] linter --- services/galley/src/Galley/API/Teams/Features/Get.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs index 640a60b1d7e..727d6646ae2 100644 --- a/services/galley/src/Galley/API/Teams/Features/Get.hs +++ b/services/galley/src/Galley/API/Teams/Features/Get.hs @@ -473,8 +473,8 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where computeConfigForTeam teamAllowed teamDbStatus = if teamAllowed then makeConfig LockStatusUnlocked teamDbStatus - -- FUTUREWORK: use default feature status instead - else makeConfig LockStatusLocked FeatureStatusDisabled + else -- FUTUREWORK: use default feature status instead + makeConfig LockStatusLocked FeatureStatusDisabled makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig makeConfig lockStatus status = From ace6b062b3ef58ca3018c9429105abec8b665fbf Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Thu, 18 Apr 2024 06:49:43 +0000 Subject: [PATCH 12/12] fix test --- integration/test/Test/Login.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs index 6f6b05f6246..1617e8b3a0f 100644 --- a/integration/test/Test/Login.hs +++ b/integration/test/Test/Login.hs @@ -68,7 +68,7 @@ testLoginVerify6DigitExpiredCodeFails = do email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" - bindResponse (getTeamFeature domain "sndFactorPasswordChallenge" team) $ \resp -> do + bindResponse (getTeamFeature owner team "sndFactorPasswordChallenge") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" generateVerificationCode owner email