Update configuration after recovering BulkSync in ouroboros-network

cabal.project

@@ -57,8 +57,8 @@ if impl(ghc >= 9.10)
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/ouroboros-network
-  tag: fcb842fcd6f32b43a7cdf18a4301c1659a8bb879
-  --sha256: kjwUrduwwxC+5QRQNJa4stEBzz7kqDJyyHOgGMfDw7s=
+  tag: 5c304e5adbd27907c675bd60a2282264a65f117c
+  --sha256: Jn3Qqlsirlyu23bsFN2SO054LIe2rcsHUW1tN8Pm1Ks=
   subdir:
     ouroboros-network
     ouroboros-network-api

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs

@@ -316,7 +316,8 @@ nonImmutableDbPath (MultipleDbPaths _ vol) = vol
 --
 -- See 'stdLowLevelRunNodeArgsIO'.
 data StdRunNodeArgs m blk (p2p :: Diffusion.P2P) = StdRunNodeArgs
-  { srnBfcMaxConcurrencyDeadline    :: Maybe Word
+  { srnBfcMaxConcurrencyBulkSync    :: Maybe Word
+  , srnBfcMaxConcurrencyDeadline    :: Maybe Word
   , srnChainDbValidateOverride      :: Bool
     -- ^ If @True@, validate the ChainDB on init no matter what
   , srnDiskPolicyArgs               :: DiskPolicyArgs
@@ -976,6 +977,9 @@ stdLowLevelRunNodeArgsIO RunNodeArgs{ rnProtocolInfo
             maybe id
               (\mc bfc -> bfc { bfcMaxConcurrencyDeadline = mc })
               srnBfcMaxConcurrencyDeadline
+          . maybe id
+              (\mc bfc -> bfc { bfcMaxConcurrencyBulkSync = mc })
+              srnBfcMaxConcurrencyBulkSync
         modifyMempoolCapacityOverride =
             maybe id
               (\mc nka -> nka { mempoolCapacityOverride = mc })

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs

@@ -60,26 +60,26 @@ data GenesisConfig = GenesisConfig
 
 -- | Genesis configuration flags and low-level args, as parsed from config file or CLI
 data GenesisConfigFlags = GenesisConfigFlags
-  { gcfEnableCSJ           :: Bool
-  , gcfEnableLoEAndGDD     :: Bool
-  , gcfEnableLoP           :: Bool
-  , gcfBulkSyncGracePeriod :: Maybe Integer
-  , gcfBucketCapacity      :: Maybe Integer
-  , gcfBucketRate          :: Maybe Integer
-  , gcfCSJJumpSize         :: Maybe Integer
-  , gcfGDDRateLimit        :: Maybe DiffTime
+  { gcfEnableCSJ             :: Bool
+  , gcfEnableLoEAndGDD       :: Bool
+  , gcfEnableLoP             :: Bool
+  , gcfBlockFetchGracePeriod :: Maybe Integer
+  , gcfBucketCapacity        :: Maybe Integer
+  , gcfBucketRate            :: Maybe Integer
+  , gcfCSJJumpSize           :: Maybe Integer
+  , gcfGDDRateLimit          :: Maybe DiffTime
   } deriving stock (Eq, Generic, Show)
 
 defaultGenesisConfigFlags :: GenesisConfigFlags
 defaultGenesisConfigFlags = GenesisConfigFlags
-  { gcfEnableCSJ            = True
-  , gcfEnableLoEAndGDD      = True
-  , gcfEnableLoP            = True
-  , gcfBulkSyncGracePeriod  = Nothing
-  , gcfBucketCapacity       = Nothing
-  , gcfBucketRate           = Nothing
-  , gcfCSJJumpSize          = Nothing
-  , gcfGDDRateLimit         = Nothing
+  { gcfEnableCSJ              = True
+  , gcfEnableLoEAndGDD        = True
+  , gcfEnableLoP              = True
+  , gcfBlockFetchGracePeriod  = Nothing
+  , gcfBucketCapacity         = Nothing
+  , gcfBucketRate             = Nothing
+  , gcfCSJJumpSize            = Nothing
+  , gcfGDDRateLimit           = Nothing
   }
 
 enableGenesisConfigDefault :: GenesisConfig
@@ -93,7 +93,7 @@ mkGenesisConfig :: Maybe GenesisConfigFlags -> GenesisConfig
 mkGenesisConfig Nothing = -- disable Genesis
   GenesisConfig
     { gcBlockFetchConfig = GenesisBlockFetchConfiguration
-        { gbfcBulkSyncGracePeriod = 0 -- no grace period when Genesis is disabled
+        { gbfcGracePeriod = 0 -- no grace period when Genesis is disabled
         }
     , gcChainSyncLoPBucketConfig = ChainSyncLoPBucketDisabled
     , gcCSJConfig                = CSJDisabled
@@ -102,7 +102,7 @@ mkGenesisConfig Nothing = -- disable Genesis
 mkGenesisConfig (Just GenesisConfigFlags{..}) =
   GenesisConfig
     { gcBlockFetchConfig = GenesisBlockFetchConfiguration
-        { gbfcBulkSyncGracePeriod
+        { gbfcGracePeriod
         }
     , gcChainSyncLoPBucketConfig = if gcfEnableLoP
         then ChainSyncLoPBucketEnabled ChainSyncLoPBucketEnabledConfig
@@ -121,18 +121,18 @@ mkGenesisConfig (Just GenesisConfigFlags{..}) =
     }
   where
     -- TODO justification/derivation from other parameters
-    defaultBulkSyncGracePeriod = 10 -- seconds
-    defaultCapacity            = 100_000 -- number of tokens
-    defaultRate                = 500 -- tokens per second leaking, 1/2ms
+    defaultBlockFetchGracePeriod = 10 -- seconds
+    defaultCapacity              = 100_000 -- number of tokens
+    defaultRate                  = 500 -- tokens per second leaking, 1/2ms
     -- 3 * 2160 * 20 works in more recent ranges of slots, but causes syncing to
     -- block in byron.
-    defaultCSJJumpSize         = 2 * 2160
-    defaultGDDRateLimit        = 1.0 -- seconds
+    defaultCSJJumpSize           = 2 * 2160
+    defaultGDDRateLimit          = 1.0 -- seconds
 
-    gbfcBulkSyncGracePeriod = fromInteger $ fromMaybe defaultBulkSyncGracePeriod gcfBulkSyncGracePeriod
-    csbcCapacity            = fromInteger $ fromMaybe defaultCapacity gcfBucketCapacity
-    csbcRate                = fromInteger $ fromMaybe defaultRate gcfBucketRate
-    csjcJumpSize            = fromInteger $ fromMaybe defaultCSJJumpSize gcfCSJJumpSize
+    gbfcGracePeriod = fromInteger $ fromMaybe defaultBlockFetchGracePeriod gcfBlockFetchGracePeriod
+    csbcCapacity              = fromInteger $ fromMaybe defaultCapacity gcfBucketCapacity
+    csbcRate                  = fromInteger $ fromMaybe defaultRate gcfBucketRate
+    csjcJumpSize              = fromInteger $ fromMaybe defaultCSJJumpSize gcfCSJJumpSize
     lgpGDDRateLimit            = fromMaybe defaultGDDRateLimit gcfGDDRateLimit
 
 newtype LoEAndGDDParams = LoEAndGDDParams

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

@@ -93,6 +93,8 @@ import           Ouroboros.Network.AnchoredFragment (AnchoredFragment,
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import           Ouroboros.Network.Block (castTip, tipFromHeader)
 import           Ouroboros.Network.BlockFetch
+import           Ouroboros.Network.BlockFetch.ConsensusInterface
+                     (GenesisFetchMode)
 import           Ouroboros.Network.Diffusion (PublicPeerSelectionState)
 import           Ouroboros.Network.NodeToNode (ConnectionId,
                      MiniProtocolParameters (..))
@@ -133,7 +135,7 @@ data NodeKernel m addrNTN addrNTC blk = NodeKernel {
 
       -- | The fetch mode, used by diffusion.
       --
-    , getFetchMode            :: STM m FetchMode
+    , getFetchMode            :: STM m GenesisFetchMode
 
       -- | The GSM state, used by diffusion. A ledger judgement can be derived
       -- from it with 'GSM.gsmStateToLedgerJudgement'.
@@ -366,6 +368,7 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
                                  , blockFetchSize, btime
                                  , mempoolCapacityOverride
                                  , gsmArgs, getUseBootstrapPeers
+                                 , genesisArgs
                                  } = do
     varGsmState <- do
       let GsmNodeKernelArgs {..} = gsmArgs
@@ -387,6 +390,7 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
 
     slotForgeTimeOracle <- BlockFetchClientInterface.initSlotForgeTimeOracle cfg chainDB
     let readFetchMode = BlockFetchClientInterface.readFetchModeDefault
+          (isGenesisEnabled $ gnkaLoEAndGDDArgs genesisArgs)
           btime
           (ChainDB.getCurrentChain chainDB)
           getUseBootstrapPeers
@@ -404,6 +408,11 @@ initInternalState NodeKernelArgs { tracers, chainDB, registry, cfg
     peerSharingRegistry <- newPeerSharingRegistry
 
     return IS {..}
+  where
+    isGenesisEnabled :: forall a. LoEAndGDDConfig a -> Bool
+    isGenesisEnabled = \case
+      LoEAndGDDDisabled -> False
+      LoEAndGDDEnabled _ -> True
 
 forkBlockForging ::
        forall m addrNTN addrNTC blk.

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs

@@ -1014,10 +1014,11 @@ runThreadNetwork systemTime ThreadNetworkArgs
                   txSubmissionMaxUnacked      = 1000 -- TODO ?
                 }
             , blockFetchConfiguration = BlockFetchConfiguration {
-                  bfcMaxConcurrencyDeadline = 2
+                  bfcMaxConcurrencyBulkSync = 1
+                , bfcMaxConcurrencyDeadline = 2
                 , bfcMaxRequestsInflight    = 10
-                , bfcDecisionLoopIntervalBulkSync = 0.0 -- Mock testsuite can use sub-second slot
-                , bfcDecisionLoopIntervalDeadline = 0.0 -- interval which doesn't play nice with
+                , bfcDecisionLoopIntervalPraos = 0.0 -- Mock testsuite can use sub-second slot
+                , bfcDecisionLoopIntervalGenesis = 0.0 -- interval which doesn't play nice with
                                                         -- blockfetch descision interval.
                 , bfcSalt                   = 0
                 , bfcGenesisBFConfig        = gcBlockFetchConfig enableGenesisConfigDefault

ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/PeerSimulator/BlockFetch.hs

@@ -40,10 +40,12 @@ import           Ouroboros.Consensus.Util.IOLike (DiffTime,
                      Exception (fromException), IOLike, atomically, retry, try)
 import           Ouroboros.Consensus.Util.ResourceRegistry
 import           Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..),
-                     FetchClientRegistry, FetchMode (..),
-                     GenesisBlockFetchConfiguration (..), blockFetchLogic,
-                     bracketFetchClient, bracketKeepAliveClient)
+                     FetchClientRegistry, GenesisBlockFetchConfiguration (..),
+                     blockFetchLogic, bracketFetchClient,
+                     bracketKeepAliveClient)
 import           Ouroboros.Network.BlockFetch.Client (blockFetchClient)
+import           Ouroboros.Network.BlockFetch.ConsensusInterface
+                     (GenesisFetchMode (..))
 import           Ouroboros.Network.Channel (Channel)
 import           Ouroboros.Network.ControlMessage (ControlMessageSTM)
 import           Ouroboros.Network.Driver (runPeer)
@@ -97,12 +99,12 @@ startBlockFetchLogic enableChainSelStarvation registry tracer chainDb fetchClien
             -- do not serialize the blocks.
             (\_hdr -> 1000)
             slotForgeTime
-            -- This is a syncing test, so we use 'FetchModeBulkSync'.
-            (pure FetchModeBulkSync)
+            -- This is a syncing test, so we use 'FetchModeGenesis'.
+            (pure FetchModeGenesis)
 
         bfcGenesisBFConfig = if enableChainSelStarvation
           then GenesisBlockFetchConfiguration
-            { gbfcBulkSyncGracePeriod =
+            { gbfcGracePeriod =
                 if enableChainSelStarvation then
                   10  -- default value for cardano-node at the time of writing
                 else
@@ -113,10 +115,11 @@ startBlockFetchLogic enableChainSelStarvation registry tracer chainDb fetchClien
         -- Values taken from
         -- ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs
         blockFetchCfg = BlockFetchConfiguration
-          { bfcMaxConcurrencyDeadline = 50 -- unused because of @pure FetchModeBulkSync@ above
+          { bfcMaxConcurrencyBulkSync = 50
+          , bfcMaxConcurrencyDeadline = 50 -- unused because of @pure FetchModeBulkSync@ above
           , bfcMaxRequestsInflight = 10
-          , bfcDecisionLoopIntervalBulkSync = 0
-          , bfcDecisionLoopIntervalDeadline = 0
+          , bfcDecisionLoopIntervalPraos = 0
+          , bfcDecisionLoopIntervalGenesis = 0
           , bfcSalt = 0
           , bfcGenesisBFConfig
           }

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/BlockFetch/ClientInterface.hs

@@ -46,7 +46,8 @@ import           Ouroboros.Network.Block (MaxSlotNo)
 import           Ouroboros.Network.BlockFetch.ConsensusInterface
                      (BlockFetchConsensusInterface (..),
                      ChainSelStarvation (..), FetchMode (..),
-                     FromConsensus (..), WhetherReceivingTentativeBlocks (..))
+                     FromConsensus (..), GenesisFetchMode (..),
+                     WhetherReceivingTentativeBlocks (..))
 import           Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers,
                      requiresBootstrapPeers)
 import           Ouroboros.Network.PeerSelection.LedgerPeers.Type
@@ -142,24 +143,28 @@ initSlotForgeTimeOracle cfg chainDB = do
 
 readFetchModeDefault ::
      (MonadSTM m, HasHeader blk)
-  => BlockchainTime m
+  => Bool -- Is genesis enabled?
+  -> BlockchainTime m
   -> STM m (AnchoredFragment blk)
   -> STM m UseBootstrapPeers
   -> STM m LedgerStateJudgement
-  -> STM m FetchMode
-readFetchModeDefault btime getCurrentChain
+  -> STM m GenesisFetchMode
+readFetchModeDefault genesisEnabled btime getCurrentChain
                      getUseBootstrapPeers getLedgerStateJudgement = do
     mCurSlot <- getCurrentSlot btime
     usingBootstrapPeers <- requiresBootstrapPeers <$> getUseBootstrapPeers
                                                   <*> getLedgerStateJudgement
+    let nonDeadlineFetchMode = if genesisEnabled
+          then FetchModeGenesis
+          else PraosFetchMode FetchModeBulkSync
 
     -- This logic means that when the node is using bootstrap peers and is in
     -- TooOld state it will always return BulkSync. Otherwise if the node
     -- isn't using bootstrap peers (i.e. has them disabled it will use the old
     -- logic of returning BulkSync if behind 1000 slots
     case (usingBootstrapPeers, mCurSlot) of
-      (True, _)                    -> return FetchModeBulkSync
-      (False, CurrentSlotUnknown)  -> return FetchModeBulkSync
+      (True, _)                    -> return nonDeadlineFetchMode
+      (False, CurrentSlotUnknown)  -> return nonDeadlineFetchMode
       (False, CurrentSlot curSlot) -> do
         curChainSlot <- AF.headSlot <$> getCurrentChain
         let slotsBehind = case curChainSlot of
@@ -171,8 +176,8 @@ readFetchModeDefault btime getCurrentChain
         return $ if slotsBehind < maxSlotsBehind
           -- When the current chain is near to "now", use deadline mode,
           -- when it is far away, use bulk sync mode.
-          then FetchModeDeadline
-          else FetchModeBulkSync
+          then PraosFetchMode FetchModeDeadline
+          else nonDeadlineFetchMode
 
 mkBlockFetchConsensusInterface ::
      forall m peer blk.
@@ -188,7 +193,7 @@ mkBlockFetchConsensusInterface ::
   -> (Header blk -> SizeInBytes)
   -> SlotForgeTimeOracle m blk
      -- ^ Slot forge time, see 'headerForgeUTCTime' and 'blockForgeUTCTime'.
-  -> STM m FetchMode
+  -> STM m GenesisFetchMode
      -- ^ See 'readFetchMode'.
   -> BlockFetchConsensusInterface peer (Header blk) blk m
 mkBlockFetchConsensusInterface

ouroboros-consensus/test/consensus-test/Test/Consensus/MiniProtocol/BlockFetch/Client.hs

@@ -57,6 +57,8 @@ import           Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..),
                      bracketFetchClient, bracketKeepAliveClient,
                      bracketSyncWithFetchClient, newFetchClientRegistry)
 import           Ouroboros.Network.BlockFetch.Client (blockFetchClient)
+import           Ouroboros.Network.BlockFetch.ConsensusInterface
+                     (GenesisFetchMode (..))
 import           Ouroboros.Network.ControlMessage (ControlMessage (..))
 import           Ouroboros.Network.Mock.Chain (Chain)
 import qualified Ouroboros.Network.Mock.Chain as Chain
@@ -98,8 +100,9 @@ prop_blockFetch bfcts@BlockFetchClientTestSetup{..} =
       [ Map.keysSet bfcoBlockFetchResults === Map.keysSet peerUpdates
       , counterexample ("Fetched blocks per peer: " <> condense bfcoFetchedBlocks) $
         property $ case blockFetchMode of
-          FetchModeDeadline -> all (> 0) bfcoFetchedBlocks
-          FetchModeBulkSync -> any (> 0) bfcoFetchedBlocks
+          PraosFetchMode FetchModeDeadline -> all (> 0) bfcoFetchedBlocks
+          PraosFetchMode FetchModeBulkSync -> all (> 0) bfcoFetchedBlocks
+          FetchModeGenesis                 -> any (> 0) bfcoFetchedBlocks
       ]
   where
     BlockFetchClientOutcome{..} = runSimOrThrow $ runBlockFetchTest bfcts
@@ -330,7 +333,7 @@ data BlockFetchClientTestSetup = BlockFetchClientTestSetup {
     -- the candidate fragments provided by the ChainSync client.
     peerUpdates    :: Map PeerId (Schedule ChainUpdate)
     -- | BlockFetch 'FetchMode'
-  , blockFetchMode :: FetchMode
+  , blockFetchMode :: GenesisFetchMode
   , blockFetchCfg  :: BlockFetchConfiguration
   }
   deriving stock (Show)
@@ -358,18 +361,23 @@ instance Arbitrary BlockFetchClientTestSetup where
       peerUpdates <-
             Map.fromList . zip peerIds
         <$> replicateM numPeers genUpdateSchedule
-      blockFetchMode <- elements [FetchModeBulkSync, FetchModeDeadline]
+      blockFetchMode <- elements
+        [ PraosFetchMode FetchModeBulkSync
+        , PraosFetchMode FetchModeDeadline
+        , FetchModeGenesis
+        ]
       blockFetchCfg  <- do
         let -- ensure that we can download blocks from all peers
+            bfcMaxConcurrencyBulkSync = fromIntegral numPeers
             bfcMaxConcurrencyDeadline = fromIntegral numPeers
             -- This is used to introduce a minimal delay between BlockFetch
             -- logic iterations in case the monitored state vars change too
             -- fast, which we don't have to worry about in this test.
-            bfcDecisionLoopIntervalBulkSync = 0
-            bfcDecisionLoopIntervalDeadline = 0
+            bfcDecisionLoopIntervalGenesis = 0
+            bfcDecisionLoopIntervalPraos = 0
         bfcMaxRequestsInflight <- chooseEnum (2, 10)
         bfcSalt                <- arbitrary
-        gbfcBulkSyncGracePeriod <- fromIntegral <$> chooseInteger (5, 60)
+        gbfcGracePeriod <- fromIntegral <$> chooseInteger (5, 60)
         let bfcGenesisBFConfig = GenesisBlockFetchConfiguration {..}
         pure BlockFetchConfiguration {..}
       pure BlockFetchClientTestSetup {..}