{- HLINT ignore "Unused LANGUAGE pragma" -}
-- False hint on TypeOperators
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Ledger.Extended
  ( -- * Extended ledger state
    ExtLedgerCfg (..)
  , ExtLedgerState (..)
  , ExtValidationError (..)

    -- * Serialisation
  , decodeDiskExtLedgerState
  , decodeExtLedgerState
  , encodeDiskExtLedgerState
  , encodeExtLedgerState
  , initPerasEpochContextResolver
  , mkPerasEpochContextResolverHandle

    -- * Type family instances
  , LedgerTables (..)
  , Ticked (..)
  ) where

import Cardano.Ledger.Binary (DecoderError (..), cborError)
import Codec.CBOR.Decoding (Decoder, decodeListLen)
import Codec.CBOR.Encoding (Encoding, encodeListLen)
import Control.DeepSeq (NFData)
import Control.Monad.Except
import Control.Monad.Trans.Except (except)
import Data.Functor ((<&>))
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Proxy
import Data.SOP.Constraint (All, Top)
import qualified Data.Text as Text
import Data.Typeable
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import NoThunks.Class (NoThunks (..))
import Ouroboros.Consensus.Block.Abstract
  ( BlockConfig
  , BlockProtocol
  , CodecConfig
  , GetHeader (getHeader)
  , HeaderHash
  , StandardHash
  , StorageConfig
  , castPoint
  )
import Ouroboros.Consensus.Block.SupportsPeras
  ( BlockSupportsPeras (..)
  , IsPerasCert (..)
  , ValidatedPerasCert (..)
  , pattern NoPerasEnabled
  )
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Abstract (HasHardForkHistory (HardForkIndices))
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Peras (PerasState (..))
import Ouroboros.Consensus.Ledger.SupportsProtocol
import Ouroboros.Consensus.Ledger.Tables.Utils (forgetLedgerTables)
import Ouroboros.Consensus.Peras.Context
  ( PerasEpochContextNotFoundForRound
  , PerasEpochContextResolver (..)
  , PerasEpochContextResolverHandle (..)
  , StateSupportsPerasEpochContext (..)
  , initPerasEpochContextResolver
  , resolveRoundNo
  , tickPerasEpochContextResolver
  )
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.IOLike (MonadSTM (STM))
import Ouroboros.Consensus.Util.IndexedMemPack

{-------------------------------------------------------------------------------
  Extended ledger state
-------------------------------------------------------------------------------}

data ExtValidationError blk
  = ExtValidationErrorLedger !(LedgerErr LedgerState blk)
  | ExtValidationErrorHeader !(HeaderError blk)
  | ExtValidationErrorPerasEpochContextResolver !PerasEpochContextNotFoundForRound
  | ExtValidationErrorPerasCertInBlock !(PerasError 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
  ( Eq (PerasError blk)
  , LedgerSupportsProtocol blk
  ) =>
  Eq (ExtValidationError blk)
deriving instance
  ( NoThunks (PerasError blk)
  , LedgerSupportsProtocol blk
  ) =>
  NoThunks (ExtValidationError blk)
deriving instance
  ( Show (PerasError blk)
  , LedgerSupportsProtocol blk
  ) =>
  Show (ExtValidationError blk)

-- | Extended ledger state
--
-- This is the combination of the header state and the ledger state proper.
data ExtLedgerState blk mk = ExtLedgerState
  { forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState :: !(LedgerState blk mk)
  , forall blk (mk :: MapKind).
ExtLedgerState blk mk -> HeaderState blk
headerState :: !(HeaderState blk)
  , forall blk (mk :: MapKind). ExtLedgerState blk mk -> PerasState blk
perasState :: !(PerasState 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
  , Eq (PerasState blk)
  , LedgerSupportsProtocol blk
  ) =>
  Eq (ExtLedgerState blk mk)
deriving instance
  ( ShowMK mk
  , Show (PerasState blk)
  , LedgerSupportsProtocol blk
  ) =>
  Show (ExtLedgerState blk mk)

-- | We override 'showTypeOf' to show the type of the block
--
-- This makes debugging a bit easier, as the block gets used to resolve all
-- kinds of type families.
instance
  ( NoThunksMK mk
  , NoThunks (PerasState blk)
  , 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 :: MapKind -> *). Proxy t
Proxy @(ExtLedgerState blk))

type instance HeaderHash (ExtLedgerState blk) = HeaderHash (LedgerState blk)
instance
  ( NFData (HeaderHash blk)
  , NoThunks (HeaderHash blk)
  , Typeable (HeaderHash blk)
  , Show (HeaderHash blk)
  , Ord (HeaderHash blk)
  , Eq (HeaderHash blk)
  ) =>
  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 :: MapKind -> *) (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

mkPerasEpochContextResolverHandle ::
  MonadSTM m =>
  STM m (ExtLedgerState blk mk) ->
  PerasEpochContextResolverHandle m blk
mkPerasEpochContextResolverHandle :: forall (m :: * -> *) blk (mk :: MapKind).
MonadSTM m =>
STM m (ExtLedgerState blk mk)
-> PerasEpochContextResolverHandle m blk
mkPerasEpochContextResolverHandle STM m (ExtLedgerState blk mk)
getLedgerStateSTM =
  STM m (PerasEpochContextResolver blk)
-> PerasEpochContextResolverHandle m blk
forall (m :: * -> *) blk.
STM m (PerasEpochContextResolver blk)
-> PerasEpochContextResolverHandle m blk
PerasEpochContextResolverHandle (STM m (PerasEpochContextResolver blk)
 -> PerasEpochContextResolverHandle m blk)
-> STM m (PerasEpochContextResolver blk)
-> PerasEpochContextResolverHandle m blk
forall a b. (a -> b) -> a -> b
$
    PerasState blk -> PerasEpochContextResolver blk
forall blk. PerasState blk -> PerasEpochContextResolver blk
perasEpochContextResolver
      (PerasState blk -> PerasEpochContextResolver blk)
-> (ExtLedgerState blk mk -> PerasState blk)
-> ExtLedgerState blk mk
-> PerasEpochContextResolver blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState blk mk -> PerasState blk
forall blk (mk :: MapKind). ExtLedgerState blk mk -> PerasState blk
perasState
      (ExtLedgerState blk mk -> PerasEpochContextResolver blk)
-> STM m (ExtLedgerState blk mk)
-> STM m (PerasEpochContextResolver blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (ExtLedgerState blk mk)
getLedgerStateSTM

{-------------------------------------------------------------------------------
  The extended ledger configuration
-------------------------------------------------------------------------------}

-- | " Ledger " configuration for the extended ledger
--
-- Since the extended ledger also does the consensus protocol validation, we
-- also need the consensus config.
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

{-------------------------------------------------------------------------------
  The ticked extended ledger state
-------------------------------------------------------------------------------}

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)
  , forall blk (mk :: MapKind).
Ticked ExtLedgerState blk mk -> Ticked (HeaderState blk)
tickedHeaderState :: Ticked (HeaderState blk)
  , forall blk (mk :: MapKind).
Ticked ExtLedgerState blk mk -> PerasState blk
tickedPerasState :: PerasState 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 :: MapKind -> *) (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
  , BlockSupportsPeras blk
  , StateSupportsPerasEpochContext blk
  , All Top (HardForkIndices blk)
  ) =>
  IsLedger ExtLedgerState blk
  where
  type LedgerErr ExtLedgerState blk = ExtValidationError blk

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> SlotNo
-> ExtLedgerState blk EmptyMK
-> LedgerResult blk (Ticked ExtLedgerState blk DiffMK)
applyChainTickLedgerResult
    ComputeLedgerEvents
evs
    LedgerCfg ExtLedgerState blk
cfg
    SlotNo
slot
    ExtLedgerState
      { LedgerState blk EmptyMK
ledgerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState :: LedgerState blk EmptyMK
ledgerState
      , HeaderState blk
headerState :: forall blk (mk :: MapKind).
ExtLedgerState blk mk -> HeaderState blk
headerState :: HeaderState blk
headerState
      , PerasState blk
perasState :: forall blk (mk :: MapKind). ExtLedgerState blk mk -> PerasState blk
perasState :: PerasState blk
perasState
      } =
      LedgerResult blk (Ticked LedgerState blk DiffMK)
-> LedgerResult blk (Ticked LedgerState blk DiffMK)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult blk (Ticked LedgerState blk DiffMK)
ledgerResult LedgerResult blk (Ticked LedgerState blk DiffMK)
-> (Ticked LedgerState blk DiffMK
    -> Ticked ExtLedgerState blk DiffMK)
-> LedgerResult 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
headerState

            tickedPerasState :: PerasState blk
tickedPerasState =
              PerasState
                { perasEpochContextResolver :: PerasEpochContextResolver blk
perasEpochContextResolver =
                    LedgerCfg LedgerState blk
-> (PerasEpochContextResolver blk, LedgerState blk EmptyMK,
    HeaderState blk)
-> (SlotNo, Ticked LedgerState blk EmptyMK,
    Ticked (HeaderState blk))
-> PerasEpochContextResolver blk
forall blk.
(All Top (HardForkIndices blk),
 StateSupportsPerasEpochContext blk) =>
LedgerConfig blk
-> (PerasEpochContextResolver blk, LedgerState blk EmptyMK,
    HeaderState blk)
-> (SlotNo, Ticked LedgerState blk EmptyMK,
    Ticked (HeaderState blk))
-> PerasEpochContextResolver blk
tickPerasEpochContextResolver
                      LedgerCfg LedgerState blk
lcfg
                      (PerasState blk -> PerasEpochContextResolver blk
forall blk. PerasState blk -> PerasEpochContextResolver blk
perasEpochContextResolver PerasState blk
perasState, LedgerState blk EmptyMK
ledgerState, HeaderState blk
headerState)
                      (SlotNo
slot, Ticked LedgerState blk DiffMK -> Ticked LedgerState blk EmptyMK
forall (l :: StateKind) blk (mk :: MapKind).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables Ticked LedgerState blk DiffMK
tickedLedgerState, Ticked (HeaderState blk)
tickedHeaderState)
                , latestPerasCertOnChainRound :: StrictMaybe PerasRoundNo
latestPerasCertOnChainRound =
                    PerasState blk -> StrictMaybe PerasRoundNo
forall blk. PerasState blk -> StrictMaybe PerasRoundNo
latestPerasCertOnChainRound PerasState blk
perasState
                }
         in TickedExtLedgerState{Ticked (HeaderState blk)
Ticked LedgerState blk DiffMK
LedgerView (BlockProtocol blk)
PerasState blk
tickedLedgerState :: Ticked LedgerState blk DiffMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedPerasState :: PerasState blk
tickedLedgerState :: Ticked LedgerState blk DiffMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedPerasState :: PerasState 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 blk (Ticked LedgerState blk DiffMK)
ledgerResult = ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> SlotNo
-> LedgerState blk EmptyMK
-> LedgerResult blk (Ticked LedgerState blk DiffMK)
forall (l :: StateKind) blk.
IsLedger l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> SlotNo
-> l blk EmptyMK
-> LedgerResult blk (Ticked l blk DiffMK)
applyChainTickLedgerResult ComputeLedgerEvents
evs LedgerCfg LedgerState blk
lcfg SlotNo
slot LedgerState blk EmptyMK
ledgerState

applyHelper ::
  forall blk.
  ( HasCallStack
  , LedgerSupportsProtocol blk
  , BlockSupportsPeras blk
  ) =>
  ( HasCallStack =>
    ComputeLedgerEvents ->
    LedgerCfg LedgerState blk ->
    blk ->
    Ticked LedgerState blk ValuesMK ->
    Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK))
  ) ->
  ComputeLedgerEvents ->
  LedgerCfg ExtLedgerState blk ->
  blk ->
  Ticked ExtLedgerState blk ValuesMK ->
  Except
    (LedgerErr ExtLedgerState blk)
    (LedgerResult blk (ExtLedgerState blk DiffMK))
applyHelper :: forall blk.
(HasCallStack, LedgerSupportsProtocol blk,
 BlockSupportsPeras blk) =>
(HasCallStack =>
 ComputeLedgerEvents
 -> LedgerCfg LedgerState blk
 -> blk
 -> Ticked LedgerState blk ValuesMK
 -> Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
applyHelper HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
f ComputeLedgerEvents
opts LedgerCfg ExtLedgerState blk
cfg blk
blk TickedExtLedgerState{Ticked (HeaderState blk)
Ticked LedgerState blk ValuesMK
LedgerView (BlockProtocol blk)
PerasState 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)
tickedPerasState :: forall blk (mk :: MapKind).
Ticked ExtLedgerState blk mk -> PerasState blk
tickedLedgerState :: Ticked LedgerState blk ValuesMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedPerasState :: PerasState blk
..} = do
  ledgerResult <-
    (LedgerErr LedgerState blk -> ExtValidationError blk)
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
-> Except
     (ExtValidationError blk)
     (LedgerResult blk (LedgerState blk DiffMK))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept LedgerErr LedgerState blk -> ExtValidationError blk
forall blk. LedgerErr LedgerState blk -> ExtValidationError blk
ExtValidationErrorLedger (Except
   (LedgerErr LedgerState blk)
   (LedgerResult blk (LedgerState blk DiffMK))
 -> Except
      (ExtValidationError blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
-> Except
     (ExtValidationError blk)
     (LedgerResult 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 blk (LedgerState blk DiffMK))
ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult 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
  perasState <- do
    -- Only when ticking the 'ExtLedgerState' do we need to update the
    -- 'PerasEpochContextResolver'. When applying block on top of a 'Ticked
    -- ExtLedgerState', the 'PerasEpochContextResolver' has already been put to
    -- the right state by the ticking.
    let perasResolver = PerasState blk -> PerasEpochContextResolver blk
forall blk. PerasState blk -> PerasEpochContextResolver blk
perasEpochContextResolver PerasState blk
tickedPerasState
    -- Update the latest Peras certificate round if the new block contains a
    -- certificate from a round more recent than the currently cached one.
    mbPerasCert <- extractAndValidatePerasCertFromBlock perasResolver blk
    let latestCertRound =
          case ValidatedPerasCert blk -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound (ValidatedPerasCert blk -> PerasRoundNo)
-> Maybe (ValidatedPerasCert blk) -> Maybe PerasRoundNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (ValidatedPerasCert blk)
mbPerasCert of
            -- The block does not contain a Peras certificate => keep the old one
            Maybe PerasRoundNo
Nothing -> do
              PerasState blk -> StrictMaybe PerasRoundNo
forall blk. PerasState blk -> StrictMaybe PerasRoundNo
latestPerasCertOnChainRound PerasState blk
tickedPerasState
            -- The block contains a Peras certificate => keep the youngest one
            Just PerasRoundNo
certInBlockRound -> do
              case PerasState blk -> StrictMaybe PerasRoundNo
forall blk. PerasState blk -> StrictMaybe PerasRoundNo
latestPerasCertOnChainRound PerasState blk
tickedPerasState of
                StrictMaybe PerasRoundNo
SNothing ->
                  PerasRoundNo -> StrictMaybe PerasRoundNo
forall a. a -> StrictMaybe a
SJust PerasRoundNo
certInBlockRound
                SJust PerasRoundNo
prevLatestCertOnChainRound ->
                  PerasRoundNo -> StrictMaybe PerasRoundNo
forall a. a -> StrictMaybe a
SJust (PerasRoundNo
certInBlockRound PerasRoundNo -> PerasRoundNo -> PerasRoundNo
forall a. Ord a => a -> a -> a
`max` PerasRoundNo
prevLatestCertOnChainRound)
    pure $
      PerasState
        { perasEpochContextResolver =
            perasResolver
        , latestPerasCertOnChainRound =
            latestCertRound
        }

  pure $
    (\LedgerState blk DiffMK
l -> LedgerState blk DiffMK
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk DiffMK
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState LedgerState blk DiffMK
l HeaderState blk
hdr PerasState blk
perasState) <$> castLedgerResult ledgerResult

-- | Extract and validate a Peras certificate from a block, if it exists.
--
-- This can fail in several ways:
-- 1. The block contains a Peras certificate that cannot be deserialized (temporary).
-- 2. The certificate claims to be from a round we cannot resolve.
-- 3. The certificate is invalid in the epoch resolved for its round.
extractAndValidatePerasCertFromBlock ::
  forall blk.
  BlockSupportsPeras blk =>
  PerasEpochContextResolver blk ->
  blk ->
  Except (LedgerErr ExtLedgerState blk) (Maybe (ValidatedPerasCert blk))
extractAndValidatePerasCertFromBlock :: forall blk.
BlockSupportsPeras blk =>
PerasEpochContextResolver blk
-> blk
-> Except
     (LedgerErr ExtLedgerState blk) (Maybe (ValidatedPerasCert blk))
extractAndValidatePerasCertFromBlock PerasEpochContextResolver blk
perasResolver blk
blk = do
  blk
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (PerasCert blk))
getPerasCertInBlockOrFail blk
blk ExceptT (ExtValidationError blk) Identity (Maybe (PerasCert blk))
-> (Maybe (PerasCert blk)
    -> ExceptT
         (ExtValidationError blk) Identity (Maybe (ValidatedPerasCert blk)))
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (ValidatedPerasCert blk))
forall a b.
ExceptT (ExtValidationError blk) Identity a
-> (a -> ExceptT (ExtValidationError blk) Identity b)
-> ExceptT (ExtValidationError blk) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (PerasCert blk)
Nothing ->
      Maybe (ValidatedPerasCert blk)
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (ValidatedPerasCert blk))
forall a. a -> ExceptT (ExtValidationError blk) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ValidatedPerasCert blk)
forall a. Maybe a
Nothing
    Just PerasCert blk
cert -> do
      let roundNo :: PerasRoundNo
roundNo = PerasCert blk -> PerasRoundNo
forall cert blk. IsPerasCert cert blk => cert -> PerasRoundNo
getPerasCertRound PerasCert blk
cert
      context <- PerasRoundNo
-> ExceptT
     (ExtValidationError blk) Identity (PerasEpochContext blk)
resolveRoundNoOrFail PerasRoundNo
roundNo
      Just <$> verifyPerasCertOrFail context cert
 where
  getPerasCertInBlockOrFail :: blk
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (PerasCert blk))
getPerasCertInBlockOrFail =
    (PerasError blk -> ExtValidationError blk)
-> Except (PerasError blk) (Maybe (PerasCert blk))
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (PerasCert blk))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept PerasError blk -> ExtValidationError blk
forall blk. PerasError blk -> ExtValidationError blk
ExtValidationErrorPerasCertInBlock
      (Except (PerasError blk) (Maybe (PerasCert blk))
 -> ExceptT
      (ExtValidationError blk) Identity (Maybe (PerasCert blk)))
-> (blk -> Except (PerasError blk) (Maybe (PerasCert blk)))
-> blk
-> ExceptT
     (ExtValidationError blk) Identity (Maybe (PerasCert blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (PerasError blk) (Maybe (PerasCert blk))
-> Except (PerasError blk) (Maybe (PerasCert blk))
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
      (Either (PerasError blk) (Maybe (PerasCert blk))
 -> Except (PerasError blk) (Maybe (PerasCert blk)))
-> (blk -> Either (PerasError blk) (Maybe (PerasCert blk)))
-> blk
-> Except (PerasError blk) (Maybe (PerasCert blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> Either (PerasError blk) (Maybe (PerasCert blk))
forall blk.
BlockSupportsPeras blk =>
blk -> Either (PerasError blk) (Maybe (PerasCert blk))
getPerasCertInBlock

  resolveRoundNoOrFail :: PerasRoundNo
-> ExceptT
     (ExtValidationError blk) Identity (PerasEpochContext blk)
resolveRoundNoOrFail =
    (PerasEpochContextNotFoundForRound -> ExtValidationError blk)
-> Except PerasEpochContextNotFoundForRound (PerasEpochContext blk)
-> ExceptT
     (ExtValidationError blk) Identity (PerasEpochContext blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept PerasEpochContextNotFoundForRound -> ExtValidationError blk
forall blk.
PerasEpochContextNotFoundForRound -> ExtValidationError blk
ExtValidationErrorPerasEpochContextResolver
      (Except PerasEpochContextNotFoundForRound (PerasEpochContext blk)
 -> ExceptT
      (ExtValidationError blk) Identity (PerasEpochContext blk))
-> (PerasRoundNo
    -> Except
         PerasEpochContextNotFoundForRound (PerasEpochContext blk))
-> PerasRoundNo
-> ExceptT
     (ExtValidationError blk) Identity (PerasEpochContext blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either PerasEpochContextNotFoundForRound (PerasEpochContext blk)
-> Except PerasEpochContextNotFoundForRound (PerasEpochContext blk)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
      (Either PerasEpochContextNotFoundForRound (PerasEpochContext blk)
 -> Except
      PerasEpochContextNotFoundForRound (PerasEpochContext blk))
-> (PerasRoundNo
    -> Either
         PerasEpochContextNotFoundForRound (PerasEpochContext blk))
-> PerasRoundNo
-> Except PerasEpochContextNotFoundForRound (PerasEpochContext blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasEpochContextResolver blk
-> PerasRoundNo
-> Either PerasEpochContextNotFoundForRound (PerasEpochContext blk)
forall blk.
PerasEpochContextResolver blk
-> PerasRoundNo
-> Either PerasEpochContextNotFoundForRound (PerasEpochContext blk)
resolveRoundNo PerasEpochContextResolver blk
perasResolver

  verifyPerasCertOrFail :: PerasEpochContext blk
-> PerasCert blk
-> ExceptT
     (ExtValidationError blk) Identity (ValidatedPerasCert blk)
verifyPerasCertOrFail PerasEpochContext blk
context =
    (PerasError blk -> ExtValidationError blk)
-> Except (PerasError blk) (ValidatedPerasCert blk)
-> ExceptT
     (ExtValidationError blk) Identity (ValidatedPerasCert blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept PerasError blk -> ExtValidationError blk
forall blk. PerasError blk -> ExtValidationError blk
ExtValidationErrorPerasCertInBlock
      (Except (PerasError blk) (ValidatedPerasCert blk)
 -> ExceptT
      (ExtValidationError blk) Identity (ValidatedPerasCert blk))
-> (PerasCert blk
    -> Except (PerasError blk) (ValidatedPerasCert blk))
-> PerasCert blk
-> ExceptT
     (ExtValidationError blk) Identity (ValidatedPerasCert blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (PerasError blk) (ValidatedPerasCert blk)
-> Except (PerasError blk) (ValidatedPerasCert blk)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except
      (Either (PerasError blk) (ValidatedPerasCert blk)
 -> Except (PerasError blk) (ValidatedPerasCert blk))
-> (PerasCert blk
    -> Either (PerasError blk) (ValidatedPerasCert blk))
-> PerasCert blk
-> Except (PerasError blk) (ValidatedPerasCert blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasEpochContext blk
-> PerasCert blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
forall blk.
BlockSupportsPeras blk =>
PerasEpochContext blk
-> PerasCert blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
verifyPerasCert PerasEpochContext blk
context

instance
  ( GetBlockKeySets blk
  , LedgerSupportsProtocol blk
  , BlockSupportsPeras blk
  , StateSupportsPerasEpochContext blk
  , All Top (HardForkIndices blk)
  ) =>
  ApplyBlock ExtLedgerState blk
  where
  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate =
    (HasCallStack =>
 ComputeLedgerEvents
 -> LedgerCfg LedgerState blk
 -> blk
 -> Ticked LedgerState blk ValuesMK
 -> Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
forall blk.
(HasCallStack, LedgerSupportsProtocol blk,
 BlockSupportsPeras blk) =>
(HasCallStack =>
 ComputeLedgerEvents
 -> LedgerCfg LedgerState blk
 -> blk
 -> Ticked LedgerState blk ValuesMK
 -> Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
applyHelper (ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate)

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
applyBlockLedgerResult =
    (HasCallStack =>
 ComputeLedgerEvents
 -> LedgerCfg LedgerState blk
 -> blk
 -> Ticked LedgerState blk ValuesMK
 -> Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
forall blk.
(HasCallStack, LedgerSupportsProtocol blk,
 BlockSupportsPeras blk) =>
(HasCallStack =>
 ComputeLedgerEvents
 -> LedgerCfg LedgerState blk
 -> blk
 -> Ticked LedgerState blk ValuesMK
 -> Except
      (LedgerErr LedgerState blk)
      (LedgerResult blk (LedgerState blk DiffMK)))
-> ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> Except
     (LedgerErr ExtLedgerState blk)
     (LedgerResult blk (ExtLedgerState blk DiffMK))
applyHelper HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (LedgerErr LedgerState blk)
     (LedgerResult blk (LedgerState blk DiffMK))
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> Except (LedgerErr l blk) (LedgerResult blk (l blk DiffMK))
applyBlockLedgerResult

  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg ExtLedgerState blk
-> blk
-> Ticked ExtLedgerState blk ValuesMK
-> LedgerResult blk (ExtLedgerState blk DiffMK)
reapplyBlockLedgerResult ComputeLedgerEvents
evs LedgerCfg ExtLedgerState blk
cfg blk
blk TickedExtLedgerState{Ticked (HeaderState blk)
Ticked LedgerState blk ValuesMK
LedgerView (BlockProtocol blk)
PerasState 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)
tickedPerasState :: forall blk (mk :: MapKind).
Ticked ExtLedgerState blk mk -> PerasState blk
tickedLedgerState :: Ticked LedgerState blk ValuesMK
ledgerView :: LedgerView (BlockProtocol blk)
tickedHeaderState :: Ticked (HeaderState blk)
tickedPerasState :: PerasState blk
..} =
    (\LedgerState blk DiffMK
l -> LedgerState blk DiffMK
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk DiffMK
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState LedgerState blk DiffMK
l HeaderState blk
hdr PerasState blk
perasState) (LedgerState blk DiffMK -> ExtLedgerState blk DiffMK)
-> LedgerResult blk (LedgerState blk DiffMK)
-> LedgerResult blk (ExtLedgerState blk DiffMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerResult blk (LedgerState blk DiffMK)
-> LedgerResult blk (LedgerState blk DiffMK)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult blk (LedgerState blk DiffMK)
ledgerResult
   where
    ledgerResult :: LedgerResult blk (LedgerState blk DiffMK)
ledgerResult =
      ComputeLedgerEvents
-> LedgerCfg LedgerState blk
-> blk
-> Ticked LedgerState blk ValuesMK
-> LedgerResult blk (LedgerState blk DiffMK)
forall (l :: StateKind) blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> Ticked l blk ValuesMK
-> LedgerResult blk (l blk 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
    -- Only when ticking the 'ExtLedgerState' do we need to update the
    -- 'PerasEpochContextResolver'. When applying block on top of a 'Ticked
    -- ExtLedgerState', the 'PerasEpochContextResolver' has already been put to
    -- the right state by the ticking.
    perasState :: PerasState blk
perasState = PerasState blk
tickedPerasState

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

encodeExtLedgerState ::
  (LedgerState blk mk -> Encoding) ->
  (ChainDepState (BlockProtocol blk) -> Encoding) ->
  (AnnTip blk -> Encoding) ->
  (PerasState blk -> Encoding) ->
  ExtLedgerState blk mk ->
  Encoding
encodeExtLedgerState :: forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> (PerasState blk -> Encoding)
-> ExtLedgerState blk mk
-> Encoding
encodeExtLedgerState
  LedgerState blk mk -> Encoding
encodeLedgerState
  ChainDepState (BlockProtocol blk) -> Encoding
encodeChainDepState
  AnnTip blk -> Encoding
encodeAnnTip
  PerasState blk -> Encoding
encodePerasState'
  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
    , PerasState blk
perasState :: forall blk (mk :: MapKind). ExtLedgerState blk mk -> PerasState blk
perasState :: PerasState blk
perasState
    } =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
3
      , LedgerState blk mk -> Encoding
encodeLedgerState LedgerState blk mk
ledgerState
      , HeaderState blk -> Encoding
encodeHeaderState' HeaderState blk
headerState
      , PerasState blk -> Encoding
encodePerasState' PerasState blk
perasState
      ]
   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)
  , EncodeDisk blk (PerasState blk)
  ) =>
  (CodecConfig blk -> ExtLedgerState blk EmptyMK -> Encoding)
encodeDiskExtLedgerState :: forall blk.
(EncodeDisk blk (LedgerState blk EmptyMK),
 EncodeDisk blk (ChainDepState (BlockProtocol blk)),
 EncodeDisk blk (AnnTip blk), EncodeDisk blk (PerasState blk)) =>
CodecConfig blk -> ExtLedgerState blk EmptyMK -> Encoding
encodeDiskExtLedgerState CodecConfig blk
cfg =
  (LedgerState blk EmptyMK -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> (PerasState blk -> Encoding)
-> ExtLedgerState blk EmptyMK
-> Encoding
forall blk (mk :: MapKind).
(LedgerState blk mk -> Encoding)
-> (ChainDepState (BlockProtocol blk) -> Encoding)
-> (AnnTip blk -> Encoding)
-> (PerasState 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)
    (CodecConfig blk -> PerasState 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 (PerasState 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 (PerasState 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
  forall s. Decoder s (PerasState blk)
decodePerasState' = do
    len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    ledgerState <- decodeLedgerState
    headerState <- decodeHeaderState'
    -- NOTE: we have to support legacy /decoding/ here until we can justify
    -- forcing a replay on all nodes even if Peras is not yet supported.
    -- Defaulting to 'defaultPerasState' should be safe for now because 1) epoch
    -- context resolution should not be triggered unless we are trying to
    -- validate a Peras object that shouldn't exist (validation will fail), and
    -- 2) the round number of the latest Peras certificate on chain will always
    -- be absent until Peras enters a cooldown for the first time after getting
    -- enabled.
    --
    -- TODO: enfoce decoding size once Peras is closer to being enabled.
    -- See https://github.com/tweag/cardano-peras/issues/275
    perasState <-
      case len of
        Int
2 -> PerasState blk -> Decoder s (PerasState blk)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasState blk
forall {blk}. PerasState blk
defaultPerasState
        Int
3 -> Decoder s (PerasState blk)
forall s. Decoder s (PerasState blk)
decodePerasState'
        Int
_ ->
          DecoderError -> Decoder s (PerasState blk)
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError (DecoderError -> Decoder s (PerasState blk))
-> DecoderError -> Decoder s (PerasState blk)
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> DecoderError
DecoderErrorCustom
              Text
"ExtLedgerState"
              (Text
"unexpected list length: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
len))
    return
      ExtLedgerState
        { ledgerState
        , headerState
        , perasState
        }
   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

    defaultPerasState :: PerasState blk
defaultPerasState =
      PerasState
        { perasEpochContextResolver :: PerasEpochContextResolver blk
perasEpochContextResolver = PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEpochContextResolver blk
forall blk.
PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEnabled (BoundedPerasEpochContext blk)
-> PerasEpochContextResolver blk
PerasEpochContextResolver PerasEnabled (BoundedPerasEpochContext blk)
forall a. PerasEnabled a
NoPerasEnabled PerasEnabled (BoundedPerasEpochContext blk)
forall a. PerasEnabled a
NoPerasEnabled
        , latestPerasCertOnChainRound :: StrictMaybe PerasRoundNo
latestPerasCertOnChainRound = StrictMaybe PerasRoundNo
forall a. StrictMaybe a
SNothing
        }

decodeDiskExtLedgerState ::
  forall blk.
  ( DecodeDisk blk (LedgerState blk EmptyMK)
  , DecodeDisk blk (ChainDepState (BlockProtocol blk))
  , DecodeDisk blk (AnnTip blk)
  , DecodeDisk blk (PerasState 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), DecodeDisk blk (PerasState 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 (PerasState 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 (PerasState 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)
    (CodecConfig blk -> forall s. Decoder s (PerasState blk)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig blk
cfg)

{-------------------------------------------------------------------------------
  Ledger Tables
-------------------------------------------------------------------------------}

instance
  (NoThunks (TxIn blk), NoThunks (TxOut blk), HasLedgerTables LedgerState blk) =>
  HasLedgerTables ExtLedgerState blk
  where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
ExtLedgerState blk mk -> LedgerTables blk mk
projectLedgerTables (ExtLedgerState LedgerState blk mk
lstate HeaderState blk
_ PerasState blk
_) =
    LedgerState blk mk -> LedgerTables blk mk
forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState blk mk -> LedgerTables blk mk
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
projectLedgerTables LedgerState blk mk
lstate
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
ExtLedgerState blk any
-> LedgerTables blk mk -> ExtLedgerState blk mk
withLedgerTables (ExtLedgerState LedgerState blk any
lstate HeaderState blk
hstate PerasState blk
perasState) LedgerTables blk mk
tables =
    LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState
      (LedgerState blk any
lstate LedgerState blk any -> LedgerTables blk mk -> LedgerState blk mk
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState blk any -> LedgerTables blk mk -> LedgerState blk mk
forall (l :: StateKind) blk (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
`withLedgerTables` LedgerTables blk mk
tables)
      HeaderState blk
hstate
      PerasState blk
perasState

instance
  (NoThunks (TxIn blk), NoThunks (TxOut blk), HasLedgerTables (Ticked LedgerState) blk) =>
  HasLedgerTables (Ticked ExtLedgerState) blk
  where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked ExtLedgerState blk mk -> LedgerTables blk mk
projectLedgerTables (TickedExtLedgerState Ticked LedgerState blk mk
lstate LedgerView (BlockProtocol blk)
_view Ticked (HeaderState blk)
_hstate PerasState blk
_perasState) =
    Ticked LedgerState blk mk -> LedgerTables blk mk
forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState blk mk -> LedgerTables blk mk
forall (l :: StateKind) blk (mk :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk mk -> LedgerTables blk mk
projectLedgerTables Ticked LedgerState blk mk
lstate
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked ExtLedgerState blk any
-> LedgerTables blk mk -> Ticked ExtLedgerState blk mk
withLedgerTables
    (TickedExtLedgerState Ticked LedgerState blk any
lstate LedgerView (BlockProtocol blk)
view Ticked (HeaderState blk)
hstate PerasState blk
perasState)
    LedgerTables blk mk
tables =
      Ticked LedgerState blk mk
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> PerasState blk
-> Ticked ExtLedgerState blk mk
forall blk (mk :: MapKind).
Ticked LedgerState blk mk
-> LedgerView (BlockProtocol blk)
-> Ticked (HeaderState blk)
-> PerasState blk
-> Ticked ExtLedgerState blk mk
TickedExtLedgerState
        (Ticked LedgerState blk any
lstate Ticked LedgerState blk any
-> LedgerTables blk mk -> Ticked LedgerState blk mk
forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState blk any
-> LedgerTables blk mk -> Ticked LedgerState blk mk
forall (l :: StateKind) blk (mk :: MapKind) (any :: MapKind).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
`withLedgerTables` LedgerTables blk mk
tables)
        LedgerView (BlockProtocol blk)
view
        Ticked (HeaderState blk)
hstate
        PerasState blk
perasState

instance
  CanStowLedgerTables (LedgerState blk) =>
  CanStowLedgerTables (ExtLedgerState blk)
  where
  stowLedgerTables :: ExtLedgerState blk ValuesMK -> ExtLedgerState blk EmptyMK
stowLedgerTables (ExtLedgerState LedgerState blk ValuesMK
lstate HeaderState blk
hstate PerasState blk
perasState) =
    LedgerState blk EmptyMK
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk EmptyMK
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk ValuesMK -> LedgerState blk EmptyMK
forall (l :: MapKind -> *).
CanStowLedgerTables l =>
l ValuesMK -> l EmptyMK
stowLedgerTables LedgerState blk ValuesMK
lstate) HeaderState blk
hstate PerasState blk
perasState

  unstowLedgerTables :: ExtLedgerState blk EmptyMK -> ExtLedgerState blk ValuesMK
unstowLedgerTables (ExtLedgerState LedgerState blk EmptyMK
lstate HeaderState blk
hstate PerasState blk
perasState) =
    LedgerState blk ValuesMK
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk ValuesMK
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk EmptyMK -> LedgerState blk ValuesMK
forall (l :: MapKind -> *).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables LedgerState blk EmptyMK
lstate) HeaderState blk
hstate PerasState blk
perasState

instance
  CanUpgradeLedgerTables LedgerState blk =>
  CanUpgradeLedgerTables ExtLedgerState blk
  where
  upgradeTables :: forall (mk1 :: MapKind) (mk2 :: MapKind).
ExtLedgerState blk mk1
-> ExtLedgerState blk mk2
-> LedgerTables blk ValuesMK
-> LedgerTables blk ValuesMK
upgradeTables (ExtLedgerState LedgerState blk mk1
st0 HeaderState blk
_ PerasState blk
_) (ExtLedgerState LedgerState blk mk2
st1 HeaderState blk
_ PerasState blk
_) =
    LedgerState blk mk1
-> LedgerState blk mk2
-> LedgerTables blk ValuesMK
-> LedgerTables blk ValuesMK
forall (mk1 :: MapKind) (mk2 :: MapKind).
LedgerState blk mk1
-> LedgerState blk mk2
-> LedgerTables blk ValuesMK
-> LedgerTables blk ValuesMK
forall (l :: StateKind) blk (mk1 :: MapKind) (mk2 :: MapKind).
CanUpgradeLedgerTables l blk =>
l blk mk1
-> l blk mk2
-> LedgerTables blk ValuesMK
-> LedgerTables blk ValuesMK
upgradeTables LedgerState blk mk1
st0 LedgerState blk mk2
st1

instance
  (txout ~ TxOut blk, IndexedMemPack LedgerState blk txout) =>
  IndexedMemPack ExtLedgerState blk txout
  where
  indexedTypeName :: Proxy txout -> ExtLedgerState blk EmptyMK -> String
indexedTypeName Proxy txout
p (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_ PerasState blk
_) = Proxy txout -> LedgerState blk EmptyMK -> String
forall (l :: StateKind) blk a.
IndexedMemPack l blk a =>
Proxy a -> l blk EmptyMK -> String
indexedTypeName Proxy txout
p LedgerState blk EmptyMK
st
  indexedPackedByteCount :: ExtLedgerState blk EmptyMK -> txout -> Int
indexedPackedByteCount (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_ PerasState blk
_) = LedgerState blk EmptyMK -> txout -> Int
forall (l :: StateKind) blk a.
IndexedMemPack l blk a =>
l blk EmptyMK -> a -> Int
indexedPackedByteCount LedgerState blk EmptyMK
st
  indexedPackM :: forall s. ExtLedgerState blk EmptyMK -> txout -> Pack s ()
indexedPackM (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_ PerasState blk
_) = LedgerState blk EmptyMK -> txout -> Pack s ()
forall s. LedgerState blk EmptyMK -> txout -> Pack s ()
forall (l :: StateKind) blk a s.
IndexedMemPack l blk a =>
l blk EmptyMK -> a -> Pack s ()
indexedPackM LedgerState blk EmptyMK
st
  indexedUnpackM :: forall b s.
Buffer b =>
ExtLedgerState blk EmptyMK -> Unpack s b txout
indexedUnpackM (ExtLedgerState LedgerState blk EmptyMK
st HeaderState blk
_ PerasState blk
_) = LedgerState blk EmptyMK -> Unpack s b txout
forall b s. Buffer b => LedgerState blk EmptyMK -> Unpack s b txout
forall s. LedgerState blk EmptyMK -> Unpack s b txout
forall (l :: StateKind) blk a b s.
(IndexedMemPack l blk a, Buffer b) =>
l blk EmptyMK -> Unpack s b a
indexedUnpackM LedgerState blk EmptyMK
st

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
st HeaderState blk
hst PerasState blk
perasState) =
    LedgerState blk mk'
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk'
forall blk (mk :: MapKind).
LedgerState blk mk
-> HeaderState blk -> PerasState blk -> ExtLedgerState blk mk
ExtLedgerState (LedgerState blk mk -> LedgerState blk mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState blk mk -> LedgerState blk mk'
forall (l :: StateKind) blk (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind LedgerState blk mk
st) HeaderState blk
hst PerasState blk
perasState

instance SerializeTablesWithHint LedgerState blk => SerializeTablesWithHint ExtLedgerState blk where
  decodeTablesWithHint :: forall s.
ExtLedgerState blk EmptyMK -> Decoder s (LedgerTables blk ValuesMK)
decodeTablesWithHint ExtLedgerState blk EmptyMK
st = LedgerState blk EmptyMK -> Decoder s (LedgerTables blk ValuesMK)
forall s.
LedgerState blk EmptyMK -> Decoder s (LedgerTables blk ValuesMK)
forall (l :: StateKind) blk s.
SerializeTablesWithHint l blk =>
l blk EmptyMK -> Decoder s (LedgerTables blk ValuesMK)
decodeTablesWithHint (ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState ExtLedgerState blk EmptyMK
st)
  encodeTablesWithHint :: ExtLedgerState blk EmptyMK -> LedgerTables blk ValuesMK -> Encoding
encodeTablesWithHint ExtLedgerState blk EmptyMK
st LedgerTables blk ValuesMK
tbs = LedgerState blk EmptyMK -> LedgerTables blk ValuesMK -> Encoding
forall (l :: StateKind) blk.
SerializeTablesWithHint l blk =>
l blk EmptyMK -> LedgerTables blk ValuesMK -> Encoding
encodeTablesWithHint (ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState ExtLedgerState blk EmptyMK
st) LedgerTables blk ValuesMK
tbs