Refactor: SelectView = BlockNo × TiebreakerView

Author: amesgen

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

ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs

@@ -82,6 +82,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 ()
@@ -164,10 +165,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
@@ -233,8 +234,8 @@ instance CardanoHardForkConstraints c => CanHardFork (CardanoEras c) where
     fromAlonzo x = fromConway $ ConwayMeasure x mempty
     fromConway 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

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

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

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 $

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

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

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

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,57 +125,53 @@ 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
     -- slot numbers are unsigned, so have to take care with subtraction
     | 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.
 --
 --     Note that this condition is equivalent to the VRFs being identical, as
 --     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
 

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