[Peras 2] Introduce PerasCertDB and related tests (#1674)

This pull request introduces the `PerasCertDB` datatype, used to hold
and access all `PerasCert`s known by a node that could affect chain
selection.

In the mid/near-term future, this will be enriched to persist
certificates across restarts, and probably also to store historical
certificates.

---

### **Peras types**

- Added modules `Ouroboros.Consensus.Storage.PerasCertDB{,.API,.Impl}`,
notably defining the types`PerasCertDB`, `PerasCertSnapshot` (read-only
snapshot of certs contained in the DB), and `AddPerasCertResult`;
alongside their respectives methods

---

### **Tests**

- Added modules
`Test.Ouroboros.Storage.PerasCertDB{,.StateMachine,.Model}` for q-s-m
testing of the `PerasCertDB` datatype. The corresponding tests have been
included in the test suite defined by `Test.Ouroboros.Storage`

---

### **Regression**

As the [previous
PR](#1673), all
the components introduced by this PR are not used at the moment by the
rest of the code, so no regression is expected.

Author: amesgen

ouroboros-consensus/changelog.d/20250917_101832_thomas.bagrel_peras_cert_db.md

@@ -0,0 +1,24 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+For top level release notes, leave all the headers commented out.
+-->
+
+<!--
+### Patch
+
+- A bullet item for the Patch category.
+
+-->
+<!--
+### Non-Breaking
+
+- A bullet item for the Non-Breaking category.
+
+-->
+
+### Breaking
+
+- Add modules `Ouroboros.Consensus.Storage.PerasCertDB{,.API,.Impl}`, notably defining the types`PerasCertDB`, `PerasCertSnapshot` (read-only snapshot of certs contained in the DB), and `AddPerasCertResult`; alongside their respective methods
+- Add modules `Test.Ouroboros.Storage.PerasCertDB{,.StateMachine,.Model}` for q-s-m testing of the `PerasCertDB` datatype. The corresponding tests are included in the test suite defined by `Test.Ouroboros.Storage`

ouroboros-consensus/ouroboros-consensus.cabal

@@ -265,6 +265,9 @@ library
     Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
     Ouroboros.Consensus.Storage.LedgerDB.V2.LSM
     Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
+    Ouroboros.Consensus.Storage.PerasCertDB
+    Ouroboros.Consensus.Storage.PerasCertDB.API
+    Ouroboros.Consensus.Storage.PerasCertDB.Impl
     Ouroboros.Consensus.Storage.Serialisation
     Ouroboros.Consensus.Storage.VolatileDB
     Ouroboros.Consensus.Storage.VolatileDB.API
@@ -723,6 +726,9 @@ test-suite storage-test
     Test.Ouroboros.Storage.LedgerDB.V1.DbChangelog
     Test.Ouroboros.Storage.LedgerDB.V1.LMDB
     Test.Ouroboros.Storage.Orphans
+    Test.Ouroboros.Storage.PerasCertDB
+    Test.Ouroboros.Storage.PerasCertDB.Model
+    Test.Ouroboros.Storage.PerasCertDB.StateMachine
     Test.Ouroboros.Storage.VolatileDB
     Test.Ouroboros.Storage.VolatileDB.Mock
     Test.Ouroboros.Storage.VolatileDB.Model

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

@@ -0,0 +1,4 @@
+module Ouroboros.Consensus.Storage.PerasCertDB (module X) where
+
+import Ouroboros.Consensus.Storage.PerasCertDB.API as X
+import Ouroboros.Consensus.Storage.PerasCertDB.Impl as X

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

@@ -0,0 +1,67 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Ouroboros.Consensus.Storage.PerasCertDB.API
+  ( PerasCertDB (..)
+  , AddPerasCertResult (..)
+
+    -- * 'PerasCertSnapshot'
+  , PerasCertSnapshot (..)
+  , PerasCertTicketNo
+  , zeroPerasCertTicketNo
+  ) where
+
+import Data.Map (Map)
+import Data.Word (Word64)
+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 :: ValidatedPerasCert blk -> m AddPerasCertResult
+  -- ^ Add a Peras certificate to the database. The result indicates whether
+  -- the certificate was actually added, or if it was already present.
+  , 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.
+  , getCertSnapshot :: STM m (PerasCertSnapshot blk)
+  , garbageCollect :: SlotNo -> m ()
+  -- ^ Garbage-collect state older than the given slot number.
+  , closeDB :: m ()
+  }
+  deriving NoThunks via OnlyCheckWhnfNamed "PerasCertDB" (PerasCertDB m blk)
+
+data AddPerasCertResult = AddedPerasCertToDB | PerasCertAlreadyInDB
+  deriving stock (Show, Eq)
+
+data PerasCertSnapshot blk = PerasCertSnapshot
+  { containsCert :: PerasRoundNo -> Bool
+  -- ^ Do we have the certificate for this round?
+  , getCertsAfter :: PerasCertTicketNo -> Map PerasCertTicketNo (ValidatedPerasCert blk)
+  -- ^ Get certificates after the given ticket number (excluded).
+  -- The result is a map of ticket numbers to validated certificates.
+  }
+
+-- | A sequence number, incremented every time we receive a new certificate.
+--
+-- Note that we will /usually/ receive certificates monotonically by round
+-- number, so round numbers could /almost/ fulfill the role of ticket numbers.
+-- However, in certain edge cases (while catching up, or during cooldowns), this
+-- might not be true, such as during syncing or during cooldown periods.
+-- Therefore, for robustness, we choose to maintain dedicated ticket numbers
+-- separately.
+newtype PerasCertTicketNo = PerasCertTicketNo Word64
+  deriving stock Show
+  deriving newtype (Eq, Ord, Enum, NoThunks)
+
+zeroPerasCertTicketNo :: PerasCertTicketNo
+zeroPerasCertTicketNo = PerasCertTicketNo 0