Skip to content

Commit

Permalink
Keep all wallets in setupDelegation alive longer
Browse files Browse the repository at this point in the history
  • Loading branch information
Anviking committed May 22, 2024
1 parent ffa6545 commit 70a761a
Showing 1 changed file with 26 additions and 16 deletions.
42 changes: 26 additions & 16 deletions lib/integration/framework/Test/Integration/Framework/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,6 +123,9 @@ import Cardano.Wallet.TokenMetadata.MockServer
( queryServerStatic
, withMetadataServer
)
import Control.Concurrent
( threadDelay
)
import Control.Lens
( view
)
Expand Down Expand Up @@ -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

0 comments on commit 70a761a

Please sign in to comment.