wip

bench/tx-generator/src/Cardano/Benchmarking/Command.hs

@@ -57,13 +57,15 @@ import           GHC.Weak as Weak (deRefWeak)
 import           System.Posix.Signals as Sig (Handler (CatchInfo),
                    SignalInfo (..), SignalSpecificInfo (..), installHandler,
                    sigINT, sigTERM)
+import Foreign.C (Errno(..))
 #if MIN_VERSION_base(4,18,0)
 import           Data.Maybe as Maybe (fromMaybe)
 import           GHC.Conc.Sync as Conc (threadLabel)
 #endif
 #endif
 
 #ifdef UNIX
+deriving instance Show Errno
 deriving instance Show SignalInfo
 deriving instance Show SignalSpecificInfo
 #endif

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

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

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

bench/tx-generator/tx-generator.cabal

@@ -129,6 +129,7 @@ library
                       , generic-monoid
                       , ghc-prim
                       , io-classes
+                      , microlens
                       , mtl
                       , network
                       , network-mux

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)

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

@@ -302,13 +302,13 @@ findAllUtxos
 findAllUtxos epochStateView sbe = withFrozenCallStack $ do
   AnyNewEpochState sbe' newEpochState <- getEpochState epochStateView
   Refl <- H.leftFail $ assertErasEqual sbe sbe'
-  pure $ fromLedgerUTxO $ newEpochState ^. L.nesEsL . L.esLStateL . L.lsUTxOStateL . L.utxosUtxoL
+  pure $ fromLedgerUTxO' $ newEpochState ^. L.nesEsL . L.esLStateL . L.lsUTxOStateL . L.utxosUtxoL
   where
-    fromLedgerUTxO
+    fromLedgerUTxO'
       :: ()
       => L.UTxO (ShelleyLedgerEra era)
       -> Map TxIn (TxOut CtxUTxO era)
-    fromLedgerUTxO (L.UTxO utxo) =
+    fromLedgerUTxO' (L.UTxO utxo) =
       shelleyBasedEraConstraints sbe
         $ Map.fromList
         . map (bimap fromShelleyTxIn (fromShelleyTxOut sbe))