diff --git a/integration/test/Test/Conversation.hs b/integration/test/Test/Conversation.hs index 3dd5615c667..da0a48d9a7f 100644 --- a/integration/test/Test/Conversation.hs +++ b/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) diff --git a/integration/test/Test/Migration/Conversation.hs b/integration/test/Test/Migration/Conversation.hs index 88f78e059ea..df4fa586a38 100644 --- a/integration/test/Test/Migration/Conversation.hs +++ b/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 diff --git a/integration/test/Testlib/App.hs b/integration/test/Testlib/App.hs index 55e6878b865..bdf3e41ffb3 100644 --- a/integration/test/Testlib/App.hs +++ b/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 ()))