From f22d8e002d18f476bde486801e5b32a99915b294 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 23 Sep 2025 15:24:26 +0200 Subject: [PATCH 01/26] Start somewhere... --- integration/default.nix | 2 + integration/integration.cabal | 2 + .../test/Test/NotificationsBenchmark.hs | 70 +++++++++++++++++++ 3 files changed, 74 insertions(+) create mode 100644 integration/test/Test/NotificationsBenchmark.hs diff --git a/integration/default.nix b/integration/default.nix index 04163fc507..03512c4bc5 100644 --- a/integration/default.nix +++ b/integration/default.nix @@ -74,6 +74,7 @@ , split , stm , streaming-commons +, streamly , string-conversions , system-linux-proc , tagged @@ -179,6 +180,7 @@ mkDerivation { split stm streaming-commons + streamly string-conversions system-linux-proc tagged diff --git a/integration/integration.cabal b/integration/integration.cabal index 0cdf6972ef..70386331cf 100644 --- a/integration/integration.cabal +++ b/integration/integration.cabal @@ -184,6 +184,7 @@ library Test.MLS.Unreachable Test.NginxZAuthModule Test.Notifications + Test.NotificationsBenchmark Test.OAuth Test.PasswordReset Test.Presence @@ -299,6 +300,7 @@ library , split , stm , streaming-commons + , streamly , string-conversions , system-linux-proc , tagged diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs new file mode 100644 index 0000000000..ea7a470f04 --- /dev/null +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -0,0 +1,70 @@ +module Test.NotificationsBenchmark where + +import API.Brig +import API.BrigCommon +import API.Common +import API.GundeckInternal +import qualified Data.Map as Map +import GHC.Conc (numCapabilities) +import GHC.Stack +import SetupHelpers +import qualified Streamly.Data.Fold.Prelude as Fold +import qualified Streamly.Data.Stream.Prelude as Stream +import System.Random +import Testlib.Prekeys +import Testlib.Prelude + +data TestRecipient = TestRecipient + { user :: Value, + clientIds :: [String] + } + deriving (Show) + +testBench :: (HasCallStack) => App () +testBench = do + -- Preparation + let parCfg = Stream.maxThreads (numCapabilities * 2) . Stream.ordered False + toMap = Fold.foldl' (\kv (k, v) -> Map.insert k v kv) Map.empty + -- Later, we only read from this map. Thus, it doesn't have to be thread-safe. + userMap :: Map Word TestRecipient <- Stream.fromList [0 :: Word .. 1000] & Stream.parMapM parCfg (\i -> generateTestRecipient >>= \r -> pure (i, r)) & Stream.fold toMap + + -- To be replaced with real data from the file. (See + -- https://wearezeta.atlassian.net/wiki/spaces/PET/pages/2118680620/Simulating+production-like+data) + let fakeData = zip [0 :: Word ..] (cycle [0 .. 1000]) + + -- TODO: Use the timestamp a calculate a delay + Stream.fromList fakeData & Stream.parMapM parCfg (\(t, uNo) -> sendAndReceive uNo userMap) & Stream.fold Fold.drain + +sendAndReceive :: Int -> Map Word TestRecipient -> App () +sendAndReceive userNo userMap = do + print $ "pushing to user" ++ show userNo + let alice = (.user) $ userMap Map.! (fromIntegral userNo) + r <- recipient alice + let push = + object + [ "recipients" .= [r], + "payload" .= [object ["foo" .= "bar"]] + ] + + void $ postPush alice [push] >>= getBody 200 + +-- void $ withWebSocket alice $ \ws -> do +-- awaitMatch (\e -> printJSON e >> pure True) ws + +generateTestRecipient :: (HasCallStack) => App TestRecipient +generateTestRecipient = do + user <- randomUser OwnDomain def + r <- randomRIO @Word (0, 8) + clientIds <- forM [0 .. r] $ \_ -> do + client <- + addClient + user + def + { acapabilities = Just ["consumable-notifications"], + prekeys = Just $ take 10 somePrekeysRendered, + lastPrekey = Just $ head someLastPrekeysRendered + } + >>= getJSON 201 + objId client + + pure $ TestRecipient user clientIds From a012ce8ca7e2fa5da435c2bb8205eb9fcc9da2da Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 23 Sep 2025 17:08:45 +0200 Subject: [PATCH 02/26] Do not send events from the simulated future --- .../test/Test/NotificationsBenchmark.hs | 27 ++++++++++++++++--- 1 file changed, 24 insertions(+), 3 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index ea7a470f04..82c4fdb615 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -4,7 +4,9 @@ import API.Brig import API.BrigCommon import API.Common import API.GundeckInternal +import Control.Concurrent import qualified Data.Map as Map +import Data.Time import GHC.Conc (numCapabilities) import GHC.Stack import SetupHelpers @@ -28,12 +30,31 @@ testBench = do -- Later, we only read from this map. Thus, it doesn't have to be thread-safe. userMap :: Map Word TestRecipient <- Stream.fromList [0 :: Word .. 1000] & Stream.parMapM parCfg (\i -> generateTestRecipient >>= \r -> pure (i, r)) & Stream.fold toMap + now <- liftIO getCurrentTime + -- To be replaced with real data from the file. (See -- https://wearezeta.atlassian.net/wiki/spaces/PET/pages/2118680620/Simulating+production-like+data) - let fakeData = zip [0 :: Word ..] (cycle [0 .. 1000]) + let fakeData = zip (plusDelta now <$> [0 :: Word ..]) (cycle [0 .. 1000]) + + Stream.fromList fakeData & Stream.parMapM parCfg (\(t, uNo) -> waitForTimeStamp t >> sendAndReceive uNo userMap) & Stream.fold Fold.drain + +-- TODO: Add a speed factor to the simulation as we want to simulate faster than real time +waitForTimeStamp :: UTCTime -> App () +waitForTimeStamp timestamp = liftIO $ do + now <- getCurrentTime + print $ "(timestamp, now)" ++ show (timestamp, now) + when (now < timestamp) + $ + -- Event comes from the simulated future: Wait here until now and timestamp are aligned. + let delta = diffTimeToMicroSeconds $ diffUTCTime timestamp now + in print ("Waiting " ++ show delta ++ " microseconds. (timestamp, now)" ++ show (timestamp, now)) + >> threadDelay delta + where + diffTimeToMicroSeconds :: NominalDiffTime -> Int + diffTimeToMicroSeconds dt = floor @Double (realToFrac dt * 1_000_000) - -- TODO: Use the timestamp a calculate a delay - Stream.fromList fakeData & Stream.parMapM parCfg (\(t, uNo) -> sendAndReceive uNo userMap) & Stream.fold Fold.drain +plusDelta :: UTCTime -> Word -> UTCTime +plusDelta timestamp deltaMilliSeconds = addUTCTime (fromIntegral deltaMilliSeconds / 1000) timestamp sendAndReceive :: Int -> Map Word TestRecipient -> App () sendAndReceive userNo userMap = do From e41001b5de4e5dda323eef2180d341d82cddc001 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 23 Sep 2025 19:09:53 +0200 Subject: [PATCH 03/26] Receive the posted events --- .../test/Test/NotificationsBenchmark.hs | 20 +++++++++++++++---- integration/test/Testlib/Cannon.hs | 2 ++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 82c4fdb615..549a298eac 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -5,7 +5,9 @@ import API.BrigCommon import API.Common import API.GundeckInternal import Control.Concurrent -import qualified Data.Map as Map +import Control.Monad.Codensity (Codensity (..)) +import Control.Monad.Reader.Class (local) +import qualified Data.Map.Strict as Map import Data.Time import GHC.Conc (numCapabilities) import GHC.Stack @@ -13,6 +15,7 @@ import SetupHelpers import qualified Streamly.Data.Fold.Prelude as Fold import qualified Streamly.Data.Stream.Prelude as Stream import System.Random +import qualified Test.Events as TestEvents import Testlib.Prekeys import Testlib.Prelude @@ -59,7 +62,8 @@ plusDelta timestamp deltaMilliSeconds = addUTCTime (fromIntegral deltaMilliSecon sendAndReceive :: Int -> Map Word TestRecipient -> App () sendAndReceive userNo userMap = do print $ "pushing to user" ++ show userNo - let alice = (.user) $ userMap Map.! (fromIntegral userNo) + let testRecipient = userMap Map.! (fromIntegral userNo) + alice = testRecipient.user r <- recipient alice let push = object @@ -69,8 +73,16 @@ sendAndReceive userNo userMap = do void $ postPush alice [push] >>= getBody 200 --- void $ withWebSocket alice $ \ws -> do --- awaitMatch (\e -> printJSON e >> pure True) ws + forM_ (testRecipient.clientIds) $ \(cid :: String) -> + runCodensity (TestEvents.createEventsWebSocket alice (Just cid)) $ \ws -> do + -- TODO: Tweak this value to the least acceptable event delivery duration + local (setTimeoutTo 120) $ TestEvents.assertFindsEvent ws $ \e -> do + print "Event received" + printJSON e + e %. "payload" `shouldMatch` [object ["foo" .= "bar"]] + +setTimeoutTo :: Int -> Env -> Env +setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} generateTestRecipient :: (HasCallStack) => App TestRecipient generateTestRecipient = do diff --git a/integration/test/Testlib/Cannon.hs b/integration/test/Testlib/Cannon.hs index 45093c3e25..9a4aad779b 100644 --- a/integration/test/Testlib/Cannon.hs +++ b/integration/test/Testlib/Cannon.hs @@ -39,6 +39,8 @@ module Testlib.Cannon printAwaitAtLeastResult, waitForResponse, assertNoEvent, + -- This should never be merged! + connect, ) where From 2e347f38465826d33fcd46a1d7f3052ab4fbc4b9 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 07:43:54 +0200 Subject: [PATCH 04/26] Introduce sharding --- .../test/Test/NotificationsBenchmark.hs | 22 +++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 549a298eac..e73ef0faf4 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -9,6 +9,7 @@ import Control.Monad.Codensity (Codensity (..)) import Control.Monad.Reader.Class (local) import qualified Data.Map.Strict as Map import Data.Time +import Debug.Trace import GHC.Conc (numCapabilities) import GHC.Stack import SetupHelpers @@ -27,19 +28,31 @@ data TestRecipient = TestRecipient testBench :: (HasCallStack) => App () testBench = do + -- TODO: Take this from config + let shardingGroupCount = 2 :: Word + shardingGroup = 0 :: Word + maxUserNo = 1000 + -- Preparation let parCfg = Stream.maxThreads (numCapabilities * 2) . Stream.ordered False toMap = Fold.foldl' (\kv (k, v) -> Map.insert k v kv) Map.empty -- Later, we only read from this map. Thus, it doesn't have to be thread-safe. - userMap :: Map Word TestRecipient <- Stream.fromList [0 :: Word .. 1000] & Stream.parMapM parCfg (\i -> generateTestRecipient >>= \r -> pure (i, r)) & Stream.fold toMap + userMap :: Map Word TestRecipient <- + Stream.fromList [0 :: Word .. maxUserNo] + & Stream.filter (\uNo -> trace (show (uNo, shardingGroup, uNo `mod` shardingGroupCount, (uNo `mod` shardingGroupCount) == shardingGroup)) (uNo `mod` shardingGroupCount) == shardingGroup) + & Stream.parMapM parCfg (\i -> generateTestRecipient >>= \r -> pure (i, r)) + & Stream.fold toMap now <- liftIO getCurrentTime - -- To be replaced with real data from the file. (See + -- TODO: To be replaced with real data from the file. (See -- https://wearezeta.atlassian.net/wiki/spaces/PET/pages/2118680620/Simulating+production-like+data) let fakeData = zip (plusDelta now <$> [0 :: Word ..]) (cycle [0 .. 1000]) - Stream.fromList fakeData & Stream.parMapM parCfg (\(t, uNo) -> waitForTimeStamp t >> sendAndReceive uNo userMap) & Stream.fold Fold.drain + Stream.fromList fakeData + & Stream.filter (\(_t, uNo) -> (uNo `mod` shardingGroupCount) == shardingGroup) + & Stream.parMapM parCfg (\(t, uNo) -> waitForTimeStamp t >> sendAndReceive uNo userMap) + & Stream.fold Fold.drain -- TODO: Add a speed factor to the simulation as we want to simulate faster than real time waitForTimeStamp :: UTCTime -> App () @@ -59,7 +72,7 @@ waitForTimeStamp timestamp = liftIO $ do plusDelta :: UTCTime -> Word -> UTCTime plusDelta timestamp deltaMilliSeconds = addUTCTime (fromIntegral deltaMilliSeconds / 1000) timestamp -sendAndReceive :: Int -> Map Word TestRecipient -> App () +sendAndReceive :: Word -> Map Word TestRecipient -> App () sendAndReceive userNo userMap = do print $ "pushing to user" ++ show userNo let testRecipient = userMap Map.! (fromIntegral userNo) @@ -86,6 +99,7 @@ setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} generateTestRecipient :: (HasCallStack) => App TestRecipient generateTestRecipient = do + print "generateTestRecipient" user <- randomUser OwnDomain def r <- randomRIO @Word (0, 8) clientIds <- forM [0 .. r] $ \_ -> do From 43e6d8e964a5cca6e459398440e123fdbff6d46a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 07:58:36 +0200 Subject: [PATCH 05/26] Use random payloads of random length --- integration/test/Test/NotificationsBenchmark.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index e73ef0faf4..512e60f1fc 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -77,11 +77,13 @@ sendAndReceive userNo userMap = do print $ "pushing to user" ++ show userNo let testRecipient = userMap Map.! (fromIntegral userNo) alice = testRecipient.user + r <- recipient alice + payload :: Value <- toJSON <$> liftIO randomPayload let push = object [ "recipients" .= [r], - "payload" .= [object ["foo" .= "bar"]] + "payload" .= [object ["foo" .= payload]] ] void $ postPush alice [push] >>= getBody 200 @@ -92,7 +94,14 @@ sendAndReceive userNo userMap = do local (setTimeoutTo 120) $ TestEvents.assertFindsEvent ws $ \e -> do print "Event received" printJSON e - e %. "payload" `shouldMatch` [object ["foo" .= "bar"]] + e %. "payload" `shouldMatch` [object ["foo" .= payload]] + where + -- \| Generate a random string with random length up to 2048 bytes + randomPayload :: IO String + randomPayload = do + -- TODO: 1 to 2028 chars is a guess. We could adjust it to the real distribution. + len <- randomRIO @Int (1, 2048) -- random length between 1 and 2048 + mapM (\_ -> randomRIO ('\32', '\126')) [1 .. len] -- printable ASCII setTimeoutTo :: Int -> Env -> Env setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} From caf4f97ac2719df5fbe3a6a816bd1ecd772a41f5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 09:47:11 +0200 Subject: [PATCH 06/26] Make test parameters configurable --- .../test/Test/NotificationsBenchmark.hs | 8 ++++---- integration/test/Testlib/Env.hs | 10 ++++++++-- integration/test/Testlib/Types.hs | 18 +++++++++++++++--- services/integration.yaml | 4 ++++ 4 files changed, 31 insertions(+), 9 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 512e60f1fc..324bc5f1bd 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -6,6 +6,7 @@ import API.Common import API.GundeckInternal import Control.Concurrent import Control.Monad.Codensity (Codensity (..)) +import Control.Monad.Reader (asks) import Control.Monad.Reader.Class (local) import qualified Data.Map.Strict as Map import Data.Time @@ -28,10 +29,9 @@ data TestRecipient = TestRecipient testBench :: (HasCallStack) => App () testBench = do - -- TODO: Take this from config - let shardingGroupCount = 2 :: Word - shardingGroup = 0 :: Word - maxUserNo = 1000 + shardingGroupCount <- asks (.shardingGroupCount) + shardingGroup <- asks (.shardingGroup) + maxUserNo <- asks (.maxUserNo) -- Preparation let parCfg = Stream.maxThreads (numCapabilities * 2) . Stream.ordered False diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 67a90228ad..775e672070 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -145,7 +145,10 @@ mkGlobalEnv cfgFile = do gDNSMockServerConfig = intConfig.dnsMockServer, gCellsEventQueue = intConfig.cellsEventQueue, gCellsEventWatchersLock, - gCellsEventWatchers + gCellsEventWatchers, + gShardingGroupCount = intConfig.shardingGroupCount, + gShardingGroup = intConfig.shardingGroup, + gMaxUserNo = intConfig.maxUserNo } where createSSLContext :: Maybe FilePath -> IO (Maybe OpenSSL.SSLContext) @@ -201,7 +204,10 @@ mkEnv currentTestName ge = do dnsMockServerConfig = ge.gDNSMockServerConfig, cellsEventQueue = ge.gCellsEventQueue, cellsEventWatchersLock = ge.gCellsEventWatchersLock, - cellsEventWatchers = ge.gCellsEventWatchers + cellsEventWatchers = ge.gCellsEventWatchers, + shardingGroupCount = ge.gShardingGroupCount, + shardingGroup = ge.gShardingGroup, + maxUserNo = ge.gMaxUserNo } allCiphersuites :: [Ciphersuite] diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 29aa0b2b4b..7a8eabb241 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -144,7 +144,10 @@ data GlobalEnv = GlobalEnv gDNSMockServerConfig :: DNSMockServerConfig, gCellsEventQueue :: String, gCellsEventWatchersLock :: MVar (), - gCellsEventWatchers :: IORef (Map String QueueWatcher) + gCellsEventWatchers :: IORef (Map String QueueWatcher), + gShardingGroupCount :: Word, + gShardingGroup :: Word, + gMaxUserNo :: Word } data IntegrationConfig = IntegrationConfig @@ -160,7 +163,10 @@ data IntegrationConfig = IntegrationConfig rabbitmqV1 :: RabbitMqAdminOpts, cassandra :: CassandraConfig, dnsMockServer :: DNSMockServerConfig, - cellsEventQueue :: String + cellsEventQueue :: String, + shardingGroupCount :: Word, + shardingGroup :: Word, + maxUserNo :: Word } deriving (Show, Generic) @@ -181,6 +187,9 @@ instance FromJSON IntegrationConfig where <*> o .: fromString "cassandra" <*> o .: fromString "dnsMockServer" <*> o .: fromString "cellsEventQueue" + <*> o .: fromString "shardingGroupCount" + <*> o .: fromString "shardingGroup" + <*> o .: fromString "maxUserNo" data ServiceMap = ServiceMap { brig :: HostPort, @@ -271,7 +280,10 @@ data Env = Env dnsMockServerConfig :: DNSMockServerConfig, cellsEventQueue :: String, cellsEventWatchersLock :: MVar (), - cellsEventWatchers :: IORef (Map String QueueWatcher) + cellsEventWatchers :: IORef (Map String QueueWatcher), + shardingGroupCount :: Word, + shardingGroup :: Word, + maxUserNo :: Word } data Response = Response diff --git a/services/integration.yaml b/services/integration.yaml index 427aa761d1..f9affefc78 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -330,3 +330,7 @@ integrationTestHostName: "localhost" additionalElasticSearch: https://localhost:9201 cellsEventQueue: cells_events + +shardingGroupCount: 1 +shardingGroup: 0 +maxUserNo: 1000 From 4dcca7c58b55e13054560e30960a4b6309d5b2f5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 10:01:54 +0200 Subject: [PATCH 07/26] Add params to Helm chart --- charts/integration/templates/configmap.yaml | 3 +++ charts/integration/values.yaml | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 82fc989528..cf3fa8a2f7 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -310,3 +310,6 @@ data: integrationTestHostName: integration-headless.{{ .Release.Namespace }}.svc.cluster.local cellsEventQueue: cells_events + shardingGroupCount: {{ .Values.config.shardingGroupCount }} + shardingGroup: {{ .Values.config.shardingGroup }} + maxUserNo: {{ .Values.config.maxUserNo }} diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index 36305b2be7..1186952c85 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -119,7 +119,9 @@ config: sesEndpointUrl: http://fake-aws-ses:4569 s3EndpointUrl: http://fake-aws-s3:9000 rabbitmqPutVHostUrl: http://rabbitmq:15672/api/vhosts - + shardingGroupCount: 1 + shardingGroup: 0 + maxUserNo: 1000 tls: verify_depth: 1 # Namespace from which to obtain the secret containing the CA trusted by From 9cac3cfea3fdb353175d5e6988d07f53f644dbb8 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 10:02:32 +0200 Subject: [PATCH 08/26] Run only testBench test in K8s --- charts/integration/templates/integration-integration.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index f59475280e..76d5b6009f 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -188,7 +188,7 @@ spec: - | set -euo pipefail - if integration --config /etc/wire/integration/integration.yaml; then + if TEST_INCLUDE=testBench integration --config /etc/wire/integration/integration.yaml; then exit_code=$? else exit_code=$? From 5994bb46001c9003fe484a027fe4487e9c4d3a42 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Wed, 24 Sep 2025 16:24:16 +0200 Subject: [PATCH 09/26] Make the sharding group a cli parameter It will be different for every pod. --- charts/integration/templates/configmap.yaml | 1 - .../integration/templates/integration-integration.yaml | 2 +- integration/test/Testlib/Env.hs | 6 +++--- integration/test/Testlib/Options.hs | 10 +++++++++- integration/test/Testlib/Run.hs | 9 +++++---- integration/test/Testlib/RunServices.hs | 4 +++- integration/test/Testlib/Types.hs | 2 -- services/integration.yaml | 1 - 8 files changed, 21 insertions(+), 14 deletions(-) diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index cf3fa8a2f7..78ff39c815 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -311,5 +311,4 @@ data: integrationTestHostName: integration-headless.{{ .Release.Namespace }}.svc.cluster.local cellsEventQueue: cells_events shardingGroupCount: {{ .Values.config.shardingGroupCount }} - shardingGroup: {{ .Values.config.shardingGroup }} maxUserNo: {{ .Values.config.maxUserNo }} diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 76d5b6009f..8477b3c64b 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -188,7 +188,7 @@ spec: - | set -euo pipefail - if TEST_INCLUDE=testBench integration --config /etc/wire/integration/integration.yaml; then + if TEST_INCLUDE=testBench integration --config /etc/wire/integration/integration.yaml --sharding-group {{ .Values.config.shardingGroup }}; then exit_code=$? else exit_code=$? diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 775e672070..deebd3cde8 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -62,8 +62,8 @@ serviceHostPort m Stern = m.stern serviceHostPort m FederatorInternal = m.federatorInternal serviceHostPort m WireServerEnterprise = m.wireServerEnterprise -mkGlobalEnv :: FilePath -> Codensity IO GlobalEnv -mkGlobalEnv cfgFile = do +mkGlobalEnv :: FilePath -> Word -> Codensity IO GlobalEnv +mkGlobalEnv cfgFile shardingGroup = do eith <- liftIO $ Yaml.decodeFileEither cfgFile intConfig <- liftIO $ case eith of Left err -> do @@ -147,7 +147,7 @@ mkGlobalEnv cfgFile = do gCellsEventWatchersLock, gCellsEventWatchers, gShardingGroupCount = intConfig.shardingGroupCount, - gShardingGroup = intConfig.shardingGroup, + gShardingGroup = shardingGroup, gMaxUserNo = intConfig.maxUserNo } where diff --git a/integration/test/Testlib/Options.hs b/integration/test/Testlib/Options.hs index f109e13d8f..2b56256eeb 100644 --- a/integration/test/Testlib/Options.hs +++ b/integration/test/Testlib/Options.hs @@ -27,7 +27,8 @@ data TestOptions = TestOptions excludeTests :: [String], listTests :: Bool, xmlReport :: Maybe FilePath, - configFile :: String + configFile :: String, + shardingGroup :: Word } parser :: Parser TestOptions @@ -64,6 +65,13 @@ parser = <> help "Use configuration FILE" <> value "services/integration.yaml" ) + <*> option + auto + ( long "sharding-group" + <> short 's' + <> help "The sharding group of this instance" + <> value 0 + ) optInfo :: ParserInfo TestOptions optInfo = diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index 1ae1ddf06d..7447230f44 100644 --- a/integration/test/Testlib/Run.hs +++ b/integration/test/Testlib/Run.hs @@ -123,6 +123,7 @@ main = do opts <- getOptions let f = testFilter opts cfg = opts.configFile + shardingGroup = opts.shardingGroup allTests <- mkAllTests let tests = @@ -132,10 +133,10 @@ main = do let qualifiedName = fromMaybe module_ (stripPrefix "Test." module_) <> "." <> name in (qualifiedName, summary, full, action) - if opts.listTests then doListTests tests else runTests tests opts.xmlReport cfg + if opts.listTests then doListTests tests else runTests tests opts.xmlReport cfg shardingGroup -runTests :: [(String, x, y, App ())] -> Maybe FilePath -> FilePath -> IO () -runTests tests mXMLOutput cfg = do +runTests :: [(String, x, y, App ())] -> Maybe FilePath -> FilePath -> Word -> IO () +runTests tests mXMLOutput cfg shardingGroup = do output <- newChan let displayOutput = readChan output >>= \case @@ -180,7 +181,7 @@ runTests tests mXMLOutput cfg = do where mkEnvs :: FilePath -> Codensity IO (GlobalEnv, Env) mkEnvs fp = do - g <- mkGlobalEnv fp + g <- mkGlobalEnv fp shardingGroup e <- mkEnv Nothing g pure (g, e) diff --git a/integration/test/Testlib/RunServices.hs b/integration/test/Testlib/RunServices.hs index 4a9f6403d4..5fbcabc2e2 100644 --- a/integration/test/Testlib/RunServices.hs +++ b/integration/test/Testlib/RunServices.hs @@ -88,8 +88,10 @@ main = do let cp = proc "sh" (["-c", "exec \"$@\"", "--"] <> opts.runSubprocess) (_, _, _, ph) <- createProcess cp exitWith =<< waitForProcess ph + -- The shardingGroup only matters for the testBench test; probably not here. + shardingGroup = 0 - runCodensity (mkGlobalEnv cfg >>= mkEnv Nothing) $ \env -> + runCodensity (mkGlobalEnv cfg shardingGroup >>= mkEnv Nothing) $ \env -> runAppWithEnv env $ lowerCodensity $ do diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index 7a8eabb241..fca1e12423 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -165,7 +165,6 @@ data IntegrationConfig = IntegrationConfig dnsMockServer :: DNSMockServerConfig, cellsEventQueue :: String, shardingGroupCount :: Word, - shardingGroup :: Word, maxUserNo :: Word } deriving (Show, Generic) @@ -188,7 +187,6 @@ instance FromJSON IntegrationConfig where <*> o .: fromString "dnsMockServer" <*> o .: fromString "cellsEventQueue" <*> o .: fromString "shardingGroupCount" - <*> o .: fromString "shardingGroup" <*> o .: fromString "maxUserNo" data ServiceMap = ServiceMap diff --git a/services/integration.yaml b/services/integration.yaml index f9affefc78..8bfeaaa9ca 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -332,5 +332,4 @@ additionalElasticSearch: https://localhost:9201 cellsEventQueue: cells_events shardingGroupCount: 1 -shardingGroup: 0 maxUserNo: 1000 From b21d83a79d132723c4247f2d8954cb1c3a37e5e1 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Thu, 25 Sep 2025 18:27:28 +0200 Subject: [PATCH 10/26] Don't setup what we don't need --- integration/test/Testlib/Run.hs | 124 ++++++++++++++------------------ 1 file changed, 55 insertions(+), 69 deletions(-) diff --git a/integration/test/Testlib/Run.hs b/integration/test/Testlib/Run.hs index 7447230f44..43667a034a 100644 --- a/integration/test/Testlib/Run.hs +++ b/integration/test/Testlib/Run.hs @@ -22,35 +22,21 @@ import Control.Exception as E import Control.Monad import Control.Monad.Codensity import Control.Monad.IO.Class -import Control.Monad.Reader.Class (asks) -import Data.Default import Data.Foldable import Data.Function import Data.Functor import Data.List import Data.Maybe (fromMaybe) -import Data.String (IsString (fromString)) -import Data.String.Conversions (cs) -import Data.Text (Text) -import qualified Data.Text as T import Data.Time -import qualified Data.Yaml as Yaml -import Network.AMQP.Extended -import Network.RabbitMqAdmin import RunAllTests import System.Directory import System.Environment import System.Exit import System.FilePath -import System.IO.Temp (writeTempFile) -import System.Process import Testlib.Assertions import Testlib.Env -import Testlib.ModService (readAndUpdateConfig) import Testlib.Options import Testlib.Printing -import Testlib.ResourcePool (acquireResources) -import Testlib.RunServices (backendA, backendB) import Testlib.Types import Testlib.XML import Text.Printf @@ -144,12 +130,12 @@ runTests tests mXMLOutput cfg shardingGroup = do Nothing -> pure () let writeOutput = writeChan output . Just - runCodensity (mkEnvs cfg) $ \(genv, env) -> + runCodensity (mkEnvs cfg) $ \(genv, _env) -> withAsync displayOutput $ \displayThread -> do -- Although migrations are run on service start up we are running them here before -- to prevent race conditions between brig and galley -- which cause flakiness and can make the complete test suite fail - runAppWithEnv env runMigrations + -- runAppWithEnv env runMigrations -- Currently 4 seems to be stable, more seems to create more timeouts. report <- fmap mconcat $ pooledForConcurrentlyN 4 tests $ \(qname, _, _, action) -> do timestamp <- getCurrentTime @@ -173,7 +159,7 @@ runTests tests mXMLOutput cfg shardingGroup = do pure (TestSuiteReport [TestCaseReport qname TestSuccess tm]) writeChan output Nothing wait displayThread - deleteFederationV0AndV1Queues genv + -- deleteFederationV0AndV1Queues genv printReport report mapM_ (saveXMLReport report) mXMLOutput when (any (\testCase -> testCase.result /= TestSuccess) report.cases) $ @@ -185,58 +171,58 @@ runTests tests mXMLOutput cfg shardingGroup = do e <- mkEnv Nothing g pure (g, e) -runMigrations :: App () -runMigrations = do - cwdBase <- asks (.servicesCwdBase) - let brig = "brig" - let (cwd, exe) = case cwdBase of - Nothing -> (Nothing, brig) - Just dir -> - (Just (dir brig), "../../dist" brig) - getConfig <- readAndUpdateConfig def backendA Brig - config <- liftIO getConfig - tempFile <- liftIO $ writeTempFile "/tmp" "brig-migrations.yaml" (cs $ Yaml.encode config) - dynDomains <- asks (.dynamicDomains) - pool <- asks (.resourcePool) - lowerCodensity $ do - resources <- acquireResources (length dynDomains) pool - let dbnames = [backendA.berPostgresqlDBName, backendB.berPostgresqlDBName] <> map (.berPostgresqlDBName) resources - for_ dbnames $ runMigration exe tempFile cwd - liftIO $ putStrLn "Postgres migrations finished" - where - runMigration :: (MonadIO m) => FilePath -> FilePath -> Maybe FilePath -> String -> m () - runMigration exe tempFile cwd dbname = do - let cp = (proc exe ["-c", tempFile, "migrate-postgres", "--dbname", dbname]) {cwd} - (_, _, _, ph) <- liftIO $ createProcess cp - void $ liftIO $ waitForProcess ph - -deleteFederationV0AndV1Queues :: GlobalEnv -> IO () -deleteFederationV0AndV1Queues env = do - let testDomains = env.gDomain1 : env.gDomain2 : env.gDynamicDomains - putStrLn "Attempting to delete federation V0 queues..." - (mV0User, mV0Pass) <- readCredsFromEnvWithSuffix "V0" - fromMaybe (putStrLn "No or incomplete credentials for fed V0 RabbitMQ") $ - deleteFederationQueues testDomains env.gRabbitMQConfigV0 <$> mV0User <*> mV0Pass - - putStrLn "Attempting to delete federation V1 queues..." - (mV1User, mV1Pass) <- readCredsFromEnvWithSuffix "V1" - fromMaybe (putStrLn "No or incomplete credentials for fed V1 RabbitMQ") $ - deleteFederationQueues testDomains env.gRabbitMQConfigV1 <$> mV1User <*> mV1Pass - where - readCredsFromEnvWithSuffix :: String -> IO (Maybe Text, Maybe Text) - readCredsFromEnvWithSuffix suffix = - (,) - <$> (fmap fromString <$> lookupEnv ("RABBITMQ_USERNAME_" <> suffix)) - <*> (fmap fromString <$> lookupEnv ("RABBITMQ_PASSWORD_" <> suffix)) - -deleteFederationQueues :: [String] -> RabbitMqAdminOpts -> Text -> Text -> IO () -deleteFederationQueues testDomains opts username password = do - client <- mkRabbitMqAdminClientEnvWithCreds opts username password - for_ testDomains $ \domain -> do - page <- client.listQueuesByVHost opts.vHost (fromString $ "^backend-notifications\\." <> domain <> "$") True 100 1 - for_ page.items $ \queue -> do - putStrLn $ "Deleting queue " <> T.unpack queue.name - void $ deleteQueue client opts.vHost queue.name +-- runMigrations :: App () +-- runMigrations = do +-- cwdBase <- asks (.servicesCwdBase) +-- let brig = "brig" +-- let (cwd, exe) = case cwdBase of +-- Nothing -> (Nothing, brig) +-- Just dir -> +-- (Just (dir brig), "../../dist" brig) +-- getConfig <- readAndUpdateConfig def backendA Brig +-- config <- liftIO getConfig +-- tempFile <- liftIO $ writeTempFile "/tmp" "brig-migrations.yaml" (cs $ Yaml.encode config) +-- dynDomains <- asks (.dynamicDomains) +-- pool <- asks (.resourcePool) +-- lowerCodensity $ do +-- resources <- acquireResources (length dynDomains) pool +-- let dbnames = [backendA.berPostgresqlDBName, backendB.berPostgresqlDBName] <> map (.berPostgresqlDBName) resources +-- for_ dbnames $ runMigration exe tempFile cwd +-- liftIO $ putStrLn "Postgres migrations finished" +-- where +-- runMigration :: (MonadIO m) => FilePath -> FilePath -> Maybe FilePath -> String -> m () +-- runMigration exe tempFile cwd dbname = do +-- let cp = (proc exe ["-c", tempFile, "migrate-postgres", "--dbname", dbname]) {cwd} +-- (_, _, _, ph) <- liftIO $ createProcess cp +-- void $ liftIO $ waitForProcess ph + +-- deleteFederationV0AndV1Queues :: GlobalEnv -> IO () +-- deleteFederationV0AndV1Queues env = do +-- let testDomains = env.gDomain1 : env.gDomain2 : env.gDynamicDomains +-- putStrLn "Attempting to delete federation V0 queues..." +-- (mV0User, mV0Pass) <- readCredsFromEnvWithSuffix "V0" +-- fromMaybe (putStrLn "No or incomplete credentials for fed V0 RabbitMQ") $ +-- deleteFederationQueues testDomains env.gRabbitMQConfigV0 <$> mV0User <*> mV0Pass +-- +-- putStrLn "Attempting to delete federation V1 queues..." +-- (mV1User, mV1Pass) <- readCredsFromEnvWithSuffix "V1" +-- fromMaybe (putStrLn "No or incomplete credentials for fed V1 RabbitMQ") $ +-- deleteFederationQueues testDomains env.gRabbitMQConfigV1 <$> mV1User <*> mV1Pass +-- where +-- readCredsFromEnvWithSuffix :: String -> IO (Maybe Text, Maybe Text) +-- readCredsFromEnvWithSuffix suffix = +-- (,) +-- <$> (fmap fromString <$> lookupEnv ("RABBITMQ_USERNAME_" <> suffix)) +-- <*> (fmap fromString <$> lookupEnv ("RABBITMQ_PASSWORD_" <> suffix)) +-- +-- deleteFederationQueues :: [String] -> RabbitMqAdminOpts -> Text -> Text -> IO () +-- deleteFederationQueues testDomains opts username password = do +-- client <- mkRabbitMqAdminClientEnvWithCreds opts username password +-- for_ testDomains $ \domain -> do +-- page <- client.listQueuesByVHost opts.vHost (fromString $ "^backend-notifications\\." <> domain <> "$") True 100 1 +-- for_ page.items $ \queue -> do +-- putStrLn $ "Deleting queue " <> T.unpack queue.name +-- void $ deleteQueue client opts.vHost queue.name doListTests :: [(String, String, String, x)] -> IO () doListTests tests = for_ tests $ \(qname, _desc, _full, _) -> do From 988d880ba6fdaff3ffe91b762db2ed11c7ae8522 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Sep 2025 10:03:12 +0200 Subject: [PATCH 11/26] Improve error message --- integration/test/Testlib/Types.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index fca1e12423..f11e0c169e 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -456,7 +456,7 @@ hoistCodensity m = Codensity $ \k -> do getServiceMap :: (HasCallStack) => String -> App ServiceMap getServiceMap fedDomain = do env <- ask - assertJust ("Could not find service map for federation domain: " <> fedDomain) (Map.lookup fedDomain env.serviceMap) + assertJust ("Could not find service map for federation domain: " <> fedDomain <> " in " <> show (Map.keys env.serviceMap)) (Map.lookup fedDomain env.serviceMap) getMLSState :: App MLSState getMLSState = do From 9e6b1e6d83681870f72c72d491a8ff9b77695ad5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Sep 2025 18:22:09 +0200 Subject: [PATCH 12/26] Hack config for sven-test env --- charts/integration/templates/configmap.yaml | 7 +- .../templates/integration-integration.yaml | 101 +----------------- charts/integration/values.yaml | 2 +- 3 files changed, 6 insertions(+), 104 deletions(-) diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 78ff39c815..bea3d10c3c 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -77,14 +77,15 @@ data: apiPort: 5380 dohPort: 5381 - originDomain: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local + # originDomain: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local + originDomain: sven-test.wire.link rabbitmq: host: rabbitmq port: 5671 adminHost: rabbitmq - adminPort: 15671 - enableTls: true + adminPort: 15672 + enableTls: false insecureSkipVerifyTls: true vHost: / diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 8477b3c64b..8b90c3b66c 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -65,22 +65,6 @@ spec: configMap: name: "background-worker" - - name: "background-worker-secrets" - secret: - secretName: "background-worker" - - - name: "stern-config" - configMap: - name: "backoffice" - - - name: "proxy-config" - configMap: - name: "proxy" - - - name: "proxy-secrets" - secret: - secretName: "proxy" - - name: "nginz-config" configMap: name: "nginz" @@ -89,28 +73,12 @@ spec: secret: secretName: "nginz" - - name: elasticsearch-ca - secret: - secretName: {{ .Values.config.elasticsearch.tlsCaSecretRef.name }} - - - name: redis-ca - secret: - secretName: {{ .Values.config.redis.tlsCaSecretRef.name }} - - - name: rabbitmq-ca - secret: - secretName: {{ .Values.config.rabbitmq.tlsCaSecretRef.name }} - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: integration-cassandra secret: secretName: {{ include "cassandraTlsSecretName" .Values.config }} {{- end }} - - name: wire-server-enterprise-config - configMap: - name: wire-server-enterprise - restartPolicy: Never initContainers: @@ -121,14 +89,10 @@ spec: {{- toYaml .Values.podSecurityContext | nindent 6 }} {{- end }} volumeMounts: - - name: elasticsearch-ca - mountPath: "/certs/elasticsearch" {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs/cassandra" {{- end }} - - name: rabbitmq-ca - mountPath: /certs/rabbitmq-ca env: - name: INTEGRATION_DYNAMIC_BACKENDS_POOLSIZE value: "{{ .Values.config.dynamicBackendsPoolsize }}" @@ -153,20 +117,7 @@ spec: - -c - | set -euo pipefail - # FUTUREWORK: Do all of this in the integration test binary - integration-dynamic-backends-db-schemas.sh \ - --host {{ .Values.config.cassandra.host }} \ - --port {{ .Values.config.cassandra.port }} \ - --replication-factor {{ .Values.config.cassandra.replicationFactor }} \ - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - --tls-ca-certificate-file /certs/cassandra/{{- include "cassandraTlsSecretKey" .Values.config }} - {{ end }} - - integration-dynamic-backends-brig-index.sh \ - --elasticsearch-server https://elastic:changeme@{{ .Values.config.elasticsearch.host }}:9200 \ - --elasticsearch-ca-cert /certs/elasticsearch/{{ .Values.config.elasticsearch.tlsCaSecretRef.key }} - integration-dynamic-backends-ses.sh {{ .Values.config.sesEndpointUrl }} - integration-dynamic-backends-s3.sh {{ .Values.config.s3EndpointUrl }} + {{- range $name, $dynamicBackend := .Values.config.dynamicBackends }} integration-dynamic-backends-vhosts.sh {{ $.Values.config.rabbitmqPutVHostUrl }} {{ $dynamicBackend.federatorExternalHostPrefix}}.{{ $.Release.Namespace }}.svc.cluster.local {{- end }} @@ -255,45 +206,12 @@ spec: - name: background-worker-config mountPath: /etc/wire/background-worker/conf - - name: background-worker-secrets - mountPath: /etc/wire/background-worker/secrets - - - name: stern-config - mountPath: /etc/wire/stern/conf - - - name: proxy-config - mountPath: /etc/wire/proxy/conf - - - name: proxy-secrets - mountPath: /etc/wire/proxy/secrets - - name: nginz-config mountPath: /etc/wire/nginz/conf - name: nginz-secrets mountPath: /etc/wire/nginz/secrets - - name: elasticsearch-ca - mountPath: /etc/wire/brig/elasticsearch-ca - - - name: redis-ca - mountPath: /etc/wire/gundeck/redis-ca - - - name: rabbitmq-ca - mountPath: /etc/wire/brig/rabbitmq-ca - - - name: rabbitmq-ca - mountPath: /etc/wire/galley/rabbitmq-ca - - - name: rabbitmq-ca - mountPath: /etc/wire/background-worker/rabbitmq-ca - - - name: rabbitmq-ca - mountPath: /etc/wire/gundeck/rabbitmq-ca - - - name: rabbitmq-ca - mountPath: /etc/wire/cannon/rabbitmq-ca - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs" @@ -311,9 +229,6 @@ spec: mountPath: "/etc/wire/spar/cassandra" {{- end }} - - name: wire-server-enterprise-config - mountPath: /etc/wire/wire-server-enterprise/conf - env: # these dummy values are necessary for Amazonka's "Discover" - name: AWS_ACCESS_KEY_ID @@ -332,20 +247,6 @@ spec: secretKeyRef: name: brig key: rabbitmqPassword - - name: RABBITMQ_USERNAME_V0 - value: "wire-server" - - name: RABBITMQ_PASSWORD_V0 - valueFrom: - secretKeyRef: - name: rabbitmq-v0 - key: rabbitmq-password - - name: RABBITMQ_USERNAME_V1 - value: "wire-server" - - name: RABBITMQ_PASSWORD_V1 - valueFrom: - secretKeyRef: - name: rabbitmq-v1 - key: rabbitmq-password {{- if hasKey .Values.secrets "redisUsername" }} - name: REDIS_USERNAME valueFrom: diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index 1186952c85..fd975a4620 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -12,7 +12,7 @@ podSecurityContext: type: RuntimeDefault config: - dynamicBackendsPoolsize: 3 + dynamicBackendsPoolsize: 0 dynamicBackends: dynamic-backend-1: federatorExternalHostPrefix: dynamic-backend-1 From 40ff389d7c13962bac655750c634b81c61b4983c Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Fri, 26 Sep 2025 18:53:45 +0200 Subject: [PATCH 13/26] Only use released API versions Otherwise we conflict with server config. --- integration/test/Testlib/Env.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index deebd3cde8..19fe1848ec 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -188,7 +188,9 @@ mkEnv currentTestName ge = do -- those domains. apiVersionByDomain = Map.fromList - [ (gFederationV0Domain ge, 4), + [ (gDomain1 ge, 11), + (gDomain1 ge, 11), + (gFederationV0Domain ge, 4), (gFederationV1Domain ge, 5), (gFederationV2Domain ge, 8) ], From c3d9d70fd9a94090070da488c340f6500f823ac9 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:03:24 +0200 Subject: [PATCH 14/26] Remove log of sharding group assignment --- integration/test/Test/NotificationsBenchmark.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 324bc5f1bd..ae49f88592 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -39,7 +39,7 @@ testBench = do -- Later, we only read from this map. Thus, it doesn't have to be thread-safe. userMap :: Map Word TestRecipient <- Stream.fromList [0 :: Word .. maxUserNo] - & Stream.filter (\uNo -> trace (show (uNo, shardingGroup, uNo `mod` shardingGroupCount, (uNo `mod` shardingGroupCount) == shardingGroup)) (uNo `mod` shardingGroupCount) == shardingGroup) + & Stream.filter ((shardingGroup ==) . (`mod` shardingGroupCount)) & Stream.parMapM parCfg (\i -> generateTestRecipient >>= \r -> pure (i, r)) & Stream.fold toMap From 294ffd69f06bd1bfbfe2f1ecb8a70fe571f3dab5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:03:45 +0200 Subject: [PATCH 15/26] All users should have at least one client --- integration/test/Test/NotificationsBenchmark.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index ae49f88592..8b98680e47 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -110,7 +110,7 @@ generateTestRecipient :: (HasCallStack) => App TestRecipient generateTestRecipient = do print "generateTestRecipient" user <- randomUser OwnDomain def - r <- randomRIO @Word (0, 8) + r <- randomRIO @Word (1, 8) clientIds <- forM [0 .. r] $ \_ -> do client <- addClient From 2312d996a33cda60a8c805d5f1f34d51964691a0 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:04:18 +0200 Subject: [PATCH 16/26] Create fake data up to maxUserNo --- integration/test/Test/NotificationsBenchmark.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 8b98680e47..95487214a6 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -47,7 +47,7 @@ testBench = do -- TODO: To be replaced with real data from the file. (See -- https://wearezeta.atlassian.net/wiki/spaces/PET/pages/2118680620/Simulating+production-like+data) - let fakeData = zip (plusDelta now <$> [0 :: Word ..]) (cycle [0 .. 1000]) + let fakeData = zip (plusDelta now <$> [0 :: Word ..]) (cycle [0 .. maxUserNo]) Stream.fromList fakeData & Stream.filter (\(_t, uNo) -> (uNo `mod` shardingGroupCount) == shardingGroup) From d86d368b27bf945f0d38d1799ac8b0c346e5ec53 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:21:59 +0200 Subject: [PATCH 17/26] Retry failed test setup functions --- .../test/Test/NotificationsBenchmark.hs | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 95487214a6..9ec7394db5 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -8,9 +8,9 @@ import Control.Concurrent import Control.Monad.Codensity (Codensity (..)) import Control.Monad.Reader (asks) import Control.Monad.Reader.Class (local) +import Control.Retry import qualified Data.Map.Strict as Map import Data.Time -import Debug.Trace import GHC.Conc (numCapabilities) import GHC.Stack import SetupHelpers @@ -109,18 +109,22 @@ setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} generateTestRecipient :: (HasCallStack) => App TestRecipient generateTestRecipient = do print "generateTestRecipient" - user <- randomUser OwnDomain def + user <- recover $ (randomUser OwnDomain def) r <- randomRIO @Word (1, 8) clientIds <- forM [0 .. r] $ \_ -> do client <- - addClient - user - def - { acapabilities = Just ["consumable-notifications"], - prekeys = Just $ take 10 somePrekeysRendered, - lastPrekey = Just $ head someLastPrekeysRendered - } + recover + $ addClient + user + def + { acapabilities = Just ["consumable-notifications"], + prekeys = Just $ take 10 somePrekeysRendered, + lastPrekey = Just $ head someLastPrekeysRendered + } >>= getJSON 201 objId client pure $ TestRecipient user clientIds + where + recover :: App a -> App a + recover = recoverAll (limitRetriesByCumulativeDelay 300 (exponentialBackoff 1_000_000)) . const From e409883ad4bf369aa79f473cea38a8785fbfba0b Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:41:17 +0200 Subject: [PATCH 18/26] Print message send delay --- integration/test/Test/NotificationsBenchmark.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 9ec7394db5..7898b48688 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -10,6 +10,7 @@ import Control.Monad.Reader (asks) import Control.Monad.Reader.Class (local) import Control.Retry import qualified Data.Map.Strict as Map +import Data.String.Conversions (cs) import Data.Time import GHC.Conc (numCapabilities) import GHC.Stack @@ -58,7 +59,6 @@ testBench = do waitForTimeStamp :: UTCTime -> App () waitForTimeStamp timestamp = liftIO $ do now <- getCurrentTime - print $ "(timestamp, now)" ++ show (timestamp, now) when (now < timestamp) $ -- Event comes from the simulated future: Wait here until now and timestamp are aligned. @@ -80,10 +80,16 @@ sendAndReceive userNo userMap = do r <- recipient alice payload :: Value <- toJSON <$> liftIO randomPayload + now <- liftIO $ getCurrentTime let push = object [ "recipients" .= [r], - "payload" .= [object ["foo" .= payload]] + "payload" + .= [ object + [ "foo" .= payload, + "sent_at" .= now + ] + ] ] void $ postPush alice [push] >>= getBody 200 @@ -92,8 +98,10 @@ sendAndReceive userNo userMap = do runCodensity (TestEvents.createEventsWebSocket alice (Just cid)) $ \ws -> do -- TODO: Tweak this value to the least acceptable event delivery duration local (setTimeoutTo 120) $ TestEvents.assertFindsEvent ws $ \e -> do - print "Event received" - printJSON e + receivedAt <- liftIO getCurrentTime + sentAt :: UTCTime <- (e %. "payload.sent_at" >>= asByteString) <&> fromJust . decode . cs + print $ "Message sent/receive delta: " ++ show (diffUTCTime receivedAt sentAt) + e %. "payload" `shouldMatch` [object ["foo" .= payload]] where -- \| Generate a random string with random length up to 2048 bytes From 5249c1d1d52fcb85d921d43092465e169cab9054 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 12:55:27 +0200 Subject: [PATCH 19/26] Delete obsolete TODO --- integration/test/Test/NotificationsBenchmark.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 7898b48688..56fc4e662a 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -55,7 +55,6 @@ testBench = do & Stream.parMapM parCfg (\(t, uNo) -> waitForTimeStamp t >> sendAndReceive uNo userMap) & Stream.fold Fold.drain --- TODO: Add a speed factor to the simulation as we want to simulate faster than real time waitForTimeStamp :: UTCTime -> App () waitForTimeStamp timestamp = liftIO $ do now <- getCurrentTime From c27899d4e3d8642f3ef0516922c175de39470fc1 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 29 Sep 2025 13:30:46 +0200 Subject: [PATCH 20/26] Use average payload size from prod --- integration/test/Test/NotificationsBenchmark.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 56fc4e662a..7e44796087 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -105,10 +105,11 @@ sendAndReceive userNo userMap = do where -- \| Generate a random string with random length up to 2048 bytes randomPayload :: IO String - randomPayload = do - -- TODO: 1 to 2028 chars is a guess. We could adjust it to the real distribution. - len <- randomRIO @Int (1, 2048) -- random length between 1 and 2048 - mapM (\_ -> randomRIO ('\32', '\126')) [1 .. len] -- printable ASCII + randomPayload = + -- Measured with + -- `kubectl exec --namespace databases -it gundeck-gundeck-eks-eu-west-1a-sts-0 -- sh -c 'cqlsh -e "select blobAsText(payload) from gundeck.notifications LIMIT 5000;" ' | sed 's/^[ \t]*//;s/[ \t]*$//' | wc` + let len :: Int = 884 -- measured in prod + in mapM (\_ -> randomRIO ('\32', '\126')) [1 .. len] -- printable ASCII setTimeoutTo :: Int -> Env -> Env setTimeoutTo tSecs env = env {timeOutSeconds = tSecs} From 7bdfcdf8a288adca64ec746cf4630412ff82ffc7 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 30 Sep 2025 13:50:34 +0200 Subject: [PATCH 21/26] Add maxDeliveryDelay config --- charts/integration/templates/configmap.yaml | 1 + charts/integration/values.yaml | 1 + integration/test/Test/NotificationsBenchmark.hs | 3 ++- integration/test/Testlib/Env.hs | 6 ++++-- integration/test/Testlib/Types.hs | 10 +++++++--- services/integration.yaml | 1 + 6 files changed, 16 insertions(+), 6 deletions(-) diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index bea3d10c3c..0a367b84fb 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -313,3 +313,4 @@ data: cellsEventQueue: cells_events shardingGroupCount: {{ .Values.config.shardingGroupCount }} maxUserNo: {{ .Values.config.maxUserNo }} + maxDeliveryDelay: {{ .Values.config.maxDeliveryDelay }} diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index fd975a4620..2709b88689 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -122,6 +122,7 @@ config: shardingGroupCount: 1 shardingGroup: 0 maxUserNo: 1000 + maxDeliveryDelay: 120 tls: verify_depth: 1 # Namespace from which to obtain the secret containing the CA trusted by diff --git a/integration/test/Test/NotificationsBenchmark.hs b/integration/test/Test/NotificationsBenchmark.hs index 7e44796087..479e0564d7 100644 --- a/integration/test/Test/NotificationsBenchmark.hs +++ b/integration/test/Test/NotificationsBenchmark.hs @@ -93,10 +93,11 @@ sendAndReceive userNo userMap = do void $ postPush alice [push] >>= getBody 200 + messageDeliveryTimeout <- asks $ fromIntegral . (.maxDeliveryDelay) forM_ (testRecipient.clientIds) $ \(cid :: String) -> runCodensity (TestEvents.createEventsWebSocket alice (Just cid)) $ \ws -> do -- TODO: Tweak this value to the least acceptable event delivery duration - local (setTimeoutTo 120) $ TestEvents.assertFindsEvent ws $ \e -> do + local (setTimeoutTo messageDeliveryTimeout) $ TestEvents.assertFindsEvent ws $ \e -> do receivedAt <- liftIO getCurrentTime sentAt :: UTCTime <- (e %. "payload.sent_at" >>= asByteString) <&> fromJust . decode . cs print $ "Message sent/receive delta: " ++ show (diffUTCTime receivedAt sentAt) diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index 19fe1848ec..f251a02e76 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -148,7 +148,8 @@ mkGlobalEnv cfgFile shardingGroup = do gCellsEventWatchers, gShardingGroupCount = intConfig.shardingGroupCount, gShardingGroup = shardingGroup, - gMaxUserNo = intConfig.maxUserNo + gMaxUserNo = intConfig.maxUserNo, + gMaxDeliveryDelay = intConfig.maxDeliveryDelay } where createSSLContext :: Maybe FilePath -> IO (Maybe OpenSSL.SSLContext) @@ -209,7 +210,8 @@ mkEnv currentTestName ge = do cellsEventWatchers = ge.gCellsEventWatchers, shardingGroupCount = ge.gShardingGroupCount, shardingGroup = ge.gShardingGroup, - maxUserNo = ge.gMaxUserNo + maxUserNo = ge.gMaxUserNo, + maxDeliveryDelay = ge.gMaxDeliveryDelay } allCiphersuites :: [Ciphersuite] diff --git a/integration/test/Testlib/Types.hs b/integration/test/Testlib/Types.hs index f11e0c169e..99044af3c6 100644 --- a/integration/test/Testlib/Types.hs +++ b/integration/test/Testlib/Types.hs @@ -147,7 +147,8 @@ data GlobalEnv = GlobalEnv gCellsEventWatchers :: IORef (Map String QueueWatcher), gShardingGroupCount :: Word, gShardingGroup :: Word, - gMaxUserNo :: Word + gMaxUserNo :: Word, + gMaxDeliveryDelay :: Word } data IntegrationConfig = IntegrationConfig @@ -165,7 +166,8 @@ data IntegrationConfig = IntegrationConfig dnsMockServer :: DNSMockServerConfig, cellsEventQueue :: String, shardingGroupCount :: Word, - maxUserNo :: Word + maxUserNo :: Word, + maxDeliveryDelay :: Word } deriving (Show, Generic) @@ -188,6 +190,7 @@ instance FromJSON IntegrationConfig where <*> o .: fromString "cellsEventQueue" <*> o .: fromString "shardingGroupCount" <*> o .: fromString "maxUserNo" + <*> o .: fromString "maxDeliveryDelay" data ServiceMap = ServiceMap { brig :: HostPort, @@ -281,7 +284,8 @@ data Env = Env cellsEventWatchers :: IORef (Map String QueueWatcher), shardingGroupCount :: Word, shardingGroup :: Word, - maxUserNo :: Word + maxUserNo :: Word, + maxDeliveryDelay :: Word } data Response = Response diff --git a/services/integration.yaml b/services/integration.yaml index 8bfeaaa9ca..9ec920a603 100644 --- a/services/integration.yaml +++ b/services/integration.yaml @@ -333,3 +333,4 @@ cellsEventQueue: cells_events shardingGroupCount: 1 maxUserNo: 1000 +maxDeliveryDelay: 120 From 1f1d3b8b0e9ba73526007918413e0f2de98b4ae8 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 30 Sep 2025 13:52:10 +0200 Subject: [PATCH 22/26] Use released API version --- integration/test/Testlib/Env.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/integration/test/Testlib/Env.hs b/integration/test/Testlib/Env.hs index f251a02e76..7638e04608 100644 --- a/integration/test/Testlib/Env.hs +++ b/integration/test/Testlib/Env.hs @@ -190,7 +190,7 @@ mkEnv currentTestName ge = do apiVersionByDomain = Map.fromList [ (gDomain1 ge, 11), - (gDomain1 ge, 11), + (gDomain2 ge, 11), (gFederationV0Domain ge, 4), (gFederationV1Domain ge, 5), (gFederationV2Domain ge, 8) From 889f60c2bb467dde6611d8d13667b5b69fb0ba53 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 30 Sep 2025 13:54:22 +0200 Subject: [PATCH 23/26] Remove more unused cruft --- .../templates/integration-integration.yaml | 25 +++---------------- 1 file changed, 3 insertions(+), 22 deletions(-) diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 8b90c3b66c..d9901cfe61 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -29,10 +29,6 @@ spec: secret: secretName: "brig" - - name: "turn-servers" - configMap: - name: "turn" - - name: "cannon-config" configMap: name: "cannon" @@ -179,9 +175,6 @@ spec: - name: brig-secrets mountPath: /etc/wire/brig/secrets - - name: turn-servers - mountPath: /etc/wire/brig/turn - - name: cannon-config mountPath: /etc/wire/cannon/conf @@ -194,18 +187,6 @@ spec: - name: spar-config mountPath: /etc/wire/spar/conf - - name: federator-config - mountPath: /etc/wire/federator/conf - - - name: federator-secrets - mountPath: /etc/wire/federator/secrets - - - name: federator-ca - mountPath: /etc/wire/federator/ca - - - name: background-worker-config - mountPath: /etc/wire/background-worker/conf - - name: nginz-config mountPath: /etc/wire/nginz/conf @@ -280,8 +261,8 @@ spec: {{- end }} {{- end }} - name: ENABLE_FEDERATION_V0 - value: "1" + value: "0" - name: ENABLE_FEDERATION_V1 - value: "1" + value: "0" - name: ENABLE_FEDERATION_V2 - value: "1" + value: "0" From df94f8528d8136001220e8d6d617779088912149 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 30 Sep 2025 14:03:25 +0200 Subject: [PATCH 24/26] Start multiple instances in the integration Pod To more more noise. --- .../templates/integration-integration.yaml | 26 ++++++++++--------- charts/integration/values.yaml | 2 +- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index d9901cfe61..2e7d3af906 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -123,11 +123,12 @@ spec: cpu: "2" containers: - - name: integration - image: "{{ .Values.image.repository }}:{{ .Values.image.tag }}" - {{- if eq (include "includeSecurityContext" .) "true" }} + {{- range $i := until (int .Values.config.shardingGroupCount) }} + - name: "integration-{{ int $i}}" + image: "{{ $.Values.image.repository }}:{{ $.Values.image.tag }}" + {{- if eq (include "includeSecurityContext" $) "true" }} securityContext: - {{- toYaml .Values.podSecurityContext | nindent 6 }} + {{- toYaml $.Values.podSecurityContext | nindent 6 }} {{- end }} command: - /bin/bash @@ -135,13 +136,13 @@ spec: - | set -euo pipefail - if TEST_INCLUDE=testBench integration --config /etc/wire/integration/integration.yaml --sharding-group {{ .Values.config.shardingGroup }}; then + if TEST_INCLUDE=testBench integration --config /etc/wire/integration/integration.yaml --sharding-group {{ $i }}; then exit_code=$? else exit_code=$? fi - {{- if .Values.config.uploadXml }} + {{- if $.Values.config.uploadXml }} # In case a different S3 compliant storage is used to upload test result. if ! [[ -z "${UPLOAD_XML_AWS_ACCESS_KEY_ID+x}" ]]; then export AWS_ACCESS_KEY_ID="$UPLOAD_XML_AWS_ACCESS_KEY_ID" @@ -193,7 +194,7 @@ spec: - name: nginz-secrets mountPath: /etc/wire/nginz/secrets - {{- if eq (include "useCassandraTLS" .Values.config) "true" }} + {{- if eq (include "useCassandraTLS" $.Values.config) "true" }} - name: "integration-cassandra" mountPath: "/certs" @@ -228,14 +229,14 @@ spec: secretKeyRef: name: brig key: rabbitmqPassword - {{- if hasKey .Values.secrets "redisUsername" }} + {{- if hasKey $.Values.secrets "redisUsername" }} - name: REDIS_USERNAME valueFrom: secretKeyRef: name: integration key: redisUsername {{- end }} - {{- if hasKey .Values.secrets "redisPassword" }} + {{- if hasKey $.Values.secrets "redisPassword" }} - name: REDIS_PASSWORD valueFrom: secretKeyRef: @@ -244,10 +245,10 @@ spec: {{- end }} - name: TEST_XML value: /tmp/result.xml - {{- if .Values.config.uploadXml }} + {{- if $.Values.config.uploadXml }} - name: UPLOAD_XML_S3_BASE_URL - value: {{ .Values.config.uploadXml.baseUrl }} - {{- if .Values.secrets.uploadXmlAwsAccessKeyId }} + value: {{ $.Values.config.uploadXml.baseUrl }} + {{- if $.Values.secrets.uploadXmlAwsAccessKeyId }} - name: UPLOAD_XML_AWS_ACCESS_KEY_ID valueFrom: secretKeyRef: @@ -266,3 +267,4 @@ spec: value: "0" - name: ENABLE_FEDERATION_V2 value: "0" + {{- end }} diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index 2709b88689..326ac84d39 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -119,8 +119,8 @@ config: sesEndpointUrl: http://fake-aws-ses:4569 s3EndpointUrl: http://fake-aws-s3:9000 rabbitmqPutVHostUrl: http://rabbitmq:15672/api/vhosts - shardingGroupCount: 1 shardingGroup: 0 + shardingGroupCount: 3 maxUserNo: 1000 maxDeliveryDelay: 120 tls: From 6b8dba25b632396d3aa0ca32768116be860cd17a Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Tue, 30 Sep 2025 14:04:54 +0200 Subject: [PATCH 25/26] Configure for dev cluster --- charts/integration/templates/configmap.yaml | 3 ++- .../integration/templates/integration-integration.yaml | 10 +++++----- charts/integration/values.yaml | 4 ++-- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/charts/integration/templates/configmap.yaml b/charts/integration/templates/configmap.yaml index 0a367b84fb..4aee4ce200 100644 --- a/charts/integration/templates/configmap.yaml +++ b/charts/integration/templates/configmap.yaml @@ -78,7 +78,8 @@ data: dohPort: 5381 # originDomain: federation-test-helper.{{ .Release.Namespace }}.svc.cluster.local - originDomain: sven-test.wire.link + # sven-test.wire.link + originDomain: dev.zinfra.io rabbitmq: host: rabbitmq diff --git a/charts/integration/templates/integration-integration.yaml b/charts/integration/templates/integration-integration.yaml index 2e7d3af906..b0ff8c19aa 100644 --- a/charts/integration/templates/integration-integration.yaml +++ b/charts/integration/templates/integration-integration.yaml @@ -101,12 +101,12 @@ spec: - name: RABBITMQ_USERNAME valueFrom: secretKeyRef: - name: brig + name: gundeck key: rabbitmqUsername - name: RABBITMQ_PASSWORD valueFrom: secretKeyRef: - name: brig + name: gundeck key: rabbitmqPassword command: - /bin/sh @@ -158,7 +158,7 @@ spec: resources: requests: memory: "512Mi" - cpu: "2" + cpu: "0.5" volumeMounts: - name: integration-config @@ -222,12 +222,12 @@ spec: - name: RABBITMQ_USERNAME valueFrom: secretKeyRef: - name: brig + name: gundeck key: rabbitmqUsername - name: RABBITMQ_PASSWORD valueFrom: secretKeyRef: - name: brig + name: gundeck key: rabbitmqPassword {{- if hasKey $.Values.secrets "redisUsername" }} - name: REDIS_USERNAME diff --git a/charts/integration/values.yaml b/charts/integration/values.yaml index 326ac84d39..5bd5556def 100644 --- a/charts/integration/values.yaml +++ b/charts/integration/values.yaml @@ -118,9 +118,9 @@ config: sqsEndpointUrl: http://fake-aws-sqs:4568 sesEndpointUrl: http://fake-aws-ses:4569 s3EndpointUrl: http://fake-aws-s3:9000 - rabbitmqPutVHostUrl: http://rabbitmq:15672/api/vhosts - shardingGroup: 0 + rabbitmqPutVHostUrl: http://rabbitmq-b.databases.svc.cluster.local:15672/api/vhosts shardingGroupCount: 3 + # shardingGroup: 0 maxUserNo: 1000 maxDeliveryDelay: 120 tls: From 2b615c4b2c5cd3b45a689357fcb48a2c39eedaf5 Mon Sep 17 00:00:00 2001 From: Sven Tennie Date: Mon, 6 Oct 2025 13:07:02 +0200 Subject: [PATCH 26/26] serve integration chart locally ... such that `make charts-serve` provides it. --- Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Makefile b/Makefile index ecf4201345..d451a3b0b0 100644 --- a/Makefile +++ b/Makefile @@ -18,7 +18,8 @@ fake-aws fake-aws-s3 fake-aws-sqs aws-ingress fluent-bit kibana backoffice \ calling-test demo-smtp elasticsearch-curator elasticsearch-external \ elasticsearch-ephemeral minio-external cassandra-external \ ingress-nginx-controller nginx-ingress-services reaper restund \ -k8ssandra-test-cluster ldap-scim-bridge wire-server-enterprise +k8ssandra-test-cluster ldap-scim-bridge wire-server-enterprise \ +integration KIND_CLUSTER_NAME := wire-server HELM_PARALLELISM ?= 1 # 1 for sequential tests; 6 for all-parallel tests # (run `psql -h localhost -p 5432 -d backendA -U wire-server -w` for the list of options for PSQL_DB)