PerasCertDB.addCert: return whether we added the cert

Author: amesgen

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

@@ -277,7 +277,7 @@ openDBInternal args launchBgTasks = runWithTempRegistry $ do
             , getReadOnlyForkerAtPoint = getEnv2 h Query.getReadOnlyForkerAtPoint
             , getStatistics = getEnv h Query.getStatistics
             , addPerasCert = getEnv1 h $ \cdb@CDB{..} cert -> do
-                PerasCertDB.addCert cdbPerasCertDB cert
+                _ <- PerasCertDB.addCert cdbPerasCertDB cert
                 -- TODO trigger chain selection in a more efficient way
                 waitChainSelectionPromise =<< ChainSel.triggerChainSelectionAsync cdb
             , getPerasWeightSnapshot = getEnvSTM h Query.getPerasWeightSnapshot

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

@@ -4,6 +4,7 @@
 
 module Ouroboros.Consensus.Storage.PerasCertDB.API
   ( PerasCertDB (..)
+  , AddPerasCertResult (..)
   ) where
 
 import NoThunks.Class
@@ -13,7 +14,7 @@ import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
 
 data PerasCertDB m blk = PerasCertDB
-  { addCert :: PerasCert blk -> m ()
+  { addCert :: PerasCert blk -> m AddPerasCertResult
   , 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
@@ -27,3 +28,6 @@ data PerasCertDB m blk = PerasCertDB
   , closeDB :: m ()
   }
   deriving NoThunks via OnlyCheckWhnfNamed "PerasCertDB" (PerasCertDB m blk)
+
+data AddPerasCertResult = AddedPerasCertToDB | PerasCertAlreadyInDB
+  deriving stock (Show, Eq)

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

@@ -20,7 +20,6 @@ module Ouroboros.Consensus.Storage.PerasCertDB.Impl
   , PerasCertDbError (..)
   ) where
 
-import Control.Monad (join)
 import Control.Tracer (Tracer, nullTracer, traceWith)
 import Data.Kind (Type)
 import qualified Data.Map.Merge.Strict as Map
@@ -145,10 +144,10 @@ implAddCert ::
   ) =>
   PerasCertDbEnv m blk ->
   PerasCert blk ->
-  m ()
+  m AddPerasCertResult
 implAddCert env cert = do
   traceWith pcdbTracer $ AddingPerasCert roundNo boostedPt
-  join $ atomically $ do
+  res <- atomically $ do
     WithFingerprint
       PerasVolatileCertState
         { pvcsCerts
@@ -157,8 +156,7 @@ implAddCert env cert = do
       fp <-
       readTVar pcdbVolatileState
     if Map.member roundNo pvcsCerts
-      then do
-        pure $ traceWith pcdbTracer $ IgnoredCertAlreadyInDB roundNo boostedPt
+      then pure PerasCertAlreadyInDB
       else do
         writeTVar pcdbVolatileState $
           WithFingerprint
@@ -170,7 +168,11 @@ implAddCert env cert = do
                   Map.insertWith (<>) boostedPt boostPerCert pvcsWeightByPoint
               }
             (succ fp)
-        pure $ traceWith pcdbTracer $ AddedPerasCert roundNo boostedPt
+        pure AddedPerasCertToDB
+  traceWith pcdbTracer $ case res of
+    AddedPerasCertToDB -> AddedPerasCert roundNo boostedPt
+    PerasCertAlreadyInDB -> IgnoredCertAlreadyInDB roundNo boostedPt
+  pure res
  where
   PerasCertDbEnv
     { pcdbTracer

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

@@ -17,10 +17,11 @@ module Test.Ouroboros.Storage.PerasCertDB.StateMachine (tests) where
 import Control.Monad.State
 import Control.Tracer (nullTracer)
 import qualified Data.List.NonEmpty as NE
+import qualified Data.Set as Set
 import Ouroboros.Consensus.Block
 import Ouroboros.Consensus.Peras.Weight (PerasWeightSnapshot)
 import qualified Ouroboros.Consensus.Storage.PerasCertDB as PerasCertDB
-import Ouroboros.Consensus.Storage.PerasCertDB.API (PerasCertDB)
+import Ouroboros.Consensus.Storage.PerasCertDB.API (AddPerasCertResult (..), PerasCertDB)
 import Ouroboros.Consensus.Util.IOLike
 import Ouroboros.Consensus.Util.STM
 import qualified Test.Ouroboros.Storage.PerasCertDB.Model as Model
@@ -51,7 +52,7 @@ instance StateModel Model where
   data Action Model a where
     OpenDB :: Action Model ()
     CloseDB :: Action Model ()
-    AddCert :: PerasCert TestBlock -> Action Model ()
+    AddCert :: PerasCert TestBlock -> Action Model AddPerasCertResult
     GetWeightSnapshot :: Action Model (PerasWeightSnapshot TestBlock)
     GarbageCollect :: SlotNo -> Action Model ()
 
@@ -124,6 +125,12 @@ instance RunModel Model (StateT (PerasCertDB IO TestBlock) IO) where
       perasCertDB <- get
       lift $ PerasCertDB.garbageCollect perasCertDB slot
 
+  postcondition (Model model, _) (AddCert cert) _ actual = do
+    let expected
+          | cert `Set.member` model.certs = PerasCertAlreadyInDB
+          | otherwise = AddedPerasCertToDB
+    counterexamplePost $ show expected <> " /= " <> show actual
+    pure $ expected == actual
   postcondition (Model model, _) GetWeightSnapshot _ actual = do
     let expected = Model.getWeightSnapshot model
     counterexamplePost $ "Model: " <> show expected