{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Protocol.Abstract
  ( -- * Abstract definition of the Ouroboros protocol
    ConsensusConfig
  , ConsensusProtocol (..)

    -- * Chain order
  , SelectView (..)
  , ChainOrder (..)
  , SimpleChainOrder (..)
  , NoTiebreaker (..)

    -- * Translation
  , TranslateProto (..)

    -- * Convenience re-exports
  , SecurityParam (..)
  ) 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
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ticked

-- | Static configuration required to run the consensus protocol
--
-- Every method in the 'ConsensusProtocol' class takes the consensus
-- configuration as a parameter, so having this as a data family rather than a
-- type family resolves most ambiguity.
--
-- Defined out of the class so that protocols can define this type without
-- having to define the entire protocol at the same time (or indeed in the same
-- module).
data family ConsensusConfig p :: Type

-- | The (open) universe of Ouroboros protocols
--
-- This class encodes the part that is independent from any particular
-- block representation.
class
  ( Show (ChainDepState p)
  , Show (ValidationErr p)
  , Show (TiebreakerView p)
  , Show (LedgerView p)
  , Eq (ChainDepState p)
  , Eq (ValidationErr p)
  , ChainOrder (TiebreakerView p)
  , NoThunks (ConsensusConfig p)
  , NoThunks (ChainDepState p)
  , NoThunks (ValidationErr p)
  , NoThunks (TiebreakerView p)
  , Typeable p -- so that p can appear in exceptions
  ) =>
  ConsensusProtocol p
  where
  -- | Protocol-specific state
  --
  -- NOTE: This chain is blockchain dependent, i.e., updated when new blocks
  -- come in (more precisely, new /headers/), and subject to rollback.
  type ChainDepState p :: Type

  -- | Evidence that a node /is/ the leader
  type IsLeader p :: Type

  -- | Evidence that we /can/ be a leader
  type CanBeLeader p :: Type

  -- | 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. 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 TiebreakerView p = NoTiebreaker

  -- | Projection of the ledger state the Ouroboros protocol needs access to
  --
  -- The 'LedgerView' is a summary of the state of the ledger that the consensus
  -- algorithm requires to do its job. Under certain circumstances the consensus
  -- algorithm may require the 'LedgerView' for slots in the past (before the
  -- current tip of the chain) or in the (near) future (beyond the tip of the
  -- current chain, without having seen those future blocks yet).
  --
  -- This puts limitations on what the 'LedgerView' can be. For example, it
  -- cannot be the "current stake distribution", since it is of course
  -- impossible to compute the current stake distibution for a slot in the
  -- future. This means that for a consensus algorithm that requires the
  -- stake distribution such as Praos, the 'LedgerView' for a particular slot
  -- must be the "stake distribution for the purpose of leader selection".
  -- This "relevant" stake distribution /can/ be computed for slots in the
  -- (near) future because it is based on historical stake, not current.
  --
  -- A somewhat unfortunate consequence of this is that some decisions that
  -- ought to live in the consensus layer (such as the decision precisely which
  -- historical stake to sample to determine the relevant stake distribution)
  -- instead live in the ledger layer. It is difficult to disentangle this,
  -- because the ledger may indeed /depend/ on those sampling decisions (for
  -- example, reward calculations /must/ be based on that same stake
  -- distribution).
  --
  -- There are also some /advantages/ to moving these sorts of decisions to the
  -- ledger layer. It means that the consensus algorithm can continue to
  -- function without modifications if we decide that the stake distribution for
  -- leader selection should be based on something else instead (for example,
  -- for some bespoke version of the blockchain we may wish to use a committee
  -- instead of a decentralized blockchain). Having sampling decisions in the
  -- ledger layer rather than the consensus layer means that these decisions can
  -- be made without modifying the consensus algorithm.
  --
  -- Note that for the specific case of Praos, whilst the ledger layer provides
  -- the relevant stake distribution, the precise leader election must still live
  -- in the consensus layer since that depends on the computation (and sampling)
  -- of entropy, which is done consensus side, not ledger side (the reward
  -- calculation does not depend on this).
  type LedgerView p :: Type

  -- | Validation errors
  type ValidationErr p :: Type

  -- | View on a header required to validate it
  type ValidateView p :: Type

  -- | Check if a node is the leader
  checkIsLeader ::
    HasCallStack =>
    ConsensusConfig p ->
    CanBeLeader p ->
    SlotNo ->
    Ticked (ChainDepState p) ->
    Maybe (IsLeader p)

  -- | Tick the 'ChainDepState'
  --
  -- We pass the 'LedgerView' to 'tickChainDepState'. Functions that /take/ a
  -- ticked 'ChainDepState' are not separately passed a ledger view; protocols
  -- that require it, can include it in their ticked 'ChainDepState' type.
  tickChainDepState ::
    ConsensusConfig p ->
    LedgerView p ->
    SlotNo ->
    ChainDepState p ->
    Ticked (ChainDepState p)

  -- | Apply a header
  updateChainDepState ::
    HasCallStack =>
    ConsensusConfig p ->
    ValidateView p ->
    SlotNo ->
    Ticked (ChainDepState p) ->
    Except (ValidationErr p) (ChainDepState p)

  -- | Re-apply a header to the same 'ChainDepState' we have been able to
  -- successfully apply to before.
  --
  -- Since a header can only be applied to a single, specific,
  -- 'ChainDepState', if we apply a previously applied header again it will be
  -- applied in the very same 'ChainDepState', and therefore can't possibly
  -- fail.
  --
  -- It is worth noting that since we already know that the header is valid
  -- w.r.t. the provided 'ChainDepState', no validation checks should be
  -- performed.
  reupdateChainDepState ::
    HasCallStack =>
    ConsensusConfig p ->
    ValidateView p ->
    SlotNo ->
    Ticked (ChainDepState p) ->
    ChainDepState p

  -- | We require that protocols support a @k@ security parameter
  protocolSecurityParam :: ConsensusConfig p -> SecurityParam

-- | Translate across protocols
class TranslateProto protoFrom protoTo where
  -- | Translate the ledger view.
  translateLedgerView ::
    Proxy (protoFrom, protoTo) -> LedgerView protoFrom -> LedgerView protoTo

  translateChainDepState ::
    Proxy (protoFrom, protoTo) -> ChainDepState protoFrom -> ChainDepState protoTo

-- | Degenerate instance - we may always translate from a protocol to itself.
instance TranslateProto singleProto singleProto where
  translateLedgerView :: Proxy (singleProto, singleProto)
-> LedgerView singleProto -> LedgerView singleProto
translateLedgerView Proxy (singleProto, singleProto)
_ = LedgerView singleProto -> LedgerView singleProto
forall a. a -> a
id
  translateChainDepState :: Proxy (singleProto, singleProto)
-> ChainDepState singleProto -> ChainDepState singleProto
translateChainDepState Proxy (singleProto, singleProto)
_ = ChainDepState singleProto -> ChainDepState singleProto
forall a. a -> a
id

-- | The chain order of some type; in the Consensus layer, this will always be
-- 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.
--
-- Additionally, we require a total order on this type, such that eg different
-- candidate chains that are preferred over our current selection can be sorted
-- for prioritization. For example, this is used in ChainSel during initial
-- chain selection or when blocks arrive out of order (not the case when the
-- node is caught up), or in the BlockFetch decision logic. Future work could
-- include also recording\/storing arrival information and using that instead
-- of\/in addition to the 'Ord' instance.
class Ord sv => ChainOrder sv where
  type ChainOrderConfig sv :: Type

  -- | Compare a candidate chain to our own.
  --
  -- This method defines when a candidate chain is /strictly/ preferable to our
  -- current chain. If both chains are equally preferable, the Ouroboros class
  -- of consensus protocols /always/ sticks with the current chain.
  --
  -- === Requirements
  --
  -- Write @ours ⊏ cand@ for @'preferCandidate' cfg ours cand@ for brevity.
  --
  --  [__Consistency with 'Ord'__]: When @ours ⊏ cand@, then @ours < cand@.
  --
  --      This means that @cand@ can only be preferred over @ours@ when @cand@
  --      is greater than @ours@ according to the 'Ord' instance.
  --
  --      However, this is not necessarily a sufficient condition; a concrete
  --      implementation may decide to not have @ours ⊏ cand@ despite @ours <
  --      cand@ for some pairs @ours, can@. However, it is recommended to think
  --      about this carefully and rather use 'SimpleChainOrder' if possible,
  --      which defines @ours ⊏ cand@ as @ours < cand@, as it simplifies
  --      reasoning about the chain ordering.
  --
  --      However, forgoing 'SimpleChainOrder' can enable more sophisticated
  --      tiebreaking rules that eg exhibit desirable incentive behavior.
  preferCandidate ::
    ChainOrderConfig sv ->
    -- | Tip of our chain
    sv ->
    -- | Tip of the candidate
    sv ->
    Bool

-- | A @DerivingVia@ helper to implement 'preferCandidate' in terms of the 'Ord'
-- instance.
newtype SimpleChainOrder sv = SimpleChainOrder sv
  deriving newtype (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
(SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> Eq (SimpleChainOrder sv)
forall sv.
Eq sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall sv.
Eq sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
== :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
$c/= :: forall sv.
Eq sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
/= :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
Eq, Eq (SimpleChainOrder sv)
Eq (SimpleChainOrder sv) =>
(SimpleChainOrder sv -> SimpleChainOrder sv -> Ordering)
-> (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> (SimpleChainOrder sv -> SimpleChainOrder sv -> Bool)
-> (SimpleChainOrder sv
    -> SimpleChainOrder sv -> SimpleChainOrder sv)
-> (SimpleChainOrder sv
    -> SimpleChainOrder sv -> SimpleChainOrder sv)
-> Ord (SimpleChainOrder sv)
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
SimpleChainOrder sv -> SimpleChainOrder sv -> Ordering
SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall sv. Ord sv => Eq (SimpleChainOrder sv)
forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Ordering
forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
$ccompare :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Ordering
compare :: SimpleChainOrder sv -> SimpleChainOrder sv -> Ordering
$c< :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
< :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
$c<= :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
<= :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
$c> :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
> :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
$c>= :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
>= :: SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
$cmax :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
max :: SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
$cmin :: forall sv.
Ord sv =>
SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
min :: SimpleChainOrder sv -> SimpleChainOrder sv -> SimpleChainOrder sv
Ord)

instance Ord sv => ChainOrder (SimpleChainOrder sv) where
  type ChainOrderConfig (SimpleChainOrder sv) = ()

  preferCandidate :: ChainOrderConfig (SimpleChainOrder sv)
-> SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
preferCandidate ChainOrderConfig (SimpleChainOrder sv)
_cfg SimpleChainOrder sv
ours SimpleChainOrder sv
cand = SimpleChainOrder sv
ours SimpleChainOrder sv -> SimpleChainOrder sv -> Bool
forall a. Ord a => a -> a -> Bool
< SimpleChainOrder sv
cand

-- | Use no tiebreaker to decide between chains of equal length, cf
-- 'TiebreakerView' and 'ChainOrder'.
data NoTiebreaker = NoTiebreaker
  deriving stock (Int -> NoTiebreaker -> ShowS
[NoTiebreaker] -> ShowS
NoTiebreaker -> String
(Int -> NoTiebreaker -> ShowS)
-> (NoTiebreaker -> String)
-> ([NoTiebreaker] -> ShowS)
-> Show NoTiebreaker
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoTiebreaker -> ShowS
showsPrec :: Int -> NoTiebreaker -> ShowS
$cshow :: NoTiebreaker -> String
show :: NoTiebreaker -> String
$cshowList :: [NoTiebreaker] -> ShowS
showList :: [NoTiebreaker] -> ShowS
Show, NoTiebreaker -> NoTiebreaker -> Bool
(NoTiebreaker -> NoTiebreaker -> Bool)
-> (NoTiebreaker -> NoTiebreaker -> Bool) -> Eq NoTiebreaker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoTiebreaker -> NoTiebreaker -> Bool
== :: NoTiebreaker -> NoTiebreaker -> Bool
$c/= :: NoTiebreaker -> NoTiebreaker -> Bool
/= :: NoTiebreaker -> NoTiebreaker -> Bool
Eq, Eq NoTiebreaker
Eq NoTiebreaker =>
(NoTiebreaker -> NoTiebreaker -> Ordering)
-> (NoTiebreaker -> NoTiebreaker -> Bool)
-> (NoTiebreaker -> NoTiebreaker -> Bool)
-> (NoTiebreaker -> NoTiebreaker -> Bool)
-> (NoTiebreaker -> NoTiebreaker -> Bool)
-> (NoTiebreaker -> NoTiebreaker -> NoTiebreaker)
-> (NoTiebreaker -> NoTiebreaker -> NoTiebreaker)
-> Ord NoTiebreaker
NoTiebreaker -> NoTiebreaker -> Bool
NoTiebreaker -> NoTiebreaker -> Ordering
NoTiebreaker -> NoTiebreaker -> NoTiebreaker
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NoTiebreaker -> NoTiebreaker -> Ordering
compare :: NoTiebreaker -> NoTiebreaker -> Ordering
$c< :: NoTiebreaker -> NoTiebreaker -> Bool
< :: NoTiebreaker -> NoTiebreaker -> Bool
$c<= :: NoTiebreaker -> NoTiebreaker -> Bool
<= :: NoTiebreaker -> NoTiebreaker -> Bool
$c> :: NoTiebreaker -> NoTiebreaker -> Bool
> :: NoTiebreaker -> NoTiebreaker -> Bool
$c>= :: NoTiebreaker -> NoTiebreaker -> Bool
>= :: NoTiebreaker -> NoTiebreaker -> Bool
$cmax :: NoTiebreaker -> NoTiebreaker -> NoTiebreaker
max :: NoTiebreaker -> NoTiebreaker -> NoTiebreaker
$cmin :: NoTiebreaker -> NoTiebreaker -> NoTiebreaker
min :: NoTiebreaker -> NoTiebreaker -> NoTiebreaker
Ord, (forall x. NoTiebreaker -> Rep NoTiebreaker x)
-> (forall x. Rep NoTiebreaker x -> NoTiebreaker)
-> Generic NoTiebreaker
forall x. Rep NoTiebreaker x -> NoTiebreaker
forall x. NoTiebreaker -> Rep NoTiebreaker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NoTiebreaker -> Rep NoTiebreaker x
from :: forall x. NoTiebreaker -> Rep NoTiebreaker x
$cto :: forall x. Rep NoTiebreaker x -> NoTiebreaker
to :: forall x. Rep NoTiebreaker x -> NoTiebreaker
Generic)
  deriving anyclass Context -> NoTiebreaker -> IO (Maybe ThunkInfo)
Proxy NoTiebreaker -> String
(Context -> NoTiebreaker -> IO (Maybe ThunkInfo))
-> (Context -> NoTiebreaker -> IO (Maybe ThunkInfo))
-> (Proxy NoTiebreaker -> String)
-> NoThunks NoTiebreaker
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> NoTiebreaker -> IO (Maybe ThunkInfo)
noThunks :: Context -> NoTiebreaker -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NoTiebreaker -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NoTiebreaker -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy NoTiebreaker -> String
showTypeOf :: Proxy NoTiebreaker -> String
NoThunks
  deriving Ord NoTiebreaker
Ord NoTiebreaker =>
(ChainOrderConfig NoTiebreaker
 -> NoTiebreaker -> NoTiebreaker -> Bool)
-> ChainOrder NoTiebreaker
ChainOrderConfig NoTiebreaker
-> NoTiebreaker -> NoTiebreaker -> Bool
forall sv.
Ord sv =>
(ChainOrderConfig sv -> sv -> sv -> Bool) -> ChainOrder sv
$cpreferCandidate :: ChainOrderConfig NoTiebreaker
-> NoTiebreaker -> NoTiebreaker -> Bool
preferCandidate :: ChainOrderConfig NoTiebreaker
-> NoTiebreaker -> NoTiebreaker -> Bool
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
  { forall p. SelectView p -> BlockNo
svBlockNo :: !BlockNo
  , forall p. SelectView p -> TiebreakerView p
svTiebreakerView :: !(TiebreakerView p)
  }
  deriving stock (forall x. SelectView p -> Rep (SelectView p) x)
-> (forall x. Rep (SelectView p) x -> SelectView p)
-> Generic (SelectView p)
forall x. Rep (SelectView p) x -> SelectView p
forall x. SelectView p -> Rep (SelectView p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (SelectView p) x -> SelectView p
forall p x. SelectView p -> Rep (SelectView p) x
$cfrom :: forall p x. SelectView p -> Rep (SelectView p) x
from :: forall x. SelectView p -> Rep (SelectView p) x
$cto :: forall p x. Rep (SelectView p) x -> SelectView p
to :: forall x. Rep (SelectView p) x -> SelectView p
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 :: SelectView p -> SelectView p -> Ordering
compare =
    [SelectView p -> SelectView p -> Ordering]
-> SelectView p -> SelectView p -> Ordering
forall a. Monoid a => [a] -> a
mconcat
      [ BlockNo -> BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockNo -> BlockNo -> Ordering)
-> (SelectView p -> BlockNo)
-> SelectView p
-> SelectView p
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SelectView p -> BlockNo
forall p. SelectView p -> BlockNo
svBlockNo
      , TiebreakerView p -> TiebreakerView p -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TiebreakerView p -> TiebreakerView p -> Ordering)
-> (SelectView p -> TiebreakerView p)
-> SelectView p
-> SelectView p
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` SelectView p -> TiebreakerView p
forall p. SelectView p -> TiebreakerView p
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 :: ChainOrderConfig (SelectView p)
-> SelectView p -> SelectView p -> Bool
preferCandidate ChainOrderConfig (SelectView p)
cfg SelectView p
ours SelectView p
cand = case BlockNo -> BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SelectView p -> BlockNo
forall p. SelectView p -> BlockNo
svBlockNo SelectView p
ours) (SelectView p -> BlockNo
forall p. SelectView p -> BlockNo
svBlockNo SelectView p
cand) of
    Ordering
LT -> Bool
True
    Ordering
EQ -> ChainOrderConfig (TiebreakerView p)
-> TiebreakerView p -> TiebreakerView p -> Bool
forall sv. ChainOrder sv => ChainOrderConfig sv -> sv -> sv -> Bool
preferCandidate ChainOrderConfig (SelectView p)
ChainOrderConfig (TiebreakerView p)
cfg (SelectView p -> TiebreakerView p
forall p. SelectView p -> TiebreakerView p
svTiebreakerView SelectView p
ours) (SelectView p -> TiebreakerView p
forall p. SelectView p -> TiebreakerView p
svTiebreakerView SelectView p
cand)
    Ordering
GT -> Bool
False