{- HLINT ignore "Unused LANGUAGE pragma" -} -- False hint on TypeOperators

{-# 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 (
    -- * Extended ledger state
    ExtLedgerCfg (..)
  , ExtLedgerState (..)
  , ExtValidationError (..)
    -- * Serialisation
  , decodeDiskExtLedgerState
  , decodeExtLedgerState
  , encodeDiskExtLedgerState
  , encodeExtLedgerState
    -- * Type family instances
  , LedgerTables (..)
  , Ticked (..)
  ) where

import           Codec.CBOR.Decoding (Decoder, decodeListLenOf)
import           Codec.CBOR.Encoding (Encoding, encodeListLen)
import           Control.Monad.Except
import           Data.Functor ((<&>))
import           Data.MemPack
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

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

data ExtValidationError blk =
    ExtValidationErrorLedger !(LedgerError blk)
  | ExtValidationErrorHeader !(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)

-- | 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)
    }
  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)

-- | 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, 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 HeaderHash (ExtLedgerState blk) = HeaderHash (LedgerState blk)
instance (
    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 :: 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

{-------------------------------------------------------------------------------
  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)
    }

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)

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

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)

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

type instance TxIn  (ExtLedgerState blk) = TxIn  (LedgerState blk)
type instance TxOut (ExtLedgerState blk) = TxOut (LedgerState blk)

instance (
    HasLedgerTables (LedgerState blk)
  , 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))
  ) => 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))
  , 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))
  ) => 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

instance SerializeTablesWithHint (LedgerState blk) => SerializeTablesWithHint (ExtLedgerState blk) where
  decodeTablesWithHint :: forall s.
SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
-> Decoder s (LedgerTables (ExtLedgerState blk) ValuesMK)
decodeTablesWithHint SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
st = LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (ExtLedgerState blk) ValuesMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (LedgerTables (LedgerState blk) ValuesMK
 -> LedgerTables (ExtLedgerState blk) ValuesMK)
-> Decoder s (LedgerTables (LedgerState blk) ValuesMK)
-> Decoder s (LedgerTables (ExtLedgerState blk) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SerializeTablesHint (LedgerTables (LedgerState blk) ValuesMK)
-> Decoder s (LedgerTables (LedgerState blk) ValuesMK)
forall s.
SerializeTablesHint (LedgerTables (LedgerState blk) ValuesMK)
-> Decoder s (LedgerTables (LedgerState blk) ValuesMK)
forall (l :: LedgerStateKind) s.
SerializeTablesWithHint l =>
SerializeTablesHint (LedgerTables l ValuesMK)
-> Decoder s (LedgerTables l ValuesMK)
decodeTablesWithHint (ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
ExtLedgerState blk EmptyMK
st)
  encodeTablesWithHint :: SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
-> LedgerTables (ExtLedgerState blk) ValuesMK -> Encoding
encodeTablesWithHint SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
st LedgerTables (ExtLedgerState blk) ValuesMK
tbs = SerializeTablesHint (LedgerTables (LedgerState blk) ValuesMK)
-> LedgerTables (LedgerState blk) ValuesMK -> Encoding
forall (l :: LedgerStateKind).
SerializeTablesWithHint l =>
SerializeTablesHint (LedgerTables l ValuesMK)
-> LedgerTables l ValuesMK -> Encoding
encodeTablesWithHint (ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState SerializeTablesHint (LedgerTables (ExtLedgerState blk) ValuesMK)
ExtLedgerState blk EmptyMK
st) (LedgerTables (ExtLedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) ValuesMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: MapKind).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (ExtLedgerState blk) ValuesMK
tbs)