Merge pull request #6085 from IntersectMBO/smelc/tx-generator-simplif…

…ications tx-generator: Core.hs: simplifications + better non-Byron support
IntersectMBO · Jan 24, 2025 · e3e74b0 · e3e74b0
2 parents 9017d91 + edebc27
commit e3e74b0
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 13 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -162,19 +162,23 @@ cancelBenchmark = do
 getLocalConnectInfo :: ActionM LocalNodeConnectInfo
 getLocalConnectInfo = makeLocalConnectInfo <$> getEnvNetworkId <*> getEnvSocketPath
 
-queryEra :: ActionM AnyCardanoEra
+queryEra :: ActionM AnyShelleyBasedEra
 queryEra = do
   localNodeConnectInfo <- getLocalConnectInfo
   chainTip  <- getLocalChainTip localNodeConnectInfo
-  mapExceptT liftIO .
+  AnyCardanoEra era <- mapExceptT liftIO .
     modifyError (Env.TxGenError . TxGenError . show) $
       queryNodeLocalState localNodeConnectInfo (SpecificPoint $ chainTipToChainPoint chainTip) QueryCurrentEra
+  caseByronOrShelleyBasedEra
+    (liftTxGenError $ TxGenError "queryEra Byron not supported")
+    (return . AnyShelleyBasedEra)
+    era
 
 queryRemoteProtocolParameters :: ActionM ProtocolParameters
 queryRemoteProtocolParameters = do
   localNodeConnectInfo <- getLocalConnectInfo
   chainTip  <- liftIO $ getLocalChainTip localNodeConnectInfo
-  era <- queryEra
+  AnyShelleyBasedEra sbe <- queryEra
   let
     callQuery :: forall era.
                  QueryInEra era (Ledger.PParams (ShelleyLedgerEra era))
@@ -187,22 +191,15 @@ queryRemoteProtocolParameters = do
       liftIO $ BSL.writeFile pparamsFile $ prettyPrintOrdered pp'
       traceDebug $ "queryRemoteProtocolParameters : query result saved in: " ++ pparamsFile
       return pp'
-  case era of
-    AnyCardanoEra ByronEra   -> liftTxGenError $ TxGenError "queryRemoteProtocolParameters Byron not supported"
-    AnyCardanoEra ShelleyEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraShelley QueryProtocolParameters
-    AnyCardanoEra AllegraEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAllegra QueryProtocolParameters
-    AnyCardanoEra MaryEra    -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraMary    QueryProtocolParameters
-    AnyCardanoEra AlonzoEra  -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraAlonzo QueryProtocolParameters
-    AnyCardanoEra BabbageEra -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraBabbage QueryProtocolParameters
-    AnyCardanoEra ConwayEra  -> callQuery $ QueryInShelleyBasedEra ShelleyBasedEraConway QueryProtocolParameters
+  callQuery $ QueryInShelleyBasedEra sbe QueryProtocolParameters
 
 getProtocolParameters :: ActionM ProtocolParameters
 getProtocolParameters = do
   getProtoParamMode  >>= \case
     ProtocolParameterQuery -> queryRemoteProtocolParameters
     ProtocolParameterLocal parameters -> return parameters
 
-waitForEra :: AnyCardanoEra -> ActionM ()
+waitForEra :: AnyShelleyBasedEra -> ActionM ()
 waitForEra era = do
   currentEra <- queryEra
   if currentEra == era

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
@@ -117,7 +117,7 @@ data Action where
   -- with testing and quick fixes.
   Reserved           :: [String] -> Action
   -- 'WaitForEra' loops doing delays/sleeps until the current era matches.
-  WaitForEra         :: !AnyCardanoEra -> Action
+  WaitForEra         :: !AnyShelleyBasedEra -> Action
   -- | 'SetProtocolParameters' has one option to read from a file and
   -- another to pass directly and just sets a state variable for
   -- the @protoParams@ field of 'Cardano.Benchmarking.Script.Env.Env'.