{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Ouroboros.Consensus.Cardano.StreamingLedgerTables
  ( mkInMemYieldArgs
  , mkInMemSinkArgs
  ) where

import Cardano.Ledger.Binary
import Cardano.Ledger.Core (ByronEra, Era, eraDecoder, toEraCBOR)
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.LedgerState as SL
import qualified Cardano.Ledger.State as SL
import qualified Codec.CBOR.Encoding
import Control.ResourceRegistry
import Data.Proxy
import Data.SOP.BasicFunctors
import Data.SOP.Functors
import Data.SOP.Strict
import qualified Data.SOP.Telescope as Telescope
import Lens.Micro
import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Cardano.Ledger
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.HardFork.Combinator.State
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Ouroboros.Consensus.Storage.LedgerDB.API
import Ouroboros.Consensus.Storage.LedgerDB.V2.InMemory as V2
import System.Directory
import System.FS.API
import System.FS.IO

type L = LedgerState (CardanoBlock StandardCrypto)

mkInMemYieldArgs :: FilePath -> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO V2.Mem L)
mkInMemYieldArgs :: FilePath
-> L EmptyMK -> ResourceRegistry IO -> IO (YieldArgs IO Mem L)
mkInMemYieldArgs FilePath
fp (HardForkLedgerState (HardForkState Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  (CardanoEras StandardCrypto)
idx)) ResourceRegistry IO
_ =
  let
    np ::
      NP
        (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
        (CardanoEras StandardCrypto)
    np :: NP
  (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
  (CardanoEras StandardCrypto)
np =
      ((Current (Flip LedgerState EmptyMK) ByronBlock
 -> K (Decoders L) ByronBlock)
-> (-.->)
     (Current (Flip LedgerState EmptyMK)) (K (Decoders L)) ByronBlock
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current (Flip LedgerState EmptyMK) ByronBlock
  -> K (Decoders L) ByronBlock)
 -> (-.->)
      (Current (Flip LedgerState EmptyMK)) (K (Decoders L)) ByronBlock)
-> (Current (Flip LedgerState EmptyMK) ByronBlock
    -> K (Decoders L) ByronBlock)
-> (-.->)
     (Current (Flip LedgerState EmptyMK)) (K (Decoders L)) ByronBlock
forall a b. (a -> b) -> a -> b
$ K (Decoders L) ByronBlock
-> Current (Flip LedgerState EmptyMK) ByronBlock
-> K (Decoders L) ByronBlock
forall a b. a -> b -> a
const (K (Decoders L) ByronBlock
 -> Current (Flip LedgerState EmptyMK) ByronBlock
 -> K (Decoders L) ByronBlock)
-> K (Decoders L) ByronBlock
-> Current (Flip LedgerState EmptyMK) ByronBlock
-> K (Decoders L) ByronBlock
forall a b. (a -> b) -> a -> b
$ Decoders L -> K (Decoders L) ByronBlock
forall k a (b :: k). a -> K a b
K (Decoders L -> K (Decoders L) ByronBlock)
-> Decoders L -> K (Decoders L) ByronBlock
forall a b. (a -> b) -> a -> b
$ FilePath -> Decoders L
forall a. HasCallStack => FilePath -> a
error FilePath
"Byron")
        (-.->)
  (Current (Flip LedgerState EmptyMK)) (K (Decoders L)) ByronBlock
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     (CardanoEras StandardCrypto)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
 -> K (Decoders L)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
  -> K (Decoders L)
       (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
    -> K (Decoders L)
         (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) ShelleyEra))
-> CardanoTxOut c
ShelleyTxOut (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
    -> LedgerState
         (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState
  EmptyMK
  (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) 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 StandardCrypto) ShelleyEra)
 -> LedgerState
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> Flip
     LedgerState
     EmptyMK
     (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) ShelleyEra,
       ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
 -> K (Decoders L)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
  -> K (Decoders L)
       (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
    -> K (Decoders L)
         (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AllegraEra))
-> CardanoTxOut c
AllegraTxOut (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) AllegraEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
    -> LedgerState
         (ShelleyBlock (TPraos StandardCrypto) AllegraEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState
  EmptyMK
  (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) 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 StandardCrypto) AllegraEra)
 -> LedgerState
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (TPraos StandardCrypto) AllegraEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> Flip
     LedgerState
     EmptyMK
     (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (TPraos StandardCrypto) AllegraEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) AllegraEra,
       ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (TPraos StandardCrypto) MaryEra)
 -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (TPraos StandardCrypto) MaryEra)
  -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) MaryEra)
    -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) MaryEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut (LedgerState (ShelleyBlock (TPraos StandardCrypto) MaryEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) MaryEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut (LedgerState (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) MaryEra))
-> CardanoTxOut c
MaryTxOut (LedgerState (ShelleyBlock (TPraos StandardCrypto) MaryEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) MaryEra)
    -> LedgerState
         (ShelleyBlock (TPraos StandardCrypto) MaryEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState EmptyMK (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) 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 StandardCrypto) MaryEra)
 -> LedgerState
      (ShelleyBlock (TPraos StandardCrypto) MaryEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) MaryEra)
    -> Flip
         LedgerState EmptyMK (ShelleyBlock (TPraos StandardCrypto) MaryEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) MaryEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> Flip
     LedgerState EmptyMK (ShelleyBlock (TPraos StandardCrypto) MaryEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (TPraos StandardCrypto) MaryEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) MaryEra,
       ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
 -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
  -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
    -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> K (Decoders L) (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut
  (LedgerState (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (TPraos c) AlonzoEra))
-> CardanoTxOut c
AlonzoTxOut (LedgerState
   (ShelleyBlock (TPraos StandardCrypto) AlonzoEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
    -> LedgerState
         (ShelleyBlock (TPraos StandardCrypto) AlonzoEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState
  EmptyMK
  (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) 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 StandardCrypto) AlonzoEra)
 -> LedgerState
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (TPraos StandardCrypto) AlonzoEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> LedgerState
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> Flip
     LedgerState
     EmptyMK
     (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (TPraos StandardCrypto) AlonzoEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (TPraos StandardCrypto) AlonzoEra,
       ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (Praos StandardCrypto) BabbageEra)
 -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (Praos StandardCrypto) BabbageEra)
  -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) BabbageEra)
    -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) BabbageEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (Praos StandardCrypto) BabbageEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) BabbageEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut
  (LedgerState (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) BabbageEra))
-> CardanoTxOut c
BabbageTxOut (LedgerState
   (ShelleyBlock (Praos StandardCrypto) BabbageEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) BabbageEra)
    -> LedgerState
         (ShelleyBlock (Praos StandardCrypto) BabbageEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState
  EmptyMK
  (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) 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 StandardCrypto) BabbageEra)
 -> LedgerState
      (ShelleyBlock (Praos StandardCrypto) BabbageEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) BabbageEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (Praos StandardCrypto) BabbageEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) BabbageEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> Flip
     LedgerState
     EmptyMK
     (ShelleyBlock (Praos StandardCrypto) BabbageEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (Praos StandardCrypto) BabbageEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) BabbageEra,
       ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (Praos StandardCrypto) ConwayEra)
 -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (Praos StandardCrypto) ConwayEra)
  -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) ConwayEra)
    -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) ConwayEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (Praos StandardCrypto) ConwayEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) ConwayEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut (LedgerState (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) ConwayEra))
-> CardanoTxOut c
ConwayTxOut (LedgerState
   (ShelleyBlock (Praos StandardCrypto) ConwayEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) ConwayEra)
    -> LedgerState
         (ShelleyBlock (Praos StandardCrypto) ConwayEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState EmptyMK (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) 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 StandardCrypto) ConwayEra)
 -> LedgerState
      (ShelleyBlock (Praos StandardCrypto) ConwayEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) ConwayEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (Praos StandardCrypto) ConwayEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) ConwayEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> Flip
     LedgerState EmptyMK (ShelleyBlock (Praos StandardCrypto) ConwayEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (Praos StandardCrypto) ConwayEra)
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) DijkstraEra]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) ConwayEra,
       ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((Current
   (Flip LedgerState EmptyMK)
   (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
 -> K (Decoders L)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((Current
    (Flip LedgerState EmptyMK)
    (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
  -> K (Decoders L)
       (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
 -> (-.->)
      (Current (Flip LedgerState EmptyMK))
      (K (Decoders L))
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
    -> K (Decoders L)
         (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> (-.->)
     (Current (Flip LedgerState EmptyMK))
     (K (Decoders L))
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall a b. (a -> b) -> a -> b
$ Decoders L
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall k a (b :: k). a -> K a b
K (Decoders L
 -> K (Decoders L)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
    -> Decoders L)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> K (Decoders L) (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOut
   (LedgerState (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
 -> CardanoTxOut StandardCrypto)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra) EmptyMK
-> Decoders L
forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut
  (LedgerState (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> CardanoTxOut StandardCrypto
forall c.
TxOut (LedgerState (ShelleyBlock (Praos c) DijkstraEra))
-> CardanoTxOut c
DijkstraTxOut (LedgerState
   (ShelleyBlock (Praos StandardCrypto) DijkstraEra) EmptyMK
 -> Decoders L)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
    -> LedgerState
         (ShelleyBlock (Praos StandardCrypto) DijkstraEra) EmptyMK)
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> Decoders L
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flip
  LedgerState
  EmptyMK
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) 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 StandardCrypto) DijkstraEra)
 -> LedgerState
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra) EmptyMK)
-> (Current
      (Flip LedgerState EmptyMK)
      (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
    -> Flip
         LedgerState
         EmptyMK
         (ShelleyBlock (Praos StandardCrypto) DijkstraEra))
-> Current
     (Flip LedgerState EmptyMK)
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> LedgerState
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra) EmptyMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (Flip LedgerState EmptyMK)
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> Flip
     LedgerState
     EmptyMK
     (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState)
        (-.->)
  (Current (Flip LedgerState EmptyMK))
  (K (Decoders L))
  (ShelleyBlock (Praos StandardCrypto) DijkstraEra)
-> NP (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L)) '[]
-> NP
     (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
     '[ShelleyBlock (Praos StandardCrypto) DijkstraEra]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L)) '[]
forall {k} (f :: k -> *). NP f '[]
Nil
   in
    YieldArgs IO Mem L -> IO (YieldArgs IO Mem L)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (YieldArgs IO Mem L -> IO (YieldArgs IO Mem L))
-> YieldArgs IO Mem L -> IO (YieldArgs IO Mem L)
forall a b. (a -> b) -> a -> b
$
      (MountPoint -> SomeHasFS IO)
-> FilePath -> Decoders L -> YieldArgs IO Mem L
forall (m :: * -> *) (l :: MapKind -> *).
(MountPoint -> SomeHasFS m)
-> FilePath -> Decoders l -> YieldArgs m Mem l
YieldInMemory
        (HasFS IO HandleIO -> SomeHasFS IO
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS IO HandleIO -> SomeHasFS IO)
-> (MountPoint -> HasFS IO HandleIO) -> MountPoint -> SomeHasFS IO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MountPoint -> HasFS IO HandleIO
forall (m :: * -> *).
(MonadIO m, PrimState IO ~ PrimState m) =>
MountPoint -> HasFS m HandleIO
ioHasFS)
        FilePath
fp
        (NS (K (Decoders L)) (CardanoEras StandardCrypto)
-> CollapseTo NS (Decoders L)
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 (Decoders L)) (CardanoEras StandardCrypto)
 -> CollapseTo NS (Decoders L))
-> NS (K (Decoders L)) (CardanoEras StandardCrypto)
-> CollapseTo NS (Decoders L)
forall a b. (a -> b) -> a -> b
$ Prod
  NS
  (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
  (CardanoEras StandardCrypto)
-> NS
     (Current (Flip LedgerState EmptyMK)) (CardanoEras StandardCrypto)
-> NS (K (Decoders L)) (CardanoEras StandardCrypto)
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 (Decoders L))
  (CardanoEras StandardCrypto)
NP
  (Current (Flip LedgerState EmptyMK) -.-> K (Decoders L))
  (CardanoEras StandardCrypto)
np (NS
   (Current (Flip LedgerState EmptyMK)) (CardanoEras StandardCrypto)
 -> NS (K (Decoders L)) (CardanoEras StandardCrypto))
-> NS
     (Current (Flip LedgerState EmptyMK)) (CardanoEras StandardCrypto)
-> NS (K (Decoders L)) (CardanoEras StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  (CardanoEras StandardCrypto)
-> NS
     (Current (Flip LedgerState EmptyMK)) (CardanoEras StandardCrypto)
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 StandardCrypto)
idx)
 where
  fromEra ::
    forall proto era.
    ShelleyCompatible proto era =>
    (TxOut (LedgerState (ShelleyBlock proto era)) -> CardanoTxOut StandardCrypto) ->
    LedgerState (ShelleyBlock proto era) EmptyMK ->
    Decoders L
  fromEra :: forall proto era.
ShelleyCompatible proto era =>
(TxOut (LedgerState (ShelleyBlock proto era))
 -> CardanoTxOut StandardCrypto)
-> LedgerState (ShelleyBlock proto era) EmptyMK -> Decoders L
fromEra TxOut (LedgerState (ShelleyBlock proto era))
-> CardanoTxOut StandardCrypto
toCardanoTxOut LedgerState (ShelleyBlock proto era) EmptyMK
st =
    let certInterns :: Interns (Credential 'Staking)
certInterns =
          Map (Credential 'Staking) (AccountState era)
-> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap (Map (Credential 'Staking) (AccountState era)
 -> Interns (Credential 'Staking))
-> Map (Credential 'Staking) (AccountState era)
-> 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) (AccountState era))
     (NewEpochState era)
     (Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. (EpochState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (EpochState era))
-> NewEpochState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (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) (AccountState era)) (EpochState era))
 -> NewEpochState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (NewEpochState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> EpochState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (EpochState era))
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (NewEpochState era)
     (Map (Credential 'Staking) (AccountState era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> EpochState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (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) (AccountState era)) (LedgerState era))
 -> EpochState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (EpochState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> LedgerState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> EpochState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> LedgerState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (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) (AccountState era)) (CertState era))
 -> LedgerState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (LedgerState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> CertState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> LedgerState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (DState era))
-> CertState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
SL.certDStateL
                ((DState era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (DState era))
 -> CertState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (CertState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> DState era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (DState era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> CertState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (CertState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Accounts era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> DState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (DState era)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
SL.accountsL
                ((Accounts era
  -> Const
       (Map (Credential 'Staking) (AccountState era)) (Accounts era))
 -> DState era
 -> Const
      (Map (Credential 'Staking) (AccountState era)) (DState era))
-> ((Map (Credential 'Staking) (AccountState era)
     -> Const
          (Map (Credential 'Staking) (AccountState era))
          (Map (Credential 'Staking) (AccountState era)))
    -> Accounts era
    -> Const
         (Map (Credential 'Staking) (AccountState era)) (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
    -> Const
         (Map (Credential 'Staking) (AccountState era))
         (Map (Credential 'Staking) (AccountState era)))
-> DState era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (DState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'Staking) (AccountState era)
 -> Const
      (Map (Credential 'Staking) (AccountState era))
      (Map (Credential 'Staking) (AccountState era)))
-> Accounts era
-> Const
     (Map (Credential 'Staking) (AccountState era)) (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
SL.accountsMapL
     in (forall s. Decoder s (TxIn L))
-> (forall s. Decoder s (TxOut L)) -> Decoders L
forall (l :: MapKind -> *).
(forall s. Decoder s (TxIn l))
-> (forall s. Decoder s (TxOut l)) -> Decoders l
Decoders
          (forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era Decoder s (CanonicalTxIn (CardanoEras StandardCrypto))
forall a s. MemPack a => Decoder s a
decodeMemPack)
          (forall era t s. Era era => Decoder s t -> Decoder s t
eraDecoder @era (Decoder s (TxOut L) -> Decoder s (TxOut L))
-> Decoder s (TxOut L) -> Decoder s (TxOut L)
forall a b. (a -> b) -> a -> b
$ TxOut era -> CardanoTxOut StandardCrypto
TxOut (LedgerState (ShelleyBlock proto era))
-> CardanoTxOut StandardCrypto
toCardanoTxOut (TxOut era -> CardanoTxOut StandardCrypto)
-> Decoder s (TxOut era) -> Decoder s (CardanoTxOut StandardCrypto)
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)

mkInMemSinkArgs ::
  FilePath ->
  L EmptyMK ->
  ResourceRegistry IO ->
  IO (SinkArgs IO V2.Mem L)
mkInMemSinkArgs :: FilePath
-> L EmptyMK -> ResourceRegistry IO -> IO (SinkArgs IO Mem L)
mkInMemSinkArgs FilePath
fp (HardForkLedgerState (HardForkState Telescope
  (K Past)
  (Current (Flip LedgerState EmptyMK))
  (CardanoEras StandardCrypto)
idx)) ResourceRegistry IO
_ = do
  currDir <- IO FilePath
getCurrentDirectory
  let
    np =
      ((f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy ByronEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ByronEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x, x, x, x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> 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 (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy ShelleyEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ShelleyEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x, x, x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> 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 (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy AllegraEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AllegraEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x, x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> 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 (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy MaryEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> 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 (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy AlonzoEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AlonzoEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> 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 (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy BabbageEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @BabbageEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy ConwayEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ConwayEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x, x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* ((f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
(f a -> g a) -> (-.->) f g a
Fn ((f x
  -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
        CardanoTxOut StandardCrypto -> Encoding)
       x)
 -> (-.->)
      f
      (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding))
      x)
-> (f x
    -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
          CardanoTxOut StandardCrypto -> Encoding)
         x)
-> (-.->)
     f
     (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
         CardanoTxOut StandardCrypto -> Encoding))
     x
forall a b. (a -> b) -> a -> b
$ K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
   CardanoTxOut StandardCrypto -> Encoding)
  x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. a -> b -> a
const (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
    CardanoTxOut StandardCrypto -> Encoding)
   x
 -> f x
 -> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
       CardanoTxOut StandardCrypto -> Encoding)
      x)
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
-> f x
-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding)
     x
forall a b. (a -> b) -> a -> b
$ (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall k a (b :: k). a -> K a b
K ((TxIn L -> Encoding, TxOut L -> Encoding)
 -> K (TxIn L -> Encoding, TxOut L -> Encoding) x)
-> (TxIn L -> Encoding, TxOut L -> Encoding)
-> K (TxIn L -> Encoding, TxOut L -> Encoding) x
forall a b. (a -> b) -> a -> b
$ Proxy DijkstraEra -> (TxIn L -> Encoding, TxOut L -> Encoding)
forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DijkstraEra))
        (-.->)
  f
  (K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
      CardanoTxOut StandardCrypto -> Encoding))
  x
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[]
-> NP
     (f
      -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
              CardanoTxOut StandardCrypto -> Encoding))
     '[x]
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NP f xs1 -> NP f (x : xs1)
:* NP
  (f
   -.-> K (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding,
           CardanoTxOut StandardCrypto -> Encoding))
  '[]
forall {k} (f :: k -> *). NP f '[]
Nil
  pure $
    uncurry
      (SinkInMemory 1000)
      (hcollapse $ hap np $ Telescope.tip idx)
      (SomeHasFS $ ioHasFS $ MountPoint currDir)
      fp
 where
  encOne ::
    forall era.
    Era era =>
    Proxy era ->
    (TxIn L -> Codec.CBOR.Encoding.Encoding, TxOut L -> Codec.CBOR.Encoding.Encoding)
  encOne :: forall era.
Era era =>
Proxy era -> (TxIn L -> Encoding, TxOut L -> Encoding)
encOne Proxy era
_ =
    (forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era (Encoding -> Encoding)
-> (CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding)
-> CanonicalTxIn (CardanoEras StandardCrypto)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CanonicalTxIn (CardanoEras StandardCrypto) -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack, forall era t. (Era era, EncCBOR t) => t -> Encoding
toEraCBOR @era (Encoding -> Encoding)
-> (CardanoTxOut StandardCrypto -> Encoding)
-> CardanoTxOut StandardCrypto
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x.
 IsShelleyBlock x =>
 Index (CardanoEras StandardCrypto) x
 -> TxOut (LedgerState x) -> Encoding)
-> CardanoTxOut StandardCrypto -> 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 StandardCrypto) x
-> TxOut (ShelleyBlockLedgerEra x)
-> Encoding
forall a b. a -> b -> a
const TxOut (ShelleyBlockLedgerEra x) -> Encoding
forall a. MemPack a => a -> Encoding
encodeMemPack))