{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Consensus.Ledger.Extended (
ExtLedgerCfg (..)
, ExtLedgerState (..)
, ExtValidationError (..)
, decodeDiskExtLedgerState
, decodeExtLedgerState
, encodeDiskExtLedgerState
, encodeExtLedgerState
, LedgerTables (..)
, Ticked (..)
) where
import Codec.CBOR.Decoding (Decoder, decodeListLenOf)
import Codec.CBOR.Encoding (Encoding, encodeListLen)
import Control.Monad.Except
import Data.Functor ((<&>))
#if __GLASGOW_HASKELL__ >= 906
import Data.MemPack
#endif
import Data.Proxy
import Data.Typeable
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.IndexedMemPack
data ExtValidationError blk =
ExtValidationErrorLedger !(LedgerError blk)
| !(HeaderError blk)
deriving ((forall x.
ExtValidationError blk -> Rep (ExtValidationError blk) x)
-> (forall x.
Rep (ExtValidationError blk) x -> ExtValidationError blk)
-> Generic (ExtValidationError blk)
forall x. Rep (ExtValidationError blk) x -> ExtValidationError blk
forall x. ExtValidationError blk -> Rep (ExtValidationError blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (ExtValidationError blk) x -> ExtValidationError blk
forall blk x.
ExtValidationError blk -> Rep (ExtValidationError blk) x
$cfrom :: forall blk x.
ExtValidationError blk -> Rep (ExtValidationError blk) x
from :: forall x. ExtValidationError blk -> Rep (ExtValidationError blk) x
$cto :: forall blk x.
Rep (ExtValidationError blk) x -> ExtValidationError blk
to :: forall x. Rep (ExtValidationError blk) x -> ExtValidationError blk
Generic)
deriving instance LedgerSupportsProtocol blk => Eq (ExtValidationError blk)
deriving instance LedgerSupportsProtocol blk => NoThunks (ExtValidationError blk)
deriving instance LedgerSupportsProtocol blk => Show (ExtValidationError blk)
data ExtLedgerState blk mk = ExtLedgerState {
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState :: !(LedgerState blk mk)
, :: !(HeaderState blk)
}
deriving ((forall x. ExtLedgerState blk mk -> Rep (ExtLedgerState blk mk) x)
-> (forall x.
Rep (ExtLedgerState blk mk) x -> ExtLedgerState blk mk)
-> Generic (ExtLedgerState blk mk)
forall x. Rep (ExtLedgerState blk mk) x -> ExtLedgerState blk mk
forall x. ExtLedgerState blk mk -> Rep (ExtLedgerState blk mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk (mk :: MapKind) x.
Rep (ExtLedgerState blk mk) x -> ExtLedgerState blk mk
forall blk (mk :: MapKind) x.
ExtLedgerState blk mk -> Rep (ExtLedgerState blk mk) x
$cfrom :: forall blk (mk :: MapKind) x.
ExtLedgerState blk mk -> Rep (ExtLedgerState blk mk) x
from :: forall x. ExtLedgerState blk mk -> Rep (ExtLedgerState blk mk) x
$cto :: forall blk (mk :: MapKind) x.
Rep (ExtLedgerState blk mk) x -> ExtLedgerState blk mk
to :: forall x. Rep (ExtLedgerState blk mk) x -> ExtLedgerState blk mk
Generic)
deriving instance (EqMK mk, LedgerSupportsProtocol blk)
=> Eq (ExtLedgerState blk mk)
deriving instance (ShowMK mk, LedgerSupportsProtocol blk)
=> Show (ExtLedgerState blk mk)
instance (NoThunksMK mk, LedgerSupportsProtocol blk)
=> NoThunks (ExtLedgerState blk mk) where
showTypeOf :: Proxy (ExtLedgerState blk mk) -> String
showTypeOf Proxy (ExtLedgerState blk mk)
_ = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy (ExtLedgerState blk) -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
forall (t :: LedgerStateKind). Proxy t
Proxy @(ExtLedgerState blk))
type instance (ExtLedgerState blk) = HeaderHash (LedgerState blk)
instance (
NoThunks (HeaderHash blk)
, Typeable (HeaderHash blk)
, Show (HeaderHash blk)
, Ord (HeaderHash blk)
#if __GLASGOW_HASKELL__ >= 906
, Eq (HeaderHash blk)
#endif
) => StandardHash (ExtLedgerState blk)
instance IsLedger (LedgerState blk) => GetTip (ExtLedgerState blk) where
getTip :: forall (mk :: MapKind).
ExtLedgerState blk mk -> Point (ExtLedgerState blk)
getTip = Point (LedgerState blk) -> Point (ExtLedgerState blk)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState blk) -> Point (ExtLedgerState blk))
-> (ExtLedgerState blk mk -> Point (LedgerState blk))
-> ExtLedgerState blk mk
-> Point (ExtLedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk mk -> Point (LedgerState blk)
forall (mk :: MapKind).
LedgerState blk mk -> Point (LedgerState blk)
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip (LedgerState blk mk -> Point (LedgerState blk))
-> (ExtLedgerState blk mk -> LedgerState blk mk)
-> ExtLedgerState blk mk
-> Point (LedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState blk mk -> LedgerState blk mk
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState
newtype ExtLedgerCfg blk = ExtLedgerCfg {
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg :: TopLevelConfig blk
}
deriving ((forall x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x)
-> (forall x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk)
-> Generic (ExtLedgerCfg blk)
forall x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
forall x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
forall blk x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
$cfrom :: forall blk x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
from :: forall x. ExtLedgerCfg blk -> Rep (ExtLedgerCfg blk) x
$cto :: forall blk x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
to :: forall x. Rep (ExtLedgerCfg blk) x -> ExtLedgerCfg blk
Generic)
instance ( ConsensusProtocol (BlockProtocol blk)
, NoThunks (BlockConfig blk)
, NoThunks (CodecConfig blk)
, NoThunks (LedgerConfig blk)
, NoThunks (StorageConfig blk)
, NoThunks (HeaderHash blk)
) => NoThunks (ExtLedgerCfg blk)
type instance LedgerCfg (ExtLedgerState blk) = ExtLedgerCfg blk
data instance Ticked (ExtLedgerState blk) mk = TickedExtLedgerState {
forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk
tickedLedgerState :: Ticked (LedgerState blk) mk
, forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> LedgerView (BlockProtocol blk)
ledgerView :: LedgerView (BlockProtocol blk)
, :: Ticked (HeaderState blk)
}
instance IsLedger (LedgerState blk) => GetTip (Ticked (ExtLedgerState blk)) where
getTip :: forall (mk :: MapKind).
Ticked (ExtLedgerState blk) mk
-> Point (Ticked (ExtLedgerState blk))
getTip = Point (Ticked (LedgerState blk))
-> Point (Ticked (ExtLedgerState blk))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Ticked (LedgerState blk))
-> Point (Ticked (ExtLedgerState blk)))
-> (Ticked (ExtLedgerState blk) mk
-> Point (Ticked (LedgerState blk)))
-> Ticked (ExtLedgerState blk) mk
-> Point (Ticked (ExtLedgerState blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState blk) mk -> Point (Ticked (LedgerState blk))
forall (mk :: MapKind).
Ticked (LedgerState blk) mk -> Point (Ticked (LedgerState blk))
forall (l :: LedgerStateKind) (mk :: MapKind).
GetTip l =>
l mk -> Point l
getTip (Ticked (LedgerState blk) mk -> Point (Ticked (LedgerState blk)))
-> (Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk)
-> Ticked (ExtLedgerState blk) mk
-> Point (Ticked (LedgerState blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk
forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk
tickedLedgerState
instance LedgerSupportsProtocol blk
=> IsLedger (ExtLedgerState blk) where
type LedgerErr (ExtLedgerState blk) = ExtValidationError blk
type AuxLedgerEvent (ExtLedgerState blk) = AuxLedgerEvent (LedgerState blk)
applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> SlotNo
-> ExtLedgerState blk EmptyMK
-> LedgerResult
(ExtLedgerState blk) (Ticked (ExtLedgerState blk) DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg (ExtLedgerState blk)
cfg SlotNo
slot (ExtLedgerState LedgerState blk EmptyMK
ledger HeaderState blk
header) =
LedgerResult (LedgerState blk) (Ticked (LedgerState blk) DiffMK)
-> LedgerResult
(ExtLedgerState blk) (Ticked (LedgerState blk) DiffMK)
forall (l :: LedgerStateKind) (l' :: LedgerStateKind) a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState blk) (Ticked (LedgerState blk) DiffMK)
ledgerResult LedgerResult (ExtLedgerState blk) (Ticked (LedgerState blk) DiffMK)
-> (Ticked (LedgerState blk) DiffMK
-> Ticked (ExtLedgerState blk) DiffMK)
-> LedgerResult
(ExtLedgerState blk) (Ticked (ExtLedgerState blk) DiffMK)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ticked (LedgerState blk) DiffMK
tickedLedgerState ->
let ledgerView :: LedgerView (BlockProtocol blk)
ledgerView :: LedgerView (BlockProtocol blk)
ledgerView = LedgerCfg (LedgerState blk)
-> Ticked (LedgerState blk) DiffMK
-> LedgerView (BlockProtocol blk)
forall blk (mk :: MapKind).
LedgerSupportsProtocol blk =>
LedgerConfig blk
-> Ticked (LedgerState blk) mk -> LedgerView (BlockProtocol blk)
forall (mk :: MapKind).
LedgerCfg (LedgerState blk)
-> Ticked (LedgerState blk) mk -> LedgerView (BlockProtocol blk)
protocolLedgerView LedgerCfg (LedgerState blk)
lcfg Ticked (LedgerState blk) DiffMK
tickedLedgerState
tickedHeaderState :: Ticked (HeaderState blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedHeaderState =
ConsensusConfig (BlockProtocol blk)
-> LedgerView (BlockProtocol blk)
-> SlotNo
-> HeaderState blk
-> Ticked (HeaderState blk)
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
ConsensusConfig (BlockProtocol blk)
-> LedgerView (BlockProtocol blk)
-> SlotNo
-> HeaderState blk
-> Ticked (HeaderState blk)
tickHeaderState
(TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
configConsensus (TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk))
-> TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
LedgerView (BlockProtocol blk)
ledgerView
SlotNo
slot
HeaderState blk
header
in TickedExtLedgerState {Ticked (HeaderState blk)
Ticked (LedgerState blk) DiffMK
LedgerView (BlockProtocol blk)
tickedLedgerState :: Ticked (LedgerState blk) DiffMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedLedgerState :: Ticked (LedgerState blk) DiffMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
..}
where
lcfg :: LedgerConfig blk
lcfg :: LedgerCfg (LedgerState blk)
lcfg = TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerCfg (LedgerState blk))
-> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg
ledgerResult :: LedgerResult (LedgerState blk) (Ticked (LedgerState blk) DiffMK)
ledgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> SlotNo
-> LedgerState blk EmptyMK
-> LedgerResult (LedgerState blk) (Ticked (LedgerState blk) DiffMK)
forall (l :: LedgerStateKind).
IsLedger l =>
ComputeLedgerEvents
-> LedgerCfg l
-> SlotNo
-> l EmptyMK
-> LedgerResult l (Ticked l DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg (LedgerState blk)
lcfg SlotNo
slot LedgerState blk EmptyMK
ledger
applyHelper ::
forall blk.
(HasCallStack, LedgerSupportsProtocol blk)
=> ( HasCallStack
=> ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
)
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyHelper :: forall blk.
(HasCallStack, LedgerSupportsProtocol blk) =>
(HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyHelper HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
f ComputeLedgerEvents
opts LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{Ticked (HeaderState blk)
Ticked (LedgerState blk) ValuesMK
LedgerView (BlockProtocol blk)
tickedLedgerState :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk
ledgerView :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> LedgerView (BlockProtocol blk)
tickedHeaderState :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (HeaderState blk)
tickedLedgerState :: Ticked (LedgerState blk) ValuesMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
..} = do
ledgerResult <-
(LedgerErr (LedgerState blk) -> ExtValidationError blk)
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
-> Except
(ExtValidationError blk)
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept LedgerErr (LedgerState blk) -> ExtValidationError blk
forall blk. LedgerError blk -> ExtValidationError blk
ExtValidationErrorLedger
(Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
-> Except
(ExtValidationError blk)
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
-> Except
(ExtValidationError blk)
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
f ComputeLedgerEvents
opts
(TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerCfg (LedgerState blk))
-> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
blk
blk
Ticked (LedgerState blk) ValuesMK
tickedLedgerState
hdr <-
withExcept ExtValidationErrorHeader
$ validateHeader @blk
(getExtLedgerCfg cfg)
ledgerView
(getHeader blk)
tickedHeaderState
pure $ (\LedgerState blk DiffMK
l -> LedgerState blk DiffMK
-> HeaderState blk -> ExtLedgerState blk DiffMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState LedgerState blk DiffMK
l HeaderState blk
hdr) <$> castLedgerResult ledgerResult
instance LedgerSupportsProtocol blk => ApplyBlock (ExtLedgerState blk) blk where
applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate =
(HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
forall blk.
(HasCallStack, LedgerSupportsProtocol blk) =>
(HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyHelper (ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
forall (l :: LedgerStateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate)
applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyBlockLedgerResult =
(HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
forall blk.
(HasCallStack, LedgerSupportsProtocol blk) =>
(HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> Except
(LedgerErr (ExtLedgerState blk))
(LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK))
applyHelper HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> Except
(LedgerErr (LedgerState blk))
(LedgerResult (LedgerState blk) (LedgerState blk DiffMK))
forall (l :: LedgerStateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> Except (LedgerErr l) (LedgerResult l (l DiffMK))
applyBlockLedgerResult
reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (ExtLedgerState blk)
-> blk
-> Ticked (ExtLedgerState blk) ValuesMK
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK)
reapplyBlockLedgerResult ComputeLedgerEvents
evs LedgerCfg (ExtLedgerState blk)
cfg blk
blk TickedExtLedgerState{Ticked (HeaderState blk)
Ticked (LedgerState blk) ValuesMK
LedgerView (BlockProtocol blk)
tickedLedgerState :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (LedgerState blk) mk
ledgerView :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> LedgerView (BlockProtocol blk)
tickedHeaderState :: forall blk (mk :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (HeaderState blk)
tickedLedgerState :: Ticked (LedgerState blk) ValuesMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
..} =
(\LedgerState blk DiffMK
l -> LedgerState blk DiffMK
-> HeaderState blk -> ExtLedgerState blk DiffMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState LedgerState blk DiffMK
l HeaderState blk
hdr) (LedgerState blk DiffMK -> ExtLedgerState blk DiffMK)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk DiffMK)
-> LedgerResult (ExtLedgerState blk) (ExtLedgerState blk DiffMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerResult (LedgerState blk) (LedgerState blk DiffMK)
-> LedgerResult (ExtLedgerState blk) (LedgerState blk DiffMK)
forall (l :: LedgerStateKind) (l' :: LedgerStateKind) a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState blk) (LedgerState blk DiffMK)
ledgerResult
where
ledgerResult :: LedgerResult (LedgerState blk) (LedgerState blk DiffMK)
ledgerResult =
ComputeLedgerEvents
-> LedgerCfg (LedgerState blk)
-> blk
-> Ticked (LedgerState blk) ValuesMK
-> LedgerResult (LedgerState blk) (LedgerState blk DiffMK)
forall (l :: LedgerStateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l ValuesMK
-> LedgerResult l (l DiffMK)
reapplyBlockLedgerResult ComputeLedgerEvents
evs
(TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall blk. TopLevelConfig blk -> LedgerConfig blk
configLedger (TopLevelConfig blk -> LedgerCfg (LedgerState blk))
-> TopLevelConfig blk -> LedgerCfg (LedgerState blk)
forall a b. (a -> b) -> a -> b
$ ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
blk
blk
Ticked (LedgerState blk) ValuesMK
tickedLedgerState
hdr :: HeaderState blk
hdr =
TopLevelConfig blk
-> LedgerView (BlockProtocol blk)
-> Header blk
-> Ticked (HeaderState blk)
-> HeaderState blk
forall blk.
(BlockSupportsProtocol blk, ValidateEnvelope blk, HasCallStack) =>
TopLevelConfig blk
-> LedgerView (BlockProtocol blk)
-> Header blk
-> Ticked (HeaderState blk)
-> HeaderState blk
revalidateHeader
(ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
cfg)
LedgerView (BlockProtocol blk)
ledgerView
(blk -> Header blk
forall blk. GetHeader blk => blk -> Header blk
getHeader blk
blk)
Ticked (HeaderState blk)
tickedHeaderState
getBlockKeySets :: blk -> LedgerTables (ExtLedgerState blk) KeysMK
getBlockKeySets = LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (ExtLedgerState blk) KeysMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (ExtLedgerState blk) KeysMK)
-> (blk -> LedgerTables (LedgerState blk) KeysMK)
-> blk
-> LedgerTables (ExtLedgerState blk) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: LedgerStateKind) blk.
ApplyBlock l blk =>
blk -> LedgerTables l KeysMK
getBlockKeySets @(LedgerState blk)
encodeExtLedgerState :: (LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk mk -> Encoding
encodeExtLedgerState :: forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk mk
-> Encoding
encodeExtLedgerState LedgerState blk mk -> Encoding
encodeLedgerState
ChainDepState (BlockProtocol blk) -> Encoding
encodeChainDepState
AnnTip blk -> Encoding
encodeAnnTip
ExtLedgerState{LedgerState blk mk
ledgerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState :: LedgerState blk mk
ledgerState, HeaderState blk
headerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> HeaderState blk
headerState :: HeaderState blk
headerState} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word -> Encoding
encodeListLen Word
2
, LedgerState blk mk -> Encoding
encodeLedgerState LedgerState blk mk
ledgerState
, HeaderState blk -> Encoding
encodeHeaderState' HeaderState blk
headerState
]
where
encodeHeaderState' :: HeaderState blk -> Encoding
encodeHeaderState' = (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
forall blk.
(ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding) -> HeaderState blk -> Encoding
encodeHeaderState
ChainDepState (BlockProtocol blk) -> Encoding
encodeChainDepState
AnnTip blk -> Encoding
encodeAnnTip
encodeDiskExtLedgerState ::
forall blk.
(EncodeDisk blk (LedgerState blk EmptyMK),
EncodeDisk blk (ChainDepState (BlockProtocol blk)),
EncodeDisk blk (AnnTip blk)
)
=> (CodecConfig blk -> ExtLedgerState blk EmptyMK -> Encoding)
encodeDiskExtLedgerState :: forall blk.
(EncodeDisk blk (LedgerState blk EmptyMK),
EncodeDisk blk (ChainDepState (BlockProtocol blk)),
EncodeDisk blk (AnnTip blk)) =>
CodecConfig blk -> ExtLedgerState blk EmptyMK -> Encoding
encodeDiskExtLedgerState CodecConfig blk
cfg =
(LedgerState blk EmptyMK -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk EmptyMK
-> Encoding
forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> ExtLedgerState blk mk
-> Encoding
encodeExtLedgerState
(CodecConfig blk -> LedgerState blk EmptyMK -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg)
(CodecConfig blk -> ChainDepState (BlockProtocol blk) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg)
(CodecConfig blk -> AnnTip blk -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig blk
cfg)
decodeExtLedgerState :: (forall s. Decoder s (LedgerState blk EmptyMK))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> (forall s. Decoder s (ExtLedgerState blk EmptyMK))
decodeExtLedgerState :: forall blk.
(forall s. Decoder s (LedgerState blk EmptyMK))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (ExtLedgerState blk EmptyMK)
decodeExtLedgerState forall s. Decoder s (LedgerState blk EmptyMK)
decodeLedgerState
forall s. Decoder s (ChainDepState (BlockProtocol blk))
decodeChainDepState
forall s. Decoder s (AnnTip blk)
decodeAnnTip = do
Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
2
ledgerState <- Decoder s (LedgerState blk EmptyMK)
forall s. Decoder s (LedgerState blk EmptyMK)
decodeLedgerState
headerState <- decodeHeaderState'
return ExtLedgerState{ledgerState, headerState}
where
decodeHeaderState' :: Decoder s (HeaderState blk)
decodeHeaderState' = (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (HeaderState blk)
forall blk.
(forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (HeaderState blk)
decodeHeaderState
Decoder s (ChainDepState (BlockProtocol blk))
forall s. Decoder s (ChainDepState (BlockProtocol blk))
decodeChainDepState
Decoder s (AnnTip blk)
forall s. Decoder s (AnnTip blk)
decodeAnnTip
decodeDiskExtLedgerState ::
forall blk.
(DecodeDisk blk (LedgerState blk EmptyMK),
DecodeDisk blk (ChainDepState (BlockProtocol blk)),
DecodeDisk blk (AnnTip blk)
)
=> (CodecConfig blk -> forall s. Decoder s (ExtLedgerState blk EmptyMK))
decodeDiskExtLedgerState :: forall blk.
(DecodeDisk blk (LedgerState blk EmptyMK),
DecodeDisk blk (ChainDepState (BlockProtocol blk)),
DecodeDisk blk (AnnTip blk)) =>
CodecConfig blk -> forall s. Decoder s (ExtLedgerState blk EmptyMK)
decodeDiskExtLedgerState CodecConfig blk
cfg =
(forall s. Decoder s (LedgerState blk EmptyMK))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (ExtLedgerState blk EmptyMK)
forall blk.
(forall s. Decoder s (LedgerState blk EmptyMK))
-> (forall s. Decoder s (ChainDepState (BlockProtocol blk)))
-> (forall s. Decoder s (AnnTip blk))
-> forall s. Decoder s (ExtLedgerState blk EmptyMK)
decodeExtLedgerState
(CodecConfig blk -> forall s. Decoder s (LedgerState blk EmptyMK)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg)
(CodecConfig blk
-> forall s. Decoder s (ChainDepState (BlockProtocol blk))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg)
(CodecConfig blk -> forall s. Decoder s (AnnTip blk)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg)
type instance TxIn (ExtLedgerState blk) = TxIn (LedgerState blk)
type instance TxOut (ExtLedgerState blk) = TxOut (LedgerState blk)
instance (
HasLedgerTables (LedgerState blk)
#if __GLASGOW_HASKELL__ >= 906
, NoThunks (TxOut (LedgerState blk))
, NoThunks (TxIn (LedgerState blk))
, Show (TxOut (LedgerState blk))
, Show (TxIn (LedgerState blk))
, Eq (TxOut (LedgerState blk))
, Ord (TxIn (LedgerState blk))
, MemPack (TxOut (LedgerState blk))
, MemPack (TxIn (LedgerState blk))
#endif
) => HasLedgerTables (ExtLedgerState blk) where
projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
ExtLedgerState blk mk -> LedgerTables (ExtLedgerState blk) mk
projectLedgerTables (ExtLedgerState LedgerState blk mk
lstate HeaderState blk
_) =
LedgerTables (LedgerState blk) mk
-> LedgerTables (ExtLedgerState blk) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerState blk mk -> LedgerTables (LedgerState blk) mk
forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState blk mk -> LedgerTables (LedgerState blk) mk
forall (l :: LedgerStateKind) (mk :: MapKind).
(HasLedgerTables l, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l mk -> LedgerTables l mk
projectLedgerTables LedgerState blk mk
lstate)
withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
ExtLedgerState blk any
-> LedgerTables (ExtLedgerState blk) mk -> ExtLedgerState blk mk
withLedgerTables (ExtLedgerState LedgerState blk any
lstate HeaderState blk
hstate) LedgerTables (ExtLedgerState blk) mk
tables =
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState
(LedgerState blk any
lstate LedgerState blk any
-> LedgerTables (LedgerState blk) mk -> LedgerState blk mk
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState blk any
-> LedgerTables (LedgerState blk) mk -> LedgerState blk mk
forall (l :: LedgerStateKind) (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l any -> LedgerTables l mk -> l mk
`withLedgerTables` LedgerTables (ExtLedgerState blk) mk
-> LedgerTables (LedgerState blk) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (ExtLedgerState blk) mk
tables)
HeaderState blk
hstate
instance LedgerTablesAreTrivial (LedgerState blk)
=> LedgerTablesAreTrivial (ExtLedgerState blk) where
convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
ExtLedgerState blk mk -> ExtLedgerState blk mk'
convertMapKind (ExtLedgerState LedgerState blk mk
x HeaderState blk
y) = LedgerState blk mk' -> HeaderState blk -> ExtLedgerState blk mk'
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk mk -> LedgerState blk mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState blk mk -> LedgerState blk mk'
forall (l :: LedgerStateKind) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind LedgerState blk mk
x) HeaderState blk
y
instance LedgerTablesAreTrivial (Ticked (LedgerState blk))
=> LedgerTablesAreTrivial (Ticked (ExtLedgerState blk)) where
convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked (ExtLedgerState blk) mk -> Ticked (ExtLedgerState blk) mk'
convertMapKind (TickedExtLedgerState Ticked (LedgerState blk) mk
x LedgerView (BlockProtocol blk)
y Ticked (HeaderState blk)
z) =
Ticked (LedgerState blk) mk'
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> Ticked (ExtLedgerState blk) mk'
forall blk (mk :: MapKind).
Ticked (LedgerState blk) mk
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> Ticked (ExtLedgerState blk) mk
TickedExtLedgerState (Ticked (LedgerState blk) mk -> Ticked (LedgerState blk) mk'
forall (mk :: MapKind) (mk' :: MapKind).
Ticked (LedgerState blk) mk -> Ticked (LedgerState blk) mk'
forall (l :: LedgerStateKind) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind Ticked (LedgerState blk) mk
x) LedgerView (BlockProtocol blk)
y Ticked (HeaderState blk)
z
instance (
HasLedgerTables (Ticked (LedgerState blk))
#if __GLASGOW_HASKELL__ >= 906
, NoThunks (TxOut (LedgerState blk))
, NoThunks (TxIn (LedgerState blk))
, Show (TxOut (LedgerState blk))
, Show (TxIn (LedgerState blk))
, Eq (TxOut (LedgerState blk))
, Ord (TxIn (LedgerState blk))
, MemPack (TxIn (LedgerState blk))
, MemPack (TxOut (LedgerState blk))
#endif
) => HasLedgerTables (Ticked (ExtLedgerState blk)) where
projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (ExtLedgerState blk) mk
-> LedgerTables (Ticked (ExtLedgerState blk)) mk
projectLedgerTables (TickedExtLedgerState Ticked (LedgerState blk) mk
lstate LedgerView (BlockProtocol blk)
_view Ticked (HeaderState blk)
_hstate) =
LedgerTables (Ticked (LedgerState blk)) mk
-> LedgerTables (Ticked (ExtLedgerState blk)) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (Ticked (LedgerState blk) mk
-> LedgerTables (Ticked (LedgerState blk)) mk
forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState blk) mk
-> LedgerTables (Ticked (LedgerState blk)) mk
forall (l :: LedgerStateKind) (mk :: MapKind).
(HasLedgerTables l, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l mk -> LedgerTables l mk
projectLedgerTables Ticked (LedgerState blk) mk
lstate)
withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (ExtLedgerState blk) any
-> LedgerTables (Ticked (ExtLedgerState blk)) mk
-> Ticked (ExtLedgerState blk) mk
withLedgerTables
(TickedExtLedgerState Ticked (LedgerState blk) any
lstate LedgerView (BlockProtocol blk)
view Ticked (HeaderState blk)
hstate)
LedgerTables (Ticked (ExtLedgerState blk)) mk
tables =
Ticked (LedgerState blk) mk
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> Ticked (ExtLedgerState blk) mk
forall blk (mk :: MapKind).
Ticked (LedgerState blk) mk
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> Ticked (ExtLedgerState blk) mk
TickedExtLedgerState
(Ticked (LedgerState blk) any
lstate Ticked (LedgerState blk) any
-> LedgerTables (Ticked (LedgerState blk)) mk
-> Ticked (LedgerState blk) mk
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked (LedgerState blk) any
-> LedgerTables (Ticked (LedgerState blk)) mk
-> Ticked (LedgerState blk) mk
forall (l :: LedgerStateKind) (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l, CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l any -> LedgerTables l mk -> l mk
`withLedgerTables` LedgerTables (Ticked (ExtLedgerState blk)) mk
-> LedgerTables (Ticked (LedgerState blk)) mk
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
(mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (Ticked (ExtLedgerState blk)) mk
tables)
LedgerView (BlockProtocol blk)
view
Ticked (HeaderState blk)
hstate
instance CanStowLedgerTables (LedgerState blk)
=> CanStowLedgerTables (ExtLedgerState blk) where
stowLedgerTables :: ExtLedgerState blk ValuesMK -> ExtLedgerState blk EmptyMK
stowLedgerTables (ExtLedgerState LedgerState blk ValuesMK
lstate HeaderState blk
hstate) =
LedgerState blk EmptyMK
-> HeaderState blk -> ExtLedgerState blk EmptyMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk ValuesMK -> LedgerState blk EmptyMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables LedgerState blk ValuesMK
lstate) HeaderState blk
hstate
unstowLedgerTables :: ExtLedgerState blk EmptyMK -> ExtLedgerState blk ValuesMK
unstowLedgerTables (ExtLedgerState LedgerState blk EmptyMK
lstate HeaderState blk
hstate) =
LedgerState blk ValuesMK
-> HeaderState blk -> ExtLedgerState blk ValuesMK
forall blk (mk :: MapKind).
LedgerState blk mk -> HeaderState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk EmptyMK -> LedgerState blk ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables LedgerState blk EmptyMK
lstate) HeaderState blk
hstate
instance (txout ~ (TxOut (LedgerState blk)), IndexedMemPack (LedgerState blk EmptyMK) txout)
=> IndexedMemPack (ExtLedgerState blk EmptyMK) txout where
indexedTypeName :: ExtLedgerState blk EmptyMK -> String
indexedTypeName (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_) = forall idx a. IndexedMemPack idx a => idx -> String
indexedTypeName @(LedgerState blk EmptyMK) @txout LedgerState blk EmptyMK
st
indexedPackedByteCount :: ExtLedgerState blk EmptyMK -> txout -> Int
indexedPackedByteCount (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_) = LedgerState blk EmptyMK -> txout -> Int
forall idx a. IndexedMemPack idx a => idx -> a -> Int
indexedPackedByteCount LedgerState blk EmptyMK
st
indexedPackM :: forall s. ExtLedgerState blk EmptyMK -> txout -> Pack s ()
indexedPackM (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_) = LedgerState blk EmptyMK -> txout -> Pack s ()
forall s. LedgerState blk EmptyMK -> txout -> Pack s ()
forall idx a s. IndexedMemPack idx a => idx -> a -> Pack s ()
indexedPackM LedgerState blk EmptyMK
st
indexedUnpackM :: forall b. Buffer b => ExtLedgerState blk EmptyMK -> Unpack b txout
indexedUnpackM (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_) = LedgerState blk EmptyMK -> Unpack b txout
forall b. Buffer b => LedgerState blk EmptyMK -> Unpack b txout
forall idx a b.
(IndexedMemPack idx a, Buffer b) =>
idx -> Unpack b a
indexedUnpackM LedgerState blk EmptyMK
st