PerasCertDB.getWeightSnapshot: add Fingerprint

Author: amesgen

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs

@@ -389,7 +389,7 @@ data ChainDB m blk = ChainDB
   -- in the tables.
   , addPerasCert :: PerasCert blk -> m ()
   -- ^ TODO
-  , getPerasWeightSnapshot :: STM m (PerasWeightSnapshot blk)
+  , getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
   -- ^ TODO
   , closeDB :: m ()
   -- ^ Close the ChainDB

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Query.hs

@@ -265,7 +265,8 @@ getReadOnlyForkerAtPoint CDB{..} = LedgerDB.getReadOnlyForker cdbLedgerDB
 getStatistics :: IOLike m => ChainDbEnv m blk -> m (Maybe LedgerDB.Statistics)
 getStatistics CDB{..} = LedgerDB.getTipStatistics cdbLedgerDB
 
-getPerasWeightSnapshot :: ChainDbEnv m blk -> STM m (PerasWeightSnapshot blk)
+getPerasWeightSnapshot ::
+  ChainDbEnv m blk -> STM m (WithFingerprint (PerasWeightSnapshot blk))
 getPerasWeightSnapshot CDB{..} = PerasCertDB.getWeightSnapshot cdbPerasCertDB
 
 {-------------------------------------------------------------------------------

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasCertDB/API.hs

@@ -10,10 +10,18 @@ import NoThunks.Class
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Peras.Weight
 import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
 
 data PerasCertDB m blk = PerasCertDB
   { addCert :: PerasCert blk -> m ()
-  , getWeightSnapshot :: STM m (PerasWeightSnapshot blk)
+  , getWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
+  -- ^ Return the Peras weights in order compare the current selection against
+  -- potential candidate chains, namely the weights for blocks not older than
+  -- the current immutable tip. It might contain weights for even older blocks
+  -- if they have not yet been garbage-collected.
+  --
+  -- The 'Fingerprint' is updated every time a new certificate is added, but it
+  -- stays the same when certificates are garbage-collected.
   , garbageCollect :: SlotNo -> m ()
   -- ^ Garbage-collect state older than the given slot number.
   , closeDB :: m ()

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasCertDB/Impl.hs

@@ -34,6 +34,7 @@ import Ouroboros.Consensus.Storage.PerasCertDB.API
 import Ouroboros.Consensus.Util.Args
 import Ouroboros.Consensus.Util.CallStack
 import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Consensus.Util.STM
 
 {------------------------------------------------------------------------------
   Opening the database
@@ -92,7 +93,7 @@ data PerasCertDbState m blk
 
 data PerasCertDbEnv m blk = PerasCertDbEnv
   { pcdbTracer :: !(Tracer m (TraceEvent blk))
-  , pcdbVolatileState :: !(StrictTVar m (PerasVolatileCertState blk))
+  , pcdbVolatileState :: !(StrictTVar m (WithFingerprint (PerasVolatileCertState blk)))
   -- ^ The 'RoundNo's of all certificates currently in the db.
   }
   deriving NoThunks via OnlyCheckWhnfNamed "PerasCertDbEnv" (PerasCertDbEnv m blk)
@@ -148,20 +149,27 @@ implAddCert ::
 implAddCert env cert = do
   traceWith pcdbTracer $ AddingPerasCert roundNo boostedPt
   join $ atomically $ do
-    PerasVolatileCertState{pvcsCerts, pvcsWeightByPoint} <- readTVar pcdbVolatileState
+    WithFingerprint
+      PerasVolatileCertState
+        { pvcsCerts
+        , pvcsWeightByPoint
+        }
+      fp <-
+      readTVar pcdbVolatileState
     if Map.member roundNo pvcsCerts
       then do
         pure $ traceWith pcdbTracer $ IgnoredCertAlreadyInDB roundNo boostedPt
       else do
-        writeTVar
-          pcdbVolatileState
-          PerasVolatileCertState
-            { pvcsCerts =
-                Map.insert roundNo cert pvcsCerts
-            , -- Note that the same block might be boosted by multiple points.
-              pvcsWeightByPoint =
-                Map.insertWith (<>) boostedPt boostPerCert pvcsWeightByPoint
-            }
+        writeTVar pcdbVolatileState $
+          WithFingerprint
+            PerasVolatileCertState
+              { pvcsCerts =
+                  Map.insert roundNo cert pvcsCerts
+              , -- Note that the same block might be boosted by multiple points.
+                pvcsWeightByPoint =
+                  Map.insertWith (<>) boostedPt boostPerCert pvcsWeightByPoint
+              }
+            (succ fp)
         pure $ traceWith pcdbTracer $ AddedPerasCert roundNo boostedPt
  where
   PerasCertDbEnv
@@ -174,16 +182,18 @@ implAddCert env cert = do
 
 implGetWeightSnapshot ::
   IOLike m =>
-  PerasCertDbEnv m blk -> STM m (PerasWeightSnapshot blk)
+  PerasCertDbEnv m blk -> STM m (WithFingerprint (PerasWeightSnapshot blk))
 implGetWeightSnapshot PerasCertDbEnv{pcdbVolatileState} =
-  PerasWeightSnapshot . pvcsWeightByPoint <$> readTVar pcdbVolatileState
+  fmap (PerasWeightSnapshot . pvcsWeightByPoint) <$> readTVar pcdbVolatileState
 
 implGarbageCollect ::
   forall m blk.
   (IOLike m, StandardHash blk) =>
   PerasCertDbEnv m blk -> SlotNo -> m ()
 implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
-  atomically $ modifyTVar pcdbVolatileState gc
+  -- No need to update the 'Fingerprint' as we only remove certificates that do
+  -- not matter for comparing interesting chains.
+  atomically $ modifyTVar pcdbVolatileState (fmap gc)
  where
   gc :: PerasVolatileCertState blk -> PerasVolatileCertState blk
   gc PerasVolatileCertState{pvcsCerts, pvcsWeightByPoint} =
@@ -235,12 +245,14 @@ data PerasVolatileCertState blk = PerasVolatileCertState
   deriving stock (Show, Generic)
   deriving anyclass NoThunks
 
-initialPerasVolatileCertState :: PerasVolatileCertState blk
+initialPerasVolatileCertState :: WithFingerprint (PerasVolatileCertState blk)
 initialPerasVolatileCertState =
-  PerasVolatileCertState
-    { pvcsCerts = Map.empty
-    , pvcsWeightByPoint = Map.empty
-    }
+  WithFingerprint
+    PerasVolatileCertState
+      { pvcsCerts = Map.empty
+      , pvcsWeightByPoint = Map.empty
+      }
+    (Fingerprint 0)
 
 {-------------------------------------------------------------------------------
   Trace types

ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/PerasCertDB/StateMachine.hs

@@ -22,6 +22,7 @@ import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
 import Ouroboros.Consensus.Storage.PerasCertDB.API (PerasCertDB)
 import Ouroboros.Consensus.Util.IOLike
+import Ouroboros.Consensus.Util.STM
 import qualified Test.Ouroboros.Storage.PerasCertDB.Model as Model
 import Test.QuickCheck
 import qualified Test.QuickCheck.Monadic as QC
@@ -118,7 +119,7 @@ instance RunModel Model (StateT (PerasCertDB IO TestBlock) IO) where
       lift $ PerasCertDB.addCert perasCertDB cert
     GetWeightSnapshot -> do
       perasCertDB <- get
-      lift $ atomically $ PerasCertDB.getWeightSnapshot perasCertDB
+      lift $ atomically $ forgetFingerprint <$> PerasCertDB.getWeightSnapshot perasCertDB
     GarbageCollect slot -> do
       perasCertDB <- get
       lift $ PerasCertDB.garbageCollect perasCertDB slot