From a7e65f0cabf8e810584b9a522d3fe5d698914d38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marcin=20W=C3=B3jtowicz?= Date: Sun, 29 Sep 2024 22:08:51 +0200 Subject: [PATCH] wip --- .../src/Cardano/Benchmarking/GeneratorTx.hs | 4 +++- .../GeneratorTx/SubmissionClient.hs | 17 +++++++++++++---- .../src/Cardano/Benchmarking/Script/Core.hs | 9 +++++---- bench/tx-generator/tx-generator.cabal | 1 + cardano-testnet/src/Parsers/Cardano.hs | 2 +- 5 files changed, 23 insertions(+), 10 deletions(-) diff --git a/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs b/bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs index f87af0bfdfa..add1e474a48 100644 --- 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 index 08a21618e74..99b6649e373 100644 --- 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 index 36810206321..9abb0d1476a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -14,6 +14,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} module Cardano.Benchmarking.Script.Core where @@ -21,7 +22,7 @@ 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 index c1fbc0cd1ed..91d6882a6c3 100644 --- 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 index 46abc97f0f2..c9112125850 100644 --- 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)