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

-- | Praos with no extensions.
module Ouroboros.Consensus.Protocol.Praos
  ( ConsensusConfig (..)
  , LeiosOnly (..)
  , VoidUnlessLeios
  , WhenLeios
  , Praos
  , PraosCrypto
  , PraosLedgerView
  , PraosState
  , PraosValidateView
  , PraosValidationErr

    -- * Re-exports

    -- | These were defined in this module before
    -- "Ouroboros.Consensus.Protocol.PolyPraos" existed. They are re-exported only
    -- for that historical reason, so that the modules importing them here did not
    -- need to change.
  , PolyPraosCrypto
  , PolyPraosState (..)
  , PolyPraosValidationErr (..)
  , PraosCannotForge (..)
  , PraosFields (..)
  , PraosIsLeader (..)
  , PraosParams (..)
  , PraosToSign (..)
  , SerialisePraosState
  , Ticked (..)
  , checkIsLeaderPolyPraos
  , forgePraosFields
  , getOpCertCountersPolyPraos
  , getPraosNoncesPolyPraos
  , leiosContextFreeHeaderChecks
  , praosCheckCanForge
  , reupdateChainDepStatePolyPraos
  , updateChainDepStatePolyPraos
  , tickChainDepStatePolyPraos
  , validateKESSignature
  , validateVRFSignature

    -- ** For testing purposes
  , doValidateKESSignature
  , doValidateVRFSignature
  ) where

import Cardano.Ledger.Chain (ChainChecksPParams (..))
import qualified Cardano.Ledger.Chain as SL
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Protocol.Crypto (Crypto, StandardCrypto)
import qualified Cardano.Protocol.Praos.BlockHeader as PraosCodec
import qualified Cardano.Protocol.TPraos.API as SL
import qualified Cardano.Protocol.TPraos.Rules.Prtcl as SL
import qualified Cardano.Protocol.TPraos.Rules.Tickn as SL
import Cardano.Slotting.EpochInfo (EpochInfo)
import Control.Monad.Except (Except)
import Data.Coerce (coerce)
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.HardFork.History as History
import Ouroboros.Consensus.Leios.Protocol
  ( LeiosProtocol (..)
  , defaultGetLeiosAnnouncement
  , defaultGetLeiosLedgerView
  , defaultValidateLeiosAnnouncement
  )
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Protocol.PolyPraos
import Ouroboros.Consensus.Protocol.Praos.Common
import Ouroboros.Consensus.Protocol.Praos.Orphans ()
import qualified Ouroboros.Consensus.Protocol.Praos.Views as Views
import Ouroboros.Consensus.Protocol.TPraos
  ( ConsensusConfig (TPraosConfig, tpraosEpochInfo, tpraosParams)
  , TPraos
  , TPraosState (tpraosStateChainDepState, tpraosStateLastSlot)
  )

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

type Praos :: Type -> Type
data Praos c

type instance ShelleyProtocolHeader (Praos c) = PraosCodec.Header c

instance PolyPraosCrypto (Praos StandardCrypto) StandardCrypto

class (Crypto c, PolyPraosCrypto (Praos c) c) => PraosCrypto c

instance PraosCrypto StandardCrypto

type PraosState c = PolyPraosState (Praos c)

type PraosLedgerView c = Views.PolyPraosLedgerView (Praos c)

type PraosValidateView c = Views.PolyPraosValidateView (Praos c) c

type PraosValidationErr c = PolyPraosValidationErr (Praos c) c

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

-- | Praos is not Leios, so it holds the left alternative.
newtype instance LeiosOnly (Praos c) a b = PraosLacksLeios a
  deriving (LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
(LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool)
-> (LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool)
-> Eq (LeiosOnly (Praos c) a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a b.
Eq a =>
LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
$c== :: forall c a b.
Eq a =>
LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
== :: LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
$c/= :: forall c a b.
Eq a =>
LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
/= :: LeiosOnly (Praos c) a b -> LeiosOnly (Praos c) a b -> Bool
Eq, (forall x.
 LeiosOnly (Praos c) a b -> Rep (LeiosOnly (Praos c) a b) x)
-> (forall x.
    Rep (LeiosOnly (Praos c) a b) x -> LeiosOnly (Praos c) a b)
-> Generic (LeiosOnly (Praos c) a b)
forall x.
Rep (LeiosOnly (Praos c) a b) x -> LeiosOnly (Praos c) a b
forall x.
LeiosOnly (Praos c) a b -> Rep (LeiosOnly (Praos 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 (Praos c) a b) x -> LeiosOnly (Praos c) a b
forall c a b x.
LeiosOnly (Praos c) a b -> Rep (LeiosOnly (Praos c) a b) x
$cfrom :: forall c a b x.
LeiosOnly (Praos c) a b -> Rep (LeiosOnly (Praos c) a b) x
from :: forall x.
LeiosOnly (Praos c) a b -> Rep (LeiosOnly (Praos c) a b) x
$cto :: forall c a b x.
Rep (LeiosOnly (Praos c) a b) x -> LeiosOnly (Praos c) a b
to :: forall x.
Rep (LeiosOnly (Praos c) a b) x -> LeiosOnly (Praos c) a b
Generic, Int -> LeiosOnly (Praos c) a b -> ShowS
[LeiosOnly (Praos c) a b] -> ShowS
LeiosOnly (Praos c) a b -> String
(Int -> LeiosOnly (Praos c) a b -> ShowS)
-> (LeiosOnly (Praos c) a b -> String)
-> ([LeiosOnly (Praos c) a b] -> ShowS)
-> Show (LeiosOnly (Praos c) a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a b. Show a => Int -> LeiosOnly (Praos c) a b -> ShowS
forall c a b. Show a => [LeiosOnly (Praos c) a b] -> ShowS
forall c a b. Show a => LeiosOnly (Praos c) a b -> String
$cshowsPrec :: forall c a b. Show a => Int -> LeiosOnly (Praos c) a b -> ShowS
showsPrec :: Int -> LeiosOnly (Praos c) a b -> ShowS
$cshow :: forall c a b. Show a => LeiosOnly (Praos c) a b -> String
show :: LeiosOnly (Praos c) a b -> String
$cshowList :: forall c a b. Show a => [LeiosOnly (Praos c) a b] -> ShowS
showList :: [LeiosOnly (Praos c) a b] -> ShowS
Show)

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

instance Functor (LeiosOnly (Praos c) a) where
  fmap :: forall a b.
(a -> b) -> LeiosOnly (Praos c) a a -> LeiosOnly (Praos c) a b
fmap a -> b
_ (PraosLacksLeios a
a) = a -> LeiosOnly (Praos c) a b
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios a
a

instance () ~ a => Applicative (LeiosOnly (Praos c) a) where
  pure :: forall a. a -> LeiosOnly (Praos c) a a
pure a
_ = a -> LeiosOnly (Praos c) a a
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()
  PraosLacksLeios () <*> :: forall a b.
LeiosOnly (Praos c) a (a -> b)
-> LeiosOnly (Praos c) a a -> LeiosOnly (Praos c) a b
<*> PraosLacksLeios () = a -> LeiosOnly (Praos c) a b
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()

instance Foldable (LeiosOnly (Praos c) a) where
  foldMap :: forall m a. Monoid m => (a -> m) -> LeiosOnly (Praos c) a a -> m
foldMap a -> m
_ (PraosLacksLeios a
_) = m
forall a. Monoid a => a
mempty

instance Traversable (LeiosOnly (Praos c) a) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> LeiosOnly (Praos c) a a -> f (LeiosOnly (Praos c) a b)
traverse a -> f b
_ (PraosLacksLeios a
a) = LeiosOnly (Praos c) a b -> f (LeiosOnly (Praos c) a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> LeiosOnly (Praos c) a b
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios a
a)

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

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

-- | Static configuration
data instance ConsensusConfig (Praos c) = PraosConfig
  { forall c. ConsensusConfig (Praos c) -> PraosParams
praosParams :: !PraosParams
  , forall c.
ConsensusConfig (Praos c)
-> EpochInfo (Except PastHorizonException)
praosEpochInfo :: !(EpochInfo (Except History.PastHorizonException))
  -- it's useful for this record to be EpochInfo and one other thing,
  -- because the one other thing can then be used as the
  -- PartialConsensConfig in the HFC instance.
  }
  deriving (forall x.
 ConsensusConfig (Praos c) -> Rep (ConsensusConfig (Praos c)) x)
-> (forall x.
    Rep (ConsensusConfig (Praos c)) x -> ConsensusConfig (Praos c))
-> Generic (ConsensusConfig (Praos c))
forall x.
Rep (ConsensusConfig (Praos c)) x -> ConsensusConfig (Praos c)
forall x.
ConsensusConfig (Praos c) -> Rep (ConsensusConfig (Praos c)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (ConsensusConfig (Praos c)) x -> ConsensusConfig (Praos c)
forall c x.
ConsensusConfig (Praos c) -> Rep (ConsensusConfig (Praos c)) x
$cfrom :: forall c x.
ConsensusConfig (Praos c) -> Rep (ConsensusConfig (Praos c)) x
from :: forall x.
ConsensusConfig (Praos c) -> Rep (ConsensusConfig (Praos c)) x
$cto :: forall c x.
Rep (ConsensusConfig (Praos c)) x -> ConsensusConfig (Praos c)
to :: forall x.
Rep (ConsensusConfig (Praos c)) x -> ConsensusConfig (Praos c)
Generic

instance Crypto c => NoThunks (ConsensusConfig (Praos c))

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

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

instance PraosCrypto c => LeiosProtocol (Praos c) where
  getLeiosAnnouncement :: forall (proxy :: * -> *).
proxy (Praos c)
-> ValidateView (Praos c) -> Maybe LeiosAnnouncement
getLeiosAnnouncement = proxy (Praos c)
-> ValidateView (Praos c) -> Maybe LeiosAnnouncement
forall (proxy :: * -> *) p.
proxy p -> ValidateView p -> Maybe LeiosAnnouncement
defaultGetLeiosAnnouncement
  validateLeiosAnnouncement :: ConsensusConfig (Praos c)
-> ValidateView (Praos c)
-> SlotNo
-> Ticked (ChainDepState (Praos c))
-> Except (ValidationErr (Praos c)) OCINStaleness
validateLeiosAnnouncement = ConsensusConfig (Praos c)
-> ValidateView (Praos c)
-> SlotNo
-> Ticked (ChainDepState (Praos c))
-> Except (ValidationErr (Praos c)) OCINStaleness
forall p.
ConsensusConfig p
-> ValidateView p
-> SlotNo
-> Ticked (ChainDepState p)
-> Except (ValidationErr p) OCINStaleness
defaultValidateLeiosAnnouncement
  getLeiosLedgerView :: forall (proxy :: * -> *).
proxy (Praos c) -> LedgerView (Praos c) -> Maybe LeiosLedgerView
getLeiosLedgerView = proxy (Praos c) -> LedgerView (Praos c) -> Maybe LeiosLedgerView
forall (proxy :: * -> *) p.
proxy p -> LedgerView p -> Maybe LeiosLedgerView
defaultGetLeiosLedgerView

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

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

  checkIsLeader :: HasCallStack =>
ConsensusConfig (Praos c)
-> CanBeLeader (Praos c)
-> SlotNo
-> Ticked (ChainDepState (Praos c))
-> Maybe (IsLeader (Praos c))
checkIsLeader = PraosParams
-> PraosCanBeLeader c
-> SlotNo
-> Ticked (PolyPraosState (Praos 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 (Praos c))
 -> Maybe (PraosIsLeader c))
-> (ConsensusConfig (Praos c) -> PraosParams)
-> ConsensusConfig (Praos c)
-> PraosCanBeLeader c
-> SlotNo
-> Ticked (PolyPraosState (Praos 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

  tickChainDepState :: ConsensusConfig (Praos c)
-> LedgerView (Praos c)
-> SlotNo
-> ChainDepState (Praos c)
-> Ticked (ChainDepState (Praos c))
tickChainDepState = EpochInfo (Except PastHorizonException)
-> PolyPraosLedgerView (Praos c)
-> SlotNo
-> PolyPraosState (Praos c)
-> Ticked (PolyPraosState (Praos c))
forall proto.
Functor (WhenLeios proto) =>
EpochInfo (Except PastHorizonException)
-> PolyPraosLedgerView proto
-> SlotNo
-> PolyPraosState proto
-> Ticked (PolyPraosState proto)
tickChainDepStatePolyPraos (EpochInfo (Except PastHorizonException)
 -> PolyPraosLedgerView (Praos c)
 -> SlotNo
 -> PolyPraosState (Praos c)
 -> Ticked (PolyPraosState (Praos c)))
-> (ConsensusConfig (Praos c)
    -> EpochInfo (Except PastHorizonException))
-> ConsensusConfig (Praos c)
-> PolyPraosLedgerView (Praos c)
-> SlotNo
-> PolyPraosState (Praos c)
-> Ticked (PolyPraosState (Praos 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

  updateChainDepState :: HasCallStack =>
ConsensusConfig (Praos c)
-> ValidateView (Praos c)
-> SlotNo
-> Ticked (ChainDepState (Praos c))
-> Except (ValidationErr (Praos c)) (ChainDepState (Praos c))
updateChainDepState (PraosConfig PraosParams
prms EpochInfo (Except PastHorizonException)
ei) = PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView (Praos c) c
-> SlotNo
-> Ticked (PolyPraosState (Praos c))
-> Except
     (PolyPraosValidationErr (Praos c) c) (PolyPraosState (Praos 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 (Praos c)
-> ValidateView (Praos c)
-> SlotNo
-> Ticked (ChainDepState (Praos c))
-> ChainDepState (Praos c)
reupdateChainDepState (PraosConfig PraosParams
prms EpochInfo (Except PastHorizonException)
ei) = PraosParams
-> EpochInfo (Except PastHorizonException)
-> PolyPraosValidateView (Praos c) c
-> SlotNo
-> Ticked (PolyPraosState (Praos c))
-> PolyPraosState (Praos 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 Views.ForecastToPolyPraosLedgerView (Praos c) era where
  forecastToPolyPraosLedgerView :: forall (t :: Timeline).
EraForecast era =>
Forecast t era -> PolyPraosLedgerView (Praos 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 (Praos c) LeiosLedgerView
Views.plvLeios = () -> WhenLeios (Praos c) LeiosLedgerView
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()
      }
   where
    cc :: ChainChecksPParams
cc = forall (t :: Timeline) era.
EraForecast era =>
Forecast t era -> ChainChecksPParams
SL.forecastChainChecks @t @era Forecast t era
f

{-------------------------------------------------------------------------------
  Translation
-------------------------------------------------------------------------------}

-- | Crossing between eras that both run this protocol changes nothing.
instance TranslateProto (Praos c) (Praos c) era where
  translateLedgerView :: Proxy (Praos c, Praos c, era)
-> TranslationContext era
-> LedgerView (Praos c)
-> LedgerView (Praos c)
translateLedgerView Proxy (Praos c, Praos c, era)
_prx TranslationContext era
_ctx = LedgerView (Praos c) -> LedgerView (Praos c)
PolyPraosLedgerView (Praos c) -> PolyPraosLedgerView (Praos c)
forall a. a -> a
id
  translateChainDepState :: Proxy (Praos c, Praos c, era)
-> ChainDepState (Praos c) -> ChainDepState (Praos c)
translateChainDepState Proxy (Praos c, Praos c, era)
_ = ChainDepState (Praos c) -> ChainDepState (Praos c)
PolyPraosState (Praos c) -> PolyPraosState (Praos c)
forall a. a -> a
id

{-------------------------------------------------------------------------------
  Translation from transitional Praos
-------------------------------------------------------------------------------}

-- | We can translate between TPraos and Praos, provided:
--
-- - They share the same HASH algorithm
-- - They share the same ADDRHASH algorithm
-- - They share the same DSIGN verification keys
-- - They share the same VRF verification keys
instance TranslateProto (TPraos c) (Praos c) era where
  translateLedgerView :: Proxy (TPraos c, Praos c, era)
-> TranslationContext era
-> LedgerView (TPraos c)
-> LedgerView (Praos c)
translateLedgerView Proxy (TPraos c, Praos c, era)
_prx TranslationContext era
_ctx SL.TPraosLedgerView{PoolDistr
tplvPoolDistr :: PoolDistr
tplvPoolDistr :: TPraosLedgerView -> PoolDistr
SL.tplvPoolDistr, ChainChecksPParams
tplvChainChecks :: ChainChecksPParams
tplvChainChecks :: TPraosLedgerView -> ChainChecksPParams
SL.tplvChainChecks} =
    Views.PraosLedgerView
      { plvPoolDistr :: PoolDistr
Views.plvPoolDistr = PoolDistr
tplvPoolDistr
      , plvMaxHeaderSize :: Word16
Views.plvMaxHeaderSize = ChainChecksPParams -> Word16
SL.ccMaxBHSize ChainChecksPParams
tplvChainChecks
      , plvMaxBodySize :: Word32
Views.plvMaxBodySize = ChainChecksPParams -> Word32
SL.ccMaxBBSize ChainChecksPParams
tplvChainChecks
      , plvProtocolVersion :: ProtVer
Views.plvProtocolVersion = ChainChecksPParams -> ProtVer
SL.ccProtocolVersion ChainChecksPParams
tplvChainChecks
      , plvLeios :: WhenLeios (Praos c) LeiosLedgerView
Views.plvLeios = () -> WhenLeios (Praos c) LeiosLedgerView
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()
      }

  translateChainDepState :: Proxy (TPraos c, Praos c, era)
-> ChainDepState (TPraos c) -> ChainDepState (Praos c)
translateChainDepState Proxy (TPraos c, Praos c, era)
_ ChainDepState (TPraos c)
tpState =
    PraosState
      { praosStateLastSlot :: WithOrigin SlotNo
praosStateLastSlot = TPraosState -> WithOrigin SlotNo
tpraosStateLastSlot ChainDepState (TPraos c)
TPraosState
tpState
      , praosStateOCertCounters :: Map (KeyHash BlockIssuer) Word64
praosStateOCertCounters = (KeyHash BlockIssuer -> KeyHash BlockIssuer)
-> Map (KeyHash BlockIssuer) Word64
-> Map (KeyHash BlockIssuer) Word64
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic KeyHash BlockIssuer -> KeyHash BlockIssuer
forall a b. Coercible a b => a -> b
coerce Map (KeyHash BlockIssuer) Word64
certCounters
      , praosStateEvolvingNonce :: Nonce
praosStateEvolvingNonce = Nonce
evolvingNonce
      , praosStateCandidateNonce :: Nonce
praosStateCandidateNonce = Nonce
candidateNonce
      , praosStateEpochNonce :: Nonce
praosStateEpochNonce = Nonce
epochNonce
      , praosStatePreviousEpochNonce :: Nonce
praosStatePreviousEpochNonce = Nonce
epochNonce -- same as current epoch nonce
      , praosStateLabNonce :: Nonce
praosStateLabNonce = Nonce
csLabNonce
      , praosStateLastEpochBlockNonce :: Nonce
praosStateLastEpochBlockNonce = TicknState -> Nonce
SL.ticknStatePrevHashNonce TicknState
csTickn
      , praosStateLeiosAnnouncement :: WhenLeios (Praos c) (Either WhyNotCertifiable LeiosAnnouncement)
praosStateLeiosAnnouncement = ()
-> WhenLeios (Praos c) (Either WhyNotCertifiable LeiosAnnouncement)
forall c a b. a -> LeiosOnly (Praos c) a b
PraosLacksLeios ()
      }
   where
    SL.ChainDepState{PrtclState
csProtocol :: PrtclState
csProtocol :: ChainDepState -> PrtclState
SL.csProtocol, TicknState
csTickn :: TicknState
csTickn :: ChainDepState -> TicknState
SL.csTickn, Nonce
csLabNonce :: Nonce
csLabNonce :: ChainDepState -> Nonce
SL.csLabNonce} =
      TPraosState -> ChainDepState
tpraosStateChainDepState ChainDepState (TPraos c)
TPraosState
tpState
    SL.PrtclState Map (KeyHash BlockIssuer) Word64
certCounters Nonce
evolvingNonce Nonce
candidateNonce =
      PrtclState
csProtocol
    epochNonce :: Nonce
epochNonce = TicknState -> Nonce
SL.ticknStateEpochNonce TicknState
csTickn

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

instance PraosCrypto c => PraosProtocolSupportsNode (Praos c) where
  type PraosProtocolSupportsNodeCrypto (Praos c) = c

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

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