Use H.forConcurrently_ in generateVoteFiles

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

Author: palas

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
@@ -230,6 +231,7 @@ test-suite cardano-testnet-test
                       , http-conduit
                       , lens-aeson
                       , microlens
+                      , monad-control
                       , mtl
                       , process
                       , regex-compat

cardano-testnet/src/Testnet/Process/Cli/DRep.hs

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

cardano-testnet/src/Testnet/Process/Cli/SPO.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -25,6 +26,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
@@ -47,6 +49,7 @@ import           Testnet.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)
@@ -408,7 +411,7 @@ registerSingleSpo identifier tap@(TmpAbsolutePath tempAbsPath') nodeConfigFile s
 -- Returns a list of generated @File VoteFile In@ representing the paths to
 -- the generated voting files.
 -- TODO: unify with DRep.generateVoteFiles
-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.
@@ -424,7 +427,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-spo-" <> show idx)
     void $ execCli' execConfig
       [ eraToString $ toCardanoEra ceo, "governance", "vote", "create"

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

@@ -28,6 +28,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
@@ -184,7 +185,7 @@ delegateToAutomaticDRep execConfig epochStateView sbe work prefix flag payingWal
   void $ waitForEpochs epochStateView (EpochInterval 1)
 
 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
   -> ConwayEraOnwards ConwayEra -- ^ The ConwaysEraOnwards witness for the Conway era
@@ -317,7 +318,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/Gov/PredefinedNoConfidenceDRep.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -23,6 +24,7 @@ import           Prelude
 
 import           Control.Monad (void)
 import           Control.Monad.Catch (MonadCatch)
+import           Control.Monad.Trans.Control (MonadBaseControl)
 import qualified Data.Map as Map
 import           Data.String (fromString)
 import qualified Data.Text as Text
@@ -134,7 +136,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
   -> ConwayEraOnwards ConwayEra
@@ -266,7 +268,7 @@ makeUpdateConstitutionalCommitteeProposal execConfig epochStateView ceo work pre
 -- 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.
@@ -302,9 +304,8 @@ testNoConfidenceProposal execConfig epochStateView ceo work prefix
 
   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
   -> ConwayEraOnwards ConwayEra