{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Ledger.Ledger (
ShelleyLedgerError (..)
, ShelleyBasedEra
, ShelleyTip (..)
, shelleyTipToPoint
, shelleyLedgerTipPoint
, ShelleyTransition(..)
, LedgerState (..)
, Ticked(..)
, ShelleyLedgerConfig (..)
, shelleyLedgerGenesis
, mkShelleyLedgerConfig
, shelleyEraParams
, shelleyEraParamsNeverHardForks
, getPParams
, encodeShelleyAnnTip
, decodeShelleyAnnTip
, decodeShelleyLedgerState
, encodeShelleyLedgerState
, encodeShelleyHeaderState
) where
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (decode, encode)
import Control.Monad.Except
import Data.Functor.Identity
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Cardano.Binary (FromCBOR (..), ToCBOR (..), enforceSize)
import Cardano.Slotting.EpochInfo
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.Forecast
import Ouroboros.Consensus.HardFork.Abstract
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.HardFork.History.Util
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.CommonProtocolParams
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Util ((...:), (..:))
import Ouroboros.Consensus.Util.CBOR (decodeWithOrigin,
encodeWithOrigin)
import Ouroboros.Consensus.Util.Versioned
import qualified Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.STS.Chain as SL (PredicateFailure)
import Ouroboros.Consensus.Shelley.Eras (EraCrypto)
import Ouroboros.Consensus.Shelley.Ledger.Block
import Ouroboros.Consensus.Shelley.Ledger.Config
import Ouroboros.Consensus.Shelley.Ledger.TPraos ()
import Ouroboros.Consensus.Shelley.Protocol (MaxMajorProtVer (..),
Ticked (TickedPraosLedgerView))
import Ouroboros.Consensus.Shelley.Protocol.Util (isNewEpoch)
newtype ShelleyLedgerError era = BBodyError (SL.BlockTransitionError era)
deriving ((forall x.
ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x)
-> (forall x.
Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era)
-> Generic (ShelleyLedgerError era)
forall x. Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
forall x. ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
forall era x.
ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
$cto :: forall era x.
Rep (ShelleyLedgerError era) x -> ShelleyLedgerError era
$cfrom :: forall era x.
ShelleyLedgerError era -> Rep (ShelleyLedgerError era) x
Generic)
deriving instance ShelleyBasedEra era => Eq (ShelleyLedgerError era)
deriving instance ShelleyBasedEra era => Show (ShelleyLedgerError era)
instance ShelleyBasedEra era => NoThunks (ShelleyLedgerError era)
data ShelleyLedgerConfig era = ShelleyLedgerConfig {
ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis :: !(CompactGenesis era)
, ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals :: !SL.Globals
}
deriving ((forall x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x)
-> (forall x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era)
-> Generic (ShelleyLedgerConfig era)
forall x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
forall x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
forall era x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
$cto :: forall era x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
$cfrom :: forall era x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
Generic, Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
Proxy (ShelleyLedgerConfig era) -> String
(Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyLedgerConfig era) -> String)
-> NoThunks (ShelleyLedgerConfig era)
forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
forall era.
ShelleyBasedEra era =>
Proxy (ShelleyLedgerConfig era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ShelleyLedgerConfig era) -> String
$cshowTypeOf :: forall era.
ShelleyBasedEra era =>
Proxy (ShelleyLedgerConfig era) -> String
wNoThunks :: Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
ShelleyBasedEra era =>
Context -> ShelleyLedgerConfig era -> IO (Maybe ThunkInfo)
NoThunks)
shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis era
shelleyLedgerGenesis :: ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis = CompactGenesis era -> ShelleyGenesis era
forall era. CompactGenesis era -> ShelleyGenesis era
getCompactGenesis (CompactGenesis era -> ShelleyGenesis era)
-> (ShelleyLedgerConfig era -> CompactGenesis era)
-> ShelleyLedgerConfig era
-> ShelleyGenesis era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> CompactGenesis era
forall era. ShelleyLedgerConfig era -> CompactGenesis era
shelleyLedgerCompactGenesis
shelleyEraParams ::
HardFork.SafeBeforeEpoch
-> SL.ShelleyGenesis era
-> HardFork.EraParams
shelleyEraParams :: SafeBeforeEpoch -> ShelleyGenesis era -> EraParams
shelleyEraParams SafeBeforeEpoch
safeBeforeEpoch ShelleyGenesis era
genesis = EraParams :: EpochSize -> SlotLength -> SafeZone -> EraParams
HardFork.EraParams {
eraEpochSize :: EpochSize
eraEpochSize = ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis era
genesis
, eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis
, eraSafeZone :: SafeZone
eraSafeZone = Word64 -> SafeBeforeEpoch -> SafeZone
HardFork.StandardSafeZone
Word64
stabilityWindow
SafeBeforeEpoch
safeBeforeEpoch
}
where
stabilityWindow :: Word64
stabilityWindow =
Word64 -> ActiveSlotCoeff -> Word64
SL.computeStabilityWindow
(ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSecurityParam ShelleyGenesis era
genesis)
(ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
SL.sgActiveSlotCoeff ShelleyGenesis era
genesis)
shelleyEraParamsNeverHardForks :: SL.ShelleyGenesis era -> HardFork.EraParams
shelleyEraParamsNeverHardForks :: ShelleyGenesis era -> EraParams
shelleyEraParamsNeverHardForks ShelleyGenesis era
genesis = EraParams :: EpochSize -> SlotLength -> SafeZone -> EraParams
HardFork.EraParams {
eraEpochSize :: EpochSize
eraEpochSize = ShelleyGenesis era -> EpochSize
forall era. ShelleyGenesis era -> EpochSize
SL.sgEpochLength ShelleyGenesis era
genesis
, eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> NominalDiffTime
forall era. ShelleyGenesis era -> NominalDiffTime
SL.sgSlotLength ShelleyGenesis era
genesis
, eraSafeZone :: SafeZone
eraSafeZone = SafeZone
HardFork.UnsafeIndefiniteSafeZone
}
mkShelleyLedgerConfig
:: SL.ShelleyGenesis era
-> EpochInfo Identity
-> MaxMajorProtVer
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig :: ShelleyGenesis era
-> EpochInfo Identity -> MaxMajorProtVer -> ShelleyLedgerConfig era
mkShelleyLedgerConfig ShelleyGenesis era
genesis EpochInfo Identity
epochInfo (MaxMajorProtVer Natural
maxMajorPV) =
ShelleyLedgerConfig :: forall era.
CompactGenesis era -> Globals -> ShelleyLedgerConfig era
ShelleyLedgerConfig {
shelleyLedgerCompactGenesis :: CompactGenesis era
shelleyLedgerCompactGenesis = ShelleyGenesis era -> CompactGenesis era
forall era. ShelleyGenesis era -> CompactGenesis era
compactGenesis ShelleyGenesis era
genesis
, shelleyLedgerGlobals :: Globals
shelleyLedgerGlobals = ShelleyGenesis era -> EpochInfo Identity -> Natural -> Globals
forall era.
ShelleyGenesis era -> EpochInfo Identity -> Natural -> Globals
SL.mkShelleyGlobals ShelleyGenesis era
genesis EpochInfo Identity
epochInfo Natural
maxMajorPV
}
type instance LedgerCfg (LedgerState (ShelleyBlock era)) = ShelleyLedgerConfig era
data ShelleyTip era = ShelleyTip {
ShelleyTip era -> SlotNo
shelleyTipSlotNo :: !SlotNo
, ShelleyTip era -> BlockNo
shelleyTipBlockNo :: !BlockNo
, ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash :: !(HeaderHash (ShelleyBlock era))
}
deriving (ShelleyTip era -> ShelleyTip era -> Bool
(ShelleyTip era -> ShelleyTip era -> Bool)
-> (ShelleyTip era -> ShelleyTip era -> Bool)
-> Eq (ShelleyTip era)
forall era. ShelleyTip era -> ShelleyTip era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyTip era -> ShelleyTip era -> Bool
$c/= :: forall era. ShelleyTip era -> ShelleyTip era -> Bool
== :: ShelleyTip era -> ShelleyTip era -> Bool
$c== :: forall era. ShelleyTip era -> ShelleyTip era -> Bool
Eq, Int -> ShelleyTip era -> ShowS
[ShelleyTip era] -> ShowS
ShelleyTip era -> String
(Int -> ShelleyTip era -> ShowS)
-> (ShelleyTip era -> String)
-> ([ShelleyTip era] -> ShowS)
-> Show (ShelleyTip era)
forall era. Int -> ShelleyTip era -> ShowS
forall era. [ShelleyTip era] -> ShowS
forall era. ShelleyTip era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTip era] -> ShowS
$cshowList :: forall era. [ShelleyTip era] -> ShowS
show :: ShelleyTip era -> String
$cshow :: forall era. ShelleyTip era -> String
showsPrec :: Int -> ShelleyTip era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyTip era -> ShowS
Show, (forall x. ShelleyTip era -> Rep (ShelleyTip era) x)
-> (forall x. Rep (ShelleyTip era) x -> ShelleyTip era)
-> Generic (ShelleyTip era)
forall x. Rep (ShelleyTip era) x -> ShelleyTip era
forall x. ShelleyTip era -> Rep (ShelleyTip era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTip era) x -> ShelleyTip era
forall era x. ShelleyTip era -> Rep (ShelleyTip era) x
$cto :: forall era x. Rep (ShelleyTip era) x -> ShelleyTip era
$cfrom :: forall era x. ShelleyTip era -> Rep (ShelleyTip era) x
Generic, Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
Proxy (ShelleyTip era) -> String
(Context -> ShelleyTip era -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyTip era -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyTip era) -> String)
-> NoThunks (ShelleyTip era)
forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
forall era. Proxy (ShelleyTip era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ShelleyTip era) -> String
$cshowTypeOf :: forall era. Proxy (ShelleyTip era) -> String
wNoThunks :: Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> ShelleyTip era -> IO (Maybe ThunkInfo)
NoThunks)
shelleyTipToPoint :: WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint :: WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint WithOrigin (ShelleyTip era)
Origin = Point (ShelleyBlock era)
forall block. Point block
GenesisPoint
shelleyTipToPoint (NotOrigin ShelleyTip era
tip) = SlotNo -> HeaderHash (ShelleyBlock era) -> Point (ShelleyBlock era)
forall block. SlotNo -> HeaderHash block -> Point block
BlockPoint (ShelleyTip era -> SlotNo
forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo ShelleyTip era
tip)
(ShelleyTip era -> HeaderHash (ShelleyBlock era)
forall era. ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash ShelleyTip era
tip)
data instance LedgerState (ShelleyBlock era) = ShelleyLedgerState {
LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
shelleyLedgerTip :: !(WithOrigin (ShelleyTip era))
, LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState :: !(SL.NewEpochState era)
, LedgerState (ShelleyBlock era) -> ShelleyTransition
shelleyLedgerTransition :: !ShelleyTransition
}
deriving ((forall x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x)
-> (forall x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era))
-> Generic (LedgerState (ShelleyBlock era))
forall x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
forall x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
forall era x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
$cto :: forall era x.
Rep (LedgerState (ShelleyBlock era)) x
-> LedgerState (ShelleyBlock era)
$cfrom :: forall era x.
LedgerState (ShelleyBlock era)
-> Rep (LedgerState (ShelleyBlock era)) x
Generic, Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
Proxy (LedgerState (ShelleyBlock era)) -> String
(Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Context
-> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState (ShelleyBlock era)) -> String)
-> NoThunks (LedgerState (ShelleyBlock era))
forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
forall era. Proxy (LedgerState (ShelleyBlock era)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (LedgerState (ShelleyBlock era)) -> String
$cshowTypeOf :: forall era. Proxy (LedgerState (ShelleyBlock era)) -> String
wNoThunks :: Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> LedgerState (ShelleyBlock era) -> IO (Maybe ThunkInfo)
NoThunks)
deriving instance ShelleyBasedEra era => Show (LedgerState (ShelleyBlock era))
deriving instance ShelleyBasedEra era => Eq (LedgerState (ShelleyBlock era))
newtype ShelleyTransition = ShelleyTransitionInfo {
ShelleyTransition -> Word32
shelleyAfterVoting :: Word32
}
deriving stock (ShelleyTransition -> ShelleyTransition -> Bool
(ShelleyTransition -> ShelleyTransition -> Bool)
-> (ShelleyTransition -> ShelleyTransition -> Bool)
-> Eq ShelleyTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyTransition -> ShelleyTransition -> Bool
$c/= :: ShelleyTransition -> ShelleyTransition -> Bool
== :: ShelleyTransition -> ShelleyTransition -> Bool
$c== :: ShelleyTransition -> ShelleyTransition -> Bool
Eq, Int -> ShelleyTransition -> ShowS
[ShelleyTransition] -> ShowS
ShelleyTransition -> String
(Int -> ShelleyTransition -> ShowS)
-> (ShelleyTransition -> String)
-> ([ShelleyTransition] -> ShowS)
-> Show ShelleyTransition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTransition] -> ShowS
$cshowList :: [ShelleyTransition] -> ShowS
show :: ShelleyTransition -> String
$cshow :: ShelleyTransition -> String
showsPrec :: Int -> ShelleyTransition -> ShowS
$cshowsPrec :: Int -> ShelleyTransition -> ShowS
Show, (forall x. ShelleyTransition -> Rep ShelleyTransition x)
-> (forall x. Rep ShelleyTransition x -> ShelleyTransition)
-> Generic ShelleyTransition
forall x. Rep ShelleyTransition x -> ShelleyTransition
forall x. ShelleyTransition -> Rep ShelleyTransition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShelleyTransition x -> ShelleyTransition
$cfrom :: forall x. ShelleyTransition -> Rep ShelleyTransition x
Generic)
deriving newtype (Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
Proxy ShelleyTransition -> String
(Context -> ShelleyTransition -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyTransition -> IO (Maybe ThunkInfo))
-> (Proxy ShelleyTransition -> String)
-> NoThunks ShelleyTransition
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ShelleyTransition -> String
$cshowTypeOf :: Proxy ShelleyTransition -> String
wNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
NoThunks)
shelleyLedgerTipPoint :: LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint :: LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint = WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
forall era. WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint (WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era))
-> (LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era))
-> LedgerState (ShelleyBlock era)
-> Point (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
forall era.
LedgerState (ShelleyBlock era) -> WithOrigin (ShelleyTip era)
shelleyLedgerTip
instance ShelleyBasedEra era => UpdateLedger (ShelleyBlock era)
instance GetTip (LedgerState (ShelleyBlock era)) where
getTip :: LedgerState (ShelleyBlock era)
-> Point (LedgerState (ShelleyBlock era))
getTip = Point (ShelleyBlock era) -> Point (LedgerState (ShelleyBlock era))
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock era)
-> Point (LedgerState (ShelleyBlock era)))
-> (LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
-> Point (LedgerState (ShelleyBlock era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
forall era.
LedgerState (ShelleyBlock era) -> Point (ShelleyBlock era)
shelleyLedgerTipPoint
instance GetTip (Ticked (LedgerState (ShelleyBlock era))) where
getTip :: Ticked (LedgerState (ShelleyBlock era))
-> Point (Ticked (LedgerState (ShelleyBlock era)))
getTip = Point (ShelleyBlock era)
-> Point (Ticked (LedgerState (ShelleyBlock era)))
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock era)
-> Point (Ticked (LedgerState (ShelleyBlock era))))
-> (Ticked (LedgerState (ShelleyBlock era))
-> Point (ShelleyBlock era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Point (Ticked (LedgerState (ShelleyBlock era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
forall era.
Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint
data instance Ticked (LedgerState (ShelleyBlock era)) = TickedShelleyLedgerState {
Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip :: !(WithOrigin (ShelleyTip era))
, Ticked (LedgerState (ShelleyBlock era)) -> ShelleyTransition
tickedShelleyLedgerTransition :: !ShelleyTransition
, Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
tickedShelleyLedgerState :: !(SL.NewEpochState era)
}
deriving ((forall x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x)
-> (forall x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era)))
-> Generic (Ticked (LedgerState (ShelleyBlock era)))
forall x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
forall x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
forall era x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
$cto :: forall era x.
Rep (Ticked (LedgerState (ShelleyBlock era))) x
-> Ticked (LedgerState (ShelleyBlock era))
$cfrom :: forall era x.
Ticked (LedgerState (ShelleyBlock era))
-> Rep (Ticked (LedgerState (ShelleyBlock era))) x
Generic, Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
(Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String)
-> NoThunks (Ticked (LedgerState (ShelleyBlock era)))
forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
forall era.
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
$cshowTypeOf :: forall era.
Proxy (Ticked (LedgerState (ShelleyBlock era))) -> String
wNoThunks :: Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context
-> Ticked (LedgerState (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
NoThunks)
untickedShelleyLedgerTipPoint ::
Ticked (LedgerState (ShelleyBlock era))
-> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint :: Ticked (LedgerState (ShelleyBlock era)) -> Point (ShelleyBlock era)
untickedShelleyLedgerTipPoint = WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
forall era. WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era)
shelleyTipToPoint (WithOrigin (ShelleyTip era) -> Point (ShelleyBlock era))
-> (Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Point (ShelleyBlock era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
forall era.
Ticked (LedgerState (ShelleyBlock era))
-> WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip
instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock era)) where
type LedgerErr (LedgerState (ShelleyBlock era)) = ShelleyLedgerError era
applyChainTick :: LedgerCfg (LedgerState (ShelleyBlock era))
-> SlotNo
-> LedgerState (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
applyChainTick LedgerCfg (LedgerState (ShelleyBlock era))
cfg SlotNo
slotNo ShelleyLedgerState{
shelleyLedgerTip
, shelleyLedgerState
, shelleyLedgerTransition
} =
TickedShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> ShelleyTransition
-> NewEpochState era
-> Ticked (LedgerState (ShelleyBlock era))
TickedShelleyLedgerState {
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip era)
untickedShelleyLedgerTip =
WithOrigin (ShelleyTip era)
shelleyLedgerTip
, tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition =
if EpochInfo Identity -> WithOrigin SlotNo -> SlotNo -> Bool
isNewEpoch EpochInfo Identity
ei (ShelleyTip era -> SlotNo
forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo (ShelleyTip era -> SlotNo)
-> WithOrigin (ShelleyTip era) -> WithOrigin SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin (ShelleyTip era)
shelleyLedgerTip) SlotNo
slotNo then
ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo { shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0 }
else
ShelleyTransition
shelleyLedgerTransition
, tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState =
Globals -> NewEpochState era -> SlotNo -> NewEpochState era
forall era.
ApplyBlock era =>
Globals -> NewEpochState era -> SlotNo -> NewEpochState era
SL.applyTick
Globals
globals
NewEpochState era
shelleyLedgerState
SlotNo
slotNo
}
where
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerCfg (LedgerState (ShelleyBlock era))
ShelleyLedgerConfig era
cfg
ei :: EpochInfo Identity
ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfo Globals
globals
instance ShelleyBasedEra era
=> ApplyBlock (LedgerState (ShelleyBlock era)) (ShelleyBlock era) where
applyLedgerBlock :: LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
(LedgerErr (LedgerState (ShelleyBlock era)))
(LedgerState (ShelleyBlock era))
applyLedgerBlock =
(Globals
-> NewEpochState era
-> Block era
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> ExceptT
(ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era))
forall era (m :: * -> *).
(ShelleyBasedEra era, Monad m) =>
(Globals
-> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper ((Globals
-> NewEpochState era
-> Block era
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> ExceptT
(ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era)))
-> (Globals
-> NewEpochState era
-> Block era
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> ExceptT
(ShelleyLedgerError era) Identity (LedgerState (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$
(BlockTransitionError era -> ShelleyLedgerError era)
-> Except (BlockTransitionError era) (NewEpochState era)
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept BlockTransitionError era -> ShelleyLedgerError era
forall era. BlockTransitionError era -> ShelleyLedgerError era
BBodyError (Except (BlockTransitionError era) (NewEpochState era)
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era))
-> (Globals
-> NewEpochState era
-> Block era
-> Except (BlockTransitionError era) (NewEpochState era))
-> Globals
-> NewEpochState era
-> Block era
-> ExceptT (ShelleyLedgerError era) Identity (NewEpochState era)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Globals
-> NewEpochState era
-> Block era
-> Except (BlockTransitionError era) (NewEpochState era)
forall era (m :: * -> *).
(ApplyBlock era, MonadError (BlockTransitionError era) m) =>
Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
SL.applyBlock
reapplyLedgerBlock :: LedgerCfg (LedgerState (ShelleyBlock era))
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
reapplyLedgerBlock = Identity (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall a. Identity a -> a
runIdentity (Identity (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era))
-> ((Globals
-> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> Identity (LedgerState (ShelleyBlock era)))
-> (Globals
-> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall y z x0 x1 x2 x3.
(y -> z)
-> (x0 -> x1 -> x2 -> x3 -> y) -> x0 -> x1 -> x2 -> x3 -> z
...:
(Globals
-> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> Identity (LedgerState (ShelleyBlock era))
forall era (m :: * -> *).
(ShelleyBasedEra era, Monad m) =>
(Globals
-> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper ((Globals
-> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era))
-> (Globals
-> NewEpochState era -> Block era -> Identity (NewEpochState era))
-> ShelleyLedgerConfig era
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerState (ShelleyBlock era)
forall a b. (a -> b) -> a -> b
$
NewEpochState era -> Identity (NewEpochState era)
forall a. a -> Identity a
Identity (NewEpochState era -> Identity (NewEpochState era))
-> (Globals -> NewEpochState era -> Block era -> NewEpochState era)
-> Globals
-> NewEpochState era
-> Block era
-> Identity (NewEpochState era)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Globals -> NewEpochState era -> Block era -> NewEpochState era
forall era.
ApplyBlock era =>
Globals -> NewEpochState era -> Block era -> NewEpochState era
SL.reapplyBlock
applyHelper ::
(ShelleyBasedEra era, Monad m)
=> (SL.Globals -> SL.NewEpochState era -> SL.Block era -> m (SL.NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper :: (Globals
-> NewEpochState era -> Block era -> m (NewEpochState era))
-> LedgerConfig (ShelleyBlock era)
-> ShelleyBlock era
-> Ticked (LedgerState (ShelleyBlock era))
-> m (LedgerState (ShelleyBlock era))
applyHelper Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
f LedgerConfig (ShelleyBlock era)
cfg ShelleyBlock era
blk TickedShelleyLedgerState{
tickedShelleyLedgerTransition
, tickedShelleyLedgerState
} = do
NewEpochState era
newNewEpochState <- Globals -> NewEpochState era -> Block era -> m (NewEpochState era)
f Globals
globals NewEpochState era
tickedShelleyLedgerState (ShelleyBlock era -> Block era
forall era. ShelleyBlock era -> Block era
shelleyBlockRaw ShelleyBlock era
blk)
LedgerState (ShelleyBlock era)
-> m (LedgerState (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock era)
ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip = ShelleyTip era -> WithOrigin (ShelleyTip era)
forall t. t -> WithOrigin t
NotOrigin ShelleyTip :: forall era.
SlotNo
-> BlockNo -> HeaderHash (ShelleyBlock era) -> ShelleyTip era
ShelleyTip {
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = ShelleyBlock era -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo ShelleyBlock era
blk
, shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo = ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk
, shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash = ShelleyBlock era -> HeaderHash (ShelleyBlock era)
forall b. HasHeader b => b -> HeaderHash b
blockHash ShelleyBlock era
blk
}
, shelleyLedgerState :: NewEpochState era
shelleyLedgerState =
NewEpochState era
newNewEpochState
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo {
shelleyAfterVoting :: Word32
shelleyAfterVoting =
(if ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
>= SlotNo
votingDeadline then Word32 -> Word32
forall a. Enum a => a -> a
succ else Word32 -> Word32
forall a. a -> a
id) (Word32 -> Word32) -> Word32 -> Word32
forall a b. (a -> b) -> a -> b
$
ShelleyTransition -> Word32
shelleyAfterVoting ShelleyTransition
tickedShelleyLedgerTransition
}
}
where
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
cfg
swindow :: Word64
swindow = Globals -> Word64
SL.stabilityWindow Globals
globals
ei :: EpochInfo Identity
ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfo Globals
globals
startOfNextEpoch :: SlotNo
startOfNextEpoch :: SlotNo
startOfNextEpoch = Identity SlotNo -> SlotNo
forall a. Identity a -> a
runIdentity (Identity SlotNo -> SlotNo) -> Identity SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$ do
EpochNo
blockEpoch <- EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei (ShelleyBlock era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock era
blk)
let nextEpoch :: EpochNo
nextEpoch = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
blockEpoch
EpochInfo Identity -> EpochNo -> Identity SlotNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m SlotNo
epochInfoFirst EpochInfo Identity
ei EpochNo
nextEpoch
votingDeadline :: SlotNo
votingDeadline :: SlotNo
votingDeadline = Word64 -> SlotNo -> SlotNo
subSlots (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
swindow) SlotNo
startOfNextEpoch
instance ShelleyBasedEra era
=> LedgerSupportsProtocol (ShelleyBlock era) where
protocolLedgerView :: LedgerConfig (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Ticked (LedgerView (BlockProtocol (ShelleyBlock era)))
protocolLedgerView LedgerConfig (ShelleyBlock era)
_cfg = LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView
(LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> (Ticked (LedgerState (ShelleyBlock era))
-> LedgerView (Crypto era))
-> Ticked (LedgerState (ShelleyBlock era))
-> Ticked (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> LedgerView (Crypto era)
forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (Crypto era)
SL.currentLedgerView
(NewEpochState era -> LedgerView (Crypto era))
-> (Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era)
-> Ticked (LedgerState (ShelleyBlock era))
-> LedgerView (Crypto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
forall era.
Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
tickedShelleyLedgerState
ledgerViewForecastAt :: LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Forecast (LedgerView (BlockProtocol (ShelleyBlock era)))
ledgerViewForecastAt LedgerConfig (ShelleyBlock era)
cfg LedgerState (ShelleyBlock era)
ledgerState = WithOrigin SlotNo
-> (SlotNo
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Forecast (LedgerView (Crypto era))
forall a.
WithOrigin SlotNo
-> (SlotNo -> Except OutsideForecastRange (Ticked a)) -> Forecast a
Forecast WithOrigin SlotNo
at ((SlotNo
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Forecast (LedgerView (Crypto era)))
-> (SlotNo
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Forecast (LedgerView (Crypto era))
forall a b. (a -> b) -> a -> b
$ \SlotNo
for -> if
| SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
for WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== WithOrigin SlotNo
at ->
Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView (LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall a b. (a -> b) -> a -> b
$ NewEpochState era -> LedgerView (Crypto era)
forall era.
GetLedgerView era =>
NewEpochState era -> LedgerView (Crypto era)
SL.currentLedgerView NewEpochState era
shelleyLedgerState
| SlotNo
for SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo
maxFor ->
Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> Ticked (LedgerView (Crypto era))
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ SlotNo -> Ticked (LedgerView (Crypto era))
futureLedgerView SlotNo
for
| Bool
otherwise ->
OutsideForecastRange
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (OutsideForecastRange
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era))))
-> OutsideForecastRange
-> Except OutsideForecastRange (Ticked (LedgerView (Crypto era)))
forall a b. (a -> b) -> a -> b
$ OutsideForecastRange :: WithOrigin SlotNo -> SlotNo -> SlotNo -> OutsideForecastRange
OutsideForecastRange {
outsideForecastAt :: WithOrigin SlotNo
outsideForecastAt = WithOrigin SlotNo
at
, outsideForecastMaxFor :: SlotNo
outsideForecastMaxFor = SlotNo
maxFor
, outsideForecastFor :: SlotNo
outsideForecastFor = SlotNo
for
}
where
ShelleyLedgerState { shelleyLedgerState } = LedgerState (ShelleyBlock era)
ledgerState
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
cfg
swindow :: Word64
swindow = Globals -> Word64
SL.stabilityWindow Globals
globals
at :: WithOrigin SlotNo
at = LedgerState (ShelleyBlock era) -> WithOrigin SlotNo
forall blk.
UpdateLedger blk =>
LedgerState blk -> WithOrigin SlotNo
ledgerTipSlot LedgerState (ShelleyBlock era)
ledgerState
futureLedgerView :: SlotNo -> Ticked (SL.LedgerView (EraCrypto era))
futureLedgerView :: SlotNo -> Ticked (LedgerView (Crypto era))
futureLedgerView =
(FutureLedgerViewError era -> Ticked (LedgerView (Crypto era)))
-> (LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era)))
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
-> Ticked (LedgerView (Crypto era))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\FutureLedgerViewError era
e -> String -> Ticked (LedgerView (Crypto era))
forall a. HasCallStack => String -> a
error (String
"futureLedgerView failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> FutureLedgerViewError era -> String
forall a. Show a => a -> String
show FutureLedgerViewError era
e))
LedgerView (Crypto era) -> Ticked (LedgerView (Crypto era))
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView
(Either (FutureLedgerViewError era) (LedgerView (Crypto era))
-> Ticked (LedgerView (Crypto era)))
-> (SlotNo
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era)))
-> SlotNo
-> Ticked (LedgerView (Crypto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Globals
-> NewEpochState era
-> SlotNo
-> Either (FutureLedgerViewError era) (LedgerView (Crypto era))
forall era (m :: * -> *).
(GetLedgerView era, MonadError (FutureLedgerViewError era) m) =>
Globals
-> NewEpochState era -> SlotNo -> m (LedgerView (Crypto era))
SL.futureLedgerView Globals
globals NewEpochState era
shelleyLedgerState
maxFor :: SlotNo
maxFor :: SlotNo
maxFor = Word64 -> SlotNo -> SlotNo
addSlots Word64
swindow (SlotNo -> SlotNo) -> SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$ WithOrigin SlotNo -> SlotNo
forall t. (Bounded t, Enum t) => WithOrigin t -> t
succWithOrigin WithOrigin SlotNo
at
instance HasHardForkHistory (ShelleyBlock era) where
type HardForkIndices (ShelleyBlock era) = '[ShelleyBlock era]
hardForkSummary :: LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary (HardForkIndices (ShelleyBlock era))
hardForkSummary = (LedgerConfig (ShelleyBlock era) -> EraParams)
-> LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary '[ShelleyBlock era]
forall blk.
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk -> Summary '[blk]
neverForksHardForkSummary ((LedgerConfig (ShelleyBlock era) -> EraParams)
-> LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary '[ShelleyBlock era])
-> (LedgerConfig (ShelleyBlock era) -> EraParams)
-> LedgerConfig (ShelleyBlock era)
-> LedgerState (ShelleyBlock era)
-> Summary '[ShelleyBlock era]
forall a b. (a -> b) -> a -> b
$
ShelleyGenesis era -> EraParams
forall era. ShelleyGenesis era -> EraParams
shelleyEraParamsNeverHardForks (ShelleyGenesis era -> EraParams)
-> (ShelleyLedgerConfig era -> ShelleyGenesis era)
-> ShelleyLedgerConfig era
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> ShelleyGenesis era
forall era. ShelleyLedgerConfig era -> ShelleyGenesis era
shelleyLedgerGenesis
instance ShelleyBasedEra era
=> CommonProtocolParams (ShelleyBlock era) where
maxHeaderSize :: LedgerState (ShelleyBlock era) -> Word32
maxHeaderSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState (ShelleyBlock era) -> Natural)
-> LedgerState (ShelleyBlock era)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams' Identity era -> Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
SL._maxBHSize (PParams' Identity era -> Natural)
-> (LedgerState (ShelleyBlock era) -> PParams' Identity era)
-> LedgerState (ShelleyBlock era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams' Identity era
forall era. NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams' Identity era)
-> (LedgerState (ShelleyBlock era) -> NewEpochState era)
-> LedgerState (ShelleyBlock era)
-> PParams' Identity era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState
maxTxSize :: LedgerState (ShelleyBlock era) -> Word32
maxTxSize = Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word32)
-> (LedgerState (ShelleyBlock era) -> Natural)
-> LedgerState (ShelleyBlock era)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PParams' Identity era -> Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
SL._maxTxSize (PParams' Identity era -> Natural)
-> (LedgerState (ShelleyBlock era) -> PParams' Identity era)
-> LedgerState (ShelleyBlock era)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams' Identity era
forall era. NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams' Identity era)
-> (LedgerState (ShelleyBlock era) -> NewEpochState era)
-> LedgerState (ShelleyBlock era)
-> PParams' Identity era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock era) -> NewEpochState era
forall era. LedgerState (ShelleyBlock era) -> NewEpochState era
shelleyLedgerState
instance ShelleyBasedEra era => BasicEnvelopeValidation (ShelleyBlock era) where
instance ShelleyBasedEra era => ValidateEnvelope (ShelleyBlock era) where
type (ShelleyBlock era) =
SL.PredicateFailure (SL.CHAIN era)
additionalEnvelopeChecks :: TopLevelConfig (ShelleyBlock era)
-> Ticked (LedgerView (BlockProtocol (ShelleyBlock era)))
-> Header (ShelleyBlock era)
-> Except (OtherHeaderEnvelopeError (ShelleyBlock era)) ()
additionalEnvelopeChecks TopLevelConfig (ShelleyBlock era)
cfg (TickedPraosLedgerView ledgerView) Header (ShelleyBlock era)
hdr =
Globals
-> ChainChecksData
-> BHeader (Crypto era)
-> ExceptT (ChainPredicateFailure era) Identity ()
forall era (m :: * -> *).
(Era era, MonadError (PredicateFailure (CHAIN era)) m) =>
Globals -> ChainChecksData -> BHeader (Crypto era) -> m ()
SL.chainChecks Globals
globals (LedgerView (Crypto era) -> ChainChecksData
forall crypto. LedgerView crypto -> ChainChecksData
SL.lvChainChecks LedgerView (Crypto era)
ledgerView) (Header (ShelleyBlock era) -> BHeader (Crypto era)
forall era. Header (ShelleyBlock era) -> BHeader (EraCrypto era)
shelleyHeaderRaw Header (ShelleyBlock era)
hdr)
where
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals (TopLevelConfig (ShelleyBlock era)
-> LedgerConfig (ShelleyBlock era)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger TopLevelConfig (ShelleyBlock era)
cfg)
getPParams :: SL.NewEpochState era -> SL.PParams era
getPParams :: NewEpochState era -> PParams era
getPParams = EpochState era -> PParams era
forall era. EpochState era -> PParams era
SL.esPp (EpochState era -> PParams era)
-> (NewEpochState era -> EpochState era)
-> NewEpochState era
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 = VersionNumber
2
encodeShelleyAnnTip ::
ShelleyBasedEra era
=> AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip :: AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip = (HeaderHash (ShelleyBlock era) -> Encoding)
-> AnnTip (ShelleyBlock era) -> Encoding
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
defaultEncodeAnnTip HeaderHash (ShelleyBlock era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
decodeShelleyAnnTip ::
ShelleyBasedEra era
=> Decoder s (AnnTip (ShelleyBlock era))
decodeShelleyAnnTip :: Decoder s (AnnTip (ShelleyBlock era))
decodeShelleyAnnTip = (forall s. Decoder s (HeaderHash (ShelleyBlock era)))
-> forall s. Decoder s (AnnTip (ShelleyBlock era))
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
defaultDecodeAnnTip forall s. Decoder s (HeaderHash (ShelleyBlock era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
encodeShelleyHeaderState ::
ShelleyBasedEra era
=> HeaderState (ShelleyBlock era)
-> Encoding
= (ChainDepState (BlockProtocol (ShelleyBlock era)) -> Encoding)
-> (AnnTip (ShelleyBlock era) -> Encoding)
-> HeaderState (ShelleyBlock era)
-> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
ChainDepState (BlockProtocol (ShelleyBlock era)) -> Encoding
forall a. Serialise a => a -> Encoding
encode
AnnTip (ShelleyBlock era) -> Encoding
forall era.
ShelleyBasedEra era =>
AnnTip (ShelleyBlock era) -> Encoding
encodeShelleyAnnTip
encodeShelleyTip :: ShelleyBasedEra era => ShelleyTip era -> Encoding
encodeShelleyTip :: ShelleyTip era -> Encoding
encodeShelleyTip ShelleyTip {
SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo :: forall era. ShelleyTip era -> SlotNo
shelleyTipSlotNo
, BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo :: forall era. ShelleyTip era -> BlockNo
shelleyTipBlockNo
, HeaderHash (ShelleyBlock era)
shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash :: forall era. ShelleyTip era -> HeaderHash (ShelleyBlock era)
shelleyTipHash
} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word -> Encoding
CBOR.encodeListLen Word
3
, SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotNo
shelleyTipSlotNo
, BlockNo -> Encoding
forall a. Serialise a => a -> Encoding
encode BlockNo
shelleyTipBlockNo
, ShelleyHash (Crypto era) -> Encoding
forall a. Serialise a => a -> Encoding
encode HeaderHash (ShelleyBlock era)
ShelleyHash (Crypto era)
shelleyTipHash
]
decodeShelleyTip :: ShelleyBasedEra era => Decoder s (ShelleyTip era)
decodeShelleyTip :: Decoder s (ShelleyTip era)
decodeShelleyTip = do
Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ShelleyTip" Int
3
SlotNo
shelleyTipSlotNo <- Decoder s SlotNo
forall a s. Serialise a => Decoder s a
decode
BlockNo
shelleyTipBlockNo <- Decoder s BlockNo
forall a s. Serialise a => Decoder s a
decode
ShelleyHash (Crypto era)
shelleyTipHash <- Decoder s (ShelleyHash (Crypto era))
forall a s. Serialise a => Decoder s a
decode
ShelleyTip era -> Decoder s (ShelleyTip era)
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyTip :: forall era.
SlotNo
-> BlockNo -> HeaderHash (ShelleyBlock era) -> ShelleyTip era
ShelleyTip {
SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo
, BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo
, HeaderHash (ShelleyBlock era)
ShelleyHash (Crypto era)
shelleyTipHash :: ShelleyHash (Crypto era)
shelleyTipHash :: HeaderHash (ShelleyBlock era)
shelleyTipHash
}
encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: ShelleyTransition -> Word32
shelleyAfterVoting} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word32 -> Encoding
CBOR.encodeWord32 Word32
shelleyAfterVoting
]
decodeShelleyTransition :: Decoder s ShelleyTransition
decodeShelleyTransition :: Decoder s ShelleyTransition
decodeShelleyTransition = do
Word32
shelleyAfterVoting <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
ShelleyTransition -> Decoder s ShelleyTransition
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyTransitionInfo :: Word32 -> ShelleyTransition
ShelleyTransitionInfo{Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting}
encodeShelleyLedgerState ::
ShelleyBasedEra era
=> LedgerState (ShelleyBlock era)
-> Encoding
encodeShelleyLedgerState :: LedgerState (ShelleyBlock era) -> Encoding
encodeShelleyLedgerState
ShelleyLedgerState { shelleyLedgerTip
, shelleyLedgerState
, shelleyLedgerTransition
} =
VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
serialisationFormatVersion2 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word -> Encoding
CBOR.encodeListLen Word
2
, (ShelleyTip era -> Encoding)
-> WithOrigin (ShelleyTip era) -> Encoding
forall a. (a -> Encoding) -> WithOrigin a -> Encoding
encodeWithOrigin ShelleyTip era -> Encoding
forall era. ShelleyBasedEra era => ShelleyTip era -> Encoding
encodeShelleyTip WithOrigin (ShelleyTip era)
shelleyLedgerTip
, NewEpochState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NewEpochState era
shelleyLedgerState
, ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransition
shelleyLedgerTransition
]
decodeShelleyLedgerState ::
forall era s. ShelleyBasedEra era
=> Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState :: Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState = [(VersionNumber, VersionDecoder (LedgerState (ShelleyBlock era)))]
-> forall s. Decoder s (LedgerState (ShelleyBlock era))
forall a.
[(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion [
(VersionNumber
serialisationFormatVersion2, (forall s. Decoder s (LedgerState (ShelleyBlock era)))
-> VersionDecoder (LedgerState (ShelleyBlock era))
forall a. (forall s. Decoder s a) -> VersionDecoder a
Decode forall s. Decoder s (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState2)
]
where
decodeShelleyLedgerState2 :: Decoder s' (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState2 :: Decoder s' (LedgerState (ShelleyBlock era))
decodeShelleyLedgerState2 = do
Text -> Int -> Decoder s' ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"LedgerState ShelleyBlock" Int
2
WithOrigin (ShelleyTip era)
shelleyLedgerTip <- Decoder s' (ShelleyTip era)
-> Decoder s' (WithOrigin (ShelleyTip era))
forall s a. Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin Decoder s' (ShelleyTip era)
forall era s. ShelleyBasedEra era => Decoder s (ShelleyTip era)
decodeShelleyTip
NewEpochState era
shelleyLedgerState <- Decoder s' (NewEpochState era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
ShelleyTransition
shelleyLedgerTransition <- Decoder s' ShelleyTransition
forall s. Decoder s ShelleyTransition
decodeShelleyTransition
LedgerState (ShelleyBlock era)
-> Decoder s' (LedgerState (ShelleyBlock era))
forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyLedgerState :: forall era.
WithOrigin (ShelleyTip era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock era)
ShelleyLedgerState {
WithOrigin (ShelleyTip era)
shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip :: WithOrigin (ShelleyTip era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
}