{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- TODO: can we un-orphan this module?
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Cardano.Ledger
  ( CardanoTxOut (..)
  , eliminateCardanoTxOut
  ) where

import Cardano.Ledger.Binary.Decoding hiding (Decoder)
import Cardano.Ledger.Binary.Encoding hiding (Encoding)
import Cardano.Ledger.Core (Era, eraDecoder, eraProtVerLow)
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.Shelley.LedgerState as SL
  ( dsUnifiedL
  , esLStateL
  , lsCertStateL
  , nesEsL
  )
import qualified Cardano.Ledger.UMap as SL
import Codec.CBOR.Decoding
import Codec.CBOR.Encoding
import qualified Data.Map as Map
import Data.MemPack
import Data.Proxy
import Data.SOP.BasicFunctors
import Data.SOP.Functors
import Data.SOP.Index
import Data.SOP.Strict
import qualified Data.SOP.Tails as Tails
import qualified Data.SOP.Telescope as Telescope
import Data.Void
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.CanHardFork
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.State.Types
import Ouroboros.Consensus.Ledger.Tables
import Ouroboros.Consensus.Protocol.Praos (Praos)
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Ledger
  ( IsShelleyBlock
  , ShelleyBlock
  , ShelleyCompatible
  , shelleyLedgerState
  )
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util.IndexedMemPack

instance
  CardanoHardForkConstraints c =>
  HasCanonicalTxIn (CardanoEras c)
  where
  newtype CanonicalTxIn (CardanoEras c) = CardanoTxIn
    { forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn :: SL.TxIn
    }
    deriving stock (Int -> CanonicalTxIn (CardanoEras c) -> ShowS
[CanonicalTxIn (CardanoEras c)] -> ShowS
CanonicalTxIn (CardanoEras c) -> String
(Int -> CanonicalTxIn (CardanoEras c) -> ShowS)
-> (CanonicalTxIn (CardanoEras c) -> String)
-> ([CanonicalTxIn (CardanoEras c)] -> ShowS)
-> Show (CanonicalTxIn (CardanoEras c))
forall c. Int -> CanonicalTxIn (CardanoEras c) -> ShowS
forall c. [CanonicalTxIn (CardanoEras c)] -> ShowS
forall c. CanonicalTxIn (CardanoEras c) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Int -> CanonicalTxIn (CardanoEras c) -> ShowS
showsPrec :: Int -> CanonicalTxIn (CardanoEras c) -> ShowS
$cshow :: forall c. CanonicalTxIn (CardanoEras c) -> String
show :: CanonicalTxIn (CardanoEras c) -> String
$cshowList :: forall c. [CanonicalTxIn (CardanoEras c)] -> ShowS
showList :: [CanonicalTxIn (CardanoEras c)] -> ShowS
Show, CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
(CanonicalTxIn (CardanoEras c)
 -> CanonicalTxIn (CardanoEras c) -> Bool)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> Bool)
-> Eq (CanonicalTxIn (CardanoEras c))
forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
== :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
$c/= :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
/= :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
Eq, Eq (CanonicalTxIn (CardanoEras c))
Eq (CanonicalTxIn (CardanoEras c)) =>
(CanonicalTxIn (CardanoEras c)
 -> CanonicalTxIn (CardanoEras c) -> Ordering)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> Bool)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> Bool)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> Bool)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> Bool)
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c))
-> (CanonicalTxIn (CardanoEras c)
    -> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c))
-> Ord (CanonicalTxIn (CardanoEras c))
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Ordering
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
forall c. Eq (CanonicalTxIn (CardanoEras c))
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Ordering
forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
$ccompare :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Ordering
compare :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Ordering
$c< :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
< :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
$c<= :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
<= :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
$c> :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
> :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
$c>= :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
>= :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> Bool
$cmax :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
max :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
$cmin :: forall c.
CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
min :: CanonicalTxIn (CardanoEras c)
-> CanonicalTxIn (CardanoEras c) -> CanonicalTxIn (CardanoEras c)
Ord)
    deriving newtype Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
Proxy (CanonicalTxIn (CardanoEras c)) -> String
(Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo))
-> (Context
    -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo))
-> (Proxy (CanonicalTxIn (CardanoEras c)) -> String)
-> NoThunks (CanonicalTxIn (CardanoEras c))
forall c.
Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
forall c. Proxy (CanonicalTxIn (CardanoEras c)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall c.
Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c.
Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CanonicalTxIn (CardanoEras c) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c. Proxy (CanonicalTxIn (CardanoEras c)) -> String
showTypeOf :: Proxy (CanonicalTxIn (CardanoEras c)) -> String
NoThunks

  injectCanonicalTxIn :: forall x.
Index (CardanoEras c) x
-> TxIn (LedgerState x) -> CanonicalTxIn (CardanoEras c)
injectCanonicalTxIn Index (CardanoEras c) x
IZ TxIn (LedgerState x)
byronTxIn = Void -> CanonicalTxIn (CardanoEras c)
forall a. Void -> a
absurd Void
TxIn (LedgerState x)
byronTxIn
  injectCanonicalTxIn (IS Index xs' x
idx) TxIn (LedgerState x)
shelleyTxIn = case Index xs' x
idx of
    Index xs' x
IZ -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS Index xs' x
IZ -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS Index xs' x
IZ) -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS (IS Index xs' x
IZ)) -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS (IS (IS Index xs' x
IZ))) -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS (IS (IS (IS Index xs' x
IZ)))) -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS (IS (IS (IS (IS Index xs' x
IZ))))) -> TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn TxIn
TxIn (LedgerState x)
shelleyTxIn
    IS (IS (IS (IS (IS (IS (IS Index xs' x
idx')))))) -> case Index xs' x
idx' of {}

  ejectCanonicalTxIn :: forall x.
Index (CardanoEras c) x
-> CanonicalTxIn (CardanoEras c) -> TxIn (LedgerState x)
ejectCanonicalTxIn Index (CardanoEras c) x
IZ CanonicalTxIn (CardanoEras c)
_ =
    String -> Void
forall a. HasCallStack => String -> a
error String
"ejectCanonicalTxIn: Byron has no TxIns"
  ejectCanonicalTxIn (IS Index xs' x
idx) CanonicalTxIn (CardanoEras c)
cardanoTxIn = case Index xs' x
idx of
    Index xs' x
IZ -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS Index xs' x
IZ -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS Index xs' x
IZ) -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS (IS Index xs' x
IZ)) -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS (IS (IS Index xs' x
IZ))) -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS (IS (IS (IS Index xs' x
IZ)))) -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS (IS (IS (IS (IS Index xs' x
IZ))))) -> CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn CanonicalTxIn (CardanoEras c)
cardanoTxIn
    IS (IS (IS (IS (IS (IS (IS Index xs' x
idx')))))) -> case Index xs' x
idx' of {}

instance CardanoHardForkConstraints c => MemPack (CanonicalTxIn (CardanoEras c)) where
  packM :: forall s. CanonicalTxIn (CardanoEras c) -> Pack s ()
packM = TxIn -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. TxIn -> Pack s ()
packM (TxIn -> Pack s ())
-> (CanonicalTxIn (CardanoEras c) -> TxIn)
-> CanonicalTxIn (CardanoEras c)
-> Pack s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn
  packedByteCount :: CanonicalTxIn (CardanoEras c) -> Int
packedByteCount = TxIn -> Int
forall a. MemPack a => a -> Int
packedByteCount (TxIn -> Int)
-> (CanonicalTxIn (CardanoEras c) -> TxIn)
-> CanonicalTxIn (CardanoEras c)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalTxIn (CardanoEras c) -> TxIn
forall c. CanonicalTxIn (CardanoEras c) -> TxIn
getCardanoTxIn
  unpackM :: forall b. Buffer b => Unpack b (CanonicalTxIn (CardanoEras c))
unpackM = TxIn -> CanonicalTxIn (CardanoEras c)
forall c. TxIn -> CanonicalTxIn (CardanoEras c)
CardanoTxIn (TxIn -> CanonicalTxIn (CardanoEras c))
-> Unpack b TxIn -> Unpack b (CanonicalTxIn (CardanoEras c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b TxIn
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b TxIn
unpackM

data CardanoTxOut c
  = ShelleyTxOut {-# UNPACK #-} !(TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra)))
  | AllegraTxOut {-# UNPACK #-} !(TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra)))
  | MaryTxOut {-# UNPACK #-} !(TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra)))
  | AlonzoTxOut !(TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra)))
  | BabbageTxOut !(TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra)))
  | ConwayTxOut !(TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra)))
  | DijkstraTxOut !(TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra)))
  deriving stock (Int -> CardanoTxOut c -> ShowS
[CardanoTxOut c] -> ShowS
CardanoTxOut c -> String
(Int -> CardanoTxOut c -> ShowS)
-> (CardanoTxOut c -> String)
-> ([CardanoTxOut c] -> ShowS)
-> Show (CardanoTxOut c)
forall c. Int -> CardanoTxOut c -> ShowS
forall c. [CardanoTxOut c] -> ShowS
forall c. CardanoTxOut c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Int -> CardanoTxOut c -> ShowS
showsPrec :: Int -> CardanoTxOut c -> ShowS
$cshow :: forall c. CardanoTxOut c -> String
show :: CardanoTxOut c -> String
$cshowList :: forall c. [CardanoTxOut c] -> ShowS
showList :: [CardanoTxOut c] -> ShowS
Show, CardanoTxOut c -> CardanoTxOut c -> Bool
(CardanoTxOut c -> CardanoTxOut c -> Bool)
-> (CardanoTxOut c -> CardanoTxOut c -> Bool)
-> Eq (CardanoTxOut c)
forall c. CardanoTxOut c -> CardanoTxOut c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. CardanoTxOut c -> CardanoTxOut c -> Bool
== :: CardanoTxOut c -> CardanoTxOut c -> Bool
$c/= :: forall c. CardanoTxOut c -> CardanoTxOut c -> Bool
/= :: CardanoTxOut c -> CardanoTxOut c -> Bool
Eq, (forall x. CardanoTxOut c -> Rep (CardanoTxOut c) x)
-> (forall x. Rep (CardanoTxOut c) x -> CardanoTxOut c)
-> Generic (CardanoTxOut c)
forall x. Rep (CardanoTxOut c) x -> CardanoTxOut c
forall x. CardanoTxOut c -> Rep (CardanoTxOut c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (CardanoTxOut c) x -> CardanoTxOut c
forall c x. CardanoTxOut c -> Rep (CardanoTxOut c) x
$cfrom :: forall c x. CardanoTxOut c -> Rep (CardanoTxOut c) x
from :: forall x. CardanoTxOut c -> Rep (CardanoTxOut c) x
$cto :: forall c x. Rep (CardanoTxOut c) x -> CardanoTxOut c
to :: forall x. Rep (CardanoTxOut c) x -> CardanoTxOut c
Generic)
  deriving anyclass Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
Proxy (CardanoTxOut c) -> String
(Context -> CardanoTxOut c -> IO (Maybe ThunkInfo))
-> (Context -> CardanoTxOut c -> IO (Maybe ThunkInfo))
-> (Proxy (CardanoTxOut c) -> String)
-> NoThunks (CardanoTxOut c)
forall c. Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
forall c. Proxy (CardanoTxOut c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall c. Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
noThunks :: Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CardanoTxOut c -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c. Proxy (CardanoTxOut c) -> String
showTypeOf :: Proxy (CardanoTxOut c) -> String
NoThunks

-- | Eliminate the wrapping of CardanoTxOut with the provided function. Similar
-- to 'hcimap' on an 'NS'.
eliminateCardanoTxOut ::
  forall r c.
  CardanoHardForkConstraints c =>
  ( forall x.
    -- TODO ProtoCrypto constraint should be in IsShelleyBlock
    IsShelleyBlock x =>
    Index (CardanoEras c) x ->
    TxOut (LedgerState x) ->
    r
  ) ->
  CardanoTxOut c ->
  r
eliminateCardanoTxOut :: forall r c.
CardanoHardForkConstraints c =>
(forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> r)
-> CardanoTxOut c -> r
eliminateCardanoTxOut forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f = \case
  ShelleyTxOut TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
txout -> Index (CardanoEras c) (ShelleyBlock (TPraos c) ShelleyEra)
-> TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) ShelleyEra)
-> Index (CardanoEras c) (ShelleyBlock (TPraos c) ShelleyEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) ShelleyEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ) TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
txout
  AllegraTxOut TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
txout -> Index (CardanoEras c) (ShelleyBlock (TPraos c) AllegraEra)
-> TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) AllegraEra)
-> Index (CardanoEras c) (ShelleyBlock (TPraos c) AllegraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AllegraEra)
-> Index
     (CardanoShelleyEras c) (ShelleyBlock (TPraos c) AllegraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AllegraEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)) TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
txout
  MaryTxOut TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
txout -> Index (CardanoEras c) (ShelleyBlock (TPraos c) MaryEra)
-> TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) MaryEra)
-> Index (CardanoEras c) (ShelleyBlock (TPraos c) MaryEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) MaryEra)
-> Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) MaryEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) MaryEra)
-> Index
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (TPraos c) MaryEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) MaryEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ))) TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
txout
  AlonzoTxOut TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
txout -> Index (CardanoEras c) (ShelleyBlock (TPraos c) AlonzoEra)
-> TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) AlonzoEra)
-> Index (CardanoEras c) (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AlonzoEra)
-> Index (CardanoShelleyEras c) (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AlonzoEra)
-> Index
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AlonzoEra)
-> Index
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)))) TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
txout
  BabbageTxOut TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
txout -> Index (CardanoEras c) (ShelleyBlock (Praos c) BabbageEra)
-> TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (Praos c) BabbageEra)
-> Index (CardanoEras c) (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) BabbageEra)
-> Index (CardanoShelleyEras c) (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) BabbageEra)
-> Index
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) BabbageEra)
-> Index
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) BabbageEra)
-> Index
     '[ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) BabbageEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ))))) TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
txout
  ConwayTxOut TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
txout -> Index (CardanoEras c) (ShelleyBlock (Praos c) ConwayEra)
-> TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (Praos c) ConwayEra)
-> Index (CardanoEras c) (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
-> Index (CardanoShelleyEras c) (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
-> Index
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
-> Index
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
-> Index
     '[ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
-> Index
     '[ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) ConwayEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ)))))) TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
txout
  DijkstraTxOut TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
txout -> Index (CardanoEras c) (ShelleyBlock (Praos c) DijkstraEra)
-> TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra)) -> r
forall x.
IsShelleyBlock x =>
Index (CardanoEras c) x -> TxOut (LedgerState x) -> r
f (Index (CardanoShelleyEras c) (ShelleyBlock (Praos c) DijkstraEra)
-> Index (CardanoEras c) (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AllegraEra,
    ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     (CardanoShelleyEras c) (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) MaryEra,
    ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (TPraos c) AlonzoEra,
    ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) BabbageEra,
    ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     '[ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) ConwayEra,
    ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     '[ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS (Index
  '[ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
-> Index
     '[ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (x' :: k) (xs' :: [k]).
(xs ~ (x' : xs')) =>
Index xs' x -> Index xs x
IS Index
  '[ShelleyBlock (Praos c) DijkstraEra]
  (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (xs :: [k]) (x :: k) (xs1 :: [k]).
(xs ~ (x : xs1)) =>
Index xs x
IZ))))))) TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
txout

instance CardanoHardForkConstraints c => HasHardForkTxOut (CardanoEras c) where
  type HardForkTxOut (CardanoEras c) = CardanoTxOut c

  injectHardForkTxOut :: forall x.
Index (CardanoEras c) x
-> TxOut (LedgerState x) -> HardForkTxOut (CardanoEras c)
injectHardForkTxOut Index (CardanoEras c) x
idx !TxOut (LedgerState x)
txOut = case Index (CardanoEras c) x
idx of
    IS Index xs' x
IZ -> TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
ShelleyTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
txOut
    IS (IS Index xs' x
IZ) -> TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
AllegraTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
txOut
    IS (IS (IS Index xs' x
IZ)) -> TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
MaryTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
txOut
    IS (IS (IS (IS Index xs' x
IZ))) -> TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
AlonzoTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
txOut
    IS (IS (IS (IS (IS Index xs' x
IZ)))) -> TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
BabbageTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
txOut
    IS (IS (IS (IS (IS (IS Index xs' x
IZ))))) -> TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
ConwayTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
txOut
    IS (IS (IS (IS (IS (IS (IS Index xs' x
IZ)))))) -> TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
DijkstraTxOut TxOut (LedgerState x)
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
txOut
    IS (IS (IS (IS (IS (IS (IS (IS Index xs' x
idx'))))))) -> case Index xs' x
idx' of {}

  ejectHardForkTxOut ::
    forall y.
    Index (CardanoEras c) y ->
    HardForkTxOut (CardanoEras c) ->
    TxOut (LedgerState y)
  ejectHardForkTxOut :: forall x.
Index (CardanoEras c) x
-> HardForkTxOut (CardanoEras c) -> TxOut (LedgerState x)
ejectHardForkTxOut Index (CardanoEras c) y
targetIdx =
    (forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x
 -> TxOut (LedgerState x) -> TxOut (LedgerState y))
-> CardanoTxOut c -> TxOut (LedgerState y)
forall r c.
CardanoHardForkConstraints c =>
(forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> r)
-> CardanoTxOut c -> r
eliminateCardanoTxOut
      ( \Index (CardanoEras c) x
origIdx ->
          WrapTxOut y -> TxOut (LedgerState y)
forall blk. WrapTxOut blk -> TxOut (LedgerState blk)
unwrapTxOut
            (WrapTxOut y -> TxOut (LedgerState y))
-> (TxOut (ShelleyBlockLedgerEra x) -> WrapTxOut y)
-> TxOut (ShelleyBlockLedgerEra x)
-> TxOut (LedgerState y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapTxOut y
-> (WrapTxOut y -> WrapTxOut y)
-> Maybe (WrapTxOut y)
-> WrapTxOut y
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> WrapTxOut y
forall a. HasCallStack => String -> a
error String
"anachrony") WrapTxOut y -> WrapTxOut y
forall a. a -> a
id
            (Maybe (WrapTxOut y) -> WrapTxOut y)
-> (TxOut (ShelleyBlockLedgerEra x) -> Maybe (WrapTxOut y))
-> TxOut (ShelleyBlockLedgerEra x)
-> WrapTxOut y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (CardanoEras c) x
-> Index (CardanoEras c) y
-> Tails (Fn2 WrapTxOut) (CardanoEras c)
-> WrapTxOut x
-> Maybe (WrapTxOut y)
forall {k} (xs :: [k]) (x :: k) (y :: k) (f :: k -> *).
SListI xs =>
Index xs x -> Index xs y -> Tails (Fn2 f) xs -> f x -> Maybe (f y)
Tails.extendWithTails Index (CardanoEras c) x
origIdx Index (CardanoEras c) y
targetIdx Tails (Fn2 WrapTxOut) (CardanoEras c)
forall (xs :: [*]). HasHardForkTxOut xs => Tails (Fn2 WrapTxOut) xs
txOutTranslations
            (WrapTxOut x -> Maybe (WrapTxOut y))
-> (TxOut (ShelleyBlockLedgerEra x) -> WrapTxOut x)
-> TxOut (ShelleyBlockLedgerEra x)
-> Maybe (WrapTxOut y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut (ShelleyBlockLedgerEra x) -> WrapTxOut x
TxOut (LedgerState x) -> WrapTxOut x
forall blk. TxOut (LedgerState blk) -> WrapTxOut blk
WrapTxOut
      )

instance
  CardanoHardForkConstraints c =>
  IndexedMemPack (LedgerState (HardForkBlock (CardanoEras c)) EmptyMK) (CardanoTxOut c)
  where
  indexedTypeName :: LedgerState (HardForkBlock (CardanoEras c)) EmptyMK -> String
indexedTypeName LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
_ = String
"CardanoTxOut"
  indexedPackM :: forall s.
LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
-> CardanoTxOut c -> Pack s ()
indexedPackM LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
_ = (forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> Pack s ())
-> CardanoTxOut c -> Pack s ()
forall r c.
CardanoHardForkConstraints c =>
(forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> r)
-> CardanoTxOut c -> r
eliminateCardanoTxOut ((TxOut (ShelleyBlockLedgerEra x) -> Pack s ())
-> Index (CardanoEras c) x
-> TxOut (ShelleyBlockLedgerEra x)
-> Pack s ()
forall a b. a -> b -> a
const TxOut (ShelleyBlockLedgerEra x) -> Pack s ()
forall s. TxOut (ShelleyBlockLedgerEra x) -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
packM)
  indexedPackedByteCount :: LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
-> CardanoTxOut c -> Int
indexedPackedByteCount LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
_ = (forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> Int)
-> CardanoTxOut c -> Int
forall r c.
CardanoHardForkConstraints c =>
(forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> r)
-> CardanoTxOut c -> r
eliminateCardanoTxOut ((TxOut (ShelleyBlockLedgerEra x) -> Int)
-> Index (CardanoEras c) x
-> TxOut (ShelleyBlockLedgerEra x)
-> Int
forall a b. a -> b -> a
const TxOut (ShelleyBlockLedgerEra x) -> Int
forall a. MemPack a => a -> Int
packedByteCount)
  indexedUnpackM :: forall b.
Buffer b =>
LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
-> Unpack b (CardanoTxOut c)
indexedUnpackM (HardForkLedgerState (HardForkState Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx)) = do
    let
      -- These could be made into a CAF to avoid recomputing it, but
      -- it is only used in serialization so it is not critical.
      np :: NP
  (f -.-> (Unpack b :.: K (CardanoTxOut c)))
  '[x, x, x, x, x, x, x, x]
np =
        ( ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ String -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a. HasCallStack => String -> a
error String
"unpacking a byron txout")
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP
     (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x, x, x]
-> NP
     (f -.-> (Unpack b :.: K (CardanoTxOut c)))
     '[x, x, x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (ShelleyTxOut ShelleyEra -> CardanoTxOut c)
-> ShelleyTxOut ShelleyEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyTxOut ShelleyEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
ShelleyTxOut (ShelleyTxOut ShelleyEra -> K (CardanoTxOut c) x)
-> Unpack b (ShelleyTxOut ShelleyEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (ShelleyTxOut ShelleyEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (ShelleyTxOut ShelleyEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP
     (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x, x]
-> NP
     (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (ShelleyTxOut AllegraEra -> CardanoTxOut c)
-> ShelleyTxOut AllegraEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyTxOut AllegraEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
AllegraTxOut (ShelleyTxOut AllegraEra -> K (CardanoTxOut c) x)
-> Unpack b (ShelleyTxOut AllegraEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (ShelleyTxOut AllegraEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (ShelleyTxOut AllegraEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x]
-> NP
     (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (ShelleyTxOut MaryEra -> CardanoTxOut c)
-> ShelleyTxOut MaryEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyTxOut MaryEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
MaryTxOut (ShelleyTxOut MaryEra -> K (CardanoTxOut c) x)
-> Unpack b (ShelleyTxOut MaryEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (ShelleyTxOut MaryEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (ShelleyTxOut MaryEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x]
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (AlonzoTxOut AlonzoEra -> CardanoTxOut c)
-> AlonzoTxOut AlonzoEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoTxOut AlonzoEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
AlonzoTxOut (AlonzoTxOut AlonzoEra -> K (CardanoTxOut c) x)
-> Unpack b (AlonzoTxOut AlonzoEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (AlonzoTxOut AlonzoEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (AlonzoTxOut AlonzoEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x]
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (BabbageTxOut BabbageEra -> CardanoTxOut c)
-> BabbageTxOut BabbageEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BabbageTxOut BabbageEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
BabbageTxOut (BabbageTxOut BabbageEra -> K (CardanoTxOut c) x)
-> Unpack b (BabbageTxOut BabbageEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (BabbageTxOut BabbageEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (BabbageTxOut BabbageEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x]
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (BabbageTxOut ConwayEra -> CardanoTxOut c)
-> BabbageTxOut ConwayEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BabbageTxOut ConwayEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
ConwayTxOut (BabbageTxOut ConwayEra -> K (CardanoTxOut c) x)
-> Unpack b (BabbageTxOut ConwayEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (BabbageTxOut ConwayEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (BabbageTxOut ConwayEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x]
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
 -> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x)
-> (f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. a -> b -> a
const ((:.:) (Unpack b) (K (CardanoTxOut c)) x
 -> f x -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
-> f x
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Unpack b (K (CardanoTxOut c) x)
 -> (:.:) (Unpack b) (K (CardanoTxOut c)) x)
-> Unpack b (K (CardanoTxOut c) x)
-> (:.:) (Unpack b) (K (CardanoTxOut c)) x
forall a b. (a -> b) -> a -> b
$ CardanoTxOut c -> K (CardanoTxOut c) x
forall k a (b :: k). a -> K a b
K (CardanoTxOut c -> K (CardanoTxOut c) x)
-> (BabbageTxOut DijkstraEra -> CardanoTxOut c)
-> BabbageTxOut DijkstraEra
-> K (CardanoTxOut c) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BabbageTxOut DijkstraEra -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
DijkstraTxOut (BabbageTxOut DijkstraEra -> K (CardanoTxOut c) x)
-> Unpack b (BabbageTxOut DijkstraEra)
-> Unpack b (K (CardanoTxOut c) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (BabbageTxOut DijkstraEra)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (BabbageTxOut DijkstraEra)
unpackM)
            (-.->) f (Unpack b :.: K (CardanoTxOut c)) x
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[]
-> NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (f -.-> (Unpack b :.: K (CardanoTxOut c))) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
        )
    NS (K (CardanoTxOut c)) (CardanoEras c)
-> CollapseTo NS (CardanoTxOut c)
NS (K (CardanoTxOut c)) (CardanoEras c) -> CardanoTxOut c
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 (CardanoTxOut c)) (CardanoEras c) -> CardanoTxOut c)
-> Unpack b (NS (K (CardanoTxOut c)) (CardanoEras c))
-> Unpack b (CardanoTxOut c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c)
-> Unpack b (NS (K (CardanoTxOut c)) (CardanoEras c))
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c)
 -> Unpack b (NS (K (CardanoTxOut c)) (CardanoEras c)))
-> NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c)
-> Unpack b (NS (K (CardanoTxOut c)) (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Unpack b :.: K (CardanoTxOut c)))
  (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NS (f -.-> g) xs -> NS f xs -> NS g xs
hap Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Unpack b :.: K (CardanoTxOut c)))
  (CardanoEras c)
NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Unpack b :.: K (CardanoTxOut c)))
  (CardanoEras c)
forall {f :: * -> *} {c} {x} {x} {x} {x} {x} {x} {x} {x}.
NP
  (f -.-> (Unpack b :.: K (CardanoTxOut c)))
  '[x, x, x, x, x, x, x, x]
np (NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
 -> NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c))
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (Unpack b :.: K (CardanoTxOut c)) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx)

instance
  CardanoHardForkConstraints c =>
  SerializeTablesWithHint (LedgerState (HardForkBlock (CardanoEras c)))
  where
  encodeTablesWithHint :: SerializeTablesHint
  (LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> Encoding
encodeTablesWithHint (HardForkLedgerState (HardForkState Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx)) (LedgerTables (ValuesMK Map
  (TxIn (LedgerState (HardForkBlock (CardanoEras c))))
  (TxOut (LedgerState (HardForkBlock (CardanoEras c))))
tbs)) =
    let
      -- These could be made into a CAF to avoid recomputing it, but
      -- it is only used in serialization so it is not critical.
      np :: NP (f -.-> K Encoding) '[x, x, x, x, x, x, x, x]
np =
        ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Word -> Encoding
Codec.CBOR.Encoding.encodeMapLen Word
0)
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x, x, x, x, x, x]
-> NP (f -.-> K Encoding) '[x, x, x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy ShelleyEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ShelleyEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x, x, x, x, x]
-> NP (f -.-> K Encoding) '[x, x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy AllegraEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AllegraEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x, x, x, x]
-> NP (f -.-> K Encoding) '[x, x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy MaryEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x, x, x]
-> NP (f -.-> K Encoding) '[x, x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy AlonzoEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AlonzoEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x, x]
-> NP (f -.-> K Encoding) '[x, x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy BabbageEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BabbageEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x, x]
-> NP (f -.-> K Encoding) '[x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy ConwayEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ConwayEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[x] -> NP (f -.-> K Encoding) '[x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x -> K Encoding x) -> (-.->) f (K Encoding) x)
-> (f x -> K Encoding x) -> (-.->) f (K Encoding) x
forall a b. (a -> b) -> a -> b
$ K Encoding x -> f x -> K Encoding x
forall a b. a -> b -> a
const (K Encoding x -> f x -> K Encoding x)
-> K Encoding x -> f x -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Encoding -> K Encoding x
forall k a (b :: k). a -> K a b
K (Encoding -> K Encoding x) -> Encoding -> K Encoding x
forall a b. (a -> b) -> a -> b
$ Proxy DijkstraEra -> Encoding
forall era. Era era => Proxy era -> Encoding
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DijkstraEra))
          (-.->) f (K Encoding) x
-> NP (f -.-> K Encoding) '[] -> NP (f -.-> K Encoding) '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (f -.-> K Encoding) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
     in
      NS (K Encoding) (CardanoEras c) -> CollapseTo NS Encoding
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 Encoding) (CardanoEras c) -> CollapseTo NS Encoding)
-> NS (K Encoding) (CardanoEras c) -> CollapseTo NS Encoding
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (K Encoding) (CardanoEras c)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NS (f -.-> g) xs -> NS f xs -> NS g xs
hap Prod
  NS
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  (CardanoEras c)
NP
  (Current (Flip LedgerState EmptyMK) -.-> K Encoding)
  (CardanoEras c)
forall {f :: * -> *} {x} {x} {x} {x} {x} {x} {x} {x}.
NP (f -.-> K Encoding) '[x, x, x, x, x, x, x, x]
np (NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
 -> NS (K Encoding) (CardanoEras c))
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (K Encoding) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx
   where
    encOne :: forall era. Era era => Proxy era -> Encoding
    encOne :: forall era. Era era => Proxy era -> Encoding
encOne Proxy era
_ =
      Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @era) (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
        (CanonicalTxIn (CardanoEras c) -> Encoding)
-> (CardanoTxOut c -> Encoding)
-> Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> Encoding
forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap CanonicalTxIn (CardanoEras c) -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack ((forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> Encoding)
-> CardanoTxOut c -> Encoding
forall r c.
CardanoHardForkConstraints c =>
(forall x.
 IsShelleyBlock x =>
 Index (CardanoEras c) x -> TxOut (LedgerState x) -> r)
-> CardanoTxOut c -> r
eliminateCardanoTxOut ((TxOut (ShelleyBlockLedgerEra x) -> Encoding)
-> Index (CardanoEras c) x
-> TxOut (ShelleyBlockLedgerEra x)
-> Encoding
forall a b. a -> b -> a
const TxOut (ShelleyBlockLedgerEra x) -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack)) Map
  (TxIn (LedgerState (HardForkBlock (CardanoEras c))))
  (TxOut (LedgerState (HardForkBlock (CardanoEras c))))
Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
tbs

  decodeTablesWithHint ::
    forall s.
    LedgerState (HardForkBlock (CardanoEras c)) EmptyMK ->
    Decoder s (LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
  decodeTablesWithHint :: forall s.
LedgerState (HardForkBlock (CardanoEras c)) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
decodeTablesWithHint (HardForkLedgerState (HardForkState Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx)) =
    let
      -- These could be made into a CAF to avoid recomputing it, but
      -- it is only used in serialization so it is not critical.
      np :: NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
  (CardanoEras c)
np =
        ( (Current (Flip LedgerState EmptyMK) ByronBlock
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      ByronBlock)
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current (Flip LedgerState EmptyMK) ByronBlock
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       ByronBlock)
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      ByronBlock)
-> (Current (Flip LedgerState EmptyMK) ByronBlock
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         ByronBlock)
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall a b. (a -> b) -> a -> b
$
            (:.:)
  (Decoder s)
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  ByronBlock
-> Current (Flip LedgerState EmptyMK) ByronBlock
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall a b. a -> b -> a
const ((:.:)
   (Decoder s)
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
   ByronBlock
 -> Current (Flip LedgerState EmptyMK) ByronBlock
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      ByronBlock)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
-> Current (Flip LedgerState EmptyMK) ByronBlock
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall a b. (a -> b) -> a -> b
$
              Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     ByronBlock)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      ByronBlock)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      ByronBlock)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        ByronBlock)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     ByronBlock
forall a b. (a -> b) -> a -> b
$
                LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     ByronBlock
forall k a (b :: k). a -> K a b
K (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      ByronBlock)
-> (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
    -> LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: LedgerStateKind) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables @(LedgerState (HardForkBlock (CardanoEras c))) (ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
 -> LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
    -> ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
-> Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
forall k v. Map k v -> ValuesMK k v
ValuesMK
                  (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      ByronBlock)
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Decoder s Int
forall s. Decoder s Int
Codec.CBOR.Decoding.decodeMapLen Decoder s Int
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
forall a b. Decoder s a -> Decoder s b -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
forall k a. Map k a
Map.empty)
        )
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  ByronBlock
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) ShelleyEra,
       ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     (CardanoEras c)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) ShelleyEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) ShelleyEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (TPraos c) ShelleyEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) ShelleyEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (TPraos c) ShelleyEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) ShelleyEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) ShelleyEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) ShelleyEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) ShelleyEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (TPraos c) ShelleyEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) ShelleyEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) ShelleyEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) ShelleyEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (TPraos c) ShelleyEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) ShelleyEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
ShelleyTxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
    -> LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) ShelleyEra)
-> LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) ShelleyEra)
 -> LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) ShelleyEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
-> LedgerState (ShelleyBlock (TPraos c) ShelleyEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) ShelleyEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) ShelleyEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (TPraos c) ShelleyEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) ShelleyEra,
       ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AllegraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AllegraEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (TPraos c) AllegraEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AllegraEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (TPraos c) AllegraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AllegraEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) AllegraEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AllegraEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) AllegraEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AllegraEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (TPraos c) AllegraEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AllegraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) AllegraEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) AllegraEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) AllegraEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (TPraos c) AllegraEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) AllegraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
AllegraTxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
    -> LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AllegraEra)
-> LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AllegraEra)
 -> LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AllegraEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
-> LedgerState (ShelleyBlock (TPraos c) AllegraEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AllegraEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AllegraEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (TPraos c) AllegraEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) AllegraEra,
       ShelleyBlock (TPraos c) MaryEra, ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) MaryEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) MaryEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (TPraos c) MaryEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) MaryEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (TPraos c) MaryEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) MaryEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) MaryEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) MaryEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) MaryEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) MaryEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (TPraos c) MaryEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) MaryEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) MaryEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) MaryEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (TPraos c) MaryEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) MaryEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
MaryTxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
    -> LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) MaryEra)
-> LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) MaryEra)
 -> LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) MaryEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
-> LedgerState (ShelleyBlock (TPraos c) MaryEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) MaryEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) MaryEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (TPraos c) MaryEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) MaryEra,
       ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AlonzoEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AlonzoEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (TPraos c) AlonzoEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AlonzoEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (TPraos c) AlonzoEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) AlonzoEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AlonzoEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) AlonzoEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (TPraos c) AlonzoEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (TPraos c) AlonzoEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (TPraos c) AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (TPraos c) AlonzoEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) AlonzoEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (TPraos c) AlonzoEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (TPraos c) AlonzoEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (TPraos c) AlonzoEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
AlonzoTxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
    -> LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AlonzoEra)
-> LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AlonzoEra)
 -> LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AlonzoEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
-> LedgerState (ShelleyBlock (TPraos c) AlonzoEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (TPraos c) AlonzoEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (TPraos c) AlonzoEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (TPraos c) AlonzoEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (TPraos c) AlonzoEra,
       ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) BabbageEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) BabbageEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (Praos c) BabbageEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) BabbageEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (Praos c) BabbageEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) BabbageEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) BabbageEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) BabbageEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) BabbageEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) BabbageEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (Praos c) BabbageEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) BabbageEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) BabbageEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) BabbageEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (Praos c) BabbageEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) BabbageEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
BabbageTxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
    -> LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (Praos c) BabbageEra)
-> LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (Praos c) BabbageEra)
 -> LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) BabbageEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
-> LedgerState (ShelleyBlock (Praos c) BabbageEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) BabbageEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) BabbageEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (Praos c) BabbageEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) BabbageEra,
       ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) ConwayEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) ConwayEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (Praos c) ConwayEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) ConwayEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (Praos c) ConwayEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) ConwayEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) ConwayEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) ConwayEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) ConwayEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) ConwayEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (Praos c) ConwayEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) ConwayEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) ConwayEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) ConwayEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (Praos c) ConwayEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
ConwayTxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
    -> LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (Praos c) ConwayEra)
-> LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (Praos c) ConwayEra)
 -> LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) ConwayEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
-> LedgerState (ShelleyBlock (Praos c) ConwayEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) ConwayEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) ConwayEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (Praos c) ConwayEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) ConwayEra,
       ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) DijkstraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) DijkstraEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
  -> (:.:)
       (Decoder s)
       (K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
       (ShelleyBlock (Praos c) DijkstraEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) DijkstraEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
    -> (:.:)
         (Decoder s)
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (ShelleyBlock (Praos c) DijkstraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) DijkstraEra)
forall a b. (a -> b) -> a -> b
$ Decoder
  s
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) DijkstraEra))
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) DijkstraEra)
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Decoder
   s
   (K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) DijkstraEra))
 -> (:.:)
      (Decoder s)
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (ShelleyBlock (Praos c) DijkstraEra))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
    -> Decoder
         s
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
            (ShelleyBlock (Praos c) DijkstraEra)))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
-> (:.:)
     (Decoder s)
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (ShelleyBlock (Praos c) DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerTables
   (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
 -> K (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
      (ShelleyBlock (Praos c) DijkstraEra))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) DijkstraEra))
forall a b. (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
-> K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
     (ShelleyBlock (Praos c) DijkstraEra)
forall k a (b :: k). a -> K a b
K (Decoder
   s
   (LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
 -> Decoder
      s
      (K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
         (ShelleyBlock (Praos c) DijkstraEra)))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
    -> Decoder
         s
         (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
-> Decoder
     s
     (K (LedgerTables
           (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
        (ShelleyBlock (Praos c) DijkstraEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
 -> CardanoTxOut c)
-> LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
DijkstraTxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK
 -> Decoder
      s
      (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
    -> LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip LedgerState EmptyMK (ShelleyBlock (Praos c) DijkstraEra)
-> LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK
forall x1 y1 (f :: x1 -> y1 -> *) (x2 :: y1) (y2 :: x1).
Flip f x2 y2 -> f y2 x2
unFlip (Flip LedgerState EmptyMK (ShelleyBlock (Praos c) DijkstraEra)
 -> LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
    -> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) DijkstraEra))
-> Current
     (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
-> LedgerState (ShelleyBlock (Praos c) DijkstraEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK) (ShelleyBlock (Praos c) DijkstraEra)
-> Flip LedgerState EmptyMK (ShelleyBlock (Praos c) DijkstraEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
          (-.->)
  (Current (Flip LedgerState EmptyMK))
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (ShelleyBlock (Praos c) DijkstraEra)
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[]
-> NP
     (Current (Flip LedgerState EmptyMK)
      -.-> (Decoder s
            :.: K (LedgerTables
                     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
     '[ShelleyBlock (Praos c) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
  '[]
forall {k} (f :: k -> *). NP f '[]
Nil
     in
      NS
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (CardanoEras c)
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
NS
  (K (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (CardanoEras c)
-> CollapseTo
     NS
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
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 (LedgerTables
         (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
   (CardanoEras c)
 -> LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
        (CardanoEras c))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NS
  (Decoder s
   :.: K (LedgerTables
            (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
  (CardanoEras c)
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
        (CardanoEras c))
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN NS xs, Applicative f) =>
NS (f :.: g) xs -> f (NS g xs)
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: * -> *)
       (g :: k -> *).
(HSequence h, SListIN h xs, Applicative f) =>
h (f :.: g) xs -> f (h g xs)
hsequence' (NS
   (Decoder s
    :.: K (LedgerTables
             (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
   (CardanoEras c)
 -> Decoder
      s
      (NS
         (K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
         (CardanoEras c)))
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (CardanoEras c)
-> Decoder
     s
     (NS
        (K (LedgerTables
              (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
        (CardanoEras c))
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
  (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (CardanoEras c)
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NS (f -.-> g) xs -> NS f xs -> NS g xs
hap Prod
  NS
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
  (CardanoEras c)
NP
  (Current (Flip LedgerState EmptyMK)
   -.-> (Decoder s
         :.: K (LedgerTables
                  (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)))
  (CardanoEras c)
np (NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
 -> NS
      (Decoder s
       :.: K (LedgerTables
                (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
      (CardanoEras c))
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS
     (Decoder s
      :.: K (LedgerTables
               (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK))
     (CardanoEras c)
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
-> NS (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip Telescope
  (K Past) (Current (Flip LedgerState EmptyMK)) (CardanoEras c)
idx)
   where
    getOne ::
      forall proto era.
      ShelleyCompatible proto era =>
      (TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c) ->
      LedgerState (ShelleyBlock proto era) EmptyMK ->
      Decoder s (LedgerTables (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
    getOne :: forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c)
-> LedgerState (ShelleyBlock proto era) EmptyMK
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
getOne TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c
toCardanoTxOut LedgerState (ShelleyBlock proto era) EmptyMK
st =
      let certInterns :: Interns (Credential 'Staking)
certInterns =
            Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap (Map (Credential 'Staking) UMElem -> Interns (Credential 'Staking))
-> Map (Credential 'Staking) UMElem
-> Interns (Credential 'Staking)
forall a b. (a -> b) -> a -> b
$
              LedgerState (ShelleyBlock proto era) EmptyMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState LedgerState (ShelleyBlock proto era) EmptyMK
st
                NewEpochState era
-> Getting
     (Map (Credential 'Staking) UMElem)
     (NewEpochState era)
     (Map (Credential 'Staking) UMElem)
-> Map (Credential 'Staking) UMElem
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> NewEpochState era
-> Const (Map (Credential 'Staking) UMElem) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
SL.nesEsL
                  ((EpochState era
  -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
 -> NewEpochState era
 -> Const (Map (Credential 'Staking) UMElem) (NewEpochState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> EpochState era
    -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> Getting
     (Map (Credential 'Staking) UMElem)
     (NewEpochState era)
     (Map (Credential 'Staking) UMElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
SL.esLStateL
                  ((LedgerState era
  -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
 -> EpochState era
 -> Const (Map (Credential 'Staking) UMElem) (EpochState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> LedgerState era
    -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> EpochState era
-> Const (Map (Credential 'Staking) UMElem) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
SL.lsCertStateL
                  ((CertState era
  -> Const (Map (Credential 'Staking) UMElem) (CertState era))
 -> LedgerState era
 -> Const (Map (Credential 'Staking) UMElem) (LedgerState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> CertState era
    -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> LedgerState era
-> Const (Map (Credential 'Staking) UMElem) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era
 -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL
                  ((DState era
  -> Const (Map (Credential 'Staking) UMElem) (DState era))
 -> CertState era
 -> Const (Map (Credential 'Staking) UMElem) (CertState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> DState era
    -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> CertState era
-> Const (Map (Credential 'Staking) UMElem) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
SL.dsUnifiedL
                  ((UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
 -> DState era
 -> Const (Map (Credential 'Staking) UMElem) (DState era))
-> ((Map (Credential 'Staking) UMElem
     -> Const
          (Map (Credential 'Staking) UMElem)
          (Map (Credential 'Staking) UMElem))
    -> UMap -> Const (Map (Credential 'Staking) UMElem) UMap)
-> (Map (Credential 'Staking) UMElem
    -> Const
         (Map (Credential 'Staking) UMElem)
         (Map (Credential 'Staking) UMElem))
-> DState era
-> Const (Map (Credential 'Staking) UMElem) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) UMElem
 -> Const
      (Map (Credential 'Staking) UMElem)
      (Map (Credential 'Staking) UMElem))
-> UMap -> Const (Map (Credential 'Staking) UMElem) UMap
Lens' UMap (Map (Credential 'Staking) UMElem)
SL.umElemsL
       in ValuesMK
  (TxIn (LedgerState (HardForkBlock (CardanoEras c))))
  (TxOut (LedgerState (HardForkBlock (CardanoEras c))))
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
forall (l :: LedgerStateKind) (mk :: MapKind).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
 -> LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
    -> ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
-> Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> LedgerTables
     (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
-> ValuesMK (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
forall k v. Map k v -> ValuesMK k v
ValuesMK
            (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c)
 -> LedgerTables
      (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
-> Decoder
     s
     (LedgerTables
        (LedgerState (HardForkBlock (CardanoEras c))) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (CanonicalTxIn (CardanoEras c))
-> Decoder s (CardanoTxOut c)
-> Decoder s (Map (CanonicalTxIn (CardanoEras c)) (CardanoTxOut c))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s (CanonicalTxIn (CardanoEras c))
forall a s. MemPack a => Decoder s a
decodeMemPack (TxOut era -> CardanoTxOut c
TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut c
toCardanoTxOut (TxOut era -> CardanoTxOut c)
-> Decoder s (TxOut era) -> Decoder s (CardanoTxOut c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (TxOut era) -> Decoder s (TxOut era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share (TxOut era) -> Decoder s (TxOut era)
decShareCBOR Share (TxOut era)
Interns (Credential 'Staking)
certInterns))