Merge #3824 #3880

3824: tx-generator: fix for Babbage r=deepfire a=MarcFontaine



3880: Old peers tracing was erroneously called in new tracing r=deepfire a=jutaro

/nix/store/qaplqccmisqy8n7ai65nssafzkxyyc7p-cabal-install-exe-cabal-3.6.2.0/bin/cabal --project-file=/home/deepfire/cardano-node/.nix-shell-cabal.project run exe:cardano-node -- +RTS -sghc-rts-report.txt -RTS run --config config.json --database-path run/current/node-0/db-testnet --topology topology.json --host-addr 127.0.0.1 --port 30000 --socket-path node.socket +RTS -N2 -I0 -A16m -qg -qb --disable-delayed-os-memory-return -RTS
cardano-node: ExceptionInLinkedThread (ThreadId 11) The name ""peersFromNodeKernel"" is already taken by a metric.
CallStack (from HasCallStack):
  error, called at ./System/Metrics.hs:214:5 in ekg-core-0.1.1.7-FjoslY1tzknIAl90c73kOZ:System.Metrics

Co-authored-by: MarcFontaine <MarcFontaine@users.noreply.github.com>
Co-authored-by: Kosyrev Serge <serge.kosyrev@iohk.io>
Co-authored-by: Yupanqui <jnf@arcor.de>

CODEOWNERS

@@ -26,7 +26,8 @@ nix/workbench                                                 @deepfire @denissh
 trace-dispatcher                                              @deepfire @denisshevchenko @jutaro @mgmeier
 trace-forward                                                 @deepfire @denisshevchenko @jutaro @mgmeier
 trace-resources                                               @deepfire @denisshevchenko @jutaro @mgmeier
-Makefile                                                      @deepfire
+Makefile                                                      @deepfire @mgmeier
+*.mk                                                          @deepfire @mgmeier
 
 .buildkite                                                    @devops
 .github                                                       @devops

Makefile

@@ -8,8 +8,8 @@ include legacy.mk
 PROJECT_NAME = cardano-node
 NUM_PROC     = $(nproc --all)
 
-## One of:  shey alra mary alzo
-ERA     ?= alzo
+## One of:  shey alra mary alzo bage
+ERA     ?= bage
 
 PROFILE ?= default-${ERA}
 REV     ?= master
@@ -53,18 +53,29 @@ ps:                                              ## Plain-text list of profiles
 ##
 ## Profile-based cluster shells (autogenerated targets)
 ##
-SHELL_PROFILES += startstop startstop-tracer startstop-oldtracing
-SHELL_PROFILES += smoke 10 10-tracer plutus
-
-SHELL_PROFILES += forge-stress forge-stress-plutus forge-stress-tracer forge-stress-oldtracing
-
-SHELL_PROFILES += chainsync-early-byron  chainsync-early-byron-tracer  chainsync-early-byron-oldtracing
-SHELL_PROFILES += chainsync-early-alonzo chainsync-early-alonzo-tracer chainsync-early-alonzo-oldtracing
+PROFILES_BASE         := default plutus
+PROFILES_STARTSTOP    := startstop startstop-p2p startstop-plutus startstop-tracer startstop-oldtracing
+PROFILES_CI_TEST      := ci-test ci-test-p2p ci-test-plutus ci-test-tracer
+PROFILES_CI_BENCH     := ci-bench ci-bench-p2p ci-bench-plutus ci-bench-tracer
+PROFILES_10           := 10 10-p2p 10-plutus 10-tracer
+PROFILES_FORGE_STRESS := forge-stress forge-stress-p2p forge-stress-plutus forge-stress-plutus-singleton forge-stress-tracer
+PROFILES_CHAINSYNC    := chainsync-early-byron  chainsync-early-byron-tracer  chainsync-early-byron-oldtracing
+PROFILES_CHAINSYNC    += chainsync-early-alonzo chainsync-early-alonzo-tracer chainsync-early-alonzo-oldtracing chainsync-early-alonzo-p2p
+
+SHELL_PROFILES += $(PROFILES_BASE)
+SHELL_PROFILES += $(PROFILES_STARTSTOP)
+SHELL_PROFILES += $(PROFILES_CI_TEST)
+SHELL_PROFILES += $(PROFILES_CI_BENCH)
+SHELL_PROFILES += $(PROFILES_10)
+SHELL_PROFILES += $(PROFILES_FORGE_STRESS)
+SHELL_PROFILES += $(PROFILES_CHAINSYNC)
 
 ## Note:  to enable a shell for a profile, just add its name (one of names from 'make ps') to SHELL_PROFILES
 
 $(eval $(call define_profile_targets,$(SHELL_PROFILES)))
 
+workbench-ci-test:  $(foreach x,$(PROFILES_CI_TEST),${x}-autonix)
+workbench-ci-bench: $(foreach x,$(PROFILES_CI_BENCH),${x}-autonix)
 
 ###
 ### Misc
@@ -81,4 +92,4 @@ full-clean: clean
 cls:
 	echo -en "\ec"
 
-.PHONY: cabal-hashes clean cli cls cluster-profiles cluster-shell help node run-test shell shell-dev stylish-haskell
+.PHONY: cabal-hashes clean cli cls cluster-profiles cluster-shell help node run-test shell shell-dev stylish-haskell $(SHELL_PROFILES) workbench-ci-test workbench-ci-bench

bench/locli/src/Cardano/Analysis/Context.hs

@@ -48,7 +48,7 @@ data GeneratorProfile
   { add_tx_size     :: Word64
   , inputs_per_tx   :: Word64
   , outputs_per_tx  :: Word64
-  , tps             :: Word64
+  , tps             :: Double
   , tx_count        :: Word64
   }
   deriving (Generic, Show, FromJSON, ToJSON)

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

@@ -88,7 +88,7 @@ benchmarkConnectTxSubmit ioManager handshakeTracer submissionTracer codecConfig
       foldMap (\p -> p connId controlMessageSTM) bundle
 
   n2nVer :: NodeToNodeVersion
-  n2nVer = NodeToNodeV_7
+  n2nVer = NodeToNodeV_10
   blkN2nVer :: BlockNodeToNodeVersion blk
   blkN2nVer = supportedVers Map.! n2nVer
   supportedVers :: Map.Map NodeToNodeVersion (BlockNodeToNodeVersion blk)

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
@@ -126,12 +130,9 @@ dummyTxSize _p m = (dummyTxSizeInEra @ era) $ metadataInEra m
 
 metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era
 metadataInEra Nothing = TxMetadataNone
-metadataInEra (Just m) = case shelleyBasedEra @ era of
-  ShelleyBasedEraShelley -> TxMetadataInEra TxMetadataInShelleyEra m
-  ShelleyBasedEraAllegra -> TxMetadataInEra TxMetadataInAllegraEra m
-  ShelleyBasedEraMary    -> TxMetadataInEra TxMetadataInMaryEra m
-  ShelleyBasedEraAlonzo  -> TxMetadataInEra TxMetadataInAlonzoEra m
-  ShelleyBasedEraBabbage -> TxMetadataInEra TxMetadataInBabbageEra m
+metadataInEra (Just m) = case txMetadataSupportedInEra (cardanoEra @ era) of
+  Nothing -> error "unreachable"
+  Just e -> TxMetadataInEra e m
 
 mkMetadata :: forall era . IsShelleyBasedEra era => Int -> Either String (TxMetadataInEra era)
 mkMetadata 0 = Right $ metadataInEra Nothing

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,7 @@ import           Ouroboros.Network.Protocol.TxSubmission2.Type (BlockingReplyLis
                                                                 TokBlockingStyle (..), TxSizeInBytes)
 
 import           Cardano.Api
-import           Cardano.Api.Shelley (Tx(ShelleyTx), fromShelleyTxId)
+import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx)
 
 import           Cardano.Benchmarking.Tracer
 import           Cardano.Benchmarking.Types
@@ -191,19 +189,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/src/Cardano/Benchmarking/GeneratorTx/Tx.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -23,7 +24,7 @@ where
 import           Prelude
 import           Cardano.Benchmarking.Types (TxAdditionalSize (..))
 
-import           Cardano.Api hiding (txOutValueToLovelace)
+import           Cardano.Api
 
 type Fund = (TxIn, InAnyCardanoEra TxOutValue)
 
@@ -63,7 +64,7 @@ mkGenesisTransaction key _payloadSize ttl fee txins txouts
     , txInsCollateral = TxInsCollateralNone
     , txInsReference = TxInsReferenceNone
     , txOuts = txouts
-    , txFee = fees
+    , txFee = mkFee fee
     , txValidityRange = (TxValidityNoLowerBound, validityUpperBound)
     , txMetadata = TxMetadataNone
     , txAuxScripts = TxAuxScriptsNone
@@ -77,12 +78,6 @@ mkGenesisTransaction key _payloadSize ttl fee txins txouts
     , txReturnCollateral = TxReturnCollateralNone
     , txTotalCollateral = TxTotalCollateralNone
     }
-  fees = case shelleyBasedEra @ era of
-    ShelleyBasedEraShelley -> TxFeeExplicit TxFeesExplicitInShelleyEra fee
-    ShelleyBasedEraAllegra -> TxFeeExplicit TxFeesExplicitInAllegraEra fee
-    ShelleyBasedEraMary    -> TxFeeExplicit TxFeesExplicitInMaryEra fee
-    ShelleyBasedEraAlonzo  -> TxFeeExplicit TxFeesExplicitInAlonzoEra fee
-    ShelleyBasedEraBabbage -> TxFeeExplicit TxFeesExplicitInBabbageEra fee
   validityUpperBound = case shelleyBasedEra @ era of
     ShelleyBasedEraShelley -> TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl
     ShelleyBasedEraAllegra -> TxValidityUpperBound ValidityUpperBoundInAllegraEra ttl
@@ -94,45 +89,24 @@ mkFee :: forall era .
      IsShelleyBasedEra era
   => Lovelace
   -> TxFee era
-mkFee f = case shelleyBasedEra @ era of
-  ShelleyBasedEraShelley -> TxFeeExplicit TxFeesExplicitInShelleyEra f
-  ShelleyBasedEraAllegra -> TxFeeExplicit TxFeesExplicitInAllegraEra f
-  ShelleyBasedEraMary    -> TxFeeExplicit TxFeesExplicitInMaryEra f
-  ShelleyBasedEraAlonzo  -> TxFeeExplicit TxFeesExplicitInAlonzoEra f
-  ShelleyBasedEraBabbage -> TxFeeExplicit TxFeesExplicitInBabbageEra f
+mkFee f = case txFeesExplicitInEra (cardanoEra @ era) of
+    Right e -> TxFeeExplicit e f
+    Left b -> TxFeeImplicit b -- error "unreachable"
 
 mkValidityUpperBound :: forall era .
      IsShelleyBasedEra era
   => SlotNo
   -> TxValidityUpperBound era
-mkValidityUpperBound ttl = case shelleyBasedEra @ era of
-  ShelleyBasedEraShelley -> TxValidityUpperBound ValidityUpperBoundInShelleyEra ttl
-  ShelleyBasedEraAllegra -> TxValidityUpperBound ValidityUpperBoundInAllegraEra ttl
-  ShelleyBasedEraMary    -> TxValidityUpperBound ValidityUpperBoundInMaryEra ttl
-  ShelleyBasedEraAlonzo  -> TxValidityUpperBound ValidityUpperBoundInAlonzoEra ttl
-  ShelleyBasedEraBabbage -> TxValidityUpperBound ValidityUpperBoundInBabbageEra ttl
+mkValidityUpperBound ttl = case validityUpperBoundSupportedInEra (cardanoEra @ era) of
+  Just p -> TxValidityUpperBound p ttl
+  Nothing -> error "unreachable"
 
 mkTxOutValueAdaOnly :: forall era . IsShelleyBasedEra era => Lovelace -> TxOutValue era
-mkTxOutValueAdaOnly l = case shelleyBasedEra @ era of
-  ShelleyBasedEraShelley -> TxOutAdaOnly AdaOnlyInShelleyEra l
-  ShelleyBasedEraAllegra -> TxOutAdaOnly AdaOnlyInAllegraEra l
-  ShelleyBasedEraMary    -> TxOutValue MultiAssetInMaryEra $ lovelaceToValue l
-  ShelleyBasedEraAlonzo  -> TxOutValue MultiAssetInAlonzoEra $ lovelaceToValue l
-  ShelleyBasedEraBabbage -> TxOutValue MultiAssetInBabbageEra $ lovelaceToValue l
-
-txOutValueToLovelace :: TxOutValue era -> Lovelace
-txOutValueToLovelace = \case
-  TxOutAdaOnly AdaOnlyInByronEra   x -> x
-  TxOutAdaOnly AdaOnlyInShelleyEra x -> x
-  TxOutAdaOnly AdaOnlyInAllegraEra x -> x
-  TxOutValue _ v -> case valueToLovelace v of
-    Just c -> c
-    Nothing -> error "txOutValueLovelace  TxOut contains no ADA"
+mkTxOutValueAdaOnly l = case multiAssetSupportedInEra (cardanoEra @ era) of
+  Right p -> TxOutValue p $ lovelaceToValue l
+  Left p -> TxOutAdaOnly p l
 
 txInModeCardano :: forall era . IsShelleyBasedEra era => Tx era -> TxInMode CardanoMode
-txInModeCardano tx = case shelleyBasedEra @ era of
-  ShelleyBasedEraShelley -> TxInMode tx ShelleyEraInCardanoMode
-  ShelleyBasedEraAllegra -> TxInMode tx AllegraEraInCardanoMode
-  ShelleyBasedEraMary    -> TxInMode tx MaryEraInCardanoMode
-  ShelleyBasedEraAlonzo  -> TxInMode tx AlonzoEraInCardanoMode
-  ShelleyBasedEraBabbage -> TxInMode tx BabbageEraInCardanoMode
+txInModeCardano tx = case toEraInMode (cardanoEra @ era) CardanoMode of
+  Just t -> TxInMode tx t
+  Nothing -> error "txInModeCardano :unreachable"