From 9624b3fa1a71f477489f82d9693d5168ebef2c4e Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 15:11:31 -0300 Subject: [PATCH 01/13] Make the in-memory LeiosDB throw a failed write at submission A caller that does not await the promise then sees the failure. The 'LeiosDbWriter' documentation now says that a write can throw at submission. --- .../20261022_120000_damian.nadales_eb_forge_store.md | 10 ++++++++++ .../Ouroboros/Consensus/Storage/LeiosDB/API.hs | 2 +- .../Consensus/Storage/LeiosDB/Impl/InMemory.hs | 7 +++---- .../Test/Ouroboros/Storage/LeiosDB.hs | 7 ++++--- 4 files changed, 18 insertions(+), 8 deletions(-) create mode 100644 changelog.d/20261022_120000_damian.nadales_eb_forge_store.md diff --git a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md new file mode 100644 index 0000000000..538c63d805 --- /dev/null +++ b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md @@ -0,0 +1,10 @@ + + +### Non-Breaking + +- If a write to the in-memory LeiosDB fails, `writeEbPoint`, `writeEbBody` and `writeTxs` throw at submission. Thus a caller that does not `await` the `Promise` sees the failure. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs index 13299e580a..0c89dd7e41 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs @@ -102,7 +102,7 @@ data LeiosDbReader m = LeiosDbReader -- -- Asynchronous interface where each operation returns upon submission. The -- returned 'Promise' can be used to 'await' the write being performed. Any --- exceptions are thrown through 'await'. +-- exceptions are thrown through 'await'. A write can also throw at submission. data LeiosDbWriter m = LeiosDbWriter { closeWriter :: m () -- ^ Close writer and flush all remaining writes. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/InMemory.hs index 5a04ba0eca..a15c787362 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/InMemory.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/InMemory.hs @@ -208,8 +208,7 @@ openInMemoryReader stateVar = -- | No worker and no queue: the state is a 'StrictTVar', so each write runs -- at submission and its 'Promise' comes back already resolved. A failure is --- captured rather than thrown here, so it surfaces at 'await' exactly like --- the SQLite backend's. +-- thrown at submission, so a caller that does not await sees it. openInMemoryWriter :: forall m. IOLike m => @@ -233,8 +232,8 @@ openInMemoryWriter stateVar notificationChan = resolved :: HasCallStack => String -> m a -> m (Promise m a) resolved job action = do result <- try action - pure $ Promise $ case result of - Right x -> pure x + case result of + Right x -> pure $ Promise $ pure x Left cause -> throwIO $ LeiosDbWriteException diff --git a/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs b/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs index 8e903ff16f..1ab9b80ca5 100644 --- a/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs +++ b/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs @@ -93,7 +93,7 @@ tests = <> [ testProperty "the two implementations agree on what a reader sees" prop_implementationsAgree , -- InMemory only: on SQLite a failed write also stops the writer, which -- is linked to the thread that opened the database. - testCase "InMemory: writing a body for an unwritten point fails, as on SQLite" $ + testCase "InMemory: writing a body for an unwritten point fails, without an await" $ withFreshDb InMemory test_ebBodyWithoutPointFails , -- InMemory only: the SQLite implementation sweeps in the background. testGroup @@ -718,10 +718,11 @@ test_multipleSlotsSameHash db = do setEquals xs ys = Map.fromList [(p, ()) | p <- xs] @?= Map.fromList [(p, ()) | p <- ys] -- | A body can only be written for a point already written, by 'writeEbPoint' --- on the announcement path. +-- on the announcement path. The write fails at submission, so a caller that +-- does not 'await' its 'Promise' also sees the failure. test_ebBodyWithoutPointFails :: LeiosDbHandle IO -> IO () test_ebBodyWithoutPointFails db = withRW db $ \con -> do - result <- tryDb $ rwInsertEbBody con (mkTestPoint (SlotNo 1) 1) (mkTestEb 2) + result <- tryDb $ void $ writeEbBody (rwWriter con) (mkTestPoint (SlotNo 1) 1) (mkTestEb 2) case result of Left _ -> pure () Right _ -> assertFailure "writeEbBody succeeded for a point that was never written" From ba4050e3f506f24476b0acc3fe3180ff10167922 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 15:12:25 -0300 Subject: [PATCH 02/13] Return the transaction bytes of a forged endorser block The LeiosDB needs these bytes to store the endorser block. Only 'forgeLeiosEb' builds a 'ForgedLeiosEb'. Thus the bytes always match the references in the endorser block. --- ...20000_damian.nadales_eb_forge_interface.md | 4 +- .../Consensus/Shelley/Ledger/Forge.hs | 10 ++-- .../Ouroboros/Consensus/Shelley/Node/Praos.hs | 4 +- .../Test/Consensus/Shelley/Forge.hs | 49 +++++++++++-------- .../Ouroboros/Consensus/NodeKernel/Forge.hs | 6 +-- .../Test/Consensus/HardFork/Combinator.hs | 14 +++--- .../Ouroboros/Consensus/Block/Forging.hs | 4 +- .../Ouroboros/Consensus/Leios/Types.hs | 25 ++++++++++ 8 files changed, 73 insertions(+), 43 deletions(-) diff --git a/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md b/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md index 36671ac5b0..a001fee558 100644 --- a/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md +++ b/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md @@ -8,7 +8,7 @@ For top level release notes, leave all the headers commented out. ### Breaking - `TxLimits` has the new superclass constraint `TxEbMeasureByteSize (TxEbMeasure blk)`, and `CanHardFork` has `TxEbMeasureByteSize (HardForkTxEbMeasure xs)`. The new class `TxEbMeasureByteSize` has one method, `txEbMeasureByteSize`: the size of the transaction references that an endorser-block measure counts, without the CBOR framing. `TxMeasure blk` and `IgnoringOverflow ByteSize32` return zero, and `DijkstraEbMeasure` returns its `txReferencesSize`. A block with a new endorser-block measure type must give an instance. The EB-forged machine trace reports this size as `txReferencesSize`. -- `forgeBlock` returns the new record `ForgeBlockResult`. Its field `rankingBlock` is the forged block, and its field `endorserBlock` is the `Maybe LeiosEb` that the block announces. Only Dijkstra (`Praos2`) builds an endorser block, and only from a non-empty `fbEbTxs`. Every other era returns `Nothing`. +- `forgeBlock` returns the new record `ForgeBlockResult`. Its field `rankingBlock` is the forged block, and its field `endorserBlock` is the `Maybe ForgedLeiosEb` that the block announces. Only Dijkstra (`Praos2`) builds an endorser block, and only from a non-empty `fbEbTxs`. Every other era returns `Nothing`. - `forgeShelleyBlock` returns a `ForgeBlockResult`, and requires `Foldable (WhenLeios proto)`. If the protocol has Leios and `fbEbTxs` is not empty, the header announces the endorser block that `forgeShelleyBlock` returns. - `praos2SharedBlockForging` requires `LedgerSupportsProtocol (ShelleyBlock (Praos2 c) era)`. Its `forgeBlock` asserts that the endorser block it returns is not larger than the `llvMaxEbBodySize` of the `plvLeios` ledger view. - `ForgeBlockArgs` has a new field, `fbEbTxs`: the transactions for the endorser block. `snapshotPartitionWithInitialPayload` selects them after the ranking-block transactions in `fbTxs`. @@ -18,4 +18,4 @@ For top level release notes, leave all the headers commented out. ### Non-Breaking - `Ouroboros.Consensus.NodeKernel.Forge.forge` gives `ebCapacityTxMeasure` to `snapshotPartitionWithInitialPayload`. If the mempool has more transactions than the Dijkstra ranking block takes, the node forges an endorser block with the next transactions. -- New functions in `Ouroboros.Consensus.Leios.Types`: `leiosEbFromTxBytes` builds an endorser block from the bytes of its transactions, and `hashLeiosEb` gives the hash that a header announces for an endorser block. +- New in `Ouroboros.Consensus.Leios.Types`: the record `ForgedLeiosEb` holds an endorser block and the bytes of its transactions. `forgeLeiosEb` builds a `ForgedLeiosEb` from the bytes of the transactions. 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 0f3155fdb1..168d76dc97 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 @@ -33,10 +33,10 @@ import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Leios.Types - ( EndorserBlock + ( ForgedLeiosEb (..) , encodeEndorserBlockSize - , endorserBlockFromTxBytes , endorserBlockHash + , forgeLeiosEb ) import Ouroboros.Consensus.Protocol.Abstract (CanBeLeader) import Ouroboros.Consensus.Protocol.Ledger.HotKey (HotKey) @@ -99,13 +99,13 @@ forgeShelleyBlock -- Only a protocol with Leios has a value in 'WhenLeios', so the other -- protocols build no endorser block. CIP-0164 does not allow an empty -- endorser block. - forgedEb :: WhenLeios proto (Maybe EndorserBlock) + forgedEb :: WhenLeios proto (Maybe ForgedLeiosEb) forgedEb = pureLeiosOnly @proto $ - endorserBlockFromTxBytes . fmap (ebTxBytes . extractTx) <$> nonEmpty fbEbTxs + forgeLeiosEb . fmap (ebTxBytes . extractTx) <$> nonEmpty fbEbTxs -- TODO Forging does not yet certify endorser blocks. - leiosFields = (,) False . maybeToStrictMaybe . fmap announce <$> forgedEb + leiosFields = (,) False . maybeToStrictMaybe . fmap (announce . forgedEbBody) <$> forgedEb announce eb = EbReferencesAnnouncement diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs index 59bce4d6ea..432df820b5 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Node/Praos.hs @@ -22,7 +22,7 @@ import Ouroboros.Consensus.Block import Ouroboros.Consensus.Config (configConsensus, configLedger) import Ouroboros.Consensus.Ledger.SupportsProtocol (LedgerSupportsProtocol (..)) import Ouroboros.Consensus.Leios.Protocol (LeiosLedgerView (..)) -import Ouroboros.Consensus.Leios.Types (encodeEndorserBlockSize) +import Ouroboros.Consensus.Leios.Types (ForgedLeiosEb (..), encodeEndorserBlockSize) import Ouroboros.Consensus.Protocol.Abstract (CanBeLeader, ConsensusConfig) import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey import Ouroboros.Consensus.Protocol.Praos @@ -151,4 +151,4 @@ praos2SharedBlockForging hotKey slotToPeriod credentials = where Praos2HasLeios leiosLedgerView = plvLeios $ protocolLedgerView (configLedger fbConfig) fbCurrentTickedLedgerState - fits eb = encodeEndorserBlockSize eb <= llvMaxEbBodySize leiosLedgerView + fits eb = encodeEndorserBlockSize (forgedEbBody eb) <= llvMaxEbBodySize leiosLedgerView diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs index de8d1bfc4e..325f2b2497 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs @@ -43,6 +43,8 @@ import Ouroboros.Consensus.Leios.Types , encodeEndorserBlockSize , endorserBlockHash , endorserBlockReferences + , forgedEbBody + , forgedEbTxs ) import Ouroboros.Consensus.Protocol.Praos ( ConsensusConfig (..) @@ -97,22 +99,25 @@ prop_announcesEb = ForgeBlockResult blk forgedEb <- forgeWith coreNode ebTxs pure $ case forgedEb of Nothing -> counterexample "no endorser block" False - Just eb -> - conjoin - [ counterexample "the endorser block does not reference the transactions in order" $ - endorserBlockReferences eb === map reference ebTxs - , counterexample "encodeEndorserBlockSize differs from the length of encodeEndorserBlock" $ - encodeEndorserBlockSize eb - === fromIntegral (BS.length (toStrictByteString (encodeEndorserBlock eb))) - , announcement blk - === SJust - EbReferencesAnnouncement - { ebReferencesAnnouncementHash = unsafeMakeSafeHash (endorserBlockHash eb) - , ebReferencesAnnouncementSize = encodeEndorserBlockSize eb - } - , counterexample "the block does not match its header" $ - blockMatchesHeader (getHeader blk) blk - ] + Just forged -> + let eb = forgedEbBody forged + in conjoin + [ counterexample "the endorser block does not reference the transactions in order" $ + endorserBlockReferences eb === map reference ebTxs + , counterexample "forgedEbTxs does not hold the referenced transaction bytes" $ + forgedEbTxs forged === map txBytes ebTxs + , counterexample "encodeEndorserBlockSize differs from the length of encodeEndorserBlock" $ + encodeEndorserBlockSize eb + === fromIntegral (BS.length (toStrictByteString (encodeEndorserBlock eb))) + , announcement blk + === SJust + EbReferencesAnnouncement + { ebReferencesAnnouncementHash = unsafeMakeSafeHash (endorserBlockHash eb) + , ebReferencesAnnouncementSize = encodeEndorserBlockSize eb + } + , counterexample "the block does not match its header" $ + blockMatchesHeader (getHeader blk) blk + ] prop_noEb :: Property prop_noEb = @@ -240,12 +245,14 @@ distinctTxs = -- | The reference that an endorser block holds for a transaction: the -- Blake2b-256 hash and the length of the transaction bytes. reference :: GenTx StandardDijkstraBlock -> (TxHash, BytesSize) -reference (ShelleyTx _ tx) = - ( Hash.castHash (Hash.hashWith @HASH id bytes) - , fromIntegral (BS.length bytes) +reference tx = + ( Hash.castHash (Hash.hashWith @HASH id (txBytes tx)) + , fromIntegral (BS.length (txBytes tx)) ) - where - bytes = serialize' (eraProtVerLow @DijkstraEra) tx + +-- | The bytes of a transaction that an endorser block references. +txBytes :: GenTx StandardDijkstraBlock -> BS.ByteString +txBytes (ShelleyTx _ tx) = serialize' (eraProtVerLow @DijkstraEra) tx exampleDijkstraBlock :: StandardDijkstraBlock exampleDijkstraBlock = example Examples.exampleBlock 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 21b59f6d1e..5066537474 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 @@ -33,7 +33,7 @@ import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.SupportsMempool import Ouroboros.Consensus.Ledger.SupportsProtocol import Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables) -import Ouroboros.Consensus.Leios.Types (EndorserBlock) +import Ouroboros.Consensus.Leios.Types (ForgedLeiosEb (..)) import Ouroboros.Consensus.Mempool import Ouroboros.Consensus.Mempool.API (MempoolMeasure (..)) import Ouroboros.Consensus.Node.Run @@ -71,7 +71,7 @@ forge :: -- | 'forge' calls this function after 'forgeBlock' and before -- 'addBlockToChainDB'. The arguments are the header of the forged ranking -- block and the endorser block that it announces. - (Header blk -> EndorserBlock -> m ()) -> + (Header blk -> ForgedLeiosEb -> m ()) -> SlotNo -> WithEarlyExit m () forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging onForgedLeiosEb currentSlot = do @@ -165,7 +165,7 @@ forge forgeEventTracer forgeStateInfoTracer cfg chainDB mempool blockForging onF TraceForgedEndorserBlock currentSlot (blockHash (Block.rankingBlock forgeRes)) - eb + (forgedEbBody eb) (endorserBlockMeasure selectedTxs) addBlockToChainDB trace chainDB mempool currentSlot (fbTxs fbArgs) (Block.rankingBlock forgeRes) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs index f3847d346a..e834d2b4bf 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs @@ -16,11 +16,11 @@ module Test.Consensus.HardFork.Combinator (tests) where -import qualified Cardano.Crypto.Hash as Hash import Cardano.Ledger.BaseTypes (knownNonZeroBounded, nonZero, unNonZero) import Data.ByteString.Short (fromShort) import Data.Function (on) import Data.Functor.Identity (Identity (..)) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.Map.Strict as Map import Data.MemPack import Data.SOP.BasicFunctors @@ -55,7 +55,7 @@ import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.Extended import Ouroboros.Consensus.Ledger.Peras (initPerasState) import Ouroboros.Consensus.Ledger.SupportsMempool -import Ouroboros.Consensus.Leios.Types (EndorserBlock, mkEndorserBlock) +import Ouroboros.Consensus.Leios.Types (ForgedLeiosEb, forgeLeiosEb) import Ouroboros.Consensus.Node.NetworkProtocolVersion import Ouroboros.Consensus.Node.ProtocolInfo import Ouroboros.Consensus.NodeId @@ -112,7 +112,7 @@ unit_hardForkForgeBlockPassesTxsAndReturnsEb = do case forged of Z (I blkA) -> blkA_body blkA @?= [txA 1, txA 2] S _ -> assertFailure "the block is not from era A" - forgedEb @?= Just (ebListing [txA 3]) + forgedEb @?= Just (ebListing (txA 3 :| [])) where hardForkForging :: BlockForging Identity TestBlock hardForkForging = @@ -134,14 +134,12 @@ unit_hardForkForgeBlockPassesTxsAndReturnsEb = do pure ForgeBlockResult { rankingBlock = blkA{blkA_body = map forgetValidatedGenTxA (fbTxs argsA)} - , endorserBlock = Just $ ebListing $ map forgetValidatedGenTxA (fbEbTxs argsA) + , endorserBlock = ebListing <$> nonEmpty (map forgetValidatedGenTxA (fbEbTxs argsA)) } } - ebListing :: [GenTx BlockA] -> EndorserBlock - ebListing txs = - mkEndorserBlock - [(Hash.castHash (Hash.hashWith fromShort (toRawTxIdHash (txId tx))), 0) | tx <- txs] + ebListing :: NonEmpty (GenTx BlockA) -> ForgedLeiosEb + ebListing = forgeLeiosEb . fmap (fromShort . toRawTxIdHash . txId) txA :: Int -> GenTx BlockA txA n = TxA (TxIdA n) InitiateAtoB diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs index 3608e7ce18..dbc9662e43 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/Forging.hs @@ -40,7 +40,7 @@ import Ouroboros.Consensus.Block.SupportsPeras (PerasCert) import Ouroboros.Consensus.Config import Ouroboros.Consensus.Ledger.Abstract import Ouroboros.Consensus.Ledger.SupportsMempool -import Ouroboros.Consensus.Leios.Types (EndorserBlock) +import Ouroboros.Consensus.Leios.Types (ForgedLeiosEb) import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Ticked @@ -289,7 +289,7 @@ data ForgeBlockArgs blk = ForgeBlockArgs data ForgeBlockResult blk = ForgeBlockResult { rankingBlock :: !blk -- ^ The forged block. - , endorserBlock :: !(Maybe EndorserBlock) + , endorserBlock :: !(Maybe ForgedLeiosEb) -- ^ The endorser block that 'rankingBlock' announces. 'forgeBlock' builds -- it from 'fbEbTxs'. A @blk@ that does not support Leios returns 'Nothing'. } diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs index b62590b2c9..70d332bddc 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs @@ -46,6 +46,10 @@ module Ouroboros.Consensus.Leios.Types , TxOffset , mkEndorserBlock , endorserBlockFromTxBytes + , ForgedLeiosEb + , forgedEbBody + , forgedEbTxs + , forgeLeiosEb , endorserBlockHash , endorserBlockReferences , encodeEndorserBlock @@ -300,6 +304,27 @@ endorserBlockFromTxBytes = -- | The position of a transaction in its endorser block. type TxOffset = Int +-- | An endorser block that this node forged, with the bytes of its +-- transactions. Only 'forgeLeiosEb' builds it, so that the bytes always match +-- the references. +data ForgedLeiosEb = ForgedLeiosEb + { forgedEbBody :: !EndorserBlock + , forgedEbTxs :: ![ByteString] + -- ^ The bytes of the transactions that 'forgedEbBody' references, in the + -- same order. + } + deriving stock (Show, Eq) + +-- | The endorser block that references the given transactions, in the given +-- order. The reference to a transaction holds the Blake2b-256 hash and the +-- length of its bytes. +forgeLeiosEb :: NonEmpty ByteString -> ForgedLeiosEb +forgeLeiosEb txBytes = + ForgedLeiosEb + { forgedEbBody = endorserBlockFromTxBytes txBytes + , forgedEbTxs = toList txBytes + } + -- | The hash ranking blocks announce for the endorser block: that of its -- encoding. endorserBlockHash :: EndorserBlock -> EndorserBlockHash From 2b724cd686625b6333664cb00c057ba9456bca93 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 15:12:48 -0300 Subject: [PATCH 03/13] Write forged endorser blocks to the LeiosDB Each forging thread opens a LeiosDB writer, and 'storeForgedEb' writes the point, the body and the transactions of each forged endorser block. The forge does not await the writes. On SQLite, it blocks while the write queue is full. If a write fails, the node stops. 'finalize' erases the KES key before 'closeWriter' runs, because 'closeWriter' waits for the LeiosDB write queue. --- ...20000_damian.nadales_eb_forge_interface.md | 2 +- ...22_120000_damian.nadales_eb_forge_store.md | 2 + .../Ouroboros/Consensus/NodeKernel.hs | 61 ++++++++++++++++--- .../Ouroboros/Consensus/Leios/NotifyLog.hs | 4 +- .../Storage/LeiosDB/Impl/SQLite/WriteQueue.hs | 3 +- 5 files changed, 62 insertions(+), 10 deletions(-) diff --git a/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md b/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md index a001fee558..9a5db1c4e3 100644 --- a/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md +++ b/changelog.d/20261007_120000_damian.nadales_eb_forge_interface.md @@ -12,7 +12,7 @@ For top level release notes, leave all the headers commented out. - `forgeShelleyBlock` returns a `ForgeBlockResult`, and requires `Foldable (WhenLeios proto)`. If the protocol has Leios and `fbEbTxs` is not empty, the header announces the endorser block that `forgeShelleyBlock` returns. - `praos2SharedBlockForging` requires `LedgerSupportsProtocol (ShelleyBlock (Praos2 c) era)`. Its `forgeBlock` asserts that the endorser block it returns is not larger than the `llvMaxEbBodySize` of the `plvLeios` ledger view. - `ForgeBlockArgs` has a new field, `fbEbTxs`: the transactions for the endorser block. `snapshotPartitionWithInitialPayload` selects them after the ranking-block transactions in `fbTxs`. -- `Ouroboros.Consensus.NodeKernel.Forge.forge` takes a new argument. It calls this argument with each forged endorser block after `forgeBlock` and before it adds the ranking block to the ChainDB. The node kernel and db-synthesizer pass a function that does nothing. +- `Ouroboros.Consensus.NodeKernel.Forge.forge` takes a new argument. It calls this argument with each forged endorser block after `forgeBlock` and before it adds the ranking block to the ChainDB. The node kernel passes `storeForgedEb`, and db-synthesizer passes a function that does nothing. - `TraceForgeEvent` has a new constructor, `TraceForgedEndorserBlock`. `forge` traces it after `TraceForgedBlock` when `forgeBlock` returns an endorser block. The `tracing` library renders it under the namespace `ForgedEndorserBlock`, with the hash of the ranking block that announces the endorser block, the endorser block hash, the number of references, the size in bytes, and the selected transactions' measure (transaction bytes, execution units, and reference-script bytes). ### Non-Breaking diff --git a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md index 538c63d805..eda78f6567 100644 --- a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md +++ b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md @@ -8,3 +8,5 @@ For top level release notes, leave all the headers commented out. ### Non-Breaking - If a write to the in-memory LeiosDB fails, `writeEbPoint`, `writeEbBody` and `writeTxs` throw at submission. Thus a caller that does not `await` the `Promise` sees the failure. +- The node kernel writes each forged endorser block to the LeiosDB. The forge does not await the writes. On SQLite, it blocks while the write queue is full. If a write fails, the node stops. +- The depth of the LeiosDB SQLite write queue counts three jobs for the forge: the point, the body and the transactions of a forged endorser block. 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 9656eed80f..f0b51894f5 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 @@ -67,6 +68,13 @@ import Ouroboros.Consensus.Leios.NotifyLog , newNotifyLog , notifyLogPruner ) +import Ouroboros.Consensus.Leios.Protocol (LeiosAnnouncement (..), LeiosProtocol (..)) +import Ouroboros.Consensus.Leios.Types + ( ForgedLeiosEb + , LeiosPoint (..) + , forgedEbBody + , forgedEbTxs + ) import Ouroboros.Consensus.Mempool import qualified Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface as BlockFetchClientInterface import Ouroboros.Consensus.MiniProtocol.ChainSync.Client @@ -104,7 +112,11 @@ import Ouroboros.Consensus.Storage.ChainDB.API import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB import Ouroboros.Consensus.Storage.ChainDB.Init (InitChainDB) import qualified Ouroboros.Consensus.Storage.ChainDB.Init as InitChainDB -import Ouroboros.Consensus.Storage.LeiosDB.API (LeiosDbHandle) +import Ouroboros.Consensus.Storage.LeiosDB.API + ( LeiosDbHandle + , LeiosDbWriter (..) + , openWriter + ) import Ouroboros.Consensus.Util.AnchoredFragment ( preferAnchoredCandidate ) @@ -487,6 +499,7 @@ data InternalState m addrNTN addrNTC blk = IS , registry :: ResourceRegistry m , btime :: BlockchainTime m , chainDB :: ChainDB m blk + , leiosDB :: LeiosDbHandle m , blockFetchInterface :: BlockFetchConsensusInterface (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m , fetchClientRegistry :: FetchClientRegistry (ConnectionId addrNTN) (HeaderWithTime blk) blk blk m @@ -511,6 +524,7 @@ initInternalState NodeKernelArgs { tracers , chainDB + , leiosDB , registry , cfg , blockFetchSize @@ -582,9 +596,9 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) = forkLinkedWatcherAllocate registry label - blockForgingMLabel - finalize - ( \bf -> knownSlotWatcher btime $ + allocateForging + finalizeForging + ( \(bf, leiosDbWriter) -> knownSlotWatcher btime $ \currentSlot -> withEarlyExit_ $ forge @@ -594,17 +608,50 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) = chainDB mempool bf - (\_ _ -> pure ()) + (storeForgedEb cfg leiosDbWriter) currentSlot ) where label :: String label = "NodeKernel.blockForging" - blockForgingMLabel = do + allocateForging = do bf <- blockForgingM labelThisThread $ Text.unpack $ forgeLabel bf - pure bf + leiosDbWriter <- openWriter leiosDB + pure (bf, leiosDbWriter) + + -- 'finalize' erases the KES key, so it runs first: 'closeWriter' waits for + -- the LeiosDB write queue. + finalizeForging (bf, leiosDbWriter) = + finalize bf `finally` closeWriter leiosDbWriter + +-- | Write an endorser block that this node forged to the LeiosDB. +-- +-- The forge does not await the writes. On SQLite, it blocks while the write +-- queue is full. If a write fails, the node stops. Peers can get the header +-- before the endorser block is stored. +storeForgedEb :: + forall m blk. + (IOLike m, RunNode blk) => + TopLevelConfig blk -> + LeiosDbWriter m -> + Header blk -> + ForgedLeiosEb -> + m () +storeForgedEb cfg writer hdr forgedEb = do + _ <- writeEbPoint writer point (announcementEbSize announcement) + _ <- writeEbBody writer point (forgedEbBody forgedEb) + void $ writeTxs writer point (zip [0 ..] (forgedEbTxs forgedEb)) + where + announcement = + case getLeiosAnnouncement (Proxy @(BlockProtocol blk)) (validateView (configBlock cfg) hdr) of + Just ann -> ann + Nothing -> error "storeForgedEb: the header does not announce the endorser block" + + -- Peers key the endorser block by the slot of the header that announces + -- it, as 'mkAnnouncingHeader' does. + point = MkLeiosPoint (blockSlot hdr) (announcementEbHash announcement) {------------------------------------------------------------------------------- TxSubmission integration diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/NotifyLog.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/NotifyLog.hs index a56d7041a4..5654ee0851 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/NotifyLog.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/NotifyLog.hs @@ -65,7 +65,9 @@ import Ouroboros.Consensus.Util.IOLike data NotifyEntry blk = -- | An announcement, with its election slot's wall-clock onset. NotifyAnnouncement !RelativeTime !(AnnouncingHeader blk) - -- TODO: add offers and votes + -- TODO: add offers and votes. 'storeForgedEb' does not wait for the writes, + -- so offer a self-forged EB only after the LeiosDB sends 'AcquiredEb', and + -- its txs only after 'AcquiredEbTxs'. deriving stock Generic deriving anyclass instance NoThunks (Header blk) => NoThunks (NotifyEntry blk) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/SQLite/WriteQueue.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/SQLite/WriteQueue.hs index c3a90ebf79..a4a0951e65 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/SQLite/WriteQueue.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/Impl/SQLite/WriteQueue.hs @@ -207,6 +207,7 @@ writerQueueDepth :: Natural writerQueueDepth = numUpstreamPeers + forge + maintenance + slack where numUpstreamPeers = 20 - forge = 1 + -- the point, the body and the txs of a forged endorser block + forge = 3 maintenance = 4 slack = 2 From 24653a6462d06e8ede11b08ff840e4d1636ef19b Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 15:13:09 -0300 Subject: [PATCH 04/13] Test that a forged endorser block is stored The test reads the endorser block back from the LeiosDB at the point that the header announces. --- ...22_120000_damian.nadales_eb_forge_store.md | 1 + .../Test/Consensus/Shelley/Forge.hs | 48 ++++++++++++++++--- .../Ouroboros/Consensus/NodeKernel.hs | 1 + ouroboros-consensus.cabal | 2 +- 4 files changed, 45 insertions(+), 7 deletions(-) diff --git a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md index eda78f6567..84af5737b1 100644 --- a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md +++ b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md @@ -10,3 +10,4 @@ For top level release notes, leave all the headers commented out. - If a write to the in-memory LeiosDB fails, `writeEbPoint`, `writeEbBody` and `writeTxs` throw at submission. Thus a caller that does not `await` the `Promise` sees the failure. - The node kernel writes each forged endorser block to the LeiosDB. The forge does not await the writes. On SQLite, it blocks while the write queue is full. If a write fails, the node stops. - The depth of the LeiosDB SQLite write queue counts three jobs for the forge: the point, the body and the transactions of a forged endorser block. +- `Ouroboros.Consensus.NodeKernel` exports `storeForgedEb`, the function that the node kernel gives to `forge`. diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs index 325f2b2497..573f7d15ca 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs @@ -13,7 +13,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core (bodyTxL, eraProtVerLow, feeTxBodyL, ppProtocolVersionL) import Cardano.Ledger.Dijkstra (DijkstraEra) import Cardano.Ledger.Dijkstra.PParams (ppMaxEndorserBlockReferencesSizeL) -import Cardano.Ledger.Hashes (HASH, unsafeMakeSafeHash) +import Cardano.Ledger.Hashes (HASH, extractHash, unsafeMakeSafeHash) import Cardano.Ledger.MemoBytes (getMemoRawType) import qualified Cardano.Ledger.Shelley.API as SL ( mkMempoolEnv @@ -46,6 +46,7 @@ import Ouroboros.Consensus.Leios.Types , forgedEbBody , forgedEbTxs ) +import Ouroboros.Consensus.NodeKernel (storeForgedEb) import Ouroboros.Consensus.Protocol.Praos ( ConsensusConfig (..) , PraosIsLeader (..) @@ -76,6 +77,12 @@ import Ouroboros.Consensus.Shelley.Ledger.Config import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node.Common (ShelleyLeaderCredentials (..)) import Ouroboros.Consensus.Shelley.Node.Praos (praos2SharedBlockForging) +import Ouroboros.Consensus.Storage.LeiosDB + ( LeiosDbReader (..) + , newLeiosDBInMemory + , withReader + , withWriter + ) import Test.Consensus.Shelley.Examples (examplesDijkstra, testShelleyGenesis) import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck @@ -89,6 +96,7 @@ tests = "Forge" [ testProperty "a block announces the endorser block it comes with" prop_announcesEb , testProperty "a block without endorser-block transactions announces nothing" prop_noEb + , testProperty "storeForgedEb stores the endorser block that the header announces" prop_storesEb ] prop_announcesEb :: Property @@ -96,7 +104,7 @@ prop_announcesEb = forAllBlind (genCoreNode (SL.KESPeriod 0)) $ \coreNode -> forAll genNumEbTxs $ \numEbTxs -> ioProperty $ do let ebTxs = take numEbTxs distinctTxs - ForgeBlockResult blk forgedEb <- forgeWith coreNode ebTxs + (_, ForgeBlockResult blk forgedEb) <- forgeWith coreNode ebTxs pure $ case forgedEb of Nothing -> counterexample "no endorser block" False Just forged -> @@ -122,9 +130,36 @@ prop_announcesEb = prop_noEb :: Property prop_noEb = forAllBlind (genCoreNode (SL.KESPeriod 0)) $ \coreNode -> ioProperty $ do - ForgeBlockResult blk forgedEb <- forgeWith coreNode [] + (_, ForgeBlockResult blk forgedEb) <- forgeWith coreNode [] pure $ (announcement blk, isJust forgedEb) === (SNothing, False) +-- | 'storeForgedEb' writes the point, the body and the transactions of the +-- forged endorser block. The test reads them back at the slot and the hash +-- that the header announces. +prop_storesEb :: Property +prop_storesEb = + forAllBlind (genCoreNode (SL.KESPeriod 0)) $ \coreNode -> + forAll genNumEbTxs $ \numEbTxs -> ioProperty $ do + let ebTxs = take numEbTxs distinctTxs + (cfg, ForgeBlockResult blk forgedEb) <- forgeWith coreNode ebTxs + db <- newLeiosDBInMemory + withWriter db $ \writer -> + mapM_ (storeForgedEb cfg writer (getHeader blk)) forgedEb + case announcement blk of + SNothing -> pure $ counterexample "the block announces no endorser block" False + SJust ann -> do + let ebHash = extractHash $ ebReferencesAnnouncementHash ann + (points, closure) <- + withReader db $ \reader -> + (,) <$> testScanEbPoints reader <*> lookupEbClosure reader ebHash + pure $ + conjoin + [ counterexample "the point is not the slot and the hash that the header announces" $ + points === [(blockSlot blk, ebHash)] + , counterexample "the stored transactions are not the forged ones" $ + closure === Just [(fst (reference tx), txBytes tx) | tx <- ebTxs] + ] + -- | A number of endorser-block transactions. 'encodeEndorserBlockSize' writes a -- longer map header from 24 and from 256 references. genNumEbTxs :: Gen Int @@ -135,12 +170,13 @@ genNumEbTxs = ] -- | Forge the block after the example ledger state, with the given endorser --- block transactions and no ranking block transactions. +-- block transactions and no ranking block transactions. Also return the +-- config of the forge. forgeWith :: CoreNode StandardCrypto -> [GenTx StandardDijkstraBlock] -> - IO (ForgeBlockResult StandardDijkstraBlock) -forgeWith coreNode ebTxs = do + IO (TopLevelConfig StandardDijkstraBlock, ForgeBlockResult StandardDijkstraBlock) +forgeWith coreNode ebTxs = fmap ((,) topLevelConfig) $ do hotKey <- instantiatePraosCredentials (SL.maxKESEvo globals) 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 f0b51894f5..d6a209424a 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 @@ -19,6 +19,7 @@ module Ouroboros.Consensus.NodeKernel , getPeersFromCurrentLedger , getPeersFromCurrentLedgerAfterSlot , initNodeKernel + , storeForgedEb , toConsensusMode ) where diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal index 03ad2fc976..8d0b70daea 100644 --- a/ouroboros-consensus.cabal +++ b/ouroboros-consensus.cabal @@ -1917,7 +1917,7 @@ test-suite shelley-test measures, mempack, microlens, - ouroboros-consensus:{cardano, ouroboros-consensus, protocol, unstable-consensus-testlib, unstable-diffusion-testlib}, + ouroboros-consensus:{cardano, diffusion, ouroboros-consensus, protocol, unstable-consensus-testlib, unstable-diffusion-testlib}, QuickCheck, sop-core, strict-sop-core, From 1e743f2e50a11ad33a873bae59a9d337696e79a2 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 13:28:07 -0300 Subject: [PATCH 05/13] Name the Leios test node 'node' instead of 'nut' --- .../Test/Consensus/Leios/ChainDB.hs | 6 +- .../Test/Consensus/Leios/Environment.hs | 20 ++-- .../Test/Consensus/Leios/LeiosFetch/Node.hs | 20 ++-- .../Test/Consensus/Leios/LeiosNotify/Node.hs | 94 +++++++++---------- .../Test/Consensus/Leios/NodeUnderTest.hs | 55 ++++++----- .../Test/Consensus/Leios/Relay.hs | 12 +-- 6 files changed, 103 insertions(+), 104 deletions(-) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/ChainDB.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/ChainDB.hs index 3b8d2dce4e..584a29508e 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/ChainDB.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/ChainDB.hs @@ -41,8 +41,8 @@ tests = -- announcements and the GC has run, these are the bodies of A and B that the -- LeiosDB still holds. bodiesAfterGc :: IOSim s ([(TxHash, BytesSize)], [(TxHash, BytesSize)]) -bodiesAfterGc = withNode $ \nut -> do - let leiosDb = getLeiosDB (nutKernel nut) +bodiesAfterGc = withNode $ \node -> do + let leiosDb = getLeiosDB (nodeKernel node) withWriter leiosDb $ \writer -> forM_ [(pointA, ebA), (pointB, ebB)] $ \(point, eb) -> do await =<< writeEbPoint writer point (encodeEndorserBlockSize eb) @@ -57,7 +57,7 @@ bodiesAfterGc = withNode $ \nut -> do ] -- Let the slots of the chain's blocks pass, so none is from the future. threadDelay 20 - mapM_ (ChainDB.addBlock_ (nutChainDB nut) noPunishment) chain + mapM_ (ChainDB.addBlock_ (nodeChainDB node) noPunishment) chain -- Long enough for the copy to the ImmutableDB and for the delayed GC. threadDelay 100 withReader leiosDb $ \reader -> diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Environment.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Environment.hs index e6414b1759..62918a5605 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Environment.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Environment.hs @@ -159,7 +159,7 @@ withNodeVsEnvConnection :: EnvPeer (IOSim s) -> (NodeVsEnvConnection (IOSim s) -> IOSim s a) -> IOSim s a -withNodeVsEnvConnection nut addr envPeer body = do +withNodeVsEnvConnection node addr envPeer body = do nodeToPeer <- Strict.newTBQueueIO bearerQueueCapacity peerToNode <- Strict.newTBQueueIO bearerQueueCapacity let nodeBearer = queueChannelAsBearer sduSize QueueChannel{readQueue = peerToNode, writeQueue = nodeToPeer} @@ -168,7 +168,7 @@ withNodeVsEnvConnection nut addr envPeer body = do peerConnId = ConnectionId{localAddress = addr, remoteAddress = nodeAddr} (bundle, version) <- concurrently - (runHandshakeClient nodeBearer nodeConnId handshakeArguments (nutVersions nut)) + (runHandshakeClient nodeBearer nodeConnId handshakeArguments (nodeVersions node)) (runHandshakeServer peerBearer peerConnId handshakeArguments peerVersions) >>= \case (Right (HandshakeNegotiationResult bundle version _), Right HandshakeNegotiationResult{}) -> @@ -179,12 +179,12 @@ withNodeVsEnvConnection nut addr envPeer body = do publicPeerSelectionStateVar <- makePublicPeerSelectionStateVar newPeerSharingAPI publicPeerSelectionStateVar - (seedEnvPeerSharing (nutSeeds nut)) + (seedEnvPeerSharing (nodeSeeds node)) ps_POLICY_PEER_SHARE_STICKY_TIME ps_POLICY_PEER_SHARE_MAX_PEERS let protocols = getOuroborosApplication (fromOuroborosBundle bundle) infos = mkMiniProtocolInfos (\_ _ -> Nothing) bundle - codecs = envCodecs nut version + codecs = envCodecs node version nodeMux <- Mx.new Mx.nullTracers infos peerMux <- Mx.new Mx.nullTracers infos withAsync (Mx.run nodeMux nodeBearer) $ \_ -> @@ -358,23 +358,23 @@ type NodeCodecs s = ByteString envCodecs :: NodeUnderTest (IOSim s) -> NodeToNodeVersion -> NodeCodecs s -envCodecs nut = +envCodecs node = NTN.defaultCodecs - (configCodec (nutTopLevelConfig nut)) + (configCodec (nodeTopLevelConfig node)) () (const encodePeerAddr) (const decodePeerAddr) envLeiosNotifyCodec :: NodeUnderTest (IOSim s) -> LeiosNotifyCodec s -envLeiosNotifyCodec nut = NTN.cLeiosNotifyCodec (envCodecs nut maxBound) +envLeiosNotifyCodec node = NTN.cLeiosNotifyCodec (envCodecs node maxBound) envLeiosFetchCodec :: NodeUnderTest (IOSim s) -> LeiosFetchCodec s -envLeiosFetchCodec nut = NTN.cLeiosFetchCodec (envCodecs nut maxBound) +envLeiosFetchCodec node = NTN.cLeiosFetchCodec (envCodecs node maxBound) -- | A LeiosFetch server that disconnects a client that sends any request. refusingLeiosFetchServer :: NodeUnderTest (IOSim s) -> Channel (IOSim s) ByteString -> IOSim s () -refusingLeiosFetchServer nut chan = - fst <$> runAnnotatedPeer nullTracer (envLeiosFetchCodec nut) chan (leiosFetchServerPeer refuse) +refusingLeiosFetchServer node chan = + fst <$> runAnnotatedPeer nullTracer (envLeiosFetchCodec node) chan (leiosFetchServerPeer refuse) where refuse = MkLeiosFetchRequestHandler $ \_request -> throwIO $ userError "the environment's LeiosFetch server serves nothing" diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosFetch/Node.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosFetch/Node.hs index 2c73646b77..ff5918dde7 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosFetch/Node.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosFetch/Node.hs @@ -101,23 +101,23 @@ type EnvClient s = -- | Run the node's server, with 'heldEb' in its LeiosDB, against a peer that -- runs this client. nodeServerAgainst :: EnvClient s -> IOSim s ServerOutcome -nodeServerAgainst client = withNode $ \nut -> do - holdHeldEb nut +nodeServerAgainst client = withNode $ \node -> do + holdHeldEb node let envPeer = EnvPeer { epLeiosNotifyServer = \_chan -> atomically retry , epLeiosNotifyClient = Nothing - , epLeiosFetchServer = refusingLeiosFetchServer nut - , epLeiosFetchClient = Just $ runEnvClient nut client + , epLeiosFetchServer = refusingLeiosFetchServer node + , epLeiosFetchClient = Just $ runEnvClient node client } - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \conn -> do server <- nodeLeiosFetchServer conn atomically server >>= \case Right () -> pure ServerEnded Left e -> pure $ ServerFailed (show e) runEnvClient :: NodeUnderTest (IOSim s) -> EnvClient s -> Channel (IOSim s) ByteString -> IOSim s () -runEnvClient nut client chan = fst <$> runAnnotatedPeer nullTracer (envLeiosFetchCodec nut) chan client +runEnvClient node client chan = fst <$> runAnnotatedPeer nullTracer (envLeiosFetchCodec node) chan client doneClient :: EnvClient s doneClient = Yield ReflClientAgency MsgDone $ Done ReflNobodyAgency () @@ -187,7 +187,7 @@ heldTx = MkLeiosTx . heldTxBytes -- | Write 'heldEb' and all its transactions but the last. holdHeldEb :: NodeUnderTest (IOSim s) -> IOSim s () -holdHeldEb nut = withWriter (getLeiosDB (nutKernel nut)) $ \writer -> do +holdHeldEb node = withWriter (getLeiosDB (nodeKernel node)) $ \writer -> do await =<< writeEbPoint writer heldPoint (encodeEndorserBlockSize heldEb) _ <- await =<< writeEbBody writer heldPoint heldEb _ <- await =<< writeTxs writer heldPoint [(i, heldTxBytes i) | i <- [0 .. 68]] @@ -200,17 +200,17 @@ holdHeldEb nut = withWriter (getLeiosDB (nutKernel nut)) $ \writer -> do -- | Whether the node's initiator bundle, and its initiator-and-responder bundle, -- include LeiosFetch among their hot mini-protocols for this version. nodeRunsLeiosFetch :: NodeToNodeVersion -> IOSim s (Bool, Bool) -nodeRunsLeiosFetch ntnVersion = withNode $ \nut -> +nodeRunsLeiosFetch ntnVersion = withNode $ \node -> pure ( runsLeiosFetch $ - NTN.initiator mempty defaultMiniProtocolParameters ntnVersion versionData (nutApps nut ()) + NTN.initiator mempty defaultMiniProtocolParameters ntnVersion versionData (nodeApps node ()) , runsLeiosFetch $ NTN.initiatorAndResponder mempty defaultMiniProtocolParameters ntnVersion versionData - (nutApps nut ()) + (nodeApps node ()) ) where versionData = nodeVersionData ntnVersion diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosNotify/Node.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosNotify/Node.hs index 45a2123399..24bd2d1240 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosNotify/Node.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/LeiosNotify/Node.hs @@ -373,16 +373,16 @@ runNodeClientAgainst :: STM (IOSim s) (Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle) -> Int -> IOSim s NodeClientOutcome -runNodeClientAgainst nut next target = do +runNodeClientAgainst node next target = do requests <- newTVarIO 0 let envPeer = EnvPeer - { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec nut) requests next + { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec node) requests next , epLeiosNotifyClient = Nothing - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \conn -> do client <- nodeLeiosNotifyClient conn early <- atomically $ @@ -401,24 +401,24 @@ runNodeClientAgainst nut next target = do -- | A peer that never has a notification: the node keeps exactly its -- pipelining bound of requests outstanding. nodeClientKeepsPipelineFull :: IOSim s NodeClientOutcome -nodeClientKeepsPipelineFull = withNode $ \nut -> - runNodeClientAgainst nut retry leiosNotifyPipelineDepth +nodeClientKeepsPipelineFull = withNode $ \node -> + runNodeClientAgainst node retry leiosNotifyPipelineDepth -- | Six replies, announcements from six elections, free six slots in the -- pipeline, which the node fills again. nodeClientRefillsPipeline :: IOSim s NodeClientOutcome -nodeClientRefillsPipeline = withNode $ \nut -> do +nodeClientRefillsPipeline = withNode $ \node -> do queue <- newTQueueIO atomically $ mapM_ (writeTQueue queue) $ [ MsgLeiosBlockAnnouncement $ ltbHeader $ setIssuer issuer $ ann 1 $ firstLeiosBlock 0 | issuer <- [0 .. 5] ] - runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 6) + runNodeClientAgainst node (readTQueue queue) (leiosNotifyPipelineDepth + 6) nodeClientUnpromptedCancel :: IOSim s NodeClientOutcome -nodeClientUnpromptedCancel = withNode $ \nut -> - runNodeClientAgainst nut (pure MsgCanceled) maxBound +nodeClientUnpromptedCancel = withNode $ \node -> + runNodeClientAgainst node (pure MsgCanceled) maxBound -- | Announce an endorser block whose hash repeats the given byte 32 times. ann :: Word8 -> LeiosTestBlock -> LeiosTestBlock @@ -426,33 +426,33 @@ ann n = setAnnouncement (UnsafeHash (SBS.replicate 32 n)) 1000 -- | A peer that relays these headers, one per request. nodeClientAgainstAnnouncements :: [LeiosTestBlock] -> IOSim s NodeClientOutcome -nodeClientAgainstAnnouncements blks = withNode $ \nut -> do +nodeClientAgainstAnnouncements blks = withNode $ \node -> do queue <- newTQueueIO atomically $ mapM_ (writeTQueue queue . MsgLeiosBlockAnnouncement . ltbHeader) blks - runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + length blks) + runNodeClientAgainst node (readTQueue queue) (leiosNotifyPipelineDepth + length blks) -- | The announcement arrives long after its slot: the peer connects only then. nodeClientTooOld :: IOSim s NodeClientOutcome -nodeClientTooOld = withNode $ \nut -> do +nodeClientTooOld = withNode $ \node -> do threadDelay (realToFrac maxAnnouncementAgeRecv + 100) queue <- newTQueueIO atomically $ writeTQueue queue $ MsgLeiosBlockAnnouncement $ ltbHeader $ ann 1 (firstLeiosBlock 0) - runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 1) + runNodeClientAgainst node (readTQueue queue) (leiosNotifyPipelineDepth + 1) -- | By the time the node connects, the current slot is past what its -- immutable tip, still at genesis, can forecast to. nodeClientGated :: IOSim s Int -nodeClientGated = withNodeForecastingOnly 5 $ \nut -> do +nodeClientGated = withNodeForecastingOnly 5 $ \node -> do threadDelay 10 requests <- newTVarIO 0 let envPeer = EnvPeer - { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec nut) requests retry + { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec node) requests retry , epLeiosNotifyClient = Nothing - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \conn -> do threadDelay 10 n <- readTVarIO requests connTerminate conn @@ -462,14 +462,14 @@ nodeClientGated = withNodeForecastingOnly 5 $ \nut -> do -- | How many elections, body offers, closure offers and votes the client's state -- holds once one of each is in, and once the immutable tip has passed them. nodePrunesClientState :: IOSim s ((Int, Int, Int, Int), (Int, Int, Int, Int)) -nodePrunesClientState = withNode $ \nut -> do +nodePrunesClientState = withNode $ \node -> do requests <- newTVarIO 0 queue <- newTQueueIO let envPeer = EnvPeer - { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec nut) requests (readTQueue queue) + { epLeiosNotifyServer = runReplyingServer (envLeiosNotifyCodec node) requests (readTQueue queue) , epLeiosNotifyClient = Nothing - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } withAsync @@ -483,18 +483,18 @@ nodePrunesClientState = withNode $ \nut -> do ] ) $ \_feeder -> - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \_conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \_conn -> do atomically $ readTVar requests >>= check . (> leiosNotifyPipelineDepth + 3) - beforePruning <- clientStateSize nut - advanceImmutableTip nut - afterPruning <- clientStateSize nut + beforePruning <- clientStateSize node + advanceImmutableTip node + afterPruning <- clientStateSize node pure (beforePruning, afterPruning) -- | How many elections, body offers, closure offers and votes the node's -- clients remember. clientStateSize :: NodeUnderTest (IOSim s) -> IOSim s (Int, Int, Int, Int) -clientStateSize nut = atomically $ do - states <- IOLike.readTVar (getLeiosNotifyClientStates (nutKernel nut)) +clientStateSize node = atomically $ do + states <- IOLike.readTVar (getLeiosNotifyClientStates (nodeKernel node)) sizes <- mapM (fmap size . IOLike.readTVar) (Map.elems states) pure ( sum [e | (e, _, _, _) <- sizes] @@ -528,11 +528,11 @@ feedAt queue = go 0 nodeClientAgainstSchedule :: [(DiffTime, Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle)] -> IOSim s NodeClientOutcome -nodeClientAgainstSchedule schedule = withNode $ \nut -> do +nodeClientAgainstSchedule schedule = withNode $ \node -> do queue <- newTQueueIO let msgs = (0, someAnnouncement) : schedule withAsync (feedAt queue msgs) $ \_feeder -> - runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + length msgs) + runNodeClientAgainst node (readTQueue queue) (leiosNotifyPipelineDepth + length msgs) -- | A vote from this seat for the announcement this block carries. voteFor :: LeiosTestBlock -> Word16 -> LeiosVote @@ -547,9 +547,9 @@ equivocation = ann 2 (forkLeiosBlock (firstLeiosBlock 0)) -- | Make the first two slots immutable: k is 10, so twelve blocks do it. advanceImmutableTip :: NodeUnderTest (IOSim s) -> IOSim s () -advanceImmutableTip nut = do +advanceImmutableTip node = do threadDelay 20 - mapM_ (ChainDB.addBlock_ (nutChainDB nut) noPunishment) $ + mapM_ (ChainDB.addBlock_ (nodeChainDB node) noPunishment) $ take 12 $ iterate successorLeiosBlock (firstLeiosBlock 1) threadDelay 1 @@ -558,27 +558,27 @@ advanceImmutableTip nut = do -- the immutable tip has passed it. nodeClientOfferTooOld :: Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle -> IOSim s NodeClientOutcome -nodeClientOfferTooOld offer = withNode $ \nut -> do +nodeClientOfferTooOld offer = withNode $ \node -> do queue <- newTQueueIO atomically $ writeTQueue queue someAnnouncement announced <- newEmptyTMVarIO let feed = do atomically $ readTMVar announced - advanceImmutableTip nut + advanceImmutableTip node atomically $ writeTQueue queue offer next = do msg <- readTQueue queue _ <- tryPutTMVar announced () pure msg - withAsync feed $ \_feeder -> runNodeClientAgainst nut next maxBound + withAsync feed $ \_feeder -> runNodeClientAgainst node next maxBound -- | A peer that announces 'someOfferedPoint', then sends these. nodeClientAgainstOffers :: [Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle] -> IOSim s NodeClientOutcome -nodeClientAgainstOffers msgs = withNode $ \nut -> do +nodeClientAgainstOffers msgs = withNode $ \node -> do queue <- newTQueueIO atomically $ mapM_ (writeTQueue queue) (someAnnouncement : msgs) - runNodeClientAgainst nut (readTQueue queue) (leiosNotifyPipelineDepth + 1 + length msgs) + runNodeClientAgainst node (readTQueue queue) (leiosNotifyPipelineDepth + 1 + length msgs) someAnnouncement :: Message (LeiosNotify LeiosPoint (Header Blk) LeiosVote) StBusy StIdle someAnnouncement = MsgLeiosBlockAnnouncement $ ltbHeader $ ann 1 (firstLeiosBlock 0) @@ -593,19 +593,19 @@ newtype NodeServerOutcome = NodeServerOutcome Int -- | The node never has a notification, so the peer's requests are all -- outstanding when it quits. nodeServerCancels :: IOSim s NodeServerOutcome -nodeServerCancels = withNode $ \nut -> do +nodeServerCancels = withNode $ \node -> do requests <- newTVarIO 0 replies <- newTVarIO 0 stop <- newEmptyTMVarIO - let codec' = envLeiosNotifyCodec nut + let codec' = envLeiosNotifyCodec node envPeer = EnvPeer { epLeiosNotifyServer = runReplyingServer codec' requests retry , epLeiosNotifyClient = Just $ runPipelinedClient codec' replies 3 stop - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \conn -> do threadDelay 10 atomically $ putTMVar stop () for_ (connPeerLeiosNotifyClient conn) $ \client -> atomically client >>= either throwIO pure @@ -616,20 +616,20 @@ nodeServerCancels = withNode $ \nut -> do -- | A peer pipelining one request more than the node's server allows, so the -- node disconnects it. nodeServerExcessive :: IOSim s ExcessiveOutcome -nodeServerExcessive = withNode $ \nut -> do +nodeServerExcessive = withNode $ \node -> do requests <- newTVarIO 0 replies <- newTVarIO 0 stop <- newEmptyTMVarIO - let codec' = envLeiosNotifyCodec nut + let codec' = envLeiosNotifyCodec node envPeer = EnvPeer { epLeiosNotifyServer = runReplyingServer codec' requests retry , epLeiosNotifyClient = Just $ runPipelinedClient codec' replies (leiosNotifyPipelineDepth + 1) stop - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } - withNodeVsEnvConnection nut (PeerAddr 1) envPeer $ \conn -> do + withNodeVsEnvConnection node (PeerAddr 1) envPeer $ \conn -> do server <- nodeLeiosNotifyServer conn atomically server >>= \case Left e | Just ExnLeiosNotifyExcessiveRequests <- fromException e -> pure $ ExcessiveOutcome Disconnected @@ -638,17 +638,17 @@ nodeServerExcessive = withNode $ \nut -> do -- | Whether the node's initiator bundle, and its initiator-and-responder bundle, -- include LeiosNotify among their hot mini-protocols for this version. nodeRunsLeiosNotify :: NodeToNodeVersion -> IOSim s (Bool, Bool) -nodeRunsLeiosNotify ntnVersion = withNode $ \nut -> +nodeRunsLeiosNotify ntnVersion = withNode $ \node -> pure ( runsLeiosNotify $ - NTN.initiator mempty defaultMiniProtocolParameters ntnVersion versionData (nutApps nut ()) + NTN.initiator mempty defaultMiniProtocolParameters ntnVersion versionData (nodeApps node ()) , runsLeiosNotify $ NTN.initiatorAndResponder mempty defaultMiniProtocolParameters ntnVersion versionData - (nutApps nut ()) + (nodeApps node ()) ) where versionData = nodeVersionData ntnVersion diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs index af4e4f719e..d598fd1a8f 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs @@ -5,8 +5,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} --- | One real node, the node under test (NUT), and a mocked environment around --- it. The @nut@ prefix of names here abbreviates it. +-- | One real node, the node under test, and a mocked environment around it. -- -- The node is built by the node's own 'initNodeKernel' over a ChainDB on a -- mocked filesystem, so the code under test is the node's, not a @@ -141,18 +140,18 @@ type Blk = LeiosTestBlock -- | What a test can vary about the node. data NodeUnderTestConfig = NodeUnderTestConfig - { nutcSecurityParam :: SecurityParam - , nutcLedgerConfig :: LeiosTestLedgerConfig - , nutcRandomness :: StdGen + { nodeConfigSecurityParam :: SecurityParam + , nodeConfigLedger :: LeiosTestLedgerConfig + , nodeConfigRandomness :: StdGen -- ^ The root of all the test's randomness; see 'Seeds'. } defaultNodeUnderTestConfig :: SecurityParam -> LeiosTestLedgerConfig -> NodeUnderTestConfig -defaultNodeUnderTestConfig nutcSecurityParam nutcLedgerConfig = +defaultNodeUnderTestConfig nodeConfigSecurityParam nodeConfigLedger = NodeUnderTestConfig - { nutcSecurityParam - , nutcLedgerConfig - , nutcRandomness = mkStdGen 0 + { nodeConfigSecurityParam + , nodeConfigLedger + , nodeConfigRandomness = mkStdGen 0 } -- | All the randomness of a Leios node-vs-environment test. @@ -174,8 +173,8 @@ data Seeds a = Seeds splitSeeds :: StdGen -> Seeds StdGen splitSeeds = evalState (mapM (\() -> state splitGen) (Seeds () () () () () ())) -nodeSeeds :: NodeUnderTestConfig -> Seeds StdGen -nodeSeeds = splitSeeds . nutcRandomness +configSeeds :: NodeUnderTestConfig -> Seeds StdGen +configSeeds = splitSeeds . nodeConfigRandomness -- | The peer address these tests use: a peer is just a number. newtype PeerAddr = PeerAddr Int @@ -185,12 +184,12 @@ newtype PeerAddr = PeerAddr Int -- | A running node, and the handles a test needs on it for its gray-box -- predicates. data NodeUnderTest m = NodeUnderTest - { nutChainDB :: ChainDB m Blk - , nutTopLevelConfig :: TopLevelConfig Blk - , nutKernel :: NodeKernel m PeerAddr (ConnectionId ()) Blk - , nutApps :: BlockNodeToNodeVersion Blk -> NodeApps m - , nutVersions :: NodeVersions m - , nutSeeds :: Seeds StdGen + { nodeChainDB :: ChainDB m Blk + , nodeTopLevelConfig :: TopLevelConfig Blk + , nodeKernel :: NodeKernel m PeerAddr (ConnectionId ()) Blk + , nodeApps :: BlockNodeToNodeVersion Blk -> NodeApps m + , nodeVersions :: NodeVersions m + , nodeSeeds :: Seeds StdGen } -- | The node's node-to-node applications, at every mini-protocol's bytes. @@ -239,7 +238,7 @@ withNodeUnderTest :: withNodeUnderTest cfg nodeDBs body = do -- What a node with Genesis disabled, the default, runs with. (genesisArgs, updateChainDbArgs) <- mkGenesisNodeKernelArgs disableGenesisConfig - let seeds = nodeSeeds cfg + let seeds = configSeeds cfg -- The ChainDB and the node each get their own resource registry. The node's -- registry is nested inside the ChainDB's, and the body runs inside both. So -- on the way out, the body finishes first, then the node's threads stop, and @@ -251,7 +250,7 @@ withNodeUnderTest cfg nodeDBs body = do <$> openChainDB dbRegistry (topLevelConfigOf cfg) - (leiosTestInitExtLedger (nutcLedgerConfig cfg)) + (leiosTestInitExtLedger (nodeConfigLedger cfg)) (mountedIn (nodeDBsImm nodeDBs)) (mountedIn (nodeDBsVol nodeDBs)) (seedSnapshotDelay seeds) @@ -316,18 +315,18 @@ withNodeUnderTest cfg nodeDBs body = do (const decodePeerAddr) body NodeUnderTest - { nutChainDB = chainDB - , nutTopLevelConfig = topLevelConfigOf cfg - , nutKernel = kernel - , nutApps = apps - , nutVersions = + { nodeChainDB = chainDB + , nodeTopLevelConfig = topLevelConfigOf cfg + , nodeKernel = kernel + , nodeApps = apps + , nodeVersions = mkNodeToNodeInitiatorResponderVersions (featureFlags kernelArgs) (miniProtocolParameters kernelArgs) nodeVersionData (supportedNodeToNodeVersions (Proxy @Blk)) apps - , nutSeeds = seeds + , nodeSeeds = seeds } -- | A node whose ledger view forecasts further ahead than any test runs. @@ -361,7 +360,7 @@ withNodeForecastingOnly range body = do } -- | The largest endorser block, and total size of the transactions it --- references, that the NUT's ledger admits. +-- references, that the node's ledger admits. maxEbBodySize :: BytesSize maxEbBodySize = 5000 @@ -400,8 +399,8 @@ mkBlockchainTime cfg registry chainDB = } topLevelConfigOf :: NodeUnderTestConfig -> TopLevelConfig Blk -topLevelConfigOf NodeUnderTestConfig{nutcSecurityParam, nutcLedgerConfig} = - singleNodeLeiosTestConfig nutcLedgerConfig nutcSecurityParam +topLevelConfigOf NodeUnderTestConfig{nodeConfigSecurityParam, nodeConfigLedger} = + singleNodeLeiosTestConfig nodeConfigLedger nodeConfigSecurityParam -- | A node's database directory, mounting each database in its own -- subdirectory as 'stdMkChainDbHasFS' does, but on a mock file system. diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Relay.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Relay.hs index c45b676242..469ec5cb86 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Relay.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Relay.hs @@ -184,8 +184,8 @@ relayPeers end ups downs = do pure $ splitAt (length ups) outcomes where specs = ups <> [PeerSpec at [] | at <- downs] - outcomes = runSimOrThrow $ withNode $ \nut -> - forConcurrently (zip [1 ..] specs) $ \(i, spec) -> runPeer nut end (PeerAddr i) spec + outcomes = runSimOrThrow $ withNode $ \node -> + forConcurrently (zip [1 ..] specs) $ \(i, spec) -> runPeer node end (PeerAddr i) spec -- | 'relay' for 20 seconds to one downstream peer connecting at the given time. relayToOne :: DiffTime -> [[(DiffTime, Notification)]] -> IO PeerOutcome @@ -195,20 +195,20 @@ relayToOne at ups = _ -> error "relayToOne: one downstream peer" runPeer :: NodeUnderTest (IOSim s) -> DiffTime -> PeerAddr -> PeerSpec -> IOSim s PeerOutcome -runPeer nut end addr PeerSpec{psConnectAt, psSends} = do +runPeer node end addr PeerSpec{psConnectAt, psSends} = do threadDelay psConnectAt queue <- newTQueueIO received <- newTVarIO [] - let c = envLeiosNotifyCodec nut + let c = envLeiosNotifyCodec node envPeer = EnvPeer { epLeiosNotifyServer = runFeedingServer c (readTQueue queue) , epLeiosNotifyClient = Just $ runRecordingClient c received - , epLeiosFetchServer = refusingLeiosFetchServer nut + , epLeiosFetchServer = refusingLeiosFetchServer node , epLeiosFetchClient = Nothing } withAsync (feedAt queue psSends) $ \_feeder -> - withNodeVsEnvConnection nut addr envPeer $ \_conn -> do + withNodeVsEnvConnection node addr envPeer $ \_conn -> do Time now <- getMonotonicTime threadDelay (end - now) PeerOutcome . reverse <$> readTVarIO received From 32449b6703ef3af7750b687a63e019b04c058b84 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Thu, 22 Oct 2026 13:28:30 -0300 Subject: [PATCH 06/13] Test that the node stores the endorser blocks that it forges The test installs a block forging with 'setBlockForging' on a node over an in-memory LeiosDB. Thus it checks that 'forkBlockForging' gives 'storeForgedEb' to 'forge'. --- .../test/consensus-test/Main.hs | 2 + .../Test/Consensus/Leios/Forge.hs | 115 ++++++++++++++++++ .../Test/Consensus/Leios/NodeUnderTest.hs | 4 +- .../Test/Consensus/Leios/TestBlock.hs | 8 +- ouroboros-consensus.cabal | 1 + 5 files changed, 124 insertions(+), 6 deletions(-) create mode 100644 ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Main.hs b/ouroboros-consensus-diffusion/test/consensus-test/Main.hs index 246650a06e..26dbdf37fa 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Main.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Main.hs @@ -7,6 +7,7 @@ import qualified Test.Consensus.Genesis.TestSuite.SmallKey.Tests (tests) import qualified Test.Consensus.Genesis.Tests (tests) import qualified Test.Consensus.HardFork.Combinator (tests) import qualified Test.Consensus.Leios.ChainDB (tests) +import qualified Test.Consensus.Leios.Forge (tests) import qualified Test.Consensus.Leios.LeiosFetch (tests) import qualified Test.Consensus.Leios.LeiosNotify (tests) import qualified Test.Consensus.Leios.Relay (tests) @@ -42,6 +43,7 @@ tests = , Test.Consensus.BlockTree.Tests.tests , Test.Consensus.Genesis.TestSuite.SmallKey.Tests.tests , Test.Consensus.Leios.ChainDB.tests + , Test.Consensus.Leios.Forge.tests , Test.Consensus.Leios.LeiosFetch.tests , Test.Consensus.Leios.LeiosNotify.tests , Test.Consensus.Leios.Relay.tests diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs new file mode 100644 index 0000000000..c7f6fa67c2 --- /dev/null +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Tests that the node stores the endorser blocks that it forges. +module Test.Consensus.Leios.Forge (tests) where + +import Control.Monad.Class.MonadTimer.SI (threadDelay) +import Control.Monad.IOSim (IOSim, runSimOrThrow) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS8 +import Data.List (sort) +import Data.List.NonEmpty (NonEmpty (..)) +import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Ledger.Abstract (GetTip (..)) +import Ouroboros.Consensus.Leios.Types +import Ouroboros.Consensus.NodeKernel (NodeKernel (..)) +import Ouroboros.Consensus.Storage.ChainDB.API (getCurrentChain) +import Ouroboros.Consensus.Storage.LeiosDB.API (LeiosDbReader (..), withReader) +import Ouroboros.Consensus.Util.IOLike (atomically) +import qualified Ouroboros.Network.AnchoredFragment as AF +import Test.Consensus.Leios.NodeUnderTest +import Test.Consensus.Leios.TestBlock +import Test.Tasty +import Test.Tasty.HUnit +import Test.Util.TestBlock (TestHash (..)) + +tests :: TestTree +tests = + testGroup + "Forging" + [ testCase + "the node stores each endorser block that it forges, at the point that the header announces" + $ do + let ForgeOutcome{announcedEbs, storedPoints} = runSimOrThrow forgedEbs + assertBool "the node forged no block" (not (null announcedEbs)) + sort storedPoints @?= sort [(announcedSlot eb, announcedHash eb) | eb <- announcedEbs] + map storedTxs announcedEbs @?= map (Just . forgedTxs) announcedEbs + ] + +-- | What the chain and the LeiosDB hold after the node forges. +data ForgeOutcome = ForgeOutcome + { announcedEbs :: [AnnouncedEb] + -- ^ The endorser blocks that the blocks on the chain announce, oldest first. + , storedPoints :: [(SlotNo, EndorserBlockHash)] + -- ^ The points in the LeiosDB. + } + +-- | An endorser block that a block on the chain announces. +data AnnouncedEb = AnnouncedEb + { announcedSlot :: SlotNo + , announcedHash :: EndorserBlockHash + , forgedTxs :: [ByteString] + -- ^ The bytes of the transactions that 'ebForging' puts in the endorser block. + , storedTxs :: Maybe [ByteString] + -- ^ The bytes of the transactions that the LeiosDB holds for 'announcedHash', + -- or 'Nothing' if it does not hold all of them. + } + +-- | The node forges in each of the first slots. +forgedEbs :: IOSim s ForgeOutcome +forgedEbs = withNode $ \node -> do + setBlockForging (nodeKernel node) [MkBlockForging (pure ebForging)] + -- A slot is one second, so the node forges in slots 0 to 3. The half slot + -- lets the forge of slot 3 add its block to the ChainDB. + threadDelay 3.5 + chain <- atomically $ getCurrentChain (nodeChainDB node) + withReader (getLeiosDB (nodeKernel node)) $ \reader -> do + announcedEbs <- + sequence + [ AnnouncedEb (blockSlot hdr) ebHash [txInSlot (blockSlot hdr)] + . fmap (map snd) + <$> lookupEbClosure reader ebHash + | hdr <- AF.toOldestFirst chain + , Just (ebHash, _size) <- [lthAnnouncement hdr] + ] + storedPoints <- testScanEbPoints reader + pure ForgeOutcome{announcedEbs, storedPoints} + +-- | A forging that leads in every slot. Each block extends the ledger tip and +-- announces an endorser block with one transaction, whose bytes depend on the +-- slot, so that each endorser block has its own hash. +ebForging :: BlockForging (IOSim s) LeiosTestBlock +ebForging = + BlockForging + { forgeLabel = "ebForging" + , canBeLeader = () + , updateForgeState = \_ _ _ -> pure $ ForgeStateUpdated () + , checkCanForge = \_ _ _ _ _ -> Right () + , forgeBlock = \ForgeBlockArgs{fbCurrentSlotNo, fbCurrentTickedLedgerState} -> do + let forgedEb = forgeLeiosEb (txInSlot fbCurrentSlotNo :| []) + eb = forgedEbBody forgedEb + ebHash = endorserBlockHash eb + tip = castPoint (getTip fbCurrentTickedLedgerState) + pure + ForgeBlockResult + { rankingBlock = + setAnnouncement ebHash (encodeEndorserBlockSize eb) $ + setSlot fbCurrentSlotNo $ + blockAfter tip + , endorserBlock = Just forgedEb + } + , finalize = pure () + } + +-- | A block whose predecessor is the given point. 'forgeBlock' sets its slot. +blockAfter :: Point LeiosTestBlock -> LeiosTestBlock +blockAfter = \case + GenesisPoint -> firstLeiosBlock 0 + BlockPoint _ (TestHash path) -> + successorLeiosBlock $ + LeiosTestBlock (ltbHeader (firstLeiosBlock 0)){lthHash = TestHash path} + +txInSlot :: SlotNo -> ByteString +txInSlot slot = BS8.pack ("tx in slot " <> show (unSlotNo slot)) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs index d598fd1a8f..cad1873f8d 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/NodeUnderTest.hs @@ -9,8 +9,8 @@ -- -- The node is built by the node's own 'initNodeKernel' over a ChainDB on a -- mocked filesystem, so the code under test is the node's, not a --- reimplementation of it. Its block is 'LeiosTestBlock'. It does not forge, --- since the test gives it no block forging. +-- reimplementation of it. Its block is 'LeiosTestBlock'. It forges only if the +-- test calls 'setBlockForging'. -- -- The node's node-to-node applications and the versions it offers them at are -- built by the node's own 'mkNodeToNodeApps' and diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/TestBlock.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/TestBlock.hs index 48fcb9c926..fee3f3af93 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/TestBlock.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/TestBlock.hs @@ -775,8 +775,8 @@ deriving via {------------------------------------------------------------------------------- Mempool - 'RunNode' demands a mempool even of a node that never forges. This one - rejects every transaction. + 'RunNode' demands a mempool. This one rejects every transaction, so a forged + block holds none. -------------------------------------------------------------------------------} data instance GenTx LeiosTestBlock = LeiosTestGenTx @@ -924,8 +924,8 @@ instance SerialiseNodeToClientConstraints LeiosTestBlock instance RunNode LeiosTestBlock --- | The node under test has no credentials, so it never forges; these exist --- only because 'RunNode' asks for them. +-- | A test's block forging has no credentials, so nothing can stop it from +-- forging. These exist only because 'RunNode' asks for them. type instance CannotForge LeiosTestBlock = Void type instance ForgeStateInfo LeiosTestBlock = () diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal index 8d0b70daea..0e13f05e8e 100644 --- a/ouroboros-consensus.cabal +++ b/ouroboros-consensus.cabal @@ -1512,6 +1512,7 @@ test-suite consensus-diffusion-test Test.Consensus.HardFork.Combinator.B Test.Consensus.Leios.ChainDB Test.Consensus.Leios.Environment + Test.Consensus.Leios.Forge Test.Consensus.Leios.LeiosFetch Test.Consensus.Leios.LeiosFetch.Codec Test.Consensus.Leios.LeiosFetch.Node From adf1e4ad3ddbe5f2c47188a2f635bb4b2f31de0f Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Tue, 27 Oct 2026 09:47:59 -0300 Subject: [PATCH 07/13] Rename ebListing to mkForgedLeiosEb --- .../consensus-test/Test/Consensus/HardFork/Combinator.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs index e834d2b4bf..fd07de4610 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/HardFork/Combinator.hs @@ -112,7 +112,7 @@ unit_hardForkForgeBlockPassesTxsAndReturnsEb = do case forged of Z (I blkA) -> blkA_body blkA @?= [txA 1, txA 2] S _ -> assertFailure "the block is not from era A" - forgedEb @?= Just (ebListing (txA 3 :| [])) + forgedEb @?= Just (mkForgedLeiosEb (txA 3 :| [])) where hardForkForging :: BlockForging Identity TestBlock hardForkForging = @@ -134,12 +134,12 @@ unit_hardForkForgeBlockPassesTxsAndReturnsEb = do pure ForgeBlockResult { rankingBlock = blkA{blkA_body = map forgetValidatedGenTxA (fbTxs argsA)} - , endorserBlock = ebListing <$> nonEmpty (map forgetValidatedGenTxA (fbEbTxs argsA)) + , endorserBlock = mkForgedLeiosEb <$> nonEmpty (map forgetValidatedGenTxA (fbEbTxs argsA)) } } - ebListing :: NonEmpty (GenTx BlockA) -> ForgedLeiosEb - ebListing = forgeLeiosEb . fmap (fromShort . toRawTxIdHash . txId) + mkForgedLeiosEb :: NonEmpty (GenTx BlockA) -> ForgedLeiosEb + mkForgedLeiosEb = forgeLeiosEb . fmap (fromShort . toRawTxIdHash . txId) txA :: Int -> GenTx BlockA txA n = TxA (TxIdA n) InitiateAtoB From 2898646acd9bc6b7de4ec0dcd27a39fabb38be1d Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Tue, 27 Oct 2026 16:53:58 -0300 Subject: [PATCH 08/13] Move storeForgedEb to the LeiosDB API 'storeForgedEb' now takes the slot of the announcing ranking block instead of the config and the header. It computes the point and the size from the endorser block body with 'endorserBlockHash' and 'encodeEndorserBlockSize'. Thus it does not need 'RunNode', and the 'LeiosDbWriter' record does not change. --- ...22_120000_damian.nadales_eb_forge_store.md | 2 +- .../Test/Consensus/Shelley/Forge.hs | 6 +-- .../Ouroboros/Consensus/NodeKernel.hs | 38 +------------------ ouroboros-consensus.cabal | 2 +- .../Consensus/Storage/LeiosDB/API.hs | 27 ++++++++++++- 5 files changed, 33 insertions(+), 42 deletions(-) diff --git a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md index 84af5737b1..80b2e2feb1 100644 --- a/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md +++ b/changelog.d/20261022_120000_damian.nadales_eb_forge_store.md @@ -10,4 +10,4 @@ For top level release notes, leave all the headers commented out. - If a write to the in-memory LeiosDB fails, `writeEbPoint`, `writeEbBody` and `writeTxs` throw at submission. Thus a caller that does not `await` the `Promise` sees the failure. - The node kernel writes each forged endorser block to the LeiosDB. The forge does not await the writes. On SQLite, it blocks while the write queue is full. If a write fails, the node stops. - The depth of the LeiosDB SQLite write queue counts three jobs for the forge: the point, the body and the transactions of a forged endorser block. -- `Ouroboros.Consensus.NodeKernel` exports `storeForgedEb`, the function that the node kernel gives to `forge`. +- `Ouroboros.Consensus.Storage.LeiosDB.API` exports `storeForgedEb`, which writes a forged endorser block to the LeiosDB. The node kernel gives it to `forge`. diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs index 573f7d15ca..97a35df354 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs @@ -46,7 +46,6 @@ import Ouroboros.Consensus.Leios.Types , forgedEbBody , forgedEbTxs ) -import Ouroboros.Consensus.NodeKernel (storeForgedEb) import Ouroboros.Consensus.Protocol.Praos ( ConsensusConfig (..) , PraosIsLeader (..) @@ -80,6 +79,7 @@ import Ouroboros.Consensus.Shelley.Node.Praos (praos2SharedBlockForging) import Ouroboros.Consensus.Storage.LeiosDB ( LeiosDbReader (..) , newLeiosDBInMemory + , storeForgedEb , withReader , withWriter ) @@ -141,10 +141,10 @@ prop_storesEb = forAllBlind (genCoreNode (SL.KESPeriod 0)) $ \coreNode -> forAll genNumEbTxs $ \numEbTxs -> ioProperty $ do let ebTxs = take numEbTxs distinctTxs - (cfg, ForgeBlockResult blk forgedEb) <- forgeWith coreNode ebTxs + (_, ForgeBlockResult blk forgedEb) <- forgeWith coreNode ebTxs db <- newLeiosDBInMemory withWriter db $ \writer -> - mapM_ (storeForgedEb cfg writer (getHeader blk)) forgedEb + mapM_ (storeForgedEb writer (blockSlot blk)) forgedEb case announcement blk of SNothing -> pure $ counterexample "the block announces no endorser block" False SJust ann -> do 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 d6a209424a..7040399df8 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 @@ -19,7 +19,6 @@ module Ouroboros.Consensus.NodeKernel , getPeersFromCurrentLedger , getPeersFromCurrentLedgerAfterSlot , initNodeKernel - , storeForgedEb , toConsensusMode ) where @@ -69,13 +68,6 @@ import Ouroboros.Consensus.Leios.NotifyLog , newNotifyLog , notifyLogPruner ) -import Ouroboros.Consensus.Leios.Protocol (LeiosAnnouncement (..), LeiosProtocol (..)) -import Ouroboros.Consensus.Leios.Types - ( ForgedLeiosEb - , LeiosPoint (..) - , forgedEbBody - , forgedEbTxs - ) import Ouroboros.Consensus.Mempool import qualified Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface as BlockFetchClientInterface import Ouroboros.Consensus.MiniProtocol.ChainSync.Client @@ -117,6 +109,7 @@ import Ouroboros.Consensus.Storage.LeiosDB.API ( LeiosDbHandle , LeiosDbWriter (..) , openWriter + , storeForgedEb ) import Ouroboros.Consensus.Util.AnchoredFragment ( preferAnchoredCandidate @@ -609,7 +602,7 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) = chainDB mempool bf - (storeForgedEb cfg leiosDbWriter) + (storeForgedEb leiosDbWriter . blockSlot) currentSlot ) where @@ -627,33 +620,6 @@ forkBlockForging IS{..} (MkBlockForging blockForgingM) = finalizeForging (bf, leiosDbWriter) = finalize bf `finally` closeWriter leiosDbWriter --- | Write an endorser block that this node forged to the LeiosDB. --- --- The forge does not await the writes. On SQLite, it blocks while the write --- queue is full. If a write fails, the node stops. Peers can get the header --- before the endorser block is stored. -storeForgedEb :: - forall m blk. - (IOLike m, RunNode blk) => - TopLevelConfig blk -> - LeiosDbWriter m -> - Header blk -> - ForgedLeiosEb -> - m () -storeForgedEb cfg writer hdr forgedEb = do - _ <- writeEbPoint writer point (announcementEbSize announcement) - _ <- writeEbBody writer point (forgedEbBody forgedEb) - void $ writeTxs writer point (zip [0 ..] (forgedEbTxs forgedEb)) - where - announcement = - case getLeiosAnnouncement (Proxy @(BlockProtocol blk)) (validateView (configBlock cfg) hdr) of - Just ann -> ann - Nothing -> error "storeForgedEb: the header does not announce the endorser block" - - -- Peers key the endorser block by the slot of the header that announces - -- it, as 'mkAnnouncingHeader' does. - point = MkLeiosPoint (blockSlot hdr) (announcementEbHash announcement) - {------------------------------------------------------------------------------- TxSubmission integration -------------------------------------------------------------------------------} diff --git a/ouroboros-consensus.cabal b/ouroboros-consensus.cabal index 0e13f05e8e..55906069fa 100644 --- a/ouroboros-consensus.cabal +++ b/ouroboros-consensus.cabal @@ -1918,7 +1918,7 @@ test-suite shelley-test measures, mempack, microlens, - ouroboros-consensus:{cardano, diffusion, ouroboros-consensus, protocol, unstable-consensus-testlib, unstable-diffusion-testlib}, + ouroboros-consensus:{cardano, ouroboros-consensus, protocol, unstable-consensus-testlib, unstable-diffusion-testlib}, QuickCheck, sop-core, strict-sop-core, diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs index 0c89dd7e41..705c22e5ea 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs @@ -20,12 +20,14 @@ module Ouroboros.Consensus.Storage.LeiosDB.API , awaitAll , withWriter , allocateWriter + , storeForgedEb , CompletedEbs , TxOffset ) where import Cardano.Slotting.Slot (SlotNo) import Control.Concurrent.Class.MonadSTM.Strict (StrictTChan) +import Control.Monad (void) import Control.ResourceRegistry (ResourceRegistry, allocate) import Data.ByteString (ByteString) import Data.Foldable (traverse_) @@ -35,9 +37,14 @@ import Ouroboros.Consensus.Leios.Types ( BytesSize , EndorserBlock , EndorserBlockHash - , LeiosPoint + , ForgedLeiosEb + , LeiosPoint (..) , TxHash , TxOffset + , encodeEndorserBlockSize + , endorserBlockHash + , forgedEbBody + , forgedEbTxs ) import Ouroboros.Consensus.Storage.LeiosDB.Trace (LeiosDbStats (..)) import Ouroboros.Consensus.Util.IOLike (IOLike, MonadThrow, NoThunks (..), bracket) @@ -176,3 +183,21 @@ allocateReader registry db = snd <$> allocate registry (\_ -> openReader db) clo allocateWriter :: IOLike m => ResourceRegistry m -> LeiosDbHandle m -> m (LeiosDbWriter m) allocateWriter registry db = snd <$> allocate registry (\_ -> openWriter db) closeWriter + +-- | Write an endorser block that this node forged to the LeiosDB. +-- +-- The slot is the slot of the ranking block that announces the endorser block. +-- That ranking block must announce the 'endorserBlockHash' and the +-- 'encodeEndorserBlockSize' of the endorser block body. +-- +-- This function does not await the writes. On SQLite, it blocks while the +-- write queue is full. If a write fails, the node stops. Peers can get the +-- header before the endorser block is stored. +storeForgedEb :: Monad m => LeiosDbWriter m -> SlotNo -> ForgedLeiosEb -> m () +storeForgedEb writer slot forgedEb = do + _ <- writeEbPoint writer point (encodeEndorserBlockSize body) + _ <- writeEbBody writer point body + void $ writeTxs writer point (zip [0 ..] (forgedEbTxs forgedEb)) + where + body = forgedEbBody forgedEb + point = MkLeiosPoint slot (endorserBlockHash body) From dd69c14e867683138c1a0782e40b016b91464c1a Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Wed, 28 Oct 2026 14:44:52 -0300 Subject: [PATCH 09/13] Make forgedEbTxs a NonEmpty list 'forgeLeiosEb' takes a 'NonEmpty' list of transaction bytes. The 'forgedEbTxs' field now keeps that type, so a forged endorser block always has at least one transaction. --- .../test/shelley-test/Test/Consensus/Shelley/Forge.hs | 3 ++- .../ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs | 4 ++-- .../Ouroboros/Consensus/Storage/LeiosDB/API.hs | 4 ++-- 3 files changed, 6 insertions(+), 5 deletions(-) diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs index 97a35df354..a589c4ddb5 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs @@ -27,6 +27,7 @@ import Cardano.Slotting.EpochInfo (fixedEpochInfo) import Codec.CBOR.Write (toStrictByteString) import Control.Tracer (nullTracer) import qualified Data.ByteString as BS +import Data.Foldable (toList) import Data.Maybe (isJust) import Lens.Micro ((&), (.~), (^.)) import Ouroboros.Consensus.Block @@ -113,7 +114,7 @@ prop_announcesEb = [ counterexample "the endorser block does not reference the transactions in order" $ endorserBlockReferences eb === map reference ebTxs , counterexample "forgedEbTxs does not hold the referenced transaction bytes" $ - forgedEbTxs forged === map txBytes ebTxs + toList (forgedEbTxs forged) === map txBytes ebTxs , counterexample "encodeEndorserBlockSize differs from the length of encodeEndorserBlock" $ encodeEndorserBlockSize eb === fromIntegral (BS.length (toStrictByteString (encodeEndorserBlock eb))) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs index 70d332bddc..f099c9dcf7 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Leios/Types.hs @@ -309,7 +309,7 @@ type TxOffset = Int -- the references. data ForgedLeiosEb = ForgedLeiosEb { forgedEbBody :: !EndorserBlock - , forgedEbTxs :: ![ByteString] + , forgedEbTxs :: !(NonEmpty ByteString) -- ^ The bytes of the transactions that 'forgedEbBody' references, in the -- same order. } @@ -322,7 +322,7 @@ forgeLeiosEb :: NonEmpty ByteString -> ForgedLeiosEb forgeLeiosEb txBytes = ForgedLeiosEb { forgedEbBody = endorserBlockFromTxBytes txBytes - , forgedEbTxs = toList txBytes + , forgedEbTxs = txBytes } -- | The hash ranking blocks announce for the endorser block: that of its diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs index 705c22e5ea..d9cb2379ba 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LeiosDB/API.hs @@ -30,7 +30,7 @@ import Control.Concurrent.Class.MonadSTM.Strict (StrictTChan) import Control.Monad (void) import Control.ResourceRegistry (ResourceRegistry, allocate) import Data.ByteString (ByteString) -import Data.Foldable (traverse_) +import Data.Foldable (toList, traverse_) import GHC.Stack (HasCallStack) import NoThunks.Class (OnlyCheckWhnfNamed (..)) import Ouroboros.Consensus.Leios.Types @@ -197,7 +197,7 @@ storeForgedEb :: Monad m => LeiosDbWriter m -> SlotNo -> ForgedLeiosEb -> m () storeForgedEb writer slot forgedEb = do _ <- writeEbPoint writer point (encodeEndorserBlockSize body) _ <- writeEbBody writer point body - void $ writeTxs writer point (zip [0 ..] (forgedEbTxs forgedEb)) + void $ writeTxs writer point (zip [0 ..] (toList (forgedEbTxs forgedEb))) where body = forgedEbBody forgedEb point = MkLeiosPoint slot (endorserBlockHash body) From e86dc6a13e5d1362de15603eedf63e065fcc51fe Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Wed, 28 Oct 2026 15:28:55 -0300 Subject: [PATCH 10/13] Name the body of the Leios forging test --- .../consensus-test/Test/Consensus/Leios/Forge.hs | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs index c7f6fa67c2..9707b221e9 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs @@ -31,13 +31,16 @@ tests = "Forging" [ testCase "the node stores each endorser block that it forges, at the point that the header announces" - $ do - let ForgeOutcome{announcedEbs, storedPoints} = runSimOrThrow forgedEbs - assertBool "the node forged no block" (not (null announcedEbs)) - sort storedPoints @?= sort [(announcedSlot eb, announcedHash eb) | eb <- announcedEbs] - map storedTxs announcedEbs @?= map (Just . forgedTxs) announcedEbs + unit_storesForgedEbs ] +unit_storesForgedEbs :: Assertion +unit_storesForgedEbs = do + let ForgeOutcome{announcedEbs, storedPoints} = runSimOrThrow forgedEbs + assertBool "the node forged no block" (not (null announcedEbs)) + sort storedPoints @?= sort [(announcedSlot eb, announcedHash eb) | eb <- announcedEbs] + map storedTxs announcedEbs @?= map (Just . forgedTxs) announcedEbs + -- | What the chain and the LeiosDB hold after the node forges. data ForgeOutcome = ForgeOutcome { announcedEbs :: [AnnouncedEb] From 9f7fddb693e9c2961985ff09a6e8e60e09e49fb6 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Wed, 28 Oct 2026 15:35:30 -0300 Subject: [PATCH 11/13] Document what the Leios forging test checks --- .../consensus-test/Test/Consensus/Leios/Forge.hs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs index 9707b221e9..4d844f4082 100644 --- a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs +++ b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Leios/Forge.hs @@ -2,7 +2,8 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} --- | Tests that the node stores the endorser blocks that it forges. +-- | Tests that 'forkBlockForging' writes each endorser block that it forges to +-- the LeiosDB. module Test.Consensus.Leios.Forge (tests) where import Control.Monad.Class.MonadTimer.SI (threadDelay) @@ -34,6 +35,16 @@ tests = unit_storesForgedEbs ] +-- | The node runs 'forkBlockForging' with 'ebForging' for slots 0 to 3. Then +-- the test reads the chain and the LeiosDB. +-- +-- * If the node forges no block, the other checks pass with no data. The +-- first check catches this. +-- * If 'forkBlockForging' does not give 'storeForgedEb' to 'forge', or if +-- 'storeForgedEb' writes at a slot or a hash that differs from the +-- announcement in the header, the second check fails. +-- * If 'storeForgedEb' does not write the transaction bytes, the third check +-- fails. unit_storesForgedEbs :: Assertion unit_storesForgedEbs = do let ForgeOutcome{announcedEbs, storedPoints} = runSimOrThrow forgedEbs From 6be685bc5ddede4834a98f0f6f30414016882d87 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Wed, 28 Oct 2026 16:13:28 -0300 Subject: [PATCH 12/13] Move the storeForgedEb test to the LeiosDB tests The test needs only a slot and some transaction bytes. It does not need a forged Shelley block. In the LeiosDB tests, it also runs on SQLite. --- .../Test/Consensus/Shelley/Forge.hs | 37 +---------------- .../Test/Ouroboros/Storage/LeiosDB.hs | 41 +++++++++++++++++++ 2 files changed, 42 insertions(+), 36 deletions(-) diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs index a589c4ddb5..71432b0e70 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Forge.hs @@ -13,7 +13,7 @@ import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core (bodyTxL, eraProtVerLow, feeTxBodyL, ppProtocolVersionL) import Cardano.Ledger.Dijkstra (DijkstraEra) import Cardano.Ledger.Dijkstra.PParams (ppMaxEndorserBlockReferencesSizeL) -import Cardano.Ledger.Hashes (HASH, extractHash, unsafeMakeSafeHash) +import Cardano.Ledger.Hashes (HASH, unsafeMakeSafeHash) import Cardano.Ledger.MemoBytes (getMemoRawType) import qualified Cardano.Ledger.Shelley.API as SL ( mkMempoolEnv @@ -77,13 +77,6 @@ import Ouroboros.Consensus.Shelley.Ledger.Config import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol () import Ouroboros.Consensus.Shelley.Node.Common (ShelleyLeaderCredentials (..)) import Ouroboros.Consensus.Shelley.Node.Praos (praos2SharedBlockForging) -import Ouroboros.Consensus.Storage.LeiosDB - ( LeiosDbReader (..) - , newLeiosDBInMemory - , storeForgedEb - , withReader - , withWriter - ) import Test.Consensus.Shelley.Examples (examplesDijkstra, testShelleyGenesis) import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck @@ -97,7 +90,6 @@ tests = "Forge" [ testProperty "a block announces the endorser block it comes with" prop_announcesEb , testProperty "a block without endorser-block transactions announces nothing" prop_noEb - , testProperty "storeForgedEb stores the endorser block that the header announces" prop_storesEb ] prop_announcesEb :: Property @@ -134,33 +126,6 @@ prop_noEb = (_, ForgeBlockResult blk forgedEb) <- forgeWith coreNode [] pure $ (announcement blk, isJust forgedEb) === (SNothing, False) --- | 'storeForgedEb' writes the point, the body and the transactions of the --- forged endorser block. The test reads them back at the slot and the hash --- that the header announces. -prop_storesEb :: Property -prop_storesEb = - forAllBlind (genCoreNode (SL.KESPeriod 0)) $ \coreNode -> - forAll genNumEbTxs $ \numEbTxs -> ioProperty $ do - let ebTxs = take numEbTxs distinctTxs - (_, ForgeBlockResult blk forgedEb) <- forgeWith coreNode ebTxs - db <- newLeiosDBInMemory - withWriter db $ \writer -> - mapM_ (storeForgedEb writer (blockSlot blk)) forgedEb - case announcement blk of - SNothing -> pure $ counterexample "the block announces no endorser block" False - SJust ann -> do - let ebHash = extractHash $ ebReferencesAnnouncementHash ann - (points, closure) <- - withReader db $ \reader -> - (,) <$> testScanEbPoints reader <*> lookupEbClosure reader ebHash - pure $ - conjoin - [ counterexample "the point is not the slot and the hash that the header announces" $ - points === [(blockSlot blk, ebHash)] - , counterexample "the stored transactions are not the forged ones" $ - closure === Just [(fst (reference tx), txBytes tx) | tx <- ebTxs] - ] - -- | A number of endorser-block transactions. 'encodeEndorserBlockSize' writes a -- longer map header from 24 and from 256 references. genNumEbTxs :: Gen Int diff --git a/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs b/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs index 1ab9b80ca5..4340964245 100644 --- a/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs +++ b/ouroboros-consensus/test/leios-storage-test/Test/Ouroboros/Storage/LeiosDB.hs @@ -26,8 +26,11 @@ import Control.Monad.Class.MonadTime.SI (diffTime, getMonotonicTime) import Control.Tracer (Tracer (..), emit, nullTracer) import qualified Data.ByteString as BS import qualified Data.ByteString.Short as SBS +import Data.Foldable (toList) import Data.Function ((&)) import Data.List (nub, sortOn) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Maybe (isJust) import qualified Data.Text as T @@ -41,7 +44,10 @@ import Ouroboros.Consensus.Leios.Types , TxHash , TxOffset , encodeEndorserBlockSize + , endorserBlockHash , endorserBlockReferences + , forgeLeiosEb + , forgedEbBody , mkEndorserBlock ) import Ouroboros.Consensus.Storage.LeiosDB @@ -53,6 +59,7 @@ import Ouroboros.Consensus.Storage.LeiosDB , Promise (..) , TraceLeiosDb (..) , newLeiosDBInMemory + , storeForgedEb , truncateLeiosDbAfterSlot , withLeiosDBSQLite , withReader @@ -247,6 +254,11 @@ mkTestGroups impl = , testProperty "partial txs returns Nothing" $ prop_completedEbPartialTxs impl , testProperty "no body returns Nothing" $ prop_completedEbNoBody impl ] + , testGroup + "storeForgedEb" + [ testProperty "stores the point, the body and the txs of the endorser block" $ + prop_storeForgedEbThenLookup impl + ] ] -- * QuickCheck generators @@ -281,6 +293,12 @@ genEb numTxs = do genPointAndEb :: Int -> Gen (LeiosPoint, EndorserBlock) genPointAndEb numTxs = (,) <$> genPoint <*> genEb numTxs +-- | Transaction bytes, distinct from each other. +genDistinctTxBytes :: Gen (NonEmpty BS.ByteString) +genDistinctTxBytes = NE.nub <$> ((:|) <$> genTxBytes <*> listOf genTxBytes) + where + genTxBytes = chooseInt (1, 32) >>= fmap BS.pack . vector + -- | Bytes for the tx at the given offset of the EB: of its declared size, as -- a write must be to be accepted, and distinct per offset. txBytesFor :: EndorserBlock -> TxOffset -> BS.ByteString @@ -1081,6 +1099,29 @@ data Op -- body, as it would on the wire. type Bodies = Map.Map EndorserBlockHash (EndorserBlock, [Int]) +-- | 'storeForgedEb' writes the endorser block at the point of the given slot +-- and the hash of the body. After the writer closes, a reader sees that point +-- and the bytes of all its txs. +prop_storeForgedEbThenLookup :: DbImpl -> Property +prop_storeForgedEbThenLookup impl = + forAll genSlotNo $ \slot -> + forAll genDistinctTxBytes $ \txs -> + ioProperty $ withFreshDb impl $ \db -> do + let forged = forgeLeiosEb txs + body = forgedEbBody forged + ebHash = endorserBlockHash body + withWriter db $ \writer -> storeForgedEb writer slot forged + (points, closure) <- + withReader db $ \reader -> + (,) <$> testScanEbPoints reader <*> lookupEbClosure reader ebHash + pure $ + conjoin + [ counterexample "the point is not the slot and the hash of the body" $ + points === [(slot, ebHash)] + , counterexample "the stored txs are not the forged ones" $ + closure === Just (zip (map fst (endorserBlockReferences body)) (toList txs)) + ] + -- | Property: running the same operations against both implementations, a -- reader sees the same in each, and each write completes the same endorser -- blocks. From aa0698ac1f2cc617d25a209263632af0b5473159 Mon Sep 17 00:00:00 2001 From: Damian Nadales Date: Wed, 28 Oct 2026 16:52:34 -0300 Subject: [PATCH 13/13] fixup! Move storeForgedEb to the LeiosDB API --- .../Ouroboros/Consensus/NodeKernel.hs | 1 - 1 file changed, 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 7040399df8..484d4d67ec 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,7 +5,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} module Ouroboros.Consensus.NodeKernel ( -- * Node kernel