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 diff --git a/integration/integration.cabal b/integration/integration.cabal index 3fd43a73d59..2c7cfa62f53 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 900469f0a27..4fe8a04846e 100644 --- a/integration/test/API/Galley.hs +++ b/integration/test/API/Galley.hs @@ -637,3 +637,14 @@ putLegalholdStatus tid usr status = do baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"]) >>= submit "PUT" . addJSONObject ["status" .= status, "ttl" .= "unlimited"] + +setTeamFeatureConfig :: (HasCallStack, MakesValue user, MakesValue team, MakesValue featureName, MakesValue payload) => user -> team -> featureName -> payload -> App Response +setTeamFeatureConfig = setTeamFeatureConfigVersioned Versioned + +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 user 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 ff9843c7a51..965c6d66bfc 100644 --- a/integration/test/API/GalleyInternal.hs +++ b/integration/test/API/GalleyInternal.hs @@ -43,6 +43,13 @@ setTeamFeatureStatus domain team featureName status = do req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName] submit "PATCH" $ req & addJSONObject ["status" .= status] +setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App () +setTeamFeatureLockStatus domain team featureName status = do + tid <- asString team + req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status] + bindResponse (submit "PUT" $ req) $ \res -> + res.status `shouldMatchInt` 200 + getFederationStatus :: ( HasCallStack, MakesValue user @@ -72,12 +79,12 @@ legalholdIsTeamInWhitelist tid uid = do req <- baseRequest uid Galley Unversioned $ joinHttpPath ["i", "legalhold", "whitelisted-teams", tidStr] submit "GET" req -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 -- | https://staging-nginz-https.zinfra.io/api-internal/swagger-ui/galley/#/galley/get_i_teams__tid__features_legalhold @@ -86,3 +93,16 @@ legalholdIsEnabled tid uid = do tidStr <- asString tid baseRequest uid Galley Unversioned do joinHttpPath ["i", "teams", tidStr, "features", "legalhold"] >>= submit "GET" + +-- 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] + +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/Notifications.hs b/integration/test/Notifications.hs index b82fca54b29..09a9514606e 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 afd4b049ac5..7c5259f4c19 100644 --- a/integration/test/Test/FeatureFlags.hs +++ b/integration/test/Test/FeatureFlags.hs @@ -18,50 +18,49 @@ module Test.FeatureFlags where import qualified API.Galley as Public -import API.GalleyInternal import qualified API.GalleyInternal as Internal +import Control.Concurrent (threadDelay) 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 import Testlib.Prelude testLimitedEventFanout :: HasCallStack => App () testLimitedEventFanout = do let featureName = "limitedEventFanout" (_alice, team, _) <- createTeam OwnDomain 1 - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + bindResponse (Internal.getTeamFeature OwnDomain featureName team) $ \resp -> do resp.status `shouldMatchInt` 200 resp.json %. "status" `shouldMatch` "disabled" - assertSuccess =<< setTeamFeatureStatus OwnDomain team featureName "enabled" - bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do + assertSuccess =<< Internal.setTeamFeatureStatus OwnDomain team featureName "enabled" + bindResponse (Internal.getTeamFeature OwnDomain featureName team) $ \resp -> 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"] - -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 feature tidStr) $ \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 +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 testMlsE2EConfigCrlProxyRequired :: HasCallStack => App () testMlsE2EConfigCrlProxyRequired = do @@ -77,7 +76,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" @@ -88,7 +87,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 @@ -109,9 +108,972 @@ 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" >>= assertSuccess + 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"]) + +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 + +testSearchVisibilityInbound :: HasCallStack => App () +testSearchVisibilityInbound = _testSimpleFlag "searchVisibilityInbound" Public.setTeamFeatureConfig False + +testDigitalSignaturesInternal :: HasCallStack => App () +testDigitalSignaturesInternal = _testSimpleFlag "digitalSignatures" Internal.setTeamFeatureConfig False + +testValidateSAMLEmailsInternal :: HasCallStack => App () +testValidateSAMLEmailsInternal = _testSimpleFlag "validateSAMLemails" Internal.setTeamFeatureConfig True + +testConferenceCallingInternal :: HasCallStack => App () +testConferenceCallingInternal = _testSimpleFlag "conferenceCalling" Internal.setTeamFeatureConfig True + +testSearchVisibilityInboundInternal :: HasCallStack => App () +testSearchVisibilityInboundInternal = _testSimpleFlag "searchVisibilityInbound" Internal.setTeamFeatureConfig False + +_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 + + (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 =<< 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 =<< setFeatureConfig owner tid featureName (object ["status" .= 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 + +testConversationGuestLinks :: HasCallStack => App () +testConversationGuestLinks = _testSimpleFlagWithLockStatus "conversationGuestLinks" Public.setTeamFeatureConfig True True + +testFileSharing :: HasCallStack => App () +testFileSharing = _testSimpleFlagWithLockStatus "fileSharing" Public.setTeamFeatureConfig True True + +testSndFactorPasswordChallenge :: HasCallStack => App () +testSndFactorPasswordChallenge = _testSimpleFlagWithLockStatus "sndFactorPasswordChallenge" Public.setTeamFeatureConfig False False + +testOutlookCalIntegration :: HasCallStack => App () +testOutlookCalIntegration = _testSimpleFlagWithLockStatus "outlookCalIntegration" Public.setTeamFeatureConfig False False + +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 + 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 =<< 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 + + 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 =<< setFeatureConfig 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 + +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" (object ["status" .= "disabled", "config" .= object ["domains" .= ["example.com"]]])} $ \domain -> do + (_, tid, m : _) <- createTeam domain 2 + 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 +-- 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 + +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) + +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" .= ""]]) + +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 + ] + ] + +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 []]]) + +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 + ] + ] + +mlsE2EIdConfig :: App (Value, Value, Value, Value) +mlsE2EIdConfig = do + cfg2 <- + mlsE2EIdConfig1 + & setField "config.verificationExpiration" (A.Number 86401) + & setField "config.useProxyOnMobile" True + invalidConfig <- cfg2 & 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 + -- 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' + +_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 + (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 + + bindResponse (Public.getFeatureConfigs randomPersonalUser) $ \resp -> do + resp.status `shouldMatchInt` 200 + resp.json %. featureName `shouldMatch` defaultFeatureConfig + + -- team user + nonTeamMember <- randomUser OwnDomain def + assertForbidden =<< Public.getTeamFeature nonTeamMember tid featureName + + checkFeature featureName m tid defaultFeatureConfig + + -- 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 =<< setTeamFeatureConfig owner tid featureName config1 + for_ wss $ \ws -> do + notif <- awaitMatch isFeatureConfigUpdateNotif ws + notif %. "payload.0.name" `shouldMatch` featureName + notif %. "payload.0.data" `shouldMatch` (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "locked" + checkFeature featureName m tid =<< setField "lockStatus" "locked" defaultFeatureConfig + Internal.setTeamFeatureLockStatus OwnDomain tid featureName "unlocked" + + void $ withWebSockets [m] $ \wss -> do + assertStatus 400 =<< setTeamFeatureConfig owner tid featureName invalidConfig + for_ wss $ assertNoEvent 2 + + checkFeature featureName m tid =<< (config1 & setField "lockStatus" "unlocked" & setField "ttl" "unlimited") + + 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 + (_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"]] + +testConferenceCallingTTLIncreaseToUnlimited :: HasCallStack => App () +testConferenceCallingTTLIncreaseToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) Nothing + +testConferenceCallingTTLIncrease :: HasCallStack => App () +testConferenceCallingTTLIncrease = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 2) (Just 4) + +testConferenceCallingTTLReduceFromUnlimited :: HasCallStack => App () +testConferenceCallingTTLReduceFromUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing (Just 2) + +testConferenceCallingTTLReduce :: HasCallStack => App () +testConferenceCallingTTLReduce = _testSimpleFlagTTLOverride "conferenceCalling" True (Just 5) (Just 2) + +testConferenceCallingTTLUnlimitedToUnlimited :: HasCallStack => App () +testConferenceCallingTTLUnlimitedToUnlimited = _testSimpleFlagTTLOverride "conferenceCalling" True Nothing Nothing + +_testSimpleFlagTTLOverride :: HasCallStack => String -> Bool -> Maybe Int -> Maybe Int -> App () +_testSimpleFlagTTLOverride featureName enabledByDefault mTtl mTtlAfter = do + let ttl = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtl + let ttlAfter = maybe (A.String . cs $ "unlimited") (A.Number . fromIntegral) mTtlAfter + (owner, tid, _) <- createTeam OwnDomain 0 + let (defaultValue, otherValue) = if enabledByDefault then ("enabled", "disabled") else ("disabled", "enabled") + + -- Initial value should be the default value + let defFeatureStatus = object ["status" .= defaultValue, "ttl" .= "unlimited", "lockStatus" .= "unlocked"] + checkFeature featureName owner tid defFeatureStatus + + -- Setting should work + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) + + case (mTtl, mTtlAfter) of + (Just d, Just d') -> do + -- wait less than expiration, override and recheck. + liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL + -- setFlagInternal otherValue ttlAfter + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + -- value is still correct + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + + liftIO $ threadDelay (d' * 1000000) -- waiting for new TTL + checkFeatureLenientTtl featureName owner tid defFeatureStatus + (Just d, Nothing) -> do + -- wait less than expiration, override and recheck. + liftIO $ threadDelay (d * 1000000 `div` 2) -- waiting half of TTL + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + -- value is still correct + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + (Nothing, Nothing) -> do + -- overriding in this case should have no effect. + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttl]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttl, "lockStatus" .= "unlocked"]) + (Nothing, Just d) -> do + assertSuccess =<< Internal.setTeamFeatureConfig OwnDomain tid featureName (object ["status" .= otherValue, "ttl" .= ttlAfter]) + checkFeatureLenientTtl featureName owner tid (object ["status" .= otherValue, "ttl" .= ttlAfter, "lockStatus" .= "unlocked"]) + liftIO $ threadDelay (d * 1000000) -- waiting it out + -- value reverts back + checkFeatureLenientTtl featureName owner tid defFeatureStatus + +-------------------------------------------------------------------------------- +-- Simple flags with implicit lock status + +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 + +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 = + object + [ "lockStatus" .= "unlocked", + "status" .= "enabled", + "ttl" .= "unlimited", + "config" .= object ["enforceAppLock" .= False, "inactivityTimeoutSecs" .= A.Number 60] + ] + _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"]]) + +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 + ] + ] + ) + +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 + 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 domain tid featureName patch + patched <- (.json) =<< Internal.getTeamFeature domain featureName tid + checkFeature featureName owner tid patched + 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" + case mPatchedConfig of + Just patchedConfig -> patchedConfig `shouldMatch` valueOrDefault "config" + 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 diff --git a/integration/test/Test/FeatureFlags/Util.hs b/integration/test/Test/FeatureFlags/Util.hs new file mode 100644 index 00000000000..62b027d9298 --- /dev/null +++ b/integration/test/Test/FeatureFlags/Util.hs @@ -0,0 +1,86 @@ +-- 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 qualified Data.Aeson as A +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 = checkFeatureWith shouldMatch + +checkFeatureWith :: (HasCallStack, MakesValue user, MakesValue tid, MakesValue expected) => (App Value -> expected -> App ()) -> String -> user -> tid -> expected -> App () +checkFeatureWith shouldMatch' feature user tid expected = do + tidStr <- asString tid + domain <- objDomain user + bindResponse (Internal.getTeamFeature domain feature tidStr) $ \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 + +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/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/integration/test/Testlib/JSON.hs b/integration/test/Testlib/JSON.hs index 871682fabb5..62eda62cba2 100644 --- a/integration/test/Testlib/JSON.hs +++ b/integration/test/Testlib/JSON.hs @@ -243,8 +243,9 @@ lookupField val selector = do go k [] v = get v k go k (k2 : ks) v = get v k >>= assertField v k >>= go k2 ks --- Update nested fields +-- | Update nested fields -- E.g. ob & "foo.bar.baz" %.= ("quux" :: String) +-- The selector path will be created if non-existing. setField :: forall a b. (HasCallStack, MakesValue a, ToJSON b) => @@ -260,7 +261,8 @@ setField selector v x = do member :: (HasCallStack, MakesValue a) => String -> a -> App Bool member k x = KM.member (KM.fromString k) <$> (make x >>= asObject) --- Update nested fields, using the old value with a stateful action +-- | Update nested fields, using the old value with a stateful action +-- The selector path will be created if non-existing. modifyField :: (HasCallStack, MakesValue a, ToJSON b) => String -> (Maybe Value -> App b) -> a -> App Value modifyField selector up x = do v <- make x @@ -275,7 +277,7 @@ modifyField selector up x = do newValue <- toJSON <$> up (KM.lookup k' ob) pure $ Object $ KM.insert k' newValue ob go k (k2 : ks) v = do - val <- v %. k + val <- fromMaybe (Object $ KM.empty) <$> lookupField v k newValue <- go k2 ks val ob <- asObject v pure $ Object $ KM.insert (KM.fromString k) newValue ob @@ -346,9 +348,9 @@ objQid ob = do Just v -> pure v where select x = runMaybeT $ do - vdom <- MaybeT $ lookupField x "domain" + vdom <- lookupFieldM x "domain" dom <- MaybeT $ asStringM vdom - vid <- MaybeT $ lookupField x "id" + vid <- lookupFieldM x "id" id_ <- MaybeT $ asStringM vid pure (dom, id_) diff --git a/services/galley/default.nix b/services/galley/default.nix index 9668d11008e..687108b8244 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 @@ -247,7 +246,6 @@ mkDerivation { filepath galley-types HsOpenSSL - hspec http-api-data http-client http-client-openssl diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal index 14a1539b9ab..910de7da03b 100644 --- a/services/galley/galley.cabal +++ b/services/galley/galley.cabal @@ -407,7 +407,6 @@ executable galley-integration API.Roles API.SQS API.Teams - API.Teams.Feature API.Teams.LegalHold API.Teams.LegalHold.DisabledByDefault API.Teams.LegalHold.Util @@ -499,7 +498,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.hs b/services/galley/test/integration/API.hs index 31a5dfe1c3c..686ebfda2f9 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 4e0ccdb3cca..00000000000 --- a/services/galley/test/integration/API/Teams/Feature.hs +++ /dev/null @@ -1,1401 +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.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 Cassandra as Cql -import Control.Lens (over, to, view, (.~), (?~)) -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.Domain (Domain (..)) -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 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.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 "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 PATCH" (testLegalHold patchLegalHoldInternal), - 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, - 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, - 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, - test s "OutlookCalIntegration" $ testSimpleFlagWithLockStatus @OutlookCalIntegrationConfig FeatureStatusDisabled LockStatusLocked, - testGroup - "TTL / Conference calling" - [ 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 "SearchVisibilityInbound" $ testSimpleFlag @SearchVisibilityInboundConfig FeatureStatusDisabled, - test s "MlsE2EId feature config" $ - testNonTrivialConfigNoTTL - ( withStatus - FeatureStatusDisabled - LockStatusUnlocked - (wsConfig (defFeatureStatus @MlsE2EIdConfig)) - FeatureTTLUnlimited - ), - 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 - -- (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) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled ConferenceCallingConfig, - test s (unpack $ featureNameBS @SearchVisibilityAvailableConfig) $ - testPatch IgnoreLockStatusChange FeatureStatusEnabled SearchVisibilityAvailableConfig, - 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, - 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)) - ], - 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 - ] - ] - --- | 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 - -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) - -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, - 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), - Arbitrary (WithStatusPatch cfg) - ) => - AssertLockStatusChange -> - FeatureStatus -> - cfg -> - TestM () -testPatch assertLockStatusChange status cfg = testPatchWithCustomGen assertLockStatusChange status cfg arbitrary - -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 - -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 - 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 () - 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 - 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 - -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, - 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, - 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 - -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 <- - 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 - 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 - --- | 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 - - 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 - (_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 - (_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]) - - 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 - -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 - 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 - 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) - -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, - 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) - -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) - -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), - 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) - -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 - -defaultEnforceFileDownloadLocationConfig :: WithStatus EnforceFileDownloadLocationConfig -defaultEnforceFileDownloadLocationConfig = - withStatus - FeatureStatusDisabled - LockStatusLocked - (EnforceFileDownloadLocationConfig Nothing) - FeatureTTLUnlimited