{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
#if __GLASGOW_HASKELL__ <= 906
{-# OPTIONS_GHC -Wno-incomplete-patterns
-Wno-incomplete-uni-patterns
-Wno-incomplete-record-updates
-Wno-overlapping-patterns #-}
#endif
module Ouroboros.Consensus.Shelley.Ledger.Ledger (
LedgerState (..)
, LedgerTables (..)
, ShelleyBasedEra
, ShelleyTip (..)
, ShelleyTransition (..)
, Ticked (..)
, castShelleyTip
, shelleyLedgerTipPoint
, shelleyTipToPoint
, ShelleyLedgerConfig (..)
, ShelleyPartialLedgerConfig (..)
, mkShelleyLedgerConfig
, shelleyEraParams
, shelleyEraParamsNeverHardForks
, shelleyLedgerGenesis
, ShelleyLedgerEvent (..)
, ShelleyReapplyException (..)
, getPParams
, decodeShelleyAnnTip
, decodeShelleyLedgerState
, encodeShelleyAnnTip
, encodeShelleyHeaderState
, encodeShelleyLedgerState
, slUtxoL
) where
import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure)
import Cardano.Ledger.BaseTypes.NonZero (unNonZero)
import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView)
import Cardano.Ledger.Binary.Decoding (decShareCBOR, decodeMap,
decodeMemPack, internsFromMap)
import Cardano.Ledger.Binary.Encoding (encodeMap, encodeMemPack,
toPlainEncoding)
import Cardano.Ledger.Binary.Plain (FromCBOR (..), ToCBOR (..),
enforceSize)
import qualified Cardano.Ledger.Block as Core
import Cardano.Ledger.Core (Era, eraDecoder, ppMaxBHSizeL,
ppMaxTxSizeL)
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Governance as SL
import qualified Cardano.Ledger.Shelley.LedgerState as SL
import qualified Cardano.Ledger.UMap as SL
import Cardano.Slotting.EpochInfo
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.Arrow (left, second)
import qualified Control.Exception as Exception
import Control.Monad.Except
import qualified Control.State.Transition.Extended as STS
import Data.Coerce (coerce)
import Data.Functor.Identity
import Data.MemPack
import qualified Data.Text as T
import qualified Data.Text as Text
import Data.Word
import GHC.Generics (Generic)
import Lens.Micro
import Lens.Micro.Extras (view)
import NoThunks.Class (NoThunks (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Abstract
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.HardFork.History.Util
import Ouroboros.Consensus.HardFork.Simple
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.CommonProtocolParams
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Protocol.Ledger.Util (isNewEpoch)
import Ouroboros.Consensus.Shelley.Ledger.Block
import Ouroboros.Consensus.Shelley.Ledger.Config
import Ouroboros.Consensus.Shelley.Ledger.Protocol ()
import Ouroboros.Consensus.Shelley.Protocol.Abstract
(EnvelopeCheckError, envelopeChecks, mkHeaderView)
import Ouroboros.Consensus.Storage.LedgerDB
import Ouroboros.Consensus.Util.CBOR (decodeWithOrigin,
encodeWithOrigin)
import Ouroboros.Consensus.Util.IndexedMemPack
import Ouroboros.Consensus.Util.Versioned
data ShelleyLedgerConfig era = ShelleyLedgerConfig {
forall era. ShelleyLedgerConfig era -> CompactGenesis
shelleyLedgerCompactGenesis :: !CompactGenesis
, forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals :: !SL.Globals
, forall era. ShelleyLedgerConfig era -> TranslationContext era
shelleyLedgerTranslationContext :: !(Core.TranslationContext era)
}
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
$cfrom :: forall era x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
from :: forall x.
ShelleyLedgerConfig era -> Rep (ShelleyLedgerConfig era) x
$cto :: forall era x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
to :: forall x.
Rep (ShelleyLedgerConfig era) x -> ShelleyLedgerConfig era
Generic)
deriving instance (NoThunks (Core.TranslationContext era), Era era) =>
NoThunks (ShelleyLedgerConfig era)
deriving instance Show (Core.TranslationContext era) => Show (ShelleyLedgerConfig era)
shelleyLedgerGenesis :: ShelleyLedgerConfig era -> SL.ShelleyGenesis
shelleyLedgerGenesis :: forall era. ShelleyLedgerConfig era -> ShelleyGenesis
shelleyLedgerGenesis = CompactGenesis -> ShelleyGenesis
getCompactGenesis (CompactGenesis -> ShelleyGenesis)
-> (ShelleyLedgerConfig era -> CompactGenesis)
-> ShelleyLedgerConfig era
-> ShelleyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> CompactGenesis
forall era. ShelleyLedgerConfig era -> CompactGenesis
shelleyLedgerCompactGenesis
shelleyEraParams ::
SL.ShelleyGenesis
-> HardFork.EraParams
shelleyEraParams :: ShelleyGenesis -> EraParams
shelleyEraParams ShelleyGenesis
genesis = HardFork.EraParams {
eraEpochSize :: EpochSize
eraEpochSize = ShelleyGenesis -> EpochSize
SL.sgEpochLength ShelleyGenesis
genesis
, eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ NominalDiffTimeMicro -> NominalDiffTime
SL.fromNominalDiffTimeMicro (NominalDiffTimeMicro -> NominalDiffTime)
-> NominalDiffTimeMicro -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NominalDiffTimeMicro
SL.sgSlotLength ShelleyGenesis
genesis
, eraSafeZone :: SafeZone
eraSafeZone = Word64 -> SafeZone
HardFork.StandardSafeZone Word64
stabilityWindow
, eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
stabilityWindow
}
where
stabilityWindow :: Word64
stabilityWindow =
Word64 -> ActiveSlotCoeff -> Word64
SL.computeStabilityWindow
(NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NonZero Word64
SL.sgSecurityParam ShelleyGenesis
genesis)
(ShelleyGenesis -> ActiveSlotCoeff
SL.sgActiveSlotCoeff ShelleyGenesis
genesis)
shelleyEraParamsNeverHardForks :: SL.ShelleyGenesis -> HardFork.EraParams
shelleyEraParamsNeverHardForks :: ShelleyGenesis -> EraParams
shelleyEraParamsNeverHardForks ShelleyGenesis
genesis = HardFork.EraParams {
eraEpochSize :: EpochSize
eraEpochSize = ShelleyGenesis -> EpochSize
SL.sgEpochLength ShelleyGenesis
genesis
, eraSlotLength :: SlotLength
eraSlotLength = NominalDiffTime -> SlotLength
mkSlotLength (NominalDiffTime -> SlotLength) -> NominalDiffTime -> SlotLength
forall a b. (a -> b) -> a -> b
$ NominalDiffTimeMicro -> NominalDiffTime
SL.fromNominalDiffTimeMicro (NominalDiffTimeMicro -> NominalDiffTime)
-> NominalDiffTimeMicro -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NominalDiffTimeMicro
SL.sgSlotLength ShelleyGenesis
genesis
, eraSafeZone :: SafeZone
eraSafeZone = SafeZone
HardFork.UnsafeIndefiniteSafeZone
, eraGenesisWin :: GenesisWindow
eraGenesisWin = Word64 -> GenesisWindow
GenesisWindow Word64
stabilityWindow
}
where
stabilityWindow :: Word64
stabilityWindow =
Word64 -> ActiveSlotCoeff -> Word64
SL.computeStabilityWindow
(NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64) -> NonZero Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> NonZero Word64
SL.sgSecurityParam ShelleyGenesis
genesis)
(ShelleyGenesis -> ActiveSlotCoeff
SL.sgActiveSlotCoeff ShelleyGenesis
genesis)
mkShelleyLedgerConfig ::
SL.ShelleyGenesis
-> Core.TranslationContext era
-> EpochInfo (Except HardFork.PastHorizonException)
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig :: forall era.
ShelleyGenesis
-> TranslationContext era
-> EpochInfo (Except PastHorizonException)
-> ShelleyLedgerConfig era
mkShelleyLedgerConfig ShelleyGenesis
genesis TranslationContext era
transCtxt EpochInfo (Except PastHorizonException)
epochInfo =
ShelleyLedgerConfig {
shelleyLedgerCompactGenesis :: CompactGenesis
shelleyLedgerCompactGenesis = ShelleyGenesis -> CompactGenesis
compactGenesis ShelleyGenesis
genesis
, shelleyLedgerGlobals :: Globals
shelleyLedgerGlobals =
ShelleyGenesis -> EpochInfo (Either Text) -> Globals
SL.mkShelleyGlobals
ShelleyGenesis
genesis
((forall a. Except PastHorizonException a -> Either Text a)
-> EpochInfo (Except PastHorizonException)
-> EpochInfo (Either Text)
forall (m :: * -> *) (n :: * -> *).
(forall a. m a -> n a) -> EpochInfo m -> EpochInfo n
hoistEpochInfo ((PastHorizonException -> Text)
-> Either PastHorizonException a -> Either Text a
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (String -> Text
Text.pack (String -> Text)
-> (PastHorizonException -> String) -> PastHorizonException -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PastHorizonException -> String
forall a. Show a => a -> String
show) (Either PastHorizonException a -> Either Text a)
-> (Except PastHorizonException a -> Either PastHorizonException a)
-> Except PastHorizonException a
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Except PastHorizonException a -> Either PastHorizonException a
forall e a. Except e a -> Either e a
runExcept) EpochInfo (Except PastHorizonException)
epochInfo)
, shelleyLedgerTranslationContext :: TranslationContext era
shelleyLedgerTranslationContext = TranslationContext era
transCtxt
}
type instance LedgerCfg (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerConfig era
data ShelleyPartialLedgerConfig era = ShelleyPartialLedgerConfig {
forall era.
ShelleyPartialLedgerConfig era -> ShelleyLedgerConfig era
shelleyLedgerConfig :: !(ShelleyLedgerConfig era)
, forall era. ShelleyPartialLedgerConfig era -> TriggerHardFork
shelleyTriggerHardFork :: !TriggerHardFork
}
deriving ((forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x)
-> (forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era)
-> Generic (ShelleyPartialLedgerConfig era)
forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
forall era x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
$cfrom :: forall era x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
from :: forall x.
ShelleyPartialLedgerConfig era
-> Rep (ShelleyPartialLedgerConfig era) x
$cto :: forall era x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
to :: forall x.
Rep (ShelleyPartialLedgerConfig era) x
-> ShelleyPartialLedgerConfig era
Generic)
deriving instance (NoThunks (Core.TranslationContext era), Core.Era era) =>
NoThunks (ShelleyPartialLedgerConfig era)
instance ShelleyCompatible proto era => HasPartialLedgerConfig (ShelleyBlock proto era) where
type PartialLedgerConfig (ShelleyBlock proto era) = ShelleyPartialLedgerConfig era
completeLedgerConfig :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> EpochInfo (Except PastHorizonException)
-> PartialLedgerConfig (ShelleyBlock proto era)
-> LedgerConfig (ShelleyBlock proto era)
completeLedgerConfig proxy (ShelleyBlock proto era)
_ EpochInfo (Except PastHorizonException)
epochInfo (ShelleyPartialLedgerConfig ShelleyLedgerConfig era
cfg TriggerHardFork
_) =
ShelleyLedgerConfig era
cfg {
shelleyLedgerGlobals = (shelleyLedgerGlobals cfg) {
SL.epochInfo =
hoistEpochInfo
(runExcept . withExceptT (T.pack . show))
epochInfo
}
}
data ShelleyTip proto era = ShelleyTip {
forall proto era. ShelleyTip proto era -> SlotNo
shelleyTipSlotNo :: !SlotNo
, forall proto era. ShelleyTip proto era -> BlockNo
shelleyTipBlockNo :: !BlockNo
, forall proto era.
ShelleyTip proto era -> HeaderHash (ShelleyBlock proto era)
shelleyTipHash :: !(HeaderHash (ShelleyBlock proto era))
}
deriving (ShelleyTip proto era -> ShelleyTip proto era -> Bool
(ShelleyTip proto era -> ShelleyTip proto era -> Bool)
-> (ShelleyTip proto era -> ShelleyTip proto era -> Bool)
-> Eq (ShelleyTip proto era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall proto era.
ShelleyTip proto era -> ShelleyTip proto era -> Bool
$c== :: forall proto era.
ShelleyTip proto era -> ShelleyTip proto era -> Bool
== :: ShelleyTip proto era -> ShelleyTip proto era -> Bool
$c/= :: forall proto era.
ShelleyTip proto era -> ShelleyTip proto era -> Bool
/= :: ShelleyTip proto era -> ShelleyTip proto era -> Bool
Eq, Int -> ShelleyTip proto era -> ShowS
[ShelleyTip proto era] -> ShowS
ShelleyTip proto era -> String
(Int -> ShelleyTip proto era -> ShowS)
-> (ShelleyTip proto era -> String)
-> ([ShelleyTip proto era] -> ShowS)
-> Show (ShelleyTip proto era)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall proto era. Int -> ShelleyTip proto era -> ShowS
forall proto era. [ShelleyTip proto era] -> ShowS
forall proto era. ShelleyTip proto era -> String
$cshowsPrec :: forall proto era. Int -> ShelleyTip proto era -> ShowS
showsPrec :: Int -> ShelleyTip proto era -> ShowS
$cshow :: forall proto era. ShelleyTip proto era -> String
show :: ShelleyTip proto era -> String
$cshowList :: forall proto era. [ShelleyTip proto era] -> ShowS
showList :: [ShelleyTip proto era] -> ShowS
Show, (forall x. ShelleyTip proto era -> Rep (ShelleyTip proto era) x)
-> (forall x. Rep (ShelleyTip proto era) x -> ShelleyTip proto era)
-> Generic (ShelleyTip proto era)
forall x. Rep (ShelleyTip proto era) x -> ShelleyTip proto era
forall x. ShelleyTip proto era -> Rep (ShelleyTip proto era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proto era x.
Rep (ShelleyTip proto era) x -> ShelleyTip proto era
forall proto era x.
ShelleyTip proto era -> Rep (ShelleyTip proto era) x
$cfrom :: forall proto era x.
ShelleyTip proto era -> Rep (ShelleyTip proto era) x
from :: forall x. ShelleyTip proto era -> Rep (ShelleyTip proto era) x
$cto :: forall proto era x.
Rep (ShelleyTip proto era) x -> ShelleyTip proto era
to :: forall x. Rep (ShelleyTip proto era) x -> ShelleyTip proto era
Generic, Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
Proxy (ShelleyTip proto era) -> String
(Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo))
-> (Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo))
-> (Proxy (ShelleyTip proto era) -> String)
-> NoThunks (ShelleyTip proto era)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall proto era.
Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
forall proto era. Proxy (ShelleyTip proto era) -> String
$cnoThunks :: forall proto era.
Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall proto era.
Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ShelleyTip proto era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall proto era. Proxy (ShelleyTip proto era) -> String
showTypeOf :: Proxy (ShelleyTip proto era) -> String
NoThunks)
shelleyTipToPoint :: WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
shelleyTipToPoint :: forall proto era.
WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
shelleyTipToPoint WithOrigin (ShelleyTip proto era)
Origin = Point (ShelleyBlock proto era)
forall {k} (block :: k). Point block
GenesisPoint
shelleyTipToPoint (NotOrigin ShelleyTip proto era
tip) = SlotNo
-> HeaderHash (ShelleyBlock proto era)
-> Point (ShelleyBlock proto era)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint (ShelleyTip proto era -> SlotNo
forall proto era. ShelleyTip proto era -> SlotNo
shelleyTipSlotNo ShelleyTip proto era
tip)
(ShelleyTip proto era -> HeaderHash (ShelleyBlock proto era)
forall proto era.
ShelleyTip proto era -> HeaderHash (ShelleyBlock proto era)
shelleyTipHash ShelleyTip proto era
tip)
castShelleyTip :: ShelleyTip proto era -> ShelleyTip proto' era'
castShelleyTip :: forall proto era proto' era'.
ShelleyTip proto era -> ShelleyTip proto' era'
castShelleyTip (ShelleyTip SlotNo
sn BlockNo
bn HeaderHash (ShelleyBlock proto era)
hh) = ShelleyTip {
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo = SlotNo
sn
, shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = BlockNo
bn
, shelleyTipHash :: HeaderHash (ShelleyBlock proto' era')
shelleyTipHash = ShelleyHash -> ShelleyHash
forall a b. Coercible a b => a -> b
coerce HeaderHash (ShelleyBlock proto era)
ShelleyHash
hh
}
data instance LedgerState (ShelleyBlock proto era) mk = ShelleyLedgerState {
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: !(WithOrigin (ShelleyTip proto era))
, forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: !(SL.NewEpochState era)
, forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: !ShelleyTransition
, forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
shelleyLedgerTables :: !(LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
}
deriving ((forall x.
LedgerState (ShelleyBlock proto era) mk
-> Rep (LedgerState (ShelleyBlock proto era) mk) x)
-> (forall x.
Rep (LedgerState (ShelleyBlock proto era) mk) x
-> LedgerState (ShelleyBlock proto era) mk)
-> Generic (LedgerState (ShelleyBlock proto era) mk)
forall x.
Rep (LedgerState (ShelleyBlock proto era) mk) x
-> LedgerState (ShelleyBlock proto era) mk
forall x.
LedgerState (ShelleyBlock proto era) mk
-> Rep (LedgerState (ShelleyBlock proto era) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proto era (mk :: * -> * -> *) x.
Rep (LedgerState (ShelleyBlock proto era) mk) x
-> LedgerState (ShelleyBlock proto era) mk
forall proto era (mk :: * -> * -> *) x.
LedgerState (ShelleyBlock proto era) mk
-> Rep (LedgerState (ShelleyBlock proto era) mk) x
$cfrom :: forall proto era (mk :: * -> * -> *) x.
LedgerState (ShelleyBlock proto era) mk
-> Rep (LedgerState (ShelleyBlock proto era) mk) x
from :: forall x.
LedgerState (ShelleyBlock proto era) mk
-> Rep (LedgerState (ShelleyBlock proto era) mk) x
$cto :: forall proto era (mk :: * -> * -> *) x.
Rep (LedgerState (ShelleyBlock proto era) mk) x
-> LedgerState (ShelleyBlock proto era) mk
to :: forall x.
Rep (LedgerState (ShelleyBlock proto era) mk) x
-> LedgerState (ShelleyBlock proto era) mk
Generic)
deriving instance (ShelleyBasedEra era, EqMK mk)
=> Eq (LedgerState (ShelleyBlock proto era) mk)
deriving instance (ShelleyBasedEra era, NoThunksMK mk)
=> NoThunks (LedgerState (ShelleyBlock proto era) mk)
deriving instance (ShelleyBasedEra era, ShowMK mk)
=> Show (LedgerState (ShelleyBlock proto era) mk)
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
$c== :: ShelleyTransition -> ShelleyTransition -> Bool
== :: ShelleyTransition -> ShelleyTransition -> Bool
$c/= :: ShelleyTransition -> ShelleyTransition -> Bool
/= :: 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
$cshowsPrec :: Int -> ShelleyTransition -> ShowS
showsPrec :: Int -> ShelleyTransition -> ShowS
$cshow :: ShelleyTransition -> String
show :: ShelleyTransition -> String
$cshowList :: [ShelleyTransition] -> ShowS
showList :: [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
$cfrom :: forall x. ShelleyTransition -> Rep ShelleyTransition x
from :: forall x. ShelleyTransition -> Rep ShelleyTransition x
$cto :: forall x. Rep ShelleyTransition x -> ShelleyTransition
to :: forall x. Rep ShelleyTransition x -> ShelleyTransition
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
$cnoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
noThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ShelleyTransition -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ShelleyTransition -> String
showTypeOf :: Proxy ShelleyTransition -> String
NoThunks)
shelleyLedgerTipPoint ::
LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
shelleyLedgerTipPoint :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
shelleyLedgerTipPoint = WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
forall proto era.
WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
shelleyTipToPoint (WithOrigin (ShelleyTip proto era)
-> Point (ShelleyBlock proto era))
-> (LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era))
-> LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
instance ShelleyCompatible proto era => UpdateLedger (ShelleyBlock proto era)
type instance TxIn (LedgerState (ShelleyBlock proto era)) = SL.TxIn
type instance TxOut (LedgerState (ShelleyBlock proto era)) = Core.TxOut era
instance (txout ~ Core.TxOut era, MemPack txout)
=> IndexedMemPack (LedgerState (ShelleyBlock proto era) EmptyMK) txout where
indexedTypeName :: LedgerState (ShelleyBlock proto era) EmptyMK -> String
indexedTypeName LedgerState (ShelleyBlock proto era) EmptyMK
_ = forall a. MemPack a => String
typeName @txout
indexedPackedByteCount :: LedgerState (ShelleyBlock proto era) EmptyMK -> txout -> Int
indexedPackedByteCount LedgerState (ShelleyBlock proto era) EmptyMK
_ = txout -> Int
forall a. MemPack a => a -> Int
packedByteCount
indexedPackM :: forall s.
LedgerState (ShelleyBlock proto era) EmptyMK -> txout -> Pack s ()
indexedPackM LedgerState (ShelleyBlock proto era) EmptyMK
_ = txout -> Pack s ()
forall s. txout -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM
indexedUnpackM :: forall b.
Buffer b =>
LedgerState (ShelleyBlock proto era) EmptyMK -> Unpack b txout
indexedUnpackM LedgerState (ShelleyBlock proto era) EmptyMK
_ = Unpack b txout
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b txout
unpackM
instance ShelleyCompatible proto era
=> SerializeTablesWithHint (LedgerState (ShelleyBlock proto era)) where
encodeTablesWithHint :: SerializeTablesHint
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Encoding
encodeTablesWithHint SerializeTablesHint
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
_ (LedgerTables (ValuesMK Map
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
tbs)) =
Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
Core.eraProtVerLow @era) (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxIn -> Encoding)
-> (TxOut era -> Encoding) -> Map TxIn (TxOut era) -> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap TxIn -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack TxOut era -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack Map TxIn (TxOut era)
Map
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
tbs
decodeTablesWithHint :: forall s.
SerializeTablesHint
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> Decoder
s (LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
decodeTablesWithHint SerializeTablesHint
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
st =
let certInterns :: Interns (Credential 'Staking)
certInterns =
Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap
(Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking))
-> Map (Credential 'Staking) UMElem
-> Interns (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) EmptyMK -> NewEpochState era
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState SerializeTablesHint
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
LedgerState (ShelleyBlock proto era) EmptyMK
st
NewEpochState era
-> Getting
(Map (Credential 'Staking) UMElem)
(NewEpochState era)
(Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
forall s a. s -> Getting a s a -> a
^. (EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> NewEpochState era
-> Const (Map (Credential 'Staking) UMElem) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
SL.nesEsL
((EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> NewEpochState era
-> Const (Map (Credential 'Staking) UMElem) (NewEpochState era))
-> ((Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> Getting
(Map (Credential 'Staking) UMElem)
(NewEpochState era)
(Map (Credential 'Staking) UMElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
SL.esLStateL
((LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> ((Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> (Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
SL.lsCertStateL
((CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> ((Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> (Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL
((DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> ((Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era))
-> (Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
SL.dsUnifiedL
((UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era))
-> ((Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> (Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) UMElem
-> Const
(Map (Credential 'Staking) UMElem)
(Map (Credential 'Staking) UMElem))
-> UMap -> Const (Map (Credential 'Staking) UMElem) UMap
Lens' UMap (Map (Credential 'Staking) UMElem)
SL.umElemsL
in ValuesMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
ValuesMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> (Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era))
-> Map TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era)
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> Decoder s (Map TxIn (TxOut era))
-> Decoder
s (LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (Map TxIn (TxOut era))
-> Decoder s (Map TxIn (TxOut era)))
-> Decoder s (Map TxIn (TxOut era))
-> Decoder s (Map TxIn (TxOut era))
forall a b. (a -> b) -> a -> b
$ Decoder s TxIn
-> Decoder s (TxOut era) -> Decoder s (Map TxIn (TxOut era))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s TxIn
forall a s. MemPack a => Decoder s a
decodeMemPack (Share (TxOut era) -> Decoder s (TxOut era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (TxOut era) -> Decoder s (TxOut era)
decShareCBOR Share (TxOut era)
Interns (Credential 'Staking)
certInterns))
instance ShelleyBasedEra era
=> HasLedgerTables (LedgerState (ShelleyBlock proto era)) where
projectLedgerTables :: forall (mk :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
projectLedgerTables = LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
shelleyLedgerTables
withLedgerTables :: forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState (ShelleyBlock proto era) any
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
-> LedgerState (ShelleyBlock proto era) mk
withLedgerTables LedgerState (ShelleyBlock proto era) any
st LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tables =
ShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
, shelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) mk
shelleyLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tables
}
where
ShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
} = LedgerState (ShelleyBlock proto era) any
st
instance ShelleyBasedEra era
=> HasLedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) where
projectLedgerTables :: forall (mk :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
projectLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerTables (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk)
-> (Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tickedShelleyLedgerTables
withLedgerTables :: forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState (ShelleyBlock proto era)) any
-> LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
withLedgerTables Ticked (LedgerState (ShelleyBlock proto era)) any
st LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
tables =
TickedShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition
, NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState
, tickedShelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tickedShelleyLedgerTables = LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) mk
tables
}
where
TickedShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> ShelleyTransition
tickedShelleyLedgerTransition
, NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState
} = Ticked (LedgerState (ShelleyBlock proto era)) any
st
instance ShelleyBasedEra era
=> CanStowLedgerTables (LedgerState (ShelleyBlock proto era)) where
stowLedgerTables :: LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) EmptyMK
stowLedgerTables LedgerState (ShelleyBlock proto era) ValuesMK
st =
ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip = WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
shelleyLedgerState'
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransition
shelleyLedgerTransition
, shelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
shelleyLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
}
where
(UTxO era
_, NewEpochState era
shelleyLedgerState') = NewEpochState era
shelleyLedgerState NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
forall era.
NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
`slUtxoL` Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
SL.UTxO Map TxIn (TxOut era)
m
ShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
, shelleyLedgerTables :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
shelleyLedgerTables = LedgerTables (ValuesMK Map TxIn (TxOut era)
m)
} = LedgerState (ShelleyBlock proto era) ValuesMK
st
unstowLedgerTables :: LedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerState (ShelleyBlock proto era) ValuesMK
unstowLedgerTables LedgerState (ShelleyBlock proto era) EmptyMK
st =
ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip = WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, shelleyLedgerState :: NewEpochState era
shelleyLedgerState = NewEpochState era
shelleyLedgerState'
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransition
shelleyLedgerTransition
, shelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
shelleyLedgerTables = ValuesMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era)
forall k v. Map k v -> ValuesMK k v
ValuesMK (UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
SL.unUTxO UTxO era
tbs))
}
where
(UTxO era
tbs, NewEpochState era
shelleyLedgerState') = NewEpochState era
shelleyLedgerState NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
forall era.
NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
`slUtxoL` UTxO era
forall a. Monoid a => a
mempty
ShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
} = LedgerState (ShelleyBlock proto era) EmptyMK
st
instance ShelleyBasedEra era
=> CanStowLedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) where
stowLedgerTables :: Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Ticked (LedgerState (ShelleyBlock proto era)) EmptyMK
stowLedgerTables Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
st =
TickedShelleyLedgerState {
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip = WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition = ShelleyTransition
tickedShelleyLedgerTransition
, tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState = NewEpochState era
tickedShelleyLedgerState'
, tickedShelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
tickedShelleyLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
}
where
(UTxO era
_, NewEpochState era
tickedShelleyLedgerState') =
NewEpochState era
tickedShelleyLedgerState NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
forall era.
NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
`slUtxoL` Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
SL.UTxO Map TxIn (TxOut era)
tbs
TickedShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, ShelleyTransition
tickedShelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition
, NewEpochState era
tickedShelleyLedgerState :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState
, tickedShelleyLedgerTables :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tickedShelleyLedgerTables = LedgerTables (ValuesMK Map TxIn (TxOut era)
tbs)
} = Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
st
unstowLedgerTables :: Ticked (LedgerState (ShelleyBlock proto era)) EmptyMK
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
unstowLedgerTables Ticked (LedgerState (ShelleyBlock proto era)) EmptyMK
st =
TickedShelleyLedgerState {
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip = WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition = ShelleyTransition
tickedShelleyLedgerTransition
, tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState = NewEpochState era
tickedShelleyLedgerState'
, tickedShelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
tickedShelleyLedgerTables = ValuesMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era)
forall k v. Map k v -> ValuesMK k v
ValuesMK (UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
SL.unUTxO UTxO era
tbs))
}
where
(UTxO era
tbs, NewEpochState era
tickedShelleyLedgerState') = NewEpochState era
tickedShelleyLedgerState NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
forall era.
NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
`slUtxoL` UTxO era
forall a. Monoid a => a
mempty
TickedShelleyLedgerState {
WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
, ShelleyTransition
tickedShelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition
, NewEpochState era
tickedShelleyLedgerState :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState
} = Ticked (LedgerState (ShelleyBlock proto era)) EmptyMK
st
slUtxoL :: SL.NewEpochState era -> SL.UTxO era -> (SL.UTxO era, SL.NewEpochState era)
slUtxoL :: forall era.
NewEpochState era -> UTxO era -> (UTxO era, NewEpochState era)
slUtxoL NewEpochState era
st UTxO era
vals =
NewEpochState era
st
NewEpochState era
-> (NewEpochState era -> (UTxO era, NewEpochState era))
-> (UTxO era, NewEpochState era)
forall a b. a -> (a -> b) -> b
& (EpochState era -> (UTxO era, EpochState era))
-> NewEpochState era -> (UTxO era, NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
SL.nesEsL
((EpochState era -> (UTxO era, EpochState era))
-> NewEpochState era -> (UTxO era, NewEpochState era))
-> ((UTxO era -> (UTxO era, UTxO era))
-> EpochState era -> (UTxO era, EpochState era))
-> (UTxO era -> (UTxO era, UTxO era))
-> NewEpochState era
-> (UTxO era, NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> (UTxO era, LedgerState era))
-> EpochState era -> (UTxO era, EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
SL.esLStateL
((LedgerState era -> (UTxO era, LedgerState era))
-> EpochState era -> (UTxO era, EpochState era))
-> ((UTxO era -> (UTxO era, UTxO era))
-> LedgerState era -> (UTxO era, LedgerState era))
-> (UTxO era -> (UTxO era, UTxO era))
-> EpochState era
-> (UTxO era, EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> (UTxO era, UTxOState era))
-> LedgerState era -> (UTxO era, LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
SL.lsUTxOStateL
((UTxOState era -> (UTxO era, UTxOState era))
-> LedgerState era -> (UTxO era, LedgerState era))
-> ((UTxO era -> (UTxO era, UTxO era))
-> UTxOState era -> (UTxO era, UTxOState era))
-> (UTxO era -> (UTxO era, UTxO era))
-> LedgerState era
-> (UTxO era, LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxO era -> (UTxO era, UTxO era))
-> UTxOState era -> (UTxO era, UTxOState era)
forall era. Lens' (UTxOState era) (UTxO era)
forall (t :: * -> *) era. CanSetUTxO t => Lens' (t era) (UTxO era)
SL.utxoL
((UTxO era -> (UTxO era, UTxO era))
-> NewEpochState era -> (UTxO era, NewEpochState era))
-> UTxO era -> NewEpochState era -> (UTxO era, NewEpochState era)
forall a s t b. LensLike ((,) a) s t a b -> b -> s -> (a, t)
<<.~ UTxO era
vals
instance GetTip (LedgerState (ShelleyBlock proto era)) where
getTip :: forall (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> Point (LedgerState (ShelleyBlock proto era))
getTip = Point (ShelleyBlock proto era)
-> Point (LedgerState (ShelleyBlock proto era))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock proto era)
-> Point (LedgerState (ShelleyBlock proto era)))
-> (LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era))
-> LedgerState (ShelleyBlock proto era) mk
-> Point (LedgerState (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
shelleyLedgerTipPoint
instance GetTip (Ticked (LedgerState (ShelleyBlock proto era))) where
getTip :: forall (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Point (Ticked (LedgerState (ShelleyBlock proto era)))
getTip = Point (ShelleyBlock proto era)
-> Point (Ticked (LedgerState (ShelleyBlock proto era)))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (ShelleyBlock proto era)
-> Point (Ticked (LedgerState (ShelleyBlock proto era))))
-> (Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Point (ShelleyBlock proto era))
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Point (Ticked (LedgerState (ShelleyBlock proto era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Point (ShelleyBlock proto era)
forall proto era (mk :: * -> * -> *).
TickedLedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
untickedShelleyLedgerTipPoint
data instance Ticked (LedgerState (ShelleyBlock proto era)) mk = TickedShelleyLedgerState {
forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip :: !(WithOrigin (ShelleyTip proto era))
, forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> ShelleyTransition
tickedShelleyLedgerTransition :: !ShelleyTransition
, forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState :: !(SL.NewEpochState era)
, forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
tickedShelleyLedgerTables ::
!(LedgerTables (LedgerState (ShelleyBlock proto era)) mk)
}
deriving ((forall x.
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x)
-> (forall x.
Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
-> Ticked (LedgerState (ShelleyBlock proto era)) mk)
-> Generic (Ticked (LedgerState (ShelleyBlock proto era)) mk)
forall x.
Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
forall x.
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall proto era (mk :: * -> * -> *) x.
Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
forall proto era (mk :: * -> * -> *) x.
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
$cfrom :: forall proto era (mk :: * -> * -> *) x.
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
from :: forall x.
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
$cto :: forall proto era (mk :: * -> * -> *) x.
Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
to :: forall x.
Rep (Ticked (LedgerState (ShelleyBlock proto era)) mk) x
-> Ticked (LedgerState (ShelleyBlock proto era)) mk
Generic)
untickedShelleyLedgerTipPoint ::
TickedLedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
untickedShelleyLedgerTipPoint :: forall proto era (mk :: * -> * -> *).
TickedLedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
untickedShelleyLedgerTipPoint = WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
forall proto era.
WithOrigin (ShelleyTip proto era) -> Point (ShelleyBlock proto era)
shelleyTipToPoint (WithOrigin (ShelleyTip proto era)
-> Point (ShelleyBlock proto era))
-> (TickedLedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era))
-> TickedLedgerState (ShelleyBlock proto era) mk
-> Point (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickedLedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip
instance ShelleyBasedEra era => IsLedger (LedgerState (ShelleyBlock proto era)) where
type LedgerErr (LedgerState (ShelleyBlock proto era)) = SL.BlockTransitionError era
type AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) = ShelleyLedgerEvent era
applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> SlotNo
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(Ticked (LedgerState (ShelleyBlock proto era)) DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg (LedgerState (ShelleyBlock proto era))
cfg SlotNo
slotNo ShelleyLedgerState{
WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition
} =
Globals
-> NewEpochState era
-> SlotNo
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
appTick Globals
globals NewEpochState era
shelleyLedgerState SlotNo
slotNo LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
-> (NewEpochState era
-> Ticked (LedgerState (ShelleyBlock proto era)) DiffMK)
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(Ticked (LedgerState (ShelleyBlock proto era)) DiffMK)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \NewEpochState era
l' ->
TickedShelleyLedgerState {
untickedShelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
untickedShelleyLedgerTip = WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition =
if EpochInfo Identity -> WithOrigin SlotNo -> SlotNo -> Bool
isNewEpoch EpochInfo Identity
ei (ShelleyTip proto era -> SlotNo
forall proto era. ShelleyTip proto era -> SlotNo
shelleyTipSlotNo (ShelleyTip proto era -> SlotNo)
-> WithOrigin (ShelleyTip proto era) -> WithOrigin SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip) SlotNo
slotNo then
ShelleyTransitionInfo { shelleyAfterVoting :: Word32
shelleyAfterVoting = Word32
0 }
else
ShelleyTransition
shelleyLedgerTransition
, tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState = NewEpochState era
l'
, tickedShelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
tickedShelleyLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) DiffMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
}
where
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerCfg (LedgerState (ShelleyBlock proto era))
ShelleyLedgerConfig era
cfg
ei :: EpochInfo Identity
ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfoPure Globals
globals
appTick :: Globals
-> NewEpochState era
-> SlotNo
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
appTick =
(NewEpochState era
-> [ShelleyLedgerEvent era]
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> (NewEpochState era, [ShelleyLedgerEvent era])
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([ShelleyLedgerEvent era]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> NewEpochState era
-> [ShelleyLedgerEvent era]
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [AuxLedgerEvent (LedgerState (ShelleyBlock proto era))]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
[ShelleyLedgerEvent era]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall (l :: LedgerStateKind) a.
[AuxLedgerEvent l] -> a -> LedgerResult l a
LedgerResult) ((NewEpochState era, [ShelleyLedgerEvent era])
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> (Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [ShelleyLedgerEvent era]))
-> Globals
-> NewEpochState era
-> SlotNo
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: case ComputeLedgerEvents
evs of
ComputeLedgerEvents
ComputeLedgerEvents ->
([Event (EraRule "TICK" era)] -> [ShelleyLedgerEvent era])
-> (NewEpochState era, [Event (EraRule "TICK" era)])
-> (NewEpochState era, [ShelleyLedgerEvent era])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Event (EraRule "TICK" era) -> ShelleyLedgerEvent era)
-> [Event (EraRule "TICK" era)] -> [ShelleyLedgerEvent era]
forall a b. (a -> b) -> [a] -> [b]
map Event (EraRule "TICK" era) -> ShelleyLedgerEvent era
forall era. Event (EraRule "TICK" era) -> ShelleyLedgerEvent era
ShelleyLedgerEventTICK) ((NewEpochState era, [Event (EraRule "TICK" era)])
-> (NewEpochState era, [ShelleyLedgerEvent era]))
-> (Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [Event (EraRule "TICK" era)]))
-> Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [ShelleyLedgerEvent era])
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..:
SingEP 'EventPolicyReturn
-> Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [Event (EraRule "TICK" era)])
forall era (ep :: EventPolicy).
ApplyBlock era =>
SingEP ep
-> Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [Event (EraRule "TICK" era)])
forall (ep :: EventPolicy).
SingEP ep
-> Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [Event (EraRule "TICK" era)])
SL.applyTick SingEP 'EventPolicyReturn
STS.EPReturn
ComputeLedgerEvents
OmitLedgerEvents ->
(,[]) (NewEpochState era
-> (NewEpochState era, [ShelleyLedgerEvent era]))
-> (Globals -> NewEpochState era -> SlotNo -> NewEpochState era)
-> Globals
-> NewEpochState era
-> SlotNo
-> (NewEpochState era, [ShelleyLedgerEvent era])
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: Globals -> NewEpochState era -> SlotNo -> NewEpochState era
forall era.
ApplyBlock era =>
Globals -> NewEpochState era -> SlotNo -> NewEpochState era
SL.applyTickNoEvents
data ShelleyLedgerEvent era =
ShelleyLedgerEventBBODY (STS.Event (Core.EraRule "BBODY" era))
| ShelleyLedgerEventTICK (STS.Event (Core.EraRule "TICK" era))
instance ShelleyCompatible proto era
=> ApplyBlock (LedgerState (ShelleyBlock proto era)) (ShelleyBlock proto era) where
applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Except
(LedgerErr (LedgerState (ShelleyBlock proto era)))
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate ComputeLedgerEvents
evs =
Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
-> ExceptT
(BlockTransitionError era)
Identity
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
-> ExceptT
(BlockTransitionError era)
Identity
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)))
-> (ShelleyLedgerConfig era
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)))
-> ShelleyLedgerConfig era
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> ExceptT
(BlockTransitionError era)
Identity
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: (Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)))
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
forall proto era.
ShelleyCompatible proto era =>
(Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)))
-> LedgerConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
applyHelper Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
appBlk
where
appBlk :: Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
appBlk =
((NewEpochState era, [ShelleyLedgerEvent era])
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
forall a b.
(a -> b)
-> Either (BlockTransitionError era) a
-> Either (BlockTransitionError era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((NewEpochState era
-> [ShelleyLedgerEvent era]
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> (NewEpochState era, [ShelleyLedgerEvent era])
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([ShelleyLedgerEvent era]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
-> NewEpochState era
-> [ShelleyLedgerEvent era]
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall a b c. (a -> b -> c) -> b -> a -> c
flip [AuxLedgerEvent (LedgerState (ShelleyBlock proto era))]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
[ShelleyLedgerEvent era]
-> NewEpochState era
-> LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)
forall (l :: LedgerStateKind) a.
[AuxLedgerEvent l] -> a -> LedgerResult l a
LedgerResult)) (Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)))
-> (Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era]))
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: case ComputeLedgerEvents
evs of
ComputeLedgerEvents
ComputeLedgerEvents ->
((NewEpochState era, [Event (EraRule "BBODY" era)])
-> (NewEpochState era, [ShelleyLedgerEvent era]))
-> Either
(BlockTransitionError era)
(NewEpochState era, [Event (EraRule "BBODY" era)])
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
forall a b.
(a -> b)
-> Either (BlockTransitionError era) a
-> Either (BlockTransitionError era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Event (EraRule "BBODY" era)] -> [ShelleyLedgerEvent era])
-> (NewEpochState era, [Event (EraRule "BBODY" era)])
-> (NewEpochState era, [ShelleyLedgerEvent era])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Event (EraRule "BBODY" era) -> ShelleyLedgerEvent era)
-> [Event (EraRule "BBODY" era)] -> [ShelleyLedgerEvent era]
forall a b. (a -> b) -> [a] -> [b]
map Event (EraRule "BBODY" era) -> ShelleyLedgerEvent era
forall era. Event (EraRule "BBODY" era) -> ShelleyLedgerEvent era
ShelleyLedgerEventBBODY)) (Either
(BlockTransitionError era)
(NewEpochState era, [Event (EraRule "BBODY" era)])
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era]))
-> (Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [Event (EraRule "BBODY" era)]))
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..:
SingEP 'EventPolicyReturn
-> ValidationPolicy
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [Event (EraRule "BBODY" era)])
forall era (ep :: EventPolicy).
ApplyBlock era =>
SingEP ep
-> ValidationPolicy
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [Event (EraRule "BBODY" era)])
SL.applyBlockEither SingEP 'EventPolicyReturn
STS.EPReturn ValidationPolicy
doValidate
ComputeLedgerEvents
OmitLedgerEvents ->
(NewEpochState era
-> (NewEpochState era, [ShelleyLedgerEvent era]))
-> Either (BlockTransitionError era) (NewEpochState era)
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
forall a b.
(a -> b)
-> Either (BlockTransitionError era) a
-> Either (BlockTransitionError era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[]) (Either (BlockTransitionError era) (NewEpochState era)
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era]))
-> (Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either (BlockTransitionError era) (NewEpochState era))
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(NewEpochState era, [ShelleyLedgerEvent era])
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..:
ValidationPolicy
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either (BlockTransitionError era) (NewEpochState era)
forall era.
ApplyBlock era =>
ValidationPolicy
-> Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either (BlockTransitionError era) (NewEpochState era)
SL.applyBlockEitherNoEvents ValidationPolicy
doValidate
applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Except
(LedgerErr (LedgerState (ShelleyBlock proto era)))
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
applyBlockLedgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Except
(LedgerErr (LedgerState (ShelleyBlock proto era)))
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
defaultApplyBlockLedgerResult
reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)
reapplyBlockLedgerResult =
(LedgerErr (LedgerState (ShelleyBlock proto era))
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState (ShelleyBlock proto era))
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)
forall (l :: LedgerStateKind) blk.
(HasCallStack, ApplyBlock l blk) =>
(LedgerErr l -> LedgerResult l (l DiffMK))
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> LedgerResult l (l DiffMK)
defaultReapplyBlockLedgerResult (\LedgerErr (LedgerState (ShelleyBlock proto era))
err -> ShelleyReapplyException
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)
forall a e. (HasCallStack, Exception e) => e -> a
Exception.throw (ShelleyReapplyException
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
-> ShelleyReapplyException
-> LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK)
forall a b. (a -> b) -> a -> b
$! forall era.
Show (BlockTransitionError era) =>
BlockTransitionError era -> ShelleyReapplyException
ShelleyReapplyException @era BlockTransitionError era
LedgerErr (LedgerState (ShelleyBlock proto era))
err)
getBlockKeySets :: ShelleyBlock proto era
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
getBlockKeySets =
KeysMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
KeysMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables
(KeysMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK)
-> (ShelleyBlock proto era -> KeysMK TxIn (TxOut era))
-> ShelleyBlock proto era
-> LedgerTables (LedgerState (ShelleyBlock proto era)) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set TxIn -> KeysMK TxIn (TxOut era)
forall k v. Set k -> KeysMK k v
KeysMK
(Set TxIn -> KeysMK TxIn (TxOut era))
-> (ShelleyBlock proto era -> Set TxIn)
-> ShelleyBlock proto era
-> KeysMK TxIn (TxOut era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (ShelleyProtocolHeader proto) era -> Set TxIn
forall h era. EraSegWits era => Block h era -> Set TxIn
Core.neededTxInsForBlock
(Block (ShelleyProtocolHeader proto) era -> Set TxIn)
-> (ShelleyBlock proto era
-> Block (ShelleyProtocolHeader proto) era)
-> ShelleyBlock proto era
-> Set TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw
data ShelleyReapplyException =
forall era. Show (SL.BlockTransitionError era)
=> ShelleyReapplyException (SL.BlockTransitionError era)
instance Show ShelleyReapplyException where
show :: ShelleyReapplyException -> String
show (ShelleyReapplyException BlockTransitionError era
err) = String
"(ShelleyReapplyException " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BlockTransitionError era -> String
forall a. Show a => a -> String
show BlockTransitionError era
err String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
instance Exception.Exception ShelleyReapplyException where
applyHelper ::
forall proto era. ShelleyCompatible proto era
=> ( SL.Globals
-> SL.NewEpochState era
-> SL.Block SL.BHeaderView era
-> Either
(SL.BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(SL.NewEpochState era)
)
)
-> LedgerConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Either
(SL.BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
applyHelper :: forall proto era.
ShelleyCompatible proto era =>
(Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era)))
-> LedgerConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era
-> Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era))
(LedgerState (ShelleyBlock proto era) DiffMK))
applyHelper Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
f LedgerConfig (ShelleyBlock proto era)
cfg ShelleyBlock proto era
blk Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
stBefore = do
let TickedShelleyLedgerState{
ShelleyTransition
tickedShelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> ShelleyTransition
tickedShelleyLedgerTransition :: ShelleyTransition
tickedShelleyLedgerTransition
, NewEpochState era
tickedShelleyLedgerState :: forall proto era (mk :: * -> * -> *).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState
} = Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> Ticked (LedgerState (ShelleyBlock proto era)) EmptyMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
stBefore
ledgerResult <-
Globals
-> NewEpochState era
-> Block BHeaderView era
-> Either
(BlockTransitionError era)
(LedgerResult
(LedgerState (ShelleyBlock proto era)) (NewEpochState era))
f
Globals
globals
NewEpochState era
tickedShelleyLedgerState
( let b :: Block (ShelleyProtocolHeader proto) era
b = ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
shelleyBlockRaw ShelleyBlock proto era
blk
h' :: BHeaderView
h' = ShelleyProtocolHeader proto -> BHeaderView
forall proto.
ProtocolHeaderSupportsLedger proto =>
ShelleyProtocolHeader proto -> BHeaderView
mkHeaderView (Block (ShelleyProtocolHeader proto) era
-> ShelleyProtocolHeader proto
forall h era. Block h era -> h
SL.bheader Block (ShelleyProtocolHeader proto) era
b)
in BHeaderView -> TxSeq era -> Block BHeaderView era
forall h era. h -> TxSeq era -> Block h era
SL.UnsafeUnserialisedBlock BHeaderView
h' (Block (ShelleyProtocolHeader proto) era -> TxSeq era
forall h era. Block h era -> TxSeq era
SL.bbody Block (ShelleyProtocolHeader proto) era
b)
)
let track ::
LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) TrackingMK
track = Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) TrackingMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' ValuesMK -> l' TrackingMK
calculateDifference Ticked (LedgerState (ShelleyBlock proto era)) ValuesMK
stBefore
return $ ledgerResult <&> \NewEpochState era
newNewEpochState ->
LedgerState (ShelleyBlock proto era) TrackingMK
-> LedgerState (ShelleyBlock proto era) DiffMK
forall (l :: LedgerStateKind).
(HasLedgerTables l, LedgerTableConstraints l) =>
l TrackingMK -> l DiffMK
trackingToDiffs (LedgerState (ShelleyBlock proto era) TrackingMK
-> LedgerState (ShelleyBlock proto era) DiffMK)
-> LedgerState (ShelleyBlock proto era) TrackingMK
-> LedgerState (ShelleyBlock proto era) DiffMK
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) TrackingMK
track (LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) TrackingMK)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> LedgerState (ShelleyBlock proto era) TrackingMK
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerState (ShelleyBlock proto era) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables (LedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> LedgerState (ShelleyBlock proto era) ValuesMK
forall a b. (a -> b) -> a -> b
$
ShelleyLedgerState {
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip = ShelleyTip proto era -> WithOrigin (ShelleyTip proto era)
forall t. t -> WithOrigin t
NotOrigin ShelleyTip {
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo = ShelleyBlock proto era -> BlockNo
forall b. HasHeader b => b -> BlockNo
blockNo ShelleyBlock proto era
blk
, shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo = ShelleyBlock proto era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock proto era
blk
, shelleyTipHash :: HeaderHash (ShelleyBlock proto era)
shelleyTipHash = ShelleyBlock proto era -> HeaderHash (ShelleyBlock proto era)
forall b. HasHeader b => b -> HeaderHash b
blockHash ShelleyBlock proto era
blk
}
, shelleyLedgerState :: NewEpochState era
shelleyLedgerState =
NewEpochState era
newNewEpochState
, shelleyLedgerTransition :: ShelleyTransition
shelleyLedgerTransition = ShelleyTransitionInfo {
shelleyAfterVoting :: Word32
shelleyAfterVoting =
(if ShelleyBlock proto era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock proto 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
}
, shelleyLedgerTables :: LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
shelleyLedgerTables = LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
}
where
globals :: Globals
globals = ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock proto era)
ShelleyLedgerConfig era
cfg
swindow :: Word64
swindow = Globals -> Word64
SL.stabilityWindow Globals
globals
ei :: EpochInfo Identity
ei :: EpochInfo Identity
ei = Globals -> EpochInfo Identity
SL.epochInfoPure 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
blockEpoch <- EpochInfo Identity -> SlotNo -> Identity EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch EpochInfo Identity
ei (ShelleyBlock proto era -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot ShelleyBlock proto era
blk)
let nextEpoch = EpochNo -> EpochNo
forall a. Enum a => a -> a
succ EpochNo
blockEpoch
epochInfoFirst ei 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 HasHardForkHistory (ShelleyBlock proto era) where
type HardForkIndices (ShelleyBlock proto era) = '[ShelleyBlock proto era]
hardForkSummary :: forall (mk :: * -> * -> *).
LedgerConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) mk
-> Summary (HardForkIndices (ShelleyBlock proto era))
hardForkSummary = (LedgerConfig (ShelleyBlock proto era) -> EraParams)
-> LedgerConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) mk
-> Summary '[ShelleyBlock proto era]
forall blk (mk :: * -> * -> *).
(LedgerConfig blk -> EraParams)
-> LedgerConfig blk -> LedgerState blk mk -> Summary '[blk]
neverForksHardForkSummary ((LedgerConfig (ShelleyBlock proto era) -> EraParams)
-> LedgerConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) mk
-> Summary '[ShelleyBlock proto era])
-> (LedgerConfig (ShelleyBlock proto era) -> EraParams)
-> LedgerConfig (ShelleyBlock proto era)
-> LedgerState (ShelleyBlock proto era) mk
-> Summary '[ShelleyBlock proto era]
forall a b. (a -> b) -> a -> b
$
ShelleyGenesis -> EraParams
shelleyEraParamsNeverHardForks (ShelleyGenesis -> EraParams)
-> (ShelleyLedgerConfig era -> ShelleyGenesis)
-> ShelleyLedgerConfig era
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerConfig era -> ShelleyGenesis
forall era. ShelleyLedgerConfig era -> ShelleyGenesis
shelleyLedgerGenesis
instance ShelleyCompatible proto era
=> CommonProtocolParams (ShelleyBlock proto era) where
maxHeaderSize :: forall (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> Word32
maxHeaderSize = Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word32)
-> (LedgerState (ShelleyBlock proto era) mk -> Word16)
-> LedgerState (ShelleyBlock proto era) mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word16 (PParams era) Word16 -> PParams era -> Word16
forall a s. Getting a s a -> s -> a
view Getting Word16 (PParams era) Word16
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppMaxBHSizeL (PParams era -> Word16)
-> (LedgerState (ShelleyBlock proto era) mk -> PParams era)
-> LedgerState (ShelleyBlock proto era) mk
-> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> (LedgerState (ShelleyBlock proto era) mk -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) mk
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState
maxTxSize :: forall (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> Word32
maxTxSize = Getting Word32 (PParams era) Word32 -> PParams era -> Word32
forall a s. Getting a s a -> s -> a
view Getting Word32 (PParams era) Word32
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxTxSizeL (PParams era -> Word32)
-> (LedgerState (ShelleyBlock proto era) mk -> PParams era)
-> LedgerState (ShelleyBlock proto era) mk
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState era -> PParams era
forall era. EraGov era => NewEpochState era -> PParams era
getPParams (NewEpochState era -> PParams era)
-> (LedgerState (ShelleyBlock proto era) mk -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) mk
-> PParams era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState
instance ShelleyCompatible proto era => BasicEnvelopeValidation (ShelleyBlock proto era) where
instance ShelleyCompatible proto era => ValidateEnvelope (ShelleyBlock proto era) where
type (ShelleyBlock proto era) =
EnvelopeCheckError proto
additionalEnvelopeChecks :: TopLevelConfig (ShelleyBlock proto era)
-> LedgerView (BlockProtocol (ShelleyBlock proto era))
-> Header (ShelleyBlock proto era)
-> Except (OtherHeaderEnvelopeError (ShelleyBlock proto era)) ()
additionalEnvelopeChecks TopLevelConfig (ShelleyBlock proto era)
cfg LedgerView (BlockProtocol (ShelleyBlock proto era))
lv Header (ShelleyBlock proto era)
hdr =
ConsensusConfig proto
-> LedgerView proto
-> ShelleyProtocolHeader proto
-> Except (EnvelopeCheckError proto) ()
forall proto.
ProtocolHeaderSupportsEnvelope proto =>
ConsensusConfig proto
-> LedgerView proto
-> ShelleyProtocolHeader proto
-> Except (EnvelopeCheckError proto) ()
envelopeChecks (TopLevelConfig (ShelleyBlock proto era)
-> ConsensusConfig (BlockProtocol (ShelleyBlock proto era))
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus TopLevelConfig (ShelleyBlock proto era)
cfg) LedgerView proto
LedgerView (BlockProtocol (ShelleyBlock proto era))
lv (Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw Header (ShelleyBlock proto era)
hdr)
getPParams :: SL.EraGov era => SL.NewEpochState era -> Core.PParams era
getPParams :: forall era. EraGov era => NewEpochState era -> PParams era
getPParams = Getting (PParams era) (NewEpochState era) (PParams era)
-> NewEpochState era -> PParams era
forall a s. Getting a s a -> s -> a
view (Getting (PParams era) (NewEpochState era) (PParams era)
-> NewEpochState era -> PParams era)
-> Getting (PParams era) (NewEpochState era) (PParams era)
-> NewEpochState era
-> PParams era
forall a b. (a -> b) -> a -> b
$ (GovState era -> Const (PParams era) (GovState era))
-> NewEpochState era -> Const (PParams era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> NewEpochState era -> f (NewEpochState era)
SL.newEpochStateGovStateL ((GovState era -> Const (PParams era) (GovState era))
-> NewEpochState era -> Const (PParams era) (NewEpochState era))
-> ((PParams era -> Const (PParams era) (PParams era))
-> GovState era -> Const (PParams era) (GovState era))
-> Getting (PParams era) (NewEpochState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (PParams era) (PParams era))
-> GovState era -> Const (PParams era) (GovState era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
SL.curPParamsGovStateL
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 :: VersionNumber
serialisationFormatVersion2 = VersionNumber
2
encodeShelleyAnnTip :: AnnTip (ShelleyBlock proto era) -> Encoding
encodeShelleyAnnTip :: forall proto era. AnnTip (ShelleyBlock proto era) -> Encoding
encodeShelleyAnnTip = (HeaderHash (ShelleyBlock proto era) -> Encoding)
-> AnnTip (ShelleyBlock proto era) -> Encoding
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(HeaderHash blk -> Encoding) -> AnnTip blk -> Encoding
defaultEncodeAnnTip HeaderHash (ShelleyBlock proto era) -> Encoding
ShelleyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
decodeShelleyAnnTip :: Decoder s (AnnTip (ShelleyBlock proto era))
decodeShelleyAnnTip :: forall s proto era. Decoder s (AnnTip (ShelleyBlock proto era))
decodeShelleyAnnTip = (forall s. Decoder s (HeaderHash (ShelleyBlock proto era)))
-> forall s. Decoder s (AnnTip (ShelleyBlock proto era))
forall blk.
(TipInfo blk ~ HeaderHash blk) =>
(forall s. Decoder s (HeaderHash blk))
-> forall s. Decoder s (AnnTip blk)
defaultDecodeAnnTip Decoder s (HeaderHash (ShelleyBlock proto era))
Decoder s ShelleyHash
forall s. Decoder s (HeaderHash (ShelleyBlock proto era))
forall s. Decoder s ShelleyHash
forall a s. FromCBOR a => Decoder s a
fromCBOR
encodeShelleyHeaderState ::
ShelleyCompatible proto era
=> HeaderState (ShelleyBlock proto era)
-> Encoding
= (ChainDepState (BlockProtocol (ShelleyBlock proto era))
-> Encoding)
-> (AnnTip (ShelleyBlock proto era) -> Encoding)
-> HeaderState (ShelleyBlock proto era)
-> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
ChainDepState proto -> Encoding
ChainDepState (BlockProtocol (ShelleyBlock proto era)) -> Encoding
forall a. Serialise a => a -> Encoding
encode
AnnTip (ShelleyBlock proto era) -> Encoding
forall proto era. AnnTip (ShelleyBlock proto era) -> Encoding
encodeShelleyAnnTip
encodeShelleyTip :: ShelleyTip proto era -> Encoding
encodeShelleyTip :: forall proto era. ShelleyTip proto era -> Encoding
encodeShelleyTip ShelleyTip {
SlotNo
shelleyTipSlotNo :: forall proto era. ShelleyTip proto era -> SlotNo
shelleyTipSlotNo :: SlotNo
shelleyTipSlotNo
, BlockNo
shelleyTipBlockNo :: forall proto era. ShelleyTip proto era -> BlockNo
shelleyTipBlockNo :: BlockNo
shelleyTipBlockNo
, HeaderHash (ShelleyBlock proto era)
shelleyTipHash :: forall proto era.
ShelleyTip proto era -> HeaderHash (ShelleyBlock proto era)
shelleyTipHash :: HeaderHash (ShelleyBlock proto 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 -> Encoding
forall a. Serialise a => a -> Encoding
encode HeaderHash (ShelleyBlock proto era)
ShelleyHash
shelleyTipHash
]
decodeShelleyTip :: Decoder s (ShelleyTip proto era)
decodeShelleyTip :: forall s proto era. Decoder s (ShelleyTip proto era)
decodeShelleyTip = do
Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ShelleyTip" Int
3
shelleyTipSlotNo <- Decoder s SlotNo
forall s. Decoder s SlotNo
forall a s. Serialise a => Decoder s a
decode
shelleyTipBlockNo <- decode
shelleyTipHash <- decode
return ShelleyTip {
shelleyTipSlotNo
, shelleyTipBlockNo
, shelleyTipHash
}
encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition :: ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransitionInfo{Word32
shelleyAfterVoting :: ShelleyTransition -> Word32
shelleyAfterVoting :: Word32
shelleyAfterVoting} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word32 -> Encoding
CBOR.encodeWord32 Word32
shelleyAfterVoting
]
decodeShelleyTransition :: Decoder s ShelleyTransition
decodeShelleyTransition :: forall s. Decoder s ShelleyTransition
decodeShelleyTransition = do
shelleyAfterVoting <- Decoder s Word32
forall s. Decoder s Word32
CBOR.decodeWord32
return ShelleyTransitionInfo{shelleyAfterVoting}
encodeShelleyLedgerState ::
ShelleyCompatible proto era
=> LedgerState (ShelleyBlock proto era) EmptyMK
-> Encoding
encodeShelleyLedgerState :: forall proto era.
ShelleyCompatible proto era =>
LedgerState (ShelleyBlock proto era) EmptyMK -> Encoding
encodeShelleyLedgerState
ShelleyLedgerState { WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk
-> WithOrigin (ShelleyTip proto era)
shelleyLedgerTip :: WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era
shelleyLedgerState :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState :: NewEpochState era
shelleyLedgerState
, ShelleyTransition
shelleyLedgerTransition :: forall proto era (mk :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk -> ShelleyTransition
shelleyLedgerTransition :: ShelleyTransition
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
3
, (ShelleyTip proto era -> Encoding)
-> WithOrigin (ShelleyTip proto era) -> Encoding
forall a. (a -> Encoding) -> WithOrigin a -> Encoding
encodeWithOrigin ShelleyTip proto era -> Encoding
forall proto era. ShelleyTip proto era -> Encoding
encodeShelleyTip WithOrigin (ShelleyTip proto era)
shelleyLedgerTip
, NewEpochState era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR NewEpochState era
shelleyLedgerState
, ShelleyTransition -> Encoding
encodeShelleyTransition ShelleyTransition
shelleyLedgerTransition
]
decodeShelleyLedgerState ::
forall era proto s. ShelleyCompatible proto era
=> Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
decodeShelleyLedgerState :: forall era proto s.
ShelleyCompatible proto era =>
Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
decodeShelleyLedgerState = [(VersionNumber,
VersionDecoder (LedgerState (ShelleyBlock proto era) EmptyMK))]
-> forall s.
Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
forall a.
[(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion [
(VersionNumber
serialisationFormatVersion2, (forall s.
Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK))
-> VersionDecoder (LedgerState (ShelleyBlock proto era) EmptyMK)
forall a. (forall s. Decoder s a) -> VersionDecoder a
Decode Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
forall s. Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
decodeShelleyLedgerState2)
]
where
decodeShelleyLedgerState2 :: Decoder s' (LedgerState (ShelleyBlock proto era) EmptyMK)
decodeShelleyLedgerState2 :: forall s. Decoder s (LedgerState (ShelleyBlock proto era) EmptyMK)
decodeShelleyLedgerState2 = do
Text -> Int -> Decoder s' ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"LedgerState ShelleyBlock" Int
3
shelleyLedgerTip <- Decoder s' (ShelleyTip proto era)
-> Decoder s' (WithOrigin (ShelleyTip proto era))
forall s a. Decoder s a -> Decoder s (WithOrigin a)
decodeWithOrigin Decoder s' (ShelleyTip proto era)
forall s proto era. Decoder s (ShelleyTip proto era)
decodeShelleyTip
shelleyLedgerState <- fromCBOR
shelleyLedgerTransition <- decodeShelleyTransition
return ShelleyLedgerState {
shelleyLedgerTip
, shelleyLedgerState
, shelleyLedgerTransition
, shelleyLedgerTables = emptyLedgerTables
}
instance CanUpgradeLedgerTables (LedgerState (ShelleyBlock proto era)) where
upgradeTables :: forall (mk1 :: * -> * -> *) (mk2 :: * -> * -> *).
LedgerState (ShelleyBlock proto era) mk1
-> LedgerState (ShelleyBlock proto era) mk2
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
upgradeTables LedgerState (ShelleyBlock proto era) mk1
_ LedgerState (ShelleyBlock proto era) mk2
_ = LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall a. a -> a
id