{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- | Praos with the Leios overlay.
module Ouroboros.Consensus.Protocol.Praos2
  ( LeiosOnly (..)
  , LeiosCrypto
  , Praos2
  , ConsensusConfig (..)
  ) where

import Cardano.Ledger.Chain (ChainChecksPParams (..))
import Cardano.Ledger.Core (TranslationContext)
import qualified Cardano.Ledger.Dijkstra.Forecast as Dijkstra
import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis (..))
import Cardano.Ledger.Dijkstra.PParams (UpgradeDijkstraPParams (..))
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.State (emptyLeiosCommittee)
import Cardano.Protocol.Crypto (Crypto, StandardCrypto)
import qualified Cardano.Protocol.Leios.BlockHeader as LeiosCodec
import Data.Kind (Type)
import Data.Proxy (Proxy (Proxy))
import qualified Data.Strict.Either as Strict
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Leios.Protocol (LeiosLedgerView (..), LeiosProtocol (..))
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Protocol.PolyPraos
  ( WhyNotCertifiable (..)
  , getLeiosAnnouncementPolyPraos
  , getLeiosLedgerViewPolyPraos
  , markUncertifiable
  , validateLeiosAnnouncementPolyPraos
  )
import Ouroboros.Consensus.Protocol.Praos
import Ouroboros.Consensus.Protocol.Praos.Common
  ( HasMaxMajorProtVer (..)
  , PraosCanBeLeader
  , PraosProtocolSupportsNode (..)
  , PraosTiebreakerView
  , ShelleyProtocolHeader
  , TypeSwitch (..)
  )
import Ouroboros.Consensus.Protocol.Praos.Orphans ()
import qualified Ouroboros.Consensus.Protocol.Praos.Views as Views
import Ouroboros.Consensus.Protocol.TPraos (TPraos)

{-------------------------------------------------------------------------------
  The protocol
-------------------------------------------------------------------------------}

type Praos2 :: Type -> Type
data Praos2 c

type instance ShelleyProtocolHeader (Praos2 c) = LeiosCodec.Header c

instance PolyPraosCrypto (Praos2 StandardCrypto) StandardCrypto

class (Crypto c, PolyPraosCrypto (Praos2 c) c) => LeiosCrypto c

instance LeiosCrypto StandardCrypto

{-------------------------------------------------------------------------------
  The fields only this protocol has
-------------------------------------------------------------------------------}

-- | This protocol is Leios, so it holds the right alternative.
newtype instance LeiosOnly (Praos2 c) a b = Praos2HasLeios b
  deriving (LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
(LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool)
-> (LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool)
-> Eq (LeiosOnly (Praos2 c) a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a b.
Eq b =>
LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
$c== :: forall c a b.
Eq b =>
LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
== :: LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
$c/= :: forall c a b.
Eq b =>
LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
/= :: LeiosOnly (Praos2 c) a b -> LeiosOnly (Praos2 c) a b -> Bool
Eq, (forall x.
 LeiosOnly (Praos2 c) a b -> Rep (LeiosOnly (Praos2 c) a b) x)
-> (forall x.
    Rep (LeiosOnly (Praos2 c) a b) x -> LeiosOnly (Praos2 c) a b)
-> Generic (LeiosOnly (Praos2 c) a b)
forall x.
Rep (LeiosOnly (Praos2 c) a b) x -> LeiosOnly (Praos2 c) a b
forall x.
LeiosOnly (Praos2 c) a b -> Rep (LeiosOnly (Praos2 c) a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c a b x.
Rep (LeiosOnly (Praos2 c) a b) x -> LeiosOnly (Praos2 c) a b
forall c a b x.
LeiosOnly (Praos2 c) a b -> Rep (LeiosOnly (Praos2 c) a b) x
$cfrom :: forall c a b x.
LeiosOnly (Praos2 c) a b -> Rep (LeiosOnly (Praos2 c) a b) x
from :: forall x.
LeiosOnly (Praos2 c) a b -> Rep (LeiosOnly (Praos2 c) a b) x
$cto :: forall c a b x.
Rep (LeiosOnly (Praos2 c) a b) x -> LeiosOnly (Praos2 c) a b
to :: forall x.
Rep (LeiosOnly (Praos2 c) a b) x -> LeiosOnly (Praos2 c) a b
Generic, Int -> LeiosOnly (Praos2 c) a b -> ShowS
[LeiosOnly (Praos2 c) a b] -> ShowS
LeiosOnly (Praos2 c) a b -> String
(Int -> LeiosOnly (Praos2 c) a b -> ShowS)
-> (LeiosOnly (Praos2 c) a b -> String)
-> ([LeiosOnly (Praos2 c) a b] -> ShowS)
-> Show (LeiosOnly (Praos2 c) a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a b. Show b => Int -> LeiosOnly (Praos2 c) a b -> ShowS
forall c a b. Show b => [LeiosOnly (Praos2 c) a b] -> ShowS
forall c a b. Show b => LeiosOnly (Praos2 c) a b -> String
$cshowsPrec :: forall c a b. Show b => Int -> LeiosOnly (Praos2 c) a b -> ShowS
showsPrec :: Int -> LeiosOnly (Praos2 c) a b -> ShowS
$cshow :: forall c a b. Show b => LeiosOnly (Praos2 c) a b -> String
show :: LeiosOnly (Praos2 c) a b -> String
$cshowList :: forall c a b. Show b => [LeiosOnly (Praos2 c) a b] -> ShowS
showList :: [LeiosOnly (Praos2 c) a b] -> ShowS
Show)

deriving anyclass instance
  NoThunks b => NoThunks (LeiosOnly (Praos2 c) a b)

instance Functor (LeiosOnly (Praos2 c) a) where
  fmap :: forall a b.
(a -> b) -> LeiosOnly (Praos2 c) a a -> LeiosOnly (Praos2 c) a b
fmap a -> b
f (Praos2HasLeios a
b) = b -> LeiosOnly (Praos2 c) a b
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios (a -> b
f a
b)

instance Applicative (LeiosOnly (Praos2 c) a) where
  pure :: forall a. a -> LeiosOnly (Praos2 c) a a
pure = a -> LeiosOnly (Praos2 c) a a
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios
  Praos2HasLeios a -> b
f <*> :: forall a b.
LeiosOnly (Praos2 c) a (a -> b)
-> LeiosOnly (Praos2 c) a a -> LeiosOnly (Praos2 c) a b
<*> Praos2HasLeios a
b = b -> LeiosOnly (Praos2 c) a b
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios (a -> b
f a
b)

instance Foldable (LeiosOnly (Praos2 c) a) where
  foldMap :: forall m a. Monoid m => (a -> m) -> LeiosOnly (Praos2 c) a a -> m
foldMap a -> m
f (Praos2HasLeios a
b) = a -> m
f a
b

instance Traversable (LeiosOnly (Praos2 c) a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> LeiosOnly (Praos2 c) a a -> f (LeiosOnly (Praos2 c) a b)
traverse a -> f b
f (Praos2HasLeios a
b) = b -> LeiosOnly (Praos2 c) a b
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios (b -> LeiosOnly (Praos2 c) a b)
-> f b -> f (LeiosOnly (Praos2 c) a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
b

instance TypeSwitch (LeiosOnly (Praos2 c)) where
  typeSwitchL :: LeiosOnly (Praos2 c) (LeiosOnly (Praos2 c) () Void) ()
typeSwitchL = () -> LeiosOnly (Praos2 c) (LeiosOnly (Praos2 c) () Void) ()
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios ()
  typeSwitchR :: LeiosOnly (Praos2 c) () (LeiosOnly (Praos2 c) Void ())
typeSwitchR = LeiosOnly (Praos2 c) Void ()
-> LeiosOnly (Praos2 c) () (LeiosOnly (Praos2 c) Void ())
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios (() -> LeiosOnly (Praos2 c) Void ()
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios ())

{-------------------------------------------------------------------------------
  Configuration
-------------------------------------------------------------------------------}

-- | Praos's configuration, wrapped only because 'ConsensusConfig' is a data
-- family.
--
-- Leios adds nothing to it: the periods, the committee, the quorum and the size
-- bounds all reach the protocol through the ledger view instead.
newtype instance ConsensusConfig (Praos2 c) = LeiosConfig
  { forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig :: ConsensusConfig (Praos c)
  }
  deriving (forall x.
 ConsensusConfig (Praos2 c) -> Rep (ConsensusConfig (Praos2 c)) x)
-> (forall x.
    Rep (ConsensusConfig (Praos2 c)) x -> ConsensusConfig (Praos2 c))
-> Generic (ConsensusConfig (Praos2 c))
forall x.
Rep (ConsensusConfig (Praos2 c)) x -> ConsensusConfig (Praos2 c)
forall x.
ConsensusConfig (Praos2 c) -> Rep (ConsensusConfig (Praos2 c)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (ConsensusConfig (Praos2 c)) x -> ConsensusConfig (Praos2 c)
forall c x.
ConsensusConfig (Praos2 c) -> Rep (ConsensusConfig (Praos2 c)) x
$cfrom :: forall c x.
ConsensusConfig (Praos2 c) -> Rep (ConsensusConfig (Praos2 c)) x
from :: forall x.
ConsensusConfig (Praos2 c) -> Rep (ConsensusConfig (Praos2 c)) x
$cto :: forall c x.
Rep (ConsensusConfig (Praos2 c)) x -> ConsensusConfig (Praos2 c)
to :: forall x.
Rep (ConsensusConfig (Praos2 c)) x -> ConsensusConfig (Praos2 c)
Generic

deriving newtype instance Crypto c => NoThunks (ConsensusConfig (Praos2 c))

instance HasMaxMajorProtVer (Praos2 c) where
  protoMaxMajorPV :: ConsensusConfig (Praos2 c) -> MaxMajorProtVer
protoMaxMajorPV = PraosParams -> MaxMajorProtVer
praosMaxMajorPV (PraosParams -> MaxMajorProtVer)
-> (ConsensusConfig (Praos2 c) -> PraosParams)
-> ConsensusConfig (Praos2 c)
-> MaxMajorProtVer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams (ConsensusConfig (Praos c) -> PraosParams)
-> (ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c))
-> ConsensusConfig (Praos2 c)
-> PraosParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig

{-------------------------------------------------------------------------------
  ConsensusProtocol
-------------------------------------------------------------------------------}

instance LeiosCrypto c => LeiosProtocol (Praos2 c) where
  getLeiosAnnouncement :: forall (proxy :: * -> *).
proxy (Praos2 c)
-> ValidateView (Praos2 c) -> Maybe LeiosAnnouncement
getLeiosAnnouncement proxy (Praos2 c)
_proxy = ValidateView (Praos2 c) -> Maybe LeiosAnnouncement
PolyPraosValidateView (Praos2 c) c -> Maybe LeiosAnnouncement
forall proto c.
Foldable (WhenLeios proto) =>
PolyPraosValidateView proto c -> Maybe LeiosAnnouncement
getLeiosAnnouncementPolyPraos
  validateLeiosAnnouncement :: ConsensusConfig (Praos2 c)
-> ValidateView (Praos2 c)
-> SlotNo
-> Ticked (ChainDepState (Praos2 c))
-> Except (ValidationErr (Praos2 c)) OCINStaleness
validateLeiosAnnouncement (LeiosConfig (PraosConfig PraosParams
prms EpochInfo (Except PastHorizonException)
_ei)) ValidateView (Praos2 c)
b SlotNo
_slot =
    PraosParams
-> PolyPraosValidateView (Praos2 c) c
-> Ticked (PolyPraosState (Praos2 c))
-> Except (PolyPraosValidationErr (Praos2 c) c) OCINStaleness
forall proto c.
(PolyPraosCrypto proto c, Applicative (WhenLeios proto),
 Foldable (WhenLeios proto), TypeSwitch (LeiosOnly proto)) =>
PraosParams
-> PolyPraosValidateView proto c
-> Ticked (PolyPraosState proto)
-> Except (PolyPraosValidationErr proto c) OCINStaleness
validateLeiosAnnouncementPolyPraos PraosParams
prms ValidateView (Praos2 c)
PolyPraosValidateView (Praos2 c) c
b
  getLeiosLedgerView :: forall (proxy :: * -> *).
proxy (Praos2 c) -> LedgerView (Praos2 c) -> Maybe LeiosLedgerView
getLeiosLedgerView proxy (Praos2 c)
_proxy = LedgerView (Praos2 c) -> Maybe LeiosLedgerView
PolyPraosLedgerView (Praos2 c) -> Maybe LeiosLedgerView
forall proto.
Foldable (WhenLeios proto) =>
PolyPraosLedgerView proto -> Maybe LeiosLedgerView
getLeiosLedgerViewPolyPraos

instance LeiosCrypto c => ConsensusProtocol (Praos2 c) where
  type ChainDepState (Praos2 c) = PolyPraosState (Praos2 c)
  type IsLeader (Praos2 c) = PraosIsLeader c
  type CanBeLeader (Praos2 c) = PraosCanBeLeader c
  type TiebreakerView (Praos2 c) = PraosTiebreakerView c
  type LedgerView (Praos2 c) = Views.PolyPraosLedgerView (Praos2 c)
  type ValidationErr (Praos2 c) = PolyPraosValidationErr (Praos2 c) c
  type ValidateView (Praos2 c) = Views.PolyPraosValidateView (Praos2 c) c

  protocolSecurityParam :: ConsensusConfig (Praos2 c) -> SecurityParam
protocolSecurityParam = PraosParams -> SecurityParam
praosSecurityParam (PraosParams -> SecurityParam)
-> (ConsensusConfig (Praos2 c) -> PraosParams)
-> ConsensusConfig (Praos2 c)
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams (ConsensusConfig (Praos c) -> PraosParams)
-> (ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c))
-> ConsensusConfig (Praos2 c)
-> PraosParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig

  checkIsLeader :: HasCallStack =>
ConsensusConfig (Praos2 c)
-> CanBeLeader (Praos2 c)
-> SlotNo
-> Ticked (ChainDepState (Praos2 c))
-> Maybe (IsLeader (Praos2 c))
checkIsLeader = PraosParams
-> PraosCanBeLeader c
-> SlotNo
-> Ticked (PolyPraosState (Praos2 c))
-> Maybe (PraosIsLeader c)
forall proto c.
PolyPraosCrypto proto c =>
PraosParams
-> PraosCanBeLeader c
-> SlotNo
-> Ticked (PolyPraosState proto)
-> Maybe (PraosIsLeader c)
checkIsLeaderPolyPraos (PraosParams
 -> PraosCanBeLeader c
 -> SlotNo
 -> Ticked (PolyPraosState (Praos2 c))
 -> Maybe (PraosIsLeader c))
-> (ConsensusConfig (Praos2 c) -> PraosParams)
-> ConsensusConfig (Praos2 c)
-> PraosCanBeLeader c
-> SlotNo
-> Ticked (PolyPraosState (Praos2 c))
-> Maybe (PraosIsLeader c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos c) -> PraosParams
forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams (ConsensusConfig (Praos c) -> PraosParams)
-> (ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c))
-> ConsensusConfig (Praos2 c)
-> PraosParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig

  tickChainDepState :: ConsensusConfig (Praos2 c)
-> LedgerView (Praos2 c)
-> SlotNo
-> ChainDepState (Praos2 c)
-> Ticked (ChainDepState (Praos2 c))
tickChainDepState = EpochInfo (Except PastHorizonException)
-> PolyPraosLedgerView (Praos2 c)
-> SlotNo
-> PolyPraosState (Praos2 c)
-> Ticked (PolyPraosState (Praos2 c))
forall proto.
Functor (WhenLeios proto) =>
EpochInfo (Except PastHorizonException)
-> PolyPraosLedgerView proto
-> SlotNo
-> PolyPraosState proto
-> Ticked (PolyPraosState proto)
tickChainDepStatePolyPraos (EpochInfo (Except PastHorizonException)
 -> PolyPraosLedgerView (Praos2 c)
 -> SlotNo
 -> PolyPraosState (Praos2 c)
 -> Ticked (PolyPraosState (Praos2 c)))
-> (ConsensusConfig (Praos2 c)
    -> EpochInfo (Except PastHorizonException))
-> ConsensusConfig (Praos2 c)
-> PolyPraosLedgerView (Praos2 c)
-> SlotNo
-> PolyPraosState (Praos2 c)
-> Ticked (PolyPraosState (Praos2 c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos c)
-> EpochInfo (Except PastHorizonException)
forall c.
ConsensusConfig (Praos c)
-> EpochInfo (Except PastHorizonException)
praosEpochInfo (ConsensusConfig (Praos c)
 -> EpochInfo (Except PastHorizonException))
-> (ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c))
-> ConsensusConfig (Praos2 c)
-> EpochInfo (Except PastHorizonException)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
forall c. ConsensusConfig (Praos2 c) -> ConsensusConfig (Praos c)
leiosPraosConfig

  -- The Leios header checks are cheap, so they run before the signature checks.
  updateChainDepState :: HasCallStack =>
ConsensusConfig (Praos2 c)
-> ValidateView (Praos2 c)
-> SlotNo
-> Ticked (ChainDepState (Praos2 c))
-> Except (ValidationErr (Praos2 c)) (ChainDepState (Praos2 c))
updateChainDepState (LeiosConfig (PraosConfig PraosParams
prms EpochInfo (Except PastHorizonException)
ei)) = PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView (Praos2 c) c
-> SlotNo
-> Ticked (PolyPraosState (Praos2 c))
-> Except
     (PolyPraosValidationErr (Praos2 c) c) (PolyPraosState (Praos2 c))
forall proto c.
(PolyPraosCrypto proto c, Applicative (WhenLeios proto),
 Foldable (WhenLeios proto), TypeSwitch (LeiosOnly proto)) =>
PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView proto c
-> SlotNo
-> Ticked (PolyPraosState proto)
-> Except (PolyPraosValidationErr proto c) (PolyPraosState proto)
updateChainDepStatePolyPraos PraosParams
prms EpochInfo (Except PastHorizonException)
ei

  reupdateChainDepState :: HasCallStack =>
ConsensusConfig (Praos2 c)
-> ValidateView (Praos2 c)
-> SlotNo
-> Ticked (ChainDepState (Praos2 c))
-> ChainDepState (Praos2 c)
reupdateChainDepState (LeiosConfig (PraosConfig PraosParams
prms EpochInfo (Except PastHorizonException)
ei)) = PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView (Praos2 c) c
-> SlotNo
-> Ticked (PolyPraosState (Praos2 c))
-> PolyPraosState (Praos2 c)
forall proto c.
Functor (WhenLeios proto) =>
PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView proto c
-> SlotNo
-> Ticked (PolyPraosState proto)
-> PolyPraosState proto
reupdateChainDepStatePolyPraos PraosParams
prms EpochInfo (Except PastHorizonException)
ei

instance Dijkstra.DijkstraEraForecast era => Views.ForecastToPolyPraosLedgerView (Praos2 c) era where
  forecastToPolyPraosLedgerView :: forall (t :: Timeline).
EraForecast era =>
Forecast t era -> PolyPraosLedgerView (Praos2 c)
forecastToPolyPraosLedgerView (Forecast t era
f :: SL.Forecast t era) =
    Views.PraosLedgerView
      { plvPoolDistr :: PoolDistr
Views.plvPoolDistr = Forecast t era
f Forecast t era
-> Getting PoolDistr (Forecast t era) PoolDistr -> PoolDistr
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
EraForecast era =>
Lens' (Forecast t era) PoolDistr
SL.poolDistrForecastL @era @t
      , plvMaxHeaderSize :: Word16
Views.plvMaxHeaderSize = ChainChecksPParams -> Word16
ccMaxBHSize ChainChecksPParams
cc
      , plvMaxBodySize :: Word32
Views.plvMaxBodySize = ChainChecksPParams -> Word32
ccMaxBBSize ChainChecksPParams
cc
      , plvProtocolVersion :: ProtVer
Views.plvProtocolVersion = ChainChecksPParams -> ProtVer
ccProtocolVersion ChainChecksPParams
cc
      , plvLeios :: WhenLeios (Praos2 c) LeiosLedgerView
Views.plvLeios =
          LeiosLedgerView -> WhenLeios (Praos2 c) LeiosLedgerView
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios
            MkLeiosLedgerView
              { llvCommittee :: LeiosCommittee
llvCommittee = Forecast t era
f Forecast t era
-> Getting LeiosCommittee (Forecast t era) LeiosCommittee
-> LeiosCommittee
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) LeiosCommittee
Dijkstra.leiosCommitteeForecastL @era @t
              , llvQuorumStakeThreshold :: UnitInterval
llvQuorumStakeThreshold = Forecast t era
f Forecast t era
-> Getting UnitInterval (Forecast t era) UnitInterval
-> UnitInterval
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) UnitInterval
Dijkstra.leiosQuorumStakeThresholdForecastL @era @t
              , llvAnnouncementPeriod :: Milliseconds32
llvAnnouncementPeriod = Forecast t era
f Forecast t era
-> Getting Milliseconds32 (Forecast t era) Milliseconds32
-> Milliseconds32
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) Milliseconds32
Dijkstra.leiosAnnouncementPeriodLengthForecastL @era @t
              , llvVotePeriod :: Milliseconds32
llvVotePeriod = Forecast t era
f Forecast t era
-> Getting Milliseconds32 (Forecast t era) Milliseconds32
-> Milliseconds32
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) Milliseconds32
Dijkstra.leiosVotePeriodLengthForecastL @era @t
              , llvDiffusionPeriod :: Milliseconds32
llvDiffusionPeriod = Forecast t era
f Forecast t era
-> Getting Milliseconds32 (Forecast t era) Milliseconds32
-> Milliseconds32
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) Milliseconds32
Dijkstra.leiosDiffusionPeriodLengthForecastL @era @t
              , llvMaxEbBodySize :: Word32
llvMaxEbBodySize = Forecast t era
f Forecast t era -> Getting Word32 (Forecast t era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) Word32
Dijkstra.maxEndorserBlockReferencesSizeForecastL @era @t
              , llvMaxEbTxsSize :: Word32
llvMaxEbTxsSize = Forecast t era
f Forecast t era -> Getting Word32 (Forecast t era) Word32 -> Word32
forall s a. s -> Getting a s a -> a
^. forall era (t :: Timeline).
DijkstraEraForecast era =>
Lens' (Forecast t era) Word32
Dijkstra.maxEndorserBlockTxsSizeForecastL @era @t
              }
      }
   where
    cc :: ChainChecksPParams
cc = forall (t :: Timeline) era.
EraForecast era =>
Forecast t era -> ChainChecksPParams
SL.forecastChainChecks @t @era Forecast t era
f

{-------------------------------------------------------------------------------
  Translation from the protocol without Leios
-------------------------------------------------------------------------------}

-- | Crossing from Praos into Praos with Leios.
--
-- Everything carries over unchanged; the Leios fields merely have to be
-- introduced. Nothing has been announced, since no header of the protocol being
-- left could have carried an announcement. The Leios parameters come from the
-- Dijkstra genesis. The committee is empty: none is seated until a stake
-- snapshot rotation within the new era, beyond any forecast from the old one.
instance
  TranslationContext era ~ DijkstraGenesis =>
  TranslateProto (Praos c) (Praos2 c) era
  where
  translateLedgerView :: Proxy (Praos c, Praos2 c, era)
-> TranslationContext era
-> LedgerView (Praos c)
-> LedgerView (Praos2 c)
translateLedgerView Proxy (Praos c, Praos2 c, era)
_prx DijkstraGenesis{dgUpgradePParams :: DijkstraGenesis -> UpgradeDijkstraPParams Identity DijkstraEra
dgUpgradePParams = UpgradeDijkstraPParams Identity DijkstraEra
upgrade} LedgerView (Praos c)
lv =
    Views.PraosLedgerView
      { plvPoolDistr :: PoolDistr
Views.plvPoolDistr = PolyPraosLedgerView (Praos c) -> PoolDistr
forall proto. PolyPraosLedgerView proto -> PoolDistr
Views.plvPoolDistr LedgerView (Praos c)
PolyPraosLedgerView (Praos c)
lv
      , plvMaxHeaderSize :: Word16
Views.plvMaxHeaderSize = PolyPraosLedgerView (Praos c) -> Word16
forall proto. PolyPraosLedgerView proto -> Word16
Views.plvMaxHeaderSize LedgerView (Praos c)
PolyPraosLedgerView (Praos c)
lv
      , plvMaxBodySize :: Word32
Views.plvMaxBodySize = PolyPraosLedgerView (Praos c) -> Word32
forall proto. PolyPraosLedgerView proto -> Word32
Views.plvMaxBodySize LedgerView (Praos c)
PolyPraosLedgerView (Praos c)
lv
      , plvProtocolVersion :: ProtVer
Views.plvProtocolVersion = PolyPraosLedgerView (Praos c) -> ProtVer
forall proto. PolyPraosLedgerView proto -> ProtVer
Views.plvProtocolVersion LedgerView (Praos c)
PolyPraosLedgerView (Praos c)
lv
      , plvLeios :: WhenLeios (Praos2 c) LeiosLedgerView
Views.plvLeios =
          LeiosLedgerView -> WhenLeios (Praos2 c) LeiosLedgerView
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios
            MkLeiosLedgerView
              { llvCommittee :: LeiosCommittee
llvCommittee = LeiosCommittee
emptyLeiosCommittee
              , llvQuorumStakeThreshold :: UnitInterval
llvQuorumStakeThreshold = UpgradeDijkstraPParams Identity DijkstraEra
-> HKD Identity UnitInterval
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f UnitInterval
udppLeiosQuorumStakeThreshold UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              , llvAnnouncementPeriod :: Milliseconds32
llvAnnouncementPeriod = UpgradeDijkstraPParams Identity DijkstraEra
-> HKD Identity Milliseconds32
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f Milliseconds32
udppLeiosAnnouncementPeriodLength UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              , llvVotePeriod :: Milliseconds32
llvVotePeriod = UpgradeDijkstraPParams Identity DijkstraEra
-> HKD Identity Milliseconds32
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f Milliseconds32
udppLeiosVotePeriodLength UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              , llvDiffusionPeriod :: Milliseconds32
llvDiffusionPeriod = UpgradeDijkstraPParams Identity DijkstraEra
-> HKD Identity Milliseconds32
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f Milliseconds32
udppLeiosDiffusionPeriodLength UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              , llvMaxEbBodySize :: Word32
llvMaxEbBodySize = UpgradeDijkstraPParams Identity DijkstraEra -> HKD Identity Word32
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f Word32
udppMaxEndorserBlockReferencesSize UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              , llvMaxEbTxsSize :: Word32
llvMaxEbTxsSize = UpgradeDijkstraPParams Identity DijkstraEra -> HKD Identity Word32
forall (f :: * -> *) era.
UpgradeDijkstraPParams f era -> HKD f Word32
udppMaxEndorserBlockTxsSize UpgradeDijkstraPParams Identity DijkstraEra
upgrade
              }
      }

  translateChainDepState :: Proxy (Praos c, Praos2 c, era)
-> ChainDepState (Praos c) -> ChainDepState (Praos2 c)
translateChainDepState Proxy (Praos c, Praos2 c, era)
_ ChainDepState (Praos c)
st =
    PraosState
      { praosStateLastSlot :: WithOrigin SlotNo
praosStateLastSlot = PolyPraosState (Praos c) -> WithOrigin SlotNo
forall proto. PolyPraosState proto -> WithOrigin SlotNo
praosStateLastSlot ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateOCertCounters :: Map (KeyHash BlockIssuer) Word64
praosStateOCertCounters = PolyPraosState (Praos c) -> Map (KeyHash BlockIssuer) Word64
forall proto.
PolyPraosState proto -> Map (KeyHash BlockIssuer) Word64
praosStateOCertCounters ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateEvolvingNonce :: Nonce
praosStateEvolvingNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStateEvolvingNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateCandidateNonce :: Nonce
praosStateCandidateNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStateCandidateNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateEpochNonce :: Nonce
praosStateEpochNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStateEpochNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStatePreviousEpochNonce :: Nonce
praosStatePreviousEpochNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStatePreviousEpochNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateLabNonce :: Nonce
praosStateLabNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStateLabNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateLastEpochBlockNonce :: Nonce
praosStateLastEpochBlockNonce = PolyPraosState (Praos c) -> Nonce
forall proto. PolyPraosState proto -> Nonce
praosStateLastEpochBlockNonce ChainDepState (Praos c)
PolyPraosState (Praos c)
st
      , praosStateLeiosAnnouncement :: WhenLeios (Praos2 c) (Either WhyNotCertifiable LeiosAnnouncement)
praosStateLeiosAnnouncement = Either WhyNotCertifiable LeiosAnnouncement
-> WhenLeios
     (Praos2 c) (Either WhyNotCertifiable LeiosAnnouncement)
forall c a b. b -> LeiosOnly (Praos2 c) a b
Praos2HasLeios (WhyNotCertifiable -> Either WhyNotCertifiable LeiosAnnouncement
forall a b. a -> Either a b
Strict.Left WhyNotCertifiable
NothingAnnounced)
      }

-- | Crossing from one era with Leios into another.
--
-- Everything carries over unchanged except the announcement: it was made in the
-- era being left, so it is no longer certifiable, since an endorser block may
-- not be certified across an era boundary (to keep the design simpler).
--
-- Nothing uses this yet: it's dead code until two adjacent eras use 'Praos2'.
-- Even so, it's important to implement it _now_, because it would be easy to
-- forget, and doing so could introduce blindspots in the rest of the Leios
-- rules.
instance TranslateProto (Praos2 c) (Praos2 c) era where
  translateLedgerView :: Proxy (Praos2 c, Praos2 c, era)
-> TranslationContext era
-> LedgerView (Praos2 c)
-> LedgerView (Praos2 c)
translateLedgerView Proxy (Praos2 c, Praos2 c, era)
_prx TranslationContext era
_ctx = LedgerView (Praos2 c) -> LedgerView (Praos2 c)
PolyPraosLedgerView (Praos2 c) -> PolyPraosLedgerView (Praos2 c)
forall a. a -> a
id
  translateChainDepState :: Proxy (Praos2 c, Praos2 c, era)
-> ChainDepState (Praos2 c) -> ChainDepState (Praos2 c)
translateChainDepState Proxy (Praos2 c, Praos2 c, era)
_ ChainDepState (Praos2 c)
st =
    ChainDepState (Praos2 c)
st
      { praosStateLeiosAnnouncement =
          markUncertifiable AnnouncedInPreviousEra <$> praosStateLeiosAnnouncement st
      }

instance
  forall c era.
  TranslationContext era ~ DijkstraGenesis =>
  TranslateProto (TPraos c) (Praos2 c) era
  where
  translateLedgerView :: Proxy (TPraos c, Praos2 c, era)
-> TranslationContext era
-> LedgerView (TPraos c)
-> LedgerView (Praos2 c)
translateLedgerView Proxy (TPraos c, Praos2 c, era)
_prx TranslationContext era
ctx =
    Proxy (Praos c, Praos2 c, era)
-> TranslationContext era
-> LedgerView (Praos c)
-> LedgerView (Praos2 c)
forall protoFrom protoTo eraTo.
TranslateProto protoFrom protoTo eraTo =>
Proxy (protoFrom, protoTo, eraTo)
-> TranslationContext eraTo
-> LedgerView protoFrom
-> LedgerView protoTo
translateLedgerView (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Praos c, Praos2 c, era)) TranslationContext era
ctx
      (PolyPraosLedgerView (Praos c) -> PolyPraosLedgerView (Praos2 c))
-> (TPraosLedgerView -> PolyPraosLedgerView (Praos c))
-> TPraosLedgerView
-> PolyPraosLedgerView (Praos2 c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (TPraos c, Praos c, era)
-> TranslationContext era
-> LedgerView (TPraos c)
-> LedgerView (Praos c)
forall protoFrom protoTo eraTo.
TranslateProto protoFrom protoTo eraTo =>
Proxy (protoFrom, protoTo, eraTo)
-> TranslationContext eraTo
-> LedgerView protoFrom
-> LedgerView protoTo
translateLedgerView (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(TPraos c, Praos c, era)) TranslationContext era
ctx

  translateChainDepState :: Proxy (TPraos c, Praos2 c, era)
-> ChainDepState (TPraos c) -> ChainDepState (Praos2 c)
translateChainDepState Proxy (TPraos c, Praos2 c, era)
_ =
    Proxy (Praos c, Praos2 c, era)
-> ChainDepState (Praos c) -> ChainDepState (Praos2 c)
forall protoFrom protoTo eraTo.
TranslateProto protoFrom protoTo eraTo =>
Proxy (protoFrom, protoTo, eraTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
translateChainDepState (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Praos c, Praos2 c, era))
      (PolyPraosState (Praos c) -> PolyPraosState (Praos2 c))
-> (TPraosState -> PolyPraosState (Praos c))
-> TPraosState
-> PolyPraosState (Praos2 c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy (TPraos c, Praos c, era)
-> ChainDepState (TPraos c) -> ChainDepState (Praos c)
forall protoFrom protoTo eraTo.
TranslateProto protoFrom protoTo eraTo =>
Proxy (protoFrom, protoTo, eraTo)
-> ChainDepState protoFrom -> ChainDepState protoTo
translateChainDepState (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(TPraos c, Praos c, era))

{-------------------------------------------------------------------------------
  PraosProtocolSupportsNode
-------------------------------------------------------------------------------}

instance LeiosCrypto c => PraosProtocolSupportsNode (Praos2 c) where
  type PraosProtocolSupportsNodeCrypto (Praos2 c) = c

  getPraosNonces :: forall (proxy :: * -> *).
proxy (Praos2 c) -> ChainDepState (Praos2 c) -> PraosNonces
getPraosNonces proxy (Praos2 c)
_prx = ChainDepState (Praos2 c) -> PraosNonces
PolyPraosState (Praos2 c) -> PraosNonces
forall proto. PolyPraosState proto -> PraosNonces
getPraosNoncesPolyPraos

  getOpCertCounters :: forall (proxy :: * -> *).
proxy (Praos2 c)
-> ChainDepState (Praos2 c) -> Map (KeyHash BlockIssuer) Word64
getOpCertCounters proxy (Praos2 c)
_prx = ChainDepState (Praos2 c) -> Map (KeyHash BlockIssuer) Word64
PolyPraosState (Praos2 c) -> Map (KeyHash BlockIssuer) Word64
forall proto.
PolyPraosState proto -> Map (KeyHash BlockIssuer) Word64
getOpCertCountersPolyPraos