{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Various things common to iterations of the Praos protocol.
module Ouroboros.Consensus.Protocol.Praos.Common (
    MaxMajorProtVer (..)
  , PraosCanBeLeader (..)
  , PraosChainSelectView (..)
  , VRFTiebreakerFlavor (..)
    -- * node support
  , PraosNonces (..)
  , PraosProtocolSupportsNode (..)
  ) where

import qualified Cardano.Crypto.VRF as VRF
import           Cardano.Ledger.BaseTypes (Nonce)
import qualified Cardano.Ledger.BaseTypes as SL
import           Cardano.Ledger.Crypto (Crypto, VRF)
import           Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer))
import qualified Cardano.Ledger.Shelley.API as SL
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)
import           Data.Ord (Down (Down))
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Protocol.Abstract

-- | The maximum major protocol version.
--
-- This refers to the largest __ledger__ version that this node supports.
--
-- Once the ledger protocol version (as reported by the ledger state)
-- exceeds this version we will consider all blocks invalid. This is
-- called the "obsolete node check" (see the 'ObsoleteNode' error
-- constructor).
--
-- Major ledger protocol versions are used to trigger both intra and
-- inter era hard forks, which can potentially change the set of
-- ledger rules that are applied.
--
-- Minor ledger protocol versions were intended to signal soft forks
-- but they're currently unused, and they're irrelevant for the
-- consensus logic.
--
-- For Cardano mainnet, the Shelley era has major protocol version
-- __2__.  For more details, see [this
-- table](https://github.com/cardano-foundation/CIPs/blob/master/CIP-0059/feature-table.md)
newtype MaxMajorProtVer = MaxMajorProtVer
  { MaxMajorProtVer -> Version
getMaxMajorProtVer :: SL.Version
  }
  deriving (MaxMajorProtVer -> MaxMajorProtVer -> Bool
(MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> (MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> Eq MaxMajorProtVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
$c/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
Eq, Int -> MaxMajorProtVer -> ShowS
[MaxMajorProtVer] -> ShowS
MaxMajorProtVer -> String
(Int -> MaxMajorProtVer -> ShowS)
-> (MaxMajorProtVer -> String)
-> ([MaxMajorProtVer] -> ShowS)
-> Show MaxMajorProtVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxMajorProtVer -> ShowS
showsPrec :: Int -> MaxMajorProtVer -> ShowS
$cshow :: MaxMajorProtVer -> String
show :: MaxMajorProtVer -> String
$cshowList :: [MaxMajorProtVer] -> ShowS
showList :: [MaxMajorProtVer] -> ShowS
Show, (forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x)
-> (forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer)
-> Generic MaxMajorProtVer
forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
from :: forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
$cto :: forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
to :: forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
Generic)
  deriving newtype Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
Proxy MaxMajorProtVer -> String
(Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Proxy MaxMajorProtVer -> String)
-> NoThunks MaxMajorProtVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy MaxMajorProtVer -> String
showTypeOf :: Proxy MaxMajorProtVer -> String
NoThunks

-- | View of the tip of a header fragment for chain selection.
data PraosChainSelectView c = PraosChainSelectView
  { forall c. PraosChainSelectView c -> BlockNo
csvChainLength :: BlockNo,
    forall c. PraosChainSelectView c -> SlotNo
csvSlotNo      :: SlotNo,
    forall c. PraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer      :: SL.VKey 'SL.BlockIssuer c,
    forall c. PraosChainSelectView c -> Word64
csvIssueNo     :: Word64,
    forall c. PraosChainSelectView c -> OutputVRF (VRF c)
csvTieBreakVRF :: VRF.OutputVRF (VRF c)
  }
  deriving (Int -> PraosChainSelectView c -> ShowS
[PraosChainSelectView c] -> ShowS
PraosChainSelectView c -> String
(Int -> PraosChainSelectView c -> ShowS)
-> (PraosChainSelectView c -> String)
-> ([PraosChainSelectView c] -> ShowS)
-> Show (PraosChainSelectView c)
forall c. Crypto c => Int -> PraosChainSelectView c -> ShowS
forall c. Crypto c => [PraosChainSelectView c] -> ShowS
forall c. Crypto c => PraosChainSelectView c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Crypto c => Int -> PraosChainSelectView c -> ShowS
showsPrec :: Int -> PraosChainSelectView c -> ShowS
$cshow :: forall c. Crypto c => PraosChainSelectView c -> String
show :: PraosChainSelectView c -> String
$cshowList :: forall c. Crypto c => [PraosChainSelectView c] -> ShowS
showList :: [PraosChainSelectView c] -> ShowS
Show, PraosChainSelectView c -> PraosChainSelectView c -> Bool
(PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> Eq (PraosChainSelectView c)
forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
== :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
$c/= :: forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
/= :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
Eq, (forall x.
 PraosChainSelectView c -> Rep (PraosChainSelectView c) x)
-> (forall x.
    Rep (PraosChainSelectView c) x -> PraosChainSelectView c)
-> Generic (PraosChainSelectView c)
forall x. Rep (PraosChainSelectView c) x -> PraosChainSelectView c
forall x. PraosChainSelectView c -> Rep (PraosChainSelectView c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (PraosChainSelectView c) x -> PraosChainSelectView c
forall c x.
PraosChainSelectView c -> Rep (PraosChainSelectView c) x
$cfrom :: forall c x.
PraosChainSelectView c -> Rep (PraosChainSelectView c) x
from :: forall x. PraosChainSelectView c -> Rep (PraosChainSelectView c) x
$cto :: forall c x.
Rep (PraosChainSelectView c) x -> PraosChainSelectView c
to :: forall x. Rep (PraosChainSelectView c) x -> PraosChainSelectView c
Generic, Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
Proxy (PraosChainSelectView c) -> String
(Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo))
-> (Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo))
-> (Proxy (PraosChainSelectView c) -> String)
-> NoThunks (PraosChainSelectView c)
forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
forall c. Crypto c => Proxy (PraosChainSelectView c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
noThunks :: Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c.
Crypto c =>
Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PraosChainSelectView c -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c. Crypto c => Proxy (PraosChainSelectView c) -> String
showTypeOf :: Proxy (PraosChainSelectView c) -> String
NoThunks)

-- | When to compare the VRF tiebreakers.
data VRFTiebreakerFlavor =
    -- | Always compare the VRF tiebreakers. This is the behavior of all eras
    -- before Conway. Once mainnet has transitioned to Conway, we can remove
    -- this option. (The honest /historical/ Ouroboros chain cannot rely on
    -- tiebreakers to win, so /retroactively/ disabling the tiebreaker won't
    -- matter.)
    UnrestrictedVRFTiebreaker
  | -- | Only compare the VRF tiebreakers when the slot numbers differ by at
    -- most the given number of slots.
    --
    -- The main motivation is as follows:
    --
    -- When two blocks A and B with the same block number differ in their slot
    -- number by more than Δ (the maximum message delay from Praos), say
    -- @slot(A) + Δ < slot(B)@, the issuer of B should have been able to mint a
    -- block with a block number higher than A (eg by minting on top of A) under
    -- normal circumstances. The reason for this not being the case might have
    -- been due to A being sent very late, or due to the issuer of B ignoring A
    -- (intentionally, or due to poor configuration/resource provision). In any
    -- case, we do not want to allow the block that was diffused later to still
    -- win by having a better VRF tiebreaker. This makes it less likely for
    -- properly configured pools to lose blocks because of poorly configured
    -- pools.
    RestrictedVRFTiebreaker SlotNo
  deriving stock (Int -> VRFTiebreakerFlavor -> ShowS
[VRFTiebreakerFlavor] -> ShowS
VRFTiebreakerFlavor -> String
(Int -> VRFTiebreakerFlavor -> ShowS)
-> (VRFTiebreakerFlavor -> String)
-> ([VRFTiebreakerFlavor] -> ShowS)
-> Show VRFTiebreakerFlavor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VRFTiebreakerFlavor -> ShowS
showsPrec :: Int -> VRFTiebreakerFlavor -> ShowS
$cshow :: VRFTiebreakerFlavor -> String
show :: VRFTiebreakerFlavor -> String
$cshowList :: [VRFTiebreakerFlavor] -> ShowS
showList :: [VRFTiebreakerFlavor] -> ShowS
Show, VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool
(VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool)
-> (VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool)
-> Eq VRFTiebreakerFlavor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool
== :: VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool
$c/= :: VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool
/= :: VRFTiebreakerFlavor -> VRFTiebreakerFlavor -> Bool
Eq, (forall x. VRFTiebreakerFlavor -> Rep VRFTiebreakerFlavor x)
-> (forall x. Rep VRFTiebreakerFlavor x -> VRFTiebreakerFlavor)
-> Generic VRFTiebreakerFlavor
forall x. Rep VRFTiebreakerFlavor x -> VRFTiebreakerFlavor
forall x. VRFTiebreakerFlavor -> Rep VRFTiebreakerFlavor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VRFTiebreakerFlavor -> Rep VRFTiebreakerFlavor x
from :: forall x. VRFTiebreakerFlavor -> Rep VRFTiebreakerFlavor x
$cto :: forall x. Rep VRFTiebreakerFlavor x -> VRFTiebreakerFlavor
to :: forall x. Rep VRFTiebreakerFlavor x -> VRFTiebreakerFlavor
Generic)
  deriving anyclass (Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo)
Proxy VRFTiebreakerFlavor -> String
(Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo))
-> (Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo))
-> (Proxy VRFTiebreakerFlavor -> String)
-> NoThunks VRFTiebreakerFlavor
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo)
noThunks :: Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VRFTiebreakerFlavor -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy VRFTiebreakerFlavor -> String
showTypeOf :: Proxy VRFTiebreakerFlavor -> String
NoThunks)

-- Used to implement the 'Ord' and 'ChainOrder' instances for Praos.
comparePraos ::
     Crypto c
  => VRFTiebreakerFlavor
  -> PraosChainSelectView c
  -> PraosChainSelectView c
  -> Ordering
comparePraos :: forall c.
Crypto c =>
VRFTiebreakerFlavor
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
comparePraos VRFTiebreakerFlavor
tiebreakerFlavor =
       (BlockNo -> BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockNo -> BlockNo -> Ordering)
-> (PraosChainSelectView c -> BlockNo)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PraosChainSelectView c -> BlockNo
forall c. PraosChainSelectView c -> BlockNo
csvChainLength)
    (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall a.
(a -> a -> Bool) -> (a -> a -> Ordering) -> a -> a -> Ordering
when' PraosChainSelectView c -> PraosChainSelectView c -> Bool
forall c.
Crypto c =>
PraosChainSelectView c -> PraosChainSelectView c -> Bool
issueNoArmed (Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word64 -> Word64 -> Ordering)
-> (PraosChainSelectView c -> Word64)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PraosChainSelectView c -> Word64
forall c. PraosChainSelectView c -> Word64
csvIssueNo)
    (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (PraosChainSelectView c -> PraosChainSelectView c -> Bool)
-> (PraosChainSelectView c -> PraosChainSelectView c -> Ordering)
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall a.
(a -> a -> Bool) -> (a -> a -> Ordering) -> a -> a -> Ordering
when' PraosChainSelectView c -> PraosChainSelectView c -> Bool
vrfArmed (Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering)
-> (PraosChainSelectView c -> Down (OutputVRF (VRF c)))
-> PraosChainSelectView c
-> PraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OutputVRF (VRF c) -> Down (OutputVRF (VRF c))
forall a. a -> Down a
Down (OutputVRF (VRF c) -> Down (OutputVRF (VRF c)))
-> (PraosChainSelectView c -> OutputVRF (VRF c))
-> PraosChainSelectView c
-> Down (OutputVRF (VRF c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PraosChainSelectView c -> OutputVRF (VRF c)
forall c. PraosChainSelectView c -> OutputVRF (VRF c)
csvTieBreakVRF)
  where
    -- When the predicate @p@ returns 'True', use the given comparison function,
    -- otherwise, no preference.
    when' ::
         (a -> a -> Bool)
      -> (a -> a -> Ordering)
      -> (a -> a -> Ordering)
    when' :: forall a.
(a -> a -> Bool) -> (a -> a -> Ordering) -> a -> a -> Ordering
when' a -> a -> Bool
p a -> a -> Ordering
comp a
a1 a
a2 =
        if a -> a -> Bool
p a
a1 a
a2 then a -> a -> Ordering
comp a
a1 a
a2 else Ordering
EQ

    -- Only compare the issue numbers when the issuers and slots are identical.
    -- Note that this case implies the VRFs also coincide.
    issueNoArmed :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
issueNoArmed PraosChainSelectView c
v1 PraosChainSelectView c
v2 =
           PraosChainSelectView c -> SlotNo
forall c. PraosChainSelectView c -> SlotNo
csvSlotNo PraosChainSelectView c
v1 SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== PraosChainSelectView c -> SlotNo
forall c. PraosChainSelectView c -> SlotNo
csvSlotNo PraosChainSelectView c
v2
        Bool -> Bool -> Bool
&& PraosChainSelectView c -> VKey 'BlockIssuer c
forall c. PraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer PraosChainSelectView c
v1 VKey 'BlockIssuer c -> VKey 'BlockIssuer c -> Bool
forall a. Eq a => a -> a -> Bool
== PraosChainSelectView c -> VKey 'BlockIssuer c
forall c. PraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer PraosChainSelectView c
v2

    -- Whether to do a VRF comparison.
    vrfArmed :: PraosChainSelectView c -> PraosChainSelectView c -> Bool
vrfArmed PraosChainSelectView c
v1 PraosChainSelectView c
v2 = case VRFTiebreakerFlavor
tiebreakerFlavor of
        VRFTiebreakerFlavor
UnrestrictedVRFTiebreaker       -> Bool
True
        RestrictedVRFTiebreaker SlotNo
maxDist ->
          SlotNo -> SlotNo -> SlotNo
slotDist (PraosChainSelectView c -> SlotNo
forall c. PraosChainSelectView c -> SlotNo
csvSlotNo PraosChainSelectView c
v1) (PraosChainSelectView c -> SlotNo
forall c. PraosChainSelectView c -> SlotNo
csvSlotNo PraosChainSelectView c
v2) SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
<= SlotNo
maxDist

    slotDist :: SlotNo -> SlotNo -> SlotNo
    slotDist :: SlotNo -> SlotNo -> SlotNo
slotDist SlotNo
s SlotNo
t
      -- slot numbers are unsigned, so have to take care with subtraction
      | SlotNo
s SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
t    = SlotNo
s SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
t
      | Bool
otherwise = SlotNo
t SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
- SlotNo
s

-- | We order between chains 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
--    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
--    @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
  compare :: PraosChainSelectView c -> PraosChainSelectView c -> Ordering
compare = VRFTiebreakerFlavor
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
forall c.
Crypto c =>
VRFTiebreakerFlavor
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
comparePraos VRFTiebreakerFlavor
UnrestrictedVRFTiebreaker

-- | IMPORTANT: This is not a 'SimpleChainOrder'; rather, there are
-- 'PraosChainSelectView'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.
--
-- 2. 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':
--
--     * If 'UnrestrictedVRFTiebreaker': Compare via a VRF value from the chain
--       tip, with lower values preferred. See @pTieBreakVRFValue@ for which one
--       is used.
--
--     * If @'RestrictedVRFTiebreaker' maxDist@: Only do the VRF comparison (as
--       in the previous step) if the slot numbers differ by at most @maxDist@.
--
-- === Non-transitivity of 'RestrictedVRFTiebreaker'
--
-- 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
--
-- +------+---+---+---+
-- |      | a | b | c |
-- +======+===+===+===+
-- | Slot | 0 | 3 | 6 |
-- +------+---+---+---+
-- | VRF  | 3 | 2 | 1 |
-- +------+---+---+---+
--
-- Then we have @'preferCandidate' cfg a b@ and @'preferCandidate' b c@, but
-- __not__ @'preferCandidate' a c@ (despite @a < c@).
--
-- === 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,
--    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,
--    the blocks minted by that pool will take precedence (allowing the actual
--    block issuer to decide on eg the block contents and the predecessor) over
--    blocks with the same block and slot number minted by the attacker, and
--    they will end up on the honest chain quickly, which means that the
--    adversary can't extend any chain containing such a block as it would
--    violate the monotonicity requirement on opcert issue numbers.
--
--     See "3.7 Block Validity and Operational Key Certificates" in "Design
--     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
--    problem":
--
--     With only the first two rules for the chain order, almost all blocks with
--     equal block number are equally preferrable. Consider two block issuers
--     minting blocks in very nearby slots. As we never change our selection
--     from one chain to an equally preferrable one, the first block to arrive
--     at another pool is the one to be adopted, and will be extended the next
--     time the pool is elected if no blocks with a higher block number arrive
--     in the meantime. We observed that this effectively incentivizes block
--     producers to concentrate geographically (historically, in Frankfurt) in
--     order to minimize their diffusion times. This works against the goal of
--     geographic decentralisation.
--
--     Also, with the VRF tiebreaker, a block with a somewhat lower propagation
--     speed has a random chance to be selected instead of the one that arrived
--     first by pools before the next block is forged.
--
--     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

  preferCandidate :: ChainOrderConfig (PraosChainSelectView c)
-> PraosChainSelectView c -> PraosChainSelectView c -> Bool
preferCandidate ChainOrderConfig (PraosChainSelectView c)
cfg PraosChainSelectView c
ours PraosChainSelectView c
cand = VRFTiebreakerFlavor
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
forall c.
Crypto c =>
VRFTiebreakerFlavor
-> PraosChainSelectView c -> PraosChainSelectView c -> Ordering
comparePraos ChainOrderConfig (PraosChainSelectView c)
VRFTiebreakerFlavor
cfg PraosChainSelectView c
ours PraosChainSelectView c
cand Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT

data PraosCanBeLeader c = PraosCanBeLeader
  { -- | Certificate delegating rights from the stake pool cold key (or
    -- genesis stakeholder delegate cold key) to the online KES key.
    forall c. PraosCanBeLeader c -> OCert c
praosCanBeLeaderOpCert     :: !(OCert.OCert c),
    -- | Stake pool cold key or genesis stakeholder delegate cold key.
    forall c. PraosCanBeLeader c -> VKey 'BlockIssuer c
praosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer c),
    forall c. PraosCanBeLeader c -> SignKeyVRF c
praosCanBeLeaderSignKeyVRF :: !(SL.SignKeyVRF c)
  }
  deriving ((forall x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x)
-> (forall x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c)
-> Generic (PraosCanBeLeader c)
forall x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
forall x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
forall c x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
$cfrom :: forall c x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
from :: forall x. PraosCanBeLeader c -> Rep (PraosCanBeLeader c) x
$cto :: forall c x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
to :: forall x. Rep (PraosCanBeLeader c) x -> PraosCanBeLeader c
Generic)

instance Crypto c => NoThunks (PraosCanBeLeader c)

-- | See 'PraosProtocolSupportsNode'
data PraosNonces = PraosNonces {
    PraosNonces -> Nonce
candidateNonce   :: !Nonce
  , PraosNonces -> Nonce
epochNonce       :: !Nonce
  , PraosNonces -> Nonce
evolvingNonce    :: !Nonce
    -- | Nonce constructed from the hash of the Last Applied Block
  , PraosNonces -> Nonce
labNonce         :: !Nonce
    -- | Nonce corresponding to the LAB nonce of the last block of the previous
    -- epoch
  , PraosNonces -> Nonce
previousLabNonce :: !Nonce
  }

-- | The node has Praos-aware code that inspects nonces in order to support
-- some Cardano API queries that are crucial to the user exprience
--
-- The interface being used for that has grown and needs review, but we're
-- adding to it here under time pressure. See
-- <https://github.com/IntersectMBO/cardano-node/issues/3864>
class ConsensusProtocol p => PraosProtocolSupportsNode p where
  type PraosProtocolSupportsNodeCrypto p

  getPraosNonces :: proxy p -> ChainDepState p -> PraosNonces

  getOpCertCounters :: proxy p -> ChainDepState p -> Map (KeyHash 'BlockIssuer (PraosProtocolSupportsNodeCrypto p)) Word64