Integrated weighted BlockFetch decision logic

Author: amesgen

cabal.project

@@ -60,10 +60,11 @@ if impl (ghc >= 9.12)
 source-repository-package
    type: git
    location: https://github.com/IntersectMBO/ouroboros-network
-   tag: 3e8d3b4b8c87ead794876c62d7fe25f32efb5142
-   --sha256: 08fpkx3iagj83nn413h9a865zjcj3lrf7017a756qd2wg2jg3amq
+   tag: 073938c7fa91fa45cf58c2f572c578ef278e8ff3
+   --sha256: sha256-jQ79Iym796tk1JLexyzGCC7vQyCAt/FJo5Y666ggAG0=
    subdir:
      ouroboros-network-api
+     ouroboros-network
 
 source-repository-package
    type: git

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

@@ -33,7 +33,7 @@ import Ouroboros.Consensus.Ledger.SupportsProtocol
   )
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CSClient
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.Jumping as CSJumping
-import Ouroboros.Consensus.Peras.Weight (emptyPerasWeightSnapshot)
+import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( AddBlockPromise
   , ChainDB
@@ -46,11 +46,13 @@ import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunis
 import Ouroboros.Consensus.Util.AnchoredFragment
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.Orphans ()
+import Ouroboros.Consensus.Util.STM
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import qualified Ouroboros.Network.AnchoredFragment as AF
 import Ouroboros.Network.Block (MaxSlotNo)
 import Ouroboros.Network.BlockFetch.ConsensusInterface
   ( BlockFetchConsensusInterface (..)
+  , ChainComparison (..)
   , ChainSelStarvation
   , FetchMode (..)
   , FromConsensus (..)
@@ -67,6 +69,7 @@ data ChainDbView m blk = ChainDbView
   , getMaxSlotNo :: STM m MaxSlotNo
   , addBlockAsync :: InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
   , getChainSelStarvation :: STM m ChainSelStarvation
+  , getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
   }
 
 defaultChainDbView :: ChainDB m blk -> ChainDbView m blk
@@ -78,6 +81,7 @@ defaultChainDbView chainDB =
     , getMaxSlotNo = ChainDB.getMaxSlotNo chainDB
     , addBlockAsync = ChainDB.addBlockAsync chainDB
     , getChainSelStarvation = ChainDB.getChainSelStarvation chainDB
+    , getPerasWeightSnapshot = ChainDB.getPerasWeightSnapshot chainDB
     }
 
 readFetchModeDefault ::
@@ -227,6 +231,16 @@ mkBlockFetchConsensusInterface
     readFetchedMaxSlotNo :: STM m MaxSlotNo
     readFetchedMaxSlotNo = getMaxSlotNo chainDB
 
+    readChainComparison :: STM m (WithFingerprint (ChainComparison (HeaderWithTime blk)))
+    readChainComparison =
+      fmap mkChainComparison <$> getPerasWeightSnapshot chainDB
+     where
+      mkChainComparison weights =
+        ChainComparison
+          { plausibleCandidateChain = plausibleCandidateChain weights
+          , compareCandidateChains = compareCandidateChains weights
+          }
+
     -- Note that @ours@ comes from the ChainDB and @cand@ from the ChainSync
     -- client.
     --
@@ -242,10 +256,11 @@ mkBlockFetchConsensusInterface
     -- fragment, our current chain might have changed.
     plausibleCandidateChain ::
       HasCallStack =>
+      PerasWeightSnapshot blk ->
       AnchoredFragment (HeaderWithTime blk) ->
       AnchoredFragment (HeaderWithTime blk) ->
       Bool
-    plausibleCandidateChain ours cand =
+    plausibleCandidateChain weights ours cand =
       -- 1. The ChainDB maintains the invariant that the anchor of our fragment
       --    corresponds to the immutable tip.
       --
@@ -270,13 +285,11 @@ mkBlockFetchConsensusInterface
         Just _ -> preferAnchoredCandidate bcfg weights ours cand
 
     compareCandidateChains ::
+      PerasWeightSnapshot blk ->
       AnchoredFragment (HeaderWithTime blk) ->
       AnchoredFragment (HeaderWithTime blk) ->
       Ordering
-    compareCandidateChains = compareAnchoredFragments bcfg weights
-
-    -- TODO requires https://github.com/IntersectMBO/ouroboros-network/pull/5161
-    weights = emptyPerasWeightSnapshot
+    compareCandidateChains = compareAnchoredFragments bcfg
 
     headerForgeUTCTime :: FromConsensus (HeaderWithTime blk) -> STM m UTCTime
     headerForgeUTCTime =

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Util/STM.hs

@@ -1,9 +1,5 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -36,10 +32,12 @@ import Control.Monad (void)
 import Control.Monad.State (StateT (..))
 import Control.ResourceRegistry
 import Data.Void
-import Data.Word (Word64)
-import GHC.Generics (Generic)
 import GHC.Stack
 import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Network.BlockFetch.ConsensusInterface
+  ( Fingerprint (..)
+  , WithFingerprint (..)
+  )
 
 {-------------------------------------------------------------------------------
   Misc
@@ -83,20 +81,6 @@ blockUntilJust getMaybeA = do
 blockUntilAllJust :: MonadSTM m => [STM m (Maybe a)] -> STM m [a]
 blockUntilAllJust = mapM blockUntilJust
 
--- | Simple type that can be used to indicate something in a @TVar@ is
--- changed.
-newtype Fingerprint = Fingerprint Word64
-  deriving stock (Show, Eq, Generic)
-  deriving newtype Enum
-  deriving anyclass NoThunks
-
--- | Store a value together with its fingerprint.
-data WithFingerprint a = WithFingerprint
-  { forgetFingerprint :: !a
-  , getFingerprint :: !Fingerprint
-  }
-  deriving (Show, Eq, Functor, Generic, NoThunks)
-
 {-------------------------------------------------------------------------------
   Simulate monad stacks
 -------------------------------------------------------------------------------}

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

@@ -306,6 +306,7 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
       getMaxSlotNo = ChainDB.getMaxSlotNo chainDB
       addBlockAsync = ChainDB.addBlockAsync chainDB
       getChainSelStarvation = ChainDB.getChainSelStarvation chainDB
+      getPerasWeightSnapshot = ChainDB.getPerasWeightSnapshot chainDB
     pure BlockFetchClientInterface.ChainDbView{..}
    where
     cdbTracer = Tracer \case