{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Intended for qualified import
--
-- > import Ouroboros.Consensus.HardFork.Combinator.State (HardForkState(..))
-- > import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
module Ouroboros.Consensus.HardFork.Combinator.State (
    module X
    -- * Support for defining instances
  , getTip
    -- * Serialisation support
  , recover
    -- * EpochInfo
  , epochInfoLedger
  , epochInfoPrecomputedTransitionInfo
  , mostRecentTransitionInfo
  , reconstructSummaryLedger
    -- * Ledger specific functionality
  , extendToSlot
  ) where

import           Control.Monad (guard)
import           Data.Functor.Product
import           Data.Proxy
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Counting (getExactly)
import           Data.SOP.Functors (Flip (..))
import           Data.SOP.InPairs (InPairs, Requiring (..))
import qualified Data.SOP.InPairs as InPairs
import           Data.SOP.Strict
import           Data.SOP.Telescope (Extend (..), ScanNext (..), Telescope)
import qualified Data.SOP.Telescope as Telescope
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HardFork.Combinator.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import           Ouroboros.Consensus.HardFork.Combinator.Basics
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HardFork.Combinator.State.Infra as X
import           Ouroboros.Consensus.HardFork.Combinator.State.Instances as X ()
import           Ouroboros.Consensus.HardFork.Combinator.State.Types as X
import           Ouroboros.Consensus.HardFork.Combinator.Translation
import qualified Ouroboros.Consensus.HardFork.History as History
import           Ouroboros.Consensus.Ledger.Abstract hiding (getTip)
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Prelude hiding (sequence)

{-------------------------------------------------------------------------------
  GetTip
-------------------------------------------------------------------------------}

getTip :: forall f xs. CanHardFork xs
       => (forall blk. SingleEraBlock blk => f blk -> Point blk)
       -> HardForkState f xs -> Point (HardForkBlock xs)
getTip :: forall (f :: * -> *) (xs :: [*]).
CanHardFork xs =>
(forall blk. SingleEraBlock blk => f blk -> Point blk)
-> HardForkState f xs -> Point (HardForkBlock xs)
getTip forall blk. SingleEraBlock blk => f blk -> Point blk
getLedgerTip =
      NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs)
NS (K (Point (HardForkBlock xs))) xs
-> CollapseTo NS (Point (HardForkBlock xs))
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (Point (HardForkBlock xs))) xs -> Point (HardForkBlock xs))
-> (HardForkState f xs -> NS (K (Point (HardForkBlock xs))) xs)
-> HardForkState f xs
-> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    f a -> K (Point (HardForkBlock xs)) a)
-> NS f xs
-> NS (K (Point (HardForkBlock xs))) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a
forall k a (b :: k). a -> K a b
K (Point (HardForkBlock xs) -> K (Point (HardForkBlock xs)) a)
-> (f a -> Point (HardForkBlock xs))
-> f a
-> K (Point (HardForkBlock xs)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point a -> Point (HardForkBlock xs)
forall blk.
SingleEraBlock blk =>
Point blk -> Point (HardForkBlock xs)
injPoint (Point a -> Point (HardForkBlock xs))
-> (f a -> Point a) -> f a -> Point (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Point a
forall blk. SingleEraBlock blk => f blk -> Point blk
getLedgerTip)
    (NS f xs -> NS (K (Point (HardForkBlock xs))) xs)
-> (HardForkState f xs -> NS f xs)
-> HardForkState f xs
-> NS (K (Point (HardForkBlock xs))) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState f xs -> NS f xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
tip
  where
    injPoint :: forall blk. SingleEraBlock blk
             => Point blk -> Point (HardForkBlock xs)
    injPoint :: forall blk.
SingleEraBlock blk =>
Point blk -> Point (HardForkBlock xs)
injPoint Point blk
GenesisPoint     = Point (HardForkBlock xs)
forall {k} (block :: k). Point block
GenesisPoint
    injPoint (BlockPoint SlotNo
s HeaderHash blk
h) = SlotNo -> HeaderHash (HardForkBlock xs) -> Point (HardForkBlock xs)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint SlotNo
s (HeaderHash (HardForkBlock xs) -> Point (HardForkBlock xs))
-> HeaderHash (HardForkBlock xs) -> Point (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ ShortByteString -> OneEraHash xs
forall k (xs :: [k]). ShortByteString -> OneEraHash xs
OneEraHash (ShortByteString -> OneEraHash xs)
-> ShortByteString -> OneEraHash xs
forall a b. (a -> b) -> a -> b
$
                                  Proxy blk -> HeaderHash blk -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy blk -> HeaderHash blk -> ShortByteString
toShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk) HeaderHash blk
h

{-------------------------------------------------------------------------------
  Recovery
-------------------------------------------------------------------------------}

-- | Recover 'HardForkState' from partial information
--
-- The primary goal of this is to make sure that for the /current/ state we
-- really only need to store the underlying @f@. It is not strictly essential
-- that this is possible but it helps with the unary hardfork case, and it may
-- in general help with binary compatibility.
recover :: forall f xs. CanHardFork xs
        => Telescope (K Past) f xs -> HardForkState f xs
recover :: forall (f :: * -> *) (xs :: [*]).
CanHardFork xs =>
Telescope (K Past) f xs -> HardForkState f xs
recover =
    case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty {} ->
          Telescope (K Past) (Current f) xs -> HardForkState f xs
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
        (Telescope (K Past) (Current f) xs -> HardForkState f xs)
-> (Telescope (K Past) f xs -> Telescope (K Past) (Current f) xs)
-> Telescope (K Past) f xs
-> HardForkState f xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. Product (K Bound) (K Past) x -> K Past x)
-> (forall x. Product (K Bound) f x -> Current f x)
-> Telescope (Product (K Bound) (K Past)) (Product (K Bound) f) xs
-> Telescope (K Past) (Current f) xs
forall {k} (xs :: [k]) (g :: k -> *) (g' :: k -> *) (f :: k -> *)
       (f' :: k -> *).
SListI xs =>
(forall (x :: k). g x -> g' x)
-> (forall (x :: k). f x -> f' x)
-> Telescope g f xs
-> Telescope g' f' xs
Telescope.bihmap
            (\(Pair K Bound x
_ K Past x
past) -> K Past x
past)
            Product (K Bound) f x -> Current f x
forall x. Product (K Bound) f x -> Current f x
recoverCurrent
        (Telescope (Product (K Bound) (K Past)) (Product (K Bound) f) xs
 -> Telescope (K Past) (Current f) xs)
-> (Telescope (K Past) f xs
    -> Telescope (Product (K Bound) (K Past)) (Product (K Bound) f) xs)
-> Telescope (K Past) f xs
-> Telescope (K Past) (Current f) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InPairs (ScanNext (K Bound) (K Past)) (x : xs1)
-> K Bound x
-> Telescope (K Past) f (x : xs1)
-> Telescope
     (Product (K Bound) (K Past)) (Product (K Bound) f) (x : xs1)
forall {a} (h :: a -> *) (g :: a -> *) (x :: a) (xs :: [a])
       (f :: a -> *).
InPairs (ScanNext h g) (x : xs)
-> h x
-> Telescope g f (x : xs)
-> Telescope (Product h g) (Product h f) (x : xs)
Telescope.scanl
            ((forall x y. ScanNext (K Bound) (K Past) x y)
-> InPairs (ScanNext (K Bound) (K Past)) (x : xs1)
forall {k} (xs :: [k]) (f :: k -> k -> *).
(SListI xs, IsNonEmpty xs) =>
(forall (x :: k) (y :: k). f x y) -> InPairs f xs
InPairs.hpure ((forall x y. ScanNext (K Bound) (K Past) x y)
 -> InPairs (ScanNext (K Bound) (K Past)) (x : xs1))
-> (forall x y. ScanNext (K Bound) (K Past) x y)
-> InPairs (ScanNext (K Bound) (K Past)) (x : xs1)
forall a b. (a -> b) -> a -> b
$ (K Bound x -> K Past x -> K Bound y)
-> ScanNext (K Bound) (K Past) x y
forall {k} (h :: k -> *) (g :: k -> *) (x :: k) (y :: k).
(h x -> g x -> h y) -> ScanNext h g x y
ScanNext ((K Bound x -> K Past x -> K Bound y)
 -> ScanNext (K Bound) (K Past) x y)
-> (K Bound x -> K Past x -> K Bound y)
-> ScanNext (K Bound) (K Past) x y
forall a b. (a -> b) -> a -> b
$ (K Past x -> K Bound y) -> K Bound x -> K Past x -> K Bound y
forall a b. a -> b -> a
const ((K Past x -> K Bound y) -> K Bound x -> K Past x -> K Bound y)
-> (K Past x -> K Bound y) -> K Bound x -> K Past x -> K Bound y
forall a b. (a -> b) -> a -> b
$ Bound -> K Bound y
forall k a (b :: k). a -> K a b
K (Bound -> K Bound y)
-> (K Past x -> Bound) -> K Past x -> K Bound y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Past -> Bound
pastEnd (Past -> Bound) -> (K Past x -> Past) -> K Past x -> Bound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K Past x -> Past
forall {k} a (b :: k). K a b -> a
unK)
            (Bound -> K Bound x
forall k a (b :: k). a -> K a b
K Bound
History.initBound)
  where
    recoverCurrent :: Product (K History.Bound) f blk -> Current f blk
    recoverCurrent :: forall x. Product (K Bound) f x -> Current f x
recoverCurrent (Pair (K Bound
prevEnd) f blk
st) = Current {
          currentStart :: Bound
currentStart = Bound
prevEnd
        , currentState :: f blk
currentState = f blk
st
        }

{-------------------------------------------------------------------------------
  Reconstruct EpochInfo
-------------------------------------------------------------------------------}

mostRecentTransitionInfo :: All SingleEraBlock xs
                         => HardForkLedgerConfig xs
                         -> HardForkState (Flip LedgerState mk) xs
                         -> TransitionInfo
mostRecentTransitionInfo :: forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> TransitionInfo
mostRecentTransitionInfo HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
..} HardForkState (Flip LedgerState mk) xs
st =
    NS (K TransitionInfo) xs -> CollapseTo NS TransitionInfo
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (NS (K TransitionInfo) xs -> CollapseTo NS TransitionInfo)
-> NS (K TransitionInfo) xs -> CollapseTo NS TransitionInfo
forall a b. (a -> b) -> a -> b
$
      Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a
    -> K EraParams a
    -> Current (Flip LedgerState mk) a
    -> K TransitionInfo a)
-> Prod NS WrapPartialLedgerConfig xs
-> Prod NS (K EraParams) xs
-> NS (Current (Flip LedgerState mk)) xs
-> NS (K TransitionInfo) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs
-> Prod h f' xs
-> h f'' xs
-> h f''' xs
hczipWith3
        Proxy SingleEraBlock
proxySingle
        WrapPartialLedgerConfig a
-> K EraParams a
-> Current (Flip LedgerState mk) a
-> K TransitionInfo a
forall a.
SingleEraBlock a =>
WrapPartialLedgerConfig a
-> K EraParams a
-> Current (Flip LedgerState mk) a
-> K TransitionInfo a
forall blk (mk :: MapKind).
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> K EraParams blk
-> Current (Flip LedgerState mk) blk
-> K TransitionInfo blk
getTransition
        Prod NS WrapPartialLedgerConfig xs
NP WrapPartialLedgerConfig xs
cfgs
        (Exactly xs EraParams -> NP (K EraParams) xs
forall (xs :: [*]) a. Exactly xs a -> NP (K a) xs
getExactly (Shape xs -> Exactly xs EraParams
forall (xs :: [*]). Shape xs -> Exactly xs EraParams
History.getShape Shape xs
hardForkLedgerConfigShape))
        (Telescope (K Past) (Current (Flip LedgerState mk)) xs
-> NS (Current (Flip LedgerState mk)) xs
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip (HardForkState (Flip LedgerState mk) xs
-> Telescope (K Past) (Current (Flip LedgerState mk)) xs
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState HardForkState (Flip LedgerState mk) xs
st))
  where
    cfgs :: NP WrapPartialLedgerConfig xs
cfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra

    getTransition :: SingleEraBlock                blk
                  => WrapPartialLedgerConfig       blk
                  -> K History.EraParams           blk
                  -> Current (Flip LedgerState mk) blk
                  -> K TransitionInfo              blk
    getTransition :: forall blk (mk :: MapKind).
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> K EraParams blk
-> Current (Flip LedgerState mk) blk
-> K TransitionInfo blk
getTransition WrapPartialLedgerConfig blk
cfg (K EraParams
eraParams) Current{currentState :: forall (f :: * -> *) blk. Current f blk -> f blk
currentState = Flip LedgerState blk mk
curState, Bound
currentStart :: forall (f :: * -> *) blk. Current f blk -> Bound
currentStart :: Bound
..} = TransitionInfo -> K TransitionInfo blk
forall k a (b :: k). a -> K a b
K (TransitionInfo -> K TransitionInfo blk)
-> TransitionInfo -> K TransitionInfo blk
forall a b. (a -> b) -> a -> b
$
        case WrapPartialLedgerConfig blk
-> EraParams -> Bound -> LedgerState blk mk -> Maybe EpochNo
forall blk (mk :: MapKind).
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> EraParams -> Bound -> LedgerState blk mk -> Maybe EpochNo
singleEraTransition' WrapPartialLedgerConfig blk
cfg EraParams
eraParams Bound
currentStart LedgerState blk mk
curState of
          Maybe EpochNo
Nothing -> WithOrigin SlotNo -> TransitionInfo
TransitionUnknown (LedgerState blk mk -> WithOrigin SlotNo
forall blk (mk :: MapKind).
UpdateLedger blk =>
LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot LedgerState blk mk
curState)
          Just EpochNo
e  -> EpochNo -> TransitionInfo
TransitionKnown EpochNo
e

reconstructSummaryLedger :: All SingleEraBlock xs
                         => HardForkLedgerConfig xs
                         -> HardForkState (Flip LedgerState mk) xs
                         -> History.Summary xs
reconstructSummaryLedger :: forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> Summary xs
reconstructSummaryLedger cfg :: HardForkLedgerConfig xs
cfg@HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..} HardForkState (Flip LedgerState mk) xs
st =
    Shape xs
-> TransitionInfo
-> HardForkState (Flip LedgerState mk) xs
-> Summary xs
forall (xs :: [*]) (f :: * -> *).
Shape xs -> TransitionInfo -> HardForkState f xs -> Summary xs
reconstructSummary
      Shape xs
hardForkLedgerConfigShape
      (HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> TransitionInfo
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> TransitionInfo
mostRecentTransitionInfo HardForkLedgerConfig xs
cfg HardForkState (Flip LedgerState mk) xs
st)
      HardForkState (Flip LedgerState mk) xs
st

-- | Construct 'EpochInfo' from the ledger state
--
-- NOTE: The resulting 'EpochInfo' is a snapshot only, with a limited range.
-- It should not be stored.
epochInfoLedger :: All SingleEraBlock xs
                => HardForkLedgerConfig xs
                -> HardForkState (Flip LedgerState mk) xs
                -> EpochInfo (Except PastHorizonException)
epochInfoLedger :: forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs
-> EpochInfo (Except PastHorizonException)
epochInfoLedger HardForkLedgerConfig xs
cfg HardForkState (Flip LedgerState mk) xs
st =
    Summary xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Summary xs -> EpochInfo (Except PastHorizonException)
History.summaryToEpochInfo (Summary xs -> EpochInfo (Except PastHorizonException))
-> Summary xs -> EpochInfo (Except PastHorizonException)
forall a b. (a -> b) -> a -> b
$
      HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> Summary xs
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs -> Summary xs
reconstructSummaryLedger HardForkLedgerConfig xs
cfg HardForkState (Flip LedgerState mk) xs
st

-- | Construct 'EpochInfo' given precomputed 'TransitionInfo'
--
-- The transition and state arguments are acquired either from a ticked ledger
-- state or a ledger view.
epochInfoPrecomputedTransitionInfo ::
     History.Shape xs
  -> TransitionInfo
  -> HardForkState f xs
  -> EpochInfo (Except PastHorizonException)
epochInfoPrecomputedTransitionInfo :: forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
epochInfoPrecomputedTransitionInfo Shape xs
shape TransitionInfo
transition HardForkState f xs
st =
    Summary xs -> EpochInfo (Except PastHorizonException)
forall (xs :: [*]).
Summary xs -> EpochInfo (Except PastHorizonException)
History.summaryToEpochInfo (Summary xs -> EpochInfo (Except PastHorizonException))
-> Summary xs -> EpochInfo (Except PastHorizonException)
forall a b. (a -> b) -> a -> b
$
      Shape xs -> TransitionInfo -> HardForkState f xs -> Summary xs
forall (xs :: [*]) (f :: * -> *).
Shape xs -> TransitionInfo -> HardForkState f xs -> Summary xs
reconstructSummary Shape xs
shape TransitionInfo
transition HardForkState f xs
st

{-------------------------------------------------------------------------------
  Extending
-------------------------------------------------------------------------------}

-- | Extend the telescope until the specified slot is within the era at the tip.
--
-- Note that transitioning to a later era might create new values in the ledger
-- tables, therefore the result of this function is a @DiffMK@.
--
-- If we are crossing no era boundaries, this whole function is a no-op that
-- only creates an empty @DiffMK@, because the @Telescope.extend@ function will
-- do nothing.
--
-- If we are crossing one era boundary, the ledger tables might be populated
-- with whatever @translateLedgerStateWith@ returns.
--
-- If we are crossing multiple era boundaries, the diffs generated when crossing
-- an era boundary will be prepended to the ones produced by later era
-- boundaries and, in order to all match the resulting era, they will be
-- translated to later eras.
--
-- This means in particular that if we extend from @era1@ to @era3@ going
-- through @era2@, we will:
--
-- 1. translate the ledger state from @era1@ to @era2@, which produces a @era2@
--    ledger state together with a some set of differences.
--
-- 2. keep the @era2@ diffs aside, and translate the @era2@ ledger state without
--    ledger tables, which produces a @era3@ ledger state together with a set of
--    @era3@ differences.
--
-- 3. Translate the @era2@ diffs to @era3@ differences, and prepend them to the
--    ones created in the step 2.
--
-- 4. Attach the diffs resulting from step 3 to the @era3@ ledger state from
--    step 2, and return it.
extendToSlot :: forall xs.
                (CanHardFork xs)
             => HardForkLedgerConfig xs
             -> SlotNo
             -> HardForkState (Flip LedgerState EmptyMK) xs
             -> HardForkState (Flip LedgerState DiffMK) xs
extendToSlot :: forall (xs :: [*]).
CanHardFork xs =>
HardForkLedgerConfig xs
-> SlotNo
-> HardForkState (Flip LedgerState EmptyMK) xs
-> HardForkState (Flip LedgerState DiffMK) xs
extendToSlot ledgerCfg :: HardForkLedgerConfig xs
ledgerCfg@HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..} SlotNo
slot ledgerSt :: HardForkState (Flip LedgerState EmptyMK) xs
ledgerSt@(HardForkState Telescope (K Past) (Current (Flip LedgerState EmptyMK)) xs
st) =
      Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
-> HardForkState (Flip LedgerState DiffMK) xs
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
HardForkState
    (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
 -> HardForkState (Flip LedgerState DiffMK) xs)
-> (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
    -> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
-> HardForkState (Flip LedgerState DiffMK) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
forall a. I a -> a
unI
    (I (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
 -> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
-> (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
    -> I (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs))
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InPairs
  (Requiring
     (K Bound) (Extend I (K Past) (Current (Flip LedgerState DiffMK))))
  xs
-> NP
     (Current (Flip LedgerState DiffMK) -.-> (Maybe :.: K Bound)) xs
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
-> I (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
forall {k} (m :: * -> *) (h :: k -> *) (g :: k -> *) (f :: k -> *)
       (xs :: [k]).
Monad m =>
InPairs (Requiring h (Extend m g f)) xs
-> NP (f -.-> (Maybe :.: h)) xs
-> Telescope g f xs
-> m (Telescope g f xs)
Telescope.extend
        ( Proxy SingleEraBlock
-> (forall x y.
    (SingleEraBlock x, SingleEraBlock y) =>
    TranslateLedgerState x y
    -> TranslateLedgerTables x y
    -> Requiring
         (K Bound)
         (Extend I (K Past) (Current (Flip LedgerState DiffMK)))
         x
         y)
-> InPairs TranslateLedgerState xs
-> InPairs TranslateLedgerTables xs
-> InPairs
     (Requiring
        (K Bound) (Extend I (K Past) (Current (Flip LedgerState DiffMK))))
     xs
forall {k} (proxy :: (k -> Constraint) -> *) (c :: k -> Constraint)
       (f :: k -> k -> *) (f' :: k -> k -> *) (f'' :: k -> k -> *)
       (xs :: [k]).
All c xs =>
proxy c
-> (forall (x :: k) (y :: k).
    (c x, c y) =>
    f x y -> f' x y -> f'' x y)
-> InPairs f xs
-> InPairs f' xs
-> InPairs f'' xs
InPairs.hczipWith Proxy SingleEraBlock
proxySingle (\TranslateLedgerState x y
f TranslateLedgerTables x y
f' -> (K Bound x
 -> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y)
-> Requiring
     (K Bound)
     (Extend I (K Past) (Current (Flip LedgerState DiffMK)))
     x
     y
forall {k} {k1} (h :: k -> *) (f :: k -> k1 -> *) (x :: k)
       (y :: k1).
(h x -> f x y) -> Requiring h f x y
Require ((K Bound x
  -> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y)
 -> Requiring
      (K Bound)
      (Extend I (K Past) (Current (Flip LedgerState DiffMK)))
      x
      y)
-> (K Bound x
    -> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y)
-> Requiring
     (K Bound)
     (Extend I (K Past) (Current (Flip LedgerState DiffMK)))
     x
     y
forall a b. (a -> b) -> a -> b
$ \(K Bound
t)
                                        -> (Current (Flip LedgerState DiffMK) x
 -> I (K Past x, Current (Flip LedgerState DiffMK) y))
-> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y
forall {k} (m :: * -> *) (g :: k -> *) (f :: k -> *) (x :: k)
       (y :: k).
(f x -> m (g x, f y)) -> Extend m g f x y
Extend  ((Current (Flip LedgerState DiffMK) x
  -> I (K Past x, Current (Flip LedgerState DiffMK) y))
 -> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y)
-> (Current (Flip LedgerState DiffMK) x
    -> I (K Past x, Current (Flip LedgerState DiffMK) y))
-> Extend I (K Past) (Current (Flip LedgerState DiffMK)) x y
forall a b. (a -> b) -> a -> b
$ \Current (Flip LedgerState DiffMK) x
cur
                                        -> (K Past x, Current (Flip LedgerState DiffMK) y)
-> I (K Past x, Current (Flip LedgerState DiffMK) y)
forall a. a -> I a
I ((K Past x, Current (Flip LedgerState DiffMK) y)
 -> I (K Past x, Current (Flip LedgerState DiffMK) y))
-> (K Past x, Current (Flip LedgerState DiffMK) y)
-> I (K Past x, Current (Flip LedgerState DiffMK) y)
forall a b. (a -> b) -> a -> b
$ TranslateLedgerState x y
-> TranslateLedgerTables x y
-> Bound
-> Current (Flip LedgerState DiffMK) x
-> (K Past x, Current (Flip LedgerState DiffMK) y)
forall blk blk'.
(HasLedgerTables (LedgerState blk),
 HasLedgerTables (LedgerState blk')) =>
TranslateLedgerState blk blk'
-> TranslateLedgerTables blk blk'
-> Bound
-> Current (Flip LedgerState DiffMK) blk
-> (K Past blk, Current (Flip LedgerState DiffMK) blk')
howExtend TranslateLedgerState x y
f TranslateLedgerTables x y
f' Bound
t Current (Flip LedgerState DiffMK) x
cur)
            InPairs TranslateLedgerState xs
translateLS
            InPairs TranslateLedgerTables xs
translateLT
        )
        (Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a
    -> K EraParams a
    -> (-.->)
         (Current (Flip LedgerState DiffMK)) (Maybe :.: K Bound) a)
-> Prod NP WrapPartialLedgerConfig xs
-> NP (K EraParams) xs
-> NP
     (Current (Flip LedgerState DiffMK) -.-> (Maybe :.: K Bound)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith
           Proxy SingleEraBlock
proxySingle
           ((Current (Flip LedgerState DiffMK) a -> (:.:) Maybe (K Bound) a)
-> (-.->) (Current (Flip LedgerState DiffMK)) (Maybe :.: K Bound) a
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *).
(f a -> f' a) -> (-.->) f f' a
fn ((Current (Flip LedgerState DiffMK) a -> (:.:) Maybe (K Bound) a)
 -> (-.->)
      (Current (Flip LedgerState DiffMK)) (Maybe :.: K Bound) a)
-> (WrapPartialLedgerConfig a
    -> K EraParams a
    -> Current (Flip LedgerState DiffMK) a
    -> (:.:) Maybe (K Bound) a)
-> WrapPartialLedgerConfig a
-> K EraParams a
-> (-.->) (Current (Flip LedgerState DiffMK)) (Maybe :.: K Bound) a
forall y z x0 x1. (y -> z) -> (x0 -> x1 -> y) -> x0 -> x1 -> z
.: WrapPartialLedgerConfig a
-> K EraParams a
-> Current (Flip LedgerState DiffMK) a
-> (:.:) Maybe (K Bound) a
forall blk.
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> K EraParams blk
-> Current (Flip LedgerState DiffMK) blk
-> (:.:) Maybe (K Bound) blk
whenExtend)
           Prod NP WrapPartialLedgerConfig xs
NP WrapPartialLedgerConfig xs
pcfgs
           (Exactly xs EraParams -> NP (K EraParams) xs
forall (xs :: [*]) a. Exactly xs a -> NP (K a) xs
getExactly (Shape xs -> Exactly xs EraParams
forall (xs :: [*]). Shape xs -> Exactly xs EraParams
History.getShape Shape xs
hardForkLedgerConfigShape)))
    -- In order to make this an automorphism, as required by 'Telescope.extend',
    -- we have to promote the input to @DiffMK@ albeit it being empty.
    (Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
 -> HardForkState (Flip LedgerState DiffMK) xs)
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
-> HardForkState (Flip LedgerState DiffMK) xs
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Current (Flip LedgerState EmptyMK) a
    -> Current (Flip LedgerState DiffMK) a)
-> Telescope (K Past) (Current (Flip LedgerState EmptyMK)) xs
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap
        Proxy SingleEraBlock
proxySingle
        (\Current (Flip LedgerState EmptyMK) a
c -> Current (Flip LedgerState EmptyMK) a
c { currentState = Flip
                                . flip withLedgerTables emptyLedgerTables
                                . unFlip
                                . currentState
                                $ c }
        )
    (Telescope (K Past) (Current (Flip LedgerState EmptyMK)) xs
 -> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs)
-> Telescope (K Past) (Current (Flip LedgerState EmptyMK)) xs
-> Telescope (K Past) (Current (Flip LedgerState DiffMK)) xs
forall a b. (a -> b) -> a -> b
$ Telescope (K Past) (Current (Flip LedgerState EmptyMK)) xs
st
  where
    pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
    cfgs :: NP WrapLedgerConfig xs
cfgs  = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialLedgerConfig xs
pcfgs
    ei :: EpochInfo (Except PastHorizonException)
ei    = HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState EmptyMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (mk :: MapKind).
All SingleEraBlock xs =>
HardForkLedgerConfig xs
-> HardForkState (Flip LedgerState mk) xs
-> EpochInfo (Except PastHorizonException)
epochInfoLedger HardForkLedgerConfig xs
ledgerCfg HardForkState (Flip LedgerState EmptyMK) xs
ledgerSt

    -- Return the end of this era if we should transition to the next
    whenExtend :: SingleEraBlock                    blk
               => WrapPartialLedgerConfig           blk
               -> K History.EraParams               blk
               -> Current (Flip LedgerState DiffMK) blk
               -> (Maybe :.: K History.Bound)       blk
    whenExtend :: forall blk.
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> K EraParams blk
-> Current (Flip LedgerState DiffMK) blk
-> (:.:) Maybe (K Bound) blk
whenExtend WrapPartialLedgerConfig blk
pcfg (K EraParams
eraParams) Current (Flip LedgerState DiffMK) blk
cur = Maybe (K Bound blk) -> (:.:) Maybe (K Bound) blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Maybe (K Bound blk) -> (:.:) Maybe (K Bound) blk)
-> Maybe (K Bound blk) -> (:.:) Maybe (K Bound) blk
forall a b. (a -> b) -> a -> b
$ Bound -> K Bound blk
forall k a (b :: k). a -> K a b
K (Bound -> K Bound blk) -> Maybe Bound -> Maybe (K Bound blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
        transition <- WrapPartialLedgerConfig blk
-> EraParams -> Bound -> LedgerState blk DiffMK -> Maybe EpochNo
forall blk (mk :: MapKind).
SingleEraBlock blk =>
WrapPartialLedgerConfig blk
-> EraParams -> Bound -> LedgerState blk mk -> Maybe EpochNo
singleEraTransition'
                        WrapPartialLedgerConfig blk
pcfg
                        EraParams
eraParams
                        (Current (Flip LedgerState DiffMK) blk -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState DiffMK) blk
cur)
                        (Flip LedgerState DiffMK blk -> LedgerState blk DiffMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState DiffMK blk -> LedgerState blk DiffMK)
-> Flip LedgerState DiffMK blk -> LedgerState blk DiffMK
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState DiffMK) blk
-> Flip LedgerState DiffMK blk
forall (f :: * -> *) blk. Current f blk -> f blk
currentState Current (Flip LedgerState DiffMK) blk
cur)
        let endBound = HasCallStack => EraParams -> Bound -> EpochNo -> Bound
EraParams -> Bound -> EpochNo -> Bound
History.mkUpperBound
                         EraParams
eraParams
                         (Current (Flip LedgerState DiffMK) blk -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState DiffMK) blk
cur)
                         EpochNo
transition
        guard (slot >= History.boundSlot endBound)
        return endBound

    howExtend :: (HasLedgerTables (LedgerState blk), HasLedgerTables (LedgerState blk'))
              => TranslateLedgerState  blk blk'
              -> TranslateLedgerTables blk blk'
              -> History.Bound
              -> Current (Flip LedgerState DiffMK) blk
              -> (K Past blk, Current (Flip LedgerState DiffMK) blk')
    howExtend :: forall blk blk'.
(HasLedgerTables (LedgerState blk),
 HasLedgerTables (LedgerState blk')) =>
TranslateLedgerState blk blk'
-> TranslateLedgerTables blk blk'
-> Bound
-> Current (Flip LedgerState DiffMK) blk
-> (K Past blk, Current (Flip LedgerState DiffMK) blk')
howExtend TranslateLedgerState blk blk'
f TranslateLedgerTables blk blk'
f' Bound
currentEnd Current (Flip LedgerState DiffMK) blk
cur = (
          Past -> K Past blk
forall k a (b :: k). a -> K a b
K Past {
              pastStart :: Bound
pastStart    = Current (Flip LedgerState DiffMK) blk -> Bound
forall (f :: * -> *) blk. Current f blk -> Bound
currentStart Current (Flip LedgerState DiffMK) blk
cur
            , pastEnd :: Bound
pastEnd      = Bound
currentEnd
            }
        , Current {
              currentStart :: Bound
currentStart = Bound
currentEnd
            , currentState :: Flip LedgerState DiffMK blk'
currentState =
                  LedgerState blk' DiffMK -> Flip LedgerState DiffMK blk'
forall x y (f :: x -> y -> *) (x1 :: y) (y1 :: x).
f y1 x1 -> Flip f x1 y1
Flip
                  -- We need to bring back the diffs provided by previous
                  -- translations. Note that if there is only one translation or
                  -- if the previous translations don't add any new tables this
                  -- will just be a no-op. See the haddock for
                  -- 'translateLedgerTablesWith' and 'extendToSlot' for more
                  -- information.
                (LedgerState blk' DiffMK -> Flip LedgerState DiffMK blk')
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerState blk' DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> Flip LedgerState DiffMK blk'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerTables (LedgerState blk') DiffMK
-> LedgerState blk' DiffMK -> LedgerState blk' DiffMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l DiffMK -> l' DiffMK -> l' DiffMK
prependDiffs ( TranslateLedgerTables blk blk'
-> LedgerTables (LedgerState blk) DiffMK
-> LedgerTables (LedgerState blk') DiffMK
forall y x.
Ord (TxIn (LedgerState y)) =>
TranslateLedgerTables x y
-> LedgerTables (LedgerState x) DiffMK
-> LedgerTables (LedgerState y) DiffMK
translateLedgerTablesWith TranslateLedgerTables blk blk'
f'
                               (LedgerTables (LedgerState blk) DiffMK
 -> LedgerTables (LedgerState blk') DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerTables (LedgerState blk) DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerTables (LedgerState blk') DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk DiffMK -> LedgerTables (LedgerState blk) DiffMK
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 DiffMK -> LedgerTables (LedgerState blk) DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerState blk DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerTables (LedgerState blk) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState DiffMK blk -> LedgerState blk DiffMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip
                               (Flip LedgerState DiffMK blk -> LedgerState blk DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> Flip LedgerState DiffMK blk)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerState blk DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Flip LedgerState DiffMK) blk
-> Flip LedgerState DiffMK blk
forall (f :: * -> *) blk. Current f blk -> f blk
currentState
                               (Current (Flip LedgerState DiffMK) blk
 -> LedgerTables (LedgerState blk') DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerTables (LedgerState blk') DiffMK
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState DiffMK) blk
cur
                               )
                (LedgerState blk' DiffMK -> LedgerState blk' DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerState blk' DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerState blk' DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TranslateLedgerState blk blk'
-> EpochNo -> LedgerState blk EmptyMK -> LedgerState blk' DiffMK
forall x y.
TranslateLedgerState x y
-> EpochNo -> LedgerState x EmptyMK -> LedgerState y DiffMK
translateLedgerStateWith TranslateLedgerState blk blk'
f (Bound -> EpochNo
History.boundEpoch Bound
currentEnd)
                (LedgerState blk EmptyMK -> LedgerState blk' DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerState blk EmptyMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerState blk' DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState blk DiffMK -> LedgerState blk EmptyMK
forall (l :: LedgerStateKind) (mk :: MapKind).
HasLedgerTables l =>
l mk -> l EmptyMK
forgetLedgerTables
                (LedgerState blk DiffMK -> LedgerState blk EmptyMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> LedgerState blk DiffMK)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerState blk EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState DiffMK blk -> LedgerState blk DiffMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip
                (Flip LedgerState DiffMK blk -> LedgerState blk DiffMK)
-> (Current (Flip LedgerState DiffMK) blk
    -> Flip LedgerState DiffMK blk)
-> Current (Flip LedgerState DiffMK) blk
-> LedgerState blk DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current (Flip LedgerState DiffMK) blk
-> Flip LedgerState DiffMK blk
forall (f :: * -> *) blk. Current f blk -> f blk
currentState
                (Current (Flip LedgerState DiffMK) blk
 -> Flip LedgerState DiffMK blk')
-> Current (Flip LedgerState DiffMK) blk
-> Flip LedgerState DiffMK blk'
forall a b. (a -> b) -> a -> b
$ Current (Flip LedgerState DiffMK) blk
cur
            }
        )

    translateLS :: InPairs TranslateLedgerState xs
    translateLS :: InPairs TranslateLedgerState xs
translateLS = NP WrapLedgerConfig xs
-> InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
-> InPairs TranslateLedgerState xs
forall {k} (h :: k -> *) (xs :: [k]) (f :: k -> k -> *).
NP h xs -> InPairs (RequiringBoth h f) xs -> InPairs f xs
InPairs.requiringBoth NP WrapLedgerConfig xs
cfgs (InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
 -> InPairs TranslateLedgerState xs)
-> InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
-> InPairs TranslateLedgerState xs
forall a b. (a -> b) -> a -> b
$
                  EraTranslation xs
-> InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
forall (xs :: [*]).
EraTranslation xs
-> InPairs (RequiringBoth WrapLedgerConfig TranslateLedgerState) xs
translateLedgerState EraTranslation xs
forall (xs :: [*]). CanHardFork xs => EraTranslation xs
hardForkEraTranslation

    translateLT :: InPairs TranslateLedgerTables xs
    translateLT :: InPairs TranslateLedgerTables xs
translateLT = EraTranslation xs -> InPairs TranslateLedgerTables xs
forall (xs :: [*]).
EraTranslation xs -> InPairs TranslateLedgerTables xs
translateLedgerTables EraTranslation xs
forall (xs :: [*]). CanHardFork xs => EraTranslation xs
hardForkEraTranslation