From 5cdc439166fb5a7f12ad4327891c203bac71f766 Mon Sep 17 00:00:00 2001 From: Alexander Esgen Date: Wed, 16 Jul 2025 13:55:18 +0200 Subject: [PATCH] =?UTF-8?q?Refactor:=20`SelectView`=20=3D=20`BlockNo`=20?= =?UTF-8?q?=C3=97=20`TiebreakerView`?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- ..._190309_alexander.esgen_tiebreaker_view.md | 5 + .../Ouroboros/Consensus/Byron/Ledger/PBFT.hs | 2 +- .../Consensus/Cardano/CanHardFork.hs | 9 +- .../Consensus/Shelley/Ledger/Block.hs | 7 +- .../Consensus/Shelley/Ledger/Protocol.hs | 15 ++- .../ThreadNet/Infra/ShelleyBasedHardFork.hs | 2 +- .../Consensus/Cardano/DiffusionPipelining.hs | 3 +- .../Test/Consensus/HardFork/Combinator.hs | 2 +- ..._190242_alexander.esgen_tiebreaker_view.md | 4 + .../Ouroboros/Consensus/Protocol/Praos.hs | 2 +- .../Consensus/Protocol/Praos/Common.hs | 68 +++++------- .../Ouroboros/Consensus/Protocol/TPraos.hs | 3 +- .../Consensus/Protocol/Praos/SelectView.hs | 33 +++--- ..._190237_alexander.esgen_tiebreaker_view.md | 11 ++ .../Consensus/Block/SupportsProtocol.hs | 25 +++-- .../Combinator/Abstract/CanHardFork.hs | 2 +- .../HardFork/Combinator/AcrossEras.hs | 12 +- .../Consensus/HardFork/Combinator/Protocol.hs | 42 +++---- .../HardFork/Combinator/Protocol/ChainSel.hs | 105 +++++++----------- .../Ouroboros/Consensus/Ledger/Dual.hs | 2 +- .../Ouroboros/Consensus/Protocol/Abstract.hs | 90 +++++++++++---- .../Consensus/Protocol/ModChainSel.hs | 30 ++--- .../Ouroboros/Consensus/Protocol/PBFT.hs | 43 ++++--- .../Ouroboros/Consensus/TypeFamilyWrappers.hs | 18 +-- .../Test/Ouroboros/Storage/TestBlock.hs | 26 ++--- .../Test/Util/TestBlock.hs | 2 +- .../Consensus/Mock/Ledger/Block/PBFT.hs | 2 +- .../Consensus/Mock/Protocol/LeaderSchedule.hs | 2 +- .../Ouroboros/Consensus/Tutorial/Simple.lhs | 32 +++--- .../Consensus/Tutorial/WithEpoch.lhs | 14 +-- 30 files changed, 323 insertions(+), 290 deletions(-) create mode 100644 ouroboros-consensus-cardano/changelog.d/20250716_190309_alexander.esgen_tiebreaker_view.md create mode 100644 ouroboros-consensus-protocol/changelog.d/20250716_190242_alexander.esgen_tiebreaker_view.md create mode 100644 ouroboros-consensus/changelog.d/20250716_190237_alexander.esgen_tiebreaker_view.md diff --git a/ouroboros-consensus-cardano/changelog.d/20250716_190309_alexander.esgen_tiebreaker_view.md b/ouroboros-consensus-cardano/changelog.d/20250716_190309_alexander.esgen_tiebreaker_view.md new file mode 100644 index 0000000000..34a455eb0a --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20250716_190309_alexander.esgen_tiebreaker_view.md @@ -0,0 +1,5 @@ +### Patch + +- Adapted to changes related to `SelectView`. + + Concretely, this changes the structure of `SelectView (BlockProtocol (CardanoBlock c))`, but it still contains the same data as before. diff --git a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/PBFT.hs b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/PBFT.hs index 6f7e618ef4..ee28705d09 100644 --- a/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/PBFT.hs +++ b/ouroboros-consensus-cardano/src/byron/Ouroboros/Consensus/Byron/Ledger/PBFT.hs @@ -74,7 +74,7 @@ instance BlockSupportsProtocol ByronBlock where where epochSlots = byronEpochSlots cfg - selectView _ = mkPBftSelectView + tiebreakerView _ = mkPBftTiebreakerView toPBftLedgerView :: Delegation.Map -> PBftLedgerView PBftByronCrypto toPBftLedgerView = PBftLedgerView . Delegation.unMap diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs index 2dc8d97b1e..3e3a32fe5b 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs @@ -83,6 +83,7 @@ import Ouroboros.Consensus.Protocol.PBFT.State (PBftState) import qualified Ouroboros.Consensus.Protocol.PBFT.State as PBftState import Ouroboros.Consensus.Protocol.Praos (Praos) import qualified Ouroboros.Consensus.Protocol.Praos as Praos +import Ouroboros.Consensus.Protocol.Praos.Common (PraosTiebreakerView) import Ouroboros.Consensus.Protocol.TPraos import qualified Ouroboros.Consensus.Protocol.TPraos as TPraos import Ouroboros.Consensus.Shelley.HFEras () @@ -171,10 +172,10 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where } hardForkChainSel = -- Byron <-> Shelley, ... - TCons (SOP.hpure CompareBlockNo) + TCons (SOP.hpure NoTiebreakerAcrossEras) -- Inter-Shelley-based $ - Tails.hcpure (Proxy @(HasPraosSelectView c)) CompareSameSelectView + Tails.hcpure (Proxy @(HasPraosTiebreakerView c)) SameTiebreakerAcrossEras hardForkInjectTxs = PCons (ignoringBoth $ Pair2 cannotInjectTx cannotInjectValidatedTx) $ PCons @@ -249,8 +250,8 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where fromConway x = fromDijkstra $ DijkstraMeasure x fromDijkstra x = x -class SelectView (BlockProtocol blk) ~ PraosChainSelectView c => HasPraosSelectView c blk -instance SelectView (BlockProtocol blk) ~ PraosChainSelectView c => HasPraosSelectView c blk +class TiebreakerView (BlockProtocol blk) ~ PraosTiebreakerView c => HasPraosTiebreakerView c blk +instance TiebreakerView (BlockProtocol blk) ~ PraosTiebreakerView c => HasPraosTiebreakerView c blk {------------------------------------------------------------------------------- Translation from Byron to Shelley diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs index cb0361db29..717a1d8b14 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Block.hs @@ -71,11 +71,8 @@ import Ouroboros.Consensus.HardFork.Combinator ) import Ouroboros.Consensus.HeaderValidation import Ouroboros.Consensus.Protocol.Abstract - ( ChainDepState - , SelectView - ) import Ouroboros.Consensus.Protocol.Praos.Common - ( PraosChainSelectView + ( PraosTiebreakerView ) import Ouroboros.Consensus.Protocol.Signed (SignedHeader) import Ouroboros.Consensus.Shelley.Eras @@ -119,7 +116,7 @@ class , Show (SL.TranslationContext era) , -- Currently the chain select view is identical -- Era and proto crypto must coincide - SelectView proto ~ PraosChainSelectView (ProtoCrypto proto) + TiebreakerView proto ~ PraosTiebreakerView (ProtoCrypto proto) , -- Need to be able to sign the protocol header SignedHeader (ShelleyProtocolHeader proto) , -- ChainDepState needs to be serialisable diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs index 65fd2f8e52..10c4302cc6 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Protocol.hs @@ -11,8 +11,8 @@ module Ouroboros.Consensus.Shelley.Ledger.Protocol () where import qualified Cardano.Ledger.Shelley.API as SL import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Protocol.Praos.Common import Ouroboros.Consensus.Protocol.Signed -import Ouroboros.Consensus.Protocol.TPraos import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Config (BlockConfig (..)) import Ouroboros.Consensus.Shelley.Protocol.Abstract @@ -30,13 +30,12 @@ import Ouroboros.Consensus.Shelley.Protocol.Abstract instance ShelleyCompatible proto era => BlockSupportsProtocol (ShelleyBlock proto era) where validateView _cfg = protocolHeaderView @proto . shelleyHeaderRaw - selectView _ hdr@(ShelleyHeader shdr _) = - PraosChainSelectView - { csvChainLength = blockNo hdr - , csvSlotNo = blockSlot hdr - , csvIssuer = hdrIssuer - , csvIssueNo = pHeaderIssueNo shdr - , csvTieBreakVRF = pTieBreakVRFValue shdr + tiebreakerView _ hdr@(ShelleyHeader shdr _) = + PraosTiebreakerView + { ptvSlotNo = blockSlot hdr + , ptvIssuer = hdrIssuer + , ptvIssueNo = pHeaderIssueNo shdr + , ptvTieBreakVRF = pTieBreakVRFValue shdr } where hdrIssuer :: SL.VKey 'SL.BlockIssuer diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs index 71802ae9f5..d6f769f096 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs @@ -271,7 +271,7 @@ instance , translateTxOutWith = SL.upgradeTxOut } - hardForkChainSel = Tails.mk2 CompareSameSelectView + hardForkChainSel = Tails.mk2 SameTiebreakerAcrossEras hardForkInjectTxs = InPairs.mk2 $ diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs index 458f3c2d0a..e00c38f9ae 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/DiffusionPipelining.hs @@ -22,6 +22,7 @@ import Ouroboros.Consensus.Byron.Ledger (ByronBlock) import Ouroboros.Consensus.Cardano (CardanoBlock) import Ouroboros.Consensus.HardFork.Combinator import Ouroboros.Consensus.HardFork.Combinator.AcrossEras +import Ouroboros.Consensus.Protocol.Abstract import Ouroboros.Consensus.Protocol.PBFT import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger @@ -79,7 +80,7 @@ instance GenTentativeHeaderViews ByronBlock where nubOrd . sort <$> listOf do bno <- arbitrary isEBB <- toIsEBB <$> arbitrary - pure $ PBftSelectView bno isEBB + pure $ SelectView bno (PBftTiebreakerView isEBB) instance ShelleyCompatible proto era => GenTentativeHeaderViews (ShelleyBlock proto era) where genTentativeHeaderViews _ = do 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 2f069bf576..549de0f352 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 @@ -441,7 +441,7 @@ instance CanHardFork '[BlockA, BlockB] where , translateChainDepState = PCons chainDepState_AtoB PNil , crossEraForecast = PCons forecast_AtoB PNil } - hardForkChainSel = Tails.mk2 CompareBlockNo + hardForkChainSel = Tails.mk2 NoTiebreakerAcrossEras hardForkInjectTxs = InPairs.mk2 injectTx_AtoB hardForkInjTxMeasure = \case diff --git a/ouroboros-consensus-protocol/changelog.d/20250716_190242_alexander.esgen_tiebreaker_view.md b/ouroboros-consensus-protocol/changelog.d/20250716_190242_alexander.esgen_tiebreaker_view.md new file mode 100644 index 0000000000..173979570e --- /dev/null +++ b/ouroboros-consensus-protocol/changelog.d/20250716_190242_alexander.esgen_tiebreaker_view.md @@ -0,0 +1,4 @@ +### Breaking + +- Removed `PraosChainSelectView`, use `SelectView (TPraos c)`/`SelectView (Praos + c)` instead. diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs index 28f56bdb26..96b896886f 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos.hs @@ -392,7 +392,7 @@ instance PraosCrypto c => ConsensusProtocol (Praos c) where type ChainDepState (Praos c) = PraosState type IsLeader (Praos c) = PraosIsLeader c type CanBeLeader (Praos c) = PraosCanBeLeader c - type SelectView (Praos c) = PraosChainSelectView c + type TiebreakerView (Praos c) = PraosTiebreakerView c type LedgerView (Praos c) = Views.LedgerView type ValidationErr (Praos c) = PraosValidationErr c type ValidateView (Praos c) = PraosValidateView c diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs index 0750600f6a..be09911058 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/Praos/Common.hs @@ -11,7 +11,7 @@ module Ouroboros.Consensus.Protocol.Praos.Common ( MaxMajorProtVer (..) , HasMaxMajorProtVer (..) , PraosCanBeLeader (..) - , PraosChainSelectView (..) + , PraosTiebreakerView (..) , VRFTiebreakerFlavor (..) -- * node support @@ -27,7 +27,6 @@ import Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer)) import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Protocol.Crypto (Crypto, VRF) import qualified Cardano.Protocol.TPraos.OCert as OCert -import Cardano.Slotting.Block (BlockNo) import Cardano.Slotting.Slot (SlotNo) import Data.Function (on) import Data.Map.Strict (Map) @@ -66,13 +65,13 @@ newtype MaxMajorProtVer = MaxMajorProtVer class HasMaxMajorProtVer proto where protoMaxMajorPV :: ConsensusConfig proto -> MaxMajorProtVer --- | View of the tip of a header fragment for chain selection. -data PraosChainSelectView c = PraosChainSelectView - { csvChainLength :: BlockNo - , csvSlotNo :: SlotNo - , csvIssuer :: SL.VKey 'SL.BlockIssuer - , csvIssueNo :: Word64 - , csvTieBreakVRF :: VRF.OutputVRF (VRF c) +-- | View of the tip of a header fragment for deciding between chains of equal +-- length. +data PraosTiebreakerView c = PraosTiebreakerView + { ptvSlotNo :: SlotNo + , ptvIssuer :: SL.VKey 'SL.BlockIssuer + , ptvIssueNo :: Word64 + , ptvTieBreakVRF :: VRF.OutputVRF (VRF c) } deriving (Show, Eq, Generic, NoThunks) @@ -107,13 +106,12 @@ data VRFTiebreakerFlavor -- Used to implement the 'Ord' and 'ChainOrder' instances for Praos. comparePraos :: VRFTiebreakerFlavor -> - PraosChainSelectView c -> - PraosChainSelectView c -> + PraosTiebreakerView c -> + PraosTiebreakerView c -> Ordering comparePraos tiebreakerFlavor = - (compare `on` csvChainLength) - <> when' issueNoArmed (compare `on` csvIssueNo) - <> when' vrfArmed (compare `on` Down . csvTieBreakVRF) + when' issueNoArmed (compare `on` ptvIssueNo) + <> when' vrfArmed (compare `on` Down . ptvTieBreakVRF) where -- When the predicate @p@ returns 'True', use the given comparison function, -- otherwise, no preference. @@ -127,14 +125,14 @@ comparePraos tiebreakerFlavor = -- Only compare the issue numbers when the issuers and slots are identical. -- Note that this case implies the VRFs also coincide. issueNoArmed v1 v2 = - csvSlotNo v1 == csvSlotNo v2 - && csvIssuer v1 == csvIssuer v2 + ptvSlotNo v1 == ptvSlotNo v2 + && ptvIssuer v1 == ptvIssuer v2 -- Whether to do a VRF comparison. vrfArmed v1 v2 = case tiebreakerFlavor of UnrestrictedVRFTiebreaker -> True RestrictedVRFTiebreaker maxDist -> - slotDist (csvSlotNo v1) (csvSlotNo v2) <= maxDist + slotDist (ptvSlotNo v1) (ptvSlotNo v2) <= maxDist slotDist :: SlotNo -> SlotNo -> SlotNo slotDist s t @@ -142,34 +140,30 @@ comparePraos tiebreakerFlavor = | s >= t = s - t | otherwise = t - s --- | We order between chains as follows: +-- | We order between chains of equal length as follows: -- --- 1. By chain length, with longer chains always preferred. --- --- 2. If the tip of each chain was issued by the same agent and they have the +-- 1. If the tip of each chain was issued by the same agent and they have the -- same slot number, prefer the chain whose tip has the highest ocert issue -- number. -- --- 3. By a VRF value from the chain tip, with lower values preferred. See +-- 2. By a VRF value from the chain tip, with lower values preferred. See -- @pTieBreakVRFValue@ for which one is used. -- -- IMPORTANT: This is not a complete picture of the Praos chain order, do also -- consult the documentation of 'ChainOrder'. -instance Crypto c => Ord (PraosChainSelectView c) where +instance Crypto c => Ord (PraosTiebreakerView c) where compare = comparePraos UnrestrictedVRFTiebreaker -- | IMPORTANT: This is not a 'SimpleChainOrder'; rather, there are --- 'PraosChainSelectView's @a, b@ such that @a < b@, but @'not' $ +-- 'PraosTiebreakerView's @a, b@ such that @a < b@, but @'not' $ -- 'preferCandidate' cfg a b@, namely for @cfg = 'RestrictedVRFTiebreaker'@. -- -- === Rules -- --- Concretely, we have @'preferCandidate' cfg ours cand@ based on the following --- lexicographical criteria: --- --- 1. Chain length, with longer chains always preferred. +-- Concretely, we have @'preferCandidate' cfg ours cand@ (where @ours@ and +-- @cand@ have equal length) based on the following lexicographical criteria: -- --- 2. If the tip of each chain was issued by the same agent and had the same +-- 1. If the tip of each chain was issued by the same agent and had the same -- slot number, then we prefer the candidate if it has a higher ocert issue -- number. -- @@ -177,7 +171,7 @@ instance Crypto c => Ord (PraosChainSelectView c) where -- the VRF is a deterministic function of the issuer VRF key, the slot and -- the epoch nonce, and VRFs are collision-resistant. -- --- 3. Depending on the 'VRFTiebreakerFlavor': +-- 2. Depending on the 'VRFTiebreakerFlavor': -- -- * If 'UnrestrictedVRFTiebreaker': Compare via a VRF value from the chain -- tip, with lower values preferred. See @pTieBreakVRFValue@ for which one @@ -190,8 +184,7 @@ instance Crypto c => Ord (PraosChainSelectView c) where -- -- When using @cfg = 'RestrictedVRFTiebreaker' maxDist@, the chain order is not -- transitive. As an example, suppose @maxDist = 5@ and consider three --- 'PraosChainSelectView's with the same chain length and pairwise different --- issuers and, as well as +-- 'PraosTiebreakerView's with pairwise different issuers and, as well as -- -- +------+---+---+---+ -- | | a | b | c | @@ -206,10 +199,7 @@ instance Crypto c => Ord (PraosChainSelectView c) where -- -- === Rationale for the rules -- --- 1. The abstract Consensus layer requires that we first compare based on chain --- length (see __Chain extension precedence__ in 'ChainOrder'). --- --- 2. Consider the scenario where the hot key of a block issuer was compromised, +-- 1. Consider the scenario where the hot key of a block issuer was compromised, -- and the attacker is now minting blocks using that identity. The actual -- block issuer can use their cold key to issue a new hot key with a higher -- opcert issue number and set up a new pool. Due to this tiebreaker rule, @@ -224,7 +214,7 @@ instance Crypto c => Ord (PraosChainSelectView c) where -- Specification for Delegation and Incentives in Cardano" by Kant et al for -- more context. -- --- 3. The main motivation to do VRF comparisons is to avoid the "Frankfurt +-- 2. The main motivation to do VRF comparisons is to avoid the "Frankfurt -- problem": -- -- With only the first two rules for the chain order, almost all blocks with @@ -244,8 +234,8 @@ instance Crypto c => Ord (PraosChainSelectView c) where -- -- See 'VRFTiebreakerFlavor' for more context on the exact conditions under -- which the VRF comparison takes place. -instance Crypto c => ChainOrder (PraosChainSelectView c) where - type ChainOrderConfig (PraosChainSelectView c) = VRFTiebreakerFlavor +instance Crypto c => ChainOrder (PraosTiebreakerView c) where + type ChainOrderConfig (PraosTiebreakerView c) = VRFTiebreakerFlavor preferCandidate cfg ours cand = comparePraos cfg ours cand == LT diff --git a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs index 01e02c9c22..103dcad8ec 100644 --- a/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs +++ b/ouroboros-consensus-protocol/src/ouroboros-consensus-protocol/Ouroboros/Consensus/Protocol/TPraos.hs @@ -16,7 +16,6 @@ -- schedule determining slots to be produced by BFT module Ouroboros.Consensus.Protocol.TPraos ( MaxMajorProtVer (..) - , PraosChainSelectView (..) , TPraos , TPraosFields (..) , TPraosIsLeader (..) @@ -308,7 +307,7 @@ instance SL.PraosCrypto c => ConsensusProtocol (TPraos c) where type ChainDepState (TPraos c) = TPraosState type IsLeader (TPraos c) = TPraosIsLeader c type CanBeLeader (TPraos c) = PraosCanBeLeader c - type SelectView (TPraos c) = PraosChainSelectView c + type TiebreakerView (TPraos c) = PraosTiebreakerView c type LedgerView (TPraos c) = SL.LedgerView type ValidationErr (TPraos c) = SL.ChainTransitionError c type ValidateView (TPraos c) = TPraosValidateView c diff --git a/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs index 9941246970..ca4e625e08 100644 --- a/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs +++ b/ouroboros-consensus-protocol/test/protocol-test/Test/Consensus/Protocol/Praos/SelectView.hs @@ -17,6 +17,8 @@ import Codec.Serialise (encode) import Control.Monad import Data.Containers.ListUtils (nubOrdOn) import Ouroboros.Consensus.Block +import Ouroboros.Consensus.Protocol.Abstract +import Ouroboros.Consensus.Protocol.Praos (Praos) import Ouroboros.Consensus.Protocol.Praos.Common import Test.Cardano.Ledger.Binary.Arbitrary () import Test.Ouroboros.Consensus.Protocol @@ -29,29 +31,32 @@ import Test.Util.TestEnv tests :: TestTree tests = testGroup - "PraosChainSelectView" + "Praos SelectView" [ adjustQuickCheckTests (* 50) -- Use a small max size by default in order to have a decent chance to -- trigger the actual tiebreaker cases. $ adjustQuickCheckMaxSize (`div` 10) $ - tests_chainOrder (Proxy @(PraosChainSelectView StandardCrypto)) + tests_chainOrder (Proxy @(SelectView (Praos StandardCrypto))) ] -instance Crypto c => Arbitrary (PraosChainSelectView c) where +instance Crypto c => Arbitrary (SelectView (Praos c)) where arbitrary = do size <- fromIntegral <$> getSize - csvChainLength <- BlockNo <$> choose (1, size) - csvSlotNo <- SlotNo <$> choose (1, size) - csvIssuer <- elements knownIssuers - csvIssueNo <- choose (1, 10) + svBlockNo <- BlockNo <$> choose (1, size) + ptvSlotNo <- SlotNo <$> choose (1, size) + ptvIssuer <- elements knownIssuers + ptvIssueNo <- choose (1, 10) pure - PraosChainSelectView - { csvChainLength - , csvSlotNo - , csvIssuer - , csvIssueNo - , csvTieBreakVRF = mkVRFFor csvIssuer csvSlotNo + SelectView + { svBlockNo = svBlockNo + , svTiebreakerView = + PraosTiebreakerView + { ptvSlotNo + , ptvIssuer + , ptvIssueNo + , ptvTieBreakVRF = mkVRFFor ptvIssuer ptvSlotNo + } } where -- We want to draw from the same small set of issuer identities in order to @@ -78,7 +83,7 @@ instance Crypto c => Arbitrary (PraosChainSelectView c) where where SL.KeyHash issuerHash = SL.hashKey issuer --- | 'ChainOrderConfig' 'PraosChainSelectView' +-- | @'ChainOrderConfig' ('SelectView' 'Praos')@ instance Arbitrary VRFTiebreakerFlavor where arbitrary = oneof diff --git a/ouroboros-consensus/changelog.d/20250716_190237_alexander.esgen_tiebreaker_view.md b/ouroboros-consensus/changelog.d/20250716_190237_alexander.esgen_tiebreaker_view.md new file mode 100644 index 0000000000..dd0c20c5e9 --- /dev/null +++ b/ouroboros-consensus/changelog.d/20250716_190237_alexander.esgen_tiebreaker_view.md @@ -0,0 +1,11 @@ +### Breaking + +- Changed `SelectView` to be a data type instead of an associated type of + `ConsensusProtocol`, which is the combination of a `BlockNo` and a + `TiebreakerView`, which is a new associated type of `ConsensusProtocol`. This + makes it explicit that `ouroboros-consensus` is targeting longest chain + protocols. + + - Removed `PBftSelectView`, use `SelectView PBft` instead. + + - Removed `HardForkSelectView`, use `SelectView (HardForkBlock xs)` instead. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs index 500befe99b..c73fa83952 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsProtocol.hs @@ -3,7 +3,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -module Ouroboros.Consensus.Block.SupportsProtocol (BlockSupportsProtocol (..)) where +module Ouroboros.Consensus.Block.SupportsProtocol (BlockSupportsProtocol (..), selectView) where import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block.Abstract @@ -30,17 +30,17 @@ class Header blk -> ValidateView (BlockProtocol blk) - selectView :: + tiebreakerView :: BlockConfig blk -> Header blk -> - SelectView (BlockProtocol blk) + TiebreakerView (BlockProtocol blk) -- Default chain selection just looks at longest chains - default selectView :: - SelectView (BlockProtocol blk) ~ BlockNo => + default tiebreakerView :: + TiebreakerView (BlockProtocol blk) ~ NoTiebreaker => BlockConfig blk -> Header blk -> - SelectView (BlockProtocol blk) - selectView _ = blockNo + TiebreakerView (BlockProtocol blk) + tiebreakerView _ _ = NoTiebreaker projectChainOrderConfig :: BlockConfig blk -> @@ -50,3 +50,14 @@ class BlockConfig blk -> ChainOrderConfig (SelectView (BlockProtocol blk)) projectChainOrderConfig _ = () + +selectView :: + BlockSupportsProtocol blk => + BlockConfig blk -> + Header blk -> + SelectView (BlockProtocol blk) +selectView bcfg hdr = + SelectView + { svBlockNo = blockNo hdr + , svTiebreakerView = tiebreakerView bcfg hdr + } diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs index 06d722e4fe..c947f4f7f3 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Abstract/CanHardFork.hs @@ -51,7 +51,7 @@ class type HardForkTxMeasure xs hardForkEraTranslation :: EraTranslation xs - hardForkChainSel :: Tails AcrossEraSelection xs + hardForkChainSel :: Tails AcrossEraTiebreaker xs hardForkInjectTxs :: InPairs ( RequiringBoth diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs index addc8cf061..281b90e796 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/AcrossEras.hs @@ -45,7 +45,7 @@ module Ouroboros.Consensus.HardFork.Combinator.AcrossEras , OneEraLedgerEvent (..) , OneEraLedgerUpdate (..) , OneEraLedgerWarning (..) - , OneEraSelectView (..) + , OneEraTiebreakerView (..) , OneEraTentativeHeaderState (..) , OneEraTentativeHeaderView (..) , OneEraTipInfo (..) @@ -134,7 +134,7 @@ newtype OneEraLedgerError xs = OneEraLedgerError {getOneEraLedgerError :: NS Wra newtype OneEraLedgerEvent xs = OneEraLedgerEvent {getOneEraLedgerEvent :: NS WrapLedgerEvent xs} newtype OneEraLedgerUpdate xs = OneEraLedgerUpdate {getOneEraLedgerUpdate :: NS WrapLedgerUpdate xs} newtype OneEraLedgerWarning xs = OneEraLedgerWarning {getOneEraLedgerWarning :: NS WrapLedgerWarning xs} -newtype OneEraSelectView xs = OneEraSelectView {getOneEraSelectView :: NS WrapSelectView xs} +newtype OneEraTiebreakerView xs = OneEraTiebreakerView {getOneEraTiebreakerView :: NS WrapTiebreakerView xs} newtype OneEraTentativeHeaderState xs = OneEraTentativeHeaderState {getOneEraTentativeHeaderState :: NS WrapTentativeHeaderState xs} newtype OneEraTentativeHeaderView xs = OneEraTentativeHeaderView {getOneEraTentativeHeaderView :: NS WrapTentativeHeaderView xs} newtype OneEraTipInfo xs = OneEraTipInfo {getOneEraTipInfo :: NS WrapTipInfo xs} @@ -333,9 +333,9 @@ deriving via CanHardFork xs => NoThunks (OneEraLedgerError xs) deriving via - LiftNamedNS "OneEraSelectView" WrapSelectView xs + LiftNamedNS "OneEraTiebreakerView" WrapTiebreakerView xs instance - CanHardFork xs => NoThunks (OneEraSelectView xs) + CanHardFork xs => NoThunks (OneEraTiebreakerView xs) deriving via LiftNamedNS "OneEraTentativeHeaderState" WrapTentativeHeaderState xs @@ -372,7 +372,7 @@ deriving via LiftNS GenTx xs instance CanHardFork xs => Eq (OneEraGenTx xs) deriving via LiftNS WrapLedgerErr xs instance CanHardFork xs => Eq (OneEraLedgerError xs) deriving via LiftNS WrapLedgerUpdate xs instance CanHardFork xs => Eq (OneEraLedgerUpdate xs) deriving via LiftNS WrapLedgerWarning xs instance CanHardFork xs => Eq (OneEraLedgerWarning xs) -deriving via LiftNS WrapSelectView xs instance CanHardFork xs => Eq (OneEraSelectView xs) +deriving via LiftNS WrapTiebreakerView xs instance CanHardFork xs => Eq (OneEraTiebreakerView xs) deriving via LiftNS WrapTipInfo xs instance CanHardFork xs => Eq (OneEraTipInfo xs) deriving via LiftNS WrapValidatedGenTx xs instance CanHardFork xs => Eq (OneEraValidatedGenTx xs) deriving via LiftNS WrapValidationErr xs instance CanHardFork xs => Eq (OneEraValidationErr xs) @@ -447,4 +447,4 @@ deriving via LiftNS WrapCannotForge xs instance CanHardFork xs => Show (OneEraCa deriving via LiftNS GenTx xs instance CanHardFork xs => Show (OneEraGenTx xs) deriving via LiftNS WrapGenTxId xs instance CanHardFork xs => Show (OneEraGenTxId xs) deriving via LiftNS Header xs instance CanHardFork xs => Show (OneEraHeader xs) -deriving via LiftNS WrapSelectView xs instance CanHardFork xs => Show (OneEraSelectView xs) +deriving via LiftNS WrapTiebreakerView xs instance CanHardFork xs => Show (OneEraTiebreakerView xs) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs index 1d86fc910b..6a6160a11a 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol.hs @@ -14,7 +14,7 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Ouroboros.Consensus.HardFork.Combinator.Protocol - ( HardForkSelectView (..) + ( HardForkTiebreakerView (..) -- * Re-exports to keep 'Protocol.State' an internal module , HardForkCanBeLeader @@ -69,41 +69,34 @@ import Ouroboros.Consensus.Util ((.:)) ChainSelection -------------------------------------------------------------------------------} -newtype HardForkSelectView xs = HardForkSelectView - { getHardForkSelectView :: WithBlockNo OneEraSelectView xs +newtype HardForkTiebreakerView xs = HardForkTiebreakerView + { getHardForkTiebreakerView :: OneEraTiebreakerView xs } deriving (Show, Eq) deriving newtype NoThunks -instance CanHardFork xs => Ord (HardForkSelectView xs) where - compare (HardForkSelectView l) (HardForkSelectView r) = +instance CanHardFork xs => Ord (HardForkTiebreakerView xs) where + compare (HardForkTiebreakerView l) (HardForkTiebreakerView r) = acrossEraSelection AcrossEraCompare (hpure Proxy) hardForkChainSel - (mapWithBlockNo getOneEraSelectView l) - (mapWithBlockNo getOneEraSelectView r) + (getOneEraTiebreakerView l) + (getOneEraTiebreakerView r) -instance CanHardFork xs => ChainOrder (HardForkSelectView xs) where - type ChainOrderConfig (HardForkSelectView xs) = PerEraChainOrderConfig xs +instance CanHardFork xs => ChainOrder (HardForkTiebreakerView xs) where + type ChainOrderConfig (HardForkTiebreakerView xs) = PerEraChainOrderConfig xs preferCandidate (PerEraChainOrderConfig cfg) - (HardForkSelectView ours) - (HardForkSelectView cand) = + (HardForkTiebreakerView ours) + (HardForkTiebreakerView cand) = acrossEraSelection AcrossEraPreferCandidate cfg hardForkChainSel - (mapWithBlockNo getOneEraSelectView ours) - (mapWithBlockNo getOneEraSelectView cand) - -mkHardForkSelectView :: - BlockNo -> - NS WrapSelectView xs -> - HardForkSelectView xs -mkHardForkSelectView bno view = - HardForkSelectView $ WithBlockNo bno (OneEraSelectView view) + (getOneEraTiebreakerView ours) + (getOneEraTiebreakerView cand) {------------------------------------------------------------------------------- ConsensusProtocol @@ -114,7 +107,7 @@ type HardForkChainDepState xs = HardForkState WrapChainDepState xs instance CanHardFork xs => ConsensusProtocol (HardForkProtocol xs) where type ChainDepState (HardForkProtocol xs) = HardForkChainDepState xs type ValidationErr (HardForkProtocol xs) = HardForkValidationErr xs - type SelectView (HardForkProtocol xs) = HardForkSelectView xs + type TiebreakerView (HardForkProtocol xs) = HardForkTiebreakerView xs type LedgerView (HardForkProtocol xs) = HardForkLedgerView xs type CanBeLeader (HardForkProtocol xs) = HardForkCanBeLeader xs type IsLeader (HardForkProtocol xs) = HardForkIsLeader xs @@ -147,9 +140,10 @@ instance CanHardFork xs => BlockSupportsProtocol (HardForkBlock xs) where where cfgs = getPerEraBlockConfig hardForkBlockConfigPerEra - selectView HardForkBlockConfig{..} hdr = - mkHardForkSelectView (blockNo hdr) - . hczipWith proxySingle (WrapSelectView .: selectView) cfgs + tiebreakerView HardForkBlockConfig{..} hdr = + HardForkTiebreakerView + . OneEraTiebreakerView + . hczipWith proxySingle (WrapTiebreakerView .: tiebreakerView) cfgs . getOneEraHeader $ getHardForkHeader hdr where diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs index bf126e4fb1..1d47b0d8f7 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/HardFork/Combinator/Protocol/ChainSel.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -11,18 +9,14 @@ -- | Infrastructure for doing chain selection across eras module Ouroboros.Consensus.HardFork.Combinator.Protocol.ChainSel ( AcrossEraMode (..) - , AcrossEraSelection (..) - , WithBlockNo (..) + , AcrossEraTiebreaker (..) , acrossEraSelection - , mapWithBlockNo ) where import Data.Kind (Type) import Data.SOP.Constraint import Data.SOP.Strict import Data.SOP.Tails (Tails (..)) -import GHC.Generics (Generic) -import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block import Ouroboros.Consensus.HardFork.Combinator.Abstract.SingleEraBlock import Ouroboros.Consensus.Protocol.Abstract @@ -32,23 +26,20 @@ import Ouroboros.Consensus.TypeFamilyWrappers Configuration -------------------------------------------------------------------------------} -data AcrossEraSelection :: Type -> Type -> Type where - -- | Just compare block numbers +-- | How to compare chains of equal length across eras. +data AcrossEraTiebreaker :: Type -> Type -> Type where + -- | No preference. + NoTiebreakerAcrossEras :: AcrossEraTiebreaker x y + -- | Two eras using the same 'TiebreakerView', so use the corresponding + -- (identical) tiebreaker. -- - -- This is a useful default when two eras run totally different consensus - -- protocols, and we just want to choose the longer chain. - CompareBlockNo :: AcrossEraSelection x y - -- | Two eras using the same 'SelectView'. In this case, we can just compare - -- chains even across eras, as the chain ordering is fully captured by - -- 'SelectView' and its 'ChainOrder' instance. - -- - -- We use the 'ChainOrderConfig' of the 'SelectView' in the newer era (with - -- the intuition that newer eras are generally "preferred") when invoking - -- 'compareChains'. However, this choice is arbitrary; we could also make it - -- configurable here. - CompareSameSelectView :: - SelectView (BlockProtocol x) ~ SelectView (BlockProtocol y) => - AcrossEraSelection x y + -- We use the 'ChainOrderConfig' of the 'TiebreakerView' in the newer era + -- (with the intuition that newer eras are generally "preferred") when + -- invoking 'compareChains'. However, this choice is arbitrary; we could also + -- make it configurable here. + SameTiebreakerAcrossEras :: + TiebreakerView (BlockProtocol x) ~ TiebreakerView (BlockProtocol y) => + AcrossEraTiebreaker x y {------------------------------------------------------------------------------- Compare two eras @@ -62,12 +53,12 @@ data AcrossEraMode cfg a where AcrossEraPreferCandidate :: AcrossEraMode WrapChainOrderConfig Bool applyAcrossEraMode :: - ChainOrder sv => + ChainOrder tv => cfg blk -> - (WrapChainOrderConfig blk -> ChainOrderConfig sv) -> + (WrapChainOrderConfig blk -> ChainOrderConfig tv) -> AcrossEraMode cfg a -> - sv -> - sv -> + tv -> + tv -> a applyAcrossEraMode cfg f = \case AcrossEraCompare -> compare @@ -81,24 +72,24 @@ acrossEras :: FlipArgs -> AcrossEraMode cfg a -> -- | The configuration corresponding to the later block/era, also see - -- 'CompareSameSelectView'. + -- 'SameTiebreakerAcrossEras'. cfg blk' -> - WithBlockNo WrapSelectView blk -> - WithBlockNo WrapSelectView blk' -> - AcrossEraSelection blk blk' -> + WrapTiebreakerView blk -> + WrapTiebreakerView blk' -> + AcrossEraTiebreaker blk blk' -> a acrossEras flipArgs mode cfg - (WithBlockNo bnoL (WrapSelectView l)) - (WithBlockNo bnoR (WrapSelectView r)) = \case - CompareBlockNo -> maybeFlip cmp bnoL bnoR + (WrapTiebreakerView l) + (WrapTiebreakerView r) = \case + NoTiebreakerAcrossEras -> maybeFlip cmp NoTiebreaker NoTiebreaker where cmp = applyAcrossEraMode cfg (const ()) mode - CompareSameSelectView -> maybeFlip cmp l r + SameTiebreakerAcrossEras -> maybeFlip cmp l r where - cmp = applyAcrossEraMode cfg (unwrapChainOrderConfig) mode + cmp = applyAcrossEraMode cfg unwrapChainOrderConfig mode where maybeFlip :: (b -> b -> a) -> b -> b -> a maybeFlip = case flipArgs of @@ -110,24 +101,24 @@ acrossEraSelection :: All SingleEraBlock xs => AcrossEraMode cfg a -> NP cfg xs -> - Tails AcrossEraSelection xs -> - WithBlockNo (NS WrapSelectView) xs -> - WithBlockNo (NS WrapSelectView) xs -> + Tails AcrossEraTiebreaker xs -> + NS WrapTiebreakerView xs -> + NS WrapTiebreakerView xs -> a acrossEraSelection mode = \cfg ffs l r -> - goBoth cfg ffs (distribBlockNo l, distribBlockNo r) + goBoth cfg ffs (l, r) where goBoth :: All SingleEraBlock xs' => NP cfg xs' -> - Tails AcrossEraSelection xs' -> - ( NS (WithBlockNo WrapSelectView) xs' - , NS (WithBlockNo WrapSelectView) xs' + Tails AcrossEraTiebreaker xs' -> + ( NS WrapTiebreakerView xs' + , NS WrapTiebreakerView xs' ) -> a goBoth _ TNil = \(a, _) -> case a of {} goBoth (cfg :* cfgs) (TCons fs ffs') = \case - (Z a, Z b) -> cmp (dropBlockNo a) (dropBlockNo b) + (Z a, Z b) -> cmp a b where cmp = applyAcrossEraMode cfg unwrapChainOrderConfig mode (Z a, S b) -> goOne KeepArgs a cfgs fs b @@ -138,10 +129,10 @@ acrossEraSelection mode = \cfg ffs l r -> forall x xs'. (SingleEraBlock x, All SingleEraBlock xs') => FlipArgs -> - WithBlockNo WrapSelectView x -> + WrapTiebreakerView x -> NP cfg xs' -> - NP (AcrossEraSelection x) xs' -> - NS (WithBlockNo WrapSelectView) xs' -> + NP (AcrossEraTiebreaker x) xs' -> + NS WrapTiebreakerView xs' -> a goOne flipArgs a = go where @@ -149,25 +140,9 @@ acrossEraSelection mode = \cfg ffs l r -> forall xs''. All SingleEraBlock xs'' => NP cfg xs'' -> - NP (AcrossEraSelection x) xs'' -> - NS (WithBlockNo WrapSelectView) xs'' -> + NP (AcrossEraTiebreaker x) xs'' -> + NS WrapTiebreakerView xs'' -> a go _ Nil b = case b of {} go (cfg :* _) (f :* _) (Z b) = acrossEras flipArgs mode cfg a b f go (_ :* cfgs) (_ :* fs) (S b) = go cfgs fs b - -{------------------------------------------------------------------------------- - WithBlockNo --------------------------------------------------------------------------------} - -data WithBlockNo (f :: k -> Type) (a :: k) = WithBlockNo - { getBlockNo :: BlockNo - , dropBlockNo :: f a - } - deriving (Show, Eq, Generic, NoThunks) - -mapWithBlockNo :: (f x -> g y) -> WithBlockNo f x -> WithBlockNo g y -mapWithBlockNo f (WithBlockNo bno fx) = WithBlockNo bno (f fx) - -distribBlockNo :: SListI xs => WithBlockNo (NS f) xs -> NS (WithBlockNo f) xs -distribBlockNo (WithBlockNo b ns) = hmap (WithBlockNo b) ns diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs index 09d27ae447..9ae75c141a 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs @@ -312,7 +312,7 @@ type instance BlockProtocol (DualBlock m a) = BlockProtocol m instance Bridge m a => BlockSupportsProtocol (DualBlock m a) where validateView cfg = validateView (dualBlockConfigMain cfg) . dualHeaderMain - selectView cfg = selectView (dualBlockConfigMain cfg) . dualHeaderMain + tiebreakerView cfg = tiebreakerView (dualBlockConfigMain cfg) . dualHeaderMain projectChainOrderConfig = projectChainOrderConfig . dualBlockConfigMain diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs index 9e2f55b70c..52d5600807 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/Abstract.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -14,8 +16,10 @@ module Ouroboros.Consensus.Protocol.Abstract , ConsensusProtocol (..) -- * Chain order + , SelectView (..) , ChainOrder (..) , SimpleChainOrder (..) + , NoTiebreaker (..) -- * Translation , TranslateProto (..) @@ -25,9 +29,11 @@ module Ouroboros.Consensus.Protocol.Abstract ) where import Control.Monad.Except +import Data.Function (on) import Data.Kind (Type) import Data.Proxy (Proxy) import Data.Typeable (Typeable) +import GHC.Generics (Generic) import GHC.Stack import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Block.Abstract @@ -52,15 +58,15 @@ data family ConsensusConfig p :: Type class ( Show (ChainDepState p) , Show (ValidationErr p) - , Show (SelectView p) + , Show (TiebreakerView p) , Show (LedgerView p) , Eq (ChainDepState p) , Eq (ValidationErr p) - , ChainOrder (SelectView p) + , ChainOrder (TiebreakerView p) , NoThunks (ConsensusConfig p) , NoThunks (ChainDepState p) , NoThunks (ValidationErr p) - , NoThunks (SelectView p) + , NoThunks (TiebreakerView p) , Typeable p -- so that p can appear in exceptions ) => ConsensusProtocol p @@ -77,19 +83,19 @@ class -- | Evidence that we /can/ be a leader type CanBeLeader p :: Type - -- | View on a header required for chain selection + -- | View on a header required for tiebreaking between chains of equal length. -- -- Chain selection is implemented by the chain database, which takes care of -- two things independent of a choice of consensus protocol: we never switch -- to chains that fork off more than @k@ blocks ago, and we never adopt an - -- invalid chain. The actual comparison of chains however depends on the chain - -- selection protocol. We define chain selection in terms of a /select view/ - -- on the headers at the tips of those chains: chain A is strictly preferred - -- over chain B whenever A's select view is preferred over B's select view - -- according to the 'ChainOrder' instance. - type SelectView p :: Type + -- invalid chain. We always prefer longer chains to shorter chains. The + -- comparison of chains A and B of equal length however depends on the chain + -- selection protocol: chain A is strictly preferred over chain B whenever A's + -- tiebreaker view is preferred over B's tiebreaker view according to the + -- 'ChainOrder' instance. + type TiebreakerView p :: Type - type SelectView p = BlockNo + type TiebreakerView p = NoTiebreaker -- | Projection of the ledger state the Ouroboros protocol needs access to -- @@ -205,7 +211,9 @@ instance TranslateProto singleProto singleProto where translateChainDepState _ = id -- | The chain order of some type; in the Consensus layer, this will always be --- the 'SelectView' of some 'ConsensusProtocol'. +-- the 'SelectView'/'TiebreakerView' of some 'ConsensusProtocol'. Namely, the +-- 'ChainOrder' instance of 'SelectView' primarily compares block numbers, but +-- refers to the 'ChainOrder' instance of 'TiebreakerView' in case of a tie. -- -- See 'preferCandidate' for the primary documentation. -- @@ -243,15 +251,6 @@ class Ord sv => ChainOrder sv where -- -- However, forgoing 'SimpleChainOrder' can enable more sophisticated -- tiebreaking rules that eg exhibit desirable incentive behavior. - -- - -- [__Chain extension precedence__]: @a@ must contain the underlying block - -- number, and use this as the primary way of comparing chains. - -- - -- Suppose that we have a function @blockNo :: sv -> Natural@. Then for - -- all @a, b@ with @blockNo a < blockNo b@ we must have @a ⊏ b@. - -- - -- Intuitively, this means that only the logic for breaking ties between - -- chains with equal block number is customizable via this class. preferCandidate :: ChainOrderConfig sv -> -- | Tip of our chain @@ -270,4 +269,51 @@ instance Ord sv => ChainOrder (SimpleChainOrder sv) where preferCandidate _cfg ours cand = ours < cand -deriving via SimpleChainOrder BlockNo instance ChainOrder BlockNo +-- | Use no tiebreaker to decide between chains of equal length, cf +-- 'TiebreakerView' and 'ChainOrder'. +data NoTiebreaker = NoTiebreaker + deriving stock (Show, Eq, Ord, Generic) + deriving anyclass NoThunks + deriving ChainOrder via SimpleChainOrder NoTiebreaker + +{------------------------------------------------------------------------------- + Helpers +-------------------------------------------------------------------------------} + +-- | Information from the tip of a chain required to compare it to other chains +-- using its 'Ord' and 'ChainOrder' instance. +-- +-- As the abstract Consensus layer targets longest chain protocols, the primary +-- measure for comparing chains is the block number. However, in case of chains +-- of equal length, we use the 'TiebreakerView' which is customizable by the +-- particular @'ConsensusProtocol' p@. +data SelectView p = SelectView + { svBlockNo :: !BlockNo + , svTiebreakerView :: !(TiebreakerView p) + } + deriving stock Generic + +deriving stock instance Show (TiebreakerView p) => Show (SelectView p) +deriving stock instance Eq (TiebreakerView p) => Eq (SelectView p) + +instance NoThunks (TiebreakerView p) => NoThunks (SelectView p) + +-- | First compare block numbers, then compare the 'TiebreakerView'. +instance Ord (TiebreakerView p) => Ord (SelectView p) where + compare = + mconcat + [ compare `on` svBlockNo + , compare `on` svTiebreakerView + ] + +-- | @cand@ is preferred to @ours@ if either @cand@ is longer than @ours@, or +-- @cand@ and @ours@ are of equal length and we have +-- +-- > preferCandidate cfg ourTiebreaker candTiebreaker +instance ChainOrder (TiebreakerView p) => ChainOrder (SelectView p) where + type ChainOrderConfig (SelectView p) = ChainOrderConfig (TiebreakerView p) + + preferCandidate cfg ours cand = case compare (svBlockNo ours) (svBlockNo cand) of + LT -> True + EQ -> preferCandidate cfg (svTiebreakerView ours) (svTiebreakerView cand) + GT -> False diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs index 4f37fd4069..07e0dc3964 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/ModChainSel.hs @@ -14,30 +14,30 @@ import GHC.Generics (Generic) import NoThunks.Class (NoThunks) import Ouroboros.Consensus.Protocol.Abstract -data ModChainSel p s +data ModChainSel p t -newtype instance ConsensusConfig (ModChainSel p s) = McsConsensusConfig +newtype instance ConsensusConfig (ModChainSel p t) = McsConsensusConfig { mcsConfigP :: ConsensusConfig p } deriving Generic instance ( ConsensusProtocol p - , ChainOrder s - , Show s - , Typeable s - , NoThunks s + , ChainOrder t + , Show t + , Typeable t + , NoThunks t ) => - ConsensusProtocol (ModChainSel p s) + ConsensusProtocol (ModChainSel p t) where - type SelectView (ModChainSel p s) = s + type TiebreakerView (ModChainSel p t) = t - type ChainDepState (ModChainSel p s) = ChainDepState p - type IsLeader (ModChainSel p s) = IsLeader p - type CanBeLeader (ModChainSel p s) = CanBeLeader p - type LedgerView (ModChainSel p s) = LedgerView p - type ValidationErr (ModChainSel p s) = ValidationErr p - type ValidateView (ModChainSel p s) = ValidateView p + type ChainDepState (ModChainSel p t) = ChainDepState p + type IsLeader (ModChainSel p t) = IsLeader p + type CanBeLeader (ModChainSel p t) = CanBeLeader p + type LedgerView (ModChainSel p t) = LedgerView p + type ValidationErr (ModChainSel p t) = ValidationErr p + type ValidateView (ModChainSel p t) = ValidateView p checkIsLeader = checkIsLeader . mcsConfigP tickChainDepState = tickChainDepState . mcsConfigP @@ -45,4 +45,4 @@ instance reupdateChainDepState = reupdateChainDepState . mcsConfigP protocolSecurityParam = protocolSecurityParam . mcsConfigP -instance ConsensusProtocol p => NoThunks (ConsensusConfig (ModChainSel p s)) +instance ConsensusProtocol p => NoThunks (ConsensusConfig (ModChainSel p t)) diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs index 29f33a7a37..e8297223b3 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Protocol/PBFT.hs @@ -26,9 +26,9 @@ module Ouroboros.Consensus.Protocol.PBFT , PBftIsLeader (..) , PBftLedgerView (..) , PBftParams (..) - , PBftSelectView (..) + , PBftTiebreakerView (..) , PBftSignatureThreshold (..) - , mkPBftSelectView + , mkPBftTiebreakerView , pbftWindowExceedsThreshold , pbftWindowSize @@ -138,38 +138,33 @@ pbftValidateRegular contextDSIGN getFields hdr = pbftValidateBoundary :: hdr -> PBftValidateView c pbftValidateBoundary _hdr = PBftValidateBoundary --- | Part of the header required for chain selection +-- | Part of the header required for chain selection between chains with an +-- equal block number at their tip. -- -- EBBs share a block number with regular blocks, and so for chain selection -- we need to know if a block is an EBB or not (because a chain ending on an -- EBB with a particular block number is longer than a chain on a regular -- block with that same block number). -data PBftSelectView = PBftSelectView - { pbftSelectViewBlockNo :: BlockNo - , pbftSelectViewIsEBB :: IsEBB +newtype PBftTiebreakerView = PBftTiebreakerView + { pbftTiebreakerViewIsEBB :: IsEBB } deriving stock (Show, Eq, Generic) deriving anyclass NoThunks - deriving ChainOrder via SimpleChainOrder PBftSelectView + deriving ChainOrder via SimpleChainOrder PBftTiebreakerView -mkPBftSelectView :: GetHeader blk => Header blk -> PBftSelectView -mkPBftSelectView hdr = - PBftSelectView - { pbftSelectViewBlockNo = blockNo hdr - , pbftSelectViewIsEBB = headerToIsEBB hdr +mkPBftTiebreakerView :: GetHeader blk => Header blk -> PBftTiebreakerView +mkPBftTiebreakerView hdr = + PBftTiebreakerView + { pbftTiebreakerViewIsEBB = headerToIsEBB hdr } -instance Ord PBftSelectView where - compare (PBftSelectView lBlockNo lIsEBB) (PBftSelectView rBlockNo rIsEBB) = - mconcat - [ -- Prefer the highest block number, as it is a proxy for chain length - lBlockNo `compare` rBlockNo - , -- If the block numbers are the same, check if one of them is an EBB. - -- An EBB has the same block number as the block before it, so the - -- chain ending with an EBB is actually longer than the one ending - -- with a regular block. - score lIsEBB `compare` score rIsEBB - ] +instance Ord PBftTiebreakerView where + compare (PBftTiebreakerView lIsEBB) (PBftTiebreakerView rIsEBB) = + -- If the block numbers are the same, check if one of them is an EBB. + -- An EBB has the same block number as the block before it, so the + -- chain ending with an EBB is actually longer than the one ending + -- with a regular block. + score lIsEBB `compare` score rIsEBB where score :: IsEBB -> Int score IsEBB = 1 @@ -297,7 +292,7 @@ data instance Ticked (PBftState c) = TickedPBftState instance PBftCrypto c => ConsensusProtocol (PBft c) where type ValidationErr (PBft c) = PBftValidationErr c type ValidateView (PBft c) = PBftValidateView c - type SelectView (PBft c) = PBftSelectView + type TiebreakerView (PBft c) = PBftTiebreakerView -- \| We require two things from the ledger state: -- diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs index d3713f0d24..afeda4e651 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/TypeFamilyWrappers.hs @@ -34,7 +34,7 @@ module Ouroboros.Consensus.TypeFamilyWrappers , WrapConsensusConfig (..) , WrapIsLeader (..) , WrapLedgerView (..) - , WrapSelectView (..) + , WrapTiebreakerView (..) , WrapValidateView (..) , WrapValidationErr (..) @@ -98,11 +98,12 @@ newtype WrapTxOut blk = WrapTxOut {unwrapTxOut :: TxOut (LedgerState blk)} newtype WrapCanBeLeader blk = WrapCanBeLeader {unwrapCanBeLeader :: CanBeLeader (BlockProtocol blk)} newtype WrapChainDepState blk = WrapChainDepState {unwrapChainDepState :: ChainDepState (BlockProtocol blk)} -newtype WrapChainOrderConfig blk = WrapChainOrderConfig {unwrapChainOrderConfig :: ChainOrderConfig (SelectView (BlockProtocol blk))} +newtype WrapChainOrderConfig blk = WrapChainOrderConfig + {unwrapChainOrderConfig :: ChainOrderConfig (TiebreakerView (BlockProtocol blk))} newtype WrapConsensusConfig blk = WrapConsensusConfig {unwrapConsensusConfig :: ConsensusConfig (BlockProtocol blk)} newtype WrapIsLeader blk = WrapIsLeader {unwrapIsLeader :: IsLeader (BlockProtocol blk)} newtype WrapLedgerView blk = WrapLedgerView {unwrapLedgerView :: LedgerView (BlockProtocol blk)} -newtype WrapSelectView blk = WrapSelectView {unwrapSelectView :: SelectView (BlockProtocol blk)} +newtype WrapTiebreakerView blk = WrapTiebreakerView {unwrapTiebreakerView :: TiebreakerView (BlockProtocol blk)} newtype WrapValidateView blk = WrapValidateView {unwrapValidateView :: ValidateView (BlockProtocol blk)} newtype WrapValidationErr blk = WrapValidationErr {unwrapValidationErr :: ValidationErr (BlockProtocol blk)} @@ -173,20 +174,21 @@ deriving instance NoThunks (TxOut (LedgerState blk)) => NoThunks (WrapTxOut blk) -------------------------------------------------------------------------------} deriving instance Eq (ChainDepState (BlockProtocol blk)) => Eq (WrapChainDepState blk) -deriving instance Eq (SelectView (BlockProtocol blk)) => Eq (WrapSelectView blk) +deriving instance Eq (TiebreakerView (BlockProtocol blk)) => Eq (WrapTiebreakerView blk) deriving instance Eq (ValidationErr (BlockProtocol blk)) => Eq (WrapValidationErr blk) -deriving instance Ord (SelectView (BlockProtocol blk)) => Ord (WrapSelectView blk) +deriving instance Ord (TiebreakerView (BlockProtocol blk)) => Ord (WrapTiebreakerView blk) -deriving instance ChainOrder (SelectView (BlockProtocol blk)) => ChainOrder (WrapSelectView blk) +deriving instance + ChainOrder (TiebreakerView (BlockProtocol blk)) => ChainOrder (WrapTiebreakerView blk) deriving instance Show (ChainDepState (BlockProtocol blk)) => Show (WrapChainDepState blk) deriving instance Show (LedgerView (BlockProtocol blk)) => Show (WrapLedgerView blk) -deriving instance Show (SelectView (BlockProtocol blk)) => Show (WrapSelectView blk) +deriving instance Show (TiebreakerView (BlockProtocol blk)) => Show (WrapTiebreakerView blk) deriving instance Show (ValidationErr (BlockProtocol blk)) => Show (WrapValidationErr blk) deriving instance NoThunks (ChainDepState (BlockProtocol blk)) => NoThunks (WrapChainDepState blk) -deriving instance NoThunks (SelectView (BlockProtocol blk)) => NoThunks (WrapSelectView blk) +deriving instance NoThunks (TiebreakerView (BlockProtocol blk)) => NoThunks (WrapTiebreakerView blk) deriving instance NoThunks (ValidationErr (BlockProtocol blk)) => NoThunks (WrapValidationErr blk) {------------------------------------------------------------------------------- diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Storage/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Storage/TestBlock.hs index d2306238d6..08ef2fa6f9 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Storage/TestBlock.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Ouroboros/Storage/TestBlock.hs @@ -474,24 +474,21 @@ mkNextEBB canContainEBB tb = Test infrastructure: protocol -------------------------------------------------------------------------------} -data BftWithEBBsSelectView = BftWithEBBsSelectView - { bebbBlockNo :: !BlockNo - , bebbIsEBB :: !IsEBB +data BftWithEBBsTiebreakerView = BftWithEBBsTiebreakerView + { bebbIsEBB :: !IsEBB , bebbChainLength :: !ChainLength , bebbHash :: !TestHeaderHash } deriving stock (Show, Eq, Generic) deriving anyclass NoThunks - deriving ChainOrder via SimpleChainOrder BftWithEBBsSelectView + deriving ChainOrder via SimpleChainOrder BftWithEBBsTiebreakerView -instance Ord BftWithEBBsSelectView where +instance Ord BftWithEBBsTiebreakerView where compare - (BftWithEBBsSelectView lBlockNo lIsEBB lChainLength lHash) - (BftWithEBBsSelectView rBlockNo rIsEBB rChainLength rHash) = + (BftWithEBBsTiebreakerView lIsEBB lChainLength lHash) + (BftWithEBBsTiebreakerView rIsEBB rChainLength rHash) = mconcat - [ -- Prefer the highest block number, as it is a proxy for chain length - lBlockNo `compare` rBlockNo - , -- If the block numbers are the same, check if one of them is an EBB. + [ -- If the block numbers are the same, check if one of them is an EBB. -- An EBB has the same block number as the block before it, so the -- chain ending with an EBB is actually longer than the one ending -- with a regular block. @@ -511,7 +508,7 @@ instance Ord BftWithEBBsSelectView where type instance BlockProtocol TestBlock = - ModChainSel (Bft BftMockCrypto) BftWithEBBsSelectView + ModChainSel (Bft BftMockCrypto) BftWithEBBsTiebreakerView {------------------------------------------------------------------------------- Test infrastructure: ledger state @@ -538,10 +535,9 @@ instance BlockSupportsProtocol TestBlock where signKey :: SlotNo -> SignKeyDSIGN MockDSIGN signKey (SlotNo n) = SignKeyMockDSIGN $ n `mod` numCore - selectView _ hdr = - BftWithEBBsSelectView - { bebbBlockNo = blockNo hdr - , bebbIsEBB = headerToIsEBB hdr + tiebreakerView _ hdr = + BftWithEBBsTiebreakerView + { bebbIsEBB = headerToIsEBB hdr , bebbChainLength = thChainLength (unTestHeader hdr) , bebbHash = blockHash hdr } diff --git a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs index f9c6a26ba2..f1f397011b 100644 --- a/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs +++ b/ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/TestBlock.hs @@ -865,7 +865,7 @@ treePreferredChain = . selectUnvalidatedChain (Proxy @(BlockProtocol TestBlock)) (() :: ChainOrderConfig (SelectView (BlockProtocol TestBlock))) - blockNo + (\hdr -> SelectView (blockNo hdr) NoTiebreaker) Genesis . treeToChains diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs index d2fc3d7bbe..c2062873e4 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Ledger/Block/PBFT.hs @@ -117,7 +117,7 @@ instance BlockSupportsProtocol (SimplePBftBlock c PBftMockCrypto) where validateView _ = pbftValidateRegular () (simplePBftExt . simpleHeaderExt) - selectView _ = mkPBftSelectView + tiebreakerView _ = mkPBftTiebreakerView -- | The ledger view is constant for the mock instantiation of PBFT -- (mock blocks cannot change delegation) diff --git a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/LeaderSchedule.hs b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/LeaderSchedule.hs index efc2adb590..06de6da25b 100644 --- a/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/LeaderSchedule.hs +++ b/ouroboros-consensus/src/unstable-mock-block/Ouroboros/Consensus/Mock/Protocol/LeaderSchedule.hs @@ -36,7 +36,7 @@ data instance ConsensusConfig (WithLeaderSchedule p) = WLSConfig deriving Generic instance ConsensusProtocol p => ConsensusProtocol (WithLeaderSchedule p) where - type SelectView (WithLeaderSchedule p) = SelectView p + type TiebreakerView (WithLeaderSchedule p) = TiebreakerView p type ChainDepState (WithLeaderSchedule p) = () type LedgerView (WithLeaderSchedule p) = () diff --git a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs index 1feb3e6f0c..90b0373230 100644 --- a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs +++ b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/Simple.lhs @@ -46,15 +46,15 @@ First, some imports we'll need: > import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed (..)) > import Cardano.Ledger.BaseTypes (knownNonZeroBounded) > import Ouroboros.Consensus.Block.Abstract -> (blockNo, blockPoint, castHeaderFields, castPoint, BlockNo, SlotNo, +> (blockPoint, castHeaderFields, castPoint, BlockNo, SlotNo, > BlockConfig, BlockProtocol, CodecConfig, GetHeader(..), GetPrevHash(..), > Header, StorageConfig, ChainHash, HasHeader(..), HeaderFields(..), > HeaderHash, Point, StandardHash) > import Ouroboros.Consensus.Protocol.Abstract -> (SecurityParam(..), ConsensusConfig, ConsensusProtocol(..) ) +> (SecurityParam(..), ConsensusConfig, ConsensusProtocol(..), NoTiebreaker(..)) > import Ouroboros.Consensus.Ticked ( Ticked, Ticked(TickedTrivial) ) > import Ouroboros.Consensus.Block -> (BlockSupportsProtocol (selectView, validateView)) +> (BlockSupportsProtocol (tiebreakerView, validateView)) > import Ouroboros.Consensus.Ledger.Abstract > (GetTip(..), IsLedger(..), LedgerCfg, > LedgerResult(LedgerResult, lrEvents, lrResult), @@ -135,7 +135,7 @@ simple one here: Next, we instantiate the `ConsensusProtocol` for `SP`: > instance ConsensusProtocol SP where -> type SelectView SP = BlockNo +> type TiebreakerView SP = NoTiebreaker > type LedgerView SP = () @@ -169,14 +169,16 @@ Finally we define a few extra things used in this instantiation: Let's examine each of these in turn: -Chain Selection: `SelectView` ------------------------------ +Chain Selection: `TiebreakerView` +--------------------------------- One of the major decisions when implementing a consensus protocol is encoding a -policy for chain selection. The `SelectView SP` type represents the information -necessary from a block header to help make this decision. +policy for chain selection. `ouroboros-consensus` targets *longest chain* +protocols, i.e. longer chains are preferred to shorter chains. The +`TiebreakerView SP` type represents the information necessary from a block +header to make this decision between chains of *equal* length. -The other half of this - which explains how a `SelectView` is derived from a +The other half of this - which explains how a `TiebreakerView` is derived from a particular block - is expressed by the block's implementation of the `BlockSupportsProtocol` typeclass. @@ -184,11 +186,11 @@ The `preferCandidate` function in `Ouroboros.Consensus.Protocol.Abstract` demonstrates how this is used. Note that instantiations of `ConsensusProtocol` for some protocol `p` -consequently requires `ChainOrder (SelectView p)` (which in particular requires -`Ord (SelectView p)`. +consequently requires `ChainOrder (TiebreakerView p)` (which in particular +requires `Ord (TiebreakerView p)`. -For `SP` we will use only `BlockNo` - to implement the simplest rule of -preferring longer chains to shorter chains. +For `SP` we will use only `NoTiebreaker` - the simple rule of sticking with our +current selection if we receive another chain of the same length. Ledger Integration: `LedgerView` @@ -197,7 +199,7 @@ Ledger Integration: `LedgerView` Some decisions that a consensus protocol needs to make will depend on the ledger's state, `LedgerState blk`. The data required from the ledger is of type `LedgerView p` (i.e., the protocol determines what is needed). Similar to -`SelectView` the projection of `LedgerState blk` into `LedgerView p` exists in +`TiebreakerView` the projection of `LedgerState blk` into `LedgerView p` exists in a typeclass, namely `LedgerSupportsProtocol`. For `SP` we do not require any information from the ledger to make decisions of @@ -477,7 +479,7 @@ block, again established by our prior instantiation of `BlockProtocol`: > instance BlockSupportsProtocol BlockC where > validateView _ _ = () -> selectView _bcfg hdr = blockNo hdr +> tiebreakerView _bcfg _hdr = NoTiebreaker Given that `ValidateView SP` is of type `()` there is only one possible implementation for this typeclass. Later examples will require more interesting diff --git a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/WithEpoch.lhs b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/WithEpoch.lhs index 53f564f435..8858db7116 100644 --- a/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/WithEpoch.lhs +++ b/ouroboros-consensus/src/unstable-tutorials/Ouroboros/Consensus/Tutorial/WithEpoch.lhs @@ -67,13 +67,13 @@ And imports, of course: > import Ouroboros.Consensus.Block.Abstract > (Header, SlotNo (..), HeaderHash, ChainHash, GetHeader (..), > GetPrevHash (..), HasHeader (..), HeaderFields (..), StandardHash, -> BlockProtocol, castHeaderFields, blockNo, BlockConfig, CodecConfig, +> BlockProtocol, castHeaderFields, BlockConfig, CodecConfig, > StorageConfig, Point, castPoint, WithOrigin (..), EpochNo (EpochNo), > pointSlot, blockPoint, BlockNo (..)) > import Ouroboros.Consensus.Block.SupportsProtocol > (BlockSupportsProtocol (..)) > import Ouroboros.Consensus.Protocol.Abstract -> (ConsensusConfig, SecurityParam, ConsensusProtocol (..)) +> (ConsensusConfig, SecurityParam, ConsensusProtocol (..), NoTiebreaker (..)) > import Ouroboros.Consensus.Ticked (Ticked, Ticked) > import Ouroboros.Consensus.Ledger.Abstract @@ -523,9 +523,9 @@ functions defined above: > type IsLeader PrtclD = PrtclD_IsLeader > type CanBeLeader PrtclD = PrtclD_CanBeLeader -> -- | View on a block header required for chain selection. Here, BlockNo is -> -- sufficient. (BlockNo is also the default type for this type family.) -> type SelectView PrtclD = BlockNo +> -- | View on a block header required for tiebreaking. Here, NoTiebreaker +> -- is sufficient, which is also the default type for this type family. +> type TiebreakerView PrtclD = NoTiebreaker > -- | View on the ledger required by the protocol > type LedgerView PrtclD = LedgerViewD @@ -570,12 +570,12 @@ Block/Protocol Integration Our implementation of `BlockSupportsProtocol BlockD` supports our definition of `ConsensusProtocol PrtclD` closely, with `validateView` extracting the `NodeId` -from the block header, and `selectView` projecting out the block number: +from the block header, and `tiebreakerView` returning 'NoTiebreaker': > instance BlockSupportsProtocol BlockD where > validateView _bcfg hdr = hbd_nodeId hdr -> selectView _bcfg hdr = blockNo hdr +> tiebreakerView _bcfg _hdr = NoTiebreaker All that remains is to establish `PrtclD` as the protocol for `BlockD`: