Merge remote-tracking branch 'origin/optimize-feature-configs-tests' …

…into optimize-feature-configs

integration/test/API/Galley.hs

@@ -677,3 +677,22 @@ putLegalholdStatus tid usr status = do
   baseRequest usr Galley Versioned (joinHttpPath ["teams", tidStr, "features", "legalhold"])
     >>= submit "PUT"
       . addJSONObject ["status" .= status, "ttl" .= "unlimited"]
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_feature_configs
+getFeatureConfigs :: (HasCallStack, MakesValue user) => user -> App Response
+getFeatureConfigs user = do
+  req <- baseRequest user Galley Versioned "/feature-configs"
+  submit "GET" req
+
+-- | https://staging-nginz-https.zinfra.io/v5/api/swagger-ui/#/default/get_teams__tid__features
+getTeamFeatures :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> App Response
+getTeamFeatures user tid = do
+  tidStr <- asString tid
+  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features"])
+  submit "GET" req
+
+getTeamFeature :: (HasCallStack, MakesValue user, MakesValue tid) => user -> tid -> String -> App Response
+getTeamFeature user tid featureName = do
+  tidStr <- asString tid
+  req <- baseRequest user Galley Versioned (joinHttpPath ["teams", tidStr, "features", featureName])
+  submit "GET" req

integration/test/API/GalleyInternal.hs

@@ -33,23 +33,27 @@ putTeamMember user team perms = do
       req
 
 getTeamFeature :: (HasCallStack, MakesValue domain_) => domain_ -> String -> String -> App Response
-getTeamFeature domain_ featureName tid = do
+getTeamFeature domain_ tid featureName = do
   req <- baseRequest domain_ Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
   submit "GET" $ req
 
 setTeamFeatureStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()
 setTeamFeatureStatus domain team featureName status = do
+  setTeamFeatureStatusExpectHttpStatus domain team featureName status 200
+
+setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> Int -> App ()
+setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do
   tid <- asString team
   req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
-  res <- submit "PATCH" $ req & addJSONObject ["status" .= status]
-  res.status `shouldMatchInt` 200
+  bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res ->
+    res.status `shouldMatchInt` httpStatus
 
 setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()
 setTeamFeatureLockStatus domain team featureName status = do
   tid <- asString team
   req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName, status]
-  res <- submit "PUT" $ req
-  res.status `shouldMatchInt` 200
+  bindResponse (submit "PUT" $ req) $ \res ->
+    res.status `shouldMatchInt` 200
 
 getFederationStatus ::
   ( HasCallStack,

integration/test/Test/Demo.hs

@@ -37,7 +37,7 @@ testModifiedGalley = do
 
   let getFeatureStatus :: (MakesValue domain) => domain -> String -> App Value
       getFeatureStatus domain team = do
-        bindResponse (GalleyI.getTeamFeature domain "searchVisibility" team) $ \res -> do
+        bindResponse (GalleyI.getTeamFeature domain team "searchVisibility") $ \res -> do
           res.status `shouldMatchInt` 200
           res.json %. "status"
 
@@ -75,7 +75,7 @@ testModifiedServices = do
 
   withModifiedBackend serviceMap $ \domain -> do
     (_user, tid, _) <- createTeam domain 1
-    bindResponse (GalleyI.getTeamFeature domain "searchVisibility" tid) $ \res -> do
+    bindResponse (GalleyI.getTeamFeature domain tid "searchVisibility") $ \res -> do
       res.status `shouldMatchInt` 200
       res.json %. "status" `shouldMatch` "enabled"
 

integration/test/Test/FeatureFlags.hs

@@ -17,19 +17,167 @@
 
 module Test.FeatureFlags where
 
-import API.GalleyInternal
+import qualified API.Galley as Public
+import qualified API.GalleyInternal as Internal
+import Control.Monad.Codensity (Codensity (runCodensity))
+import Control.Monad.Reader
 import SetupHelpers
 import Testlib.Prelude
+import Testlib.ResourcePool (acquireResources)
 
 testLimitedEventFanout :: HasCallStack => App ()
 testLimitedEventFanout = do
   let featureName = "limitedEventFanout"
   (_alice, team, _) <- createTeam OwnDomain 1
   -- getTeamFeatureStatus OwnDomain team "limitedEventFanout" "enabled"
-  bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do
+  bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "disabled"
-  setTeamFeatureStatus OwnDomain team featureName "enabled"
-  bindResponse (getTeamFeature OwnDomain featureName team) $ \resp -> do
+  Internal.setTeamFeatureStatus OwnDomain team featureName "enabled"
+  bindResponse (Internal.getTeamFeature OwnDomain team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "enabled"
+
+disabled :: Value
+disabled = object ["lockStatus" .= "unlocked", "status" .= "disabled", "ttl" .= "unlimited"]
+
+disabledLocked :: Value
+disabledLocked = object ["lockStatus" .= "locked", "status" .= "disabled", "ttl" .= "unlimited"]
+
+enabled :: Value
+enabled = object ["lockStatus" .= "unlocked", "status" .= "enabled", "ttl" .= "unlimited"]
+
+-- always disabled
+testLegalholdDisabledPermanently :: HasCallStack => App ()
+testLegalholdDisabledPermanently = do
+  let cfgLhDisabledPermanently =
+        def
+          { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-permanently"
+          }
+      cfgLhDisabledByDefault =
+        def
+          { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"
+          }
+  resourcePool <- asks (.resourcePool)
+  runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do
+    let domain = testBackend.berDomain
+
+    -- Happy case: DB has no config for the team
+    runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do
+      (owner, tid, _) <- createTeam domain 1
+      checkFeature "legalhold" owner tid disabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 403
+
+    -- Inteteresting case: The team had LH enabled before backend config was
+    -- changed to disabled-permanently
+    (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do
+      (owner, tid, _) <- createTeam domain 1
+      checkFeature "legalhold" owner tid disabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "enabled" 200
+      checkFeature "legalhold" owner tid enabled
+      pure (owner, tid)
+
+    runCodensity (startDynamicBackend testBackend cfgLhDisabledPermanently) $ \_ -> do
+      checkFeature "legalhold" owner tid disabled
+
+-- can be enabled for a team, disabled if unset
+testLegalholdDisabledByDefault :: HasCallStack => App ()
+testLegalholdDisabledByDefault = do
+  withModifiedBackend
+    (def {galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"})
+    $ \domain -> do
+      (owner, tid, _) <- createTeam domain 1
+      checkFeature "legalhold" owner tid disabled
+      Internal.setTeamFeatureStatus domain tid "legalhold" "enabled"
+      checkFeature "legalhold" owner tid enabled
+      Internal.setTeamFeatureStatus domain tid "legalhold" "disabled"
+      checkFeature "legalhold" owner tid disabled
+
+-- enabled if team is allow listed, disabled in any other case
+testLegalholdWhitelistTeamsAndImplicitConsent :: HasCallStack => App ()
+testLegalholdWhitelistTeamsAndImplicitConsent = do
+  let cfgLhWhitelistTeamsAndImplicitConsent =
+        def
+          { galleyCfg = setField "settings.featureFlags.legalhold" "whitelist-teams-and-implicit-consent"
+          }
+      cfgLhDisabledByDefault =
+        def
+          { galleyCfg = setField "settings.featureFlags.legalhold" "disabled-by-default"
+          }
+  resourcePool <- asks (.resourcePool)
+  runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do
+    let domain = testBackend.berDomain
+
+    -- Happy case: DB has no config for the team
+    (owner, tid) <- runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do
+      (owner, tid, _) <- createTeam domain 1
+      checkFeature "legalhold" owner tid disabled
+      Internal.legalholdWhitelistTeam tid owner >>= assertSuccess
+      checkFeature "legalhold" owner tid enabled
+
+      -- Disabling it doesn't work
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 403
+      checkFeature "legalhold" owner tid enabled
+      pure (owner, tid)
+
+    -- Interesting case: The team had LH disabled before backend config was
+    -- changed to "whitelist-teams-and-implicit-consent". It should still show
+    -- enabled when the config gets changed.
+    runCodensity (startDynamicBackend testBackend cfgLhDisabledByDefault) $ \_ -> do
+      checkFeature "legalhold" owner tid disabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "legalhold" "disabled" 200
+      checkFeature "legalhold" owner tid disabled
+
+    runCodensity (startDynamicBackend testBackend cfgLhWhitelistTeamsAndImplicitConsent) $ \_ -> do
+      checkFeature "legalhold" owner tid enabled
+
+testExposeInvitationURLsToTeamAdminConfig :: HasCallStack => App ()
+testExposeInvitationURLsToTeamAdminConfig = do
+  let cfgExposeInvitationURLsTeamAllowlist tids =
+        def
+          { galleyCfg = setField "settings.exposeInvitationURLsTeamAllowlist" tids
+          }
+  resourcePool <- asks (.resourcePool)
+  runCodensity (acquireResources 1 resourcePool) $ \[testBackend] -> do
+    let domain = testBackend.berDomain
+
+    -- Happy case: DB has no config for the team
+    let testNoAllowlistEntry = runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist ([] :: [String])) $ \_ -> do
+          (owner, tid, _) <- createTeam domain 1
+          checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabledLocked
+          -- here we get a response with HTTP status 200 and feature status unchanged (disabled), which we find weird, but we're just testing the current behavior
+          Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200
+          Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200
+          pure (owner, tid)
+
+    (owner, tid) <- testNoAllowlistEntry
+
+    -- Interesting case: The team is in the allow list
+    runCodensity (startDynamicBackend testBackend $ cfgExposeInvitationURLsTeamAllowlist [tid]) $ \_ -> do
+      checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200
+      checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200
+      checkFeature "exposeInvitationURLsToTeamAdmin" owner tid disabled
+      Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "enabled" 200
+      checkFeature "exposeInvitationURLsToTeamAdmin" owner tid enabled
+
+    -- Interesting case: The team had the feature enabled but is not in allow list
+    void testNoAllowlistEntry
+
+checkFeature :: (HasCallStack, MakesValue user, MakesValue tid) => String -> user -> tid -> Value -> App ()
+checkFeature feature user tid expected = do
+  tidStr <- asString tid
+  domain <- objDomain user
+  bindResponse (Internal.getTeamFeature domain tidStr feature) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json `shouldMatch` expected
+  bindResponse (Public.getFeatureConfigs user) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. feature `shouldMatch` expected
+  bindResponse (Public.getTeamFeatures user tid) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. feature `shouldMatch` expected
+  bindResponse (Public.getTeamFeature user tid feature) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json `shouldMatch` expected

integration/test/Test/User.hs

@@ -63,11 +63,11 @@ testUpdateHandle = do
   mem1id <- asString $ mem1 %. "id"
 
   let featureName = "mlsE2EId"
-  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+  bindResponse (getTeamFeature owner team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "disabled"
   setTeamFeatureStatus owner team featureName "enabled"
-  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+  bindResponse (getTeamFeature owner team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "enabled"
 
@@ -126,11 +126,11 @@ testUpdateSelf (MkTagged mode) = do
   (owner, team, [mem1]) <- createTeam OwnDomain 2
 
   let featureName = "mlsE2EId"
-  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+  bindResponse (getTeamFeature owner team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "disabled"
   setTeamFeatureStatus owner team featureName "enabled"
-  bindResponse (getTeamFeature owner featureName team) $ \resp -> do
+  bindResponse (getTeamFeature owner team featureName) $ \resp -> do
     resp.status `shouldMatchInt` 200
     resp.json %. "status" `shouldMatch` "enabled"
 

services/galley/src/Galley/API/Teams/Features/Get.hs

@@ -439,6 +439,7 @@ instance GetFeatureConfig ExposeInvitationURLsToTeamAdminConfig where
       computeConfigForTeam teamAllowed teamDbStatus =
         if teamAllowed
           then makeConfig LockStatusUnlocked teamDbStatus
+          -- FUTUREWORK: use default feature status instead
           else makeConfig LockStatusLocked FeatureStatusDisabled
 
       makeConfig :: LockStatus -> FeatureStatus -> WithStatus ExposeInvitationURLsToTeamAdminConfig