Ensure cluster setup runs without rollbacks

This commit re-adds the setup specific callback from removed in 925b4d9
such that the fuacet setup is run on the BFT node, before pools are
registered and can roll back.

This should hopefully fix a #2720, #2428, and perhaps something more.

lib/shelley/bench/Latency.hs

@@ -451,19 +451,18 @@ withShelleyServer tracers action = do
             createDirectory db
             let logCfg = LogFileConfig Error Nothing Error
             let clusterCfg = LocalClusterConfig [] maxBound logCfg
-            withCluster nullTracer dir clusterCfg $
-                onClusterStart act dir db
+            withCluster nullTracer dir clusterCfg (setupFaucet dir) $
+                onClusterStart act db
 
-    setupFaucet conn dir = do
+    setupFaucet dir (RunningNode conn _ _) = do
         let encodeAddr = T.unpack . encodeAddress @'Mainnet
         let addresses = map (first encodeAddr) shelleyIntegrationTestFunds
         let addressesMA = map (first encodeAddr) (maryIntegrationTestAssets (Coin 10_000_000))
         sendFaucetFundsTo nullTracer conn dir addresses
         sendFaucetAssetsTo nullTracer conn dir 20 addressesMA
 
-    onClusterStart act dir db (RunningNode conn block0 (np, vData)) = do
+    onClusterStart act db (RunningNode conn block0 (np, vData)) = do
         listen <- walletListenFromEnv
-        setupFaucet conn dir
         serveWallet
             (SomeNetworkDiscriminant $ Proxy @'Mainnet)
             tracers

lib/shelley/exe/local-cluster.hs

@@ -213,10 +213,11 @@ main = withLocalClusterSetup $ \dir clusterLogs walletLogs ->
     withLoggingNamed "cluster" clusterLogs $ \(_, (_, trCluster)) -> do
         let tr' = contramap MsgCluster $ trMessageText trCluster
         clusterCfg <- localClusterConfigFromEnv
-        withCluster tr' dir clusterCfg $
-            whenReady dir (trMessageText trCluster) walletLogs
+        withCluster tr' dir clusterCfg
+            (setupFaucet dir (trMessageText trCluster))
+            (whenReady dir (trMessageText trCluster) walletLogs)
   where
-    setupFaucet dir trCluster socketPath = do
+    setupFaucet dir trCluster (RunningNode socketPath _ _) = do
         traceWith trCluster MsgSettingUpFaucet
         let trCluster' = contramap MsgCluster trCluster
         let encodeAddresses = map (first (T.unpack . encodeAddress @'Mainnet))
@@ -231,7 +232,6 @@ main = withLocalClusterSetup $ \dir clusterLogs walletLogs ->
 
     whenReady dir trCluster logs (RunningNode socketPath block0 (gp, vData)) =
         withLoggingNamed "cardano-wallet" logs $ \(sb, (cfg, tr)) -> do
-            setupFaucet dir trCluster socketPath
 
             ekgEnabled >>= flip when (EKG.plugin cfg tr sb >>= loadPlugin sb)
 

lib/shelley/src/Cardano/Wallet/Shelley/Launch/Cluster.hs

@@ -513,11 +513,12 @@ withCluster
     -- ^ Temporary directory to create config files in.
     -> LocalClusterConfig
     -- ^ The configurations of pools to spawn.
+    -> (RunningNode -> IO ())
+    -- ^ Setup action to run using the BFT node.
     -> (RunningNode -> IO a)
-    -- ^ Action to run once we have transitioned to the Allegra era and cluster
-    -- nodes (stake pools and bft) are running.
+    -- ^ Action to run once when the stake pools are setup.
     -> IO a
-withCluster tr dir LocalClusterConfig{..} onClusterStart =
+withCluster tr dir LocalClusterConfig{..} onSetup onClusterStart =
     bracketTracer' tr "withCluster" $ do
         traceWith tr $ MsgStartingCluster dir
         resetGlobals
@@ -530,6 +531,8 @@ withCluster tr dir LocalClusterConfig{..} onClusterStart =
         withBFTNode tr dir bftCfg $ \bftSocket block0 params -> do
             waitForSocket tr bftSocket
 
+            onSetup $ RunningNode bftSocket block0 params
+
             (rawTx, faucetPrv) <- prepareKeyRegistration tr dir
             tx <- signTx tr dir rawTx [faucetPrv]
             submitTx tr bftSocket "pre-registered stake key" tx

lib/shelley/test/integration/Main.hs

@@ -312,12 +312,12 @@ specWithServer testDir (tr, tracers) = aroundAll withContext
     withServer dbDecorator onReady = bracketTracer' tr "withServer" $
         withSMASH testDir $ \smashUrl -> do
             clusterCfg <- localClusterConfigFromEnv
-            withCluster tr' testDir clusterCfg $
+            withCluster tr' testDir clusterCfg setupFaucet $
                 onClusterStart (onReady $ T.pack smashUrl) dbDecorator
 
     tr' = contramap MsgCluster tr
     encodeAddresses = map (first (T.unpack . encodeAddress @'Mainnet))
-    setupFaucet conn = do
+    setupFaucet (RunningNode conn _ _) = do
         traceWith tr MsgSettingUpFaucet
         let rewards = (,Coin $ fromIntegral oneMillionAda) <$>
                 concatMap genRewardAccounts mirMnemonics
@@ -328,7 +328,6 @@ specWithServer testDir (tr, tracers) = aroundAll withContext
             encodeAddresses (maryIntegrationTestAssets (Coin 10_000_000))
 
     onClusterStart action dbDecorator (RunningNode conn block0 (gp, vData)) = do
-        setupFaucet conn
         let db = testDir </> "wallets"
         createDirectory db
         listen <- walletListenFromEnv