{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}

-- | The data structure that holds the cached ledger states.
module Ouroboros.Consensus.Storage.LedgerDB.V2.LedgerSeq
  ( -- * LedgerHandles
    LedgerTablesHandle (..)

    -- * The ledger seq
  , LedgerSeq (..)
  , LedgerSeq'
  , StateRef (..)
  , closeLedgerSeq
  , empty
  , empty'

    -- * Apply Blocks
  , extend
  , prune
  , pruneToImmTipOnly
  , reapplyBlock
  , reapplyThenPush

    -- * Queries
  , anchor
  , anchorHandle
  , current
  , currentHandle
  , getPastLedgerAt
  , immutableTipSlot
  , isSaturated
  , maxRollback
  , rollback
  , rollbackN
  , rollbackToAnchor
  , rollbackToPoint
  , snapshots
  , tip
  , volatileStatesBimap
  ) where

import Cardano.Ledger.BaseTypes
import Data.Function (on)
import Data.Word
import GHC.Generics
import NoThunks.Class
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Storage.LedgerDB.API
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Network.AnchoredSeq hiding
  ( anchor
  , last
  , map
  , rollback
  )
import qualified Ouroboros.Network.AnchoredSeq as AS hiding (map)
import System.FS.CRC (CRC)
import Prelude hiding (read)

{-------------------------------------------------------------------------------
  LedgerTablesHandles
-------------------------------------------------------------------------------}

-- | The interface fulfilled by handles on both the InMemory and LSM handles.
--
-- The most relevant concept is handle duplication:
--
-- A duplicated handle must provide access to all the data that was there in
-- the original handle while being able to mutate in ways different than the
-- original handle.
--
-- When applying diffs to a table, we will first duplicate the handle, then
-- apply the diffs in the copy. It is expected that duplicating the handle
-- takes constant time.
data LedgerTablesHandle m l blk = LedgerTablesHandle
  { forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk -> m ()
close :: !(m ())
  -- ^ Close the handle
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK -> l blk DiffMK -> m (LedgerTablesHandle m l blk)
duplicateWithDiffs :: !(l blk EmptyMK -> l blk DiffMK -> m (LedgerTablesHandle m l blk))
  -- ^ Create a new handle by duplicating this one and push some diffs to it.
  --
  -- The first argument has to be the ledger state before applying
  -- the block, the second argument should be the ledger state after
  -- applying a block. See 'CanUpgradeLedgerTables'.
  --
  -- Note 'CanUpgradeLedgerTables' is only used in the InMemory backend.
  --
  -- This is expected to be used when applying new blocks onto a forker, which
  -- happens only in chain selection (see 'forkerPush') and initial chain
  -- selection (see 'reapplyBlock').
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk -> m (LedgerTablesHandle m l blk)
duplicate :: !(m (LedgerTablesHandle m l blk))
  -- ^ Create an duplicate of a handle. This will be used when opening read-only
  -- forkers and also to open the first handle for a forker used in chain
  -- selection.
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK
-> LedgerTables blk KeysMK
-> m (LedgerTables blk ValuesMK)
read :: !(l blk EmptyMK -> LedgerTables blk KeysMK -> m (LedgerTables blk ValuesMK))
  -- ^ Read values for the given keys from the tables, and deserialize them as
  -- if they were from the same era as the given ledger state.
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK
-> (Maybe (TxIn blk), Int)
-> m (LedgerTables blk ValuesMK, Maybe (TxIn blk))
readRange ::
      !(l blk EmptyMK -> (Maybe (TxIn blk), Int) -> m (LedgerTables blk ValuesMK, Maybe (TxIn blk)))
  -- ^ Read the requested number of values, possibly starting from the given
  -- key, from the tables, and deserialize them as if they were from the same
  -- era as the given ledger state.
  --
  -- The returned value contains both the read values as well as the last key
  -- retrieved. This is necessary in case the backend uses a serialization
  -- format such that the order in the store (which will be used when reading)
  -- might not match the order in a Haskell @Map@ (induced by @Ord@), so the
  -- backend must tell which key it read last (if any).
  --
  -- The last key retrieved is part of the map too. It is intended to be fed
  -- back into the next iteration of the range read. If the function returns
  -- Nothing, it means the read returned no results, or in other words, we
  -- reached the end of the ledger tables.
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK -> m (LedgerTables blk ValuesMK)
readAll :: !(l blk EmptyMK -> m (LedgerTables blk ValuesMK))
  -- ^ Costly read all operation, not to be used in Consensus but only in
  -- snapshot-converter executable. The values will be read as if they were from
  -- the same era as the given ledger state.
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK -> String -> m (Maybe CRC)
takeHandleSnapshot :: !(l blk EmptyMK -> String -> m (Maybe CRC))
  -- ^ Take a snapshot of a handle. The given ledger state is used to decide the
  -- encoding of the values based on the current era.
  --
  -- It returns a CRC only on backends that support it, as the InMemory backend.
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk -> Int
tablesSize :: !Int
  -- ^ Consult the size of the ledger tables in the database.
  }
  deriving Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
Proxy (LedgerTablesHandle m l blk) -> String
(Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo))
-> (Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerTablesHandle m l blk) -> String)
-> NoThunks (LedgerTablesHandle m l blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Proxy (LedgerTablesHandle m l blk) -> String
$cnoThunks :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerTablesHandle m l blk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Proxy (LedgerTablesHandle m l blk) -> String
showTypeOf :: Proxy (LedgerTablesHandle m l blk) -> String
NoThunks via OnlyCheckWhnfNamed "LedgerTablesHandle" (LedgerTablesHandle m l blk)

{-------------------------------------------------------------------------------
  StateRef, represents a full ledger state, i.e. with a handle for its tables
-------------------------------------------------------------------------------}

-- | For single era blocks, it would be the same to hold a stowed ledger state
-- (@'LedgerTables' ('LedgerState' blk) 'EmptyMK'@), an unstowed one
-- (@'LedgerTables' ('LedgerState' blk) 'ValuesMK'@) or a tuple with the state
-- and the tables ('LedgerState' blk 'EmptyMK', 'LedgerTables' ('LedgerState'
-- blk) 'ValuesMK'), however, for a hard fork block, these are not equivalent.
--
-- If we were to hold a sequence of type @LedgerState blk EmptyMK@ with stowed
-- values, we would have to translate the entirety of the tables on epoch
-- boundaries.
--
-- If we were to hold a sequence of type @LedgerState blk ValuesMK@ we would
-- have the same problem as the @mk@ in the state actually refers to the @mk@ in
-- the @HardForkState@'ed state.
--
-- Therefore it sounds reasonable to hold a @LedgerState blk EmptyMK@ with no
-- values, and a @LedgerTables blk ValuesMK@ next to it, that will live its
-- entire lifetime as @LedgerTables@ of the @HardForkBlock@.
data StateRef m l blk = StateRef
  { forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state :: !(l blk EmptyMK)
  , forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> LedgerTablesHandle m l blk
tables :: !(LedgerTablesHandle m l blk)
  }
  deriving (forall x. StateRef m l blk -> Rep (StateRef m l blk) x)
-> (forall x. Rep (StateRef m l blk) x -> StateRef m l blk)
-> Generic (StateRef m l blk)
forall x. Rep (StateRef m l blk) x -> StateRef m l blk
forall x. StateRef m l blk -> Rep (StateRef m l blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
Rep (StateRef m l blk) x -> StateRef m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
StateRef m l blk -> Rep (StateRef m l blk) x
$cfrom :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
StateRef m l blk -> Rep (StateRef m l blk) x
from :: forall x. StateRef m l blk -> Rep (StateRef m l blk) x
$cto :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
Rep (StateRef m l blk) x -> StateRef m l blk
to :: forall x. Rep (StateRef m l blk) x -> StateRef m l blk
Generic

deriving instance (IOLike m, NoThunks (l blk EmptyMK)) => NoThunks (StateRef m l blk)

instance Eq (l blk EmptyMK) => Eq (StateRef m l blk) where
  == :: StateRef m l blk -> StateRef m l blk -> Bool
(==) = l blk EmptyMK -> l blk EmptyMK -> Bool
forall a. Eq a => a -> a -> Bool
(==) (l blk EmptyMK -> l blk EmptyMK -> Bool)
-> (StateRef m l blk -> l blk EmptyMK)
-> StateRef m l blk
-> StateRef m l blk
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state

instance Show (l blk EmptyMK) => Show (StateRef m l blk) where
  show :: StateRef m l blk -> String
show = l blk EmptyMK -> String
forall a. Show a => a -> String
show (l blk EmptyMK -> String)
-> (StateRef m l blk -> l blk EmptyMK)
-> StateRef m l blk
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state

instance GetTip (l blk) => Anchorable (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk) where
  asAnchor :: StateRef m l blk -> StateRef m l blk
asAnchor = StateRef m l blk -> StateRef m l blk
forall a. a -> a
id
  getAnchorMeasure :: Proxy (StateRef m l blk) -> StateRef m l blk -> WithOrigin SlotNo
getAnchorMeasure Proxy (StateRef m l blk)
_ = l blk EmptyMK -> WithOrigin SlotNo
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot (l blk EmptyMK -> WithOrigin SlotNo)
-> (StateRef m l blk -> l blk EmptyMK)
-> StateRef m l blk
-> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state

{-------------------------------------------------------------------------------
  The LedgerSeq
-------------------------------------------------------------------------------}

newtype LedgerSeq m l blk = LedgerSeq
  { forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq :: AnchoredSeq (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
  }
  deriving (forall x. LedgerSeq m l blk -> Rep (LedgerSeq m l blk) x)
-> (forall x. Rep (LedgerSeq m l blk) x -> LedgerSeq m l blk)
-> Generic (LedgerSeq m l blk)
forall x. Rep (LedgerSeq m l blk) x -> LedgerSeq m l blk
forall x. LedgerSeq m l blk -> Rep (LedgerSeq m l blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
Rep (LedgerSeq m l blk) x -> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
LedgerSeq m l blk -> Rep (LedgerSeq m l blk) x
$cfrom :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
LedgerSeq m l blk -> Rep (LedgerSeq m l blk) x
from :: forall x. LedgerSeq m l blk -> Rep (LedgerSeq m l blk) x
$cto :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk x.
Rep (LedgerSeq m l blk) x -> LedgerSeq m l blk
to :: forall x. Rep (LedgerSeq m l blk) x -> LedgerSeq m l blk
Generic

deriving newtype instance (IOLike m, NoThunks (l blk EmptyMK)) => NoThunks (LedgerSeq m l blk)

deriving newtype instance Eq (l blk EmptyMK) => Eq (LedgerSeq m l blk)
deriving newtype instance Show (l blk EmptyMK) => Show (LedgerSeq m l blk)

type LedgerSeq' m blk = LedgerSeq m ExtLedgerState blk

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Creates an empty @LedgerSeq@
empty ::
  ( GetTip (l blk)
  , IOLike m
  ) =>
  l blk EmptyMK ->
  init ->
  (init -> m (LedgerTablesHandle m l blk)) ->
  m (LedgerSeq m l blk)
empty :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *) init.
(GetTip (l blk), IOLike m) =>
l blk EmptyMK
-> init
-> (init -> m (LedgerTablesHandle m l blk))
-> m (LedgerSeq m l blk)
empty l blk EmptyMK
st init
tbs init -> m (LedgerTablesHandle m l blk)
new = AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> LedgerSeq m l blk)
-> (LedgerTablesHandle m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerTablesHandle m l blk
-> LedgerSeq m l blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AS.Empty (StateRef m l blk
 -> AnchoredSeq
      (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> (LedgerTablesHandle m l blk -> StateRef m l blk)
-> LedgerTablesHandle m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l blk EmptyMK -> LedgerTablesHandle m l blk -> StateRef m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
l blk EmptyMK -> LedgerTablesHandle m l blk -> StateRef m l blk
StateRef l blk EmptyMK
st (LedgerTablesHandle m l blk -> LedgerSeq m l blk)
-> m (LedgerTablesHandle m l blk) -> m (LedgerSeq m l blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> init -> m (LedgerTablesHandle m l blk)
new init
tbs

-- | Creates an empty @LedgerSeq@
empty' ::
  ( GetTip (l blk)
  , IOLike m
  , HasLedgerTables l blk
  ) =>
  l blk ValuesMK ->
  (l blk ValuesMK -> m (LedgerTablesHandle m l blk)) ->
  m (LedgerSeq m l blk)
empty' :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
(GetTip (l blk), IOLike m, HasLedgerTables l blk) =>
l blk ValuesMK
-> (l blk ValuesMK -> m (LedgerTablesHandle m l blk))
-> m (LedgerSeq m l blk)
empty' l blk ValuesMK
st = l blk EmptyMK
-> l blk ValuesMK
-> (l blk ValuesMK -> m (LedgerTablesHandle m l blk))
-> m (LedgerSeq m l blk)
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *) init.
(GetTip (l blk), IOLike m) =>
l blk EmptyMK
-> init
-> (init -> m (LedgerTablesHandle m l blk))
-> m (LedgerSeq m l blk)
empty (l blk ValuesMK -> l blk EmptyMK
forall (l :: * -> (* -> * -> *) -> *) blk (mk :: * -> * -> *).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables l blk ValuesMK
st) l blk ValuesMK
st

-- | Close all 'LedgerTablesHandle' in this 'LedgerSeq', in particular that on
-- the anchor.
closeLedgerSeq :: Monad m => LedgerSeq m l blk -> m ()
closeLedgerSeq :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Monad m =>
LedgerSeq m l blk -> m ()
closeLedgerSeq (LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
l) =
  (StateRef m l blk -> m ()) -> [StateRef m l blk] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LedgerTablesHandle m l blk -> m ()
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk -> m ()
close (LedgerTablesHandle m l blk -> m ())
-> (StateRef m l blk -> LedgerTablesHandle m l blk)
-> StateRef m l blk
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> LedgerTablesHandle m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> LedgerTablesHandle m l blk
tables) ([StateRef m l blk] -> m ()) -> [StateRef m l blk] -> m ()
forall a b. (a -> b) -> a -> b
$ AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. AnchoredSeq v a b -> a
AS.anchor AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
l StateRef m l blk -> [StateRef m l blk] -> [StateRef m l blk]
forall a. a -> [a] -> [a]
: AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> [StateRef m l blk]
forall v a b. AnchoredSeq v a b -> [b]
AS.toOldestFirst AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
l

{-------------------------------------------------------------------------------
  Apply blocks
-------------------------------------------------------------------------------}

-- | Apply a block on top of the ledger state and extend the LedgerSeq with
-- the result ledger state.
--
-- The @fst@ component of the result should be run to close the pruned states.
reapplyThenPush ::
  (IOLike m, ApplyBlock l blk) =>
  LedgerDbCfg l blk ->
  blk ->
  LedgerSeq m l blk ->
  m (LedgerSeq m l blk)
reapplyThenPush :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
(IOLike m, ApplyBlock l blk) =>
LedgerDbCfg l blk
-> blk -> LedgerSeq m l blk -> m (LedgerSeq m l blk)
reapplyThenPush LedgerDbCfg l blk
cfg blk
ap LedgerSeq m l blk
db = do
  newSt <- ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> LedgerSeq m l blk
-> m (StateRef m l blk)
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
(ApplyBlock l blk, IOLike m) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> LedgerSeq m l blk
-> m (StateRef m l blk)
reapplyBlock (LedgerDbCfg l blk -> ComputeLedgerEvents
forall (f :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerDbCfgF f l blk -> ComputeLedgerEvents
ledgerDbCfgComputeLedgerEvents LedgerDbCfg l blk
cfg) (LedgerDbCfg l blk -> HKD Identity (LedgerCfg l blk)
forall (f :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerDbCfgF f l blk -> HKD f (LedgerCfg l blk)
ledgerDbCfg LedgerDbCfg l blk
cfg) blk
ap LedgerSeq m l blk
db
  let (m, db') = pruneToImmTipOnly $ extend newSt db
  m
  pure db'

reapplyBlock ::
  (ApplyBlock l blk, IOLike m) =>
  ComputeLedgerEvents ->
  LedgerCfg l blk ->
  blk ->
  LedgerSeq m l blk ->
  m (StateRef m l blk)
reapplyBlock :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
(ApplyBlock l blk, IOLike m) =>
ComputeLedgerEvents
-> LedgerCfg l blk
-> blk
-> LedgerSeq m l blk
-> m (StateRef m l blk)
reapplyBlock ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
b LedgerSeq m l blk
db = do
  let ks :: LedgerTables blk KeysMK
ks = blk -> LedgerTables blk KeysMK
forall blk. GetBlockKeySets blk => blk -> LedgerTables blk KeysMK
getBlockKeySets blk
b
      StateRef l blk EmptyMK
st LedgerTablesHandle m l blk
tbs = LedgerSeq m l blk -> StateRef m l blk
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> StateRef m l blk
currentHandle LedgerSeq m l blk
db
  vals <- LedgerTablesHandle m l blk
-> l blk EmptyMK
-> LedgerTables blk KeysMK
-> m (LedgerTables blk ValuesMK)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerTablesHandle m l blk
-> l blk EmptyMK
-> LedgerTables blk KeysMK
-> m (LedgerTables blk ValuesMK)
read LedgerTablesHandle m l blk
tbs l blk EmptyMK
st LedgerTables blk KeysMK
ks
  let st' = ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> l blk ValuesMK -> l blk DiffMK
forall (l :: * -> (* -> * -> *) -> *) blk.
ApplyBlock l blk =>
ComputeLedgerEvents
-> LedgerCfg l blk -> blk -> l blk ValuesMK -> l blk DiffMK
tickThenReapply ComputeLedgerEvents
evs LedgerCfg l blk
cfg blk
b (l blk EmptyMK
st l blk EmptyMK -> LedgerTables blk ValuesMK -> l blk ValuesMK
forall (mk :: * -> * -> *) (any :: * -> * -> *).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
forall (l :: * -> (* -> * -> *) -> *) blk (mk :: * -> * -> *)
       (any :: * -> * -> *).
(HasLedgerTables l blk, CanMapMK mk, CanMapKeysMK mk,
 ZeroableMK mk) =>
l blk any -> LedgerTables blk mk -> l blk mk
`withLedgerTables` LedgerTables blk ValuesMK
vals)
      newst = l blk DiffMK -> l blk EmptyMK
forall (l :: * -> (* -> * -> *) -> *) blk (mk :: * -> * -> *).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables l blk DiffMK
st'

  newtbs <- duplicateWithDiffs tbs st st'
  pure (StateRef newst newtbs)

-- | Prune older ledger states according to the given 'LedgerDbPrune' strategy.
--
-- The @fst@ component of the returned value is an action closing the pruned
-- ledger states.
--
-- >>> ldb  = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> ldb' = LedgerSeq $ AS.fromOldestFirst     l1 [l2, l3]
-- >>> snd (prune (LedgerDbPruneBeforeSlot 1) ldb) == ldb'
-- True
--
-- where @lX@ is a ledger state from slot @X-1@ (or 'Origin' for @l0@).
prune ::
  (Monad m, GetTip (l blk)) =>
  LedgerDbPrune ->
  LedgerSeq m l blk ->
  (m (), LedgerSeq m l blk)
prune :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
(Monad m, GetTip (l blk)) =>
LedgerDbPrune -> LedgerSeq m l blk -> (m (), LedgerSeq m l blk)
prune LedgerDbPrune
howToPrune (LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb) = case LedgerDbPrune
howToPrune of
  LedgerDbPrune
LedgerDbPruneAll ->
    (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> m ()
closeButHead AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
before, AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
after)
   where
    (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
before, AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
after) = (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb, StateRef m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AS.Empty (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
AS.headAnchor AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb))
  LedgerDbPruneBeforeSlot SlotNo
slot ->
    (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> m ()
closeButHead AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
before, AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
after)
   where
    -- The anchor of @vol'@ might still have a tip slot older than @slot@, which
    -- is fine to ignore (we will prune it later).
    (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
before, AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
after) = WithOrigin SlotNo
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> (AnchoredSeq
      (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk),
    AnchoredSeq
      (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
forall v a b.
Anchorable v a b =>
v -> AnchoredSeq v a b -> (AnchoredSeq v a b, AnchoredSeq v a b)
AS.splitAtMeasure (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slot) AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb
 where
  -- Above, we split @ldb@ into two sequences @before@ and @after@ such that
  -- @AS.headAnchor before == AS.anchor after@. We want to close all handles of
  -- @ldb@ not present in @after@, which are none if @before@ is empty, and all
  -- (in particular the anchor) of @before@ apart from the the head of @before@
  -- if @before@ is non-empty.
  closeButHead :: AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> m ()
closeButHead = \case
    AS.Empty StateRef m l blk
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
toPrune AS.:> StateRef m l blk
_ -> LedgerSeq m l blk -> m ()
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
Monad m =>
LedgerSeq m l blk -> m ()
closeLedgerSeq (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
toPrune)

-- NOTE: we must inline 'prune' otherwise we get unexplained thunks in
-- 'LedgerSeq' and thus a space leak. Alternatively, we could disable the
-- @-fstrictness@ optimisation (enabled by default for -O1). See
-- https://github.com/IntersectMBO/ouroboros-network/issues/2532.
--
-- NOTE (@js): this INLINE was inherited from before UTxO-HD, so maybe it is not
-- needed anymore.
{-# INLINE prune #-}

-- | Extending the LedgerDB with a valid ledger state.
--
-- >>> ldb            = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> LedgerSeq ldb' = extend l4 ldb
-- >>> AS.toOldestFirst ldb' == [l1, l2, l3, l4]
-- True
extend ::
  GetTip (l blk) =>
  StateRef m l blk ->
  LedgerSeq m l blk ->
  LedgerSeq m l blk
extend :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
StateRef m l blk -> LedgerSeq m l blk -> LedgerSeq m l blk
extend StateRef m l blk
newState =
  AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> LedgerSeq m l blk)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> LedgerSeq m l blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall v a b.
Anchorable v a b =>
AnchoredSeq v a b -> b -> AnchoredSeq v a b
:> StateRef m l blk
newState) (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> AnchoredSeq
      (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

{-------------------------------------------------------------------------------
  Reset
-------------------------------------------------------------------------------}

-- | Set the volatile tip as the immutable tip and prune all older states.
--
-- >>> ldb  = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> LedgerSeq ldb' = snd $ pruneToImmTipOnly ldb
-- >>> AS.anchor ldb' == l3 && AS.toOldestFirst ldb' == []
-- True
pruneToImmTipOnly ::
  (Monad m, GetTip (l blk)) =>
  LedgerSeq m l blk ->
  (m (), LedgerSeq m l blk)
pruneToImmTipOnly :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
(Monad m, GetTip (l blk)) =>
LedgerSeq m l blk -> (m (), LedgerSeq m l blk)
pruneToImmTipOnly = LedgerDbPrune -> LedgerSeq m l blk -> (m (), LedgerSeq m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
(Monad m, GetTip (l blk)) =>
LedgerDbPrune -> LedgerSeq m l blk -> (m (), LedgerSeq m l blk)
prune LedgerDbPrune
LedgerDbPruneAll

{-------------------------------------------------------------------------------
  Internal: rolling back
-------------------------------------------------------------------------------}

-- | Rollback @n@ ledger states.
--
-- Returns 'Nothing' if maximum rollback (usually @k@, but can be less on
-- startup or under corruption) is exceeded.
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> fmap (([l1] ==) . AS.toOldestFirst . getLedgerSeq) (rollbackN 2 ldb)
-- Just True
rollbackN ::
  GetTip (l blk) =>
  Word64 ->
  LedgerSeq m l blk ->
  Maybe (LedgerSeq m l blk)
rollbackN :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
Word64 -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollbackN Word64
n LedgerSeq m l blk
ldb
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= LedgerSeq m l blk -> Word64
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> Word64
maxRollback LedgerSeq m l blk
ldb =
      LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall a. a -> Maybe a
Just (LedgerSeq m l blk -> Maybe (LedgerSeq m l blk))
-> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall a b. (a -> b) -> a -> b
$ AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq (Int
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall v a b.
Anchorable v a b =>
Int -> AnchoredSeq v a b -> AnchoredSeq v a b
AS.dropNewest (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n) (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> AnchoredSeq
      (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall a b. (a -> b) -> a -> b
$ LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq LedgerSeq m l blk
ldb)
  | Bool
otherwise =
      Maybe (LedgerSeq m l blk)
forall a. Maybe a
Nothing

{-------------------------------------------------------------------------------
  Queries
-------------------------------------------------------------------------------}

-- | The ledger state at the tip of the chain
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> l3s == current ldb
-- True
current :: GetTip (l blk) => LedgerSeq m l blk -> l blk EmptyMK
current :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> l blk EmptyMK
current = StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state (StateRef m l blk -> l blk EmptyMK)
-> (LedgerSeq m l blk -> StateRef m l blk)
-> LedgerSeq m l blk
-> l blk EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk -> StateRef m l blk
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> StateRef m l blk
currentHandle

currentHandle :: GetTip (l blk) => LedgerSeq m l blk -> StateRef m l blk
currentHandle :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> StateRef m l blk
currentHandle = AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
headAnchor (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> StateRef m l blk)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> StateRef m l blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

-- | The ledger state at the anchor of the Volatile chain (i.e. the immutable
-- tip).
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> l0s == anchor ldb
-- True
anchor :: LedgerSeq m l blk -> l blk EmptyMK
anchor :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk -> l blk EmptyMK
anchor = StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state (StateRef m l blk -> l blk EmptyMK)
-> (LedgerSeq m l blk -> StateRef m l blk)
-> LedgerSeq m l blk
-> l blk EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk -> StateRef m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk -> StateRef m l blk
anchorHandle

anchorHandle :: LedgerSeq m l blk -> StateRef m l blk
anchorHandle :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk -> StateRef m l blk
anchorHandle = AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. AnchoredSeq v a b -> a
AS.anchor (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> StateRef m l blk)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> StateRef m l blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

-- | All snapshots currently stored by the ledger DB (new to old)
--
-- This also includes the snapshot at the anchor. For each snapshot we also
-- return the distance from the tip.
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> [(0, l3s), (1, l2s), (2, l1s)] == snapshots ldb
-- True
snapshots :: LedgerSeq m l blk -> [(Word64, l blk EmptyMK)]
snapshots :: forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk -> [(Word64, l blk EmptyMK)]
snapshots =
  [Word64] -> [l blk EmptyMK] -> [(Word64, l blk EmptyMK)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0 ..]
    ([l blk EmptyMK] -> [(Word64, l blk EmptyMK)])
-> (LedgerSeq m l blk -> [l blk EmptyMK])
-> LedgerSeq m l blk
-> [(Word64, l blk EmptyMK)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateRef m l blk -> l blk EmptyMK)
-> [StateRef m l blk] -> [l blk EmptyMK]
forall a b. (a -> b) -> [a] -> [b]
map StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state
    ([StateRef m l blk] -> [l blk EmptyMK])
-> (LedgerSeq m l blk -> [StateRef m l blk])
-> LedgerSeq m l blk
-> [l blk EmptyMK]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> [StateRef m l blk]
forall v a b. AnchoredSeq v a b -> [b]
AS.toNewestFirst
    (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> [StateRef m l blk])
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> [StateRef m l blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

-- | How many blocks can we currently roll back?
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> maxRollback ldb
-- 3
maxRollback :: GetTip (l blk) => LedgerSeq m l blk -> Word64
maxRollback :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> Word64
maxRollback =
  Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Int -> Word64)
-> (LedgerSeq m l blk -> Int) -> LedgerSeq m l blk -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> Int
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Int
AS.length
    (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> Int)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

-- | Reference to the block at the tip of the chain
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> tip ldb == getTip l3s
-- True
tip :: GetTip (l blk) => LedgerSeq m l blk -> Point (l blk)
tip :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> Point (l blk)
tip = Point (l blk) -> Point (l blk)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (l blk) -> Point (l blk))
-> (LedgerSeq m l blk -> Point (l blk))
-> LedgerSeq m l blk
-> Point (l blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l blk EmptyMK -> Point (l blk)
forall (mk :: * -> * -> *). l blk mk -> Point (l blk)
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip (l blk EmptyMK -> Point (l blk))
-> (LedgerSeq m l blk -> l blk EmptyMK)
-> LedgerSeq m l blk
-> Point (l blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk -> l blk EmptyMK
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> l blk EmptyMK
current

-- | Have we seen at least @k@ blocks?
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> isSaturated (SecurityParam (unsafeNonZero 3)) ldb
-- True
-- >>> isSaturated (SecurityParam (unsafeNonZero 4)) ldb
-- False
isSaturated :: GetTip (l blk) => SecurityParam -> LedgerSeq m l blk -> Bool
isSaturated :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
SecurityParam -> LedgerSeq m l blk -> Bool
isSaturated (SecurityParam NonZero Word64
k) LedgerSeq m l blk
db =
  LedgerSeq m l blk -> Word64
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> Word64
maxRollback LedgerSeq m l blk
db Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k

-- | Get a past ledger state
--
--  \( O(\log(\min(i,n-i)) \)
--
-- When no ledger state (or anchor) has the given 'Point', 'Nothing' is
-- returned.
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> getPastLedgerAt (Point (At (Block 4 4)) :: Point B) ldb == Nothing
-- True
-- >>> getPastLedgerAt (Point (At (Block 1 1)) :: Point B) ldb == Just l2s
-- True
getPastLedgerAt ::
  ( HasHeader blk
  , GetTip (l blk)
  , HeaderHash (l blk) ~ HeaderHash blk
  , StandardHash (l blk)
  ) =>
  Point blk ->
  LedgerSeq m l blk ->
  Maybe (l blk EmptyMK)
getPastLedgerAt :: forall blk (l :: * -> (* -> * -> *) -> *) (m :: * -> *).
(HasHeader blk, GetTip (l blk),
 HeaderHash (l blk) ~ HeaderHash blk, StandardHash (l blk)) =>
Point blk -> LedgerSeq m l blk -> Maybe (l blk EmptyMK)
getPastLedgerAt Point blk
pt LedgerSeq m l blk
db = LedgerSeq m l blk -> l blk EmptyMK
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> l blk EmptyMK
current (LedgerSeq m l blk -> l blk EmptyMK)
-> Maybe (LedgerSeq m l blk) -> Maybe (l blk EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point blk -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall blk (l :: * -> (* -> * -> *) -> *) (m :: * -> *).
(HasHeader blk, GetTip (l blk),
 HeaderHash (l blk) ~ HeaderHash blk, StandardHash (l blk)) =>
Point blk -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollback Point blk
pt LedgerSeq m l blk
db

-- | Roll back the volatile states up to the specified point.
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> Just (LedgerSeq ldb') = rollbackToPoint (Point Origin) ldb
-- >>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == []
-- True
-- >>> rollbackToPoint (Point (At (Block 1 2))) ldb == Nothing
-- True
-- >>> Just (LedgerSeq ldb') = rollbackToPoint (Point (At (Block 1 1))) ldb
-- >>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == [l1, l2]
-- True
rollbackToPoint ::
  ( StandardHash (l blk)
  , GetTip (l blk)
  ) =>
  Point (l blk) -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollbackToPoint :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
(StandardHash (l blk), GetTip (l blk)) =>
Point (l blk) -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollbackToPoint Point (l blk)
pt (LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb) = do
  AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq
    (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> LedgerSeq m l blk)
-> Maybe
     (AnchoredSeq
        (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> Maybe (LedgerSeq m l blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WithOrigin SlotNo
-> (Either (StateRef m l blk) (StateRef m l blk) -> Bool)
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> Maybe
     (AnchoredSeq
        (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
forall v a b.
Anchorable v a b =>
v
-> (Either a b -> Bool)
-> AnchoredSeq v a b
-> Maybe (AnchoredSeq v a b)
AS.rollback
      (Point (l blk) -> WithOrigin SlotNo
forall {k} (block :: k). Point block -> WithOrigin SlotNo
pointSlot Point (l blk)
pt)
      ((Point (l blk) -> Point (l blk) -> Bool
forall a. Eq a => a -> a -> Bool
== Point (l blk)
pt) (Point (l blk) -> Bool)
-> (Either (StateRef m l blk) (StateRef m l blk) -> Point (l blk))
-> Either (StateRef m l blk) (StateRef m l blk)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l blk EmptyMK -> Point (l blk)
forall (mk :: * -> * -> *). l blk mk -> Point (l blk)
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip (l blk EmptyMK -> Point (l blk))
-> (Either (StateRef m l blk) (StateRef m l blk) -> l blk EmptyMK)
-> Either (StateRef m l blk) (StateRef m l blk)
-> Point (l blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateRef m l blk -> l blk EmptyMK)
-> (StateRef m l blk -> l blk EmptyMK)
-> Either (StateRef m l blk) (StateRef m l blk)
-> l blk EmptyMK
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state)
      AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
ldb

-- | Rollback the volatile states up to the volatile anchor.
--
-- >>> ldb = LedgerSeq $ AS.fromOldestFirst l0 [l1, l2, l3]
-- >>> LedgerSeq ldb' = rollbackToAnchor ldb
-- >>> AS.anchor ldb' == l0 && AS.toOldestFirst ldb' == []
-- True
rollbackToAnchor ::
  GetTip (l blk) =>
  LedgerSeq m l blk -> LedgerSeq m l blk
rollbackToAnchor :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> LedgerSeq m l blk
rollbackToAnchor (LedgerSeq AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
vol) =
  AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> LedgerSeq m l blk
LedgerSeq (StateRef m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall v a b. Anchorable v a b => a -> AnchoredSeq v a b
AS.Empty (AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. AnchoredSeq v a b -> a
AS.anchor AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
vol))

-- | Get a prefix of the LedgerDB that ends at the given point
--
--  \( O(\log(\min(i,n-i)) \)
--
-- When no ledger state (or anchor) has the given 'Point', 'Nothing' is
-- returned.
rollback ::
  ( HasHeader blk
  , GetTip (l blk)
  , HeaderHash (l blk) ~ HeaderHash blk
  , StandardHash (l blk)
  ) =>
  Point blk ->
  LedgerSeq m l blk ->
  Maybe (LedgerSeq m l blk)
rollback :: forall blk (l :: * -> (* -> * -> *) -> *) (m :: * -> *).
(HasHeader blk, GetTip (l blk),
 HeaderHash (l blk) ~ HeaderHash blk, StandardHash (l blk)) =>
Point blk -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollback Point blk
pt LedgerSeq m l blk
db
  | Point blk
pt Point blk -> Point blk -> Bool
forall a. Eq a => a -> a -> Bool
== Point (l blk) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (l blk EmptyMK -> Point (l blk)
forall (mk :: * -> * -> *). l blk mk -> Point (l blk)
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip (LedgerSeq m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk -> l blk EmptyMK
anchor LedgerSeq m l blk
db)) =
      LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall a. a -> Maybe a
Just (LedgerSeq m l blk -> Maybe (LedgerSeq m l blk))
-> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall a b. (a -> b) -> a -> b
$ LedgerSeq m l blk -> LedgerSeq m l blk
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> LedgerSeq m l blk
rollbackToAnchor LedgerSeq m l blk
db
  | Bool
otherwise =
      Point (l blk) -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
(StandardHash (l blk), GetTip (l blk)) =>
Point (l blk) -> LedgerSeq m l blk -> Maybe (LedgerSeq m l blk)
rollbackToPoint (Point blk -> Point (l blk)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint Point blk
pt) LedgerSeq m l blk
db

immutableTipSlot ::
  GetTip (l blk) =>
  LedgerSeq m l blk -> WithOrigin SlotNo
immutableTipSlot :: forall (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
GetTip (l blk) =>
LedgerSeq m l blk -> WithOrigin SlotNo
immutableTipSlot =
  l blk EmptyMK -> WithOrigin SlotNo
forall (l :: (* -> * -> *) -> *) (mk :: * -> * -> *).
GetTip l =>
l mk -> WithOrigin SlotNo
getTipSlot
    (l blk EmptyMK -> WithOrigin SlotNo)
-> (LedgerSeq m l blk -> l blk EmptyMK)
-> LedgerSeq m l blk
-> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state
    (StateRef m l blk -> l blk EmptyMK)
-> (LedgerSeq m l blk -> StateRef m l blk)
-> LedgerSeq m l blk
-> l blk EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq
  (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> StateRef m l blk
forall v a b. AnchoredSeq v a b -> a
AS.anchor
    (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> StateRef m l blk)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> StateRef m l blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

-- | Transform the underlying volatile 'AnchoredSeq' using the given functions.
volatileStatesBimap ::
  AS.Anchorable (WithOrigin SlotNo) a b =>
  (l blk EmptyMK -> a) ->
  (l blk EmptyMK -> b) ->
  LedgerSeq m l blk ->
  AS.AnchoredSeq (WithOrigin SlotNo) a b
volatileStatesBimap :: forall a b (l :: * -> (* -> * -> *) -> *) blk (m :: * -> *).
Anchorable (WithOrigin SlotNo) a b =>
(l blk EmptyMK -> a)
-> (l blk EmptyMK -> b)
-> LedgerSeq m l blk
-> AnchoredSeq (WithOrigin SlotNo) a b
volatileStatesBimap l blk EmptyMK -> a
f l blk EmptyMK -> b
g =
  (StateRef m l blk -> a)
-> (StateRef m l blk -> b)
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
-> AnchoredSeq (WithOrigin SlotNo) a b
forall v2 a2 b2 a1 b1 v1.
Anchorable v2 a2 b2 =>
(a1 -> a2)
-> (b1 -> b2) -> AnchoredSeq v1 a1 b1 -> AnchoredSeq v2 a2 b2
AS.bimap (l blk EmptyMK -> a
f (l blk EmptyMK -> a)
-> (StateRef m l blk -> l blk EmptyMK) -> StateRef m l blk -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state) (l blk EmptyMK -> b
g (l blk EmptyMK -> b)
-> (StateRef m l blk -> l blk EmptyMK) -> StateRef m l blk -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateRef m l blk -> l blk EmptyMK
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
StateRef m l blk -> l blk EmptyMK
state)
    (AnchoredSeq
   (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
 -> AnchoredSeq (WithOrigin SlotNo) a b)
-> (LedgerSeq m l blk
    -> AnchoredSeq
         (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk))
-> LedgerSeq m l blk
-> AnchoredSeq (WithOrigin SlotNo) a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
forall (m :: * -> *) (l :: * -> (* -> * -> *) -> *) blk.
LedgerSeq m l blk
-> AnchoredSeq
     (WithOrigin SlotNo) (StateRef m l blk) (StateRef m l blk)
getLedgerSeq

{-------------------------------------------------------------------------------
  docspec setup
-------------------------------------------------------------------------------}

-- $setup
-- >>> :set -XTypeFamilies -XUndecidableInstances -XFlexibleInstances -XTypeApplications -XMultiParamTypeClasses
-- >>> import qualified Ouroboros.Network.AnchoredSeq as AS
-- >>> import Ouroboros.Network.Block
-- >>> import Ouroboros.Network.Point
-- >>> import Ouroboros.Consensus.Ledger.Tables
-- >>> import Ouroboros.Consensus.Ledger.Tables.Utils
-- >>> import Ouroboros.Consensus.Ledger.Basics
-- >>> import Ouroboros.Consensus.Config
-- >>> import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory
-- >>> import Ouroboros.Consensus.Util.IndexedMemPack
-- >>> import Ouroboros.Consensus.Storage.LedgerDB.API
-- >>> import Cardano.Ledger.BaseTypes.NonZero
-- >>> import Data.Void
-- >>> import Cardano.Slotting.Slot
-- >>> import Data.Proxy
--
-- >>> data B
-- >>> type instance HeaderHash B = Int
-- >>> instance StandardHash B
-- >>> instance HasHeader B where getHeaderFields = undefined
--
-- >>> type instance TxIn B = Void
-- >>> type instance TxOut B = Void
--
-- >>> data instance LedgerState B (mk :: MapKind) = LS (Point B)
-- >>> instance Eq (LedgerState B EmptyMK) where LS p1 == LS p2 = p1 == p2
-- >>> :{
--  instance GetTip (LedgerState B) where
--    getTip (LS p) = castPoint p
-- :}
--
-- >>> :{
--  s = [ LS (Point Origin)
--      , LS (Point (At (Block 0 0)))
--      , LS (Point (At (Block 1 1)))
--      , LS (Point (At (Block 2 2)))
--      , LS (Point (At (Block 3 3)))
--      ]
-- :}
--
-- >>> [l0s, l1s, l2s, l3s, l4s] = s
--
-- >>> :{
--  instance LedgerTablesAreTrivial LedgerState B where
--    convertMapKind (LS p) = LS p
--  instance HasLedgerTables LedgerState B where
--    projectLedgerTables _ = trivialLedgerTables (Proxy @LedgerState)
--    withLedgerTables st _ = convertMapKind st
--  instance IndexedMemPack LedgerState B Void where
--    indexedTypeName _ _ = typeName @Void
--    indexedPackedByteCount _ = packedByteCount
--    indexedPackM _ = packM
--    indexedUnpackM _ = unpackM
-- :}
--
-- >>> :{
--  emptyHandle =
--     LedgerTablesHandle
--        (pure ())
--        (\_ _ -> pure emptyHandle)
--        (pure emptyHandle)
--        (\_ _ -> pure (trivialLedgerTables (Proxy @LedgerState)))
--        (\_ _ -> pure (trivialLedgerTables (Proxy @LedgerState), Nothing))
--        (\_ -> pure (trivialLedgerTables (Proxy @LedgerState)))
--        (\_ _ -> undefined)
--        0 :: LedgerTablesHandle IO LedgerState B
-- :}
--
-- >>> [l0, l1, l2, l3, l4] = map (flip StateRef emptyHandle) s