test(integration): retry transient 533 in testSynchroniseUserRemovalNotification

integration/test/Test/Conversation.hs

@@ -701,7 +701,7 @@ testSynchroniseUserRemovalNotification domain = do
         charlie <- randomUser dynBackend.berDomain def
         mapM_ (connectTwoUsers charlie) [alice, bob]
         conv <-
-          postConversation alice (defProteus {qualifiedUsers = [bob, charlie]})
+          retryTransient (postConversation alice (defProteus {qualifiedUsers = [bob, charlie]}))
             >>= getJSON 201
         pure (conv, charlie)
 

integration/test/Test/Migration/Conversation.hs

@@ -15,7 +15,6 @@ module Test.Migration.Conversation where
 import API.Galley
 import qualified API.GalleyInternal as I
 import Control.Applicative
-import Control.Concurrent (threadDelay)
 import Control.Monad.Codensity
 import Control.Monad.Reader
 import Data.IntMap (IntMap)
@@ -255,28 +254,6 @@ testMigrationToPostgresProteus = do
         convs <- replicateM n $ action
         pure (phase, convs)
 
-    -- \| Retry a request that fans out over federation on transient errors.
-    --
-    -- Conversation creates and membership changes federate to the freshly
-    -- (re)started migrating backend; during that cold-start burst transient
-    -- federation failures are common (the dynamic backend is declared ready by
-    -- a single federated ping, then hit with parallelism-8 fan-out). This
-    -- tolerates 533 (unreachable backends / unexpected federation response),
-    -- 521 (connection refused) and 525 (SSL), in addition to the 500/422 that
-    -- the previous helper already covered. Bounded by a cumulative cap so
-    -- genuine failures still surface.
-    retryTransient :: App Response -> App Response
-    retryTransient action = go (0 :: Int) (100_000 :: Int)
-      where
-        go spent delay = do
-          resp <- action
-          if resp.status `elem` [500, 422, 521, 525, 533] && spent < maxCumulative
-            then do
-              liftIO $ threadDelay delay
-              go (spent + delay) (min 2_000_000 (delay * 2))
-            else pure resp
-        maxCumulative = 30_000_000
-
     runPhaseOperations :: (HasCallStack) => Int -> Value -> String -> TestConvList -> Value -> Value -> App [ConvId]
     runPhaseOperations phase convAdmin tid TestConvList {..} mel mark = do
       withWebSocket mel $ \melWS -> do

integration/test/Testlib/App.hs

@@ -18,6 +18,7 @@
 module Testlib.App where
 
 import Control.Applicative ((<|>))
+import Control.Concurrent (threadDelay)
 import Control.Monad.Reader
 import Control.Monad.Trans.Maybe (MaybeT (MaybeT), runMaybeT)
 import qualified Control.Retry as Retry
@@ -67,6 +68,28 @@ instance MakesValue Domain where
 retryT :: App a -> App a
 retryT action = Retry.recoverAll (Retry.exponentialBackoff 8000 <> Retry.limitRetries 10) (const action)
 
+-- | Retry a request that fans out over federation on transient errors.
+--
+-- Conversation creates and membership changes federate to all involved remote
+-- backends concurrently, and 'ensureNoUnreachableBackends' fails fast on the
+-- first unreachable backend with no retries (HTTP 533). Under CI load a single
+-- transient federation-ping failure (connection refused, TLS handshake, DNS) to
+-- one backend can therefore surface as 533 even though the backend is healthy.
+-- This tolerates 533 (unreachable backends / unexpected federation response),
+-- 521 (connection refused) and 525 (SSL), in addition to 500/422. Bounded by a
+-- cumulative 30s cap so genuine failures still surface.
+retryTransient :: App Response -> App Response
+retryTransient action = go (0 :: Int) (100_000 :: Int)
+  where
+    go spent delay = do
+      resp <- action
+      if resp.status `elem` [500, 422, 521, 525, 533] && spent < maxCumulative
+        then do
+          liftIO $ threadDelay delay
+          go (spent + delay) (min 2_000_000 (delay * 2))
+        else pure resp
+    maxCumulative = 30_000_000
+
 -- | make Bool lazy
 liftBool :: (Functor f) => f Bool -> BoolT f
 liftBool = MaybeT . fmap (bool Nothing (Just ()))