From f83f6221ae5ab8da90019c786012e8d670154e83 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 12:03:28 +0000 Subject: [PATCH 01/30] port sso tests --- integration/integration.cabal | 1 + integration/test/API/Galley.hs | 11 ++++ integration/test/API/GalleyInternal.hs | 6 +- integration/test/Test/FeatureFlags.hs | 62 ++++++++++--------- integration/test/Test/FeatureFlags/Util.hs | 51 +++++++++++++++ .../test/integration/API/Teams/Feature.hs | 34 +--------- 6 files changed, 100 insertions(+), 65 deletions(-) create mode 100644 integration/test/Test/FeatureFlags/Util.hs diff --git a/integration/integration.cabal b/integration/integration.cabal index 15fd4c7a8d6..3c3d9f63e6c 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -122,6 +122,7 @@ library Test.Errors Test.ExternalPartner Test.FeatureFlags + Test.FeatureFlags.Util Test.Federation Test.Federator Test.LegalHold diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index f169e341cb7..d169a2365ad 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -701,3 +701,14 @@ getTeamFeature user tid featureName = do tidStr <- asString tid req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) submit "GET" req + +setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig = setTeamFeatureConfigVersioned Versioned + +setTeamFeatureConfigVersioned :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfigVersioned versioned domain team featureName payload = do + tid <- asString team + fn <- asString featureName + p <- make payload + req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + submit "PUT" $ req & addJSON p diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 5da28bbf554..ccc4a5e4e9f 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -102,10 +102,10 @@ generateVerificationCode' domain email = do emailStr <- asString email submit "POST" $ req & addJSONObject ["email" .= emailStr, "action" .= "login"] -setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> domain -> team -> featureName -> payload -> App Response -setTeamFeatureConfig versioned domain team featureName payload = do +setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig domain team featureName payload = do tid <- asString team fn <- asString featureName p <- make payload - req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] submit "PUT" $ req & addJSON p diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4903392f213..4615bff18c6 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -23,6 +23,7 @@ import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Reader import qualified Data.Aeson as A import SetupHelpers +import Test.FeatureFlags.Util import Testlib.Prelude import Testlib.ResourcePool (acquireResources) @@ -39,15 +40,6 @@ testLimitedEventFanout = do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" -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"] - -- always disabled testLegalholdDisabledPermanently :: HasCallStack => App () testLegalholdDisabledPermanently = do @@ -166,23 +158,6 @@ testExposeInvitationURLsToTeamAdminConfig = do -- 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 - tidStr <- asString tid - domain <- objDomain user - bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json `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 - bindResponse (Public.getFeatureConfigs user) $ \resp -> do - resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatch` expected - testMlsE2EConfigCrlProxyRequired :: HasCallStack => App () testMlsE2EConfigCrlProxyRequired = do (owner, tid, _) <- createTeam OwnDomain 1 @@ -197,7 +172,7 @@ testMlsE2EConfigCrlProxyRequired = do ] -- From API version 6 onwards, the CRL proxy is required, so the request should fail when it's not provided - bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfig owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 400 resp.json %. "label" `shouldMatch` "mls-e2eid-missing-crl-proxy" @@ -208,7 +183,7 @@ testMlsE2EConfigCrlProxyRequired = do & setField "status" "enabled" -- The request should succeed when the CRL proxy is provided - bindResponse (Internal.setTeamFeatureConfig Versioned owner tid "mlsE2EId" configWithCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfig owner tid "mlsE2EId" configWithCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 200 -- Assert that the feature config got updated correctly @@ -229,9 +204,38 @@ testMlsE2EConfigCrlProxyNotRequiredInV5 = do ] -- In API version 5, the CRL proxy is not required, so the request should succeed - bindResponse (Internal.setTeamFeatureConfig (ExplicitVersion 5) owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do + bindResponse (Public.setTeamFeatureConfigVersioned (ExplicitVersion 5) owner tid "mlsE2EId" configWithoutCrlProxy) $ \resp -> do resp.status `shouldMatchInt` 200 -- Assert that the feature config got updated correctly expectedResponse <- configWithoutCrlProxy & setField "lockStatus" "unlocked" & setField "ttl" "unlimited" checkFeature "mlsE2EId" owner tid expectedResponse + +testSSODisabledByDefault :: HasCallStack => App () +testSSODisabledByDefault = do + let put uid tid = Internal.setTeamFeatureConfig uid tid "sso" (object ["status" .= "enabled"]) >>= assertSuccess + let patch uid tid = Internal.setTeamFeatureStatus uid tid "sso" "enabled" + forM_ [put, patch] $ \enableFeature -> do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.sso" "disabled-by-default"} + $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "sso" + -- Test default + checkFeature "sso" m tid disabled + -- Test override + enableFeature owner tid + checkFeature "sso" owner tid enabled + +testSSOEnabledByDefault :: HasCallStack => App () +testSSOEnabledByDefault = do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.sso" "enabled-by-default"} + $ \domain -> do + (owner, tid, _m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "sso" + checkFeature "sso" owner tid enabled + -- check that the feature cannot be disabled + assertLabel 403 "not-implemented" =<< Internal.setTeamFeatureConfig owner tid "sso" (object ["status" .= "disabled"]) diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs new file mode 100644 index 00000000000..2b46347b23b --- /dev/null +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -0,0 +1,51 @@ +-- This file is part of the Wire Server implementation. +-- +-- Copyright (C) 2023 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.FeatureFlags.Util where + +import qualified API.Galley as Public +import qualified API.GalleyInternal as Internal +import Testlib.Prelude + +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"] + +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.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 + bindResponse (Public.getFeatureConfigs user) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. feature `shouldMatch` expected + +assertForbidden :: HasCallStack => Response -> App () +assertForbidden = assertLabel 403 "no-team-member" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 4e0ccdb3cca..153d9ddb432 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,9 +64,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "SSO - set with HTTP PUT" (testSSO putSSOInternal), - test s "SSO - set with HTTP PATCH" (testSSO patchSSOInternal), - test s "LegalHold - set with HTTP PUT" (testLegalHold putLegalHoldInternal), + [ test s "LegalHold - set with HTTP PUT" (testLegalHold putLegalHoldInternal), test s "LegalHold - set with HTTP PATCH" (testLegalHold patchLegalHoldInternal), test s "SearchVisibility" testSearchVisibility, test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, @@ -283,36 +281,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testSSO :: (TeamId -> FeatureStatus -> TestM ()) -> TestM () -testSSO setSSOFeature = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - assertFlagForbidden $ getTeamFeature @SSOConfig nonMember tid - - featureSSO <- view (tsGConf . settings . featureFlags . flagSSO) - case featureSSO of - FeatureSSODisabledByDefault -> do - -- Test default - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - - -- Test override - setSSOFeature tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - FeatureSSOEnabledByDefault -> do - -- since we don't allow to disable (see 'disableSsoNotImplemented'), we can't test - -- much here. (disable failure is covered in "enable/disable SSO" above.) - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited) - -putSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () -putSSOInternal tid = - void - . putTeamFeatureInternal @SSOConfig expect2xx tid - . (\st -> WithStatusNoLock st SSOConfig FeatureTTLUnlimited) - -patchSSOInternal :: HasCallStack => TeamId -> FeatureStatus -> TestM () -patchSSOInternal tid status = void $ patchTeamFeatureInternalWithMod @SSOConfig expect2xx tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) - testLegalHold :: ((Request -> Request) -> TeamId -> FeatureStatus -> TestM ()) -> TestM () testLegalHold setLegalHoldInternal = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 From f7ec882aeb5283d61c3bf97f217cdaa366b51eb7 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 12:49:00 +0000 Subject: [PATCH 02/30] legalhold tests and little cleanup --- integration/test/API/GalleyInternal.hs | 9 +-- integration/test/Test/Conversation.hs | 2 +- integration/test/Test/FeatureFlags.hs | 58 +++++++++++-------- integration/test/Test/Login.hs | 12 ++-- integration/test/Test/Search.hs | 4 +- integration/test/Test/User.hs | 4 +- .../test/integration/API/Teams/Feature.hs | 39 +------------ 7 files changed, 47 insertions(+), 81 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index ccc4a5e4e9f..56cb982830c 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -37,16 +37,11 @@ getTeamFeature domain_ tid featureName = do req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "GET" $ req -setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () +setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App Response 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] - bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res -> do - res.status `shouldMatchInt` httpStatus + submit "PATCH" $ req & addJSONObject ["status" .= status] setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () setTeamFeatureLockStatus domain team featureName status = do diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 81a15c7e16f..9426f1a41c1 100644 --- a/integration/test/Test/Conversation.hs +++ b/integration/test/Test/Conversation.hs @@ -681,7 +681,7 @@ testDeleteTeamMemberLimitedEventFanout = do -- Only the team admins will get the team-level event about Alex being removed -- from the team - setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" + assertSuccess =<< setTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled" withWebSockets [alice, amy, bob, alison, ana] $ \[wsAlice, wsAmy, wsBob, wsAlison, wsAna] -> do diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4615bff18c6..ca7a9778c6d 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -35,11 +35,30 @@ testLimitedEventFanout = do bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" +testLegalholdDisabledByDefault :: HasCallStack => App () +testLegalholdDisabledByDefault = do + let put uid tid st = Internal.setTeamFeatureConfig uid tid "legalhold" (object ["status" .= st]) >>= assertSuccess + let patch uid tid st = Internal.setTeamFeatureStatus uid tid "legalhold" st >>= assertSuccess + forM_ [put, patch] $ \setFeatureStatus -> do + withModifiedBackend + def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"} + $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "legalhold" + -- Test default + checkFeature "legalhold" m tid disabled + -- Test override + setFeatureStatus owner tid "enabled" + checkFeature "legalhold" owner tid enabled + setFeatureStatus owner tid "disabled" + checkFeature "legalhold" owner tid disabled + -- always disabled testLegalholdDisabledPermanently :: HasCallStack => App () testLegalholdDisabledPermanently = do @@ -59,33 +78,21 @@ testLegalholdDisabledPermanently = do runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do (owner, tid, _) <- createTeam domain 1 checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403 + assertStatus 403 =<< Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" + assertStatus 403 =<< Internal.setTeamFeatureConfig domain tid "legalhold" (object ["status" .= "enabled"]) - -- Inteteresting case: The team had LH enabled before backend config was + -- Interesting 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 checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" checkFeature "legalhold" owner tid enabled pure (owner, tid) runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do checkFeature "legalhold" owner tid disabled --- 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 - checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatus domain tid "legalhold" "enabled" - checkFeature "legalhold" owner tid enabled - Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" - checkFeature "legalhold" owner tid disabled - -- enabled if team is allow listed, disabled in any other case testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App () testLegalholdWhitelistTeamsAndImplicitConsent = do @@ -109,7 +116,8 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do checkFeature "legalhold" owner tid enabled -- Disabling it doesn't work - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403 + assertStatus 403 =<< Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" + assertStatus 403 =<< Internal.setTeamFeatureConfig domain tid "legalhold" (object ["status" .= "disabled"]) checkFeature "legalhold" owner tid enabled pure (owner, tid) @@ -118,7 +126,7 @@ testLegalholdWhitelistTeamsAndImplicitConsent = do -- enabled when the config gets changed. runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do checkFeature "legalhold" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "legalhold" "disabled" checkFeature "legalhold" owner tid disabled runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do @@ -138,8 +146,8 @@ testExposeInvitationURLsToTeamAdminConfig = 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 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" pure (owner, tid) -- Happy case: DB has no config for the team @@ -148,11 +156,11 @@ testExposeInvitationURLsToTeamAdminConfig = do -- 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 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled - Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200 + assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled -- Interesting case: The team had the feature enabled but is not in allow list @@ -214,7 +222,7 @@ testMlsE2EConfigCrlProxyNotRequiredInV5 = do testSSODisabledByDefault :: HasCallStack => App () testSSODisabledByDefault = do let put uid tid = Internal.setTeamFeatureConfig uid tid "sso" (object ["status" .= "enabled"]) >>= assertSuccess - let patch uid tid = Internal.setTeamFeatureStatus uid tid "sso" "enabled" + let patch uid tid = Internal.setTeamFeatureStatus uid tid "sso" "enabled" >>= assertSuccess forM_ [put, patch] $ \enableFeature -> do withModifiedBackend def {galleyCfg = setField "settings.featureFlags.sso" "disabled-by-default"} diff --git a/integration/test/Test/Login.hs b/integration/test/Test/Login.hs index b16f5ec3074..c5ca8b2d513 100644 --- a/integration/test/Test/Login.hs +++ b/integration/test/Test/Login.hs @@ -17,7 +17,7 @@ testLoginVerify6DigitEmailCodeSuccess = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email code <- getVerificationCode owner "login" >>= getJSON 200 >>= asString bindResponse (loginWith2ndFactor owner email defPassword code) $ \resp -> do @@ -30,7 +30,7 @@ testLoginVerify6DigitWrongCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 @@ -45,7 +45,7 @@ testLoginVerify6DigitMissingCodeFails = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" bindResponse (login owner email defPassword) $ \resp -> do resp.status `shouldMatchInt` 403 resp.json %. "label" `shouldMatch` "code-authentication-required" @@ -60,7 +60,7 @@ testLoginVerify6DigitExpiredCodeFails = do (owner, team, []) <- createTeam domain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" bindResponse (getTeamFeature owner team "sndFactorPasswordChallenge") $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -78,7 +78,7 @@ testLoginVerify6DigitResendCodeSuccessAndRateLimiting = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email fstCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString bindResponse (generateVerificationCode' owner email) $ \resp -> do @@ -100,7 +100,7 @@ testLoginVerify6DigitLimitRetries = do (owner, team, []) <- createTeam OwnDomain 0 email <- owner %. "email" setTeamFeatureLockStatus owner team "sndFactorPasswordChallenge" "unlocked" - setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" + assertSuccess =<< setTeamFeatureStatus owner team "sndFactorPasswordChallenge" "enabled" generateVerificationCode owner email correctCode <- getVerificationCode owner "login" >>= getJSON 200 >>= asString let wrongCode :: String = printf "%06d" $ (read @Int correctCode) + 1 `mod` 1000000 diff --git a/integration/test/Test/Search.hs b/integration/test/Test/Search.hs index 7d93b4ff015..fab4fd54daa 100644 --- a/integration/test/Test/Search.hs +++ b/integration/test/Test/Search.hs @@ -112,7 +112,7 @@ federatedUserSearch d1 d2 test = do u2 <- randomUser d2 def {BrigI.team = True} uidD2 <- objId u2 team2 <- u2 %. "team" - GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" + assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" addTeamRestriction d1 d2 team2 test.restrictionD1D2 addTeamRestriction d2 d1 teamU1 test.restrictionD2D1 @@ -167,7 +167,7 @@ testFederatedUserSearchNonTeamSearcher = do u1 <- randomUser d1 def u2 <- randomUser d2 def {BrigI.team = True} team2 <- u2 %. "team" - GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" + assertSuccess =<< GalleyI.setTeamFeatureStatus d2 team2 "searchVisibilityInbound" "enabled" u2Handle <- API.randomHandle bindResponse (BrigP.putHandle u2 u2Handle) $ assertSuccess diff --git a/integration/test/Test/User.hs b/integration/test/Test/User.hs index 89af540d2eb..55fe4082550 100644 --- a/integration/test/Test/User.hs +++ b/integration/test/Test/User.hs @@ -66,7 +66,7 @@ testUpdateHandle = do bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus owner team featureName "enabled" + assertSuccess =<< setTeamFeatureStatus owner team featureName "enabled" bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" @@ -129,7 +129,7 @@ testUpdateSelf (MkTagged mode) = do bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - setTeamFeatureStatus owner team featureName "enabled" + assertSuccess =<< setTeamFeatureStatus owner team featureName "enabled" bindResponse (getTeamFeature owner team featureName) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "enabled" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 153d9ddb432..e6f9a399a71 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,9 +64,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "LegalHold - set with HTTP PUT" (testLegalHold putLegalHoldInternal), - test s "LegalHold - set with HTTP PATCH" (testLegalHold patchLegalHoldInternal), - test s "SearchVisibility" testSearchVisibility, + [ test s "SearchVisibility" testSearchVisibility, test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, @@ -281,41 +279,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testLegalHold :: ((Request -> Request) -> TeamId -> FeatureStatus -> TestM ()) -> TestM () -testLegalHold setLegalHoldInternal = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - assertFlagForbidden $ getTeamFeature @LegalholdConfig nonMember tid - - -- FUTUREWORK: run two galleys, like below for custom search visibility. - featureLegalHold <- view (tsGConf . settings . featureFlags . flagLegalHold) - case featureLegalHold of - FeatureLegalHoldDisabledByDefault -> do - -- Test default - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - - -- Test override - setLegalHoldInternal expect2xx tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited) - - -- turned off for instance - FeatureLegalHoldDisabledPermanently -> do - setLegalHoldInternal expect4xx tid FeatureStatusEnabled - - -- turned off but for whitelisted teams with implicit consent - FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do - setLegalHoldInternal expect4xx tid FeatureStatusEnabled - -putLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () -putLegalHoldInternal expectation tid = - void - . putTeamFeatureInternal @LegalholdConfig expectation tid - . (\st -> WithStatusNoLock st LegalholdConfig FeatureTTLUnlimited) - -patchLegalHoldInternal :: HasCallStack => (Request -> Request) -> TeamId -> FeatureStatus -> TestM () -patchLegalHoldInternal expectation tid status = void $ patchTeamFeatureInternalWithMod @LegalholdConfig expectation tid (withStatus' (Just status) Nothing Nothing (Just FeatureTTLUnlimited)) - testSearchVisibility :: TestM () testSearchVisibility = do let setTeamSearchVisibilityInternal :: TeamId -> FeatureStatus -> TestM () From e455d1231b191900c4372dc7c61477f034e3b848 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 13:03:54 +0000 Subject: [PATCH 03/30] search visibility --- integration/test/Test/FeatureFlags.hs | 26 ++++++++++++++ .../test/integration/API/Teams/Feature.hs | 34 +------------------ 2 files changed, 27 insertions(+), 33 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index ca7a9778c6d..8760d9149d5 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -247,3 +247,29 @@ testSSOEnabledByDefault = do checkFeature "sso" owner tid enabled -- check that the feature cannot be disabled assertLabel 403 "not-implemented" =<< Internal.setTeamFeatureConfig owner tid "sso" (object ["status" .= "disabled"]) + +testSearchVisibilityDisabledByDefault :: HasCallStack => App () +testSearchVisibilityDisabledByDefault = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "disabled-by-default"} $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "searchVisibility" + -- Test default + checkFeature "searchVisibility" m tid disabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" + checkFeature "searchVisibility" owner tid enabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "disabled" + checkFeature "searchVisibility" owner tid disabled + +testSearchVisibilityEnabledByDefault :: HasCallStack => App () +testSearchVisibilityEnabledByDefault = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.teamSearchVisibility" "enabled-by-default"} $ \domain -> do + (owner, tid, m : _) <- createTeam domain 2 + nonMember <- randomUser domain def + assertForbidden =<< Public.getTeamFeature nonMember tid "searchVisibility" + -- Test default + checkFeature "searchVisibility" m tid enabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "disabled" + checkFeature "searchVisibility" owner tid disabled + assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" + checkFeature "searchVisibility" owner tid enabled diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index e6f9a399a71..2fb304193f4 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,8 +64,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "SearchVisibility" testSearchVisibility, - test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, + [ test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, @@ -279,37 +278,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testSearchVisibility :: TestM () -testSearchVisibility = do - let setTeamSearchVisibilityInternal :: TeamId -> FeatureStatus -> TestM () - setTeamSearchVisibilityInternal teamid val = do - putTeamSearchVisibilityAvailableInternal teamid val - - (_, tid, [member]) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - assertFlagForbidden $ getTeamFeature @SearchVisibilityAvailableConfig nonMember tid - - withCustomSearchFeature FeatureTeamSearchVisibilityUnavailableByDefault $ do - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid FeatureStatusEnabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid FeatureStatusDisabled - checkTeamFeatureAllEndpoints member tid (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - (_, tid2, team2member : _) <- createBindingTeamWithNMembers 1 - - withCustomSearchFeature FeatureTeamSearchVisibilityAvailableByDefault $ do - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid2 FeatureStatusDisabled - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - - setTeamSearchVisibilityInternal tid2 FeatureStatusEnabled - checkTeamFeatureAllEndpoints team2member tid2 (withStatus FeatureStatusEnabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited) - testClassifiedDomainsEnabled :: TestM () testClassifiedDomainsEnabled = do (_, tid, member : _) <- createBindingTeamWithNMembers 1 From 53c60aae05a2cee71b961b732a9b614780f43c12 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 13:46:41 +0000 Subject: [PATCH 04/30] digital signatures --- integration/test/Notifications.hs | 4 +++ integration/test/Test/FeatureFlags.hs | 31 +++++++++++++++++++ .../test/integration/API/Teams/Feature.hs | 3 +- 3 files changed, 36 insertions(+), 2 deletions(-) diff --git a/integration/test/Notifications.hs b/integration/test/Notifications.hs index 9186f325f07..3278a94c35e 100644 --- a/integration/test/Notifications.hs +++ b/integration/test/Notifications.hs @@ -100,6 +100,10 @@ isDeleteUserNotif :: MakesValue a => a -> App Bool isDeleteUserNotif n = nPayload n %. "type" `isEqual` "user.delete" +isFeatureConfigUpdateNotif :: MakesValue a => a -> App Bool +isFeatureConfigUpdateNotif n = + nPayload n %. "type" `isEqual` "feature-config.update" + isNewMessageNotif :: MakesValue a => a -> App Bool isNewMessageNotif n = fieldEquals n "payload.0.type" "conversation.otr-message-add" diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 8760d9149d5..b832bb79aaf 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -22,6 +22,7 @@ import qualified API.GalleyInternal as Internal import Control.Monad.Codensity (Codensity (runCodensity)) import Control.Monad.Reader import qualified Data.Aeson as A +import Notifications import SetupHelpers import Test.FeatureFlags.Util import Testlib.Prelude @@ -273,3 +274,33 @@ testSearchVisibilityEnabledByDefault = do checkFeature "searchVisibility" owner tid disabled assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" checkFeature "searchVisibility" owner tid enabled + +testDigitalSignatures :: HasCallStack => App () +testDigitalSignatures = _testSimpleFlag "digitalSignatures" False + +_testSimpleFlag :: HasCallStack => String -> Bool -> App () +_testSimpleFlag featureName featureEnabledByDefault = do + let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" + let defaultValue = if featureEnabledByDefault then enabled else disabled + let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" + let otherValue = if featureEnabledByDefault then disabled else enabled + + (_, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + checkFeature featureName m tid defaultValue + -- should receive an event + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain tid featureName otherStatus + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` otherValue + + checkFeature featureName m tid otherValue + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain tid featureName defaultStatus + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` defaultValue + checkFeature featureName m tid defaultValue diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 2fb304193f4..ee4727c7ba9 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,8 +64,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "DigitalSignatures" $ testSimpleFlag @DigitalSignaturesConfig FeatureStatusDisabled, - test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, + [ test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, From 4c3b6e0c234d7fe17f8c6a3b3be87c6065bb880d Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 13:54:50 +0000 Subject: [PATCH 05/30] ported all simple flag tests --- integration/test/Test/FeatureFlags.hs | 9 +++++++++ .../test/integration/API/Teams/Feature.hs | 19 +------------------ 2 files changed, 10 insertions(+), 18 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index b832bb79aaf..7c67af09f8a 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -278,6 +278,15 @@ testSearchVisibilityEnabledByDefault = do testDigitalSignatures :: HasCallStack => App () testDigitalSignatures = _testSimpleFlag "digitalSignatures" False +testValidateSAMLEmails :: HasCallStack => App () +testValidateSAMLEmails = _testSimpleFlag "validateSAMLemails" True + +testConferenceCalling :: HasCallStack => App () +testConferenceCalling = _testSimpleFlag "conferenceCalling" True + +testSearchVisibilityInbound :: HasCallStack => App () +testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" False + _testSimpleFlag :: HasCallStack => String -> Bool -> App () _testSimpleFlag featureName featureEnabledByDefault = do let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index ee4727c7ba9..8bee403f4e3 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,13 +64,11 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "ValidateSAMLEmails" $ testSimpleFlag @ValidateSAMLEmailsConfig FeatureStatusEnabled, - test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, + [ test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, test s "All features" testAllFeatures, test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, - test s "ConferenceCalling" $ testSimpleFlag @ConferenceCallingConfig FeatureStatusEnabled, test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, @@ -93,7 +91,6 @@ tests s = test s "Unlimited to unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited FeatureTTLUnlimited ], test s "MLS feature config" testMLS, - test s "SearchVisibilityInbound" $ testSimpleFlag @SearchVisibilityInboundConfig FeatureStatusDisabled, test s "MlsE2EId feature config" $ testNonTrivialConfigNoTTL ( withStatus @@ -300,20 +297,6 @@ testClassifiedDomainsDisabled = do withSettingsOverrides classifiedDomainsDisabled $ checkTeamFeatureAllEndpoints member tid expected -testSimpleFlag :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - FromJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - TestM () -testSimpleFlag defaultValue = testSimpleFlagTTL @cfg defaultValue FeatureTTLUnlimited - testSimpleFlagTTLOverride :: forall cfg. ( HasCallStack, From 33da86f3a0ec75354a329116f7134198a94e0213 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 14:49:45 +0000 Subject: [PATCH 06/30] guest link test --- integration/test/API/Galley.hs | 8 ++-- integration/test/Test/FeatureFlags.hs | 42 +++++++++++++++++++ .../test/integration/API/Teams/Feature.hs | 1 - 3 files changed, 46 insertions(+), 5 deletions(-) diff --git a/integration/test/API/Galley.hs b/integration/test/API/Galley.hs index d169a2365ad..c744ad12258 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -702,13 +702,13 @@ getTeamFeature user tid featureName = do req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName]) submit "GET" req -setTeamFeatureConfig :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => domain -> team -> featureName -> payload -> App Response +setTeamFeatureConfig :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => user -> team -> featureName -> payload -> App Response setTeamFeatureConfig = setTeamFeatureConfigVersioned Versioned -setTeamFeatureConfigVersioned :: (HasCallStack, MakesValue domain, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> domain -> team -> featureName -> payload -> App Response -setTeamFeatureConfigVersioned versioned domain team featureName payload = do +setTeamFeatureConfigVersioned :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => Versioned -> user -> team -> featureName -> payload -> App Response +setTeamFeatureConfigVersioned versioned user team featureName payload = do tid <- asString team fn <- asString featureName p <- make payload - req <- baseRequest domain Galley versioned $ joinHttpPath ["teams", tid, "features", fn] + req <- baseRequest user Galley versioned $ joinHttpPath ["teams", tid, "features", fn] submit "PUT" $ req & addJSON p diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 7c67af09f8a..44fed9b90cc 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -313,3 +313,45 @@ _testSimpleFlag featureName featureEnabledByDefault = do notif %. "payload.0.name" `shouldMatch` featureName notif %. "payload.0.data" `shouldMatch` defaultValue checkFeature featureName m tid defaultValue + +testConversationGuestLinks :: HasCallStack => App () +testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" True True + +_testSimpleFlagWithLockStatus :: HasCallStack => String -> Bool -> Bool -> App () +_testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlockedByDefault = do + -- let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" + defaultValue <- (if featureEnabledByDefault then enabled else disabled) & setField "lockStatus" (if featureUnlockedByDefault then "unlocked" else "locked") + let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + + checkFeature featureName m tid defaultValue + + -- unlock feature if it is locked + unless featureUnlockedByDefault $ Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- change the status + let otherValue = if featureEnabledByDefault then disabled else enabled + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< Public.setTeamFeatureConfig 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 + + checkFeature featureName m tid otherValue + + -- lock feature + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + + -- feature status should be the default again + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultValue + assertStatus 409 =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + + -- unlock again + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- feature status should be the previously set status again + checkFeature featureName m tid =<< setField "lockStatus" "unlocked" otherValue diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 8bee403f4e3..932664bc27e 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -72,7 +72,6 @@ tests s = test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, - test s "ConversationGuestLinks - lock status" $ testSimpleFlagWithLockStatus @GuestLinksConfig FeatureStatusEnabled LockStatusUnlocked, test s "SndFactorPasswordChallenge - lock status" $ testSimpleFlagWithLockStatus @SndFactorPasswordChallengeConfig FeatureStatusDisabled LockStatusLocked, test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, From 679f7833f1c5f33b0f72085b77e55fda54809474 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Fri, 24 May 2024 14:57:07 +0000 Subject: [PATCH 07/30] ported more tests --- integration/test/Test/FeatureFlags.hs | 9 ++ .../test/integration/API/Teams/Feature.hs | 138 +----------------- 2 files changed, 10 insertions(+), 137 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 44fed9b90cc..b01be35dda3 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -317,6 +317,15 @@ _testSimpleFlag featureName featureEnabledByDefault = do testConversationGuestLinks :: HasCallStack => App () testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" True True +testFileSharing :: HasCallStack => App () +testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" True True + +testSndFactorPasswordChallenge :: HasCallStack => App () +testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" False False + +testOutlookCalIntegration :: HasCallStack => App () +testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" False False + _testSimpleFlagWithLockStatus :: HasCallStack => String -> Bool -> Bool -> App () _testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlockedByDefault = do -- let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 932664bc27e..2e0e34c3d40 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -64,18 +64,15 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "FileSharing with lock status" $ testSimpleFlagWithLockStatus @FileSharingConfig FeatureStatusEnabled LockStatusUnlocked, - test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, + [ test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, test s "All features" testAllFeatures, test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, - test s "SndFactorPasswordChallenge - lock status" $ testSimpleFlagWithLockStatus @SndFactorPasswordChallengeConfig FeatureStatusDisabled LockStatusLocked, test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, - test s "OutlookCalIntegration" $ testSimpleFlagWithLockStatus @OutlookCalIntegrationConfig FeatureStatusDisabled LockStatusLocked, testGroup "TTL / Conference calling" [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, @@ -487,103 +484,6 @@ testSimpleFlagTTL defaultValue ttl = do setFlagInternal defaultValue FeatureTTLUnlimited getFlag defaultValue -testSimpleFlagWithLockStatus :: - forall cfg. - ( HasCallStack, - Typeable cfg, - Eq cfg, - Show cfg, - FeatureTrivialConfig cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - ToSchema cfg, - ToJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - LockStatus -> - TestM () -testSimpleFlagWithLockStatus defaultStatus defaultLockStatus = do - galley <- viewGalley - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let getFlag :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFlag expectedStatus expectedLockStatus = do - let flag = getTeamFeature @cfg member tid - assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus - - getFeatureConfig :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFeatureConfig expectedStatus expectedLockStatus = do - actual <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus actual @?= expectedStatus - liftIO $ wsLockStatus actual @?= expectedLockStatus - - getFlagInternal :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - getFlagInternal expectedStatus expectedLockStatus = do - let flag = getTeamFeatureInternal @cfg tid - assertFlagNoConfigWithLockStatus @cfg flag expectedStatus expectedLockStatus - - getFlags expectedStatus expectedLockStatus = do - getFlag expectedStatus expectedLockStatus - getFeatureConfig expectedStatus expectedLockStatus - getFlagInternal expectedStatus expectedLockStatus - - setFlagWithGalley :: FeatureStatus -> TestM () - setFlagWithGalley statusValue = - putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) - !!! statusCode - === const 200 - - assertSetStatusForbidden :: FeatureStatus -> TestM () - assertSetStatusForbidden statusValue = - putTeamFeature @cfg owner tid (WithStatusNoLock statusValue (trivialConfig @cfg) FeatureTTLUnlimited) - !!! statusCode - === const 409 - - setLockStatus :: LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @cfg galley tid lockStatus - !!! statusCode - === const 200 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherStatus = case defaultStatus of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial status and lock status should be the defaults - getFlags defaultStatus defaultLockStatus - - -- unlock feature if it is locked - when (defaultLockStatus == LockStatusLocked) $ setLockStatus LockStatusUnlocked - - -- setting should work - cannon <- view tsCannon - -- should receive an event - WS.bracketR cannon member $ \ws -> do - setFlagWithGalley otherStatus - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigWithLockStatusUpdate @cfg otherStatus LockStatusUnlocked - - getFlags otherStatus LockStatusUnlocked - - -- lock feature - setLockStatus LockStatusLocked - -- feature status should now be the default again - getFlags defaultStatus LockStatusLocked - assertSetStatusForbidden defaultStatus - -- unlock feature - setLockStatus LockStatusUnlocked - -- feature status should be the previously set value - getFlags otherStatus LockStatusUnlocked - - -- clean up - setFlagWithGalley defaultStatus - setLockStatus defaultLockStatus - getFlags defaultStatus defaultLockStatus - testSelfDeletingMessages :: TestM () testSelfDeletingMessages = do defLockStatus :: LockStatus <- @@ -1169,25 +1069,6 @@ assertFlagNoConfig res expected = do ) === const (Right expected) -assertFlagNoConfigWithLockStatus :: - forall cfg. - ( HasCallStack, - Typeable cfg, - FeatureTrivialConfig cfg, - FromJSON (WithStatus cfg), - Eq cfg, - Show cfg - ) => - TestM ResponseLBS -> - FeatureStatus -> - LockStatus -> - TestM () -assertFlagNoConfigWithLockStatus res expectedStatus expectedLockStatus = do - res !!! do - statusCode === const 200 - responseJsonEither @(WithStatus cfg) - === const (Right (withStatus expectedStatus expectedLockStatus (trivialConfig @cfg) FeatureTTLUnlimited)) - assertFlagWithConfig :: forall cfg m. ( HasCallStack, @@ -1229,23 +1110,6 @@ wsAssertFeatureTrivialConfigUpdate status ttl notification = do @?= Aeson.toJSON (withStatus status (wsLockStatus (defFeatureStatus @cfg)) (trivialConfig @cfg) ttl) -wsAssertFeatureConfigWithLockStatusUpdate :: - forall cfg. - ( IsFeatureConfig cfg, - ToSchema cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg - ) => - FeatureStatus -> - LockStatus -> - Notification -> - IO () -wsAssertFeatureConfigWithLockStatusUpdate status lockStatus notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= (featureName @cfg) - FeatureConfig._eventData e @?= Aeson.toJSON (withStatus status lockStatus (trivialConfig @cfg) FeatureTTLUnlimited) - wsAssertFeatureConfigUpdate :: forall cfg. ( KnownSymbol (FeatureSymbol cfg), From aeeab162863e6a279dc3db7120be86636f96d5b7 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 06:17:35 +0000 Subject: [PATCH 08/30] classified domains tests --- integration/test/Test/FeatureFlags.hs | 13 +++++++++ .../test/integration/API/Teams/Feature.hs | 29 ++----------------- 2 files changed, 15 insertions(+), 27 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index b01be35dda3..848cf4a52a4 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -364,3 +364,16 @@ _testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlocke -- feature status should be the previously set status again checkFeature featureName m tid =<< setField "lockStatus" "unlocked" otherValue + +testClassifiedDomainsEnabled :: HasCallStack => App () +testClassifiedDomainsEnabled = do + (_, tid, m : _) <- createTeam OwnDomain 2 + expected <- enabled & setField "config.domains" ["example.com"] + checkFeature "classifiedDomains" m tid expected + +testClassifiedDomainsDisabled :: HasCallStack => App () +testClassifiedDomainsDisabled = do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.classifiedDomains.status" "disabled"} $ \domain -> do + (_, tid, m : _) <- createTeam domain 2 + expected <- disabled & setField "config.domains" ["d1.example.com"] + checkFeature "classifiedDomains" m tid expected diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 2e0e34c3d40..ed49cacee5c 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -26,7 +26,7 @@ import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) import Cassandra as Cql -import Control.Lens (over, to, view, (.~), (?~)) +import Control.Lens (to, view, (.~), (?~)) import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) import Data.Aeson (FromJSON, ToJSON) @@ -64,9 +64,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "Classified Domains (enabled)" testClassifiedDomainsEnabled, - test s "Classified Domains (disabled)" testClassifiedDomainsDisabled, - test s "All features" testAllFeatures, + [ test s "All features" testAllFeatures, test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, @@ -270,29 +268,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testClassifiedDomainsEnabled :: TestM () -testClassifiedDomainsEnabled = do - (_, tid, member : _) <- createBindingTeamWithNMembers 1 - let expected = - withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited - - checkTeamFeatureAllEndpoints member tid expected - -testClassifiedDomainsDisabled :: TestM () -testClassifiedDomainsDisabled = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - let expected = - withStatus FeatureStatusDisabled LockStatusUnlocked (ClassifiedDomainsConfig []) FeatureTTLUnlimited - - let classifiedDomainsDisabled opts = - opts - & over - (settings . featureFlags . flagClassifiedDomains) - (\(ImplicitLockStatus s) -> ImplicitLockStatus (s & setStatus FeatureStatusDisabled & setConfig (ClassifiedDomainsConfig []))) - - withSettingsOverrides classifiedDomainsDisabled $ - checkTeamFeatureAllEndpoints member tid expected - testSimpleFlagTTLOverride :: forall cfg. ( HasCallStack, From 956a21f0ea9c01d0490c64dc078a6a7d5b3183bc Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 10:34:24 +0000 Subject: [PATCH 09/30] all feature configs --- integration/test/Test/FeatureFlags.hs | 84 +++++++++++++++++++ .../test/integration/API/Teams/Feature.hs | 77 +---------------- 2 files changed, 85 insertions(+), 76 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 848cf4a52a4..df86d68249d 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -377,3 +377,87 @@ testClassifiedDomainsDisabled = do (_, tid, m : _) <- createTeam domain 2 expected <- disabled & setField "config.domains" ["d1.example.com"] checkFeature "classifiedDomains" m tid expected + +-- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all +-- features are there. +testAllFeatures :: HasCallStack => App () +testAllFeatures = do + (_, tid, m : _) <- createTeam OwnDomain 2 + let 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]], + "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]], + "conversationGuestLinks" .= enabled, + "sndFactorPasswordChallenge" .= disabledLocked, + "mls" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ], + "searchVisibilityInbound" .= disabled, + "exposeInvitationURLsToTeamAdmin" .= disabledLocked, + "outlookCalIntegration" .= disabledLocked, + "mlsE2EId" + .= object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ], + "mlsMigration" + .= object + [ "lockStatus" .= "locked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" + ] + ], + "enforceFileDownloadLocation" .= object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []], + "limitedEventFanout" .= disabled + ] + bindResponse (Public.getTeamFeatures m tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + -- This block catches potential errors in the logic that reverts to default if there is a distinction made between + -- 1. there is no row for a team_id in galley.team_features + -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) + Internal.setTeamFeatureConfig OwnDomain tid "conversationGuestLinks" enabled >>= assertSuccess + + bindResponse (Public.getTeamFeatures m tid) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + bindResponse (Public.getFeatureConfigs m) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json + + randomPersonalUser <- randomUser OwnDomain def + + bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do + resp.status `shouldMatchInt` 200 + expected `shouldMatch` resp.json diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index ed49cacee5c..f6d2c09166b 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -34,7 +34,6 @@ import Data.Aeson qualified as Aeson import Data.Aeson.Key qualified as AesonKey import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Char8 (unpack) -import Data.Domain (Domain (..)) import Data.Id import Data.Json.Util (fromUTCTimeMillis, readUTCTimeMillis) import Data.List1 qualified as List1 @@ -64,8 +63,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "All features" testAllFeatures, - test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, + [ test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, @@ -612,71 +610,6 @@ testGuestLinks getStatus putStatus setLockStatusInternal = do checkSetLockStatusInternal LockStatusUnlocked checkGet FeatureStatusDisabled LockStatusUnlocked --- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all --- features are there. -testAllFeatures :: TestM () -testAllFeatures = do - defLockStatus :: LockStatus <- - view - ( tsGConf - . settings - . featureFlags - . flagSelfDeletingMessages - . unDefaults - . to wsLockStatus - ) - - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - getAllTeamFeatures member tid !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - -- This block catches potential errors in the logic that reverts to default if there is a distinction made between - -- 1. there is no row for a team_id in galley.team_features - -- 2. there is a row for team_id in galley.team_features but the feature has a no entry (null value) - galley <- viewGalley - -- this sets the guest links config to its default value thereby creating a row for the team in galley.team_features - putTeamFeatureInternal @GuestLinksConfig galley tid (WithStatusNoLock FeatureStatusEnabled GuestLinksConfig FeatureTTLUnlimited) - !!! statusCode - === const 200 - getAllTeamFeatures member tid !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - getAllFeatureConfigs member !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by default in galley -})) - - randomPersonalUser <- randomUser - getAllFeatureConfigs randomPersonalUser !!! do - statusCode === const 200 - responseJsonMaybe === const (Just (expected FeatureStatusEnabled defLockStatus {- determined by 'getAfcConferenceCallingDefNew' in brig -})) - where - expected confCalling lockStateSelfDeleting = - AllFeatureConfigs - { afcLegalholdStatus = withStatus FeatureStatusDisabled LockStatusUnlocked LegalholdConfig FeatureTTLUnlimited, - afcSSOStatus = withStatus FeatureStatusDisabled LockStatusUnlocked SSOConfig FeatureTTLUnlimited, - afcTeamSearchVisibilityAvailable = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityAvailableConfig FeatureTTLUnlimited, - afcValidateSAMLEmails = withStatus FeatureStatusEnabled LockStatusUnlocked ValidateSAMLEmailsConfig FeatureTTLUnlimited, - afcDigitalSignatures = withStatus FeatureStatusDisabled LockStatusUnlocked DigitalSignaturesConfig FeatureTTLUnlimited, - afcAppLock = withStatus FeatureStatusEnabled LockStatusUnlocked (AppLockConfig (EnforceAppLock False) (60 :: Int32)) FeatureTTLUnlimited, - afcFileSharing = withStatus FeatureStatusEnabled LockStatusUnlocked FileSharingConfig FeatureTTLUnlimited, - afcClassifiedDomains = withStatus FeatureStatusEnabled LockStatusUnlocked (ClassifiedDomainsConfig [Domain "example.com"]) FeatureTTLUnlimited, - afcConferenceCalling = withStatus confCalling LockStatusUnlocked ConferenceCallingConfig FeatureTTLUnlimited, - afcSelfDeletingMessages = withStatus FeatureStatusEnabled lockStateSelfDeleting (SelfDeletingMessagesConfig 0) FeatureTTLUnlimited, - afcGuestLink = withStatus FeatureStatusEnabled LockStatusUnlocked GuestLinksConfig FeatureTTLUnlimited, - afcSndFactorPasswordChallenge = withStatus FeatureStatusDisabled LockStatusLocked SndFactorPasswordChallengeConfig FeatureTTLUnlimited, - afcMLS = withStatus FeatureStatusDisabled LockStatusUnlocked (MLSConfig [] ProtocolProteusTag [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 [ProtocolProteusTag, ProtocolMLSTag]) FeatureTTLUnlimited, - afcSearchVisibilityInboundConfig = withStatus FeatureStatusDisabled LockStatusUnlocked SearchVisibilityInboundConfig FeatureTTLUnlimited, - afcExposeInvitationURLsToTeamAdmin = withStatus FeatureStatusDisabled LockStatusLocked ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited, - afcOutlookCalIntegration = withStatus FeatureStatusDisabled LockStatusLocked OutlookCalIntegrationConfig FeatureTTLUnlimited, - afcMlsE2EId = withStatus FeatureStatusDisabled LockStatusUnlocked (wsConfig defFeatureStatus) FeatureTTLUnlimited, - afcMlsMigration = defaultMlsMigrationConfig, - afcEnforceFileDownloadLocation = defaultEnforceFileDownloadLocationConfig, - afcLimitedEventFanout = - withStatus FeatureStatusDisabled LockStatusUnlocked LimitedEventFanoutConfig FeatureTTLUnlimited - } - testFeatureConfigConsistency :: TestM () testFeatureConfigConsistency = do (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 @@ -1110,11 +1043,3 @@ defaultMlsMigrationConfig = finaliseRegardlessAfter = fmap fromUTCTimeMillis (readUTCTimeMillis "2029-10-17T00:00:00.000Z") } FeatureTTLUnlimited - -defaultEnforceFileDownloadLocationConfig :: WithStatus EnforceFileDownloadLocationConfig -defaultEnforceFileDownloadLocationConfig = - withStatus - FeatureStatusDisabled - LockStatusLocked - (EnforceFileDownloadLocationConfig Nothing) - FeatureTTLUnlimited From 6118e76a87f5faa23dafadd335fcff7924fd51ba Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 10:46:42 +0000 Subject: [PATCH 10/30] test feature consistency --- integration/test/Test/FeatureFlags.hs | 21 +++++++++++++ .../test/integration/API/Teams/Feature.hs | 30 ++----------------- 2 files changed, 23 insertions(+), 28 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index df86d68249d..96f4e2888c4 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -22,6 +22,9 @@ import qualified API.GalleyInternal as Internal 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 Notifications import SetupHelpers import Test.FeatureFlags.Util @@ -461,3 +464,21 @@ testAllFeatures = do bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do resp.status `shouldMatchInt` 200 expected `shouldMatch` resp.json + +testFeatureConfigConsistency :: HasCallStack => App () +testFeatureConfigConsistency = do + (_, tid, m : _) <- createTeam OwnDomain 2 + + allFeaturesRes <- Public.getFeatureConfigs m >>= parseObjectKeys + + allTeamFeaturesRes <- Public.getTeamFeatures m tid >>= parseObjectKeys + + unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ + assertFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) + where + parseObjectKeys :: Response -> App (Set.Set String) + parseObjectKeys res = do + val <- res.json + case val of + (A.Object hm) -> pure (Set.fromList . map (show . A.toText) . KM.keys $ hm) + x -> assertFailure ("JSON was not an object, but " <> show x) diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index f6d2c09166b..a3273f17d29 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -31,25 +31,21 @@ import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) import Data.Aeson (FromJSON, ToJSON) import Data.Aeson qualified as Aeson -import Data.Aeson.Key qualified as AesonKey -import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString.Char8 (unpack) import Data.Id import Data.Json.Util (fromUTCTimeMillis, readUTCTimeMillis) import Data.List1 qualified as List1 import Data.Schema (ToSchema) -import Data.Set qualified as Set import Data.Timeout (TimeoutUnit (Second), (#)) import GHC.TypeLits (KnownSymbol) import Galley.Options (exposeInvitationURLsTeamAllowlist, featureFlags, settings) import Galley.Types.Teams import Imports import Network.Wai.Utilities (label) -import Test.Hspec (expectationFailure) import Test.QuickCheck (Gen, generate, suchThat) import Test.Tasty import Test.Tasty.Cannon qualified as WS -import Test.Tasty.HUnit (assertFailure, (@?=)) +import Test.Tasty.HUnit ((@?=)) import TestHelpers (test) import TestSetup import Wire.API.Conversation.Protocol @@ -63,8 +59,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "Feature Configs / Team Features Consistency" testFeatureConfigConsistency, - test s "SelfDeletingMessages" testSelfDeletingMessages, + [ test s "SelfDeletingMessages" testSelfDeletingMessages, test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, @@ -610,27 +605,6 @@ testGuestLinks getStatus putStatus setLockStatusInternal = do checkSetLockStatusInternal LockStatusUnlocked checkGet FeatureStatusDisabled LockStatusUnlocked -testFeatureConfigConsistency :: TestM () -testFeatureConfigConsistency = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - - allFeaturesRes <- getAllFeatureConfigs member >>= parseObjectKeys - - allTeamFeaturesRes <- getAllTeamFeatures member tid >>= parseObjectKeys - - unless (allTeamFeaturesRes `Set.isSubsetOf` allFeaturesRes) $ - liftIO $ - expectationFailure (show allTeamFeaturesRes <> " is not a subset of " <> show allFeaturesRes) - where - parseObjectKeys :: ResponseLBS -> TestM (Set.Set Text) - parseObjectKeys res = do - case responseJsonEither res of - Left err -> liftIO $ assertFailure ("Did not parse as an object" <> err) - Right (val :: Aeson.Value) -> - case val of - (Aeson.Object hm) -> pure (Set.fromList . map AesonKey.toText . KeyMap.keys $ hm) - x -> liftIO $ assertFailure ("JSON was not an object, but " <> show x) - testSearchVisibilityInbound :: TestM () testSearchVisibilityInbound = do let defaultValue = FeatureStatusDisabled From c486b3c566dd67f0c488ba6232bf90d89b39595b Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 12:09:21 +0000 Subject: [PATCH 11/30] self deleting messages --- integration/test/Test/FeatureFlags.hs | 70 ++++++++++++ services/galley/galley.cabal | 1 - .../test/integration/API/Teams/Feature.hs | 108 +----------------- 3 files changed, 73 insertions(+), 106 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 96f4e2888c4..3cf6ae9d582 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -482,3 +482,73 @@ testFeatureConfigConsistency = do case val of (A.Object hm) -> pure (Set.fromList . map (show . A.toText) . KM.keys $ hm) x -> assertFailure ("JSON was not an object, but " <> show x) + +testSelfDeletingMessages :: HasCallStack => App () +testSelfDeletingMessages = + _testLockStatusWithConfig + "selfDeletingMessages" + (object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + +_testLockStatusWithConfig :: HasCallStack => String -> Value -> Value -> App () +_testLockStatusWithConfig featureName defaultSetting configUpdate = do + -- personal user + randomPersonalUser <- randomUser OwnDomain def + + bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. featureName `shouldMatch` defaultSetting + + -- team user + defaultConfig <- defaultSetting %. "config" + + featureUnlockedByDefault <- do + ls <- defaultSetting %. "lockStatus" >>= asString + pure $ ls == "unlocked" + + featureEnabledByDefault <- do + s <- defaultSetting %. "status" >>= asString + pure $ s == "enabled" + + (owner, tid, m : _) <- createTeam OwnDomain 2 + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + + checkFeature featureName m tid defaultSetting + + -- unlock feature if it is locked + unless featureUnlockedByDefault $ Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- change the status + let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" + defaultSettingWithOtherStatus <- defaultSetting & setField "status" otherStatus + + void $ withWebSockets [m] $ \wss -> do + assertSuccess =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus, "config" .= defaultConfig]) + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` defaultSettingWithOtherStatus + + checkFeature featureName m tid defaultSettingWithOtherStatus + + -- lock feature + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + + -- feature status should be the default again + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultSetting + assertStatus 409 =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus, "config" .= defaultConfig]) + + -- unlock again + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + -- feature status should be the previously set status again + checkFeature featureName m tid defaultSettingWithOtherStatus + + bindResponse (Public.setTeamFeatureConfig owner tid featureName configUpdate) $ \resp -> do + resp.status `shouldMatchInt` 200 + checkFeature featureName m tid =<< (configUpdate & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + -- after locking once again it should be the default again + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultSetting diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 25e88c7ae18..53fe0072284 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -489,7 +489,6 @@ executable galley-integration , galley , galley-types , HsOpenSSL - , hspec , http-api-data , http-client , http-client-openssl diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index a3273f17d29..ecf83e3ea86 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -26,7 +26,7 @@ import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) import Cassandra as Cql -import Control.Lens (to, view, (.~), (?~)) +import Control.Lens (view, (.~), (?~)) import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) import Data.Aeson (FromJSON, ToJSON) @@ -38,8 +38,7 @@ import Data.List1 qualified as List1 import Data.Schema (ToSchema) import Data.Timeout (TimeoutUnit (Second), (#)) import GHC.TypeLits (KnownSymbol) -import Galley.Options (exposeInvitationURLsTeamAllowlist, featureFlags, settings) -import Galley.Types.Teams +import Galley.Options (exposeInvitationURLsTeamAllowlist, settings) import Imports import Network.Wai.Utilities (label) import Test.QuickCheck (Gen, generate, suchThat) @@ -59,8 +58,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "SelfDeletingMessages" testSelfDeletingMessages, - test s "ConversationGuestLinks - public API" testGuestLinksPublic, + [ test s "ConversationGuestLinks - public API" testGuestLinksPublic, test s "ConversationGuestLinks - internal API" testGuestLinksInternal, test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, @@ -452,106 +450,6 @@ testSimpleFlagTTL defaultValue ttl = do setFlagInternal defaultValue FeatureTTLUnlimited getFlag defaultValue -testSelfDeletingMessages :: TestM () -testSelfDeletingMessages = do - defLockStatus :: LockStatus <- - view - ( tsGConf - . settings - . featureFlags - . flagSelfDeletingMessages - . unDefaults - . to wsLockStatus - ) - - -- personal users - let settingWithoutLockStatus :: FeatureStatus -> Int32 -> WithStatusNoLock SelfDeletingMessagesConfig - settingWithoutLockStatus stat tout = - WithStatusNoLock - stat - (SelfDeletingMessagesConfig tout) - FeatureTTLUnlimited - settingWithLockStatus :: FeatureStatus -> Int32 -> LockStatus -> WithStatus SelfDeletingMessagesConfig - settingWithLockStatus stat tout lockStatus = - withStatus - stat - lockStatus - (SelfDeletingMessagesConfig tout) - FeatureTTLUnlimited - - personalUser <- randomUser - do - result <- Util.getFeatureConfig @SelfDeletingMessagesConfig personalUser - liftIO $ result @?= settingWithLockStatus FeatureStatusEnabled 0 defLockStatus - - -- team users - galley <- viewGalley - (owner, tid, []) <- createBindingTeamWithNMembers 0 - - let checkSet :: FeatureStatus -> Int32 -> Int -> TestM () - checkSet stat tout expectedStatusCode = - do - putTeamFeatureInternal @SelfDeletingMessagesConfig - galley - tid - (settingWithoutLockStatus stat tout) - !!! statusCode - === const expectedStatusCode - - -- internal, public (/team/:tid/features), and team-agnostic (/feature-configs). - checkGet :: HasCallStack => FeatureStatus -> Int32 -> LockStatus -> TestM () - checkGet stat tout lockStatus = do - let expected = settingWithLockStatus stat tout lockStatus - forM_ - [ getTeamFeatureInternal @SelfDeletingMessagesConfig tid, - getTeamFeature @SelfDeletingMessagesConfig owner tid - ] - (!!! responseJsonEither === const (Right expected)) - result <- Util.getFeatureConfig @SelfDeletingMessagesConfig owner - liftIO $ result @?= expected - - checkSetLockStatus :: HasCallStack => LockStatus -> TestM () - checkSetLockStatus status = - do - Util.setLockStatusInternal @SelfDeletingMessagesConfig galley tid status - !!! statusCode - === const 200 - - -- test that the default lock status comes from `galley.yaml`. - -- use this to change `galley.integration.yaml` locally and manually test that conf file - -- parsing works as expected. - checkGet FeatureStatusEnabled 0 defLockStatus - - case defLockStatus of - LockStatusLocked -> do - checkSet FeatureStatusDisabled 0 409 - LockStatusUnlocked -> do - checkSet FeatureStatusDisabled 0 200 - checkGet FeatureStatusDisabled 0 LockStatusUnlocked - checkSet FeatureStatusEnabled 0 200 - checkGet FeatureStatusEnabled 0 LockStatusUnlocked - - -- now don't worry about what's in the config, write something to cassandra, and test with that. - checkSetLockStatus LockStatusLocked - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusDisabled 0 409 - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusEnabled 30 409 - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSetLockStatus LockStatusUnlocked - checkGet FeatureStatusEnabled 0 LockStatusUnlocked - checkSet FeatureStatusDisabled 0 200 - checkGet FeatureStatusDisabled 0 LockStatusUnlocked - checkSet FeatureStatusEnabled 30 200 - checkGet FeatureStatusEnabled 30 LockStatusUnlocked - checkSet FeatureStatusDisabled 30 200 - checkGet FeatureStatusDisabled 30 LockStatusUnlocked - checkSetLockStatus LockStatusLocked - checkGet FeatureStatusEnabled 0 LockStatusLocked - checkSet FeatureStatusEnabled 50 409 - checkSetLockStatus LockStatusUnlocked - checkGet FeatureStatusDisabled 30 LockStatusUnlocked - testGuestLinksInternal :: TestM () testGuestLinksInternal = do galley <- viewGalley From 3f8af5e249b44d709c5dd3e4a065d8a0b3bb2ea9 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 12:33:47 +0000 Subject: [PATCH 12/30] interal and public tests --- integration/test/Test/FeatureFlags.hs | 43 +++++++++++--- .../test/integration/API/Teams/Feature.hs | 57 +------------------ 2 files changed, 36 insertions(+), 64 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 3cf6ae9d582..1573430e323 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -318,21 +318,40 @@ _testSimpleFlag featureName featureEnabledByDefault = do checkFeature featureName m tid defaultValue testConversationGuestLinks :: HasCallStack => App () -testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" True True +testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" Public.setTeamFeatureConfig True True testFileSharing :: HasCallStack => App () -testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" True True +testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" Public.setTeamFeatureConfig True True testSndFactorPasswordChallenge :: HasCallStack => App () -testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" False False +testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Public.setTeamFeatureConfig False False testOutlookCalIntegration :: HasCallStack => App () -testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" False False +testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" Public.setTeamFeatureConfig False False -_testSimpleFlagWithLockStatus :: HasCallStack => String -> Bool -> Bool -> App () -_testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlockedByDefault = do +testConversationGuestLinksInternal :: HasCallStack => App () +testConversationGuestLinksInternal = _testSimpleFlagWithLockStatus "conversationGuestLinks" Internal.setTeamFeatureConfig True True + +testFileSharingInternal :: HasCallStack => App () +testFileSharingInternal = _testSimpleFlagWithLockStatus "fileSharing" Internal.setTeamFeatureConfig True True + +testSndFactorPasswordChallengeInternal :: HasCallStack => App () +testSndFactorPasswordChallengeInternal = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Internal.setTeamFeatureConfig False False + +testOutlookCalIntegrationInternal :: HasCallStack => App () +testOutlookCalIntegrationInternal = _testSimpleFlagWithLockStatus "outlookCalIntegration" Internal.setTeamFeatureConfig False False + +_testSimpleFlagWithLockStatus :: + HasCallStack => + String -> + (Value -> String -> String -> Value -> App Response) -> + Bool -> + Bool -> + App () +_testSimpleFlagWithLockStatus featureName setFeatureConfig featureEnabledByDefault featureUnlockedByDefault = do -- let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" defaultValue <- (if featureEnabledByDefault then enabled else disabled) & setField "lockStatus" (if featureUnlockedByDefault then "unlocked" else "locked") + let thisStatus = if featureEnabledByDefault then "enabled" else "disabled" let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" (owner, tid, m : _) <- createTeam OwnDomain 2 @@ -347,7 +366,7 @@ _testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlocke -- change the status let otherValue = if featureEnabledByDefault then disabled else enabled void $ withWebSockets [m] $ \wss -> do - assertSuccess =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) for_ wss $ \ws -> do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` featureName @@ -355,12 +374,20 @@ _testSimpleFlagWithLockStatus featureName featureEnabledByDefault featureUnlocke checkFeature featureName m tid otherValue + bindResponse (setFeatureConfig owner tid featureName (object ["status" .= thisStatus])) $ \resp -> do + resp.status `shouldMatchInt` 200 + checkFeature featureName m tid (object ["status" .= thisStatus, "lockStatus" .= "unlocked", "ttl" .= "unlimited"]) + + bindResponse (setFeatureConfig owner tid featureName (object ["status" .= otherStatus])) $ \resp -> do + resp.status `shouldMatchInt` 200 + checkFeature featureName m tid (object ["status" .= otherStatus, "lockStatus" .= "unlocked", "ttl" .= "unlimited"]) + -- lock feature Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" -- feature status should be the default again checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultValue - assertStatus 409 =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus]) + assertStatus 409 =<< setFeatureConfig owner tid featureName (object ["status" .= otherStatus]) -- unlock again Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index ecf83e3ea86..28c21611e15 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -58,9 +58,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "ConversationGuestLinks - public API" testGuestLinksPublic, - test s "ConversationGuestLinks - internal API" testGuestLinksInternal, - test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, + [ test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, testGroup "TTL / Conference calling" @@ -450,59 +448,6 @@ testSimpleFlagTTL defaultValue ttl = do setFlagInternal defaultValue FeatureTTLUnlimited getFlag defaultValue -testGuestLinksInternal :: TestM () -testGuestLinksInternal = do - galley <- viewGalley - testGuestLinks - (const $ getTeamFeatureInternal @GuestLinksConfig) - (const $ putTeamFeatureInternal @GuestLinksConfig galley) - (Util.setLockStatusInternal @GuestLinksConfig galley) - -testGuestLinksPublic :: TestM () -testGuestLinksPublic = do - galley <- viewGalley - testGuestLinks - (getTeamFeature @GuestLinksConfig) - (putTeamFeature @GuestLinksConfig) - (Util.setLockStatusInternal @GuestLinksConfig galley) - -testGuestLinks :: - (UserId -> TeamId -> TestM ResponseLBS) -> - (UserId -> TeamId -> WithStatusNoLock GuestLinksConfig -> TestM ResponseLBS) -> - (TeamId -> LockStatus -> TestM ResponseLBS) -> - TestM () -testGuestLinks getStatus putStatus setLockStatusInternal = do - (owner, tid, []) <- createBindingTeamWithNMembers 0 - let checkGet :: HasCallStack => FeatureStatus -> LockStatus -> TestM () - checkGet status lock = - getStatus owner tid !!! do - statusCode === const 200 - responseJsonEither === const (Right (withStatus status lock GuestLinksConfig FeatureTTLUnlimited)) - - checkSet :: HasCallStack => FeatureStatus -> Int -> TestM () - checkSet status expectedStatusCode = - putStatus owner tid (WithStatusNoLock status GuestLinksConfig FeatureTTLUnlimited) !!! statusCode === const expectedStatusCode - - checkSetLockStatusInternal :: HasCallStack => LockStatus -> TestM () - checkSetLockStatusInternal lockStatus = - setLockStatusInternal tid lockStatus !!! statusCode === const 200 - - checkGet FeatureStatusEnabled LockStatusUnlocked - checkSet FeatureStatusDisabled 200 - checkGet FeatureStatusDisabled LockStatusUnlocked - checkSet FeatureStatusEnabled 200 - checkGet FeatureStatusEnabled LockStatusUnlocked - checkSet FeatureStatusDisabled 200 - checkGet FeatureStatusDisabled LockStatusUnlocked - -- when locks status is locked the team default feature status should be returned - -- and the team feature status can not be changed - checkSetLockStatusInternal LockStatusLocked - checkGet FeatureStatusEnabled LockStatusLocked - checkSet FeatureStatusDisabled 409 - -- when lock status is unlocked again the previously set feature status is restored - checkSetLockStatusInternal LockStatusUnlocked - checkGet FeatureStatusDisabled LockStatusUnlocked - testSearchVisibilityInbound :: TestM () testSearchVisibilityInbound = do let defaultValue = FeatureStatusDisabled From 12423836294683e72c6a4c04462276ceeeb16c1d Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 12:53:23 +0000 Subject: [PATCH 13/30] search visibility inbound --- integration/test/Test/FeatureFlags.hs | 29 ++++++++++--------- .../test/integration/API/Teams/Feature.hs | 25 +--------------- 2 files changed, 17 insertions(+), 37 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 1573430e323..aee56ce2b8d 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -278,39 +278,42 @@ testSearchVisibilityEnabledByDefault = do assertSuccess =<< Internal.setTeamFeatureStatus owner tid "searchVisibility" "enabled" checkFeature "searchVisibility" owner tid enabled -testDigitalSignatures :: HasCallStack => App () -testDigitalSignatures = _testSimpleFlag "digitalSignatures" False +testSearchVisibilityInbound :: HasCallStack => App () +testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" Public.setTeamFeatureConfig False -testValidateSAMLEmails :: HasCallStack => App () -testValidateSAMLEmails = _testSimpleFlag "validateSAMLemails" True +testDigitalSignaturesInternal :: HasCallStack => App () +testDigitalSignaturesInternal = _testSimpleFlag "digitalSignatures" Internal.setTeamFeatureConfig False -testConferenceCalling :: HasCallStack => App () -testConferenceCalling = _testSimpleFlag "conferenceCalling" True +testValidateSAMLEmailsInternal :: HasCallStack => App () +testValidateSAMLEmailsInternal = _testSimpleFlag "validateSAMLemails" Internal.setTeamFeatureConfig True -testSearchVisibilityInbound :: HasCallStack => App () -testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" False +testConferenceCallingInternal :: HasCallStack => App () +testConferenceCallingInternal = _testSimpleFlag "conferenceCalling" Internal.setTeamFeatureConfig True + +testSearchVisibilityInboundInternal :: HasCallStack => App () +testSearchVisibilityInboundInternal = _testSimpleFlag "searchVisibilityInbound" Internal.setTeamFeatureConfig False -_testSimpleFlag :: HasCallStack => String -> Bool -> App () -_testSimpleFlag featureName featureEnabledByDefault = do +_testSimpleFlag :: HasCallStack => String -> (Value -> String -> String -> Value -> App Response) -> Bool -> App () +_testSimpleFlag featureName setFeatureConfig featureEnabledByDefault = do let defaultStatus = if featureEnabledByDefault then "enabled" else "disabled" let defaultValue = if featureEnabledByDefault then enabled else disabled let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" let otherValue = if featureEnabledByDefault then disabled else enabled - (_, tid, m : _) <- createTeam OwnDomain 2 + (owner, tid, m : _) <- createTeam OwnDomain 2 nonTeamMember <- randomUser OwnDomain def assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName checkFeature featureName m tid defaultValue -- should receive an event void $ withWebSockets [m] $ \wss -> do - assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain tid featureName otherStatus + 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 checkFeature featureName m tid otherValue - assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain tid featureName defaultStatus + assertSuccess =<< setFeatureConfig owner tid featureName (object ["status" .= defaultStatus]) for_ wss $ \ws -> do notif <- awaitMatch isFeatureConfigUpdateNotif ws notif %. "payload.0.name" `shouldMatch` featureName diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 28c21611e15..b6640d3e58b 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -58,8 +58,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "SearchVisibilityInbound - internal API" testSearchVisibilityInbound, - test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, + [ test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, testGroup "TTL / Conference calling" [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, @@ -448,28 +447,6 @@ testSimpleFlagTTL defaultValue ttl = do setFlagInternal defaultValue FeatureTTLUnlimited getFlag defaultValue -testSearchVisibilityInbound :: TestM () -testSearchVisibilityInbound = do - let defaultValue = FeatureStatusDisabled - (_owner, tid, _) <- createBindingTeamWithNMembers 1 - - let getFlagInternal :: HasCallStack => FeatureStatus -> TestM () - getFlagInternal expected = - flip (assertFlagNoConfig @SearchVisibilityInboundConfig) expected $ getTeamFeatureInternal @SearchVisibilityInboundConfig tid - - setFlagInternal :: FeatureStatus -> TestM () - setFlagInternal statusValue = - void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - getFlagInternal defaultValue - setFlagInternal otherValue - getFlagInternal otherValue - testFeatureNoConfigMultiSearchVisibilityInbound :: TestM () testFeatureNoConfigMultiSearchVisibilityInbound = do (_owner1, team1, _) <- createBindingTeamWithNMembers 0 From fcdbfef9ad2ab1e2957931fd7e9eefaa5c5bf100 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 13:50:37 +0000 Subject: [PATCH 14/30] search visibility inbound multi --- integration/test/API/GalleyInternal.hs | 7 +++++ integration/test/Test/FeatureFlags.hs | 13 ++++++++ .../test/integration/API/Teams/Feature.hs | 31 +------------------ 3 files changed, 21 insertions(+), 30 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index 56cb982830c..f012141c438 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -104,3 +104,10 @@ setTeamFeatureConfig domain team featureName payload = do p <- make payload req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", fn] submit "PUT" $ 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 + fn <- asString featureName + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "features-multi-teams", fn] + submit "POST" $ req & addJSONObject ["teams" .= tids] diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index aee56ce2b8d..b18176aacc7 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -582,3 +582,16 @@ _testLockStatusWithConfig featureName defaultSetting configUpdate = do -- after locking once again it should be the default again Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultSetting + +testFeatureNoConfigMultiSearchVisibilityInbound :: HasCallStack => App () +testFeatureNoConfigMultiSearchVisibilityInbound = do + (_owner1, team1, _) <- createTeam OwnDomain 0 + (_owner2, team2, _) <- createTeam OwnDomain 0 + + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain team2 "searchVisibilityInbound" "enabled" + + response <- Internal.getFeatureStatusMulti OwnDomain "searchVisibilityInbound" [team1, team2] + + statuses <- response.json %. "default_status" >>= asList + length statuses `shouldMatchInt` 2 + statuses `shouldMatchSet` [object ["team" .= team1, "status" .= "disabled"], object ["team" .= team2, "status" .= "enabled"]] diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index b6640d3e58b..b0bdfc2d750 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -51,15 +51,13 @@ import Wire.API.Conversation.Protocol import Wire.API.Event.FeatureConfig qualified as FeatureConfig import Wire.API.Internal.Notification (Notification) import Wire.API.MLS.CipherSuite -import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti as Multi import Wire.API.Team.Feature hiding (setLockStatus) tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "SearchVisibilityInbound - internal multi team API" testFeatureNoConfigMultiSearchVisibilityInbound, - testGroup + [ testGroup "TTL / Conference calling" [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, test s "ConferenceCalling 2s TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) @@ -447,33 +445,6 @@ testSimpleFlagTTL defaultValue ttl = do setFlagInternal defaultValue FeatureTTLUnlimited getFlag defaultValue -testFeatureNoConfigMultiSearchVisibilityInbound :: TestM () -testFeatureNoConfigMultiSearchVisibilityInbound = do - (_owner1, team1, _) <- createBindingTeamWithNMembers 0 - (_owner2, team2, _) <- createBindingTeamWithNMembers 0 - - let setFlagInternal :: TeamId -> FeatureStatus -> TestM () - setFlagInternal tid statusValue = - void $ putTeamFeatureInternal @SearchVisibilityInboundConfig expect2xx tid (WithStatusNoLock statusValue SearchVisibilityInboundConfig FeatureTTLUnlimited) - - setFlagInternal team2 FeatureStatusEnabled - - r <- - getFeatureStatusMulti @SearchVisibilityInboundConfig (Multi.TeamFeatureNoConfigMultiRequest [team1, team2]) - Date: Mon, 27 May 2024 16:26:44 +0000 Subject: [PATCH 15/30] ttl overrides --- integration/test/Test/FeatureFlags.hs | 60 ++++++++++ integration/test/Test/FeatureFlags/Util.hs | 45 +++++++- .../test/integration/API/Teams/Feature.hs | 104 ------------------ 3 files changed, 100 insertions(+), 109 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index b18176aacc7..b99d732ac9b 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -19,12 +19,14 @@ 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 @@ -595,3 +597,61 @@ testFeatureNoConfigMultiSearchVisibilityInbound = do statuses <- response.json %. "default_status" >>= asList 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 diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index 2b46347b23b..a83430c7f86 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -19,6 +19,7 @@ module Test.FeatureFlags.Util where import qualified API.Galley as Public import qualified API.GalleyInternal as Internal +import qualified Data.Aeson as A import Testlib.Prelude disabled :: Value @@ -31,21 +32,55 @@ enabled :: Value enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"] checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () -checkFeature feature user tid expected = do +checkFeature = checkFeatureWith shouldMatch + +checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => (App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () +checkFeatureWith shouldMatchStatus 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 + resp.json `shouldMatchStatus` expected bindResponse (Public.getTeamFeatures user tid) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatch` expected + resp.json %. feature `shouldMatchStatus` expected bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json `shouldMatch` expected + resp.json `shouldMatchStatus` expected bindResponse (Public.getFeatureConfigs user) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatch` expected + resp.json %. feature `shouldMatchStatus` expected + +checkFeatureLenientTtl :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () +checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl + where + shouldMatchLenientTtl :: App Value -> Value -> App () + shouldMatchLenientTtl actual expected = do + expectedLockStatus <- expected %. "lockStatus" + actual %. "lockStatus" `shouldMatch` expectedLockStatus + expectedStatus <- expected %. "status" + actual %. "status" `shouldMatch` expectedStatus + mExpectedConfig <- lookupField expected "config" + mActualConfig <- lookupField actual "config" + mActualConfig `shouldMatch` mExpectedConfig + expectedTtl <- expected %. "ttl" + actualTtl <- actual %. "ttl" + checkTtl actualTtl expectedTtl + + checkTtl :: Value -> Value -> App () + checkTtl (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 + 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 > 0 + && actualTtl <= expectedTtl + && abs (actualTtl - expectedTtl) <= 2 + ) + checkTtl _ _ = assertFailure "unexpected ttl value(s)" assertForbidden :: HasCallStack => Response -> App () assertForbidden = assertLabel 403 "no-team-member" diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index b0bdfc2d750..42fbff37d52 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -62,14 +62,6 @@ tests s = [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, test s "ConferenceCalling 2s TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) ], - testGroup - "TTL / Overrides" - [ test s "increase to unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) FeatureTTLUnlimited, - test s "increase" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) (FeatureTTLSeconds 4), - test s "reduce from unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited (FeatureTTLSeconds 2), - test s "reduce" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 5) (FeatureTTLSeconds 2), - test s "Unlimited to unlimited" $ testSimpleFlagTTLOverride @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited FeatureTTLUnlimited - ], test s "MLS feature config" testMLS, test s "MlsE2EId feature config" $ testNonTrivialConfigNoTTL @@ -254,102 +246,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testSimpleFlagTTLOverride :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - Eq cfg, - Show cfg - ) => - FeatureStatus -> - FeatureTTL -> - FeatureTTL -> - TestM () -testSimpleFlagTTLOverride defaultValue ttl ttlAfter = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () - setFlagInternal statusValue ttl' = - void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') - - select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) - select = fromString "select ttl(conference_calling) from team_features where team_id = ?" - - assertUnlimited :: TestM () - assertUnlimited = do - -- TTL should be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - storedTTL @?= Nothing - - assertLimited :: Word -> TestM () - assertLimited upper = do - -- TTL should NOT be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - let check = case storedTTL of - Nothing -> False - Just FeatureTTLUnlimited -> False - Just (FeatureTTLSeconds i) -> i <= upper - unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - - toMicros :: Word -> Int - toMicros secs = fromIntegral secs * 1000000 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) - - -- Setting should work - setFlagInternal otherValue ttl - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) - - case (ttl, ttlAfter) of - (FeatureTTLSeconds d, FeatureTTLSeconds d') -> do - assertLimited d -- TTL should be NULL after expiration. - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (toMicros d `div` 2) -- waiting half of TTL - setFlagInternal otherValue ttlAfter - -- value is still correct - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - - liftIO $ threadDelay (toMicros d') -- waiting for new TTL - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue) - (FeatureTTLSeconds d, FeatureTTLUnlimited) -> do - assertLimited d -- TTL should be NULL after expiration. - -- wait less than expiration, override and recheck. - liftIO $ threadDelay (fromIntegral d `div` 2) -- waiting half of TTL - setFlagInternal otherValue ttlAfter - -- value is still correct - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - (FeatureTTLUnlimited, FeatureTTLUnlimited) -> do - assertUnlimited - - -- overriding in this case should have no effect. - setFlagInternal otherValue ttl - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttl) - (FeatureTTLUnlimited, FeatureTTLSeconds d) -> do - assertUnlimited - - setFlagInternal otherValue ttlAfter - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus otherValue & setTTL ttlAfter) - - liftIO $ threadDelay (toMicros d) -- waiting it out - -- value reverts back - checkTeamFeatureAllEndpoints member tid (defFeatureStatus @cfg & setStatus defaultValue & setTTL ttl) - testSimpleFlagTTL :: forall cfg. ( HasCallStack, From ba9a0bd85c4bb9dfd1f5621c12c09586bac99199 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Mon, 27 May 2024 16:37:04 +0000 Subject: [PATCH 16/30] nix pacakges --- services/galley/default.nix | 2 -- 1 file changed, 2 deletions(-) diff --git a/services/galley/default.nix b/services/galley/default.nix index 7985313dc72..26be21dac96 100644 --- a/services/galley/default.nix +++ b/services/galley/default.nix @@ -45,7 +45,6 @@ , gitignoreSource , gundeck-types , HsOpenSSL -, hspec , http-api-data , http-client , http-client-openssl @@ -246,7 +245,6 @@ mkDerivation { filepath galley-types HsOpenSSL - hspec http-api-data http-client http-client-openssl From 1601a1c4521afb39250f0016ace3283bd230c3fc Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 07:41:29 +0000 Subject: [PATCH 17/30] fix classified domains test --- integration/test/Test/FeatureFlags.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index b99d732ac9b..7688d9d7e40 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -408,9 +408,9 @@ testClassifiedDomainsEnabled = do testClassifiedDomainsDisabled :: HasCallStack => App () testClassifiedDomainsDisabled = do - withModifiedBackend def {galleyCfg = setField "settings.featureFlags.classifiedDomains.status" "disabled"} $ \domain -> do + withModifiedBackend def {galleyCfg = setField "settings.featureFlags.classifiedDomains" (object ["status" .= "disabled", "config" .= object ["domains" .= ["example.com"]]])} $ \domain -> do (_, tid, m : _) <- createTeam domain 2 - expected <- disabled & setField "config.domains" ["d1.example.com"] + expected <- disabled & setField "config.domains" ["example.com"] checkFeature "classifiedDomains" m tid expected -- | Call 'GET /teams/:tid/features' and 'GET /feature-configs', and check if all From d458219dcb0c195917d27389c1e3547d08d6150a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 07:46:53 +0000 Subject: [PATCH 18/30] removed two tests as the functionality is already fully covered by the other tests --- .../test/integration/API/Teams/Feature.hs | 141 +----------------- 1 file changed, 2 insertions(+), 139 deletions(-) diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 42fbff37d52..456b3564276 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -25,11 +25,10 @@ import API.Util.TeamFeature qualified as Util import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) -import Cassandra as Cql import Control.Lens (view, (.~), (?~)) import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) -import Data.Aeson (FromJSON, ToJSON) +import Data.Aeson (ToJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Char8 (unpack) import Data.Id @@ -57,12 +56,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ testGroup - "TTL / Conference calling" - [ test s "ConferenceCalling unlimited TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled FeatureTTLUnlimited, - test s "ConferenceCalling 2s TTL" $ testSimpleFlagTTL @ConferenceCallingConfig FeatureStatusEnabled (FeatureTTLSeconds 2) - ], - test s "MLS feature config" testMLS, + [ test s "MLS feature config" testMLS, test s "MlsE2EId feature config" $ testNonTrivialConfigNoTTL ( withStatus @@ -246,101 +240,6 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual -testSimpleFlagTTL :: - forall cfg. - ( HasCallStack, - Typeable cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg, - FromJSON (WithStatusNoLock cfg) - ) => - FeatureStatus -> - FeatureTTL -> - TestM () -testSimpleFlagTTL defaultValue ttl = do - (_owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - let getFlag :: HasCallStack => FeatureStatus -> TestM () - getFlag expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeature @cfg member tid - - getFeatureConfig :: HasCallStack => FeatureStatus -> TestM () - getFeatureConfig expected = do - actual <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus actual @?= expected - - getFlagInternal :: HasCallStack => FeatureStatus -> TestM () - getFlagInternal expected = - flip (assertFlagNoConfig @cfg) expected $ getTeamFeatureInternal @cfg tid - - setFlagInternal :: FeatureStatus -> FeatureTTL -> TestM () - setFlagInternal statusValue ttl' = - void $ putTeamFeatureInternal @cfg expect2xx tid (WithStatusNoLock statusValue (trivialConfig @cfg) ttl') - - select :: PrepQuery R (Identity TeamId) (Identity (Maybe FeatureTTL)) - select = fromString "select ttl(conference_calling) from team_features where team_id = ?" - - assertUnlimited :: TestM () - assertUnlimited = do - -- TTL should be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - storedTTL @?= Nothing - - assertLimited :: Word -> TestM () - assertLimited upper = do - -- TTL should NOT be NULL inside cassandra - cassState <- view tsCass - liftIO $ do - storedTTL <- maybe Nothing runIdentity <$> Cql.runClient cassState (Cql.query1 select $ params LocalQuorum (Identity tid)) - let check = case storedTTL of - Nothing -> False - Just FeatureTTLUnlimited -> False - Just (FeatureTTLSeconds i) -> i <= upper - unless check $ error ("expected ttl <= " <> show upper <> ", got " <> show storedTTL) - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - let otherValue = case defaultValue of - FeatureStatusDisabled -> FeatureStatusEnabled - FeatureStatusEnabled -> FeatureStatusDisabled - - -- Initial value should be the default value - getFlag defaultValue - getFlagInternal defaultValue - getFeatureConfig defaultValue - - -- Setting should work - cannon <- view tsCannon - -- should receive an event - WS.bracketR cannon member $ \ws -> do - setFlagInternal otherValue ttl - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureTrivialConfigUpdate @cfg otherValue ttl - getFlag otherValue - getFeatureConfig otherValue - getFlagInternal otherValue - - case ttl of - FeatureTTLSeconds d -> do - -- should revert back after TTL expires - assertLimited d - liftIO $ threadDelay (fromIntegral d * 1000000) - assertUnlimited - getFlag defaultValue - FeatureTTLUnlimited -> do - -- TTL should be NULL inside cassandra - assertUnlimited - - -- Clean up - setFlagInternal defaultValue FeatureTTLUnlimited - getFlag defaultValue - testNonTrivialConfigNoTTL :: forall cfg. ( Typeable cfg, @@ -621,23 +520,6 @@ assertFlagForbidden res = do statusCode === const 403 fmap label . responseJsonMaybe === const (Just "no-team-member") -assertFlagNoConfig :: - forall cfg. - ( HasCallStack, - Typeable cfg, - FromJSON (WithStatusNoLock cfg) - ) => - TestM ResponseLBS -> - FeatureStatus -> - TestM () -assertFlagNoConfig res expected = do - res !!! do - statusCode === const 200 - ( fmap wssStatus - . responseJsonEither @(WithStatusNoLock cfg) - ) - === const (Right expected) - assertFlagWithConfig :: forall cfg m. ( HasCallStack, @@ -660,25 +542,6 @@ assertFlagWithConfig response expected = do fmap wssStatus rJson @?= (Right . wssStatus $ expected) fmap wssConfig rJson @?= (Right . wssConfig $ expected) -wsAssertFeatureTrivialConfigUpdate :: - forall cfg. - ( IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - FeatureTrivialConfig cfg, - ToSchema cfg - ) => - FeatureStatus -> - FeatureTTL -> - Notification -> - IO () -wsAssertFeatureTrivialConfigUpdate status ttl notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= featureName @cfg - FeatureConfig._eventData e - @?= Aeson.toJSON - (withStatus status (wsLockStatus (defFeatureStatus @cfg)) (trivialConfig @cfg) ttl) - wsAssertFeatureConfigUpdate :: forall cfg. ( KnownSymbol (FeatureSymbol cfg), From a26d9ba0ef304e64370236f889273797932a382c Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 09:25:35 +0000 Subject: [PATCH 19/30] mls test --- integration/test/Test/FeatureFlags.hs | 169 ++++++++++++++---- integration/test/Testlib/Cannon.hs | 12 ++ .../test/integration/API/Teams/Feature.hs | 110 +----------- 3 files changed, 144 insertions(+), 147 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 7688d9d7e40..d353dd2c9fe 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -519,71 +519,164 @@ testSelfDeletingMessages :: HasCallStack => App () testSelfDeletingMessages = _testLockStatusWithConfig "selfDeletingMessages" + Public.setTeamFeatureConfig (object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "disabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) -_testLockStatusWithConfig :: HasCallStack => String -> Value -> Value -> App () -_testLockStatusWithConfig featureName defaultSetting configUpdate = do +testSelfDeletingMessagesInternal :: HasCallStack => App () +testSelfDeletingMessagesInternal = + _testLockStatusWithConfig + "selfDeletingMessages" + Internal.setTeamFeatureConfig + (object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "disabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + (object ["status" .= "enabled", "config" .= object ["enforcedTimeoutSeconds" .= ""]]) + +testMls :: HasCallStack => App () +testMls = do + user <- randomUser OwnDomain def + uid <- asString $ user %. "id" + _testLockStatusWithConfig + "mls" + Public.setTeamFeatureConfig + mlsDefaultConfig + (mlsConfig1 uid) + mlsConfig2 + mlsInvalidConfig + +testMlsInternal :: HasCallStack => App () +testMlsInternal = do + user <- randomUser OwnDomain def + uid <- asString $ user %. "id" + _testLockStatusWithConfig + "mls" + Internal.setTeamFeatureConfig + mlsDefaultConfig + (mlsConfig1 uid) + mlsConfig2 + mlsInvalidConfig + +mlsDefaultConfig :: Value +mlsDefaultConfig = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsConfig1 :: String -> Value +mlsConfig1 uid = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= [uid], + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsConfig2 :: Value +mlsConfig2 = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsInvalidConfig :: Value +mlsInvalidConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +_testLockStatusWithConfig :: + HasCallStack => + String -> + (Value -> String -> String -> Value -> App Response) -> + -- | the default feature config (should include the lock status and ttl, as it is returned by the API) + Value -> + -- | a valid config used to update the feature setting (should not include the lock status and ttl, as these are not part of the request payload) + Value -> + -- | another valid config + Value -> + -- | an invalid config + Value -> + App () +_testLockStatusWithConfig featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig = do -- personal user randomPersonalUser <- randomUser OwnDomain def bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. featureName `shouldMatch` defaultSetting + resp.json %. featureName `shouldMatch` defaultFeatureConfig -- team user - defaultConfig <- defaultSetting %. "config" - - featureUnlockedByDefault <- do - ls <- defaultSetting %. "lockStatus" >>= asString - pure $ ls == "unlocked" - - featureEnabledByDefault <- do - s <- defaultSetting %. "status" >>= asString - pure $ s == "enabled" - (owner, tid, m : _) <- createTeam OwnDomain 2 nonTeamMember <- randomUser OwnDomain def assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName - checkFeature featureName m tid defaultSetting - - -- unlock feature if it is locked - unless featureUnlockedByDefault $ Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + checkFeature featureName m tid defaultFeatureConfig - -- change the status - let otherStatus = if featureEnabledByDefault then "disabled" else "enabled" - defaultSettingWithOtherStatus <- defaultSetting & setField "status" otherStatus + -- lock the feature + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + assertStatus 409 =<< setTeamFeatureConfig owner tid featureName config1 + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" void $ withWebSockets [m] $ \wss -> do - assertSuccess =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus, "config" .= defaultConfig]) + 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` defaultSettingWithOtherStatus + notif %. "payload.0.data" `shouldMatch` (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") - checkFeature featureName m tid defaultSettingWithOtherStatus + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") - -- lock feature Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" - - -- feature status should be the default again - checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultSetting - assertStatus 409 =<< Public.setTeamFeatureConfig owner tid featureName (object ["status" .= otherStatus, "config" .= defaultConfig]) - - -- unlock again + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultFeatureConfig Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" - -- feature status should be the previously set status again - checkFeature featureName m tid defaultSettingWithOtherStatus + void $ withWebSockets [m] $ \wss -> do + assertStatus 400 =<< setTeamFeatureConfig owner tid featureName invalidConfig + for_ wss $ assertNoEvent 2 - bindResponse (Public.setTeamFeatureConfig owner tid featureName configUpdate) $ \resp -> do - resp.status `shouldMatchInt` 200 - checkFeature featureName m tid =<< (configUpdate & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") - -- after locking once again it should be the default again - Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" - checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultSetting + void $ withWebSockets [m] $ \wss -> 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") + + checkFeature featureName m tid =<< (config2 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") testFeatureNoConfigMultiSearchVisibilityInbound :: HasCallStack => App () testFeatureNoConfigMultiSearchVisibilityInbound = do diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 8ab338df38a..c6a57b66cce 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -38,6 +38,7 @@ module Testlib.Cannon printAwaitResult, printAwaitAtLeastResult, waitForResponse, + assertNoEvent, ) where @@ -463,6 +464,17 @@ awaitMatch :: App Value awaitMatch checkMatch ws = head <$> awaitNMatches 1 checkMatch ws +assertNoEvent :: + HasCallStack => + Int -> + WebSocket -> + App () +assertNoEvent to ws = do + mEvent <- awaitAnyEvent to ws + case mEvent of + Just event -> assertFailure $ "Expected no event, but got: " <> show event + Nothing -> pure () + nPayload :: MakesValue a => a -> App Value nPayload event = do payloads <- event %. "payload" & asList diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 456b3564276..f31f96be2bc 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -56,8 +56,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "MLS feature config" testMLS, - test s "MlsE2EId feature config" $ + [ test s "MlsE2EId feature config" $ testNonTrivialConfigNoTTL ( withStatus FeatureStatusDisabled @@ -345,113 +344,6 @@ testNonTrivialConfigNoTTL defaultCfg = do -- feature status should be the previously set value getViaEndpoints config3 -testMLS :: TestM () -testMLS = do - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - - galley <- viewGalley - cannon <- view tsCannon - - let getForTeam :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeature @MLSConfig member tid - - getForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureInternal @MLSConfig tid - - getForUser :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getForUser expected = do - result <- Util.getFeatureConfig @MLSConfig member - liftIO $ wsStatus result @?= wssStatus expected - liftIO $ wsConfig result @?= wssConfig expected - - getViaEndpoints :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - getViaEndpoints expected = do - getForTeam expected - getForTeamInternal expected - getForUser expected - - setForTeamWithStatusCode :: HasCallStack => Int -> WithStatusNoLock MLSConfig -> TestM () - setForTeamWithStatusCode resStatusCode wsnl = - putTeamFeature @MLSConfig owner tid wsnl - !!! statusCode - === const resStatusCode - - setForTeam :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - setForTeam = setForTeamWithStatusCode 200 - - setForTeamInternalWithStatusCode :: HasCallStack => (Request -> Request) -> WithStatusNoLock MLSConfig -> TestM () - setForTeamInternalWithStatusCode expect wsnl = - void $ putTeamFeatureInternal @MLSConfig expect tid wsnl - - setForTeamInternal :: HasCallStack => WithStatusNoLock MLSConfig -> TestM () - setForTeamInternal = setForTeamInternalWithStatusCode expect2xx - - setLockStatus :: HasCallStack => LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @MLSConfig galley tid lockStatus !!! statusCode === const 200 - - let cipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - defaultConfig = - WithStatusNoLock - FeatureStatusDisabled - (MLSConfig [] ProtocolProteusTag [cipherSuite] cipherSuite [ProtocolProteusTag, ProtocolMLSTag]) - FeatureTTLUnlimited - config2 = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [member] ProtocolMLSTag [] cipherSuite [ProtocolProteusTag, ProtocolMLSTag]) - FeatureTTLUnlimited - config3 = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [] ProtocolMLSTag [cipherSuite] cipherSuite [ProtocolMLSTag]) - FeatureTTLUnlimited - invalidConfig = - WithStatusNoLock - FeatureStatusEnabled - (MLSConfig [] ProtocolMLSTag [cipherSuite] cipherSuite [ProtocolProteusTag]) - FeatureTTLUnlimited - - getViaEndpoints defaultConfig - - -- when the feature is locked it cannot be changed - setLockStatus LockStatusLocked - setForTeamWithStatusCode 409 config2 - setLockStatus LockStatusUnlocked - - WS.bracketR cannon member $ \ws -> do - setForTeam config2 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @MLSConfig config2 LockStatusUnlocked - getViaEndpoints config2 - - -- when the feature is locked the default config is returned - setLockStatus LockStatusLocked - getViaEndpoints defaultConfig - setLockStatus LockStatusUnlocked - - WS.bracketR cannon member $ \ws -> do - setForTeamWithStatusCode 400 invalidConfig - void . liftIO $ - WS.assertNoEvent (2 # Second) [ws] - getViaEndpoints config2 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternal config3 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @MLSConfig config3 LockStatusUnlocked - getViaEndpoints config3 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternalWithStatusCode expect4xx invalidConfig - void . liftIO $ - WS.assertNoEvent (2 # Second) [ws] - getViaEndpoints config3 - testExposeInvitationURLsToTeamAdminTeamIdInAllowList :: TestM () testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do owner <- randomUser From cc6a52a88eceac5ab96d9d4204a88fd91c82c22e Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 10:09:26 +0000 Subject: [PATCH 20/30] enforce download location --- integration/test/Test/FeatureFlags.hs | 20 +++++++++++++++++++ .../test/integration/API/Teams/Feature.hs | 2 -- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index d353dd2c9fe..41b9da1a0c1 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -617,6 +617,26 @@ mlsInvalidConfig = ] ] +testEnforceDownloadLocation :: HasCallStack => App () +testEnforceDownloadLocation = + _testLockStatusWithConfig + "enforceFileDownloadLocation" + Public.setTeamFeatureConfig + (object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) + (object ["status" .= "disabled", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) + +testEnforceDownloadLocationInternal :: HasCallStack => App () +testEnforceDownloadLocationInternal = + _testLockStatusWithConfig + "enforceFileDownloadLocation" + Internal.setTeamFeatureConfig + (object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) + (object ["status" .= "disabled", "config" .= object []]) + (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) + _testLockStatusWithConfig :: HasCallStack => String -> diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index f31f96be2bc..47a3f49dafb 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -66,8 +66,6 @@ tests s = ), test s "MlsMigration feature config" $ testNonTrivialConfigNoTTL defaultMlsMigrationConfig, - test s "EnforceFileDownloadLocation feature config" $ - testNonTrivialConfigNoTTL (defFeatureStatus @EnforceFileDownloadLocationConfig), testGroup "Patch" [ -- Note: `SSOConfig` and `LegalHoldConfig` may not be able to be reset From 2f2c2670049f91a79136dfec721de8eb6a54a3cd Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 10:33:53 +0000 Subject: [PATCH 21/30] mls migration test --- integration/test/Test/FeatureFlags.hs | 107 +++++++++++++++++- .../test/integration/API/Teams/Feature.hs | 14 --- 2 files changed, 106 insertions(+), 15 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 41b9da1a0c1..a95bbb2c7a6 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -637,6 +637,93 @@ testEnforceDownloadLocationInternal = (object ["status" .= "disabled", "config" .= object []]) (object ["status" .= "enabled", "config" .= object ["enforcedDownloadLocation" .= object []]]) +testMlsMigration :: HasCallStack => App () +testMlsMigration = do + -- first we have to enable mls + (owner, tid, m : _) <- createTeam OwnDomain 2 + assertSuccess =<< Public.setTeamFeatureConfig owner tid "mls" mlsEnableConfig + _testLockStatusWithConfigWithTeam + (owner, tid, m) + "mlsMigration" + Public.setTeamFeatureConfig + mlsMigrationDefaultConfig + mlsMigrationConfig1 + mlsMigrationConfig2 + mlsMigrationInvalidConfig + +testMlsMigrationInternal :: HasCallStack => App () +testMlsMigrationInternal = do + -- first we have to enable mls + (owner, tid, m : _) <- createTeam OwnDomain 2 + assertSuccess =<< Public.setTeamFeatureConfig owner tid "mls" mlsEnableConfig + _testLockStatusWithConfigWithTeam + (owner, tid, m) + "mlsMigration" + Internal.setTeamFeatureConfig + mlsMigrationDefaultConfig + mlsMigrationConfig1 + mlsMigrationConfig2 + mlsMigrationInvalidConfig + +mlsEnableConfig :: Value +mlsEnableConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + +mlsMigrationDefaultConfig :: Value +mlsMigrationDefaultConfig = + object + [ "lockStatus" .= "locked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2029-10-17T00:00:00Z" + ] + ] + +mlsMigrationConfig1 :: Value +mlsMigrationConfig1 = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= "2029-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2030-10-17T00:00:00Z" + ] + ] + +mlsMigrationConfig2 :: Value +mlsMigrationConfig2 = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= "2030-05-16T10:11:12.123Z", + "finaliseRegardlessAfter" .= "2031-10-17T00:00:00Z" + ] + ] + +mlsMigrationInvalidConfig :: Value +mlsMigrationInvalidConfig = + object + [ "status" .= "enabled", + "config" + .= object + [ "startTime" .= A.Number 1 + ] + ] + _testLockStatusWithConfig :: HasCallStack => String -> @@ -651,6 +738,25 @@ _testLockStatusWithConfig :: Value -> App () _testLockStatusWithConfig featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig = do + (owner, tid, m : _) <- createTeam OwnDomain 2 + _testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig + +_testLockStatusWithConfigWithTeam :: + HasCallStack => + -- | (owner, tid, member) + (Value, String, Value) -> + String -> + (Value -> String -> String -> Value -> App Response) -> + -- | the default feature config (should include the lock status and ttl, as it is returned by the API) + Value -> + -- | a valid config used to update the feature setting (should not include the lock status and ttl, as these are not part of the request payload) + Value -> + -- | another valid config + Value -> + -- | an invalid config + Value -> + App () +_testLockStatusWithConfigWithTeam (owner, tid, m) featureName setTeamFeatureConfig defaultFeatureConfig config1 config2 invalidConfig = do -- personal user randomPersonalUser <- randomUser OwnDomain def @@ -659,7 +765,6 @@ _testLockStatusWithConfig featureName setTeamFeatureConfig defaultFeatureConfig resp.json %. featureName `shouldMatch` defaultFeatureConfig -- team user - (owner, tid, m : _) <- createTeam OwnDomain 2 nonTeamMember <- randomUser OwnDomain def assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 47a3f49dafb..fbe6fda939b 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -32,7 +32,6 @@ import Data.Aeson (ToJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Char8 (unpack) import Data.Id -import Data.Json.Util (fromUTCTimeMillis, readUTCTimeMillis) import Data.List1 qualified as List1 import Data.Schema (ToSchema) import Data.Timeout (TimeoutUnit (Second), (#)) @@ -64,8 +63,6 @@ tests s = (wsConfig (defFeatureStatus @MlsE2EIdConfig)) FeatureTTLUnlimited ), - test s "MlsMigration feature config" $ - testNonTrivialConfigNoTTL defaultMlsMigrationConfig, testGroup "Patch" [ -- Note: `SSOConfig` and `LegalHoldConfig` may not be able to be reset @@ -446,14 +443,3 @@ wsAssertFeatureConfigUpdate config lockStatus notification = do FeatureConfig._eventType e @?= FeatureConfig.Update FeatureConfig._eventFeatureName e @?= featureName @cfg FeatureConfig._eventData e @?= Aeson.toJSON (withLockStatus lockStatus config) - -defaultMlsMigrationConfig :: WithStatus MlsMigrationConfig -defaultMlsMigrationConfig = - withStatus - FeatureStatusEnabled - LockStatusLocked - MlsMigrationConfig - { startTime = fmap fromUTCTimeMillis (readUTCTimeMillis "2029-05-16T10:11:12.123Z"), - finaliseRegardlessAfter = fmap fromUTCTimeMillis (readUTCTimeMillis "2029-10-17T00:00:00.000Z") - } - FeatureTTLUnlimited From 9dbb9cef7bb401e6ba1727d4d566d6cd899406ef Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 12:09:44 +0000 Subject: [PATCH 22/30] removed redundant expose invitaion url tests --- integration/test/Test/FeatureFlags.hs | 6 ++ .../test/integration/API/Teams/Feature.hs | 73 +------------------ 2 files changed, 7 insertions(+), 72 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index a95bbb2c7a6..300e7e19e1f 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -152,7 +152,12 @@ testExposeInvitationURLsToTeamAdminConfig = 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 + -- a team that is not in the allow list cannot enable the feature, it will always be disabled and locked + -- even though the internal API request to enable it succeeds assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" + checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked + -- however, a request to the public API will fail + assertStatus 409 =<< Public.setTeamFeatureConfig owner tid "exposeInvitationURLsToTeamAdmin" (object ["status" .= "enabled"]) assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" pure (owner, tid) @@ -161,6 +166,7 @@ testExposeInvitationURLsToTeamAdminConfig = do -- Interesting case: The team is in the allow list runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist [tid]) $ \_ -> do + -- when the team is in the allow list the lock status is implicitly unlocked checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled assertSuccess =<< Internal.setTeamFeatureStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index fbe6fda939b..55ddcab7339 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -18,25 +18,22 @@ module API.Teams.Feature (tests) where -import API.SQS (assertTeamActivate) import API.Util import API.Util.TeamFeature hiding (getFeatureConfig, setLockStatusInternal) import API.Util.TeamFeature qualified as Util import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) -import Control.Lens (view, (.~), (?~)) +import Control.Lens (view) import Control.Lens.Operators () import Control.Monad.Catch (MonadCatch) import Data.Aeson (ToJSON) import Data.Aeson qualified as Aeson import Data.ByteString.Char8 (unpack) -import Data.Id import Data.List1 qualified as List1 import Data.Schema (ToSchema) import Data.Timeout (TimeoutUnit (Second), (#)) import GHC.TypeLits (KnownSymbol) -import Galley.Options (exposeInvitationURLsTeamAllowlist, settings) import Imports import Network.Wai.Utilities (label) import Test.QuickCheck (Gen, generate, suchThat) @@ -107,12 +104,6 @@ tests s = testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @MlsE2EIdConfig)), test s (unpack $ featureNameBS @EnforceFileDownloadLocationConfig) $ testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @EnforceFileDownloadLocationConfig)) - ], - testGroup - "ExposeInvitationURLsToTeamAdmin" - [ test s "can be set when TeamId is in allow list" testExposeInvitationURLsToTeamAdminTeamIdInAllowList, - test s "can not be set when allow list is empty" testExposeInvitationURLsToTeamAdminEmptyAllowList, - test s "server config takes precendece over team feature config" testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence ] ] @@ -339,68 +330,6 @@ testNonTrivialConfigNoTTL defaultCfg = do -- feature status should be the previously set value getViaEndpoints config3 -testExposeInvitationURLsToTeamAdminTeamIdInAllowList :: TestM () -testExposeInvitationURLsToTeamAdminTeamIdInAllowList = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 200 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked - -testExposeInvitationURLsToTeamAdminEmptyAllowList :: TestM () -testExposeInvitationURLsToTeamAdminEmptyAllowList = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 409 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - --- | Ensure that the server config takes precedence over a saved team config. --- --- In other words: When a team id is no longer in the --- `exposeInvitationURLsTeamAllowlist` the --- `ExposeInvitationURLsToTeamAdminConfig` is always disabled (even tough it --- might have been enabled before). -testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence :: TestM () -testExposeInvitationURLsToTeamAdminServerConfigTakesPrecedence = do - owner <- randomUser - tid <- createBindingTeamInternal "foo" owner - assertTeamActivate "create team" tid - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist ?~ [tid]) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusUnlocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 200 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusEnabled LockStatusUnlocked - void $ - withSettingsOverrides (\opts -> opts & settings . exposeInvitationURLsTeamAllowlist .~ Nothing) $ do - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - let enabled = WithStatusNoLock FeatureStatusEnabled ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited - void $ - putTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid enabled !!! do - const 409 === statusCode - assertExposeInvitationURLsToTeamAdminConfigStatus owner tid FeatureStatusDisabled LockStatusLocked - -assertExposeInvitationURLsToTeamAdminConfigStatus :: UserId -> TeamId -> FeatureStatus -> LockStatus -> TestM () -assertExposeInvitationURLsToTeamAdminConfigStatus owner tid fStatus lStatus = do - getTeamFeature @ExposeInvitationURLsToTeamAdminConfig owner tid !!! do - const 200 === statusCode - const (Right (withStatus fStatus lStatus ExposeInvitationURLsToTeamAdminConfig FeatureTTLUnlimited)) === responseJsonEither - assertFlagForbidden :: HasCallStack => TestM ResponseLBS -> TestM () assertFlagForbidden res = do res !!! do From f9cab9ca4b3888d3e4c49f8bd2bbb6f02cf4f179 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 28 May 2024 14:27:17 +0200 Subject: [PATCH 23/30] WIP: MLSE2EId test ported --- integration/test/Test/FeatureFlags.hs | 55 +++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 300e7e19e1f..39922bf9009 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -730,6 +730,61 @@ mlsMigrationInvalidConfig = ] ] +mlsE2EIdConfig :: App (Value, Value, Value, Value) +mlsE2EIdConfig = do + cfg2 <- + mlsE2EIdConfig1 + & setField "config.verificationExpiration" (A.Number 86401) + & setField "config.useProxyOnMobile" True + invalidConfig <- mlsE2EIdConfig2 & removeField "config.crlProxy" + pure (mlsE2EIdDefConfig, mlsE2EIdConfig1, cfg2, invalidConfig) + where + mlsE2EIdDefConfig :: Value + mlsE2EIdDefConfig = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + mlsE2EIdConfig1 :: Value + mlsE2EIdConfig1 = + object + [ "status" .= "enabled", + "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + +testMLSE2EId :: HasCallStack => App () +testMLSE2EId = do + (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig + _testLockStatusWithConfig + "mlsE2EId" + Public.setTeamFeatureConfig + defCfg + cfg1 + cfg2 + invalidCfg + +testMLSE2EIdInternal :: HasCallStack => App () +testMLSE2EIdInternal = do + (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig + _testLockStatusWithConfig + "mlsE2EId" + Internal.setTeamFeatureConfig + defCfg + cfg1 + cfg2 + invalidCfg + _testLockStatusWithConfig :: HasCallStack => String -> From 4a6bed6788ef9374ab03195d14588c14809a179a Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 13:42:52 +0000 Subject: [PATCH 24/30] remove old test, little fixes --- integration/test/Test/FeatureFlags.hs | 6 +- .../test/integration/API/Teams/Feature.hs | 169 +----------------- 2 files changed, 5 insertions(+), 170 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 39922bf9009..4df1cb49495 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -736,7 +736,7 @@ mlsE2EIdConfig = do mlsE2EIdConfig1 & setField "config.verificationExpiration" (A.Number 86401) & setField "config.useProxyOnMobile" True - invalidConfig <- mlsE2EIdConfig2 & removeField "config.crlProxy" + invalidConfig <- cfg2 & removeField "config.crlProxy" pure (mlsE2EIdDefConfig, mlsE2EIdConfig1, cfg2, invalidConfig) where mlsE2EIdDefConfig :: Value @@ -777,13 +777,15 @@ testMLSE2EId = do testMLSE2EIdInternal :: HasCallStack => App () testMLSE2EIdInternal = do (defCfg, cfg1, cfg2, invalidCfg) <- mlsE2EIdConfig + -- the internal API is not as strict as the public one, so we need to tweak the invalid config some more + invalidCfg' <- invalidCfg & setField "config.crlProxy" (object []) _testLockStatusWithConfig "mlsE2EId" Internal.setTeamFeatureConfig defCfg cfg1 cfg2 - invalidCfg + invalidCfg' _testLockStatusWithConfig :: HasCallStack => diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 55ddcab7339..71ac05cc38c 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -20,31 +20,20 @@ module API.Teams.Feature (tests) where import API.Util import API.Util.TeamFeature hiding (getFeatureConfig, setLockStatusInternal) -import API.Util.TeamFeature qualified as Util import Bilge import Bilge.Assert import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) -import Control.Lens (view) import Control.Lens.Operators () -import Control.Monad.Catch (MonadCatch) -import Data.Aeson (ToJSON) -import Data.Aeson qualified as Aeson import Data.ByteString.Char8 (unpack) -import Data.List1 qualified as List1 import Data.Schema (ToSchema) -import Data.Timeout (TimeoutUnit (Second), (#)) import GHC.TypeLits (KnownSymbol) import Imports -import Network.Wai.Utilities (label) import Test.QuickCheck (Gen, generate, suchThat) import Test.Tasty -import Test.Tasty.Cannon qualified as WS import Test.Tasty.HUnit ((@?=)) import TestHelpers (test) import TestSetup import Wire.API.Conversation.Protocol -import Wire.API.Event.FeatureConfig qualified as FeatureConfig -import Wire.API.Internal.Notification (Notification) import Wire.API.MLS.CipherSuite import Wire.API.Team.Feature hiding (setLockStatus) @@ -52,15 +41,7 @@ tests :: IO TestSetup -> TestTree tests s = testGroup "Feature Config API and Team Features API" - [ test s "MlsE2EId feature config" $ - testNonTrivialConfigNoTTL - ( withStatus - FeatureStatusDisabled - LockStatusUnlocked - (wsConfig (defFeatureStatus @MlsE2EIdConfig)) - FeatureTTLUnlimited - ), - testGroup + [ testGroup "Patch" [ -- Note: `SSOConfig` and `LegalHoldConfig` may not be able to be reset -- (depending on prior state or configuration). Thus, they cannot be @@ -224,151 +205,3 @@ testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do wsLockStatus actual @?= fromMaybe (wsLockStatus original) (wspLockStatus rndFeatureConfig) wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) checkTeamFeatureAllEndpoints uid tid actual - -testNonTrivialConfigNoTTL :: - forall cfg. - ( Typeable cfg, - Eq cfg, - Show cfg, - ToSchema cfg, - IsFeatureConfig cfg, - KnownSymbol (FeatureSymbol cfg), - Arbitrary (WithStatus cfg) - ) => - WithStatus cfg -> - TestM () -testNonTrivialConfigNoTTL defaultCfg = do - (owner, tid, member : _) <- createBindingTeamWithNMembers 1 - nonMember <- randomUser - - galley <- viewGalley - cannon <- view tsCannon - - let getForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForTeam expected = - flip assertFlagWithConfig expected $ getTeamFeature @cfg member tid - - getForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForTeamInternal expected = - flip assertFlagWithConfig expected $ getTeamFeatureInternal @cfg tid - - getForUser :: HasCallStack => WithStatusNoLock cfg -> TestM () - getForUser expected = do - result <- Util.getFeatureConfig @cfg member - liftIO $ wsStatus result @?= wssStatus expected - liftIO $ wsConfig result @?= wssConfig expected - - getViaEndpoints :: HasCallStack => WithStatusNoLock cfg -> TestM () - getViaEndpoints expected = do - getForTeam expected - getForTeamInternal expected - getForUser expected - - setForTeam :: HasCallStack => WithStatusNoLock cfg -> TestM () - setForTeam wsnl = - putTeamFeature @cfg owner tid wsnl - !!! statusCode - === const 200 - - setForTeamInternal :: HasCallStack => WithStatusNoLock cfg -> TestM () - setForTeamInternal wsnl = - void $ putTeamFeatureInternal @cfg expect2xx tid wsnl - setLockStatus :: LockStatus -> TestM () - setLockStatus lockStatus = - Util.setLockStatusInternal @cfg galley tid lockStatus - !!! statusCode - === const 200 - - assertFlagForbidden $ getTeamFeature @cfg nonMember tid - - getViaEndpoints (forgetLock defaultCfg) - - -- unlock feature - setLockStatus LockStatusUnlocked - - let defaultMLSConfig = - WithStatusNoLock - { wssStatus = FeatureStatusEnabled, - wssConfig = - MLSConfig - { mlsProtocolToggleUsers = [], - mlsDefaultProtocol = ProtocolMLSTag, - mlsAllowedCipherSuites = [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519], - mlsDefaultCipherSuite = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519, - mlsSupportedProtocols = [ProtocolProteusTag, ProtocolMLSTag] - }, - wssTTL = FeatureTTLUnlimited - } - - config2 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) - config3 <- liftIO $ generate arbitrary <&> (forgetLock . setTTL FeatureTTLUnlimited) - - putTeamFeature @MLSConfig owner tid defaultMLSConfig - !!! statusCode - === const 200 - - WS.bracketR cannon member $ \ws -> do - setForTeam config2 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @cfg config2 LockStatusUnlocked - getViaEndpoints config2 - - WS.bracketR cannon member $ \ws -> do - setForTeamInternal config3 - void . liftIO $ - WS.assertMatch (5 # Second) ws $ - wsAssertFeatureConfigUpdate @cfg config3 LockStatusUnlocked - getViaEndpoints config3 - - -- lock the feature - setLockStatus LockStatusLocked - -- feature status should now be the default again - getViaEndpoints (forgetLock defaultCfg) - -- unlock feature - setLockStatus LockStatusUnlocked - -- feature status should be the previously set value - getViaEndpoints config3 - -assertFlagForbidden :: HasCallStack => TestM ResponseLBS -> TestM () -assertFlagForbidden res = do - res !!! do - statusCode === const 403 - fmap label . responseJsonMaybe === const (Just "no-team-member") - -assertFlagWithConfig :: - forall cfg m. - ( HasCallStack, - Eq cfg, - ToSchema cfg, - Show cfg, - Typeable cfg, - IsFeatureConfig cfg, - MonadIO m, - MonadCatch m - ) => - m ResponseLBS -> - WithStatusNoLock cfg -> - m () -assertFlagWithConfig response expected = do - r <- response - let rJson = responseJsonEither @(WithStatusNoLock cfg) r - pure r !!! statusCode === const 200 - liftIO $ do - fmap wssStatus rJson @?= (Right . wssStatus $ expected) - fmap wssConfig rJson @?= (Right . wssConfig $ expected) - -wsAssertFeatureConfigUpdate :: - forall cfg. - ( KnownSymbol (FeatureSymbol cfg), - ToJSON (WithStatus cfg) - ) => - WithStatusNoLock cfg -> - LockStatus -> - Notification -> - IO () -wsAssertFeatureConfigUpdate config lockStatus notification = do - let e :: FeatureConfig.Event = List1.head (WS.unpackPayload notification) - FeatureConfig._eventType e @?= FeatureConfig.Update - FeatureConfig._eventFeatureName e @?= featureName @cfg - FeatureConfig._eventData e @?= Aeson.toJSON (withLockStatus lockStatus config) From fd8d7320493f3e5c14e89ad12eb9460dcd0dc6ea Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 14:44:34 +0000 Subject: [PATCH 25/30] search visibility, validate saml emails, and digital signatures patch --- integration/test/API/GalleyInternal.hs | 6 ++++ integration/test/Test/FeatureFlags.hs | 34 +++++++++++++++++++ .../test/integration/API/Teams/Feature.hs | 6 ---- 3 files changed, 40 insertions(+), 6 deletions(-) diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs index f012141c438..59a0880411f 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -111,3 +111,9 @@ getFeatureStatusMulti domain featureName tids = do fn <- asString featureName req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "features-multi-teams", fn] submit "POST" $ req & addJSONObject ["teams" .= tids] + +patchTeamFeature :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> Value -> App Response +patchTeamFeature domain team featureName payload = do + tid <- asString team + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] + submit "PATCH" $ req & addJSON payload diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 4df1cb49495..ae92ebc514b 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -936,3 +936,37 @@ _testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do liftIO $ threadDelay (d * 1000000) -- waiting it out -- value reverts back checkFeatureLenientTtl featureName owner tid defFeatureStatus + +testPatchSearchVisibility :: HasCallStack => App () +testPatchSearchVisibility = _testPatch "searchVisibility" False disabled enabled + +testPatchValidateSAMLEmails :: HasCallStack => App () +testPatchValidateSAMLEmails = _testPatch "validateSAMLemails" False enabled disabled + +testPatchDigitalSignatures :: HasCallStack => App () +testPatchDigitalSignatures = _testPatch "digitalSignatures" False disabled enabled + +_testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () +_testPatch featureName _assertLockStatusChange defaultFeatureConfig patch = do + (owner, tid, _) <- createTeam OwnDomain 0 + checkFeature featureName owner tid defaultFeatureConfig + assertSuccess =<< Internal.patchTeamFeature OwnDomain tid featureName patch + patched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName + checkFeature featureName owner tid patched + lockStatus <- patched %. "lockStatus" >>= asString + if lockStatus == "locked" + then do + patched `shouldMatch` (defaultFeatureConfig & setField "lockStatus" "locked") + else do + patched %. "status" `shouldMatch` valueOrDefault "status" + mPatchedConfig <- lookupField patched "config" + case mPatchedConfig of + Just patchedConfig -> patchedConfig `shouldMatch` valueOrDefault "config" + Nothing -> do + mDefConfig <- lookupField defaultFeatureConfig "config" + assertBool "patch had an unexpected config field" (isNothing mDefConfig) + where + valueOrDefault :: String -> App Value + valueOrDefault key = do + mValue <- lookupField patch key + maybe (defaultFeatureConfig %. key) pure mValue diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 71ac05cc38c..0c6940e96b9 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -47,12 +47,6 @@ tests s = -- (depending on prior state or configuration). Thus, they cannot be -- tested here (setting random values), but are tested with separate -- tests. - test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled SearchVisibilityAvailableConfig, - test s (unpack $ featureNameBS @ValidateSAMLEmailsConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled ValidateSAMLEmailsConfig, - test s (unpack $ featureNameBS @DigitalSignaturesConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled DigitalSignaturesConfig, test s (unpack $ featureNameBS @AppLockConfig) $ testPatchWithCustomGen IgnoreLockStatusChange FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) 60) validAppLockConfigGen, test s (unpack $ featureNameBS @ConferenceCallingConfig) $ From 52b3cb2354178730f9fc3d0c3da448c2e8d72519 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Tue, 28 May 2024 14:56:21 +0000 Subject: [PATCH 26/30] test patch AppLock --- integration/test/Test/FeatureFlags.hs | 15 +++++++++++++++ .../galley/test/integration/API/Teams/Feature.hs | 10 ---------- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index ae92ebc514b..9d024aacea0 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -946,6 +946,21 @@ testPatchValidateSAMLEmails = _testPatch "validateSAMLemails" False enabled disa testPatchDigitalSignatures :: HasCallStack => App () testPatchDigitalSignatures = _testPatch "digitalSignatures" False disabled enabled +testPatchAppLock :: HasCallStack => App () +testPatchAppLock = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60] + ] + _testPatch "appLock" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "appLock" True defCfg (object ["status" .= "disabled"]) + _testPatch "appLock" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "appLock" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 120]]) + _testPatch "appLock" True defCfg (object ["config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 240]]) + _testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () _testPatch featureName _assertLockStatusChange defaultFeatureConfig patch = do (owner, tid, _) <- createTeam OwnDomain 0 diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 0c6940e96b9..a7df56cd894 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -47,8 +47,6 @@ tests s = -- (depending on prior state or configuration). Thus, they cannot be -- tested here (setting random values), but are tested with separate -- tests. - test s (unpack $ featureNameBS @AppLockConfig) $ - testPatchWithCustomGen IgnoreLockStatusChange FeatureStatusEnabled (AppLockConfig (EnforceAppLock False) 60) validAppLockConfigGen, test s (unpack $ featureNameBS @ConferenceCallingConfig) $ testPatch IgnoreLockStatusChange FeatureStatusEnabled ConferenceCallingConfig, test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ @@ -101,14 +99,6 @@ validMLSConfigGen = where sortedAndNoDuplicates xs = (sort . nub) xs == xs -validAppLockConfigGen :: Gen (WithStatusPatch AppLockConfig) -validAppLockConfigGen = - arbitrary - `suchThat` ( \cfg -> case wspConfig cfg of - Just (AppLockConfig _ secs) -> secs >= 30 - Nothing -> True - ) - -- | Binary type to prevent "boolean blindness" data AssertLockStatusChange = AssertLockStatusChange | IgnoreLockStatusChange deriving (Eq) From e9de23ce86dcadced4fda728876b62b59876c3b0 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 29 May 2024 08:33:00 +0000 Subject: [PATCH 27/30] add more patch tests --- integration/test/Test/FeatureFlags.hs | 112 +++++++++++++++++- integration/test/Test/FeatureFlags/Util.hs | 10 +- .../test/integration/API/Teams/Feature.hs | 37 +----- 3 files changed, 113 insertions(+), 46 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 9d024aacea0..a762e2c38f7 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -937,6 +937,9 @@ _testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do -- value reverts back checkFeatureLenientTtl featureName owner tid defFeatureStatus +-------------------------------------------------------------------------------- +-- Simple flags with implicit lock status + testPatchSearchVisibility :: HasCallStack => App () testPatchSearchVisibility = _testPatch "searchVisibility" False disabled enabled @@ -946,6 +949,27 @@ 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 + +testPatchFileSharing :: HasCallStack => App () +testPatchFileSharing = _testPatch "fileSharing" True enabled disabled + +testPatchGuestLinks :: HasCallStack => App () +testPatchGuestLinks = _testPatch "conversationGuestLinks" True enabled disabled + +testPatchSndFactorPasswordChallenge :: HasCallStack => App () +testPatchSndFactorPasswordChallenge = _testPatch "sndFactorPasswordChallenge" True disabledLocked enabled + +testPatchOutlookCalIntegration :: HasCallStack => App () +testPatchOutlookCalIntegration = _testPatch "outlookCalIntegration" True disabledLocked enabled + +-------------------------------------------------------------------------------- +-- Flags with config & implicit lock status + testPatchAppLock :: HasCallStack => App () testPatchAppLock = do let defCfg = @@ -955,14 +979,47 @@ testPatchAppLock = do "ttl" .= "unlimited", "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60] ] - _testPatch "appLock" True defCfg (object ["lockStatus" .= "locked"]) - _testPatch "appLock" True defCfg (object ["status" .= "disabled"]) - _testPatch "appLock" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) - _testPatch "appLock" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 120]]) - _testPatch "appLock" True defCfg (object ["config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 240]]) + _testPatch "appLock" False defCfg (object ["lockStatus" .= "locked"]) + _testPatch "appLock" False defCfg (object ["status" .= "disabled"]) + _testPatch "appLock" False defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "appLock" False defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 120]]) + _testPatch "appLock" False defCfg (object ["config" .= object ["enforceAppLock" .= True, "inactivityTimeoutSecs" .= A.Number 240]]) + +-------------------------------------------------------------------------------- +-- Flags with config & explicit lock status + +testPatchSelfDeletingMessages :: HasCallStack => App () +testPatchSelfDeletingMessages = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" .= object ["enforcedTimeoutSeconds" .= A.Number 0] + ] + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "selfDeletingMessages" True defCfg (object ["status" .= "disabled"]) + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "locked", "status" .= "disabled"]) + _testPatch "selfDeletingMessages" True defCfg (object ["lockStatus" .= "unlocked", "config" .= object ["enforcedTimeoutSeconds" .= A.Number 30]]) + _testPatch "selfDeletingMessages" True defCfg (object ["config" .= object ["enforcedTimeoutSeconds" .= A.Number 60]]) + +testPatchEnforceFileDownloadLocation :: HasCallStack => App () +testPatchEnforceFileDownloadLocation = do + let defCfg = + object + [ "lockStatus" .= "locked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" .= object [] + ] + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "unlocked"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["status" .= "enabled"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "unlocked", "status" .= "enabled"]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "locked", "config" .= object []]) + _testPatch "enforceFileDownloadLocation" True defCfg (object ["config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) _testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () -_testPatch featureName _assertLockStatusChange defaultFeatureConfig patch = do +_testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do (owner, tid, _) <- createTeam OwnDomain 0 checkFeature featureName owner tid defaultFeatureConfig assertSuccess =<< Internal.patchTeamFeature OwnDomain tid featureName patch @@ -971,7 +1028,13 @@ _testPatch featureName _assertLockStatusChange defaultFeatureConfig patch = do lockStatus <- patched %. "lockStatus" >>= asString if lockStatus == "locked" then do + -- if lock status is locked the feature status should fall back to the default patched `shouldMatch` (defaultFeatureConfig & setField "lockStatus" "locked") + -- if lock status is locked, it was either locked before or changed by the patch + mPatchedLockStatus <- lookupField patch "lockStatus" + case mPatchedLockStatus of + Just ls -> ls `shouldMatch` "locked" + Nothing -> defaultFeatureConfig %. "lockStatus" `shouldMatch` "locked" else do patched %. "status" `shouldMatch` valueOrDefault "status" mPatchedConfig <- lookupField patched "config" @@ -980,8 +1043,45 @@ _testPatch featureName _assertLockStatusChange defaultFeatureConfig patch = do Nothing -> do mDefConfig <- lookupField defaultFeatureConfig "config" assertBool "patch had an unexpected config field" (isNothing mDefConfig) + + when hasExplicitLockStatus $ do + -- if lock status is unlocked, it was either unlocked before or changed by the patch + mPatchedLockStatus <- lookupField patch "lockStatus" + case mPatchedLockStatus of + Just ls -> ls `shouldMatch` "unlocked" + Nothing -> defaultFeatureConfig %. "lockStatus" `shouldMatch` "unlocked" where valueOrDefault :: String -> App Value valueOrDefault key = do mValue <- lookupField patch key maybe (defaultFeatureConfig %. key) pure mValue + +-- _testPatch' :: HasCallStack => String -> Bool -> Value -> [Value] -> App () +-- _testPatch' featureName _assertLockStatusChange defaultFeatureConfig patches = do +-- (owner, tid, _) <- createTeam OwnDomain 0 +-- checkFeature featureName owner tid defaultFeatureConfig +-- forM_ patches $ \patch -> foo owner tid patch +-- where +-- foo :: Value -> String -> Value -> App () +-- foo owner tid patch = do +-- beforePatched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName +-- assertSuccess =<< Internal.patchTeamFeature OwnDomain tid featureName patch +-- patched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName +-- checkFeature featureName owner tid patched +-- lockStatus <- patched %. "lockStatus" >>= asString +-- if lockStatus == "locked" +-- then do +-- patched `shouldMatch` (defaultFeatureConfig & setField "lockStatus" "locked") +-- else do +-- patched %. "status" `shouldMatch` patchedOrOld beforePatched patch "status" +-- mPatchedConfig <- lookupField patched "config" +-- case mPatchedConfig of +-- Just patchedConfig -> patchedConfig `shouldMatch` patchedOrOld beforePatched patch "config" +-- Nothing -> do +-- mDefConfig <- lookupField defaultFeatureConfig "config" +-- assertBool "patch had an unexpected config field" (isNothing mDefConfig) + +-- patchedOrOld :: Value -> Value -> String -> App Value +-- patchedOrOld old patch key = do +-- mValue <- lookupField patch key +-- maybe (old %. key) pure mValue diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs index a83430c7f86..c03959919dd 100644 --- a/integration/test/Test/FeatureFlags/Util.hs +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -35,21 +35,21 @@ checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> use checkFeature = checkFeatureWith shouldMatch checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => (App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () -checkFeatureWith shouldMatchStatus feature user tid expected = do +checkFeatureWith shouldMatch' 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 `shouldMatchStatus` expected + resp.json `shouldMatch'` expected bindResponse (Public.getTeamFeatures user tid) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatchStatus` expected + resp.json %. feature `shouldMatch'` expected bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json `shouldMatchStatus` expected + resp.json `shouldMatch'` expected bindResponse (Public.getFeatureConfigs user) $ \resp -> do resp.status `shouldMatchInt` 200 - resp.json %. feature `shouldMatchStatus` expected + resp.json %. feature `shouldMatch'` expected checkFeatureLenientTtl :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App () checkFeatureLenientTtl = checkFeatureWith shouldMatchLenientTtl diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index a7df56cd894..6f502318cb0 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -47,10 +47,6 @@ tests s = -- (depending on prior state or configuration). Thus, they cannot be -- tested here (setting random values), but are tested with separate -- tests. - test s (unpack $ featureNameBS @ConferenceCallingConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled ConferenceCallingConfig, - test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled SearchVisibilityAvailableConfig, test s (unpack $ featureNameBS @MLSConfig) $ testPatchWithCustomGen AssertLockStatusChange @@ -63,20 +59,8 @@ tests s = [ProtocolProteusTag, ProtocolMLSTag] ) validMLSConfigGen, - test s (unpack $ featureNameBS @FileSharingConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled FileSharingConfig, - test s (unpack $ featureNameBS @GuestLinksConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled GuestLinksConfig, - test s (unpack $ featureNameBS @SndFactorPasswordChallengeConfig) $ - testPatch AssertLockStatusChange FeatureStatusDisabled SndFactorPasswordChallengeConfig, - test s (unpack $ featureNameBS @SelfDeletingMessagesConfig) $ - testPatch AssertLockStatusChange FeatureStatusEnabled (SelfDeletingMessagesConfig 0), - test s (unpack $ featureNameBS @OutlookCalIntegrationConfig) $ - testPatch AssertLockStatusChange FeatureStatusDisabled OutlookCalIntegrationConfig, test s (unpack $ featureNameBS @MlsE2EIdConfig) $ - testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @MlsE2EIdConfig)), - test s (unpack $ featureNameBS @EnforceFileDownloadLocationConfig) $ - testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @EnforceFileDownloadLocationConfig)) + testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @MlsE2EIdConfig)) ] ] @@ -100,7 +84,7 @@ validMLSConfigGen = sortedAndNoDuplicates xs = (sort . nub) xs == xs -- | Binary type to prevent "boolean blindness" -data AssertLockStatusChange = AssertLockStatusChange | IgnoreLockStatusChange +data AssertLockStatusChange = AssertLockStatusChange deriving (Eq) testPatchWithArbitrary :: @@ -141,23 +125,6 @@ testPatchWithCustomGen assertLockStatusChange featureStatus cfg gen = do generatedConfig <- liftIO $ generate gen testPatch' assertLockStatusChange generatedConfig featureStatus cfg -testPatch :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg), - Arbitrary (WithStatusPatch cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - TestM () -testPatch assertLockStatusChange status cfg = testPatchWithCustomGen assertLockStatusChange status cfg arbitrary - testPatch' :: forall cfg. ( HasCallStack, From ea77dcdb8ea0dfc223d90b7d304111c506f0e6d3 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 29 May 2024 08:45:59 +0000 Subject: [PATCH 28/30] mlse2eid patch --- integration/test/Test/FeatureFlags.hs | 74 +++++++++++-------- .../test/integration/API/Teams/Feature.hs | 23 +----- 2 files changed, 45 insertions(+), 52 deletions(-) diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index a762e2c38f7..92f95b60fd1 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -1018,6 +1018,50 @@ testPatchEnforceFileDownloadLocation = do _testPatch "enforceFileDownloadLocation" True defCfg (object ["lockStatus" .= "locked", "config" .= object []]) _testPatch "enforceFileDownloadLocation" True defCfg (object ["config" .= object ["enforcedDownloadLocation" .= "/tmp"]]) +testPatchE2EId :: HasCallStack => App () +testPatchE2EId = do + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "verificationExpiration" .= A.Number 86400, + "useProxyOnMobile" .= False + ] + ] + _testPatch "mlsE2EId" True defCfg (object ["lockStatus" .= "locked"]) + _testPatch "mlsE2EId" True defCfg (object ["status" .= "enabled"]) + _testPatch "mlsE2EId" True defCfg (object ["lockStatus" .= "locked", "status" .= "enabled"]) + _testPatch + "mlsE2EId" + True + defCfg + ( object + [ "lockStatus" .= "unlocked", + "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86401, + "useProxyOnMobile" .= True + ] + ] + ) + _testPatch + "mlsE2EId" + True + defCfg + ( object + [ "config" + .= object + [ "crlProxy" .= "https://example.com", + "verificationExpiration" .= A.Number 86401, + "useProxyOnMobile" .= True + ] + ] + ) + _testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () _testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do (owner, tid, _) <- createTeam OwnDomain 0 @@ -1055,33 +1099,3 @@ _testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do valueOrDefault key = do mValue <- lookupField patch key maybe (defaultFeatureConfig %. key) pure mValue - --- _testPatch' :: HasCallStack => String -> Bool -> Value -> [Value] -> App () --- _testPatch' featureName _assertLockStatusChange defaultFeatureConfig patches = do --- (owner, tid, _) <- createTeam OwnDomain 0 --- checkFeature featureName owner tid defaultFeatureConfig --- forM_ patches $ \patch -> foo owner tid patch --- where --- foo :: Value -> String -> Value -> App () --- foo owner tid patch = do --- beforePatched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName --- assertSuccess =<< Internal.patchTeamFeature OwnDomain tid featureName patch --- patched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName --- checkFeature featureName owner tid patched --- lockStatus <- patched %. "lockStatus" >>= asString --- if lockStatus == "locked" --- then do --- patched `shouldMatch` (defaultFeatureConfig & setField "lockStatus" "locked") --- else do --- patched %. "status" `shouldMatch` patchedOrOld beforePatched patch "status" --- mPatchedConfig <- lookupField patched "config" --- case mPatchedConfig of --- Just patchedConfig -> patchedConfig `shouldMatch` patchedOrOld beforePatched patch "config" --- Nothing -> do --- mDefConfig <- lookupField defaultFeatureConfig "config" --- assertBool "patch had an unexpected config field" (isNothing mDefConfig) - --- patchedOrOld :: Value -> Value -> String -> App Value --- patchedOrOld old patch key = do --- mValue <- lookupField patch key --- maybe (old %. key) pure mValue diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs index 6f502318cb0..78021aca831 100644 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ b/services/galley/test/integration/API/Teams/Feature.hs @@ -58,9 +58,7 @@ tests s = MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 [ProtocolProteusTag, ProtocolMLSTag] ) - validMLSConfigGen, - test s (unpack $ featureNameBS @MlsE2EIdConfig) $ - testPatchWithArbitrary AssertLockStatusChange FeatureStatusDisabled (wsConfig (defFeatureStatus @MlsE2EIdConfig)) + validMLSConfigGen ] ] @@ -87,25 +85,6 @@ validMLSConfigGen = data AssertLockStatusChange = AssertLockStatusChange deriving (Eq) -testPatchWithArbitrary :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg), - Arbitrary (WithStatusPatch cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - TestM () -testPatchWithArbitrary assertLockStatusChange featureStatus cfg = do - generatedConfig <- liftIO $ generate arbitrary - testPatch' assertLockStatusChange generatedConfig featureStatus cfg - testPatchWithCustomGen :: forall cfg. ( HasCallStack, From cf5b7723683678cf95153a03f6b134c463aec2d6 Mon Sep 17 00:00:00 2001 From: Leif Battermann Date: Wed, 29 May 2024 09:48:32 +0000 Subject: [PATCH 29/30] MLS patch --- integration/test/Test/FeatureFlags.hs | 100 ++++++++++++- services/galley/galley.cabal | 1 - services/galley/test/integration/API.hs | 2 - .../test/integration/API/Teams/Feature.hs | 137 ------------------ 4 files changed, 97 insertions(+), 143 deletions(-) delete mode 100644 services/galley/test/integration/API/Teams/Feature.hs diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs index 92f95b60fd1..32a22526da7 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -1062,12 +1062,106 @@ testPatchE2EId = do ] ) +testPatchMLS :: HasCallStack => App () +testPatchMLS = do + dom <- asString OwnDomain + (_, tid, _) <- createTeam dom 0 + assertSuccess + =<< Internal.patchTeamFeature + dom + tid + "mlsMigration" + (object ["status" .= "disabled", "lockStatus" .= "unlocked"]) + let defCfg = + object + [ "lockStatus" .= "unlocked", + "status" .= "disabled", + "ttl" .= "unlimited", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "proteus", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["lockStatus" .= "locked"]) + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["status" .= "enabled"]) + _testPatchWithSetup mlsMigrationSetup dom "mls" True defCfg (object ["lockStatus" .= "locked", "status" .= "enabled"]) + _testPatchWithSetup + mlsMigrationSetup + dom + "mls" + True + defCfg + ( object + [ "status" .= "enabled", + "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + ) + _testPatchWithSetup + mlsMigrationSetup + dom + "mls" + True + defCfg + ( object + [ "config" + .= object + [ "protocolToggleUsers" .= ([] :: [String]), + "defaultProtocol" .= "mls", + "supportedProtocols" .= ["proteus", "mls"], + "allowedCipherSuites" .= ([1] :: [Int]), + "defaultCipherSuite" .= A.Number 1 + ] + ] + ) + where + mlsMigrationSetup :: HasCallStack => String -> String -> App () + mlsMigrationSetup dom tid = + assertSuccess + =<< Internal.patchTeamFeature + dom + tid + "mlsMigration" + (object ["status" .= "disabled", "lockStatus" .= "unlocked"]) + _testPatch :: HasCallStack => String -> Bool -> Value -> Value -> App () _testPatch featureName hasExplicitLockStatus defaultFeatureConfig patch = do - (owner, tid, _) <- createTeam OwnDomain 0 + dom <- asString OwnDomain + _testPatchWithSetup + (\_ _ -> pure ()) + dom + featureName + hasExplicitLockStatus + defaultFeatureConfig + patch + +_testPatchWithSetup :: + HasCallStack => + (String -> String -> App ()) -> + String -> + String -> + Bool -> + Value -> + Value -> + App () +_testPatchWithSetup setup domain featureName hasExplicitLockStatus defaultFeatureConfig patch = do + (owner, tid, _) <- createTeam domain 0 + -- run a feature-specific setup. For most features this is a no-op. + setup domain tid + checkFeature featureName owner tid defaultFeatureConfig - assertSuccess =<< Internal.patchTeamFeature OwnDomain tid featureName patch - patched <- (.json) =<< Internal.getTeamFeature OwnDomain tid featureName + assertSuccess =<< Internal.patchTeamFeature domain tid featureName patch + patched <- (.json) =<< Internal.getTeamFeature domain tid featureName checkFeature featureName owner tid patched lockStatus <- patched %. "lockStatus" >>= asString if lockStatus == "locked" diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 53fe0072284..b61df20ca8b 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -397,7 +397,6 @@ executable galley-integration API.Roles API.SQS API.Teams - API.Teams.Feature API.Teams.LegalHold API.Teams.LegalHold.DisabledByDefault API.Teams.LegalHold.Util diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs index b20fb577974..62c10b3e20a 100644 --- a/services/galley/test/integration/API.hs +++ b/services/galley/test/integration/API.hs @@ -32,7 +32,6 @@ import API.MessageTimer qualified as MessageTimer import API.Roles qualified as Roles import API.SQS import API.Teams qualified as Teams -import API.Teams.Feature qualified as TeamFeature import API.Teams.LegalHold qualified as Teams.LegalHold import API.Teams.LegalHold.DisabledByDefault qualified import API.Util @@ -120,7 +119,6 @@ tests s = MessageTimer.tests s, Roles.tests s, CustomBackend.tests s, - TeamFeature.tests s, Federation.tests s, API.MLS.tests s ] diff --git a/services/galley/test/integration/API/Teams/Feature.hs b/services/galley/test/integration/API/Teams/Feature.hs deleted file mode 100644 index 78021aca831..00000000000 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ /dev/null @@ -1,137 +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 API.Teams.Feature (tests) where - -import API.Util -import API.Util.TeamFeature hiding (getFeatureConfig, setLockStatusInternal) -import Bilge -import Bilge.Assert -import Brig.Types.Test.Arbitrary (Arbitrary (arbitrary)) -import Control.Lens.Operators () -import Data.ByteString.Char8 (unpack) -import Data.Schema (ToSchema) -import GHC.TypeLits (KnownSymbol) -import Imports -import Test.QuickCheck (Gen, generate, suchThat) -import Test.Tasty -import Test.Tasty.HUnit ((@?=)) -import TestHelpers (test) -import TestSetup -import Wire.API.Conversation.Protocol -import Wire.API.MLS.CipherSuite -import Wire.API.Team.Feature hiding (setLockStatus) - -tests :: IO TestSetup -> TestTree -tests s = - testGroup - "Feature Config API and Team Features API" - [ testGroup - "Patch" - [ -- Note: `SSOConfig` and `LegalHoldConfig` may not be able to be reset - -- (depending on prior state or configuration). Thus, they cannot be - -- tested here (setting random values), but are tested with separate - -- tests. - test s (unpack $ featureNameBS @MLSConfig) $ - testPatchWithCustomGen - AssertLockStatusChange - FeatureStatusDisabled - ( MLSConfig - [] - ProtocolProteusTag - [MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519] - MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 - [ProtocolProteusTag, ProtocolMLSTag] - ) - validMLSConfigGen - ] - ] - --- | Provides a `Gen` with test objects that are realistic and can easily be asserted -validMLSConfigGen :: Gen (WithStatusPatch MLSConfig) -validMLSConfigGen = - arbitrary - `suchThat` ( \cfg -> - case wspConfig cfg of - Just (MLSConfig us defProtocol cTags ctag supProtocol) -> - sortedAndNoDuplicates us - && sortedAndNoDuplicates cTags - && elem ctag cTags - && notElem ProtocolMixedTag supProtocol - && elem defProtocol supProtocol - && sortedAndNoDuplicates supProtocol - _ -> True - && Just FeatureStatusEnabled == wspStatus cfg - ) - where - sortedAndNoDuplicates xs = (sort . nub) xs == xs - --- | Binary type to prevent "boolean blindness" -data AssertLockStatusChange = AssertLockStatusChange - deriving (Eq) - -testPatchWithCustomGen :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - Gen (WithStatusPatch cfg) -> - TestM () -testPatchWithCustomGen assertLockStatusChange featureStatus cfg gen = do - generatedConfig <- liftIO $ generate gen - testPatch' assertLockStatusChange generatedConfig featureStatus cfg - -testPatch' :: - forall cfg. - ( HasCallStack, - IsFeatureConfig cfg, - Typeable cfg, - ToSchema cfg, - Eq cfg, - Show cfg, - KnownSymbol (FeatureSymbol cfg) - ) => - AssertLockStatusChange -> - WithStatusPatch cfg -> - FeatureStatus -> - cfg -> - TestM () -testPatch' testLockStatusChange rndFeatureConfig defStatus defConfig = do - (uid, tid) <- createBindingTeam - Just original <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid - patchTeamFeatureInternal tid rndFeatureConfig !!! statusCode === const 200 - Just actual <- responseJsonMaybe <$> getTeamFeatureInternal @cfg tid - liftIO $ - if wsLockStatus actual == LockStatusLocked - then do - wsStatus actual @?= defStatus - wsConfig actual @?= defConfig - else do - wsStatus actual @?= fromMaybe (wsStatus original) (wspStatus rndFeatureConfig) - when (testLockStatusChange == AssertLockStatusChange) $ - wsLockStatus actual @?= fromMaybe (wsLockStatus original) (wspLockStatus rndFeatureConfig) - wsConfig actual @?= fromMaybe (wsConfig original) (wspConfig rndFeatureConfig) - checkTeamFeatureAllEndpoints uid tid actual From 7d3f72ab443e446a6570314f5071830aea5b4262 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Wed, 29 May 2024 15:17:54 +0200 Subject: [PATCH 30/30] Add a changelog --- changelog.d/5-internal/WPB-6442 | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/5-internal/WPB-6442 diff --git a/changelog.d/5-internal/WPB-6442 b/changelog.d/5-internal/WPB-6442 new file mode 100644 index 00000000000..efb05804505 --- /dev/null +++ b/changelog.d/5-internal/WPB-6442 @@ -0,0 +1 @@ +Port team feature tests to the `integration` package