Use H.forConcurrently_ in generateVoteFiles

Co-authored-by: Mateusz Galazyn <[email protected]>

cardano-testnet/cardano-testnet.cabal

@@ -67,6 +67,7 @@ library
                       , mtl
                       , network
                       , network-mux
+                      , monad-control
                       , optparse-applicative-fork
                       , ouroboros-network ^>= 0.14
                       , ouroboros-network-api
@@ -228,6 +229,7 @@ test-suite cardano-testnet-test
                       , http-conduit
                       , lens-aeson
                       , microlens
+                      , monad-control
                       , mtl
                       , process
                       , regex-compat

cardano-testnet/src/Testnet/Components/DReps.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}

cardano-testnet/src/Testnet/Components/SPO.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -27,6 +28,7 @@ import qualified Cardano.Ledger.UMap as L
 import           Control.Monad
 import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.State.Strict as StateT
+import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Data.Aeson as Aeson
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -51,6 +53,7 @@ import           Testnet.Start.Types
 import           Hedgehog
 import           Hedgehog.Extras (ExecConfig)
 import qualified Hedgehog.Extras as H
+import           Hedgehog.Extras.Test.Concurrent (forConcurrently)
 
 checkStakePoolRegistered
   :: (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
@@ -410,7 +413,7 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s
 --
 -- Returns a list of generated @File VoteFile In@ representing the paths to
 -- the generated voting files.
-generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m, HasCallStack)
+generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m, HasCallStack, MonadBaseControl IO m)
   => ConwayEraOnwards era -- ^ The conway era onwards witness for the era in which the
                           -- transaction will be constructed.
   -> H.ExecConfig -- ^ Specifies the CLI execution configuration.
@@ -426,7 +429,7 @@ generateVoteFiles :: (MonadTest m, MonadIO m, MonadCatch m, HasCallStack)
   -> m [File VoteFile In]
 generateVoteFiles ceo execConfig work prefix governanceActionTxId governanceActionIndex allVotes = do
   baseDir <- H.createDirectoryIfMissing $ work </> prefix
-  forM (zip [(1 :: Integer)..] allVotes) $ \(idx, (spoKeys, vote)) -> do
+  forConcurrently (zip [(1 :: Integer)..] allVotes) $ \(idx, (spoKeys, vote)) -> do
     let path = File (baseDir </> "vote-" <> show idx)
     void $ H.execCli' execConfig
       [ eraToString $ toCardanoEra ceo, "governance", "vote", "create"

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedAbstainDRep.hs

@@ -29,6 +29,7 @@ import           Prelude
 
 import           Control.Monad (void)
 import           Control.Monad.Catch (MonadCatch)
+import           Control.Monad.Trans.Control (MonadBaseControl)
 import           Data.Data (Typeable)
 import           Data.String (fromString)
 import qualified Data.Text as Text
@@ -190,7 +191,7 @@ delegateToAutomaticDRep execConfig epochStateView configurationFile socketPath s
   void $ waitUntilEpoch (File configurationFile) (File socketPath) (EpochNo (epochAfterProp + 2))
 
 desiredPoolNumberProposalTest
-  :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t)
+  :: (HasCallStack, MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO m, Foldable t)
   => H.ExecConfig -- ^ Specifies the CLI execution configuration.
   -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
   -> FilePath -- ^ Path to the node configuration file as returned by 'cardanoTestnetDefault'.
@@ -337,7 +338,7 @@ type DefaultSPOVote = (String, Int)
 -- | Create and issue votes for (or against) a government proposal with default
 -- Delegate Representative (DReps created by 'cardanoTestnetDefault') and
 -- default Stake Pool Operatorsusing using @cardano-cli@.
-voteChangeProposal :: (Typeable era, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m)
+voteChangeProposal :: (Typeable era, MonadTest m, MonadIO m, MonadCatch m, H.MonadAssertion m, MonadBaseControl IO m)
   => H.ExecConfig -- ^ Specifies the CLI execution configuration.
   -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
   -> ConwayEraOnwards era -- ^ The @ConwayEraOnwards@ witness for the current era.

cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/PredefinedNoConfidenceDRep.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -26,6 +27,7 @@ import           Prelude
 import           Control.Monad (void)
 import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.State.Strict (MonadState (put), StateT)
+import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Data.Map as Map
 import           Data.String (fromString)
 import qualified Data.Text as Text
@@ -173,7 +175,7 @@ filterCommittee (AnyNewEpochState sbe newEpochState) =
     sbe
 
 updateConstitutionalCommittee
-  :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t)
+  :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO m, Foldable t, HasCallStack)
   => H.ExecConfig
   -> EpochStateView
   -> FilePath
@@ -320,7 +322,7 @@ makeUpdateConstitutionalCommitteeProposal execConfig epochStateView configuratio
 -- Run a no confidence motion and check the result. Vote "yes" with 3 SPOs. Check the no
 -- confidence motion passes.
 testNoConfidenceProposal
-  :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, Foldable t, HasCallStack)
+  :: (MonadTest m, MonadIO m, H.MonadAssertion m, MonadCatch m, MonadBaseControl IO m, Foldable t, HasCallStack)
   => H.ExecConfig -- ^ Specifies the CLI execution configuration.
   -> EpochStateView -- ^ Current epoch state view for transaction building. It can be obtained
                     -- using the 'getEpochStateView' function.
@@ -359,9 +361,8 @@ testNoConfidenceProposal execConfig epochStateView configurationFile socketPath
 
   return thisProposal
 
-
 makeNoConfidenceProposal
-  :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m)
+  :: (H.MonadAssertion m, MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => H.ExecConfig
   -> EpochStateView
   -> NodeConfigFile 'In