tx-generator updates for Babbage

sized Metadate : tests for Alonzo & Babbage
rebase on #3818 and reuse code from Cardano.Api.InMode
fixes in SubmissionClient
workbench:  add babbage era

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs

@@ -26,21 +26,25 @@ assume_cbor_properties
     && prop_mapCostsAllegra
     && prop_mapCostsMary
     && prop_mapCostsAlonzo
+    && prop_mapCostsBabbage
     && prop_bsCostsShelley
     && prop_bsCostsAllegra
     && prop_bsCostsMary
     && prop_bsCostsAlonzo
+    && prop_bsCostsBabbage
 
 -- The cost of map entries in metadata follows a step function.
 -- This assumes the map indices are [0..n].
 prop_mapCostsShelley :: Bool
 prop_mapCostsAllegra :: Bool
 prop_mapCostsMary    :: Bool
 prop_mapCostsAlonzo  :: Bool
-prop_mapCostsShelley = measureMapCosts AsShelleyEra == assumeMapCosts AsShelleyEra
-prop_mapCostsAllegra = measureMapCosts AsAllegraEra == assumeMapCosts AsAllegraEra
-prop_mapCostsMary    = measureMapCosts AsMaryEra    == assumeMapCosts AsMaryEra
-prop_mapCostsAlonzo  = measureMapCosts AsAlonzoEra  == assumeMapCosts AsAlonzoEra
+prop_mapCostsBabbage :: Bool
+prop_mapCostsShelley = measureMapCosts AsShelleyEra   == assumeMapCosts AsShelleyEra
+prop_mapCostsAllegra = measureMapCosts AsAllegraEra   == assumeMapCosts AsAllegraEra
+prop_mapCostsMary    = measureMapCosts AsMaryEra      == assumeMapCosts AsMaryEra
+prop_mapCostsAlonzo  = measureMapCosts AsAlonzoEra    == assumeMapCosts AsAlonzoEra
+prop_mapCostsBabbage = measureMapCosts AsBabbageEra   == assumeMapCosts AsBabbageEra
 
 assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
 assumeMapCosts _proxy = stepFunction [
@@ -55,21 +59,21 @@ assumeMapCosts _proxy = stepFunction [
       ShelleyBasedEraShelley -> 37
       ShelleyBasedEraAllegra -> 39
       ShelleyBasedEraMary    -> 39
- -- Unconfirmed ! update when alonzo is runnable.
-      ShelleyBasedEraAlonzo  -> error "39"
-      ShelleyBasedEraBabbage -> error "39"
+      ShelleyBasedEraAlonzo  -> 42
+      ShelleyBasedEraBabbage -> 42
 
 -- Bytestring costs are not LINEAR !!
 -- Costs are piecewise linear for payload sizes [0..23] and [24..64].
 prop_bsCostsShelley  :: Bool
 prop_bsCostsAllegra :: Bool
 prop_bsCostsMary    :: Bool
 prop_bsCostsAlonzo  :: Bool
-prop_bsCostsShelley  = measureBSCosts AsShelleyEra == [37..60] ++ [62..102]
+prop_bsCostsBabbage   :: Bool
+prop_bsCostsShelley = measureBSCosts AsShelleyEra == [37..60] ++ [62..102]
 prop_bsCostsAllegra = measureBSCosts AsAllegraEra == [39..62] ++ [64..104]
 prop_bsCostsMary    = measureBSCosts AsMaryEra    == [39..62] ++ [64..104]
- -- Unconfirmed ! update when alonzo is runnable.
-prop_bsCostsAlonzo  = measureBSCosts AsAlonzoEra  == error "[39..62] ++ [64..104]"
+prop_bsCostsAlonzo  = measureBSCosts AsAlonzoEra  == [42..65] ++ [67..107]
+prop_bsCostsBabbage = measureBSCosts AsBabbageEra == [42..65] ++ [67..107]
 
 stepFunction :: [(Int, Int)] -> [Int]
 stepFunction f = scanl1 (+) steps

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs

@@ -23,7 +23,7 @@ module Cardano.Benchmarking.GeneratorTx.SubmissionClient
   , txSubmissionClient
   ) where
 
-import           Prelude (error, fail)
+import           Prelude (error,fail)
 import           Cardano.Prelude hiding (ByteString, atomically, retry, state, threadDelay)
 
 import           Control.Arrow ((&&&))
@@ -44,12 +44,10 @@ import           Cardano.Tracing.OrphanInstances.Shelley ()
 import qualified Ouroboros.Consensus.Cardano as Consensus (CardanoBlock)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTx, GenTxId, txInBlockSize)
 import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Mempool
-import           Ouroboros.Consensus.Shelley.Ledger.Mempool (mkShelleyTx)
 import qualified Ouroboros.Consensus.Shelley.Ledger.Mempool as Mempool (TxId(ShelleyTxId))
 import           Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
 
-import           Ouroboros.Consensus.Cardano.Block (GenTx (GenTxAllegra, GenTxAlonzo, GenTxShelley, GenTxMary))
-import qualified Ouroboros.Consensus.Cardano.Block as Block (TxId(GenTxIdShelley, GenTxIdAllegra, GenTxIdAlonzo, GenTxIdMary))
+import qualified Ouroboros.Consensus.Cardano.Block as Block (TxId(GenTxIdShelley, GenTxIdAllegra, GenTxIdAlonzo, GenTxIdMary,GenTxIdBabbage ))
 
 import           Ouroboros.Network.Protocol.TxSubmission2.Client (ClientStIdle (..),
                                                                   ClientStTxIds (..),
@@ -59,7 +57,8 @@ import           Ouroboros.Network.Protocol.TxSubmission2.Type (BlockingReplyLis
                                                                 TokBlockingStyle (..), TxSizeInBytes)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (Tx(ShelleyTx), fromShelleyTxId)
+import           Cardano.Api.InMode (toConsensusGenTx)
+import           Cardano.Api.Shelley (fromShelleyTxId)
 
 import           Cardano.Benchmarking.Tracer
 import           Cardano.Benchmarking.Types
@@ -191,19 +190,20 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   txToIdSize = (Mempool.txId &&& txInBlockSize) . toGenTx
 
   toGenTx :: tx -> GenTx CardanoBlock
-  toGenTx tx = case (shelleyBasedEra @ era , tx) of
-    (ShelleyBasedEraShelley, ShelleyTx _ tx') -> GenTxShelley (mkShelleyTx tx')
-    (ShelleyBasedEraAllegra, ShelleyTx _ tx') -> GenTxAllegra (mkShelleyTx tx')
-    (ShelleyBasedEraMary, ShelleyTx _ tx') -> GenTxMary (mkShelleyTx tx')
-    (ShelleyBasedEraAlonzo, ShelleyTx _ tx') -> GenTxAlonzo (mkShelleyTx tx')
-    (ShelleyBasedEraBabbage, ShelleyTx _ _tx') -> error "TODO:Babbage"
+  toGenTx tx = case shelleyBasedEra @ era of
+    ShelleyBasedEraShelley  -> toConsensusGenTx $ TxInMode tx ShelleyEraInCardanoMode
+    ShelleyBasedEraAllegra  -> toConsensusGenTx $ TxInMode tx AllegraEraInCardanoMode
+    ShelleyBasedEraMary     -> toConsensusGenTx $ TxInMode tx MaryEraInCardanoMode
+    ShelleyBasedEraAlonzo   -> toConsensusGenTx $ TxInMode tx AlonzoEraInCardanoMode
+    ShelleyBasedEraBabbage  -> toConsensusGenTx $ TxInMode tx BabbageEraInCardanoMode
 
   fromGenTxId :: GenTxId CardanoBlock -> TxId
   fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i
   fromGenTxId (Block.GenTxIdAllegra (Mempool.ShelleyTxId i)) = fromShelleyTxId i
   fromGenTxId (Block.GenTxIdMary    (Mempool.ShelleyTxId i)) = fromShelleyTxId i
   fromGenTxId (Block.GenTxIdAlonzo  (Mempool.ShelleyTxId i)) = fromShelleyTxId i
-  fromGenTxId _ = error "submission.hs: fromGenTxId"
+  fromGenTxId (Block.GenTxIdBabbage (Mempool.ShelleyTxId i)) = fromShelleyTxId i
+  fromGenTxId _ = error "TODO: fix incomplete match"
 
   tokIsBlocking :: TokBlockingStyle a -> Bool
   tokIsBlocking = \case

bench/tx-generator/test/Main.hs

@@ -18,11 +18,15 @@ tests =  testGroup "cardano-tx-generator"
   ]
 
 sizedMetadata = testGroup "properties of the CBOR encoding relevant for generating sized metadat"
-  [ testCase "Shelley metadata map costs" $ assertBool "metadata map costs" prop_mapCostsShelley
-  , testCase "Shelley metadata ByteString costs" $ assertBool "metadata ByteString costs" prop_bsCostsShelley
-  , testCase "Allegra metadata map costs" $ assertBool "metadata map costs" prop_mapCostsAllegra
-  , testCase "Allegra metadata ByteString costs" $ assertBool "metadata ByteString costs" prop_bsCostsAllegra
-  , testCase "Mary metadata map costs"    $ assertBool "metadata map costs" prop_mapCostsMary
-  , testCase "Marymetadata ByteString costs"    $ assertBool "metadata ByteString costs" prop_bsCostsMary
+  [ testCase "Shelley metadata map costs"          $ assertBool "metadata map costs" prop_mapCostsShelley
+  , testCase "Shelley metadata ByteString costs"   $ assertBool "metadata ByteString costs" prop_bsCostsShelley
+  , testCase "Allegra metadata map costs"          $ assertBool "metadata map costs" prop_mapCostsAllegra
+  , testCase "Allegra metadata ByteString costs"   $ assertBool "metadata ByteString costs" prop_bsCostsAllegra
+  , testCase "Mary metadata map costs"             $ assertBool "metadata map costs" prop_mapCostsMary
+  , testCase "Mary metadata ByteString costs"      $ assertBool "metadata ByteString costs" prop_bsCostsMary
+  , testCase "Alonzo metadata map costs"           $ assertBool "metadata map costs" prop_mapCostsAlonzo
+  , testCase "Alonzo metadata ByteString costs"    $ assertBool "metadata ByteString costs" prop_bsCostsAlonzo
+  , testCase "Babbage metadata map costs"           $ assertBool "metadata map costs" prop_mapCostsBabbage
+  , testCase "Babbage metadata ByteString costs"    $ assertBool "metadata ByteString costs" prop_bsCostsBabbage
   , testCase "Test mkMetadata" $ assertBool "" True --WIP
   ]

bench/tx-generator/tx-generator.cabal

@@ -1,5 +1,5 @@
 name:                  tx-generator
-version:               2.0
+version:               2.1
 description:           The transaction generator for cardano node
 author:                IOHK
 maintainer:            [email protected]

cabal.project

@@ -130,6 +130,9 @@ package small-steps
 package small-steps-test
   tests: False
 
+package tx-generator
+  tests: True
+
 package goblins
   tests: False
 

cardano-api/cardano-api.cabal

@@ -47,6 +47,7 @@ library
                         -- in this module
                         Cardano.Api.Orphans
                         Cardano.Api.SerialiseTextEnvelope
+                        Cardano.Api.InMode
 
   other-modules:
                         -- Splitting up the big Typed module:
@@ -86,7 +87,6 @@ library
                         Cardano.Api.StakePoolMetadata
                         Cardano.Api.Tx
                         Cardano.Api.TxBody
-                        Cardano.Api.InMode
                         Cardano.Api.TxMetadata
                         Cardano.Api.TxSubmit.ErrorRender
                         Cardano.Api.TxSubmit.Types