Update cardano-node after addition of the new BulkSync implementation

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

@@ -162,6 +162,9 @@ data NodeConfiguration
 
          -- Enable Peer Sharing
        , ncPeerSharing :: PeerSharing
+
+       -- Enable Genesis syncing protocol
+       , ncEnableGenesis :: Bool
        } deriving (Eq, Show)
 
 
@@ -225,6 +228,9 @@ data PartialNodeConfiguration
 
          -- Peer Sharing
        , pncPeerSharing :: !(Last PeerSharing)
+
+         -- Genesis syncing protocol
+       , pncEnableGenesis :: !(Last Bool)
        } deriving (Eq, Generic, Show)
 
 instance AdjustFilePaths PartialNodeConfiguration where
@@ -321,6 +327,10 @@ instance FromJSON PartialNodeConfiguration where
       -- DISABLED BY DEFAULT
       pncPeerSharing <- Last <$> v .:? "PeerSharing" .!= Just PeerSharingDisabled
 
+      -- Genesis syncing protocol
+      -- DISABLED BY DEFAULT
+      pncEnableGenesis <- Last <$> v .:? "EnableGenesis" .!= Just False
+
       pure PartialNodeConfiguration {
              pncProtocolConfig
            , pncSocketConfig = Last . Just $ SocketConfig mempty mempty mempty pncSocketPath
@@ -355,6 +365,7 @@ instance FromJSON PartialNodeConfiguration where
            , pncTargetNumberOfActiveBigLedgerPeers
            , pncEnableP2P
            , pncPeerSharing
+           , pncEnableGenesis
            }
     where
       parseMempoolCapacityBytesOverride v = parseNoOverride <|> parseOverride
@@ -531,6 +542,7 @@ defaultPartialNodeConfiguration =
     , pncTargetNumberOfActiveBigLedgerPeers      = Last (Just 5)
     , pncEnableP2P                      = Last (Just EnabledP2PMode)
     , pncPeerSharing                    = Last (Just PeerSharingDisabled)
+    , pncEnableGenesis                  = Last (Just False)
     }
 
 lastOption :: Parser a -> Parser (Last a)
@@ -596,6 +608,10 @@ makeNodeConfiguration pnc = do
     lastToEither "Missing PeerSharing"
     $ pncPeerSharing pnc
 
+  ncEnableGenesis <-
+    lastToEither "Missing EnableGenesis"
+    $ pncEnableGenesis pnc
+
   -- TODO: This is not mandatory
   experimentalProtocols <-
     lastToEither "Missing ExperimentalProtocolsEnabled" $
@@ -643,6 +659,7 @@ makeNodeConfiguration pnc = do
                  EnabledP2PMode  -> SomeNetworkP2PMode Consensus.EnabledP2PMode
                  DisabledP2PMode -> SomeNetworkP2PMode Consensus.DisabledP2PMode
              , ncPeerSharing
+             , ncEnableGenesis
              }
 
 ncProtocol :: NodeConfiguration -> Protocol

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

@@ -126,6 +126,7 @@ nodeRunParser = do
            , pncTargetNumberOfActiveBigLedgerPeers = mempty
            , pncEnableP2P = mempty
            , pncPeerSharing = mempty
+           , pncEnableGenesis = mempty
            }
 
 parseSocketPath :: Text -> Parser SocketPath

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

@@ -6,9 +6,11 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE PackageImports #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
 
 {-# LANGUAGE TypeApplications #-}
 
@@ -45,7 +47,7 @@ import           "contra-tracer" Control.Tracer
 import           Data.Either (partitionEithers)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import           Data.Maybe (catMaybes, fromMaybe, mapMaybe)
+import           Data.Maybe (catMaybes, fromMaybe, mapMaybe, isJust)
 import           Data.Monoid (Last (..))
 import           Data.Proxy (Proxy (..))
 import           Data.Text (Text, breakOn, pack)
@@ -93,9 +95,11 @@ import           Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
 
 import qualified Ouroboros.Consensus.Config as Consensus
 import           Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
+import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as ChainSync.Client
 import           Ouroboros.Consensus.Node (DiskPolicyArgs (..), NetworkP2PMode (..),
                    RunNodeArgs (..), StdRunNodeArgs (..))
 import qualified Ouroboros.Consensus.Node as Node (getChainDB, run)
+import qualified Ouroboros.Consensus.Node.Genesis as Genesis
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Util.Orphans ()
@@ -476,6 +480,9 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
               , rnEnableP2P      = p2pMode
               , rnPeerSharing    = ncPeerSharing nc
               , rnGetUseBootstrapPeers = readTVar useBootstrapVar
+              , rnGenesisConfig = if ncEnableGenesis nc
+                  then Genesis.enableGenesisConfigDefault
+                  else Genesis.disableGenesisConfig
               }
 #ifdef UNIX
         -- initial `SIGHUP` handler, which only rereads the topology file but
@@ -508,8 +515,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                   rnNodeKernelHook nodeArgs registry nodeKernel
             }
             StdRunNodeArgs
-              { srnBfcMaxConcurrencyBulkSync    = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
-              , srnBfcMaxConcurrencyDeadline    = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
+              { srnBfcMaxConcurrencyDeadline    = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
               , srnChainDbValidateOverride      = ncValidateDB nc
               , srnDiskPolicyArgs               = diskPolicyArgs
               , srnDatabasePath                 = dbPath
@@ -559,6 +565,9 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                 , rnEnableP2P      = p2pMode
                 , rnPeerSharing    = ncPeerSharing nc
                 , rnGetUseBootstrapPeers = pure DontUseBootstrapPeers
+                , rnGenesisConfig = if ncEnableGenesis nc
+                    then Genesis.enableGenesisConfigDefault
+                    else Genesis.disableGenesisConfig
                 }
 #ifdef UNIX
         -- initial `SIGHUP` handler; it only warns that neither updating of
@@ -581,8 +590,7 @@ handleSimpleNode blockType runP p2pMode tracers nc onKernel = do
                   rnNodeKernelHook nodeArgs registry nodeKernel
             }
             StdRunNodeArgs
-              { srnBfcMaxConcurrencyBulkSync   = unMaxConcurrencyBulkSync <$> ncMaxConcurrencyBulkSync nc
-              , srnBfcMaxConcurrencyDeadline   = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
+              { srnBfcMaxConcurrencyDeadline   = unMaxConcurrencyDeadline <$> ncMaxConcurrencyDeadline nc
               , srnChainDbValidateOverride     = ncValidateDB nc
               , srnDiskPolicyArgs              = diskPolicyArgs
               , srnDatabasePath                = dbPath

cardano-node/src/Cardano/Node/Tracing/Consistency.hs

@@ -38,6 +38,7 @@ import           Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTim
 import           Ouroboros.Consensus.BlockchainTime.WallClock.Util (TraceBlockchainTimeEvent (..))
 import           Ouroboros.Consensus.Cardano.Block
 import           Ouroboros.Consensus.Ledger.Query (Query)
+import           Ouroboros.Consensus.Genesis.Governor (TraceGDDEvent)
 import           Ouroboros.Consensus.Ledger.SupportsMempool (ApplyTxErr, GenTxId)
 import           Ouroboros.Consensus.Mempool (TraceEventMempool (..))
 import           Ouroboros.Consensus.MiniProtocol.BlockFetch.Server
@@ -46,11 +47,13 @@ import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client (TraceChainSy
 import           Ouroboros.Consensus.MiniProtocol.ChainSync.Server (TraceChainSyncServerEvent)
 import           Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
                    (TraceLocalTxSubmissionServerEvent (..))
+import           Ouroboros.Consensus.Node.GSM (TraceGsmEvent)
 import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
+import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as CSJumping
 import           Ouroboros.Network.Block (Point (..), SlotNo, Tip)
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
-import           Ouroboros.Network.BlockFetch.Decision
+import           Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch
 import           Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..))
 import           Ouroboros.Network.ConnectionId (ConnectionId)
 import           Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..))
@@ -151,9 +154,7 @@ getAllNamespaces =
         chainSyncServerBlockNS = map (nsGetTuple . nsReplacePrefix ["ChainSync", "ServerBlock"])
                         (allNamespaces :: [Namespace (TraceChainSyncServerEvent blk)])
         blockFetchDecisionNS = map (nsGetTuple . nsReplacePrefix ["BlockFetch", "Decision"])
-                        (allNamespaces :: [Namespace [BlockFetch.TraceLabelPeer
-                                                      remotePeer
-                                                      (FetchDecision [Point (Header blk)])]])
+                        (allNamespaces :: [Namespace (TraceDecisionEvent remotePeer (Header blk))])
         blockFetchClientNS = map (nsGetTuple . nsReplacePrefix ["BlockFetch", "Client"])
                         (allNamespaces :: [Namespace (BlockFetch.TraceLabelPeer
                                                       remotePeer
@@ -185,6 +186,15 @@ getAllNamespaces =
         blockchainTimeNS = map (nsGetTuple . nsReplacePrefix  ["BlockchainTime"])
                         (allNamespaces :: [Namespace (TraceBlockchainTimeEvent RelativeTime)])
 
+        gsmEventNS = map (nsGetTuple . nsReplacePrefix  ["GsmEvent"])
+                         (allNamespaces :: [Namespace (TraceGsmEvent selection)])
+
+        csjEventNS = map nsGetTuple
+                         (allNamespaces :: [Namespace (CSJumping.TraceEvent peer)])
+
+        gddEventNS = map nsGetTuple
+                         (allNamespaces :: [Namespace (TraceGDDEvent peer blk)])
+
 -- Node to client
         keepAliveClientNS = map (nsGetTuple . nsReplacePrefix ["Net"])
                                 (allNamespaces :: [Namespace  (TraceKeepAliveClient peer)])
@@ -390,6 +400,9 @@ getAllNamespaces =
             <> mempoolNS
             <> forgeNS
             <> blockchainTimeNS
+            <> gsmEventNS
+            <> csjEventNS
+            <> gddEventNS
 -- NodeToClient
             <> keepAliveClientNS
             <> chainSyncNS

cardano-node/src/Cardano/Node/Tracing/Documentation.hs

@@ -59,7 +59,7 @@ import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
 import qualified Ouroboros.Consensus.Storage.ChainDB as ChainDB
 import           Ouroboros.Network.Block (Point (..), Serialised, SlotNo, Tip)
 import qualified Ouroboros.Network.BlockFetch.ClientState as BlockFetch
-import           Ouroboros.Network.BlockFetch.Decision
+import qualified Ouroboros.Network.BlockFetch.Decision.Trace as BlockFetch
 import           Ouroboros.Network.ConnectionHandler (ConnectionHandlerTrace (..))
 import           Ouroboros.Network.ConnectionId (ConnectionId)
 import           Ouroboros.Network.ConnectionManager.Types (ConnectionManagerTrace (..))
@@ -278,9 +278,7 @@ docTracersFirstPhase condConfigFileName = do
                 ["BlockFetch", "Decision"]
     configureTracers configReflection trConfig [blockFetchDecisionTr]
     blockFetchDecisionTrDoc <- documentTracer (blockFetchDecisionTr ::
-       Trace IO [BlockFetch.TraceLabelPeer
-                                      remotePeer
-                                      (FetchDecision [Point (Header blk)])])
+       Trace IO (BlockFetch.TraceDecisionEvent remotePeer (Header blk)))
 
     blockFetchClientTr  <- mkCardanoTracer
                 trBase trForward mbTrEKG

cardano-node/src/Cardano/Node/Tracing/Tracers.hs

@@ -317,12 +317,17 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
     !consensusStartupErrorTr <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["Consensus", "Startup"]
+    configureTracers configReflection trConfig [consensusStartupErrorTr]
 
     !consensusGsmTr <- mkCardanoTracer
                 trBase trForward mbTrEKG
                 ["Consensus", "GSM"]
+    configureTracers configReflection trConfig [consensusGsmTr]
 
-    configureTracers configReflection trConfig [consensusStartupErrorTr]
+    !consensusCsjTr <- mkCardanoTracer
+                trBase trForward mbTrEKG
+                ["Consensus", "CSJ"]
+    configureTracers configReflection trConfig [consensusCsjTr]
 
     pure $ Consensus.Tracers
       { Consensus.chainSyncClientTracer = Tracer $
@@ -361,6 +366,8 @@ mkConsensusTracers configReflection trBase trForward mbTrEKG _trDataPoint trConf
           traceWith consensusStartupErrorTr . ConsensusStartupException
       , Consensus.gsmTracer = Tracer $
           traceWith consensusGsmTr
+      , Consensus.gddTracer = Tracer $ \_ -> pure () -- TODO
+      , Consensus.csjTracer = Tracer $ traceWith consensusCsjTr
       }
 
 mkNodeToClientTracers :: forall blk.

cardano-node/src/Cardano/Node/Tracing/Tracers/ChainDB.hs

@@ -90,6 +90,7 @@ instance (  LogFormatting (Header blk)
   forHuman (ChainDB.TraceLedgerReplayEvent v)      = forHumanOrMachine v
   forHuman (ChainDB.TraceImmutableDBEvent v)       = forHumanOrMachine v
   forHuman (ChainDB.TraceVolatileDBEvent v)        = forHumanOrMachine v
+  forHuman (ChainDB.TraceChainSelStarvationEvent v)= forHumanOrMachine v
 
   forMachine details (ChainDB.TraceAddBlockEvent v) =
     forMachine details v
@@ -113,6 +114,8 @@ instance (  LogFormatting (Header blk)
     forMachine details v
   forMachine details (ChainDB.TraceVolatileDBEvent v) =
     forMachine details v
+  forMachine details (ChainDB.TraceChainSelStarvationEvent v) =
+    forMachine details v
 
   asMetrics (ChainDB.TraceAddBlockEvent v)          = asMetrics v
   asMetrics (ChainDB.TraceFollowerEvent v)          = asMetrics v
@@ -125,6 +128,7 @@ instance (  LogFormatting (Header blk)
   asMetrics (ChainDB.TraceLedgerReplayEvent v)      = asMetrics v
   asMetrics (ChainDB.TraceImmutableDBEvent v)       = asMetrics v
   asMetrics (ChainDB.TraceVolatileDBEvent v)        = asMetrics v
+  asMetrics (ChainDB.TraceChainSelStarvationEvent v)     = asMetrics v
 
 
 instance MetaTrace  (ChainDB.TraceEvent blk) where
@@ -150,6 +154,8 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
     nsPrependInner "ImmDbEvent" (namespaceFor ev)
   namespaceFor (ChainDB.TraceVolatileDBEvent ev) =
      nsPrependInner "VolatileDbEvent" (namespaceFor ev)
+  namespaceFor (ChainDB.TraceChainSelStarvationEvent ev) =
+    nsPrependInner "ChainSelStarvationEvent" (namespaceFor ev)
 
   severityFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) =
     severityFor (Namespace out tl) (Just ev')
@@ -195,6 +201,10 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
     severityFor (Namespace out tl) (Just ev')
   severityFor (Namespace out ("VolatileDbEvent" : tl)) Nothing =
     severityFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk)) Nothing
+  severityFor (Namespace out ("ChainSelStarvationEvent" : tl)) (Just (ChainDB.TraceChainSelStarvationEvent ev')) =
+    severityFor (Namespace out tl) (Just ev')
+  severityFor (Namespace out ("ChainSelStarvationEvent" : tl)) Nothing =
+    severityFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk)) Nothing
   severityFor _ns _ = Nothing
 
   privacyFor (Namespace out ("AddBlockEvent" : tl)) (Just (ChainDB.TraceAddBlockEvent ev')) =
@@ -287,6 +297,10 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
     detailsFor (Namespace out tl) (Just ev')
   detailsFor (Namespace out ("VolatileDbEvent" : tl)) Nothing =
     detailsFor (Namespace out tl :: (Namespace (VolDB.TraceEvent blk))) Nothing
+  detailsFor (Namespace out ("ChainSelStarvationEvent" : tl)) (Just (ChainDB.TraceChainSelStarvationEvent ev')) =
+    detailsFor (Namespace out tl) (Just ev')
+  detailsFor (Namespace out ("ChainSelStarvationEvent" : tl)) Nothing =
+    detailsFor (Namespace out tl :: (Namespace (ChainDB.TraceChainSelStarvationEvent blk))) Nothing
   detailsFor _ _ = Nothing
 
   metricsDocFor (Namespace out ("AddBlockEvent" : tl)) =
@@ -311,6 +325,8 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
     metricsDocFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk))
   metricsDocFor (Namespace out ("VolatileDbEvent" : tl)) =
     metricsDocFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk))
+  metricsDocFor (Namespace out ("ChainSelStarvationEvent" : tl)) =
+    metricsDocFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk))
   metricsDocFor _ = []
 
   documentFor (Namespace out ("AddBlockEvent" : tl)) =
@@ -335,6 +351,8 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
     documentFor (Namespace out tl :: Namespace (ImmDB.TraceEvent blk))
   documentFor (Namespace out ("VolatileDbEvent" : tl)) =
     documentFor (Namespace out tl :: Namespace (VolDB.TraceEvent blk))
+  documentFor (Namespace out ("ChainSelStarvationEvent" : tl)) =
+    documentFor (Namespace out tl :: Namespace (ChainDB.TraceChainSelStarvationEvent blk))
   documentFor _ = Nothing
 
   allNamespaces =
@@ -360,7 +378,8 @@ instance MetaTrace  (ChainDB.TraceEvent blk) where
                   (allNamespaces :: [Namespace (ImmDB.TraceEvent blk)])
           ++ map  (nsPrependInner "VolatileDbEvent")
                   (allNamespaces :: [Namespace (VolDB.TraceEvent blk)])
-
+          ++ map  (nsPrependInner "ChainSelStarvationEvent")
+                  (allNamespaces :: [Namespace (ChainDB.TraceChainSelStarvationEvent blk)])
 
 --------------------------------------------------------------------------------
 -- AddBlockEvent
@@ -1171,6 +1190,47 @@ instance MetaTrace (ChainDB.TraceValidationEvent blk) where
       , Namespace [] ["UpdateLedgerDb"]
       ]
 
+--------------------------------------------------------------------------------
+-- TraceChainSelStarvationEvent
+--------------------------------------------------------------------------------
+
+instance ConvertRawHash blk
+          => LogFormatting (ChainDB.TraceChainSelStarvationEvent blk) where
+  forHuman (ChainDB.ChainSelStarvationStarted time) =
+      "Chain selection starvation started at " <> showT time
+  forHuman (ChainDB.ChainSelStarvationEnded time pt) =
+      "Chain selection starvation ended at " <> showT time <>
+      " because of " <> renderRealPointAsPhrase pt
+
+  forMachine _dtal (ChainDB.ChainSelStarvationStarted time) =
+    mconcat [ "kind" .= String "ChainSelStarvationStarted"
+            , "time" .= String (showT time) ]
+  forMachine dtal (ChainDB.ChainSelStarvationEnded time pt) =
+    mconcat [ "kind" .= String "ChainSelStarvationEnded"
+             , "time" .= String (showT time)
+             , "point" .= forMachine dtal pt ]
+
+instance MetaTrace (ChainDB.TraceChainSelStarvationEvent blk) where
+    namespaceFor ChainDB.ChainSelStarvationStarted {} =
+      Namespace [] ["ChainSelStarvationStarted"]
+    namespaceFor ChainDB.ChainSelStarvationEnded {} =
+      Namespace [] ["ChainSelStarvationEnded"]
+
+    severityFor (Namespace _ ["ChainSelStarvationStarted"]) _ = Just Debug
+    severityFor (Namespace _ ["ChainSelStarvationEnded"]) _ = Just Debug
+    severityFor _ _ = Nothing
+
+    documentFor (Namespace _ ["ChainSelStarvationStarted"]) = Just
+      "Chain selection starvation started."
+    documentFor (Namespace _ ["ChainSelStarvationEnded"]) = Just
+      "Chain selection starvation ended."
+    documentFor _ = Nothing
+
+    allNamespaces =
+      [ Namespace [] ["ChainSelStarvationStarted"]
+      , Namespace [] ["ChainSelStarvationEnded"]
+      ]
+
 --------------------------------------------------------------------------------
 -- TraceOpenEvent
 --------------------------------------------------------------------------------