Merge remote-tracking branch 'origin/bolt12/tx-submission' into mwojt…

…owicz/genesis-ledger-peer-snapshot

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/SubmissionClient.hs

@@ -11,8 +11,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
@@ -26,10 +24,11 @@ module Cardano.Benchmarking.GeneratorTx.SubmissionClient
   ) where
 
 import           Cardano.Api hiding (Active)
-import           Cardano.Api.Shelley (fromShelleyTxId, toConsensusGenTx)
+import           Cardano.Api.Shelley (Tx (..), fromShelleyTxId, toConsensusGenTx)
 
 import           Cardano.Benchmarking.LogTypes
 import           Cardano.Benchmarking.Types
+import           Cardano.Ledger.Core (sizeTxF)
 import           Cardano.Logging
 import           Cardano.Prelude hiding (ByteString, atomically, retry, state, threadDelay)
 import           Cardano.Tracing.OrphanInstances.Byron ()
@@ -40,7 +39,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))
@@ -57,6 +56,8 @@ import qualified Data.List as L
 import qualified Data.List.Extra as L
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
+import           Lens.Micro.Extras (view)
+
 type CardanoBlock    = Consensus.CardanoBlock  StandardCrypto
 
 data SubmissionThreadStats
@@ -85,10 +86,9 @@ type LocalState era = (TxSource era, UnAcked (Tx era), SubmissionThreadStats)
 type EndOfProtocolCallback m = SubmissionThreadStats -> m ()
 
 txSubmissionClient
-  :: forall m era tx.
+  :: forall m era .
      ( MonadIO m, MonadFail m
      , IsShelleyBasedEra era
-     , tx      ~ Tx era
      )
   => Trace m NodeToNodeSubmissionTrace
   -> Trace m (TraceBenchTxSubmit TxId)
@@ -110,11 +110,11 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
     traceWith bmtr $ SubmissionClientDiscardAcknowledged  (getTxId . getTxBody <$> acked)
     return (txSource, UnAcked stillUnacked, newStats)
 
-  queueNewTxs :: [tx] -> LocalState era -> LocalState era
+  queueNewTxs :: [Tx era] -> LocalState era -> LocalState era
   queueNewTxs newTxs (txSource, UnAcked unAcked, stats)
     = (txSource, UnAcked (newTxs <> unAcked), stats)
 
-  client ::LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()
+  client :: LocalState era -> ClientStIdle (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()
 
   client localState = ClientStIdle
     { recvMsgRequestTxIds = requestTxIds localState
@@ -177,11 +177,15 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
               , stsUnavailable =
                 stsUnavailable stats + Unav (length missIds)}))
 
-  txToIdSize :: tx -> (GenTxId CardanoBlock, SizeInBytes)
-  txToIdSize = (Mempool.txId &&& (SizeInBytes . txInBlockSize)) . toGenTx
+  txToIdSize :: Tx era -> (GenTxId CardanoBlock, SizeInBytes)
+  txToIdSize = (Mempool.txId . toGenTx) &&& (SizeInBytes . fromInteger . getTxSize)
+    where
+      getTxSize :: Tx era -> Integer
+      getTxSize (ShelleyTx sbe tx) =
+        shelleyBasedEraConstraints sbe $ view sizeTxF tx
 
-  toGenTx :: tx -> GenTx CardanoBlock
-  toGenTx tx = toConsensusGenTx $ TxInMode (shelleyBasedEra @era) tx
+  toGenTx :: Tx era -> GenTx CardanoBlock
+  toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx
 
 
   fromGenTxId :: GenTxId CardanoBlock -> TxId

bench/tx-generator/tx-generator.cabal

@@ -157,6 +157,7 @@ library
                       , transformers-except
                       , unordered-containers
                       , yaml
+                      , microlens
 
   default-language:     Haskell2010
   default-extensions:   OverloadedStrings

cabal.project

@@ -67,3 +67,32 @@ allow-newer:
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-network
+  tag: 1070ab4afc337bf2718e270768e24f263061554a
+  --sha256: sha256-ITwg+Hpw4MsoeYhXpe7rE6wDniOElOFxkKgnktKWMdo=
+  subdir:
+    cardano-client
+    cardano-ping
+    monoidal-synchronisation
+    network-mux
+    ntp-client
+    ouroboros-network-api
+    ouroboros-network-framework
+    ouroboros-network-mock
+    ouroboros-network-protocols
+    ouroboros-network-testing
+    ouroboros-network
+    quickcheck-monoids
+
+source-repository-package
+  type: git
+  location: https://github.com/IntersectMBO/ouroboros-consensus
+  tag: 35adef5a76b285029762a4013059c1b430604e9c
+  --sha256: sha256-FKCY2nFZyXnBR3Wkn80HXipiKlbyDOohU++aRBAq3fA=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-cardano
+    ouroboros-consensus-diffusion
+    ouroboros-consensus-protocol

cardano-node/src/Cardano/Node/Configuration/POM.hs

@@ -38,6 +38,7 @@ import qualified Ouroboros.Consensus.Node as Consensus (NetworkP2PMode (..))
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..),
                    SnapshotInterval (..))
 import           Ouroboros.Network.Diffusion.Configuration as Configuration
+import           Ouroboros.Network.TxSubmission.Inbound.Server (EnableNewTxSubmissionProtocol (..))
 
 import           Control.Monad (when)
 import           Data.Aeson
@@ -148,6 +149,13 @@ data NodeConfiguration
          -- | Node AcceptedConnectionsLimit
        , ncAcceptedConnectionsLimit :: !AcceptedConnectionsLimit
 
+         -- Used to determine which set of peer targets to use
+         -- by the diffusion layer when syncing
+       , ncConsensusMode :: !ConsensusMode
+         -- Minimum number of active big ledger peers we must be connected to
+         -- in Genesis mode
+       , ncMinBigLedgerPeersForTrustedState :: MinBigLedgerPeersForTrustedState
+
          -- P2P governor targets
        , ncDeadlineTargetOfRootPeers        :: !Int
        , ncDeadlineTargetOfKnownPeers       :: !Int
@@ -160,17 +168,15 @@ data NodeConfiguration
        , ncSyncTargetOfKnownBigLedgerPeers       :: !Int
        , ncSyncTargetOfEstablishedBigLedgerPeers :: !Int
        , ncSyncTargetOfActiveBigLedgerPeers      :: !Int
-       , ncSyncMinTrusted :: !MinBigLedgerPeersForTrustedState
-
-         -- Used to determine which set of peer targets to use
-         -- by the diffusion layer when syncing
-       , ncConsensusMode :: !ConsensusMode
 
          -- Enable experimental P2P mode
        , ncEnableP2P :: SomeNetworkP2PMode
 
          -- Enable Peer Sharing
        , ncPeerSharing :: PeerSharing
+
+         -- Enable new TX Submission Protocol
+       , ncEnableNewTxSubmissionProtocol :: EnableNewTxSubmissionProtocol
        } deriving (Eq, Show)
 
 
@@ -220,6 +226,12 @@ data PartialNodeConfiguration
          -- AcceptedConnectionsLimit
        , pncAcceptedConnectionsLimit :: !(Last AcceptedConnectionsLimit)
 
+         -- Consensus mode for diffusion layer
+       , pncConsensusMode :: !(Last ConsensusMode)
+         -- Minimum number of active big ledger peers we must be connected to
+         -- in Genesis mode, otherwise syncing is halted temporarily
+       , pncMinBigLedgerPeersForTrustedState :: !(Last MinBigLedgerPeersForTrustedState)
+
          -- P2P governor targets
        , pncDeadlineTargetOfRootPeers        :: !(Last Int)
        , pncDeadlineTargetOfKnownPeers       :: !(Last Int)
@@ -232,16 +244,15 @@ data PartialNodeConfiguration
        , pncSyncTargetOfKnownBigLedgerPeers       :: !(Last Int)
        , pncSyncTargetOfEstablishedBigLedgerPeers :: !(Last Int)
        , pncSyncTargetOfActiveBigLedgerPeers      :: !(Last Int)
-       , pncSyncMinTrusted :: !(Last MinBigLedgerPeersForTrustedState)
-
-         -- Consensus mode for diffusion layer
-       , pncConsensusMode :: !(Last ConsensusMode)
 
          -- Enable experimental P2P mode
        , pncEnableP2P :: !(Last NetworkP2PMode)
 
          -- Peer Sharing
        , pncPeerSharing :: !(Last PeerSharing)
+
+         -- Enable new TX Submission Protocol
+       , pncEnableNewTxSubmissionProtocol :: !(Last EnableNewTxSubmissionProtocol)
        } deriving (Eq, Generic, Show)
 
 instance AdjustFilePaths PartialNodeConfiguration where
@@ -316,6 +327,8 @@ instance FromJSON PartialNodeConfiguration where
       pncAcceptedConnectionsLimit
         <- Last <$> v .:? "AcceptedConnectionsLimit"
 
+      pncConsensusMode <- Last <$> v .:? "ConsensusMode"
+
       -- P2P Governor parameters, with conservative defaults.
       pncDeadlineTargetOfRootPeers        <- Last <$> v .:? "TargetNumberOfRootPeers"
       pncDeadlineTargetOfKnownPeers       <- Last <$> v .:? "TargetNumberOfKnownPeers"
@@ -328,9 +341,7 @@ instance FromJSON PartialNodeConfiguration where
       pncSyncTargetOfKnownBigLedgerPeers       <- Last <$> v .:? "SyncTargetNumberOfKnownBigLedgerPeers"
       pncSyncTargetOfEstablishedBigLedgerPeers <- Last <$> v .:? "SyncTargetNumberOfEstablishedBigLedgerPeers"
       pncSyncTargetOfActiveBigLedgerPeers      <- Last <$> v .:? "SyncTargetNumberOfActiveBigLedgerPeers"
-      pncSyncMinTrusted <- Last <$> v .:? "SyncMinNumberOfBigLedgerPeersForTrustedState"
-
-      pncConsensusMode <- Last <$> v .:? "ConsensusMode"
+      pncMinBigLedgerPeersForTrustedState <- Last <$> v .:? "MinBigLedgerPeersForTrustedState"
 
       pncChainSyncIdleTimeout      <- Last <$> v .:? "ChainSyncIdleTimeout"
 
@@ -346,6 +357,14 @@ instance FromJSON PartialNodeConfiguration where
       -- DISABLED BY DEFAULT
       pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just Configuration.PeerSharingDisabled
 
+      -- Enable new TX Submission Protocol
+      newTxSubmissionProtocol <- v .:? "EnableNewTxSubmissionProtocol"
+      let pncEnableNewTxSubmissionProtocol =
+            case newTxSubmissionProtocol of
+              Nothing -> Last $ Just EnableNewTxSubmissionProtocol -- defaultEnableNewTxSubmissionProtocol
+              Just False -> Last $ Just DisableNewTxSubmissionProtocol
+              Just True -> Last $ Just EnableNewTxSubmissionProtocol
+
       pure PartialNodeConfiguration {
              pncProtocolConfig
            , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath
@@ -382,10 +401,11 @@ instance FromJSON PartialNodeConfiguration where
            , pncSyncTargetOfKnownBigLedgerPeers
            , pncSyncTargetOfEstablishedBigLedgerPeers
            , pncSyncTargetOfActiveBigLedgerPeers
-           , pncSyncMinTrusted
+           , pncMinBigLedgerPeersForTrustedState
            , pncConsensusMode
            , pncEnableP2P
            , pncPeerSharing
+           , pncEnableNewTxSubmissionProtocol
            }
     where
       parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride
@@ -564,10 +584,11 @@ defaultPartialNodeConfiguration =
     , pncSyncTargetOfKnownBigLedgerPeers       = Last (Just syncBigKnown)
     , pncSyncTargetOfEstablishedBigLedgerPeers = Last (Just syncBigEst)
     , pncSyncTargetOfActiveBigLedgerPeers      = Last (Just syncBigAct)
-    , pncSyncMinTrusted = Last (Just defaultMinBigLedgerPeersForTrustedState)
+    , pncMinBigLedgerPeersForTrustedState = Last (Just defaultMinBigLedgerPeersForTrustedState)
     , pncConsensusMode = mempty
     , pncEnableP2P     = Last (Just EnabledP2PMode)
     , pncPeerSharing   = Last (Just Configuration.PeerSharingDisabled)
+    , pncEnableNewTxSubmissionProtocol  = Last (Just EnableNewTxSubmissionProtocol) -- defaultEnableNewTxSubmissionProtocol)
     }
   where
     Configuration.PeerSelectionTargets {
@@ -637,9 +658,9 @@ makeNodeConfiguration pnc = do
   ncSyncTargetOfActiveBigLedgerPeers <-
     lastToEither "Missing SyncTargetNumberOfActiveBigLedgerPeers"
     $ pncSyncTargetOfActiveBigLedgerPeers pnc
-  ncSyncMinTrusted <-
-    lastToEither "Missing SyncMinNumberOfBigLedgerPeersForTrustedState"
-    $ pncSyncMinTrusted pnc
+  ncMinBigLedgerPeersForTrustedState <- 
+    lastToEither "Missing MinBigLedgerPeersForTrustedState"
+    $ pncMinBigLedgerPeersForTrustedState pnc
   ncConsensusMode <-
     lastToEither "Missing ConsensusMode"
     $ pncConsensusMode pnc
@@ -665,6 +686,10 @@ makeNodeConfiguration pnc = do
     lastToEither "Missing PeerSharing"
     $ pncPeerSharing pnc
 
+  ncEnableNewTxSubmissionProtocol <-
+    lastToEither "Missing EnableNewTxSubmissionProtocol"
+    $ pncEnableNewTxSubmissionProtocol pnc
+
   -- TODO: This is not mandatory
   experimentalProtocols <-
     lastToEither "Missing ExperimentalProtocolsEnabled" $
@@ -712,12 +737,13 @@ makeNodeConfiguration pnc = do
              , ncSyncTargetOfKnownBigLedgerPeers
              , ncSyncTargetOfEstablishedBigLedgerPeers
              , ncSyncTargetOfActiveBigLedgerPeers
-             , ncSyncMinTrusted
+             , ncMinBigLedgerPeersForTrustedState
              , ncEnableP2P = case enableP2P of
                  EnabledP2PMode  -> SomeNetworkP2PMode Consensus.EnabledP2PMode
                  DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode
              , ncPeerSharing
              , ncConsensusMode
+             , ncEnableNewTxSubmissionProtocol
              }
 
 ncProtocol :: NodeConfiguration -> Protocol

cardano-node/src/Cardano/Node/Parsers.hs

@@ -20,7 +20,7 @@ import           Cardano.Node.Configuration.Socket
 import           Cardano.Node.Handlers.Shutdown
 import           Cardano.Node.Types
 import           Cardano.Prelude (ConvertText (..))
-import           Ouroboros.Consensus.Mempool (MempoolCapacityBytes (..))
+import           Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..))
 import           Ouroboros.Consensus.Node
 import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy (NumOfDiskSnapshots (..),
                    SnapshotInterval (..))
@@ -132,6 +132,9 @@ nodeRunParser = do
            , pncConsensusMode = mempty
            , pncEnableP2P = mempty
            , pncPeerSharing = mempty
+           , pncConsensusMode = mempty
+           , pncMinBigLedgerPeersForTrustedState = mempty
+           , pncEnableNewTxSubmissionProtocol = mempty
            }
 
 parseSocketPath :: Text -> Parser SocketPath
@@ -217,7 +220,7 @@ parseMempoolCapacityOverride = parseOverride <|> parseNoOverride
   where
     parseOverride :: Parser MempoolCapacityBytesOverride
     parseOverride =
-      MempoolCapacityBytesOverride . MempoolCapacityBytes <$>
+      MempoolCapacityBytesOverride . ByteSize32 <$>
       Opt.option (auto @Word32)
         (  long "mempool-capacity-override"
         <> metavar "BYTES"

cardano-node/src/Cardano/Node/Protocol/Types.hs

@@ -16,6 +16,7 @@ import qualified Cardano.Api as Api
 import           Cardano.Node.Orphans ()
 import           Cardano.Node.Queries (HasKESInfo, HasKESMetricsData)
 import           Cardano.Node.TraceConstraints (TraceConstraints)
+import           Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
 
 import           Control.DeepSeq (NFData)
 import           Data.Aeson
@@ -45,6 +46,7 @@ data SomeConsensusProtocol where
                                           , HasKESMetricsData blk
                                           , HasKESInfo blk
                                           , TraceConstraints blk
+                                          , ToJSONKey (GenTxId blk)
                                           )
                            => Api.BlockType blk
                            -> Api.ProtocolInfoArgs blk