From 70a761ace7aba504646436f0deb6cca3cb50573d Mon Sep 17 00:00:00 2001
From: Johannes Lund <anviking@me.com>
Date: Wed, 22 May 2024 20:29:16 +0200
Subject: [PATCH] Keep all wallets in `setupDelegation` alive longer

---
 .../Test/Integration/Framework/Setup.hs       | 42 ++++++++++++-------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/lib/integration/framework/Test/Integration/Framework/Setup.hs b/lib/integration/framework/Test/Integration/Framework/Setup.hs
index 84f9b29ab33..f7ef5d89453 100644
--- a/lib/integration/framework/Test/Integration/Framework/Setup.hs
+++ b/lib/integration/framework/Test/Integration/Framework/Setup.hs
@@ -123,6 +123,9 @@ import Cardano.Wallet.TokenMetadata.MockServer
     ( queryServerStatic
     , withMetadataServer
     )
+import Control.Concurrent
+    ( threadDelay
+    )
 import Control.Lens
     ( view
     )
@@ -530,22 +533,29 @@ withContext testingCtx@TestingCtx{..} action = do
                     ctx
                     (Link.listStakePools arbitraryStake)
                     Empty
-        -- Having 'runResourceT' /inside/ the loop ensures the wallets are
-        -- deleted as quickly as possible, not to deplete file descriptors or
-        -- resources for unnecessary restoration.
-        forM_ mnemonics $ \mw -> runResourceT $ do
-            w <- walletFromMnemonic ctx mw
-            (httpStatus, res) <-
-                joinStakePool
-                    @('Testnet 0) -- protocol magic doesn't matter
-                    ctx
-                    (SpecificPool pool)
-                    (w, fixturePassphrase)
-            liftIO $ case res of
-                Right _ -> return ()
-                Left err -> traceWith tr
-                    $ MsgRewardWalletDelegationFailed
-                    $ T.pack $ show (httpStatus, err)
+
+        -- We only delete the wallets together at the end of the loop by
+        -- using this /outer/ 'runResourceT'. While this may be taxing on
+        -- resources, it enables tx submission to ensure all txs make it into
+        -- the chain.
+        runResourceT $ do
+            forM_ mnemonics $ \mw -> do
+                w <- walletFromMnemonic ctx mw
+                (httpStatus, res) <-
+                    joinStakePool
+                        @('Testnet 0) -- protocol magic doesn't matter
+                        ctx
+                        (SpecificPool pool)
+                        (w, fixturePassphrase)
+                liftIO $ case res of
+                    Left err -> traceWith tr
+                        $ MsgRewardWalletDelegationFailed
+                        $ T.pack $ show (httpStatus, err)
+                    Right _ -> return ()
+
+            -- Extra time to ensure the final txs make it into the chain
+            let second = 1_000_000
+            liftIO $ threadDelay $ 10 * second
 
 bracketTracer' :: Tracer IO TestsLog -> Text -> IO a -> IO a
 bracketTracer' tr name = bracketTracer $ contramap (MsgBracket name) tr