From 7b265308b21864f149d924e637e71d97475feb87 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Mon, 5 Oct 2026 16:06:47 +0200
Subject: [PATCH 01/13] Revert "Disable ticking of PerasEpochContextResolver"

This reverts commit b7d3216d13028a85e38ee0357c149c7d00cd2993.
---
 .../Ouroboros/Consensus/Ledger/Extended.hs           | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
index d474c8c7bb..6a56c34148 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Extended.hs
@@ -74,6 +74,7 @@ import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Peras (PerasState (..))
 import Ouroboros.Consensus.Ledger.SupportsProtocol
+import Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables)
 import Ouroboros.Consensus.Peras.Context
   ( PerasEpochContextNotFoundForRound
   , PerasEpochContextResolver (..)
@@ -81,6 +82,7 @@ import Ouroboros.Consensus.Peras.Context
   , StateSupportsPerasEpochContext (..)
   , initPerasEpochContextResolver
   , resolveRoundNo
+  , tickPerasEpochContextResolver
   )
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Storage.Serialisation
@@ -247,12 +249,10 @@ instance
             tickedPerasState =
               PerasState
                 { perasEpochContextResolver =
-                    -- HOTFIX: disabled for now
-                    -- tickPerasEpochContextResolver
-                    --   lcfg
-                    --   (perasEpochContextResolver perasState, ledgerState, headerState)
-                    --   (slot, forgetLedgerTables tickedLedgerState, tickedHeaderState)
-                    perasEpochContextResolver perasState
+                    tickPerasEpochContextResolver
+                      lcfg
+                      (perasEpochContextResolver perasState, ledgerState, headerState)
+                      (slot, forgetLedgerTables tickedLedgerState, tickedHeaderState)
                 , latestPerasCertOnChainRound =
                     latestPerasCertOnChainRound perasState
                 }

From a85ec153623d81e2ca5156478760071e4a87582d Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 28 Aug 2026 09:56:58 +0200
Subject: [PATCH 02/13] (temp) Add ShelleyPerasCertCompatibleWithLedger type
 class and wire Peras certs

---
 .../Consensus/Shelley/Ledger/Block.hs         |  38 +++++-
 .../Consensus/Shelley/Ledger/Forge.hs         |   1 +
 .../Ouroboros/Consensus/Shelley/Node/Peras.hs | 128 +++++++++++++++++-
 .../test/shelley-test/Main.hs                 |   2 +
 .../Test/Consensus/Shelley/Peras.hs           |  81 +++++++++++
 ouroboros-consensus.cabal                     |   2 +
 .../Ouroboros/Consensus/Peras/Error/V1.hs     |   4 +
 7 files changed, 246 insertions(+), 10 deletions(-)
 create mode 100644 ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Peras.hs

diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs
index 742b7425a6..c59178434e 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs
@@ -16,6 +16,8 @@ module Ouroboros.Consensus.Shelley.Ledger.Block
   ( GetHeader (..)
   , Header (..)
   , IsShelleyBlock
+  , ShelleyPerasCertCompatibleWithLedger (..)
+  , LedgerPerasCertError
   , NestedCtxt_ (..)
   , ShelleyBasedEra
   , ShelleyBlock (..)
@@ -50,15 +52,12 @@ import Cardano.Ledger.Binary
 import qualified Cardano.Ledger.Binary.Plain as Plain
 import qualified Cardano.Ledger.Block as SL (EraBlockHeader)
 import Cardano.Ledger.Core as SL
-  ( eraDecoder
+  ( EraBlockBody (..)
+  , eraDecoder
   , eraProtVerLow
   , toEraCBOR
   )
-import qualified Cardano.Ledger.Core as SL
-  ( TranslationContext
-  , hashBlockBody
-  , txSeqBlockBodyL
-  )
+import qualified Cardano.Ledger.Core as SL (TranslationContext)
 import Cardano.Ledger.Hashes (HASH)
 import qualified Cardano.Ledger.Shelley.API as SL
 import Cardano.Protocol.Crypto (Crypto)
@@ -144,6 +143,7 @@ class
     StateSupportsPerasEpochContext (ShelleyBlock proto era)
   , BlockSupportsPeras (ShelleyBlock proto era)
   , MaybeEraIndexedEpochToPerasRoundInfo (ShelleyBlock proto era) ~ EpochToPerasRoundInfo
+  , ShelleyPerasCertCompatibleWithLedger proto era
   ) =>
   ShelleyCompatible proto era
 
@@ -272,6 +272,32 @@ instance ShelleyCompatible proto era => HasAnnTip (ShelleyBlock proto era)
 -- "Ouroboros.Consensus.Shelley.Ledger.Ledger" module because of the
 -- dependency on the 'LedgerConfig'.
 
+{-------------------------------------------------------------------------------
+  Conversion between Peras certificates type between Ledger and Consensus
+-------------------------------------------------------------------------------}
+
+-- | Error type for Ledger <=> Consensus Peras certificate conversions.
+--
+-- NOTE: this will disappear once we have a proper type for Peras certificates
+-- in the Ledger.
+type LedgerPerasCertError = String
+
+-- | Bridge between the Peras certificates types between Consensus and Ledger
+--
+-- NOTE: this will disappear once we have a proper type for Peras certificates
+-- in the Ledger.
+class ShelleyPerasCertCompatibleWithLedger proto era where
+  -- | Extract a Peras certificate from a Shelley block body, if present
+  extractPerasCertFromShelleyBlockBody ::
+    BlockBody era ->
+    Either LedgerPerasCertError (Maybe (PerasCert (ShelleyBlock proto era)))
+
+  -- | Inject a Peras certificate into a Shelley block body
+  injectPerasCertIntoShelleyBlockBody ::
+    PerasCert (ShelleyBlock proto era) ->
+    BlockBody era ->
+    BlockBody era
+
 {-------------------------------------------------------------------------------
   Conversions
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs
index 60c96c0cdb..b62a928df9 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Forge.hs
@@ -83,6 +83,7 @@ forgeShelleyBlock
       SL.mkBasicBlockBody
         & SL.txSeqBlockBodyL
           .~ Seq.fromList (fmap extractTx fbTxs)
+        & maybe id injectPerasCertIntoShelleyBlockBody fbPerasCert
 
     actualBodySize = SL.blockBodySize protocolVersion body
 
diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
index 84e293ffcc..1334ea2533 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -11,14 +12,32 @@
 -- NOTE: this module exists solely because the orphan module
 -- 'Ouroboros.Consensus.Shelley.Node.Serialisation' needs some of these
 -- instances, but defining them there would be too confusing.
-module Ouroboros.Consensus.Shelley.Node.Peras () where
+module Ouroboros.Consensus.Shelley.Node.Peras
+  ( -- * Exported for testing purposes only
+    toOpaqueLedgerPerasCert
+  , fromOpaqueLedgerPerasCert
+  ) where
 
-import Cardano.Binary (serialize)
+import Cardano.Binary (Decoder, Encoding, FromCBOR (..), ToCBOR (..), serialize)
 import Cardano.Ledger.Api
+import qualified Cardano.Ledger.Binary as CBOR
+import qualified Cardano.Ledger.Dijkstra.BlockBody as SL
+import qualified Cardano.Ledger.Shelley.API as SL
+import qualified Codec.CBOR.Read as CBOR
 import Control.Monad (when)
+import Data.Array.Byte (ByteArray)
+import Data.Bifunctor (Bifunctor (..))
+import Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as LazyByteString
+import qualified Data.ByteString.Short as ShortByteString
+import Data.Maybe.Strict (StrictMaybe (..))
 import qualified Data.Measure as Measure
+import Data.MemPack.Buffer
+  ( byteArrayFromShortByteString
+  , byteArrayToShortByteString
+  )
 import Data.Typeable (Typeable)
+import Lens.Micro ((.~), (^.))
 import Ouroboros.Consensus.Block.SupportsPeras
   ( BlockSupportsPeras (..)
   , ValidatedPerasCert (..)
@@ -54,7 +73,11 @@ import Ouroboros.Consensus.Protocol.Abstract
   ( ChainDepStateSupportsPeras
   , ConsensusProtocol (..)
   )
-import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock (..))
+import Ouroboros.Consensus.Shelley.Ledger.Block
+  ( LedgerPerasCertError
+  , ShelleyBlock (..)
+  , ShelleyPerasCertCompatibleWithLedger (..)
+  )
 import Ouroboros.Consensus.Shelley.Ledger.Ledger ()
 import Ouroboros.Consensus.Shelley.Ledger.Mempool (AlonzoMeasure (..))
 import Ouroboros.Consensus.Ticked (Ticked)
@@ -315,4 +338,101 @@ instance
         V1.PerasCertTooLargeError sizeUpperBound dijkstraPerasMaxCertSize
     pure cert
   verifyPerasCert = defaultVerifyPerasCert
-  getPerasCertInBlock _ = Right Nothing
+  getPerasCertInBlock blk =
+    bimap V1.PerasTemporaryCertInBlockError id
+      . extractPerasCertFromShelleyBlockBody
+      . SL.blockBody
+      . shelleyBlockRaw
+      $ blk
+
+{-------------------------------------------------------------------------------
+  ShelleyPerasCertCompatibleWithLedger
+-------------------------------------------------------------------------------}
+
+-- NOTE: these instances will be removed once we have a proper type for Peras
+-- certificates in the ledger.
+
+instance ShelleyPerasCertCompatibleWithLedger proto ShelleyEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance ShelleyPerasCertCompatibleWithLedger proto AllegraEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance ShelleyPerasCertCompatibleWithLedger proto MaryEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance ShelleyPerasCertCompatibleWithLedger proto AlonzoEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance ShelleyPerasCertCompatibleWithLedger proto BabbageEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance ShelleyPerasCertCompatibleWithLedger proto ConwayEra where
+  extractPerasCertFromShelleyBlockBody _ = Right Nothing
+  injectPerasCertIntoShelleyBlockBody _ = id
+
+instance
+  Typeable proto =>
+  ShelleyPerasCertCompatibleWithLedger proto DijkstraEra
+  where
+  extractPerasCertFromShelleyBlockBody blockBody =
+    case blockBody ^. SL.perasCertBlockBodyL of
+      SNothing ->
+        Right Nothing
+      SJust ledgerCert ->
+        case fromOpaqueLedgerPerasCert ledgerCert of
+          Left err -> Left err
+          Right cert -> Right (Just cert)
+
+  injectPerasCertIntoShelleyBlockBody cert =
+    SL.perasCertBlockBodyL .~ SJust (toOpaqueLedgerPerasCert cert)
+
+toOpaqueLedgerPerasCert ::
+  Typeable blk =>
+  V1.PerasCert blk ->
+  SL.PerasCert
+toOpaqueLedgerPerasCert =
+  SL.PerasCert . toByteArray . toCBOR
+ where
+  toByteArray :: Encoding -> ByteArray
+  toByteArray =
+    byteArrayFromShortByteString
+      . ShortByteString.toShort
+      . CBOR.toStrictByteString
+
+fromOpaqueLedgerPerasCert ::
+  Typeable blk =>
+  SL.PerasCert ->
+  Either LedgerPerasCertError (V1.PerasCert blk)
+fromOpaqueLedgerPerasCert (SL.PerasCert byteArray) =
+  fromByteArray fromCBOR byteArray
+ where
+  fromByteArray ::
+    (forall s. Decoder s (V1.PerasCert blk)) ->
+    ByteArray ->
+    Either LedgerPerasCertError (V1.PerasCert blk)
+  fromByteArray decoder =
+    handleParseErrors
+      . CBOR.deserialiseFromBytes decoder
+      . LazyByteString.fromStrict
+      . ShortByteString.fromShort
+      . byteArrayToShortByteString
+
+  handleParseErrors ::
+    Either CBOR.DeserialiseFailure (ByteString, a) ->
+    Either LedgerPerasCertError a
+  handleParseErrors = \case
+    Left err -> failure err
+    Right (trailing, a)
+      | not (LazyByteString.null trailing) -> failure "trailing bytes"
+      | otherwise -> pure a
+   where
+    failure err =
+      Left $
+        "Failed to deserialize opaque Peras certificate from byte array: "
+          <> show err
diff --git a/ouroboros-consensus-cardano/test/shelley-test/Main.hs b/ouroboros-consensus-cardano/test/shelley-test/Main.hs
index 1180c51658..6418c5038c 100644
--- a/ouroboros-consensus-cardano/test/shelley-test/Main.hs
+++ b/ouroboros-consensus-cardano/test/shelley-test/Main.hs
@@ -5,6 +5,7 @@ import qualified Test.Consensus.Shelley.EndorserBlock (tests)
 import qualified Test.Consensus.Shelley.Golden (tests)
 import qualified Test.Consensus.Shelley.Integrity (tests)
 import qualified Test.Consensus.Shelley.LedgerTables (tests)
+import qualified Test.Consensus.Shelley.Peras (tests)
 import qualified Test.Consensus.Shelley.Serialisation (tests)
 import qualified Test.Consensus.Shelley.SupportedNetworkProtocolVersion (tests)
 import Test.Tasty
@@ -26,6 +27,7 @@ tests =
     , Test.Consensus.Shelley.Golden.tests
     , Test.Consensus.Shelley.Integrity.tests
     , Test.Consensus.Shelley.LedgerTables.tests
+    , Test.Consensus.Shelley.Peras.tests
     , Test.Consensus.Shelley.Serialisation.tests
     , Test.Consensus.Shelley.SupportedNetworkProtocolVersion.tests
     , Test.ThreadNet.Shelley.tests
diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Peras.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Peras.hs
new file mode 100644
index 0000000000..f876d0e5ed
--- /dev/null
+++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Peras.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Consensus.Shelley.Peras (tests) where
+
+import Cardano.Binary (ToCBOR (..))
+import qualified Cardano.Ledger.Dijkstra.BlockBody as SL
+import qualified Codec.CBOR.Write as CBOR
+import qualified Data.ByteString.Short as Short
+import Data.MemPack.Buffer (byteArrayFromShortByteString)
+import Ouroboros.Consensus.Block (Point (..))
+import Ouroboros.Consensus.Block.SupportsPeras (PerasCert)
+import Ouroboros.Consensus.Peras.Cert.Mock (MockPerasCert (..))
+import Ouroboros.Consensus.Shelley.HFEras (StandardDijkstraBlock)
+import Ouroboros.Consensus.Shelley.Node.Peras
+  ( fromOpaqueLedgerPerasCert
+  , toOpaqueLedgerPerasCert
+  )
+import Test.Ouroboros.Storage.TestBlock (TestBlock)
+import Test.QuickCheck
+  ( Gen
+  , Property
+  , counterexample
+  , forAll
+  , property
+  , (===)
+  )
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+import Test.Util.Peras (genPerasCert)
+import Test.Util.Peras.Common (genRoundNo)
+import Test.Util.Peras.Mock (genMockPerasVoterIndices)
+
+tests :: TestTree
+tests =
+  testGroup
+    "ShelleyBlockPerasCert"
+    [ testProperty
+        "Roundtrip through ShelleyBlockPerasCert for Dijkstra"
+        prop_DijkstraPerasCertRoundtrip
+    , testProperty
+        "Deserializing an invalid Dijkstra Peras certificate fails"
+        prop_DijkstraPerasCertRoundtripError
+    ]
+
+prop_DijkstraPerasCertRoundtrip :: Property
+prop_DijkstraPerasCertRoundtrip =
+  forAll (genPerasCert @StandardDijkstraBlock True) $ \cert -> do
+    let ledgerCert = toOpaqueLedgerPerasCert cert
+    counterexample ("Ledger cert: " <> show ledgerCert) $
+      fromOpaqueLedgerPerasCert ledgerCert === Right cert
+
+prop_DijkstraPerasCertRoundtripError :: Property
+prop_DijkstraPerasCertRoundtripError =
+  forAll genInvalidLedgerPerasCert $ \ledgerCert ->
+    case fromOpaqueLedgerPerasCert ledgerCert of
+      Left _ ->
+        property True
+      Right (cert :: PerasCert StandardDijkstraBlock) ->
+        counterexample
+          ("Didn't fail to decode an invalid Dijkstra cert from: " <> show cert)
+          $ False
+
+-- | Generate an invalid ledger Peras cert by serializing a random mocked one.
+genInvalidLedgerPerasCert :: Gen SL.PerasCert
+genInvalidLedgerPerasCert = do
+  mockCertRound <- genRoundNo
+  mockCertVoters <- genMockPerasVoterIndices
+  let mockCertBlock = GenesisPoint @TestBlock
+  pure
+    . SL.PerasCert
+    . byteArrayFromShortByteString
+    . Short.toShort
+    . CBOR.toStrictByteString
+    . toCBOR
+    $ MockPerasCert
+      { mockCertRound
+      , mockCertBlock
+      , mockCertVoters
+      }
diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index 727a384c08..f9ba662aa1 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -1865,6 +1865,7 @@ test-suite shelley-test
     Test.Consensus.Shelley.Golden
     Test.Consensus.Shelley.Integrity
     Test.Consensus.Shelley.LedgerTables
+    Test.Consensus.Shelley.Peras
     Test.Consensus.Shelley.Serialisation
     Test.Consensus.Shelley.SupportedNetworkProtocolVersion
     Test.ThreadNet.Shelley
@@ -1872,6 +1873,7 @@ test-suite shelley-test
   build-depends:
     base,
     bytestring,
+    cardano-binary,
     cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
     cardano-ledger-api,
     cardano-ledger-babbage:testlib,
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Error/V1.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Error/V1.hs
index 52e4886656..4b8887df71 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Error/V1.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Error/V1.hs
@@ -41,6 +41,10 @@ data PerasError blk
       PerasCertSize
       -- | Actual size
       PerasCertSize
+  | PerasTemporaryPublicKeyHackError
+      String
+  | PerasTemporaryCertInBlockError
+      String
 
 deriving instance
   Show (PerasVotingCommitteeError blk) =>

From 6bec9672898420bacfdeb00cd5996cb0aa236ae8 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 28 Aug 2026 10:15:27 +0200
Subject: [PATCH 03/13] (temp) Add unsafe BLS helpers to read data from the
 environment

---
 ouroboros-consensus.cabal                     |   1 +
 .../Consensus/Peras/Crypto/BLS/Unsafe.hs      | 119 ++++++++++++++++++
 2 files changed, 120 insertions(+)
 create mode 100644 ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Crypto/BLS/Unsafe.hs

diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal
index f9ba662aa1..1e8965033d 100644
--- a/ouroboros-consensus.cabal
+++ b/ouroboros-consensus.cabal
@@ -249,6 +249,7 @@ library
     Ouroboros.Consensus.Peras.Cert.V1
     Ouroboros.Consensus.Peras.Context
     Ouroboros.Consensus.Peras.Crypto.BLS
+    Ouroboros.Consensus.Peras.Crypto.BLS.Unsafe
     Ouroboros.Consensus.Peras.Crypto.Mock
     Ouroboros.Consensus.Peras.Error.Mock
     Ouroboros.Consensus.Peras.Error.V1
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Crypto/BLS/Unsafe.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Crypto/BLS/Unsafe.hs
new file mode 100644
index 0000000000..2220fc11c9
--- /dev/null
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Crypto/BLS/Unsafe.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Temporary hack for retrieving BLS keys from the environment.
+--
+-- * Our private key can be read directly from the value of the environment
+-- variable 'PERAS_PRIVATE_KEY'.
+--
+-- * Public keys from all nodes (including oneself) can be read from a JSON file
+-- specified in the environment variable 'PERAS_PUBLIC_KEY_FILE'.
+--
+-- NOTE: keys read using this module always have the "TESTNET" scope.
+--
+-- WARNING: this is a temporary hack for testing purposes, and should not be
+-- used under any circumstances in production. This will be replaced with proper
+-- on-chain key registration in the future.
+module Ouroboros.Consensus.Peras.Crypto.BLS.Unsafe
+  ( unsafePerasBLSPrivateKeyFromEnv
+  , unsafeExtendPerasStakeDistrWithPublicKeysFromEnv
+  , unsafePerasBLSPublicKeysFromEnv
+  ) where
+
+import Cardano.Ledger.State (IndividualPoolStake (..), PoolDistr (..))
+import Data.Aeson (eitherDecodeFileStrict')
+import qualified Data.ByteString.Base16 as B16
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.String (IsString (..))
+import qualified Ouroboros.Consensus.Committee.Crypto.BLS as BLS
+import Ouroboros.Consensus.Committee.Types (LedgerStake (..), PoolId (..))
+import Ouroboros.Consensus.Peras.Crypto.BLS (PerasPrivateKey (..), PerasPublicKey (..))
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
+
+keyScope :: BLS.KeyScope
+keyScope = "TESTNET"
+
+-- | Read a private key from the environment variable 'PERAS_PRIVATE_KEY'
+unsafePerasBLSPrivateKeyFromEnv :: Either String PerasPrivateKey
+unsafePerasBLSPrivateKeyFromEnv =
+  unsafePerformIO $
+    lookupEnv envVar >>= \case
+      Nothing ->
+        pure $ Left $ "Environment variable " <> envVar <> "not set."
+      Just rawKey ->
+        pure $ decodeKey rawKey
+ where
+  envVar =
+    "PERAS_PRIVATE_KEY"
+
+  decodeKey key =
+    case B16.decode (fromString key) of
+      Left msg ->
+        Left $ "Invalid private key format: " <> msg
+      Right keyBytes -> do
+        case BLS.rawDeserialisePrivateKey keyScope keyBytes of
+          Nothing -> do
+            Left $ "Invalid private key format: " <> key
+          Just sk -> do
+            Right $ PerasPrivateKey sk
+{-# NOINLINE unsafePerasBLSPrivateKeyFromEnv #-}
+
+-- | Extend a given 'PoolDistr' with the corresponding BLS public keys for each
+-- pool retrieved from the JSON file specified in the environment variable
+-- 'PERAS_PUBLIC_KEY_FILE'.
+--
+-- WARNING: this is a temporary hack for testing purposes, and should not be
+-- used under any circumstances in production. This will be replaced with proper
+-- on-chain key registration in the future.
+unsafeExtendPerasStakeDistrWithPublicKeysFromEnv ::
+  PoolDistr ->
+  Either
+    String
+    (Map PoolId (LedgerStake, PerasPublicKey))
+unsafeExtendPerasStakeDistrWithPublicKeysFromEnv poolDistr = do
+  publicKeys <- unsafePerasBLSPublicKeysFromEnv -- uses 'unsafePerformIO'
+  Map.traverseWithKey
+    ( \poolId stake -> do
+        let ledgerStake =
+              LedgerStake (individualPoolStake stake)
+        case Map.lookup poolId publicKeys of
+          Nothing ->
+            Left ("Public key not found for pool: " <> show poolId)
+          Just publicKey ->
+            Right (ledgerStake, publicKey)
+    )
+    . Map.mapKeysMonotonic PoolId
+    . unPoolDistr
+    $ poolDistr
+
+-- | Retrieve the BLS public keys for the Peras committee members from a JSON
+-- file specified in the environment variable 'PERAS_PUBLIC_KEY_FILE'.
+--
+-- WARNING: this is a temporary hack for testing purposes, and should not be
+-- used under any circumstances in production. This will be replaced with proper
+-- on-chain key registration in the future.
+unsafePerasBLSPublicKeysFromEnv :: Either String (Map PoolId PerasPublicKey)
+unsafePerasBLSPublicKeysFromEnv =
+  unsafePerformIO $
+    lookupEnv envVar >>= \case
+      Nothing -> do
+        pure $ Left $ "Environment variable " <> envVar <> " not set."
+      Just keysFile -> do
+        eitherDecodeFileStrict' keysFile >>= \case
+          Left err -> do
+            pure $ Left $ "Failed to parse public keys from file: " <> err
+          Right rawKeys -> do
+            pure $ traverse decodeKey (Map.mapKeysMonotonic PoolId rawKeys)
+ where
+  envVar =
+    "PERAS_PUBLIC_KEY_FILE"
+
+  decodeKey key =
+    case BLS.rawDeserialisePublicKey keyScope (fromString key) of
+      Nothing ->
+        Left $ "Invalid public key format: " <> key
+      Just pk ->
+        Right $ PerasPublicKey pk
+{-# NOINLINE unsafePerasBLSPublicKeysFromEnv #-}

From d92899e78f6c8f41dffb8ed6bfeb9aec91e120a7 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Tue, 8 Sep 2026 11:43:07 +0200
Subject: [PATCH 04/13] (temp) Read public keys from the environment

---
 .../Ouroboros/Consensus/Peras/Voting/V1.hs                | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/V1.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/V1.hs
index 350ef27050..b2ae012222 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/V1.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/V1.hs
@@ -33,6 +33,9 @@ import Ouroboros.Consensus.Ledger.SupportsPeras
   ( LedgerStateSupportsPeras (..)
   )
 import Ouroboros.Consensus.Peras.Crypto.BLS (PerasBLSCrypto, PerasPublicKey (..))
+import Ouroboros.Consensus.Peras.Crypto.BLS.Unsafe
+  ( unsafeExtendPerasStakeDistrWithPublicKeysFromEnv
+  )
 import qualified Ouroboros.Consensus.Peras.Error.V1 as V1
 import Ouroboros.Consensus.Protocol.Abstract (ChainDepStateSupportsPeras (..))
 
@@ -77,7 +80,10 @@ mkPerasVotingCommitteeInput ::
 mkPerasVotingCommitteeInput ledgerState headerState = do
   let epochNonce = getEpochNonce headerState
       poolDistr = getPoolDistr ledgerState
-      stakeDistrWithPublicKeys = extractPerasStakeDistrAndPublicKeys poolDistr
+  -- TODO: replace the following hack with proper on-chain key registration.
+  stakeDistrWithPublicKeys <-
+    bimap V1.PerasTemporaryPublicKeyHackError id $
+      unsafeExtendPerasStakeDistrWithPublicKeysFromEnv poolDistr
   extWFAStakeDistr <-
     bimap V1.PerasVotingWFAError id $
       mkExtWFAStakeDistr

From 0f8de0ca597092b22d19baf57095565b923c8d18 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 28 Aug 2026 10:37:56 +0200
Subject: [PATCH 05/13] (temp) Extend BlockSupportsPeras to read private key
 and pool ID from the environment

---
 .../Ouroboros/Consensus/Shelley/Node/Peras.hs |  5 ++
 .../Consensus/Block/SupportsPeras.hs          | 53 +++++++++++++++++++
 .../Consensus/HardFork/Combinator/Basics.hs   | 16 ++++++
 3 files changed, 74 insertions(+)

diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
index 1334ea2533..f5c4b44567 100644
--- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
+++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Peras.hs
@@ -65,6 +65,9 @@ import Ouroboros.Consensus.Peras.Context
   , mkBoundedPerasEpochContextWith
   )
 import qualified Ouroboros.Consensus.Peras.Crypto.BLS as BLS
+import Ouroboros.Consensus.Peras.Crypto.BLS.Unsafe
+  ( unsafePerasBLSPrivateKeyFromEnv
+  )
 import qualified Ouroboros.Consensus.Peras.Error.V1 as V1
 import Ouroboros.Consensus.Peras.Params (dijkstraPerasMaxCertSize)
 import qualified Ouroboros.Consensus.Peras.Vote.V1 as V1
@@ -344,6 +347,8 @@ instance
       . SL.blockBody
       . shelleyBlockRaw
       $ blk
+  readPerasPrivateKeyFromEnv _ =
+    unsafePerasBLSPrivateKeyFromEnv
 
 {-------------------------------------------------------------------------------
   ShelleyPerasCertCompatibleWithLedger
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
index fefda33bad..78324e76d9 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs
@@ -1,10 +1,15 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -64,6 +69,8 @@ module Ouroboros.Consensus.Block.SupportsPeras
   ) where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeListLenOf, encodeListLen)
+import qualified Cardano.Crypto.Hash as Hash
+import Cardano.Ledger.Hashes (KeyHash (..))
 import Control.Exception (assert)
 import Control.Exception.Base (Exception)
 import Control.Monad.Error.Class (MonadError (..))
@@ -95,6 +102,9 @@ import Ouroboros.Consensus.Peras.Types
 import Ouroboros.Consensus.Peras.Void
 import Ouroboros.Consensus.Peras.Vote.Class
 import Ouroboros.Consensus.Peras.Voting.Adapter
+import Ouroboros.Consensus.Util.Orphans ()
+import System.Environment (lookupEnv)
+import System.IO.Unsafe (unsafePerformIO)
 
 -- * Voting committee types for Peras
 
@@ -282,6 +292,49 @@ class
     blk ->
     Either (PerasError blk) (Maybe (PerasCert blk))
 
+  -- | Read the private key for Peras voting from the env vars.
+  --
+  -- NOTE: this is a temporary workaround for testnet, this is supposed to be
+  -- replaced for Peras-to-mainnet with proper key registration and retrieval
+  -- mechanisms.
+  readPerasPrivateKeyFromEnv ::
+    proxy blk ->
+    Either String (PrivateKey (PerasCrypto blk))
+  default readPerasPrivateKeyFromEnv ::
+    PrivateKey (PerasCrypto blk) ~ () =>
+    proxy blk ->
+    Either String (PrivateKey (PerasCrypto blk))
+  readPerasPrivateKeyFromEnv _ =
+    Right ()
+
+  -- | Read the PoolId from the environment variable 'PERAS_POOL_ID'.
+  --
+  -- NOTE: this is a temporary workaround for testnet, we still need to figure
+  -- out how to properly thread the PoolId throughout a node creation for
+  -- Peras-to-mainnet.
+  readPerasPoolIdFromEnv ::
+    proxy blk ->
+    Either String PoolId
+  default readPerasPoolIdFromEnv ::
+    proxy blk ->
+    Either String PoolId
+  readPerasPoolIdFromEnv _ =
+    unsafePerformIO $
+      lookupEnv envVar >>= \case
+        Nothing -> do
+          pure $ Left $ "Environment variable " <> envVar <> "not set."
+        Just rawKey -> do
+          pure $ decodeKey rawKey
+   where
+    envVar =
+      "PERAS_POOL_ID"
+
+    decodeKey key =
+      case Hash.hashFromStringAsHex key of
+        Just hash -> Right $ PoolId (KeyHash hash)
+        Nothing -> Left $ "failed to decode PoolId, invalid hash bytes: " <> show key
+  {-# NOINLINE readPerasPoolIdFromEnv #-}
+
 -- | Forge a Peras vote if the given pool is eligible to vote in the given round.
 defaultForgePerasVoteIfEligible ::
   forall blk.
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Basics.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Basics.hs
index af2eb5f5d5..9c0c8c2edc 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Basics.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Basics.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -751,6 +752,21 @@ instance
         )
       $ nsBlock
 
+  readPerasPrivateKeyFromEnv _proxy =
+    fmap PerEraPerasPrivateKey $
+      hsequence' $
+        hcpure proxySingle dispatchReadKey
+   where
+    dispatchReadKey ::
+      forall blk.
+      SingleEraBlock blk =>
+      (Either String :.: WrapPerasPrivateKey) blk
+    dispatchReadKey =
+      Comp
+        . fmap WrapPerasPrivateKey
+        . readPerasPrivateKeyFromEnv
+        $ Proxy @blk
+
 {-------------------------------------------------------------------------------
   LedgerSupportsPeras
 -------------------------------------------------------------------------------}

From efd7f149a2e3fbbd1325cb8ed0c5c898a2230275 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 28 Aug 2026 10:44:58 +0200
Subject: [PATCH 06/13] Implement Peras voting and certificate inclusion
 controllers

---
 .../Ouroboros/Consensus/NodeKernel.hs         | 223 ++++++++++++++++--
 .../Ouroboros/Consensus/NodeKernel/Forge.hs   |   7 +-
 .../Consensus/Peras/Cert/Inclusion/Trace.hs   |  18 ++
 .../Ouroboros/Consensus/Peras/Voting/Trace.hs |   7 +
 .../Ouroboros/Consensus/Tracing/Consensus.hs  |  65 +++++
 5 files changed, 298 insertions(+), 22 deletions(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index 376c0e757c..641fb7042b 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Ouroboros.Consensus.NodeKernel
   ( -- * Node kernel
@@ -21,7 +22,7 @@ module Ouroboros.Consensus.NodeKernel
   , toConsensusMode
   ) where
 
-import Cardano.Base.FeatureFlags (CardanoFeatureFlag)
+import Cardano.Base.FeatureFlags (CardanoFeatureFlag (..))
 import Cardano.Network.ConsensusMode (ConsensusMode (..))
 import Cardano.Network.LedgerStateJudgement (LedgerStateJudgement (..))
 import Cardano.Network.NodeToNode
@@ -37,6 +38,8 @@ import qualified Control.Concurrent.Class.MonadSTM.Strict as StrictSTM
 import Control.DeepSeq (force)
 import Control.Monad
 import qualified Control.Monad.Class.MonadTimer.SI as SI
+import Control.Monad.Trans.Maybe (hoistMaybe, runMaybeT)
+import Control.Monad.Writer (runWriterT, tell)
 import Control.ResourceRegistry
 import Control.Tracer
 import Data.Bifunctor (second)
@@ -49,13 +52,18 @@ import Data.Hashable (Hashable)
 import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Set (Set)
+import Data.Proxy
+import Data.Set (Set, member)
 import qualified Data.Text as Text
 import Data.Void (Void)
+import Data.Word (Word64)
 import Ouroboros.Consensus.Block hiding (blockMatchesHeader)
 import Ouroboros.Consensus.BlockchainTime
 import Ouroboros.Consensus.Config
 import Ouroboros.Consensus.Genesis.Governor (gddWatcher)
+import Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory)
+import qualified Ouroboros.Consensus.HardFork.History.EraParams as HF
+import Ouroboros.Consensus.HardFork.History.Qry (slotToPerasRoundNo')
 import Ouroboros.Consensus.HeaderValidation
 import Ouroboros.Consensus.Ledger.Abstract
 import Ouroboros.Consensus.Ledger.Extended
@@ -91,9 +99,17 @@ import Ouroboros.Consensus.Node.Genesis
 import Ouroboros.Consensus.Node.Run
 import Ouroboros.Consensus.Node.Tracers
 import Ouroboros.Consensus.NodeKernel.Forge (forge)
+import Ouroboros.Consensus.Peras.Cert.Inclusion (PerasCertInclusionRulesDecision (..))
+import Ouroboros.Consensus.Peras.Context
+  ( forgePerasVoteIfEligibleWithHandle
+  , runQueryWithContextHandle
+  )
+import Ouroboros.Consensus.Peras.Voting.Rules (PerasVotingRulesDecision (..))
 import Ouroboros.Consensus.Protocol.Abstract
 import Ouroboros.Consensus.Storage.ChainDB.API
   ( ChainDB
+  , isPerasVotingAllowedWithHandle
+  , needCertWithHandle
   )
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB)
@@ -252,11 +268,13 @@ initNodeKernel
   args@NodeKernelArgs
     { registry
     , cfg
+    , featureFlags
     , tracers
     , chainDB
     , initChainDB
     , blockFetchConfiguration
     , btime
+    , systemTime
     , gsmArgs
     , peerSharingRng
     , publicPeerSelectionStateVar
@@ -401,6 +419,12 @@ initNodeKernel
           sharedTxStateVar
           peerTxRegistry
 
+    void $
+      forkLinkedWatcher registry "NodeKernel.perasVoteForging" $
+        knownSlotWatcher btime $ \currentSlot ->
+          whenPerasEnabled currentSlot $ \roundInfo ->
+            withEarlyExit_ $ perasVoteForgingController systemTime st roundInfo
+
     return
       NodeKernel
         { getChainDB = chainDB
@@ -426,6 +450,26 @@ initNodeKernel
         , getLeiosNotifyClientStates = leiosNotifyClientStates
         }
    where
+    -- Start a thread conditionally when the PerasFlag is provided and the
+    -- current block type supports Peras.
+    whenPerasEnabled currentSlot f =
+      if PerasFlag `member` featureFlags
+        then do
+          roundInfo <- atomically $ do
+            runQueryWithContextHandle
+              (ChainDB.getTimeResolutionContextHandle chainDB)
+              (slotToPerasRoundNo' currentSlot)
+              >>= \case
+                Left err -> throwSTM err
+                -- We don't know whether Peras is enabled at this point.
+                -- Abort if it isn't.
+                Right HF.NoPerasEnabled -> pure Nothing
+                Right (HF.PerasEnabled roundInfo) -> pure (Just roundInfo)
+          case roundInfo of
+            Nothing -> pure ()
+            Just roundInfo' -> f roundInfo'
+        else pure ()
+
     blockForgingController ::
       InternalState m remotePeer localPeer blk ->
       STM m [MkBlockForging m blk] ->
@@ -439,6 +483,93 @@ initNodeKernel
         blockForging' <- traverse (forkBlockForging st) blockForging
         go blockForging'
 
+perasVoteForgingController ::
+  forall m remotePeer localPeer blk.
+  ( IOLike m
+  , BlockSupportsPeras blk
+  ) =>
+  SystemTime m ->
+  InternalState m remotePeer localPeer blk ->
+  (PerasRoundNo, Word64) ->
+  WithEarlyExit m ()
+perasVoteForgingController
+  systemTime
+  IS{chainDB, tracers}
+  (roundNo, slotInRound) = do
+    -- Get crypto data from environment variables
+    -- TODO: move the code outside of the vote forging controller once
+    -- they are properly obtained from the ledger/context.
+    poolId <- case readPerasPoolIdFromEnv (Proxy @blk) of
+      Left err -> do
+        tracePerasVoteForging $ TracePerasVotingCantReadEnv err
+        exitEarly
+      Right poolId -> pure poolId
+
+    privateKey <- case readPerasPrivateKeyFromEnv (Proxy @blk) of
+      Left err -> do
+        tracePerasVoteForging $ TracePerasVotingCantReadEnv err
+        exitEarly
+      Right privateKey -> pure privateKey
+
+    -- We run all 3 STM computations in a WriterT monad so that we can have proper logging,
+    -- while keeping everything in the same transaction. We also use MaybeT because there is
+    -- a natural abort/continue logic within the transaction. Unfortunately, we can't leverage
+    -- the outer WithEarlyExit monad, because we _always_ want to get the trace.
+    (mbPerasVote, traceEvents) <-
+      lift $ atomically $ runWriterT $ runMaybeT $ do
+        -- Is this the first slot in the round? If not, we don't forge a vote.
+        when (slotInRound /= 0) $ do
+          tell [TracePerasVotingNoVoteAfterFirstSlotInRound roundNo slotInRound]
+          hoistMaybe Nothing
+        -- Do the voting rules state that we should vote? And if so, for which block?
+        votingDecision <-
+          lift . lift $
+            isPerasVotingAllowedWithHandle
+              (ChainDB.getPerasVotingViewHandle chainDB)
+              roundNo
+        case votingDecision of
+          Left err -> do
+            tell [TracePerasVotingViewError roundNo err]
+            hoistMaybe Nothing
+          Right decision -> do
+            tell [TracePerasVotingRulesDecision roundNo decision]
+            case decision of
+              NoVote _evidence -> do
+                hoistMaybe Nothing
+              Vote _evidence candidateBlock -> do
+                -- Forge the vote if eligible in this round.
+                mbVote <-
+                  lift . lift $
+                    forgePerasVoteIfEligibleWithHandle
+                      (ChainDB.getPerasEpochContextResolverHandle chainDB)
+                      poolId
+                      privateKey
+                      roundNo
+                      candidateBlock
+                case mbVote of
+                  Nothing -> do
+                    tell [TracePerasVotingNotAVoterInRound roundNo]
+                    hoistMaybe Nothing
+                  Just vote ->
+                    pure vote
+
+    traverse_ tracePerasVoteForging traceEvents
+
+    vote <- maybe exitEarly pure mbPerasVote
+    tickedVote <- lift $ addArrivalTime systemTime vote
+    tracePerasVoteForging $ TracePerasVotingForgedVote roundNo tickedVote
+    -- Add vote and potential cert to the DB
+    (addVoteResult, mAddCertChainSelOutcome) <- lift $ ChainDB.addPerasVoteSync chainDB tickedVote
+    tracePerasVoteForging $ TracePerasVotingAddVoteResult roundNo addVoteResult
+    traverse_
+      (tracePerasVoteForging . TracePerasVotingAddCertChainSelOutcome roundNo)
+      mAddCertChainSelOutcome
+   where
+    tracePerasVoteForging :: TracePerasVoteForgingEvent blk -> WithEarlyExit m ()
+    tracePerasVoteForging =
+      lift
+        . traceWith (perasVoteForgingTracer tracers)
+
 castTraceFetchDecision ::
   forall remotePeer blk.
   TraceDecisionEvent remotePeer (HeaderWithTime blk) -> TraceDecisionEvent remotePeer (Header blk)
@@ -554,23 +685,23 @@ forkBlockForging ::
   MkBlockForging m blk ->
   m (Thread m Void)
 forkBlockForging IS{..} (MkBlockForging blockForgingM) =
-  forkLinkedWatcherAllocate
-    registry
-    label
-    blockForgingMLabel
-    finalize
-    ( \bf -> knownSlotWatcher btime $
-        \currentSlot ->
-          withEarlyExit_ $
-            forge
-              (forgeTracer tracers)
-              (forgeStateInfoTracer tracers)
-              cfg
-              chainDB
-              mempool
-              bf
-              currentSlot
-    )
+  forkLinkedWatcherAllocate registry label blockForgingMLabel finalize $ \bf ->
+    knownSlotWatcher btime $ \currentSlot -> do
+      mbPerasCert <-
+        checkPerasCertInclusion
+          (perasCertInclusionTracer tracers)
+          chainDB
+          currentSlot
+      withEarlyExit_ $
+        forge
+          (forgeTracer tracers)
+          (forgeStateInfoTracer tracers)
+          cfg
+          chainDB
+          mempool
+          bf
+          currentSlot
+          mbPerasCert
  where
   label :: String
   label = "NodeKernel.blockForging"
@@ -580,6 +711,60 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
     labelThisThread $ Text.unpack $ forgeLabel bf
     pure bf
 
+-- | Decide if we need to include a Peras certificate in the block we are
+-- forging in the current slot.
+checkPerasCertInclusion ::
+  forall m blk.
+  ( IOLike m
+  , HasHardForkHistory blk
+  ) =>
+  Tracer m (TracePerasCertInclusionEvent blk) ->
+  ChainDB m blk ->
+  SlotNo ->
+  m (Maybe (PerasCert blk))
+checkPerasCertInclusion certInclusionTracer chainDB currentSlot = do
+  (mbPerasCert, traceEvents) <-
+    atomically $ runWriterT $ runMaybeT $ do
+      -- First we need to find out if Peras is enabled and if so, in which
+      -- round we are currently in.
+      mbRoundInfo <-
+        lift . lift $
+          runQueryWithContextHandle
+            (ChainDB.getTimeResolutionContextHandle chainDB)
+            (slotToPerasRoundNo' currentSlot)
+      case mbRoundInfo of
+        Left pastHorizon -> do
+          tell [TracePerasCertInclusionPastHorizonException currentSlot (show pastHorizon)]
+          hoistMaybe Nothing
+        Right HF.NoPerasEnabled -> do
+          tell [TracePerasCertInclusionNotEnabledForRound currentSlot]
+          hoistMaybe Nothing
+        Right (HF.PerasEnabled (currentRoundNo, _slotsInRound)) -> do
+          -- Peras is enabled, the next step is to check if a Peras
+          -- certificate needs to be included in this block when in this round.
+          certInclusionDecision <-
+            lift . lift $
+              needCertWithHandle
+                (ChainDB.getPerasCertInclusionViewHandle chainDB)
+                currentRoundNo
+          case certInclusionDecision of
+            Left err -> do
+              tell [TracePerasCertInclusionError currentSlot err]
+              hoistMaybe Nothing
+            Right Nothing -> do
+              tell [TracePerasCertInclusionNoCertToInclude currentSlot]
+              hoistMaybe Nothing
+            Right (Just decision) -> do
+              tell [TracePerasCertInclusionRulesDecision currentSlot currentRoundNo decision]
+              case decision of
+                DoNotIncludeCert _evidence ->
+                  hoistMaybe Nothing
+                IncludeCert _evidence cert ->
+                  pure $ vpcCert (forgetArrivalTime cert)
+
+  traverse_ (traceWith certInclusionTracer) traceEvents
+  return mbPerasCert
+
 {-------------------------------------------------------------------------------
   TxSubmission integration
 -------------------------------------------------------------------------------}
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
index f4407a3e16..774a7aea5e 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
@@ -68,8 +68,9 @@ forge ::
   Mempool m blk ->
   BlockForging m blk ->
   SlotNo ->
+  Maybe (PerasCert blk) ->
   WithEarlyExit m ()
-forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging currentSlot = do
+forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging currentSlot mbPerasCert = do
   let trace :: TraceForgeEvent blk -> WithEarlyExit m ()
       trace =
         lift
@@ -121,13 +122,13 @@ forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging cur
             currentSlot
             tickedLedgerState
             forker
-            Nothing -- NOTE: no Peras cert to include for now
+            mbPerasCert
         let fbArgs =
               Block.ForgeBlockArgs
                 { Block.fbConfig = cfg
                 , Block.fbCurrentBlockNo = bcBlockNo
                 , Block.fbCurrentSlotNo = currentSlot
-                , Block.fbPerasCert = Nothing -- No PerasCert for now
+                , Block.fbPerasCert = mbPerasCert
                 , Block.fbCurrentTickedLedgerState = forgetLedgerTables tickedLedgerState
                 , Block.fbTxs = txs
                 , Block.fbIsLeader = proof
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Cert/Inclusion/Trace.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Cert/Inclusion/Trace.hs
index d308ecaf5b..15ad45d2bd 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Cert/Inclusion/Trace.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Cert/Inclusion/Trace.hs
@@ -15,6 +15,7 @@ import Ouroboros.Consensus.Block.SupportsPeras (PerasCert, ValidatedPerasCert)
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
 import Ouroboros.Consensus.Peras.Cert.Inclusion (PerasCertInclusionRulesDecision)
 import Ouroboros.Consensus.Peras.Types (PerasRoundNo)
+import Ouroboros.Consensus.Storage.ChainDB.API (PerasCertInclusionViewError)
 
 -- | Peras certificate inclusion events.
 data TracePerasCertInclusionEvent blk
@@ -30,6 +31,23 @@ data TracePerasCertInclusionEvent blk
       PerasRoundNo
       -- | The reason to include or not include a certificate
       (PerasCertInclusionRulesDecision (WithArrivalTime (ValidatedPerasCert blk)))
+  | -- | Peras is not enabled for the current round
+    TracePerasCertInclusionNotEnabledForRound
+      -- | The current slot number
+      SlotNo
+  | -- | We triggered a 'PastHorizonException' while trying to find the round
+    -- number corresponding to the current slot number
+    TracePerasCertInclusionPastHorizonException
+      -- | The current slot number
+      SlotNo
+      -- | Serialised 'PastHorizonException'
+      String
+  | -- There was an error during the evaluation of the certificate inclusion rules
+    TracePerasCertInclusionError
+      -- | The current slot number
+      SlotNo
+      -- | The error encountered during the evaluation of the inclusion rules
+      PerasCertInclusionViewError
 
 deriving instance
   Show (PerasCert blk) =>
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/Trace.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/Trace.hs
index 459676e940..aa0ac9f855 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/Trace.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/Trace.hs
@@ -23,6 +23,7 @@ import Ouroboros.Consensus.Peras.Voting.Rules (PerasVotingRulesDecision)
 import Ouroboros.Consensus.Storage.ChainDB
   ( AddPerasCertChainSelOutcome
   , AddPerasVoteResult
+  , PerasVotingViewError
   )
 
 -- | Peras vote forging events.
@@ -61,6 +62,12 @@ data TracePerasVoteForgingEvent blk
       PerasRoundNo
       -- | The result of adding the certificate to the chain
       AddPerasCertChainSelOutcome
+  | -- | An error occurred while trying to evaluate the voting rules
+    TracePerasVotingViewError
+      -- | The current round number
+      PerasRoundNo
+      -- | The error that occurred while trying to evaluate the voting rules
+      PerasVotingViewError
   | -- | TODO: get rid of this when we no longer read stuff from env variables
     TracePerasVotingCantReadEnv String
 
diff --git a/tracing/Ouroboros/Consensus/Tracing/Consensus.hs b/tracing/Ouroboros/Consensus/Tracing/Consensus.hs
index dd70a2879c..648301163a 100644
--- a/tracing/Ouroboros/Consensus/Tracing/Consensus.hs
+++ b/tracing/Ouroboros/Consensus/Tracing/Consensus.hs
@@ -2811,6 +2811,23 @@ instance
         , "round" .= unPerasRoundNo roundNo
         , "decision" .= String (showT decision)
         ]
+    TracePerasCertInclusionNotEnabledForRound slotNo ->
+      mconcat
+        [ "kind" .= String "TracePerasCertInclusionNotEnabledForRound"
+        , "slot" .= unSlotNo slotNo
+        ]
+    TracePerasCertInclusionPastHorizonException slotNo err ->
+      mconcat
+        [ "kind" .= String "TracePerasCertInclusionPastHorizonException"
+        , "slot" .= unSlotNo slotNo
+        , "error" .= String (showT err)
+        ]
+    TracePerasCertInclusionError slotNo err ->
+      mconcat
+        [ "kind" .= String "TracePerasCertInclusionError"
+        , "slot" .= unSlotNo slotNo
+        , "error" .= String (showT err)
+        ]
 
   forHuman = \case
     TracePerasCertInclusionNoCertToInclude slotNo ->
@@ -2823,15 +2840,37 @@ instance
         <> showT (unSlotNo slotNo)
         <> ", round "
         <> showT (unPerasRoundNo roundNo)
+    TracePerasCertInclusionNotEnabledForRound slotNo ->
+      "Peras is not enabled for the round containing slot "
+        <> showT (unSlotNo slotNo)
+    TracePerasCertInclusionPastHorizonException slotNo err ->
+      "Encountered a past horizon exception while determining the Peras round for slot "
+        <> showT (unSlotNo slotNo)
+        <> ": "
+        <> showT err
+    TracePerasCertInclusionError slotNo err ->
+      "Error evaluating Peras certificate inclusion rules for slot "
+        <> showT (unSlotNo slotNo)
+        <> ": "
+        <> showT err
 
 instance MetaTrace (TracePerasCertInclusionEvent blk) where
   namespaceFor TracePerasCertInclusionNoCertToInclude{} =
     Namespace [] ["NoCertToInclude"]
   namespaceFor TracePerasCertInclusionRulesDecision{} =
     Namespace [] ["RulesDecision"]
+  namespaceFor TracePerasCertInclusionNotEnabledForRound{} =
+    Namespace [] ["NotEnabledForRound"]
+  namespaceFor TracePerasCertInclusionPastHorizonException{} =
+    Namespace [] ["PastHorizonException"]
+  namespaceFor TracePerasCertInclusionError{} =
+    Namespace [] ["Error"]
 
   severityFor (Namespace _ ["NoCertToInclude"]) _ = Just Debug
   severityFor (Namespace _ ["RulesDecision"]) _ = Just Info
+  severityFor (Namespace _ ["NotEnabledForRound"]) _ = Just Debug
+  severityFor (Namespace _ ["PastHorizonException"]) _ = Just Warning
+  severityFor (Namespace _ ["Error"]) _ = Just Error
   severityFor _ _ = Nothing
 
   documentFor (Namespace _ ["NoCertToInclude"]) =
@@ -2841,11 +2880,20 @@ instance MetaTrace (TracePerasCertInclusionEvent blk) where
     Just
       "The decision taken by the Peras certificate inclusion rules, i.e. whether a\
       \ certificate is to be included in the block being forged, and why."
+  documentFor (Namespace _ ["NotEnabledForRound"]) =
+    Just "Peras is not enabled for the round containing the current slot."
+  documentFor (Namespace _ ["PastHorizonException"]) =
+    Just "A past horizon exception occurred while determining the current Peras round."
+  documentFor (Namespace _ ["Error"]) =
+    Just "An error occurred while evaluating Peras certificate inclusion rules."
   documentFor _ = Nothing
 
   allNamespaces =
     [ Namespace [] ["NoCertToInclude"]
     , Namespace [] ["RulesDecision"]
+    , Namespace [] ["NotEnabledForRound"]
+    , Namespace [] ["PastHorizonException"]
+    , Namespace [] ["Error"]
     ]
 
 --------------------------------------------------------------------------------
@@ -2900,6 +2948,12 @@ instance
         [ "kind" .= String "TracePerasVotingCantReadEnv"
         , "error" .= String (Text.pack err)
         ]
+    TracePerasVotingViewError roundNo err ->
+      mconcat
+        [ "kind" .= String "TracePerasVotingViewError"
+        , "round" .= unPerasRoundNo roundNo
+        , "error" .= String (showT err)
+        ]
 
   forHuman = \case
     TracePerasVotingNoVoteAfterFirstSlotInRound roundNo slotInRound ->
@@ -2932,6 +2986,11 @@ instance
         <> showT outcome
     TracePerasVotingCantReadEnv err ->
       "Could not read the Peras voting environment: " <> Text.pack err
+    TracePerasVotingViewError roundNo err ->
+      "Could not obtain the Peras voting view for round "
+        <> showT (unPerasRoundNo roundNo)
+        <> ": "
+        <> showT err
 
 instance MetaTrace (TracePerasVoteForgingEvent blk) where
   namespaceFor TracePerasVotingNoVoteAfterFirstSlotInRound{} =
@@ -2948,6 +3007,8 @@ instance MetaTrace (TracePerasVoteForgingEvent blk) where
     Namespace [] ["AddCertChainSelOutcome"]
   namespaceFor TracePerasVotingCantReadEnv{} =
     Namespace [] ["CantReadEnv"]
+  namespaceFor TracePerasVotingViewError{} =
+    Namespace [] ["ViewError"]
 
   severityFor (Namespace _ ["NoVoteAfterFirstSlotInRound"]) _ = Just Debug
   severityFor (Namespace _ ["NotAVoterInRound"]) _ = Just Debug
@@ -2956,6 +3017,7 @@ instance MetaTrace (TracePerasVoteForgingEvent blk) where
   severityFor (Namespace _ ["AddVoteResult"]) _ = Just Info
   severityFor (Namespace _ ["AddCertChainSelOutcome"]) _ = Just Info
   severityFor (Namespace _ ["CantReadEnv"]) _ = Just Error
+  severityFor (Namespace _ ["ViewError"]) _ = Just Error
   severityFor _ _ = Nothing
 
   documentFor (Namespace _ ["NoVoteAfterFirstSlotInRound"]) =
@@ -2982,6 +3044,8 @@ instance MetaTrace (TracePerasVoteForgingEvent blk) where
   documentFor (Namespace _ ["CantReadEnv"]) =
     Just
       "The Peras voting environment could not be read."
+  documentFor (Namespace _ ["ViewError"]) =
+    Just "The Peras voting view could not be obtained for the current round."
   documentFor _ = Nothing
 
   allNamespaces =
@@ -2992,4 +3056,5 @@ instance MetaTrace (TracePerasVoteForgingEvent blk) where
     , Namespace [] ["AddVoteResult"]
     , Namespace [] ["AddCertChainSelOutcome"]
     , Namespace [] ["CantReadEnv"]
+    , Namespace [] ["ViewError"]
     ]

From 190988a01cb5afcc05ba6b299cfa9ded56e26554 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Tue, 6 Oct 2026 10:36:51 +0200
Subject: [PATCH 07/13] (temp) Allow default PerasParams to be read from the
 environment

---
 .../Ouroboros/Consensus/Peras/Params.hs       | 42 +++++++++++++++----
 1 file changed, 33 insertions(+), 9 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs
index 7931df4e67..61e839d3df 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Params.hs
@@ -59,11 +59,14 @@ import Data.Semigroup (Sum (..))
 import Data.Typeable (Typeable)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
+import GHC.IO.Unsafe (unsafePerformIO)
 import qualified Ouroboros.Consensus.Committee.Types as Committee
 import Ouroboros.Consensus.Peras.Types (PerasCertSize (..))
 import Ouroboros.Consensus.Util.Condense (Condense (..))
 import Ouroboros.Consensus.Util.IOLike (NoThunks)
 import Quiet (Quiet (..))
+import System.Environment (lookupEnv)
+import Text.Read (readMaybe)
 
 -- * Protocol parameters
 
@@ -216,28 +219,49 @@ defaultPerasParams =
   PerasParams
     { -- ceil(T_heal + T_cq) / perasRoundLength) as per the design document
       perasIgnoranceRounds =
-        PerasIgnoranceRounds 487
+        PerasIgnoranceRounds $
+          487 `orUnsafeEnv` "PERAS_IGNORANCE_ROUNDS"
     , -- ceil(T_heal + T_cq + T_cp) / perasRoundLength) + 1 as per the design document
       perasCooldownRounds =
-        PerasCooldownRounds 1928
+        PerasCooldownRounds $
+          1928 `orUnsafeEnv` "PERAS_COOLDOWN_ROUNDS"
     , -- must be between 30 and 900 as per the design document
       perasBlockMinSlots =
-        PerasBlockMinSlots 90
+        PerasBlockMinSlots $
+          90 `orUnsafeEnv` "PERAS_BLOCK_MIN_SLOTS"
     , -- equal to perasIgnoranceRounds as per the design document
       perasCertMaxRounds =
-        PerasCertMaxRounds 487
+        PerasCertMaxRounds $
+          487 `orUnsafeEnv` "PERAS_CERT_MAX_ROUNDS"
     , perasCertArrivalThreshold =
-        PerasCertArrivalThreshold 30
+        PerasCertArrivalThreshold $
+          30 `orUnsafeEnv` "PERAS_CERT_ARRIVAL_THRESHOLD"
     , perasWeight =
-        PerasWeight 15
+        PerasWeight $
+          15 `orUnsafeEnv` "PERAS_WEIGHT"
     , perasQuorumWeightThreshold =
-        PerasQuorumWeightThreshold (3 / 4)
+        PerasQuorumWeightThreshold $
+          (3 / 4) `orUnsafeEnv` "PERAS_QUORUM_WEIGHT_THRESHOLD"
     , perasQuorumWeightThresholdSafetyMargin =
-        PerasQuorumWeightThresholdSafetyMargin (2 / 100)
+        PerasQuorumWeightThresholdSafetyMargin $
+          (2 / 100) `orUnsafeEnv` "PERAS_QUORUM_WEIGHT_THRESHOLD_SAFETY_MARGIN"
     , perasTargetCommitteeSize =
-        Committee.TargetCommitteeSize 800
+        Committee.TargetCommitteeSize $
+          800 `orUnsafeEnv` "PERAS_TARGET_COMMITTEE_SIZE"
     }
 
+-- | Temporary hack to allow overriding default Peras parameters via env vars.
+orUnsafeEnv :: Read a => a -> String -> a
+orUnsafeEnv def var =
+  unsafePerformIO $
+    lookupEnv var >>= \case
+      Nothing -> pure def
+      Just str ->
+        case readMaybe str of
+          Nothing -> pure def
+          Just x -> pure x
+{-# NOINLINE orUnsafeEnv #-}
+
 -- * Era-dependent default values
 
 -- | Default value for 'PerasRoundLength' in the Dijkstra eras.

From ebb711608bc696481e22519d29b19530b9a1593e Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Tue, 6 Oct 2026 11:07:58 +0200
Subject: [PATCH 08/13] (temp) Tweak Peras voting controller to run at the end
 of the round

---
 .../Ouroboros/Consensus/NodeKernel.hs                      | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index 641fb7042b..29f573a43c 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -518,7 +518,12 @@ perasVoteForgingController
     (mbPerasVote, traceEvents) <-
       lift $ atomically $ runWriterT $ runMaybeT $ do
         -- Is this the first slot in the round? If not, we don't forge a vote.
-        when (slotInRound /= 0) $ do
+        --
+        -- HACK: we leave some time to allow for /some/ block to be applied in
+        -- this round before invoking the epoch context resolver. Otherwise, it
+        -- can fail to resolve the current round info as it might still be stuck
+        -- on the previous epoch.
+        when (slotInRound /= 75) $ do
           tell [TracePerasVotingNoVoteAfterFirstSlotInRound roundNo slotInRound]
           hoistMaybe Nothing
         -- Do the voting rules state that we should vote? And if so, for which block?

From 807d9df44a31cc095246db92691c0087624d7182 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Tue, 13 Oct 2026 11:39:55 +0200
Subject: [PATCH 09/13] (temp) Pin cardano-ledger to peras/testnet@92307b7

---
 cabal.project | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/cabal.project b/cabal.project
index 125c34d8d1..f9b1029c6e 100644
--- a/cabal.project
+++ b/cabal.project
@@ -43,12 +43,12 @@ if os (windows)
 constraints:
   tasty <1.5.4,
 
--- master after https://github.com/IntersectMBO/cardano-ledger/pull/6148
+-- peras/testnet@92307b7
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/cardano-ledger
-  --sha256: sha256-s/LVusbn3sE+yXYyOJpEg52PY+YVKqwmmEFdHM9ikD0=
-  tag: 0a72d43f5996c23eae1f6164d7d6a4dfeabe4c7f
+  --sha256: sha256-7T8CwDdrbqAuQDsICky0uqzssnm52hJQ2e3EeowM/E8=
+  tag: 92307b7635a8beea99241e4cf20d93f66d6aa0e9
   subdir:
     libs/cardano-data
     libs/cardano-ledger-api
@@ -77,4 +77,4 @@ allow-newer:
     , cardano-config:cardano-ledger-conway
     , cardano-config:cardano-ledger-core
     , cardano-config:cardano-ledger-dijkstra
-    , cardano-config:cardano-ledger-shelley
\ No newline at end of file
+    , cardano-config:cardano-ledger-shelley

From cfde237dd2175aab75c8ab6cc50392a627f324ef Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Wed, 14 Oct 2026 13:21:51 +0200
Subject: [PATCH 10/13] (fixme) Disable ancestor check in voting view leading
 to faulty VR-1B

---
 .../Ouroboros/Consensus/Peras/Voting/View.hs  | 19 +++++++++++++------
 1 file changed, 13 insertions(+), 6 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/View.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/View.hs
index 9fbc2aef10..845bcd33d5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/View.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Peras/Voting/View.hs
@@ -277,12 +277,19 @@ mkPerasVotingView
       -- that it extends any volatile suffix.
       True
     candidateBlockExtendsCert (CertBoostingBlockInVolatileDB cert) =
-      -- The block boosted by the latest certificate seen is still in the
-      -- VolatileDB, so we can check whether it is within the bounds of the
-      -- anchored fragment leading to the candidate block.
-      AF.withinFragmentBounds
-        (castPoint (getPerasCertPoint cert))
-        chainAtCandidateBlock
+      -- FIXME: there is a bug in this code path: the call to
+      -- 'withinFragmentBounds' always returns 'False'. We need to understand if
+      -- this is because 'withinFragmentBounds' is being called on an immutable
+      -- block and that's not being properly reflected on the
+      -- 'WithBoostedBlockStatus' of 'cert', or if something fishy is going on
+      -- between 'chainAtCandidateBlock' and 'withinFragmentBounds'.
+      const True $
+        -- The block boosted by the latest certificate seen is still in the
+        -- VolatileDB, so we can check whether it is within the bounds of the
+        -- anchored fragment leading to the candidate block.
+        AF.withinFragmentBounds
+          (castPoint (getPerasCertPoint cert))
+          chainAtCandidateBlock
 
     candidateBlock =
       AF.anchorToPoint

From d5d3947c4b22044f4fbd8f1b11fde858a83f754b Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Wed, 14 Oct 2026 13:59:34 +0200
Subject: [PATCH 11/13] Make Peras cert inclusion check run conditionally only
 when actually forging blocks

---
 .../Cardano/Tools/DBSynthesizer/Forging.hs               | 7 ++++++-
 .../Ouroboros/Consensus/NodeKernel.hs                    | 9 ++-------
 .../Ouroboros/Consensus/NodeKernel/Forge.hs              | 6 ++++--
 3 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs
index 33376cc4e3..a1d9e57d61 100644
--- a/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs
+++ b/ouroboros-consensus-cardano/src/unstable-cardano-tools/Cardano/Tools/DBSynthesizer/Forging.hs
@@ -171,12 +171,17 @@ runForge epochSize_ nextSlot opts chainDB blockForging cfg genTxs = do
             case mayMpRes of
               Nothing -> lift $ warnTimeout currentSlot txs
               Just mpRes -> lift $ warnRejected currentSlot txs mpRes
+    -- TODO: DBSynthesizer does not currently support including Peras certificates in blocks
+    let includePerasCert _ _ = pure Nothing
     -- Forge a block for each credential.
     -- A block is adopted when forge returns `Just ()`.
     -- If more than one is a leader in this slot, there will be a fork and some block will be orphaned in VolatileDB.
     results <-
       mapM
-        (\bf -> withEarlyExit $ forge nullTracer nullTracer cfg chainDB mempool bf currentSlot)
+        ( \bf ->
+            withEarlyExit $
+              forge nullTracer nullTracer cfg chainDB mempool bf includePerasCert currentSlot
+        )
         blockForging
     pure $ any isJust results
 
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
index 29f573a43c..6ed456ecc0 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs
@@ -691,12 +691,7 @@ forkBlockForging ::
   m (Thread m Void)
 forkBlockForging IS{..} (MkBlockForging blockForgingM) =
   forkLinkedWatcherAllocate registry label blockForgingMLabel finalize $ \bf ->
-    knownSlotWatcher btime $ \currentSlot -> do
-      mbPerasCert <-
-        checkPerasCertInclusion
-          (perasCertInclusionTracer tracers)
-          chainDB
-          currentSlot
+    knownSlotWatcher btime $ \currentSlot ->
       withEarlyExit_ $
         forge
           (forgeTracer tracers)
@@ -705,8 +700,8 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) =
           chainDB
           mempool
           bf
+          (checkPerasCertInclusion (perasCertInclusionTracer tracers))
           currentSlot
-          mbPerasCert
  where
   label :: String
   label = "NodeKernel.blockForging"
diff --git a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
index 774a7aea5e..5ee444e980 100644
--- a/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
+++ b/ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel/Forge.hs
@@ -67,10 +67,10 @@ forge ::
   ChainDB m blk ->
   Mempool m blk ->
   BlockForging m blk ->
+  (ChainDB m blk -> SlotNo -> m (Maybe (PerasCert blk))) ->
   SlotNo ->
-  Maybe (PerasCert blk) ->
   WithEarlyExit m ()
-forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging currentSlot mbPerasCert = do
+forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging includePerasCert currentSlot = do
   let trace :: TraceForgeEvent blk -> WithEarlyExit m ()
       trace =
         lift
@@ -115,6 +115,8 @@ forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging cur
 
         traceForgingMempoolSnapshot trace mempool currentSlot bcPrevPoint
 
+        mbPerasCert <- lift $ includePerasCert chainDB currentSlot
+
         (txs, payloadSz, snapSize) <-
           getTransactionsToForge
             cfg

From 3eab8da721d621d483e2113f3e740c4b2f0a2541 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 16 Oct 2026 16:33:18 +0200
Subject: [PATCH 12/13] (nit) Reduce lazyness in HFC query

---
 .../Ouroboros/Consensus/HardFork/History/Qry.hs            | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Qry.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Qry.hs
index b3157fe12b..dc67ae2ab5 100644
--- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Qry.hs
+++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/History/Qry.hs
@@ -409,8 +409,7 @@ evalExprInEra EraSummary{..} = \(ClosedExpr e) -> go e
           -- directly.
           guardEnd $ \end ->
             relSlot < countSlots (boundSlot end) (boundSlot eraStart)
-          Just $
-            NoPerasEnabled
+          Just NoPerasEnabled
         PerasEnabled (PerasRoundLength roundLength) ->
           Just $
             PerasEnabled $
@@ -691,7 +690,7 @@ slotToPerasRoundNo absSlot = runPerasEnabledT $ do
   roundLength <-
     PerasEnabledT $
       qryFromExpr (perasRoundNoPerasRoundLengthExpr absPerasRoundNo)
-  pure $
+  pure
     ( absPerasRoundNo
     , getSlotInPerasRound slotInPerasRound
     , unPerasRoundLength roundLength - getSlotInPerasRound slotInPerasRound
@@ -705,7 +704,7 @@ slotToPerasRoundNo' absSlot = runPerasEnabledT $ do
   absPerasRoundNo <-
     PerasEnabledT $
       qryFromExpr (ERelToAbsPerasRoundNo (ELit (PerasEnabled (relPerasRoundNo, slotInPerasRound))))
-  pure $
+  pure
     ( absPerasRoundNo
     , getSlotInPerasRound slotInPerasRound
     )

From b3c6c4f623afd4055c208be1d6fa728c9c4569e8 Mon Sep 17 00:00:00 2001
From: Agustin Mista <agustin.mista@tweag.io>
Date: Fri, 16 Oct 2026 16:38:12 +0200
Subject: [PATCH 13/13] Tweak Peras tracers

* Peras: make severity function exhaustive

* testnet: add moreutils for sponge executable

* testnet: use info as a default severity in tracers

Info severity is needed in order to output most interesting peras messages.

Co-authored-by: Alexander Vershilov <alexander.vershilov@tweag.io>
---
 .../Ouroboros/Consensus/Tracing/ChainDB.hs    | 21 +++++++++++--------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/tracing/Ouroboros/Consensus/Tracing/ChainDB.hs b/tracing/Ouroboros/Consensus/Tracing/ChainDB.hs
index 8048207749..182e1556ec 100644
--- a/tracing/Ouroboros/Consensus/Tracing/ChainDB.hs
+++ b/tracing/Ouroboros/Consensus/Tracing/ChainDB.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -19,6 +20,7 @@ import Cardano.Logging
 import Cardano.Slotting.Time (getSlotLength)
 import Data.Aeson (Object, ToJSON, Value (Object, String), object, toJSON, (.=))
 import qualified Data.ByteString.Base16 as B16
+import Data.Functor ((<&>))
 import Data.Int (Int64)
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.SOP (All, K (..), hcmap, hcollapse)
@@ -2035,7 +2037,7 @@ instance
       , "cert" .= String (Text.pack $ show cert)
       , "result" .= String (Text.pack $ show result)
       ]
-  forMachine _dtal (PerasCertDB.GarbageCollected slotNo) =
+  forMachine _dtal (PerasCertDB.GarbageCollected (SlotNo slotNo)) =
     mconcat
       [ "kind" .= String "GarbageCollected"
       , "slot" .= String (Text.pack $ show slotNo)
@@ -3674,14 +3676,15 @@ instance MetaTrace (ChainDB.TraceAddPerasCertEvent blk) where
   namespaceFor (ChainDB.PerasCertBoostsBlockNotYetReceived _ _) = Namespace [] ["PerasCertBoostsBlockNotYetReceived"]
   namespaceFor (ChainDB.ChainSelectionForBoostedBlock _ _) = Namespace [] ["ChainSelectionForBoostedBlock"]
 
-  severityFor (Namespace _ ["AddedPerasCertToQueue"]) _ = Just Debug
-  severityFor (Namespace _ ["PoppedPerasCertFromQueue"]) _ = Just Debug
-  severityFor (Namespace _ ["IgnorePerasCertTooOld"]) _ = Just Info
-  severityFor (Namespace _ ["PerasCertBoostsCurrentChain"]) _ = Just Info
-  severityFor (Namespace _ ["PerasCertBoostsGenesis"]) _ = Just Info
-  severityFor (Namespace _ ["PerasCertBoostsBlockNotYetReceived"]) _ = Just Info
-  severityFor (Namespace _ ["ChainSelectionForBoostedBlock"]) _ = Just Info
-  severityFor _ _ = Nothing
+  severityFor _ msg =
+    msg <&> \case
+      ChainDB.AddedPerasCertToQueue{} -> Debug
+      ChainDB.PoppedPerasCertFromQueue{} -> Debug
+      ChainDB.IgnorePerasCertTooOld{} -> Info
+      ChainDB.PerasCertBoostsCurrentChain{} -> Info
+      ChainDB.PerasCertBoostsBlockNotYetReceived{} -> Info
+      ChainDB.ChainSelectionForBoostedBlock{} -> Info
+      ChainDB.PerasCertBoostsGenesis{} -> Info
 
   privacyFor (Namespace _ ["AddedPerasCertToQueue"]) _ = Just Public
   privacyFor (Namespace _ ["PoppedPerasCertFromQueue"]) _ = Just Public