wip

IntersectMBO · Sep 30, 2024 · a7e65f0 · a7e65f0
1 parent 388d671
commit a7e65f0
Show file tree

Hide file tree

Showing 5 changed files with 23 additions and 10 deletions.
diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs
@@ -19,6 +19,8 @@ module Cardano.Benchmarking.GeneratorTx
   , waitBenchmark
   ) where
 
+import qualified Cardano.Ledger.Core as Ledger
+import           Cardano.Api.Shelley (ShelleyLedgerEra)
 import           Cardano.Api hiding (txFee)
 
 import           Cardano.Benchmarking.GeneratorTx.NodeToNode
@@ -110,7 +112,7 @@ handleTxSubmissionClientError
       LogErrors   -> traceWith traceSubmit $
         TraceBenchTxSubError (pack errDesc)
 
-walletBenchmark :: forall era. IsShelleyBasedEra era
+walletBenchmark :: forall era. (IsShelleyBasedEra era, Ledger.EraTx (ShelleyLedgerEra era))
   => Trace IO (TraceBenchTxSubmit TxId)
   -> Trace IO NodeToNodeSubmissionTrace
   -> ConnectClient

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs
@@ -25,8 +25,10 @@ module Cardano.Benchmarking.GeneratorTx.SubmissionClient
   , txSubmissionClient
   ) where
 
+import           Lens.Micro ((^.))
+import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Api hiding (Active)
-import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx)
+import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx, Tx (..), ShelleyLedgerEra)
 
 import           Cardano.Benchmarking.LogTypes
 import           Cardano.Benchmarking.Types
@@ -40,7 +42,7 @@ import           Cardano.Tracing.OrphanInstances.Shelley ()
 import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock)
 import qualified Ouroboros.Consensus.Cardano.Block as Block
                    (TxId (GenTxIdAllegra, GenTxIdAlonzo, GenTxIdBabbage, GenTxIdConway, GenTxIdMary, GenTxIdShelley))
-import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, txInBlockSize)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId)
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId (ShelleyTxId))
@@ -52,7 +54,6 @@ import           Ouroboros.Network.SizeInBytes
 
 import           Prelude (error, fail)
 
-import           Control.Arrow ((&&&))
 import qualified Data.List as L
 import qualified Data.List.Extra as L
 import qualified Data.List.NonEmpty as NE
@@ -89,6 +90,7 @@ txSubmissionClient
      ( MonadIO m, MonadFail m
      , IsShelleyBasedEra era
      , tx      ~ Tx era
+     , Ledger.EraTx (ShelleyLedgerEra era)
      )
   => Trace m NodeToNodeSubmissionTrace
   -> Trace m (TraceBenchTxSubmit TxId)
@@ -178,7 +180,14 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
                 stsUnavailable stats + Unav (length missIds)}))
 
   txToIdSize :: tx -> (GenTxId CardanoBlock, SizeInBytes)
-  txToIdSize = (Mempool.txId &&& (SizeInBytes . txInBlockSize)) . toGenTx
+  txToIdSize tx = -- (Mempool.txId &&& (SizeInBytes . txInBlockSize)) . toGenTx
+    (thisID, SizeInBytes thisSize)
+    where
+      thisID = Mempool.txId . toGenTx $ tx
+      thisSize =
+        case tx of
+          ShelleyTx _sbe tx' -> tx' ^. Ledger.wireSizeTxF
+
 
   toGenTx :: tx -> GenTx CardanoBlock
   toGenTx tx = toConsensusGenTx $ TxInMode (shelleyBasedEra @era) tx

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -14,14 +14,15 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Cardano.Benchmarking.Script.Core
 where
 
 import           Cardano.Api
 import           Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters,
                    ShelleyLedgerEra, convertToLedgerProtocolParameters, protocolParamMaxTxExUnits,
-                   protocolParamPrices)
+                   protocolParamPrices, ShelleyLedgerEra)
 
 import           Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl)
 import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (waitBenchmark, walletBenchmark)
@@ -70,7 +71,7 @@ import qualified Streaming.Prelude as Streaming
 liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x)
 liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall)
 
-withEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ActionM x) -> ActionM x
+withEra :: AnyCardanoEra -> (forall era. (IsShelleyBasedEra era, Ledger.EraTx (ShelleyLedgerEra era)) => AsType era -> ActionM x) -> ActionM x
 withEra era action = do
   case era of
     AnyCardanoEra ConwayEra  -> action AsConwayEra
@@ -238,7 +239,7 @@ toMetadata (Just payloadSize) = case mkMetadata payloadSize of
 submitAction :: AnyCardanoEra -> SubmitMode -> Generator -> TxGenTxParams -> ActionM ()
 submitAction era submitMode generator txParams = withEra era $ submitInEra submitMode generator txParams
 
-submitInEra :: forall era. IsShelleyBasedEra era => SubmitMode -> Generator -> TxGenTxParams -> AsType era -> ActionM ()
+submitInEra :: forall era. (IsShelleyBasedEra era, Ledger.EraTx (ShelleyLedgerEra era)) => SubmitMode -> Generator -> TxGenTxParams -> AsType era -> ActionM ()
 submitInEra submitMode generator txParams era = do
   txStream <- evalGenerator generator txParams era
   case submitMode of
@@ -263,7 +264,7 @@ submitInEra submitMode generator txParams era = do
         callback tx
         submitAll callback rest
 
-benchmarkTxStream :: forall era. IsShelleyBasedEra era
+benchmarkTxStream :: forall era. (IsShelleyBasedEra era, Ledger.EraTx (ShelleyLedgerEra era))
   => TxStream IO era
   -> TargetNodes
   -> TPSRate

diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal
@@ -129,6 +129,7 @@ library
                       , generic-monoid
                       , ghc-prim
                       , io-classes
+                      , microlens
                       , mtl
                       , network
                       , network-mux

diff --git a/cardano-testnet/src/Parsers/Cardano.hs b/cardano-testnet/src/Parsers/Cardano.hs
@@ -2,7 +2,7 @@ module Parsers.Cardano
   ( cmdCardano
   ) where
 
-import           Cardano.Api (EraInEon (..), bounded, AnyShelleyBasedEra (AnyShelleyBasedEra))
+import           Cardano.Api (EraInEon (..), AnyShelleyBasedEra (AnyShelleyBasedEra))
 
 import           Cardano.CLI.Environment
 import           Cardano.CLI.EraBased.Options.Common hiding (pNetworkId)