Optimize IO time for getting all feature configs (#4002)

Co-authored-by: Leif Battermann <[email protected]> Co-authored-by: Matthias Fischmann <[email protected]>
wireapp · Apr 19, 2024 · 92be9fc · 92be9fc
1 parent 9fff6f9
commit 92be9fc
Show file tree

Hide file tree

Showing 20 changed files with 758 additions and 425 deletions.
diff --git a/changelog.d/3-bug-fixes/wpb8713-get-feature-configs-end-point-performance b/changelog.d/3-bug-fixes/wpb8713-get-feature-configs-end-point-performance
@@ -0,0 +1 @@
+ Optimize getting all feature configs
diff --git a/integration/test/API/GalleyInternal.hs b/integration/test/API/GalleyInternal.hs
@@ -45,7 +45,7 @@ setTeamFeatureStatusExpectHttpStatus :: (HasCallStack, MakesValue domain, MakesV
 setTeamFeatureStatusExpectHttpStatus domain team featureName status httpStatus = do
   tid <- asString team
   req <- baseRequest domain Galley Unversioned $ joinHttpPath ["i", "teams", tid, "features", featureName]
-  bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res ->
+  bindResponse (submit "PATCH" $ req & addJSONObject ["status" .= status]) $ \res -> do
     res.status `shouldMatchInt` httpStatus
 
 setTeamFeatureLockStatus :: (HasCallStack, MakesValue domain, MakesValue team) => domain -> team -> String -> String -> App ()

diff --git a/integration/test/Test/FeatureFlags.hs b/integration/test/Test/FeatureFlags.hs
@@ -141,7 +141,6 @@ testExposeInvitationURLsToTeamAdminConfig = do
   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
@@ -150,6 +149,7 @@ testExposeInvitationURLsToTeamAdminConfig = do
           Internal.setTeamFeatureStatusExpectHttpStatus domain tid "exposeInvitationURLsToTeamAdmin" "disabled" 200
           pure (owner, tid)
 
+    -- Happy case: DB has no config for the team
     (owner, tid) <- testNoAllowlistEntry
 
     -- Interesting case: The team is in the allow list
@@ -172,12 +172,12 @@ checkFeature feature user tid expected = do
   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
+  bindResponse (Public.getFeatureConfigs user) $ \resp -> do
+    resp.status `shouldMatchInt` 200
+    resp.json %. feature `shouldMatch` expected
diff --git a/libs/wire-api/test/unit/Test/Wire/API/Run.hs b/libs/wire-api/test/unit/Test/Wire/API/Run.hs
@@ -37,6 +37,7 @@ import Test.Wire.API.Routes.Version qualified as Routes.Version
 import Test.Wire.API.Routes.Version.Wai qualified as Routes.Version.Wai
 import Test.Wire.API.Swagger qualified as Swagger
 import Test.Wire.API.Team.Export qualified as Team.Export
+import Test.Wire.API.Team.Feature qualified as Team.Feature
 import Test.Wire.API.Team.Member qualified as Team.Member
 import Test.Wire.API.User qualified as User
 import Test.Wire.API.User.Auth qualified as User.Auth
@@ -69,5 +70,6 @@ main =
         unsafePerformIO Routes.Version.Wai.tests,
         RawJson.tests,
         OAuth.tests,
-        Password.tests
+        Password.tests,
+        Team.Feature.tests
       ]
diff --git a/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs b/libs/wire-api/test/unit/Test/Wire/API/Team/Feature.hs
@@ -0,0 +1,92 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2024 Wire Swiss GmbH <[email protected]>
+--
+-- 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 <https://www.gnu.org/licenses/>.
+
+module Test.Wire.API.Team.Feature (tests) where
+
+import Imports
+import Test.Tasty
+import Test.Tasty.HUnit
+import Wire.API.Team.Feature
+
+tests :: TestTree
+tests =
+  testGroup
+    "Wire.API.Team.Feature"
+    [ testCase "no lock status in DB" testComputeFeatureConfigForTeamUserLsIsNothing,
+      testCase "feature is locked in DB" testComputeFeatureConfigForTeamUserLocked,
+      testCase "feature is unlocked in DB but has no feature status" testComputeFeatureConfigForTeamUserUnlocked,
+      testCase "feature is unlocked in DB and has feature status" testComputeFeatureConfigForTeamWithDbStatus
+    ]
+
+testComputeFeatureConfigForTeamUserLsIsNothing :: Assertion
+testComputeFeatureConfigForTeamUserLsIsNothing = do
+  let mStatusDb = undefined
+  let mLockStatusDb = Nothing
+  let defStatus =
+        withStatus
+          FeatureStatusEnabled
+          LockStatusLocked
+          ExposeInvitationURLsToTeamAdminConfig
+          FeatureTTLUnlimited
+  let expected = defStatus
+  let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus
+  actual @?= expected
+
+testComputeFeatureConfigForTeamUserLocked :: Assertion
+testComputeFeatureConfigForTeamUserLocked = do
+  let mStatusDb = undefined
+  let mLockStatusDb = Just LockStatusLocked
+  let defStatus =
+        withStatus
+          FeatureStatusEnabled
+          LockStatusLocked
+          ExposeInvitationURLsToTeamAdminConfig
+          FeatureTTLUnlimited
+  let expected = defStatus
+  let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus
+  actual @?= expected
+
+testComputeFeatureConfigForTeamUserUnlocked :: Assertion
+testComputeFeatureConfigForTeamUserUnlocked = do
+  let mStatusDb = Nothing
+  let mLockStatusDb = Just LockStatusUnlocked
+  let defStatus =
+        withStatus
+          FeatureStatusEnabled
+          LockStatusLocked
+          ExposeInvitationURLsToTeamAdminConfig
+          FeatureTTLUnlimited
+  let expected = defStatus & setLockStatus LockStatusUnlocked
+  let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus
+  actual @?= expected
+
+testComputeFeatureConfigForTeamWithDbStatus :: Assertion
+testComputeFeatureConfigForTeamWithDbStatus = do
+  let mStatusDb =
+        Just . forgetLock $
+          withStatus
+            FeatureStatusDisabled
+            LockStatusUnlocked
+            ExposeInvitationURLsToTeamAdminConfig
+            FeatureTTLUnlimited
+  let mLockStatusDb = Just LockStatusUnlocked
+  let defStatus = undefined
+  let (Just expected) = withUnlocked <$> mStatusDb
+  let actual = computeFeatureConfigForTeamUser @ExposeInvitationURLsToTeamAdminConfig mStatusDb mLockStatusDb defStatus
+  actual @?= expected
diff --git a/libs/wire-api/wire-api.cabal b/libs/wire-api/wire-api.cabal
@@ -653,6 +653,7 @@ test-suite wire-api-tests
     Test.Wire.API.Run
     Test.Wire.API.Swagger
     Test.Wire.API.Team.Export
+    Test.Wire.API.Team.Feature
     Test.Wire.API.Team.Member
     Test.Wire.API.User
     Test.Wire.API.User.Auth

diff --git a/services/galley/default.nix b/services/galley/default.nix
@@ -27,6 +27,7 @@
 , conduit
 , containers
 , cookie
+, cql
 , crypton
 , crypton-x509
 , currency-codes
@@ -153,6 +154,7 @@ mkDerivation {
     cereal
     comonad
     containers
+    cql
     crypton
     crypton-x509
     currency-codes

diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal
@@ -138,6 +138,7 @@ library
     Galley.Cassandra.Conversation.MLS
     Galley.Cassandra.ConversationList
     Galley.Cassandra.CustomBackend
+    Galley.Cassandra.GetAllTeamFeatureConfigs
     Galley.Cassandra.Instances
     Galley.Cassandra.LegalHold
     Galley.Cassandra.Proposal
@@ -302,6 +303,7 @@ library
     , cereal                 >=0.4
     , comonad
     , containers             >=0.5
+    , cql
     , crypton
     , crypton-x509
     , currency-codes         >=2.0

diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
@@ -52,6 +52,7 @@ import Galley.API.Teams.Features
 import Galley.API.Update qualified as Update
 import Galley.API.Util
 import Galley.App
+import Galley.Cassandra.TeamFeatures (getAllFeatureConfigsForServer)
 import Galley.Data.Conversation qualified as Data
 import Galley.Effects
 import Galley.Effects.BackendNotificationQueueAccess

diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs
@@ -22,7 +22,6 @@ module Galley.API.Teams.Features
     setFeatureStatusInternal,
     patchFeatureStatusInternal,
     getFeatureStatusForUser,
-    getAllFeatureConfigsForServer,
     getAllFeatureConfigsForTeam,
     getAllFeatureConfigsForUser,
     updateLockStatus,

diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs
@@ -193,15 +193,13 @@ getAllFeatureConfigsForUser zusr = do
     maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership
   case mbTeam of
     Just tid ->
-      getAllFeatureConfigsTeam tid
+      TeamFeatures.getAllFeatureConfigs tid
     Nothing ->
       getAllFeatureConfigsUser zusr
 
 getAllFeatureConfigsForTeam ::
   forall r.
   ( Member (ErrorS 'NotATeamMember) r,
-    Member (Input Opts) r,
-    Member LegalHoldStore r,
     Member TeamFeatureStore r,
     Member TeamStore r
   ) =>
@@ -211,7 +209,7 @@ getAllFeatureConfigsForTeam ::
 getAllFeatureConfigsForTeam luid tid = do
   zusrMembership <- getTeamMember tid (tUnqualified luid)
   maybe (throwS @'NotATeamMember) (const $ pure ()) zusrMembership
-  getAllFeatureConfigsTeam tid
+  TeamFeatures.getAllFeatureConfigs tid
 
 getAllFeatureConfigsForServer ::
   forall r.
@@ -276,38 +274,6 @@ getAllFeatureConfigsUser uid =
     <*> getConfigForUser @EnforceFileDownloadLocationConfig uid
     <*> getConfigForUser @LimitedEventFanoutConfig uid
 
-getAllFeatureConfigsTeam ::
-  forall r.
-  ( Member (Input Opts) r,
-    Member LegalHoldStore r,
-    Member TeamFeatureStore r,
-    Member TeamStore r
-  ) =>
-  TeamId ->
-  Sem r AllFeatureConfigs
-getAllFeatureConfigsTeam tid =
-  AllFeatureConfigs
-    <$> getConfigForTeam @LegalholdConfig tid
-    <*> getConfigForTeam @SSOConfig tid
-    <*> getConfigForTeam @SearchVisibilityAvailableConfig tid
-    <*> getConfigForTeam @SearchVisibilityInboundConfig tid
-    <*> getConfigForTeam @ValidateSAMLEmailsConfig tid
-    <*> getConfigForTeam @DigitalSignaturesConfig tid
-    <*> getConfigForTeam @AppLockConfig tid
-    <*> getConfigForTeam @FileSharingConfig tid
-    <*> getConfigForTeam @ClassifiedDomainsConfig tid
-    <*> getConfigForTeam @ConferenceCallingConfig tid
-    <*> getConfigForTeam @SelfDeletingMessagesConfig tid
-    <*> getConfigForTeam @GuestLinksConfig tid
-    <*> getConfigForTeam @SndFactorPasswordChallengeConfig tid
-    <*> getConfigForTeam @MLSConfig tid
-    <*> getConfigForTeam @ExposeInvitationURLsToTeamAdminConfig tid
-    <*> getConfigForTeam @OutlookCalIntegrationConfig tid
-    <*> getConfigForTeam @MlsE2EIdConfig tid
-    <*> getConfigForTeam @MlsMigrationConfig tid
-    <*> getConfigForTeam @EnforceFileDownloadLocationConfig tid
-    <*> getConfigForTeam @LimitedEventFanoutConfig tid
-
 -- | Note: this is an internal function which doesn't cover all features, e.g. LegalholdConfig
 genericGetConfigForTeam ::
   forall cfg r.

diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs
@@ -49,6 +49,7 @@ import Cassandra hiding (Set)
 import Cassandra.Util (initCassandraForService)
 import Control.Error hiding (err)
 import Control.Lens hiding ((.=))
+import Data.Id
 import Data.Metrics.Middleware
 import Data.Misc
 import Data.Qualified
@@ -83,6 +84,7 @@ import Galley.Options hiding (brig, endpoint, federator)
 import Galley.Options qualified as O
 import Galley.Queue
 import Galley.Queue qualified as Q
+import Galley.Types.Teams (FeatureLegalHold)
 import Galley.Types.Teams qualified as Teams
 import HTTP2.Client.Manager (Http2Manager, http2ManagerWithSSLCtx)
 import Imports hiding (forkIO)
@@ -259,6 +261,8 @@ evalGalley e =
     . interpretWaiRoutes
     . runInputConst (e ^. options)
     . runInputConst (toLocalUnsafe (e ^. options . settings . federationDomain) ())
+    . interpretTeamFeatureSpecialContext e
+    . runInputSem getAllFeatureConfigsForServer
     . interpretInternalTeamListToCassandra
     . interpretTeamListToCassandra
     . interpretLegacyConversationListToCassandra
@@ -268,11 +272,11 @@ evalGalley e =
     . interpretTeamMemberStoreToCassandra lh
     . interpretTeamStoreToCassandra lh
     . interpretTeamNotificationStoreToCassandra
-    . interpretTeamFeatureStoreToCassandra
     . interpretServiceStoreToCassandra
     . interpretSearchVisibilityStoreToCassandra
     . interpretMemberStoreToCassandra
     . interpretLegalHoldStoreToCassandra lh
+    . interpretTeamFeatureStoreToCassandra
     . interpretCustomBackendStoreToCassandra
     . randomToIO
     . interpretSubConversationStoreToCassandra
@@ -292,3 +296,10 @@ evalGalley e =
     . interpretBrigAccess
   where
     lh = view (options . settings . featureFlags . Teams.flagLegalHold) e
+
+interpretTeamFeatureSpecialContext :: Env -> Sem (Input (Maybe [TeamId], FeatureLegalHold) ': r) a -> Sem r a
+interpretTeamFeatureSpecialContext e =
+  runInputConst
+    ( e ^. options . settings . exposeInvitationURLsTeamAllowlist,
+      e ^. options . settings . featureFlags . Teams.flagLegalHold
+    )