{-# 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
(
ConsensusConfig
, ConsensusProtocol (..)
, SelectView (..)
, ChainOrder (..)
, SimpleChainOrder (..)
, NoTiebreaker (..)
, TranslateProto (..)
, 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
data family ConsensusConfig p :: Type
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
) =>
ConsensusProtocol p
where
type ChainDepState p :: Type
type IsLeader p :: Type
type CanBeLeader p :: Type
type TiebreakerView p :: Type
type TiebreakerView p = NoTiebreaker
type LedgerView p :: Type
type ValidationErr p :: Type
type ValidateView p :: Type
checkIsLeader ::
HasCallStack =>
ConsensusConfig p ->
CanBeLeader p ->
SlotNo ->
Ticked (ChainDepState p) ->
Maybe (IsLeader p)
tickChainDepState ::
ConsensusConfig p ->
LedgerView p ->
SlotNo ->
ChainDepState p ->
Ticked (ChainDepState p)
updateChainDepState ::
HasCallStack =>
ConsensusConfig p ->
ValidateView p ->
SlotNo ->
Ticked (ChainDepState p) ->
Except (ValidationErr p) (ChainDepState p)
reupdateChainDepState ::
HasCallStack =>
ConsensusConfig p ->
ValidateView p ->
SlotNo ->
Ticked (ChainDepState p) ->
ChainDepState p
protocolSecurityParam :: ConsensusConfig p -> SecurityParam
class TranslateProto protoFrom protoTo where
translateLedgerView ::
Proxy (protoFrom, protoTo) -> LedgerView protoFrom -> LedgerView protoTo
translateChainDepState ::
Proxy (protoFrom, protoTo) -> ChainDepState protoFrom -> ChainDepState protoTo
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
class Ord sv => ChainOrder sv where
type ChainOrderConfig sv :: Type
preferCandidate ::
ChainOrderConfig sv ->
sv ->
sv ->
Bool
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
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
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)
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
]
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