Dynamic block forging for the P2P mode

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

@@ -1,6 +1,7 @@
 {- HLINT ignore "Eta reduce" -}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Benchmarking.OuroborosImports
   (
@@ -44,8 +45,8 @@ import           Cardano.Ledger.Shelley.Genesis (ShelleyGenesis)
 
 type CardanoBlock = Consensus.CardanoBlock StandardCrypto
 
-toProtocolInfo :: SomeConsensusProtocol -> ProtocolInfo IO CardanoBlock
-toProtocolInfo (SomeConsensusProtocol CardanoBlockType info) = protocolInfo info
+toProtocolInfo :: SomeConsensusProtocol -> ProtocolInfo CardanoBlock
+toProtocolInfo (SomeConsensusProtocol CardanoBlockType info) = fst $ protocolInfo @IO info
 toProtocolInfo _ = error "toProtocolInfo unknown protocol"
 
 protocolToTopLevelConfig :: SomeConsensusProtocol -> TopLevelConfig CardanoBlock

bench/tx-generator/tx-generator.cabal

@@ -97,7 +97,7 @@ library
                       , attoparsec
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 8.2
+                      , cardano-api ^>= 8.5
                       , cardano-binary
                       , cardano-cli ^>= 8.2
                       , cardano-crypto-class
@@ -193,7 +193,7 @@ test-suite tx-generator-apitest
                       , bytestring
                       , filepath
                       , optparse-applicative-fork
-                      , cardano-api ^>= 8.2
+                      , cardano-api ^>= 8.5
                       , cardano-cli ^>= 8.2
                       , cardano-node
                       , plutus-tx
@@ -209,7 +209,7 @@ test-suite tx-generator-apitest
                      , bytestring
                      , filepath
                      , optparse-applicative-fork
-                     , cardano-api ^>= 8.2
+                     , cardano-api ^>= 8.5
                      , cardano-cli ^>= 8.2
                      , cardano-node
                      , transformers

cabal.project

@@ -108,3 +108,39 @@ package snap-server
 -- 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/input-output-hk/cardano-cli
+  tag: 3fbf9e18a5c44043982b9382d357502d8fe5a78d
+  --sha256: sha256-Q1pXMt4P2QOTUjQIj3Y7sVHoLvxItklnhN9rhNRYyTc=
+  subdir:
+    cardano-cli
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/ouroboros-consensus
+  tag: d639fbdacaf9abd47db28250964d5168743b3520
+  --sha256: sha256-Um0QL6LGpTqyb5iW/VFRpQk+YgMVjcEHI2UQ+nqqbIo=
+  subdir:
+    ouroboros-consensus
+    ouroboros-consensus-diffusion
+    ouroboros-consensus-cardano
+    ouroboros-consensus-protocol
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/cardano-api
+  tag: a5aff8c19063f8679b757cdc15b44239065d5815
+  --sha256: sha256-GWrck5RLD3uP68uesrVh6bszyCJI2z+a09sTsbFzaUE=
+  subdir:
+    cardano-api
+
+-- Needed because consensus uses it
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/io-sim
+  tag: ec202298c420378ef90b3fc0126c39e0f52290a3
+  --sha256: 1p6pn83kwp66x2m0cw9a27blfcpmw0lrra72qd0pi5bj3v1bcrl9
+  subdir:
+    strict-mvar

cardano-node-chairman/app/Cardano/Chairman/Commands/Run.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Chairman.Commands.Run
   ( cmdRun
@@ -120,7 +121,7 @@ run RunOpts
 
   let (k , nId) = case p of
             SomeConsensusProtocol _ runP ->
-              let ProtocolInfo { pInfoConfig } = Api.protocolInfo runP
+              let ProtocolInfo { pInfoConfig } = fst $ Api.protocolInfo @IO runP
               in ( Consensus.configSecurityParam pInfoConfig
                  , fromNetworkMagic . getNetworkMagic $ Consensus.configBlock pInfoConfig
                  )

cardano-node/cardano-node.cabal

@@ -137,7 +137,7 @@ library
                       , async
                       , base16-bytestring
                       , bytestring
-                      , cardano-api ^>= 8.2
+                      , cardano-api ^>= 8.5
                       , cardano-crypto-class
                       , cardano-crypto-wrapper
                       , cardano-git-rev
@@ -234,7 +234,7 @@ test-suite cardano-node-test
                       , aeson >= 1.5.6.0
                       , bytestring
                       , cardano-crypto-class
-                      , cardano-api ^>= 8.2
+                      , cardano-api ^>= 8.5
                       , cardano-ledger-core
                       , cardano-node
                       , cardano-slotting >= 0.1

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

@@ -5,6 +5,7 @@
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Node.Configuration.Logging
   ( LoggingLayer (..)
@@ -329,7 +330,7 @@ nodeBasicInfo :: NodeConfiguration
               -> IO [LogObject Text]
 nodeBasicInfo nc (SomeConsensusProtocol whichP pForInfo) nodeStartTime' = do
   meta <- mkLOMeta Notice Public
-  let cfg = pInfoConfig $ Api.protocolInfo pForInfo
+  let cfg = pInfoConfig $ fst $ Api.protocolInfo @IO pForInfo
       protocolDependentItems =
         case whichP of
           Api.ByronBlockType ->

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

@@ -87,6 +87,8 @@ data NodeConfiguration
        , ncValidateDB      :: !Bool
        , ncShutdownConfig  :: !ShutdownConfig
 
+       , ncStartAsNonProducingNode :: !Bool
+
         -- Protocol-specific parameters:
        , ncProtocolConfig :: !NodeProtocolConfiguration
 
@@ -159,6 +161,8 @@ data PartialNodeConfiguration
        , pncValidateDB      :: !(Last Bool)
        , pncShutdownConfig  :: !(Last ShutdownConfig)
 
+       , pncStartAsNonProducingNode :: !(Last Bool)
+
          -- Protocol-specific parameters:
        , pncProtocolConfig :: !(Last NodeProtocolConfiguration)
 
@@ -309,6 +313,7 @@ instance FromJSON PartialNodeConfiguration where
            , pncProtocolFiles = mempty
            , pncValidateDB = mempty
            , pncShutdownConfig = mempty
+           , pncStartAsNonProducingNode = Last $ Just False
            , pncMaybeMempoolCapacityOverride
            , pncProtocolIdleTimeout
            , pncTimeWaitTimeout
@@ -466,6 +471,7 @@ defaultPartialNodeConfiguration =
     , pncProtocolFiles = mempty
     , pncValidateDB = Last $ Just False
     , pncShutdownConfig = Last . Just $ ShutdownConfig Nothing Nothing
+    , pncStartAsNonProducingNode = Last $ Just False
     , pncProtocolConfig = mempty
     , pncMaxConcurrencyBulkSync = mempty
     , pncMaxConcurrencyDeadline = mempty
@@ -500,6 +506,7 @@ makeNodeConfiguration pnc = do
   topologyFile <- lastToEither "Missing TopologyFile" $ pncTopologyFile pnc
   databaseFile <- lastToEither "Missing DatabaseFile" $ pncDatabaseFile pnc
   validateDB <- lastToEither "Missing ValidateDB" $ pncValidateDB pnc
+  startAsNonProducingNode <- lastToEither "Missing StartAsNonProducingNode" $ pncStartAsNonProducingNode pnc
   protocolConfig <- lastToEither "Missing ProtocolConfig" $ pncProtocolConfig pnc
   loggingSwitch <- lastToEither "Missing LoggingSwitch" $ pncLoggingSwitch pnc
   logMetrics <- lastToEither "Missing LogMetrics" $ pncLogMetrics pnc
@@ -555,6 +562,7 @@ makeNodeConfiguration pnc = do
                    Nothing -> ProtocolFilepaths Nothing Nothing Nothing Nothing Nothing Nothing
              , ncValidateDB = validateDB
              , ncShutdownConfig = shutdownConfig
+             , ncStartAsNonProducingNode = startAsNonProducingNode
              , ncProtocolConfig = protocolConfig
              , ncSocketConfig = socketConfig
              , ncDiffusionMode = diffusionMode

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

@@ -16,7 +16,6 @@ module Cardano.Node.Configuration.TopologyP2P
   , NodeHostIPv6Address(..)
   , NodeSetup(..)
   , PeerAdvertise(..)
-  , UseLedger(..)
   , nodeAddressToSockAddr
   , readTopologyFile
   , readTopologyFileOrError
@@ -27,7 +26,6 @@ where
 import           Control.Exception (IOException)
 import qualified Control.Exception as Exception
 import           Control.Exception.Base (Exception (..))
-import           Control.Monad (MonadPlus (..))
 import           Data.Aeson
 import           Data.Bifunctor (Bifunctor (..))
 import qualified Data.ByteString as BS
@@ -39,7 +37,6 @@ import           Data.Word (Word64)
 import           "contra-tracer" Control.Tracer (Tracer, traceWith)
 
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
-import           Cardano.Slotting.Slot (SlotNo (..))
 
 import           Cardano.Node.Configuration.NodeAddress
 import           Cardano.Node.Configuration.Topology (TopologyError (..))
@@ -50,26 +47,6 @@ import           Ouroboros.Network.NodeToNode (PeerAdvertise (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..))
 import           Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..))
 
-
-
--- | A newtype wrapper around 'UseLedgerAfter' which provides 'FromJSON' and
--- 'ToJSON' instances.
---
--- 'UseLedgerAfter' is used to configure from which slot a p2p node can use on
--- chain root peers.
---
-newtype UseLedger = UseLedger UseLedgerAfter deriving (Eq, Show)
-
-instance FromJSON UseLedger where
-  parseJSON (Data.Aeson.Number n) =
-    if n >= 0 then return $ UseLedger $ UseLedgerAfter $ SlotNo $ floor n
-              else return $ UseLedger   DontUseLedger
-  parseJSON _ = mzero
-
-instance ToJSON UseLedger where
-  toJSON (UseLedger (UseLedgerAfter (SlotNo n))) = Number $ fromIntegral n
-  toJSON (UseLedger DontUseLedger)               = Number (-1)
-
 data NodeSetup = NodeSetup
   { nodeId          :: !Word64
   , nodeIPv4Address :: !(Maybe NodeIPv4Address)

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

@@ -62,6 +62,7 @@ nodeRunParser = do
   shelleyVRFFile  <- optional parseVrfKeyFilePath
   shelleyCertFile <- optional parseOperationalCertFilePath
   shelleyBulkCredsFile <- optional parseBulkCredsFilePath
+  startAsNonProducingNode <- lastOption parseStartAsNonProducingNode
 
   -- Node Address
   nIPv4Address <- lastOption parseHostIPv4Addr
@@ -102,6 +103,7 @@ nodeRunParser = do
            , pncValidateDB = validate
            , pncShutdownConfig =
                Last . Just $ ShutdownConfig (getLast shutdownIPC) (getLast shutdownOnLimit)
+           , pncStartAsNonProducingNode = startAsNonProducingNode
            , pncProtocolConfig = mempty
            , pncMaxConcurrencyBulkSync = mempty
            , pncMaxConcurrencyDeadline = mempty
@@ -313,6 +315,14 @@ parseVrfKeyFilePath =
         <> completer (bashCompleter "file")
     )
 
+parseStartAsNonProducingNode :: Parser Bool
+parseStartAsNonProducingNode =
+  switch (
+    long "start-as-non-producing-node"
+      <> help ("Start the node as a non block producing node even if "
+            ++ "credentials are specified.")
+  )
+
 -- TODO revisit because it sucks
 parseSnapshotInterval :: Parser SnapshotInterval
 parseSnapshotInterval = fmap (RequestedSnapshotInterval . secondsToDiffTime) parseDifftime

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

@@ -60,5 +60,5 @@ data SomeConsensusProtocol where
                                           , TraceConstraints blk
                                           )
                            => Api.BlockType blk
-                           -> Api.ProtocolInfoArgs IO blk
+                           -> Api.ProtocolInfoArgs blk
                            -> SomeConsensusProtocol