{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.HardFork.Combinator.Mempool
  ( GenTx (..)
  , HardForkApplyTxErr (..)
  , TxId (..)
  , Validated (..)
  , hardForkApplyTxErrFromEither
  , hardForkApplyTxErrToEither
  ) where

import Control.Arrow ((+++))
import Control.Monad.Except
import Data.ByteString.Short (ShortByteString)
import qualified Data.Foldable as Foldable
import Data.Functor.Identity
import Data.Functor.Product
import qualified Data.Measure as Measure
import Data.SOP.BasicFunctors
import Data.SOP.Constraint
import qualified Data.SOP.InPairs as InPairs
import Data.SOP.Index
import Data.SOP.Strict
import qualified Data.SOP.Telescope as Tele
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HardFork.Combinator.Abstract
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
import Ouroboros.Consensus.HardFork.Combinator.Basics
import Ouroboros.Consensus.HardFork.Combinator.InjectTxs
import Ouroboros.Consensus.HardFork.Combinator.Ledger
import Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables.Utils (applyDiffs, forgetLedgerTables)
import Ouroboros.Consensus.TypeFamilyWrappers
import Ouroboros.Consensus.Util
import Ouroboros.Network.Tx (HasRawTxId (..))

data HardForkApplyTxErr xs
  = -- | Validation error from one of the eras
    HardForkApplyTxErrFromEra !(OneEraApplyTxErr xs)
  | -- | We tried to apply a transaction from the wrong era
    HardForkApplyTxErrWrongEra !(MismatchEraInfo xs)
  deriving (forall x. HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x)
-> (forall x.
    Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs)
-> Generic (HardForkApplyTxErr xs)
forall (xs :: [*]) x.
Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs
forall (xs :: [*]) x.
HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x
forall x. Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs
forall x. HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x
from :: forall x. HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x
$cto :: forall (xs :: [*]) x.
Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs
to :: forall x. Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs
Generic

instance Typeable xs => ShowProxy (HardForkApplyTxErr xs)

hardForkApplyTxErrToEither ::
  HardForkApplyTxErr xs ->
  Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
hardForkApplyTxErrToEither :: forall (xs :: [*]).
HardForkApplyTxErr xs
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
hardForkApplyTxErrToEither (HardForkApplyTxErrFromEra OneEraApplyTxErr xs
err) = OneEraApplyTxErr xs
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
forall a b. b -> Either a b
Right OneEraApplyTxErr xs
err
hardForkApplyTxErrToEither (HardForkApplyTxErrWrongEra MismatchEraInfo xs
err) = MismatchEraInfo xs
-> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
forall a b. a -> Either a b
Left MismatchEraInfo xs
err

hardForkApplyTxErrFromEither ::
  Either (MismatchEraInfo xs) (OneEraApplyTxErr xs) ->
  HardForkApplyTxErr xs
hardForkApplyTxErrFromEither :: forall (xs :: [*]).
Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
-> HardForkApplyTxErr xs
hardForkApplyTxErrFromEither (Right OneEraApplyTxErr xs
err) = OneEraApplyTxErr xs -> HardForkApplyTxErr xs
forall (xs :: [*]). OneEraApplyTxErr xs -> HardForkApplyTxErr xs
HardForkApplyTxErrFromEra OneEraApplyTxErr xs
err
hardForkApplyTxErrFromEither (Left MismatchEraInfo xs
err) = MismatchEraInfo xs -> HardForkApplyTxErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra MismatchEraInfo xs
err

deriving stock instance CanHardFork xs => Show (HardForkApplyTxErr xs)

deriving stock instance CanHardFork xs => Eq (HardForkApplyTxErr xs)

newtype instance GenTx (HardForkBlock xs) = HardForkGenTx
  { forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx :: OneEraGenTx xs
  }
  deriving (GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
(GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool)
-> (GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool)
-> Eq (GenTx (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
== :: GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
$c/= :: forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
/= :: GenTx (HardForkBlock xs) -> GenTx (HardForkBlock xs) -> Bool
Eq, (forall x.
 GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x)
-> (forall x.
    Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs))
-> Generic (GenTx (HardForkBlock xs))
forall (xs :: [*]) x.
Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs)
forall (xs :: [*]) x.
GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x
forall x.
Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs)
forall x.
GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x
from :: forall x.
GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x
$cto :: forall (xs :: [*]) x.
Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs)
to :: forall x.
Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs)
Generic, Int -> GenTx (HardForkBlock xs) -> ShowS
[GenTx (HardForkBlock xs)] -> ShowS
GenTx (HardForkBlock xs) -> String
(Int -> GenTx (HardForkBlock xs) -> ShowS)
-> (GenTx (HardForkBlock xs) -> String)
-> ([GenTx (HardForkBlock xs)] -> ShowS)
-> Show (GenTx (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Int -> GenTx (HardForkBlock xs) -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
[GenTx (HardForkBlock xs)] -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> GenTx (HardForkBlock xs) -> ShowS
showsPrec :: Int -> GenTx (HardForkBlock xs) -> ShowS
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> String
show :: GenTx (HardForkBlock xs) -> String
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[GenTx (HardForkBlock xs)] -> ShowS
showList :: [GenTx (HardForkBlock xs)] -> ShowS
Show)
  deriving anyclass Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
Proxy (GenTx (HardForkBlock xs)) -> String
(Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx (HardForkBlock xs)) -> String)
-> NoThunks (GenTx (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (GenTx (HardForkBlock xs)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (GenTx (HardForkBlock xs)) -> String
showTypeOf :: Proxy (GenTx (HardForkBlock xs)) -> String
NoThunks

newtype instance Validated (GenTx (HardForkBlock xs)) = HardForkValidatedGenTx
  { forall (xs :: [*]).
Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs
getHardForkValidatedGenTx :: OneEraValidatedGenTx xs
  }
  deriving (Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
(Validated (GenTx (HardForkBlock xs))
 -> Validated (GenTx (HardForkBlock xs)) -> Bool)
-> (Validated (GenTx (HardForkBlock xs))
    -> Validated (GenTx (HardForkBlock xs)) -> Bool)
-> Eq (Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
== :: Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
$c/= :: forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
/= :: Validated (GenTx (HardForkBlock xs))
-> Validated (GenTx (HardForkBlock xs)) -> Bool
Eq, (forall x.
 Validated (GenTx (HardForkBlock xs))
 -> Rep (Validated (GenTx (HardForkBlock xs))) x)
-> (forall x.
    Rep (Validated (GenTx (HardForkBlock xs))) x
    -> Validated (GenTx (HardForkBlock xs)))
-> Generic (Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]) x.
Rep (Validated (GenTx (HardForkBlock xs))) x
-> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]) x.
Validated (GenTx (HardForkBlock xs))
-> Rep (Validated (GenTx (HardForkBlock xs))) x
forall x.
Rep (Validated (GenTx (HardForkBlock xs))) x
-> Validated (GenTx (HardForkBlock xs))
forall x.
Validated (GenTx (HardForkBlock xs))
-> Rep (Validated (GenTx (HardForkBlock xs))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
Validated (GenTx (HardForkBlock xs))
-> Rep (Validated (GenTx (HardForkBlock xs))) x
from :: forall x.
Validated (GenTx (HardForkBlock xs))
-> Rep (Validated (GenTx (HardForkBlock xs))) x
$cto :: forall (xs :: [*]) x.
Rep (Validated (GenTx (HardForkBlock xs))) x
-> Validated (GenTx (HardForkBlock xs))
to :: forall x.
Rep (Validated (GenTx (HardForkBlock xs))) x
-> Validated (GenTx (HardForkBlock xs))
Generic, Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS
[Validated (GenTx (HardForkBlock xs))] -> ShowS
Validated (GenTx (HardForkBlock xs)) -> String
(Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS)
-> (Validated (GenTx (HardForkBlock xs)) -> String)
-> ([Validated (GenTx (HardForkBlock xs))] -> ShowS)
-> Show (Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
[Validated (GenTx (HardForkBlock xs))] -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs)) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS
showsPrec :: Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs)) -> String
show :: Validated (GenTx (HardForkBlock xs)) -> String
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[Validated (GenTx (HardForkBlock xs))] -> ShowS
showList :: [Validated (GenTx (HardForkBlock xs))] -> ShowS
Show)
  deriving anyclass Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx (HardForkBlock xs))) -> String
(Context
 -> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo))
-> (Context
    -> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx (HardForkBlock xs))) -> String)
-> NoThunks (Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (Validated (GenTx (HardForkBlock xs))) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (Validated (GenTx (HardForkBlock xs))) -> String
showTypeOf :: Proxy (Validated (GenTx (HardForkBlock xs))) -> String
NoThunks

instance Typeable xs => ShowProxy (GenTx (HardForkBlock xs))

type instance ApplyTxErr (HardForkBlock xs) = HardForkApplyTxErr xs

-- | Just to discharge cognitive load, this is equivalent to:
--
-- > ([invalidTxs, ...], [validTxs, ...], st)
--
-- Where @invalidTxs@ and @validTxs@ are hard-fork transactions, and only @st@
-- depends on a particular @blk@.
--
-- We do not define this as a new data type to reuse the @Applicative@ and
-- friends instances of these type constructors, which are useful to
-- @hsequence'@ a @HardForkState@ of this.
--
-- This is also isomorphic to
-- @'Ouroboros.Consensus.Ledger.SupportsMempool.ReapplyTxsResult' (HardForkBlock xs)@
type DecomposedReapplyTxsResult extra xs wtd =
  (,,)
    [Invalidated (HardForkBlock xs)]
    [ ( Validated (GenTx (HardForkBlock xs))
      , InputTxDiffs (HardForkBlock xs) wtd
      , extra
      )
    ]
    :.: FlipTickedLedgerState EmptyMK

instance
  ( CanHardFork xs
  , HasCanonicalTxIn xs
  , HasHardForkTxOut xs
  ) =>
  LedgerSupportsMempool (HardForkBlock xs)
  where
  applyTx :: LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
applyTx = LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
applyHelper

  reapplyTx :: HasCallStack =>
LedgerConfig (HardForkBlock xs)
-> SlotNo
-> Validated (GenTx (HardForkBlock xs))
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (TickedLedgerState (HardForkBlock xs) ValuesMK)
reapplyTx =
    String
-> HardForkLedgerConfig xs
-> SlotNo
-> Validated (GenTx (HardForkBlock xs))
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (TickedLedgerState (HardForkBlock xs) ValuesMK)
forall a. HasCallStack => String -> a
error String
"This method is unreachable"

  reapplyTxs ::
    forall wtd extra.
    LedgerConfig (HardForkBlock xs) ->
    SlotNo ->
    -- \^ Slot number of the block containing the tx
    [ ( Validated (GenTx (HardForkBlock xs))
      , InputTxDiffs (HardForkBlock xs) wtd
      , extra
      )
    ] ->
    TickedLedgerState (HardForkBlock xs) ValuesMK ->
    ReapplyTxsResult extra (HardForkBlock xs) wtd
  reapplyTxs :: forall (wtd :: WhatToDoWithTxDiffs) extra.
LedgerConfig (HardForkBlock xs)
-> SlotNo
-> [(Validated (GenTx (HardForkBlock xs)),
     InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> ReapplyTxsResult extra (HardForkBlock xs) wtd
reapplyTxs
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
..}
    SlotNo
slot
    [(Validated (GenTx (HardForkBlock xs)),
  InputTxDiffs (HardForkBlock xs) wtd, extra)]
vtxs
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState) =
      ( \([Invalidated (HardForkBlock xs)]
err, [(Validated (GenTx (HardForkBlock xs)),
  InputTxDiffs (HardForkBlock xs) wtd, extra)]
val, HardForkState (FlipTickedLedgerState EmptyMK) xs
st) ->
          [Invalidated (HardForkBlock xs)]
-> [(Validated (GenTx (HardForkBlock xs)),
     InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> TickedLedgerState (HardForkBlock xs) EmptyMK
-> ReapplyTxsResult extra (HardForkBlock xs) wtd
forall extra blk (wtd :: WhatToDoWithTxDiffs).
[Invalidated blk]
-> [(Validated (GenTx blk), InputTxDiffs blk wtd, extra)]
-> TickedLedgerState blk EmptyMK
-> ReapplyTxsResult extra blk wtd
ReapplyTxsResult
            (((Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)
 -> Invalidated (HardForkBlock xs))
-> [(Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)]
-> [Invalidated (HardForkBlock xs)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Validated (GenTx (HardForkBlock xs))
x, MismatchEraInfo xs
y) -> GenTx (HardForkBlock xs)
-> ApplyTxErr (HardForkBlock xs) -> Invalidated (HardForkBlock xs)
forall blk. GenTx blk -> ApplyTxErr blk -> Invalidated blk
Invalidated (Validated (GenTx (HardForkBlock xs)) -> GenTx (HardForkBlock xs)
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated Validated (GenTx (HardForkBlock xs))
x) (ApplyTxErr (HardForkBlock xs) -> Invalidated (HardForkBlock xs))
-> ApplyTxErr (HardForkBlock xs) -> Invalidated (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs -> HardForkApplyTxErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra MismatchEraInfo xs
y) [(Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)]
mismatched [Invalidated (HardForkBlock xs)]
-> [Invalidated (HardForkBlock xs)]
-> [Invalidated (HardForkBlock xs)]
forall a. [a] -> [a] -> [a]
++ [Invalidated (HardForkBlock xs)]
err)
            [(Validated (GenTx (HardForkBlock xs)),
  InputTxDiffs (HardForkBlock xs) wtd, extra)]
val
            (TransitionInfo
-> HardForkState (FlipTickedLedgerState EmptyMK) xs
-> TickedLedgerState (HardForkBlock xs) EmptyMK
forall (xs :: [*]) (mk :: MapKind).
TransitionInfo
-> HardForkState (FlipTickedLedgerState mk) xs
-> Ticked LedgerState (HardForkBlock xs) mk
TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState EmptyMK) xs
st)
      )
        (([Invalidated (HardForkBlock xs)],
  [(Validated (GenTx (HardForkBlock xs)),
    InputTxDiffs (HardForkBlock xs) wtd, extra)],
  HardForkState (FlipTickedLedgerState EmptyMK) xs)
 -> ReapplyTxsResult extra (HardForkBlock xs) wtd)
-> ([Invalidated (HardForkBlock xs)],
    [(Validated (GenTx (HardForkBlock xs)),
      InputTxDiffs (HardForkBlock xs) wtd, extra)],
    HardForkState (FlipTickedLedgerState EmptyMK) xs)
-> ReapplyTxsResult extra (HardForkBlock xs) wtd
forall a b. (a -> b) -> a -> b
$ HardForkState
  ((,,)
     [Invalidated (HardForkBlock xs)]
     [(Validated (GenTx (HardForkBlock xs)),
       InputTxDiffs (HardForkBlock xs) wtd, extra)]
   :.: FlipTickedLedgerState EmptyMK)
  xs
-> ([Invalidated (HardForkBlock xs)],
    [(Validated (GenTx (HardForkBlock xs)),
      InputTxDiffs (HardForkBlock xs) wtd, extra)],
    HardForkState (FlipTickedLedgerState EmptyMK) xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN HardForkState xs, Applicative f) =>
HardForkState (f :.: g) xs -> f (HardForkState 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'
        (HardForkState
   ((,,)
      [Invalidated (HardForkBlock xs)]
      [(Validated (GenTx (HardForkBlock xs)),
        InputTxDiffs (HardForkBlock xs) wtd, extra)]
    :.: FlipTickedLedgerState EmptyMK)
   xs
 -> ([Invalidated (HardForkBlock xs)],
     [(Validated (GenTx (HardForkBlock xs)),
       InputTxDiffs (HardForkBlock xs) wtd, extra)],
     HardForkState (FlipTickedLedgerState EmptyMK) xs))
-> HardForkState
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)]
      :.: FlipTickedLedgerState EmptyMK)
     xs
-> ([Invalidated (HardForkBlock xs)],
    [(Validated (GenTx (HardForkBlock xs)),
      InputTxDiffs (HardForkBlock xs) wtd, extra)],
    HardForkState (FlipTickedLedgerState EmptyMK) xs)
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapLedgerConfig a
    -> Product
         (FlipTickedLedgerState ValuesMK)
         (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra)
         a
    -> (:.:)
         ((,,)
            [Invalidated (HardForkBlock xs)]
            [(Validated (GenTx (HardForkBlock xs)),
              InputTxDiffs (HardForkBlock xs) wtd, extra)])
         (FlipTickedLedgerState EmptyMK)
         a)
-> NP WrapLedgerConfig xs
-> HardForkState
     (Product
        (FlipTickedLedgerState ValuesMK)
        (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra))
     xs
-> HardForkState
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)]
      :.: FlipTickedLedgerState EmptyMK)
     xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith
          Proxy SingleEraBlock
proxySingle
          Index xs a
-> WrapLedgerConfig a
-> Product
     (FlipTickedLedgerState ValuesMK)
     (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra)
     a
-> DecomposedReapplyTxsResult extra xs wtd a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product
     (FlipTickedLedgerState ValuesMK)
     (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra)
     a
-> (:.:)
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)])
     (FlipTickedLedgerState EmptyMK)
     a
modeApplyCurrent
          NP WrapLedgerConfig xs
cfgs
          HardForkState
  (Product
     (FlipTickedLedgerState ValuesMK)
     (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra))
  xs
matched
     where
      pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
      cfgs :: NP WrapLedgerConfig xs
cfgs = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialLedgerConfig xs
pcfgs
      ei :: EpochInfo (Except PastHorizonException)
ei =
        Shape xs
-> TransitionInfo
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
          Shape xs
hardForkLedgerConfigShape
          TransitionInfo
transition
          HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState

      ([(Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)]
mismatched, HardForkState
  (Product
     (FlipTickedLedgerState ValuesMK)
     (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra))
  xs
matched) = (forall (xs :: [*]).
 Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs)
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> [(Validated (GenTx (HardForkBlock xs)),
     InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> ([(Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)],
    HardForkState
      (Product
         (FlipTickedLedgerState ValuesMK)
         (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra))
      xs)
forall (xs :: [*]) a b (f :: * -> *).
All SingleEraBlock xs =>
(forall (xs :: [*]).
 Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs)
-> HardForkState f xs
-> [(Validated (GenTx (HardForkBlock xs)), a, b)]
-> ([(Validated (GenTx (HardForkBlock xs)), MismatchEraInfo xs)],
    HardForkState (Product f (TxsToApply a b)) xs)
rematchValidatedTxs Validated (GenTx (HardForkBlock xs0)) -> OneEraValidatedGenTx xs0
forall (xs :: [*]).
Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs
getHardForkValidatedGenTx HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState [(Validated (GenTx (HardForkBlock xs)),
  InputTxDiffs (HardForkBlock xs) wtd, extra)]
vtxs

      modeApplyCurrent ::
        forall blk.
        SingleEraBlock blk =>
        Index xs blk ->
        WrapLedgerConfig blk ->
        Product
          (FlipTickedLedgerState ValuesMK)
          (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra)
          blk ->
        DecomposedReapplyTxsResult extra xs wtd blk
      modeApplyCurrent :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product
     (FlipTickedLedgerState ValuesMK)
     (TxsToApply (InputTxDiffs (HardForkBlock xs) wtd) extra)
     a
-> (:.:)
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)])
     (FlipTickedLedgerState EmptyMK)
     a
modeApplyCurrent Index xs blk
index WrapLedgerConfig blk
cfg (Pair (FlipTickedLedgerState Ticked LedgerState blk ValuesMK
st) (ReapplyTxs [(WrapValidatedGenTx blk, InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
txs)) =
        let ReapplyTxsResult [Invalidated blk]
err [(Validated (GenTx blk), InputTxDiffs blk Discard,
  (extra, InputTxDiffs (HardForkBlock xs) wtd))]
val TickedLedgerState blk EmptyMK
st' =
              forall blk (wtd :: WhatToDoWithTxDiffs) extra.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> SlotNo
-> [(Validated (GenTx blk), InputTxDiffs blk wtd, extra)]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult extra blk wtd
reapplyTxs @blk @Discard
                (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg)
                SlotNo
slot
                [(WrapValidatedGenTx blk -> Validated (GenTx blk)
forall blk. WrapValidatedGenTx blk -> Validated (GenTx blk)
unwrapValidatedGenTx WrapValidatedGenTx blk
tx, (), (extra
df, InputTxDiffs (HardForkBlock xs) wtd
tk)) | (WrapValidatedGenTx blk
tx, InputTxDiffs (HardForkBlock xs) wtd
tk, extra
df) <- [(WrapValidatedGenTx blk, InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
txs]
                Ticked LedgerState blk ValuesMK
st
         in ([Invalidated (HardForkBlock xs)],
 [(Validated (GenTx (HardForkBlock xs)),
   InputTxDiffs (HardForkBlock xs) wtd, extra)],
 FlipTickedLedgerState EmptyMK blk)
-> (:.:)
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)])
     (FlipTickedLedgerState EmptyMK)
     blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
              ( [ Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
injectGenTx Index xs blk
index (Invalidated blk -> GenTx blk
forall blk. Invalidated blk -> GenTx blk
getInvalidated Invalidated blk
x) GenTx (HardForkBlock xs)
-> ApplyTxErr (HardForkBlock xs) -> Invalidated (HardForkBlock xs)
forall blk. GenTx blk -> ApplyTxErr blk -> Invalidated blk
`Invalidated` Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Index xs blk
index (Invalidated blk -> ApplyTxErr blk
forall blk. Invalidated blk -> ApplyTxErr blk
getReason Invalidated blk
x)
                | Invalidated blk
x <- [Invalidated blk]
err
                ]
              , [ (OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]).
OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
HardForkValidatedGenTx (OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs)))
-> (Validated (GenTx blk) -> OneEraValidatedGenTx xs)
-> Validated (GenTx blk)
-> Validated (GenTx (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
forall (xs :: [*]).
NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
OneEraValidatedGenTx (NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs)
-> (Validated (GenTx blk) -> NS WrapValidatedGenTx xs)
-> Validated (GenTx blk)
-> OneEraValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index (WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs)
-> (Validated (GenTx blk) -> WrapValidatedGenTx blk)
-> Validated (GenTx blk)
-> NS WrapValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> WrapValidatedGenTx blk
forall blk. Validated (GenTx blk) -> WrapValidatedGenTx blk
WrapValidatedGenTx (Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs)))
-> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ Validated (GenTx blk)
x, InputTxDiffs (HardForkBlock xs) wtd
z1, extra
z2)
                | (Validated (GenTx blk)
x, (), (extra
z2, InputTxDiffs (HardForkBlock xs) wtd
z1)) <- [(Validated (GenTx blk), (),
  (extra, InputTxDiffs (HardForkBlock xs) wtd))]
[(Validated (GenTx blk), InputTxDiffs blk Discard,
  (extra, InputTxDiffs (HardForkBlock xs) wtd))]
val
                ]
              , TickedLedgerState blk EmptyMK -> FlipTickedLedgerState EmptyMK blk
forall (mk :: MapKind) blk.
Ticked LedgerState blk mk -> FlipTickedLedgerState mk blk
FlipTickedLedgerState TickedLedgerState blk EmptyMK
st'
              )
      modeApplyCurrent Index xs blk
index WrapLedgerConfig blk
cfg (Pair (FlipTickedLedgerState Ticked LedgerState blk ValuesMK
st) (ApplyTxs [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
txs)) =
        let ([Invalidated blk]
err, [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
val, Ticked LedgerState blk ValuesMK
st') = [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
foldApplyTxs [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
txs
         in ([Invalidated (HardForkBlock xs)],
 [(Validated (GenTx (HardForkBlock xs)),
   InputTxDiffs (HardForkBlock xs) wtd, extra)],
 FlipTickedLedgerState EmptyMK blk)
-> (:.:)
     ((,,)
        [Invalidated (HardForkBlock xs)]
        [(Validated (GenTx (HardForkBlock xs)),
          InputTxDiffs (HardForkBlock xs) wtd, extra)])
     (FlipTickedLedgerState EmptyMK)
     blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp
              ( [ Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
injectGenTx Index xs blk
index (Invalidated blk -> GenTx blk
forall blk. Invalidated blk -> GenTx blk
getInvalidated Invalidated blk
x) GenTx (HardForkBlock xs)
-> ApplyTxErr (HardForkBlock xs) -> Invalidated (HardForkBlock xs)
forall blk. GenTx blk -> ApplyTxErr blk -> Invalidated blk
`Invalidated` Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Index xs blk
index (Invalidated blk -> ApplyTxErr blk
forall blk. Invalidated blk -> ApplyTxErr blk
getReason Invalidated blk
x)
                | Invalidated blk
x <- [Invalidated blk]
err
                ]
              , [ (OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]).
OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
HardForkValidatedGenTx (OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs)))
-> (Validated (GenTx blk) -> OneEraValidatedGenTx xs)
-> Validated (GenTx blk)
-> Validated (GenTx (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
forall (xs :: [*]).
NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
OneEraValidatedGenTx (NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs)
-> (Validated (GenTx blk) -> NS WrapValidatedGenTx xs)
-> Validated (GenTx blk)
-> OneEraValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index (WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs)
-> (Validated (GenTx blk) -> WrapValidatedGenTx blk)
-> Validated (GenTx blk)
-> NS WrapValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> WrapValidatedGenTx blk
forall blk. Validated (GenTx blk) -> WrapValidatedGenTx blk
WrapValidatedGenTx (Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs)))
-> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ Validated (GenTx blk)
x, InputTxDiffs (HardForkBlock xs) wtd
z1, extra
z2)
                | (Validated (GenTx blk)
x, InputTxDiffs (HardForkBlock xs) wtd
z1, extra
z2) <- [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
val
                ]
              , TickedLedgerState blk EmptyMK -> FlipTickedLedgerState EmptyMK blk
forall (mk :: MapKind) blk.
Ticked LedgerState blk mk -> FlipTickedLedgerState mk blk
FlipTickedLedgerState (TickedLedgerState blk EmptyMK
 -> FlipTickedLedgerState EmptyMK blk)
-> TickedLedgerState blk EmptyMK
-> FlipTickedLedgerState EmptyMK blk
forall a b. (a -> b) -> a -> b
$ Ticked LedgerState blk ValuesMK -> TickedLedgerState blk EmptyMK
forall (l :: * -> MapKind -> *) blk (mk :: MapKind).
HasLedgerTables l blk =>
l blk mk -> l blk EmptyMK
forgetLedgerTables Ticked LedgerState blk ValuesMK
st'
              )
       where
        foldApplyTxs ::
          [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)] ->
          ( [Invalidated blk]
          , [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd, extra)]
          , TickedLedgerState blk ValuesMK
          )
        foldApplyTxs :: [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
foldApplyTxs [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
xs =
          let step :: ([Invalidated blk],
 [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
   extra)],
 Ticked LedgerState blk ValuesMK)
-> (GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
step ([Invalidated blk]
accE, [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
accV, Ticked LedgerState blk ValuesMK
accSt) (GenTx blk
a, InputTxDiffs (HardForkBlock xs) wtd
d, extra
e) =
                case Except
  (ApplyTxErr blk)
  (TickedLedgerState blk DiffMK, Validated (GenTx blk))
-> Either
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
forall e a. Except e a -> Either e a
runExcept (LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked LedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg) WhetherToIntervene
DoNotIntervene SlotNo
slot GenTx blk
a Ticked LedgerState blk ValuesMK
accSt) of
                  Left ApplyTxErr blk
err -> (GenTx blk -> ApplyTxErr blk -> Invalidated blk
forall blk. GenTx blk -> ApplyTxErr blk -> Invalidated blk
Invalidated GenTx blk
a ApplyTxErr blk
err Invalidated blk -> [Invalidated blk] -> [Invalidated blk]
forall a. a -> [a] -> [a]
: [Invalidated blk]
accE, [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
accV, Ticked LedgerState blk ValuesMK
accSt)
                  Right (TickedLedgerState blk DiffMK
accSt', Validated (GenTx blk)
validated) -> ([Invalidated blk]
accE, (Validated (GenTx blk)
validated, InputTxDiffs (HardForkBlock xs) wtd
d, extra
e) (Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd, extra)
-> [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
     extra)]
-> [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
     extra)]
forall a. a -> [a] -> [a]
: [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
accV, Ticked LedgerState blk ValuesMK
-> TickedLedgerState blk DiffMK -> Ticked LedgerState blk ValuesMK
forall (l :: * -> MapKind -> *) blk (l' :: * -> MapKind -> *).
(HasLedgerTables l blk, HasLedgerTables l' blk) =>
l blk ValuesMK -> l' blk DiffMK -> l' blk ValuesMK
applyDiffs Ticked LedgerState blk ValuesMK
accSt TickedLedgerState blk DiffMK
accSt')
              ([Invalidated blk]
invalids, [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
valids, Ticked LedgerState blk ValuesMK
finalSt) = (([Invalidated blk],
  [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
    extra)],
  Ticked LedgerState blk ValuesMK)
 -> (GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)
 -> ([Invalidated blk],
     [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
       extra)],
     Ticked LedgerState blk ValuesMK))
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
-> [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ([Invalidated blk],
 [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
   extra)],
 Ticked LedgerState blk ValuesMK)
-> (GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)
-> ([Invalidated blk],
    [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
      extra)],
    Ticked LedgerState blk ValuesMK)
step ([], [], Ticked LedgerState blk ValuesMK
st) [(GenTx blk, InputTxDiffs (HardForkBlock xs) wtd, extra)]
xs
           in ([Invalidated blk] -> [Invalidated blk]
forall a. [a] -> [a]
reverse [Invalidated blk]
invalids, [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
-> [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
     extra)]
forall a. [a] -> [a]
reverse [(Validated (GenTx blk), InputTxDiffs (HardForkBlock xs) wtd,
  extra)]
valids, Ticked LedgerState blk ValuesMK
finalSt)

  txForgetValidated :: Validated (GenTx (HardForkBlock xs)) -> GenTx (HardForkBlock xs)
txForgetValidated =
    OneEraGenTx xs -> GenTx (HardForkBlock xs)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
HardForkGenTx
      (OneEraGenTx xs -> GenTx (HardForkBlock xs))
-> (Validated (GenTx (HardForkBlock xs)) -> OneEraGenTx xs)
-> Validated (GenTx (HardForkBlock xs))
-> GenTx (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS GenTx xs -> OneEraGenTx xs
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
OneEraGenTx
      (NS GenTx xs -> OneEraGenTx xs)
-> (Validated (GenTx (HardForkBlock xs)) -> NS GenTx xs)
-> Validated (GenTx (HardForkBlock xs))
-> OneEraGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => WrapValidatedGenTx a -> GenTx a)
-> NS WrapValidatedGenTx xs
-> NS GenTx xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (Validated (GenTx a) -> GenTx a
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx a) -> GenTx a)
-> (WrapValidatedGenTx a -> Validated (GenTx a))
-> WrapValidatedGenTx a
-> GenTx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapValidatedGenTx a -> Validated (GenTx a)
forall blk. WrapValidatedGenTx blk -> Validated (GenTx blk)
unwrapValidatedGenTx)
      (NS WrapValidatedGenTx xs -> NS GenTx xs)
-> (Validated (GenTx (HardForkBlock xs))
    -> NS WrapValidatedGenTx xs)
-> Validated (GenTx (HardForkBlock xs))
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
forall (xs :: [*]).
OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
getOneEraValidatedGenTx
      (OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs)
-> (Validated (GenTx (HardForkBlock xs))
    -> OneEraValidatedGenTx xs)
-> Validated (GenTx (HardForkBlock xs))
-> NS WrapValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs
forall (xs :: [*]).
Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs
getHardForkValidatedGenTx

  getTransactionKeySets :: GenTx (HardForkBlock xs) -> LedgerTables (HardForkBlock xs) KeysMK
getTransactionKeySets (HardForkGenTx (OneEraGenTx NS GenTx xs
ns)) =
    NS (K (LedgerTables (HardForkBlock xs) KeysMK)) xs
-> CollapseTo NS (LedgerTables (HardForkBlock xs) KeysMK)
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 (HardForkBlock xs) KeysMK)) xs
 -> CollapseTo NS (LedgerTables (HardForkBlock xs) KeysMK))
-> NS (K (LedgerTables (HardForkBlock xs) KeysMK)) xs
-> CollapseTo NS (LedgerTables (HardForkBlock xs) KeysMK)
forall a b. (a -> b) -> a -> b
$
      Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> GenTx a -> K (LedgerTables (HardForkBlock xs) KeysMK) a)
-> NS GenTx xs
-> NS (K (LedgerTables (HardForkBlock xs) KeysMK)) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a)
-> h f1 xs
-> h f2 xs
hcimap Proxy SingleEraBlock
proxySingle Index xs a
-> GenTx a -> K (LedgerTables (HardForkBlock xs) KeysMK) a
forall a.
SingleEraBlock a =>
Index xs a
-> GenTx a -> K (LedgerTables (HardForkBlock xs) KeysMK) a
f NS GenTx xs
ns
   where
    f ::
      SingleEraBlock x =>
      Index xs x ->
      GenTx x ->
      K (LedgerTables (HardForkBlock xs) KeysMK) x
    f :: forall a.
SingleEraBlock a =>
Index xs a
-> GenTx a -> K (LedgerTables (HardForkBlock xs) KeysMK) a
f Index xs x
idx GenTx x
tx = LedgerTables (HardForkBlock xs) KeysMK
-> K (LedgerTables (HardForkBlock xs) KeysMK) x
forall k a (b :: k). a -> K a b
K (LedgerTables (HardForkBlock xs) KeysMK
 -> K (LedgerTables (HardForkBlock xs) KeysMK) x)
-> LedgerTables (HardForkBlock xs) KeysMK
-> K (LedgerTables (HardForkBlock xs) KeysMK) x
forall a b. (a -> b) -> a -> b
$ Index xs x
-> LedgerTables x KeysMK -> LedgerTables (HardForkBlock xs) KeysMK
forall (xs :: [*]) x (mk :: MapKind).
(CanMapKeysMK mk, CanMapMK mk, HasCanonicalTxIn xs,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables x mk -> LedgerTables (HardForkBlock xs) mk
injectLedgerTables Index xs x
idx (LedgerTables x KeysMK -> LedgerTables (HardForkBlock xs) KeysMK)
-> LedgerTables x KeysMK -> LedgerTables (HardForkBlock xs) KeysMK
forall a b. (a -> b) -> a -> b
$ GenTx x -> LedgerTables x KeysMK
forall blk.
LedgerSupportsMempool blk =>
GenTx blk -> LedgerTables blk KeysMK
getTransactionKeySets GenTx x
tx

  -- This optimization is worthwile because we can save the projection and
  -- injection of ledger tables.
  --
  -- These operations are used when adding new transactions to the mempool,
  -- which is _not_ in the critical path for the forging loop but still will
  -- make adoption of new transactions faster. As adding a transaction takes a
  -- TMVar, it is interesting to hold it for as short of a time as possible.
  prependMempoolDiffs :: TickedLedgerState (HardForkBlock xs) DiffMK
-> TickedLedgerState (HardForkBlock xs) DiffMK
-> TickedLedgerState (HardForkBlock xs) DiffMK
prependMempoolDiffs
    (TickedHardForkLedgerState TransitionInfo
_ (State.HardForkState Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st1))
    (TickedHardForkLedgerState TransitionInfo
tr (State.HardForkState Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st2)) =
      TransitionInfo
-> HardForkState (FlipTickedLedgerState DiffMK) xs
-> TickedLedgerState (HardForkBlock xs) DiffMK
forall (xs :: [*]) (mk :: MapKind).
TransitionInfo
-> HardForkState (FlipTickedLedgerState mk) xs
-> Ticked LedgerState (HardForkBlock xs) mk
TickedHardForkLedgerState
        TransitionInfo
tr
        (HardForkState (FlipTickedLedgerState DiffMK) xs
 -> TickedLedgerState (HardForkBlock xs) DiffMK)
-> HardForkState (FlipTickedLedgerState DiffMK) xs
-> TickedLedgerState (HardForkBlock xs) DiffMK
forall a b. (a -> b) -> a -> b
$ Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
-> HardForkState (FlipTickedLedgerState DiffMK) xs
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
State.HardForkState
        (Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
 -> HardForkState (FlipTickedLedgerState DiffMK) xs)
-> Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
-> HardForkState (FlipTickedLedgerState DiffMK) xs
forall a b. (a -> b) -> a -> b
$ Identity
  (Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs)
-> Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
forall a. Identity a -> a
runIdentity
          ( InPairs
  (Requiring
     (K Past)
     (Extend
        Identity (K Past) (Current (FlipTickedLedgerState DiffMK))))
  xs
-> NP
     (Current (FlipTickedLedgerState DiffMK)
      -.-> (Current (FlipTickedLedgerState DiffMK)
            -.-> Current (FlipTickedLedgerState DiffMK)))
     xs
-> Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
-> Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
-> Identity
     (Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs)
forall {k} (m :: * -> *) (g' :: k -> *) (g :: k -> *) (f :: k -> *)
       (xs :: [k]) (f' :: k -> *) (f'' :: k -> *).
(Monad m, HasCallStack) =>
InPairs (Requiring g' (Extend m g f)) xs
-> NP (f' -.-> (f -.-> f'')) xs
-> Telescope g' f' xs
-> Telescope g f xs
-> m (Telescope g f'' xs)
Tele.alignExtend
              ( (forall x y.
 Requiring
   (K Past)
   (Extend Identity (K Past) (Current (FlipTickedLedgerState DiffMK)))
   x
   y)
-> InPairs
     (Requiring
        (K Past)
        (Extend
           Identity (K Past) (Current (FlipTickedLedgerState DiffMK))))
     xs
forall {k} (xs :: [k]) (f :: k -> k -> *).
(SListI xs, IsNonEmpty xs) =>
(forall (x :: k) (y :: k). f x y) -> InPairs f xs
InPairs.hpure
                  (String
-> Requiring
     (K Past)
     (Extend Identity (K Past) (Current (FlipTickedLedgerState DiffMK)))
     x
     y
forall a. HasCallStack => String -> a
error String
"When prepending mempool diffs we used to un-aligned states, this should be impossible!")
              )
              ( Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    (-.->)
      (Current (FlipTickedLedgerState DiffMK))
      (Current (FlipTickedLedgerState DiffMK)
       -.-> Current (FlipTickedLedgerState DiffMK))
      a)
-> NP
     (Current (FlipTickedLedgerState DiffMK)
      -.-> (Current (FlipTickedLedgerState DiffMK)
            -.-> Current (FlipTickedLedgerState DiffMK)))
     xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure Proxy SingleEraBlock
proxySingle ((forall a.
  SingleEraBlock a =>
  (-.->)
    (Current (FlipTickedLedgerState DiffMK))
    (Current (FlipTickedLedgerState DiffMK)
     -.-> Current (FlipTickedLedgerState DiffMK))
    a)
 -> NP
      (Current (FlipTickedLedgerState DiffMK)
       -.-> (Current (FlipTickedLedgerState DiffMK)
             -.-> Current (FlipTickedLedgerState DiffMK)))
      xs)
-> (forall a.
    SingleEraBlock a =>
    (-.->)
      (Current (FlipTickedLedgerState DiffMK))
      (Current (FlipTickedLedgerState DiffMK)
       -.-> Current (FlipTickedLedgerState DiffMK))
      a)
-> NP
     (Current (FlipTickedLedgerState DiffMK)
      -.-> (Current (FlipTickedLedgerState DiffMK)
            -.-> Current (FlipTickedLedgerState DiffMK)))
     xs
forall a b. (a -> b) -> a -> b
$ (Current (FlipTickedLedgerState DiffMK) a
 -> Current (FlipTickedLedgerState DiffMK) a
 -> Current (FlipTickedLedgerState DiffMK) a)
-> (-.->)
     (Current (FlipTickedLedgerState DiffMK))
     (Current (FlipTickedLedgerState DiffMK)
      -.-> Current (FlipTickedLedgerState DiffMK))
     a
forall {k} (f :: k -> *) (a :: k) (f' :: k -> *) (f'' :: k -> *).
(f a -> f' a -> f'' a) -> (-.->) f (f' -.-> f'') a
fn_2 ((Current (FlipTickedLedgerState DiffMK) a
  -> Current (FlipTickedLedgerState DiffMK) a
  -> Current (FlipTickedLedgerState DiffMK) a)
 -> (-.->)
      (Current (FlipTickedLedgerState DiffMK))
      (Current (FlipTickedLedgerState DiffMK)
       -.-> Current (FlipTickedLedgerState DiffMK))
      a)
-> (Current (FlipTickedLedgerState DiffMK) a
    -> Current (FlipTickedLedgerState DiffMK) a
    -> Current (FlipTickedLedgerState DiffMK) a)
-> (-.->)
     (Current (FlipTickedLedgerState DiffMK))
     (Current (FlipTickedLedgerState DiffMK)
      -.-> Current (FlipTickedLedgerState DiffMK))
     a
forall a b. (a -> b) -> a -> b
$ \(State.Current Bound
_ FlipTickedLedgerState DiffMK a
a) (State.Current Bound
start FlipTickedLedgerState DiffMK a
b) ->
                  Bound
-> FlipTickedLedgerState DiffMK a
-> Current (FlipTickedLedgerState DiffMK) a
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
State.Current Bound
start (FlipTickedLedgerState DiffMK a
 -> Current (FlipTickedLedgerState DiffMK) a)
-> FlipTickedLedgerState DiffMK a
-> Current (FlipTickedLedgerState DiffMK) a
forall a b. (a -> b) -> a -> b
$
                    Ticked LedgerState a DiffMK -> FlipTickedLedgerState DiffMK a
forall (mk :: MapKind) blk.
Ticked LedgerState blk mk -> FlipTickedLedgerState mk blk
FlipTickedLedgerState (Ticked LedgerState a DiffMK -> FlipTickedLedgerState DiffMK a)
-> Ticked LedgerState a DiffMK -> FlipTickedLedgerState DiffMK a
forall a b. (a -> b) -> a -> b
$
                      Ticked LedgerState a DiffMK
-> Ticked LedgerState a DiffMK -> Ticked LedgerState a DiffMK
forall blk.
LedgerSupportsMempool blk =>
TickedLedgerState blk DiffMK
-> TickedLedgerState blk DiffMK -> TickedLedgerState blk DiffMK
prependMempoolDiffs
                        (FlipTickedLedgerState DiffMK a -> Ticked LedgerState a DiffMK
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked LedgerState blk mk
getFlipTickedLedgerState FlipTickedLedgerState DiffMK a
a)
                        (FlipTickedLedgerState DiffMK a -> Ticked LedgerState a DiffMK
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked LedgerState blk mk
getFlipTickedLedgerState FlipTickedLedgerState DiffMK a
b)
              )
              Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st1
              Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st2
          )

  -- This optimization is worthwile because we can save the projection and
  -- injection of ledger tables.
  --
  -- These operations are used when adding new transactions to the mempool,
  -- which is _not_ in the critical path for the forging loop but still will
  -- make adoption of new transactions faster. As adding a transaction takes a
  -- TMVar, it is interesting to hold it for as short of a time as possible.
  applyMempoolDiffs :: LedgerTables (HardForkBlock xs) ValuesMK
-> LedgerTables (HardForkBlock xs) KeysMK
-> TickedLedgerState (HardForkBlock xs) DiffMK
-> TickedLedgerState (HardForkBlock xs) ValuesMK
applyMempoolDiffs
    LedgerTables (HardForkBlock xs) ValuesMK
vals
    LedgerTables (HardForkBlock xs) KeysMK
keys
    (TickedHardForkLedgerState TransitionInfo
tr (State.HardForkState Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st)) =
      TransitionInfo
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> TickedLedgerState (HardForkBlock xs) ValuesMK
forall (xs :: [*]) (mk :: MapKind).
TransitionInfo
-> HardForkState (FlipTickedLedgerState mk) xs
-> Ticked LedgerState (HardForkBlock xs) mk
TickedHardForkLedgerState TransitionInfo
tr (HardForkState (FlipTickedLedgerState ValuesMK) xs
 -> TickedLedgerState (HardForkBlock xs) ValuesMK)
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> TickedLedgerState (HardForkBlock xs) ValuesMK
forall a b. (a -> b) -> a -> b
$
        Telescope (K Past) (Current (FlipTickedLedgerState ValuesMK)) xs
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
forall (f :: * -> *) (xs :: [*]).
Telescope (K Past) (Current f) xs -> HardForkState f xs
State.HardForkState (Telescope (K Past) (Current (FlipTickedLedgerState ValuesMK)) xs
 -> HardForkState (FlipTickedLedgerState ValuesMK) xs)
-> Telescope (K Past) (Current (FlipTickedLedgerState ValuesMK)) xs
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
forall a b. (a -> b) -> a -> b
$
          Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> Current (FlipTickedLedgerState DiffMK) a
    -> Current (FlipTickedLedgerState ValuesMK) a)
-> Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
-> Telescope (K Past) (Current (FlipTickedLedgerState ValuesMK)) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a)
-> h f1 xs
-> h f2 xs
hcimap
            Proxy SingleEraBlock
proxySingle
            ( \Index xs a
idx (State.Current Bound
start (FlipTickedLedgerState Ticked LedgerState a DiffMK
a)) ->
                Bound
-> FlipTickedLedgerState ValuesMK a
-> Current (FlipTickedLedgerState ValuesMK) a
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
State.Current Bound
start (FlipTickedLedgerState ValuesMK a
 -> Current (FlipTickedLedgerState ValuesMK) a)
-> FlipTickedLedgerState ValuesMK a
-> Current (FlipTickedLedgerState ValuesMK) a
forall a b. (a -> b) -> a -> b
$
                  Ticked LedgerState a ValuesMK -> FlipTickedLedgerState ValuesMK a
forall (mk :: MapKind) blk.
Ticked LedgerState blk mk -> FlipTickedLedgerState mk blk
FlipTickedLedgerState (Ticked LedgerState a ValuesMK -> FlipTickedLedgerState ValuesMK a)
-> Ticked LedgerState a ValuesMK
-> FlipTickedLedgerState ValuesMK a
forall a b. (a -> b) -> a -> b
$
                    LedgerTables a ValuesMK
-> LedgerTables a KeysMK
-> Ticked LedgerState a DiffMK
-> Ticked LedgerState a ValuesMK
forall blk.
LedgerSupportsMempool blk =>
LedgerTables blk ValuesMK
-> LedgerTables blk KeysMK
-> TickedLedgerState blk DiffMK
-> TickedLedgerState blk ValuesMK
applyMempoolDiffs
                      (Index xs a
-> LedgerTables (HardForkBlock xs) ValuesMK
-> LedgerTables a ValuesMK
forall (xs :: [*]) x (mk :: MapKind).
(CanMapKeysMK mk, Ord (TxIn x), HasCanonicalTxIn xs, CanMapMK mk,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables (HardForkBlock xs) mk -> LedgerTables x mk
ejectLedgerTables Index xs a
idx LedgerTables (HardForkBlock xs) ValuesMK
vals)
                      (Index xs a
-> LedgerTables (HardForkBlock xs) KeysMK -> LedgerTables a KeysMK
forall (xs :: [*]) x (mk :: MapKind).
(CanMapKeysMK mk, Ord (TxIn x), HasCanonicalTxIn xs, CanMapMK mk,
 HasHardForkTxOut xs) =>
Index xs x
-> LedgerTables (HardForkBlock xs) mk -> LedgerTables x mk
ejectLedgerTables Index xs a
idx LedgerTables (HardForkBlock xs) KeysMK
keys)
                      Ticked LedgerState a DiffMK
a
            )
            Telescope (K Past) (Current (FlipTickedLedgerState DiffMK)) xs
st

  mkMempoolApplyTxError :: forall (mk :: MapKind).
TickedLedgerState (HardForkBlock xs) mk
-> Text -> Maybe (ApplyTxErr (HardForkBlock xs))
mkMempoolApplyTxError (TickedHardForkLedgerState TransitionInfo
_transition HardForkState (FlipTickedLedgerState mk) xs
hardForkState) Text
txt =
    HardForkState (K (Maybe (HardForkApplyTxErr xs))) xs
-> CollapseTo HardForkState (Maybe (HardForkApplyTxErr xs))
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState (K (Maybe (HardForkApplyTxErr xs))) xs
 -> CollapseTo HardForkState (Maybe (HardForkApplyTxErr xs)))
-> HardForkState (K (Maybe (HardForkApplyTxErr xs))) xs
-> CollapseTo HardForkState (Maybe (HardForkApplyTxErr xs))
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> FlipTickedLedgerState mk a
    -> K (Maybe (HardForkApplyTxErr xs)) a)
-> HardForkState (FlipTickedLedgerState mk) xs
-> HardForkState (K (Maybe (HardForkApplyTxErr xs))) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a)
-> h f1 xs
-> h f2 xs
hcimap Proxy SingleEraBlock
proxySingle Index xs a
-> FlipTickedLedgerState mk a
-> K (Maybe (ApplyTxErr (HardForkBlock xs))) a
Index xs a
-> FlipTickedLedgerState mk a
-> K (Maybe (HardForkApplyTxErr xs)) a
forall a.
SingleEraBlock a =>
Index xs a
-> FlipTickedLedgerState mk a
-> K (Maybe (HardForkApplyTxErr xs)) a
forall x (mk :: MapKind).
SingleEraBlock x =>
Index xs x
-> FlipTickedLedgerState mk x
-> K (Maybe (ApplyTxErr (HardForkBlock xs))) x
f HardForkState (FlipTickedLedgerState mk) xs
hardForkState
   where
    f ::
      SingleEraBlock x =>
      Index xs x ->
      FlipTickedLedgerState mk x ->
      K (Maybe (ApplyTxErr (HardForkBlock xs))) x
    f :: forall x (mk :: MapKind).
SingleEraBlock x =>
Index xs x
-> FlipTickedLedgerState mk x
-> K (Maybe (ApplyTxErr (HardForkBlock xs))) x
f Index xs x
idx (FlipTickedLedgerState Ticked LedgerState x mk
tlst) =
      Maybe (ApplyTxErr (HardForkBlock xs))
-> K (Maybe (ApplyTxErr (HardForkBlock xs))) x
forall k a (b :: k). a -> K a b
K (Maybe (ApplyTxErr (HardForkBlock xs))
 -> K (Maybe (ApplyTxErr (HardForkBlock xs))) x)
-> Maybe (ApplyTxErr (HardForkBlock xs))
-> K (Maybe (ApplyTxErr (HardForkBlock xs))) x
forall a b. (a -> b) -> a -> b
$ Index xs x -> ApplyTxErr x -> HardForkApplyTxErr xs
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Index xs x
idx (ApplyTxErr x -> ApplyTxErr (HardForkBlock xs))
-> Maybe (ApplyTxErr x) -> Maybe (ApplyTxErr (HardForkBlock xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ticked LedgerState x mk -> Text -> Maybe (ApplyTxErr x)
forall blk (mk :: MapKind).
LedgerSupportsMempool blk =>
TickedLedgerState blk mk -> Text -> Maybe (ApplyTxErr blk)
forall (mk :: MapKind).
TickedLedgerState x mk -> Text -> Maybe (ApplyTxErr x)
mkMempoolApplyTxError Ticked LedgerState x mk
tlst Text
txt

instance CanHardFork xs => TxLimits (HardForkBlock xs) where
  type TxMeasurePhase1 (HardForkBlock xs) = HardForkTxMeasurePhase1 xs
  type TxMeasurePhase2 (HardForkBlock xs) = HardForkTxMeasurePhase2 xs

  txWireSize :: GenTx (HardForkBlock xs) -> SizeInBytes
txWireSize =
    \GenTx (HardForkBlock xs)
tx ->
      let tx' :: NS GenTx xs
          tx' :: NS GenTx xs
tx' = OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx (GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx GenTx (HardForkBlock xs)
tx)
          -- HFC overhead
          -- note that HFC might be disabled, then this gives an upperbound.
          overhead :: SizeInBytes
overhead
            | NS GenTx xs -> Word8
forall {k} (xs :: [k]) (f :: k -> *). SListI xs => NS f xs -> Word8
nsToIndex NS GenTx xs
tx' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
23 = SizeInBytes
2
            | Bool
otherwise = SizeInBytes
3
       in (SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
overhead)
            (SizeInBytes -> SizeInBytes)
-> (NS GenTx xs -> SizeInBytes) -> NS GenTx xs -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (K SizeInBytes) xs -> CollapseTo NS SizeInBytes
NS (K SizeInBytes) xs -> SizeInBytes
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 SizeInBytes) xs -> SizeInBytes)
-> (NS GenTx xs -> NS (K SizeInBytes) xs)
-> NS GenTx xs
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => GenTx a -> K SizeInBytes a)
-> NS GenTx xs
-> NS (K SizeInBytes) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (SizeInBytes -> K SizeInBytes a
forall k a (b :: k). a -> K a b
K (SizeInBytes -> K SizeInBytes a)
-> (GenTx a -> SizeInBytes) -> GenTx a -> K SizeInBytes a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx a -> SizeInBytes
forall blk. TxLimits blk => GenTx blk -> SizeInBytes
txWireSize)
            (NS GenTx xs -> SizeInBytes) -> NS GenTx xs -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ NS GenTx xs
tx'

  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) mk
-> TxMeasure (HardForkBlock xs)
blockCapacityTxMeasure
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState mk) xs
hardForkState) =
      HardForkState (K (TxMeasure (HardForkBlock xs))) xs
-> CollapseTo HardForkState (TxMeasure (HardForkBlock xs))
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState (K (TxMeasure (HardForkBlock xs))) xs
 -> CollapseTo HardForkState (TxMeasure (HardForkBlock xs)))
-> HardForkState (K (TxMeasure (HardForkBlock xs))) xs
-> CollapseTo HardForkState (TxMeasure (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$
        Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapPartialLedgerConfig a
    -> FlipTickedLedgerState mk a
    -> K (TxMeasure (HardForkBlock xs)) a)
-> NP WrapPartialLedgerConfig xs
-> HardForkState (FlipTickedLedgerState mk) xs
-> HardForkState (K (TxMeasure (HardForkBlock xs))) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith Proxy SingleEraBlock
proxySingle Index xs a
-> WrapPartialLedgerConfig a
-> FlipTickedLedgerState mk a
-> K (TxMeasure (HardForkBlock xs)) a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapPartialLedgerConfig a
-> FlipTickedLedgerState mk a
-> K (TxMeasure (HardForkBlock xs)) a
forall blk (mk :: MapKind).
SingleEraBlock blk =>
Index xs blk
-> WrapPartialLedgerConfig blk
-> FlipTickedLedgerState mk blk
-> K (TxMeasure (HardForkBlock xs)) blk
aux NP WrapPartialLedgerConfig xs
pcfgs HardForkState (FlipTickedLedgerState mk) xs
hardForkState
     where
      pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
      ei :: EpochInfo (Except PastHorizonException)
ei =
        Shape xs
-> TransitionInfo
-> HardForkState (FlipTickedLedgerState mk) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
          Shape xs
hardForkLedgerConfigShape
          TransitionInfo
transition
          HardForkState (FlipTickedLedgerState mk) xs
hardForkState

      aux ::
        SingleEraBlock blk =>
        Index xs blk ->
        WrapPartialLedgerConfig blk ->
        FlipTickedLedgerState mk blk ->
        K (TxMeasure (HardForkBlock xs)) blk
      aux :: forall blk (mk :: MapKind).
SingleEraBlock blk =>
Index xs blk
-> WrapPartialLedgerConfig blk
-> FlipTickedLedgerState mk blk
-> K (TxMeasure (HardForkBlock xs)) blk
aux Index xs blk
idx WrapPartialLedgerConfig blk
pcfg FlipTickedLedgerState mk blk
st' =
        TxMeasure (HardForkBlock xs)
-> K (TxMeasure (HardForkBlock xs)) blk
forall k a (b :: k). a -> K a b
K (TxMeasure (HardForkBlock xs)
 -> K (TxMeasure (HardForkBlock xs)) blk)
-> TxMeasure (HardForkBlock xs)
-> K (TxMeasure (HardForkBlock xs)) blk
forall a b. (a -> b) -> a -> b
$
          let TxMeasure TxMeasurePhase1 blk
p1 TxMeasurePhase2 blk
p2 =
                LedgerConfig blk -> TickedLedgerState blk mk -> TxMeasure blk
forall blk (mk :: MapKind).
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk mk -> TxMeasure blk
forall (mk :: MapKind).
LedgerConfig blk -> TickedLedgerState blk mk -> TxMeasure blk
blockCapacityTxMeasure
                  (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> LedgerConfig blk
completeLedgerConfig' EpochInfo (Except PastHorizonException)
ei WrapPartialLedgerConfig blk
pcfg)
                  (FlipTickedLedgerState mk blk -> TickedLedgerState blk mk
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked LedgerState blk mk
getFlipTickedLedgerState FlipTickedLedgerState mk blk
st')
           in TxMeasurePhase1 (HardForkBlock xs)
-> TxMeasurePhase2 (HardForkBlock xs)
-> TxMeasure (HardForkBlock xs)
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure
                (NS WrapTxMeasurePhase1 xs -> TxMeasurePhase1 (HardForkBlock xs)
NS WrapTxMeasurePhase1 xs -> HardForkTxMeasurePhase1 xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasurePhase1 xs -> HardForkTxMeasurePhase1 xs
hardForkInjTxMeasurePhase1 (NS WrapTxMeasurePhase1 xs -> TxMeasurePhase1 (HardForkBlock xs))
-> (WrapTxMeasurePhase1 blk -> NS WrapTxMeasurePhase1 xs)
-> WrapTxMeasurePhase1 blk
-> TxMeasurePhase1 (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk
-> WrapTxMeasurePhase1 blk -> NS WrapTxMeasurePhase1 xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasurePhase1 blk -> TxMeasurePhase1 (HardForkBlock xs))
-> WrapTxMeasurePhase1 blk -> TxMeasurePhase1 (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ TxMeasurePhase1 blk -> WrapTxMeasurePhase1 blk
forall blk. TxMeasurePhase1 blk -> WrapTxMeasurePhase1 blk
WrapTxMeasurePhase1 TxMeasurePhase1 blk
p1)
                (NS WrapTxMeasurePhase2 xs -> TxMeasurePhase2 (HardForkBlock xs)
NS WrapTxMeasurePhase2 xs -> HardForkTxMeasurePhase2 xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasurePhase2 xs -> HardForkTxMeasurePhase2 xs
hardForkInjTxMeasurePhase2 (NS WrapTxMeasurePhase2 xs -> TxMeasurePhase2 (HardForkBlock xs))
-> (WrapTxMeasurePhase2 blk -> NS WrapTxMeasurePhase2 xs)
-> WrapTxMeasurePhase2 blk
-> TxMeasurePhase2 (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk
-> WrapTxMeasurePhase2 blk -> NS WrapTxMeasurePhase2 xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasurePhase2 blk -> TxMeasurePhase2 (HardForkBlock xs))
-> WrapTxMeasurePhase2 blk -> TxMeasurePhase2 (HardForkBlock xs)
forall a b. (a -> b) -> a -> b
$ TxMeasurePhase2 blk -> WrapTxMeasurePhase2 blk
forall blk. TxMeasurePhase2 blk -> WrapTxMeasurePhase2 blk
WrapTxMeasurePhase2 TxMeasurePhase2 blk
p2)

  txMeasurePhase1 :: LedgerConfig (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) EmptyMK
-> GenTx (HardForkBlock xs)
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (TxMeasurePhase1 (HardForkBlock xs))
txMeasurePhase1
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState EmptyMK) xs
hardForkState)
    GenTx (HardForkBlock xs)
tx =
      case NS GenTx xs
-> HardForkState (FlipTickedLedgerState EmptyMK) xs
-> Either
     (MismatchEraInfo xs)
     (HardForkState (Product (FlipTickedLedgerState EmptyMK) GenTx) xs)
forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
NS GenTx xs
-> HardForkState f xs
-> Either (MismatchEraInfo xs) (HardForkState (Product f GenTx) xs)
matchTx (GenTx (HardForkBlock xs) -> NS GenTx xs
forall {xs :: [*]}. GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx GenTx (HardForkBlock xs)
tx) HardForkState (FlipTickedLedgerState EmptyMK) xs
hardForkState of
        Left{} -> HardForkTxMeasurePhase1 xs
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
forall a. a -> ExceptT (HardForkApplyTxErr xs) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HardForkTxMeasurePhase1 xs
forall a. Measure a => a
Measure.zero -- safe b/c the tx will be found invalid
        Right HardForkState (Product (FlipTickedLedgerState EmptyMK) GenTx) xs
pair -> HardForkState
  (K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)))
  xs
-> CollapseTo
     HardForkState
     (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState
   (K (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)))
   xs
 -> CollapseTo
      HardForkState
      (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)))
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)))
     xs
-> CollapseTo
     HardForkState
     (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapLedgerConfig a
    -> Product (FlipTickedLedgerState EmptyMK) GenTx a
    -> K (ExceptT
            (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
         a)
-> NP WrapLedgerConfig xs
-> HardForkState (Product (FlipTickedLedgerState EmptyMK) GenTx) xs
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)))
     xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith Proxy SingleEraBlock
proxySingle Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState EmptyMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
     a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState EmptyMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
     a
aux NP WrapLedgerConfig xs
cfgs HardForkState (Product (FlipTickedLedgerState EmptyMK) GenTx) xs
pair
     where
      pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
      ei :: EpochInfo (Except PastHorizonException)
ei =
        Shape xs
-> TransitionInfo
-> HardForkState (FlipTickedLedgerState EmptyMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
          Shape xs
hardForkLedgerConfigShape
          TransitionInfo
transition
          HardForkState (FlipTickedLedgerState EmptyMK) xs
hardForkState
      cfgs :: NP WrapLedgerConfig xs
cfgs = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialLedgerConfig xs
pcfgs

      unwrapTx :: GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx = OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx (OneEraGenTx xs -> NS GenTx xs)
-> (GenTx (HardForkBlock xs) -> OneEraGenTx xs)
-> GenTx (HardForkBlock xs)
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx

      aux ::
        forall blk.
        SingleEraBlock blk =>
        Index xs blk ->
        WrapLedgerConfig blk ->
        (Product (FlipTickedLedgerState EmptyMK) GenTx) blk ->
        K (Except (HardForkApplyTxErr xs) (HardForkTxMeasurePhase1 xs)) blk
      aux :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState EmptyMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
     a
aux Index xs blk
idx WrapLedgerConfig blk
cfg (Pair FlipTickedLedgerState EmptyMK blk
st' GenTx blk
tx') =
        ExceptT
  (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
     blk
forall k a (b :: k). a -> K a b
K
          (ExceptT
   (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
 -> K (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
      blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
     blk
forall a b. (a -> b) -> a -> b
$ (Either (ApplyTxErr blk) (TxMeasurePhase1 blk)
 -> Either (HardForkApplyTxErr xs) (HardForkTxMeasurePhase1 xs))
-> Except (ApplyTxErr blk) (TxMeasurePhase1 blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept
            ( ( OneEraApplyTxErr xs -> HardForkApplyTxErr xs
forall (xs :: [*]). OneEraApplyTxErr xs -> HardForkApplyTxErr xs
HardForkApplyTxErrFromEra
                  (OneEraApplyTxErr xs -> HardForkApplyTxErr xs)
-> (ApplyTxErr blk -> OneEraApplyTxErr xs)
-> ApplyTxErr blk
-> HardForkApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
forall (xs :: [*]). NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
OneEraApplyTxErr
                  (NS WrapApplyTxErr xs -> OneEraApplyTxErr xs)
-> (ApplyTxErr blk -> NS WrapApplyTxErr xs)
-> ApplyTxErr blk
-> OneEraApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapApplyTxErr blk -> NS WrapApplyTxErr xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx
                  (WrapApplyTxErr blk -> NS WrapApplyTxErr xs)
-> (ApplyTxErr blk -> WrapApplyTxErr blk)
-> ApplyTxErr blk
-> NS WrapApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr
              )
                (ApplyTxErr blk -> HardForkApplyTxErr xs)
-> (TxMeasurePhase1 blk -> HardForkTxMeasurePhase1 xs)
-> Either (ApplyTxErr blk) (TxMeasurePhase1 blk)
-> Either (HardForkApplyTxErr xs) (HardForkTxMeasurePhase1 xs)
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: MapKind) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ (NS WrapTxMeasurePhase1 xs -> HardForkTxMeasurePhase1 xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasurePhase1 xs -> HardForkTxMeasurePhase1 xs
hardForkInjTxMeasurePhase1 (NS WrapTxMeasurePhase1 xs -> HardForkTxMeasurePhase1 xs)
-> (TxMeasurePhase1 blk -> NS WrapTxMeasurePhase1 xs)
-> TxMeasurePhase1 blk
-> HardForkTxMeasurePhase1 xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk
-> WrapTxMeasurePhase1 blk -> NS WrapTxMeasurePhase1 xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasurePhase1 blk -> NS WrapTxMeasurePhase1 xs)
-> (TxMeasurePhase1 blk -> WrapTxMeasurePhase1 blk)
-> TxMeasurePhase1 blk
-> NS WrapTxMeasurePhase1 xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasurePhase1 blk -> WrapTxMeasurePhase1 blk
forall blk. TxMeasurePhase1 blk -> WrapTxMeasurePhase1 blk
WrapTxMeasurePhase1)
            )
          (Except (ApplyTxErr blk) (TxMeasurePhase1 blk)
 -> ExceptT
      (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs))
-> Except (ApplyTxErr blk) (TxMeasurePhase1 blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase1 xs)
forall a b. (a -> b) -> a -> b
$ LedgerConfig blk
-> TickedLedgerState blk EmptyMK
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasurePhase1 blk)
forall blk.
TxLimits blk =>
LedgerConfig blk
-> TickedLedgerState blk EmptyMK
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasurePhase1 blk)
txMeasurePhase1
            (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg)
            (FlipTickedLedgerState EmptyMK blk -> TickedLedgerState blk EmptyMK
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked LedgerState blk mk
getFlipTickedLedgerState FlipTickedLedgerState EmptyMK blk
st')
            GenTx blk
tx'

  txMeasurePhase2 :: LedgerConfig (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> GenTx (HardForkBlock xs)
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (TxMeasurePhase2 (HardForkBlock xs))
txMeasurePhase2
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState)
    GenTx (HardForkBlock xs)
tx =
      case NS GenTx xs
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> Either
     (MismatchEraInfo xs)
     (HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs)
forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
NS GenTx xs
-> HardForkState f xs
-> Either (MismatchEraInfo xs) (HardForkState (Product f GenTx) xs)
matchTx (GenTx (HardForkBlock xs) -> NS GenTx xs
forall {xs :: [*]}. GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx GenTx (HardForkBlock xs)
tx) HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState of
        Left{} -> HardForkTxMeasurePhase2 xs
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
forall a. a -> ExceptT (HardForkApplyTxErr xs) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HardForkTxMeasurePhase2 xs
forall a. Measure a => a
Measure.zero -- safe b/c the tx will be found invalid
        Right HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
pair -> HardForkState
  (K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)))
  xs
-> CollapseTo
     HardForkState
     (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState
   (K (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)))
   xs
 -> CollapseTo
      HardForkState
      (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)))
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)))
     xs
-> CollapseTo
     HardForkState
     (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapLedgerConfig a
    -> Product (FlipTickedLedgerState ValuesMK) GenTx a
    -> K (ExceptT
            (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
         a)
-> NP WrapLedgerConfig xs
-> HardForkState
     (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)))
     xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith Proxy SingleEraBlock
proxySingle Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
     a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
     a
aux NP WrapLedgerConfig xs
cfgs HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
pair
     where
      pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
      ei :: EpochInfo (Except PastHorizonException)
ei =
        Shape xs
-> TransitionInfo
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
          Shape xs
hardForkLedgerConfigShape
          TransitionInfo
transition
          HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState
      cfgs :: NP WrapLedgerConfig xs
cfgs = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialLedgerConfig xs
pcfgs

      unwrapTx :: GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx = OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx (OneEraGenTx xs -> NS GenTx xs)
-> (GenTx (HardForkBlock xs) -> OneEraGenTx xs)
-> GenTx (HardForkBlock xs)
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx

      aux ::
        forall blk.
        SingleEraBlock blk =>
        Index xs blk ->
        WrapLedgerConfig blk ->
        (Product (FlipTickedLedgerState ValuesMK) GenTx) blk ->
        K (Except (HardForkApplyTxErr xs) (HardForkTxMeasurePhase2 xs)) blk
      aux :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
     a
aux Index xs blk
idx WrapLedgerConfig blk
cfg (Pair FlipTickedLedgerState ValuesMK blk
st' GenTx blk
tx') =
        ExceptT
  (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
     blk
forall k a (b :: k). a -> K a b
K
          (ExceptT
   (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
 -> K (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
      blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
     blk
forall a b. (a -> b) -> a -> b
$ (Either (ApplyTxErr blk) (TxMeasurePhase2 blk)
 -> Either (HardForkApplyTxErr xs) (HardForkTxMeasurePhase2 xs))
-> Except (ApplyTxErr blk) (TxMeasurePhase2 blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept
            ( ( OneEraApplyTxErr xs -> HardForkApplyTxErr xs
forall (xs :: [*]). OneEraApplyTxErr xs -> HardForkApplyTxErr xs
HardForkApplyTxErrFromEra
                  (OneEraApplyTxErr xs -> HardForkApplyTxErr xs)
-> (ApplyTxErr blk -> OneEraApplyTxErr xs)
-> ApplyTxErr blk
-> HardForkApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
forall (xs :: [*]). NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
OneEraApplyTxErr
                  (NS WrapApplyTxErr xs -> OneEraApplyTxErr xs)
-> (ApplyTxErr blk -> NS WrapApplyTxErr xs)
-> ApplyTxErr blk
-> OneEraApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapApplyTxErr blk -> NS WrapApplyTxErr xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx
                  (WrapApplyTxErr blk -> NS WrapApplyTxErr xs)
-> (ApplyTxErr blk -> WrapApplyTxErr blk)
-> ApplyTxErr blk
-> NS WrapApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr
              )
                (ApplyTxErr blk -> HardForkApplyTxErr xs)
-> (TxMeasurePhase2 blk -> HardForkTxMeasurePhase2 xs)
-> Either (ApplyTxErr blk) (TxMeasurePhase2 blk)
-> Either (HardForkApplyTxErr xs) (HardForkTxMeasurePhase2 xs)
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: MapKind) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ (NS WrapTxMeasurePhase2 xs -> HardForkTxMeasurePhase2 xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasurePhase2 xs -> HardForkTxMeasurePhase2 xs
hardForkInjTxMeasurePhase2 (NS WrapTxMeasurePhase2 xs -> HardForkTxMeasurePhase2 xs)
-> (TxMeasurePhase2 blk -> NS WrapTxMeasurePhase2 xs)
-> TxMeasurePhase2 blk
-> HardForkTxMeasurePhase2 xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk
-> WrapTxMeasurePhase2 blk -> NS WrapTxMeasurePhase2 xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasurePhase2 blk -> NS WrapTxMeasurePhase2 xs)
-> (TxMeasurePhase2 blk -> WrapTxMeasurePhase2 blk)
-> TxMeasurePhase2 blk
-> NS WrapTxMeasurePhase2 xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasurePhase2 blk -> WrapTxMeasurePhase2 blk
forall blk. TxMeasurePhase2 blk -> WrapTxMeasurePhase2 blk
WrapTxMeasurePhase2)
            )
          (Except (ApplyTxErr blk) (TxMeasurePhase2 blk)
 -> ExceptT
      (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs))
-> Except (ApplyTxErr blk) (TxMeasurePhase2 blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (HardForkTxMeasurePhase2 xs)
forall a b. (a -> b) -> a -> b
$ LedgerConfig blk
-> TickedLedgerState blk ValuesMK
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasurePhase2 blk)
forall blk.
TxLimits blk =>
LedgerConfig blk
-> TickedLedgerState blk ValuesMK
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasurePhase2 blk)
txMeasurePhase2
            (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg)
            (FlipTickedLedgerState ValuesMK blk
-> TickedLedgerState blk ValuesMK
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked LedgerState blk mk
getFlipTickedLedgerState FlipTickedLedgerState ValuesMK blk
st')
            GenTx blk
tx'

-- | A private type used only to clarify the definition of 'applyHelper'
data ApplyResult xs blk = ApplyResult
  { forall (xs :: [*]) blk.
ApplyResult xs blk -> Ticked LedgerState blk DiffMK
arState :: Ticked LedgerState blk DiffMK
  , forall (xs :: [*]) blk.
ApplyResult xs blk -> Validated (GenTx (HardForkBlock xs))
arValidatedTx :: Validated (GenTx (HardForkBlock xs))
  }

-- | The shared logic between 'applyTx' and 'reapplyTx' for 'HardForkBlock'
--
-- The @txIn@ variable is 'GenTx' or 'WrapValidatedGenTx', respectively. See
-- 'ApplyHelperMode'.
applyHelper ::
  forall xs.
  CanHardFork xs =>
  LedgerConfig (HardForkBlock xs) ->
  WhetherToIntervene ->
  SlotNo ->
  GenTx (HardForkBlock xs) ->
  TickedLedgerState (HardForkBlock xs) ValuesMK ->
  Except
    (HardForkApplyTxErr xs)
    ( TickedLedgerState (HardForkBlock xs) DiffMK
    , Validated (GenTx (HardForkBlock xs))
    )
applyHelper :: forall (xs :: [*]).
CanHardFork xs =>
LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs) ValuesMK
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
applyHelper
  HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
  WhetherToIntervene
wti
  SlotNo
slot
  GenTx (HardForkBlock xs)
tx
  (TickedHardForkLedgerState TransitionInfo
transition HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState) =
    case NS GenTx xs
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> Either
     (MismatchEraInfo xs)
     (HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs)
forall (xs :: [*]) (f :: * -> *).
All SingleEraBlock xs =>
NS GenTx xs
-> HardForkState f xs
-> Either (MismatchEraInfo xs) (HardForkState (Product f GenTx) xs)
matchTx (GenTx (HardForkBlock xs) -> NS GenTx xs
forall {xs :: [*]}. GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx GenTx (HardForkBlock xs)
tx) HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState of
      Left MismatchEraInfo xs
mismatch -> HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
forall a.
HardForkApplyTxErr xs -> ExceptT (HardForkApplyTxErr xs) Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HardForkApplyTxErr xs
 -> Except
      (HardForkApplyTxErr xs)
      (TickedLedgerState (HardForkBlock xs) DiffMK,
       Validated (GenTx (HardForkBlock xs))))
-> HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs) DiffMK,
      Validated (GenTx (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs -> HardForkApplyTxErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra MismatchEraInfo xs
mismatch
      Right HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
matched ->
        -- We are updating the ticked ledger state by applying a transaction,
        -- but for the HFC that ledger state contains a bundled
        -- 'TransitionInfo'. We don't change that 'TransitionInfo' here, which
        -- requires justification. Three cases:
        --
        -- o 'TransitionUnknown'. Transitions become known only when the
        --    transaction that confirms them becomes stable, so this cannot
        --    happen simply by applying a transaction. In this case we record
        --    the tip of the ledger, which is also not changed halfway a block.
        -- o 'TransitionKnown'. In this case, we record the 'EpochNo' of the
        --    epoch that starts the new era; this information similarly won't
        --    halfway a block (it can only change, in fact, when we do transition
        --    to that new era).
        -- o 'TransitionImpossible'. Two subcases: we are in the final era (in
        --    which we will remain to be) or we are forecasting, which is not
        --    applicable here.
        do
          result <-
            HardForkState
  (ExceptT (HardForkApplyTxErr xs) Identity :.: ApplyResult xs) xs
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (ApplyResult xs) xs)
forall (xs :: [*]) (f :: * -> *) (g :: * -> *).
(SListIN HardForkState xs, Applicative f) =>
HardForkState (f :.: g) xs -> f (HardForkState 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' (HardForkState
   (ExceptT (HardForkApplyTxErr xs) Identity :.: ApplyResult xs) xs
 -> ExceptT
      (HardForkApplyTxErr xs)
      Identity
      (HardForkState (ApplyResult xs) xs))
-> HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity :.: ApplyResult xs) xs
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (ApplyResult xs) xs)
forall a b. (a -> b) -> a -> b
$
              Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapLedgerConfig a
    -> Product (FlipTickedLedgerState ValuesMK) GenTx a
    -> (:.:)
         (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a)
-> NP WrapLedgerConfig xs
-> HardForkState
     (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
-> HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity :.: ApplyResult xs) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *) (f3 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a -> f3 a)
-> NP f1 xs
-> h f2 xs
-> h f3 xs
hcizipWith Proxy SingleEraBlock
proxySingle Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
modeApplyCurrent NP WrapLedgerConfig xs
cfgs HardForkState (Product (FlipTickedLedgerState ValuesMK) GenTx) xs
matched
          let _ = result :: State.HardForkState (ApplyResult xs) xs

              st' :: State.HardForkState (FlipTickedLedgerState DiffMK) xs
              st' = (Ticked LedgerState a DiffMK -> FlipTickedLedgerState DiffMK a
forall (mk :: MapKind) blk.
Ticked LedgerState blk mk -> FlipTickedLedgerState mk blk
FlipTickedLedgerState (Ticked LedgerState a DiffMK -> FlipTickedLedgerState DiffMK a)
-> (ApplyResult xs a -> Ticked LedgerState a DiffMK)
-> ApplyResult xs a
-> FlipTickedLedgerState DiffMK a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyResult xs a -> Ticked LedgerState a DiffMK
forall (xs :: [*]) blk.
ApplyResult xs blk -> Ticked LedgerState blk DiffMK
arState) (forall {a}. ApplyResult xs a -> FlipTickedLedgerState DiffMK a)
-> HardForkState (ApplyResult xs) xs
-> HardForkState (FlipTickedLedgerState DiffMK) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
`hmap` HardForkState (ApplyResult xs) xs
result

              vtx :: Validated (GenTx (HardForkBlock xs))
              vtx = HardForkState (K (Validated (GenTx (HardForkBlock xs)))) xs
-> CollapseTo HardForkState (Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]) a.
SListIN HardForkState xs =>
HardForkState (K a) xs -> CollapseTo HardForkState a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (HardForkState (K (Validated (GenTx (HardForkBlock xs)))) xs
 -> CollapseTo HardForkState (Validated (GenTx (HardForkBlock xs))))
-> HardForkState (K (Validated (GenTx (HardForkBlock xs)))) xs
-> CollapseTo HardForkState (Validated (GenTx (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ (Validated (GenTx (HardForkBlock xs))
-> K (Validated (GenTx (HardForkBlock xs))) a
forall k a (b :: k). a -> K a b
K (Validated (GenTx (HardForkBlock xs))
 -> K (Validated (GenTx (HardForkBlock xs))) a)
-> (ApplyResult xs a -> Validated (GenTx (HardForkBlock xs)))
-> ApplyResult xs a
-> K (Validated (GenTx (HardForkBlock xs))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyResult xs a -> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]) blk.
ApplyResult xs blk -> Validated (GenTx (HardForkBlock xs))
arValidatedTx) (forall {a}.
 ApplyResult xs a -> K (Validated (GenTx (HardForkBlock xs))) a)
-> HardForkState (ApplyResult xs) xs
-> HardForkState (K (Validated (GenTx (HardForkBlock xs)))) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *).
(SListIN (Prod h) xs, HAp h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
`hmap` HardForkState (ApplyResult xs) xs
result

          return (TickedHardForkLedgerState transition st', vtx)
   where
    pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
    cfgs :: NP WrapLedgerConfig xs
cfgs = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo (Except PastHorizonException)
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo (Except PastHorizonException)
ei) NP WrapPartialLedgerConfig xs
pcfgs
    ei :: EpochInfo (Except PastHorizonException)
ei =
      Shape xs
-> TransitionInfo
-> HardForkState (FlipTickedLedgerState ValuesMK) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
        Shape xs
hardForkLedgerConfigShape
        TransitionInfo
transition
        HardForkState (FlipTickedLedgerState ValuesMK) xs
hardForkState

    unwrapTx :: GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx = OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx (OneEraGenTx xs -> NS GenTx xs)
-> (GenTx (HardForkBlock xs) -> OneEraGenTx xs)
-> GenTx (HardForkBlock xs)
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx

    modeApplyCurrent ::
      forall blk.
      SingleEraBlock blk =>
      Index xs blk ->
      WrapLedgerConfig blk ->
      Product (FlipTickedLedgerState ValuesMK) GenTx blk ->
      ( Except (HardForkApplyTxErr xs)
          :.: ApplyResult xs
      )
        blk
    modeApplyCurrent :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product (FlipTickedLedgerState ValuesMK) GenTx a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
modeApplyCurrent Index xs blk
index WrapLedgerConfig blk
cfg (Pair (FlipTickedLedgerState Ticked LedgerState blk ValuesMK
st) GenTx blk
tx') =
      Except (HardForkApplyTxErr xs) (ApplyResult xs blk)
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Except (HardForkApplyTxErr xs) (ApplyResult xs blk)
 -> (:.:)
      (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) blk)
-> Except (HardForkApplyTxErr xs) (ApplyResult xs blk)
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) blk
forall a b. (a -> b) -> a -> b
$ (ApplyTxErr blk -> HardForkApplyTxErr xs)
-> Except (ApplyTxErr blk) (ApplyResult xs blk)
-> Except (HardForkApplyTxErr xs) (ApplyResult xs blk)
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Index xs blk
index) (Except (ApplyTxErr blk) (ApplyResult xs blk)
 -> Except (HardForkApplyTxErr xs) (ApplyResult xs blk))
-> Except (ApplyTxErr blk) (ApplyResult xs blk)
-> Except (HardForkApplyTxErr xs) (ApplyResult xs blk)
forall a b. (a -> b) -> a -> b
$ do
        let lcfg :: LedgerConfig blk
lcfg = WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg
        (st', vtx) <- LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked LedgerState blk ValuesMK
-> ExceptT
     (ApplyTxErr blk)
     Identity
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerConfig blk
lcfg WhetherToIntervene
wti SlotNo
slot GenTx blk
tx' Ticked LedgerState blk ValuesMK
st
        pure
          ApplyResult
            { arValidatedTx = injectValidatedGenTx index vtx
            , arState = st'
            }

newtype instance TxId (GenTx (HardForkBlock xs)) = HardForkGenTxId
  { forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId :: OneEraGenTxId xs
  }
  deriving (TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
(TxId (GenTx (HardForkBlock xs))
 -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> Eq (TxId (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
== :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
$c/= :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
/= :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
Eq, (forall x.
 TxId (GenTx (HardForkBlock xs))
 -> Rep (TxId (GenTx (HardForkBlock xs))) x)
-> (forall x.
    Rep (TxId (GenTx (HardForkBlock xs))) x
    -> TxId (GenTx (HardForkBlock xs)))
-> Generic (TxId (GenTx (HardForkBlock xs)))
forall (xs :: [*]) x.
Rep (TxId (GenTx (HardForkBlock xs))) x
-> TxId (GenTx (HardForkBlock xs))
forall (xs :: [*]) x.
TxId (GenTx (HardForkBlock xs))
-> Rep (TxId (GenTx (HardForkBlock xs))) x
forall x.
Rep (TxId (GenTx (HardForkBlock xs))) x
-> TxId (GenTx (HardForkBlock xs))
forall x.
TxId (GenTx (HardForkBlock xs))
-> Rep (TxId (GenTx (HardForkBlock xs))) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (xs :: [*]) x.
TxId (GenTx (HardForkBlock xs))
-> Rep (TxId (GenTx (HardForkBlock xs))) x
from :: forall x.
TxId (GenTx (HardForkBlock xs))
-> Rep (TxId (GenTx (HardForkBlock xs))) x
$cto :: forall (xs :: [*]) x.
Rep (TxId (GenTx (HardForkBlock xs))) x
-> TxId (GenTx (HardForkBlock xs))
to :: forall x.
Rep (TxId (GenTx (HardForkBlock xs))) x
-> TxId (GenTx (HardForkBlock xs))
Generic, Eq (TxId (GenTx (HardForkBlock xs)))
Eq (TxId (GenTx (HardForkBlock xs))) =>
(TxId (GenTx (HardForkBlock xs))
 -> TxId (GenTx (HardForkBlock xs)) -> Ordering)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)) -> Bool)
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)))
-> (TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs))
    -> TxId (GenTx (HardForkBlock xs)))
-> Ord (TxId (GenTx (HardForkBlock xs)))
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
forall (xs :: [*]).
CanHardFork xs =>
Eq (TxId (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
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
$ccompare :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
compare :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
$c< :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
< :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
$c<= :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
<= :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
$c> :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
> :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
$c>= :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
>= :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
$cmax :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
max :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
$cmin :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
min :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
Ord, Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS
[TxId (GenTx (HardForkBlock xs))] -> ShowS
TxId (GenTx (HardForkBlock xs)) -> String
(Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS)
-> (TxId (GenTx (HardForkBlock xs)) -> String)
-> ([TxId (GenTx (HardForkBlock xs))] -> ShowS)
-> Show (TxId (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
[TxId (GenTx (HardForkBlock xs))] -> ShowS
forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs)) -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS
showsPrec :: Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs)) -> String
show :: TxId (GenTx (HardForkBlock xs)) -> String
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[TxId (GenTx (HardForkBlock xs))] -> ShowS
showList :: [TxId (GenTx (HardForkBlock xs))] -> ShowS
Show)
  deriving anyclass Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx (HardForkBlock xs))) -> String
(Context
 -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo))
-> (Context
    -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx (HardForkBlock xs))) -> String)
-> NoThunks (TxId (GenTx (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
forall (xs :: [*]).
CanHardFork xs =>
Proxy (TxId (GenTx (HardForkBlock xs))) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (TxId (GenTx (HardForkBlock xs))) -> String
showTypeOf :: Proxy (TxId (GenTx (HardForkBlock xs))) -> String
NoThunks

instance Typeable xs => ShowProxy (TxId (GenTx (HardForkBlock xs)))

instance CanHardFork xs => HasTxId (GenTx (HardForkBlock xs)) where
  txId :: GenTx (HardForkBlock xs) -> TxId (GenTx (HardForkBlock xs))
txId =
    OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
forall (xs :: [*]).
OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs))
HardForkGenTxId
      (OneEraGenTxId xs -> TxId (GenTx (HardForkBlock xs)))
-> (GenTx (HardForkBlock xs) -> OneEraGenTxId xs)
-> GenTx (HardForkBlock xs)
-> TxId (GenTx (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapGenTxId xs -> OneEraGenTxId xs
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
OneEraGenTxId
      (NS WrapGenTxId xs -> OneEraGenTxId xs)
-> (GenTx (HardForkBlock xs) -> NS WrapGenTxId xs)
-> GenTx (HardForkBlock xs)
-> OneEraGenTxId xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => GenTx a -> WrapGenTxId a)
-> NS GenTx xs
-> NS WrapGenTxId xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (GenTxId a -> WrapGenTxId a
forall blk. GenTxId blk -> WrapGenTxId blk
WrapGenTxId (GenTxId a -> WrapGenTxId a)
-> (GenTx a -> GenTxId a) -> GenTx a -> WrapGenTxId a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx a -> GenTxId a
forall tx. HasTxId tx => tx -> TxId tx
txId)
      (NS GenTx xs -> NS WrapGenTxId xs)
-> (GenTx (HardForkBlock xs) -> NS GenTx xs)
-> GenTx (HardForkBlock xs)
-> NS WrapGenTxId xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx
      (OneEraGenTx xs -> NS GenTx xs)
-> (GenTx (HardForkBlock xs) -> OneEraGenTx xs)
-> GenTx (HardForkBlock xs)
-> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx

instance CanHardFork xs => HasRawTxId (TxId (GenTx (HardForkBlock xs))) where
  type RawTxId (TxId (GenTx (HardForkBlock xs))) = ShortByteString
  getRawTxId :: TxId (GenTx (HardForkBlock xs))
-> RawTxId (TxId (GenTx (HardForkBlock xs)))
getRawTxId = NS WrapGenTxId xs -> ShortByteString
forall (xs :: [*]).
All SingleEraBlock xs =>
NS WrapGenTxId xs -> ShortByteString
rawHashNS (NS WrapGenTxId xs -> ShortByteString)
-> (TxId (GenTx (HardForkBlock xs)) -> NS WrapGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraGenTxId xs -> NS WrapGenTxId xs
forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs
getOneEraGenTxId (OneEraGenTxId xs -> NS WrapGenTxId xs)
-> (TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> NS WrapGenTxId xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId

{-------------------------------------------------------------------------------
  HasTxs

  This is not required by consensus itself, but is required by RunNode.
-------------------------------------------------------------------------------}

instance All HasTxs xs => HasTxs (HardForkBlock xs) where
  extractTxs :: HardForkBlock xs -> [GenTx (HardForkBlock xs)]
extractTxs =
    NS (K [GenTx (HardForkBlock xs)]) xs -> [GenTx (HardForkBlock xs)]
NS (K [GenTx (HardForkBlock xs)]) xs
-> CollapseTo NS [GenTx (HardForkBlock xs)]
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K [GenTx (HardForkBlock xs)]) xs
 -> [GenTx (HardForkBlock xs)])
-> (HardForkBlock xs -> NS (K [GenTx (HardForkBlock xs)]) xs)
-> HardForkBlock xs
-> [GenTx (HardForkBlock xs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy HasTxs
-> (forall a.
    HasTxs a =>
    Index xs a -> I a -> K [GenTx (HardForkBlock xs)] a)
-> NS I xs
-> NS (K [GenTx (HardForkBlock xs)]) xs
forall {k} (h :: (k -> *) -> [k] -> *) (c :: k -> Constraint)
       (xs :: [k]) (proxy :: (k -> Constraint) -> *) (f1 :: k -> *)
       (f2 :: k -> *).
(HAp h, All c xs, Prod h ~ NP) =>
proxy c
-> (forall (a :: k). c a => Index xs a -> f1 a -> f2 a)
-> h f1 xs
-> h f2 xs
hcimap (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @HasTxs) Index xs a -> I a -> K [GenTx (HardForkBlock xs)] a
forall a.
HasTxs a =>
Index xs a -> I a -> K [GenTx (HardForkBlock xs)] a
aux
      (NS I xs -> NS (K [GenTx (HardForkBlock xs)]) xs)
-> (HardForkBlock xs -> NS I xs)
-> HardForkBlock xs
-> NS (K [GenTx (HardForkBlock xs)]) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraBlock xs -> NS I xs
forall (xs :: [*]). OneEraBlock xs -> NS I xs
getOneEraBlock
      (OneEraBlock xs -> NS I xs)
-> (HardForkBlock xs -> OneEraBlock xs)
-> HardForkBlock xs
-> NS I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkBlock xs -> OneEraBlock xs
forall (xs :: [*]). HardForkBlock xs -> OneEraBlock xs
getHardForkBlock
   where
    aux ::
      HasTxs blk =>
      Index xs blk ->
      I blk ->
      K [GenTx (HardForkBlock xs)] blk
    aux :: forall a.
HasTxs a =>
Index xs a -> I a -> K [GenTx (HardForkBlock xs)] a
aux Index xs blk
index = [GenTx (HardForkBlock xs)] -> K [GenTx (HardForkBlock xs)] blk
forall k a (b :: k). a -> K a b
K ([GenTx (HardForkBlock xs)] -> K [GenTx (HardForkBlock xs)] blk)
-> (I blk -> [GenTx (HardForkBlock xs)])
-> I blk
-> K [GenTx (HardForkBlock xs)] blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenTx blk -> GenTx (HardForkBlock xs))
-> [GenTx blk] -> [GenTx (HardForkBlock xs)]
forall a b. (a -> b) -> [a] -> [b]
map (Proxy GenTx
-> Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
forall {k} (f :: k -> *) a b (x :: k) (xs :: [k]).
(All Top xs, Coercible a (f x), Coercible b (NS f xs)) =>
Proxy f -> Index xs x -> a -> b
injectNS' (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) Index xs blk
index) ([GenTx blk] -> [GenTx (HardForkBlock xs)])
-> (I blk -> [GenTx blk]) -> I blk -> [GenTx (HardForkBlock xs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. blk -> [GenTx blk]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs (blk -> [GenTx blk]) -> (I blk -> blk) -> I blk -> [GenTx blk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I blk -> blk
forall a. I a -> a
unI

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

injectApplyTxErr :: SListI xs => Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr :: forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Index xs blk
index =
  OneEraApplyTxErr xs -> HardForkApplyTxErr xs
forall (xs :: [*]). OneEraApplyTxErr xs -> HardForkApplyTxErr xs
HardForkApplyTxErrFromEra
    (OneEraApplyTxErr xs -> HardForkApplyTxErr xs)
-> (ApplyTxErr blk -> OneEraApplyTxErr xs)
-> ApplyTxErr blk
-> HardForkApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
forall (xs :: [*]). NS WrapApplyTxErr xs -> OneEraApplyTxErr xs
OneEraApplyTxErr
    (NS WrapApplyTxErr xs -> OneEraApplyTxErr xs)
-> (ApplyTxErr blk -> NS WrapApplyTxErr xs)
-> ApplyTxErr blk
-> OneEraApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapApplyTxErr blk -> NS WrapApplyTxErr xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index
    (WrapApplyTxErr blk -> NS WrapApplyTxErr xs)
-> (ApplyTxErr blk -> WrapApplyTxErr blk)
-> ApplyTxErr blk
-> NS WrapApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr

injectValidatedGenTx ::
  SListI xs => Index xs blk -> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
injectValidatedGenTx :: forall (xs :: [*]) blk.
SListI xs =>
Index xs blk
-> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
injectValidatedGenTx Index xs blk
index =
  OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]).
OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs))
HardForkValidatedGenTx
    (OneEraValidatedGenTx xs -> Validated (GenTx (HardForkBlock xs)))
-> (Validated (GenTx blk) -> OneEraValidatedGenTx xs)
-> Validated (GenTx blk)
-> Validated (GenTx (HardForkBlock xs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
forall (xs :: [*]).
NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs
OneEraValidatedGenTx
    (NS WrapValidatedGenTx xs -> OneEraValidatedGenTx xs)
-> (Validated (GenTx blk) -> NS WrapValidatedGenTx xs)
-> Validated (GenTx blk)
-> OneEraValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index
    (WrapValidatedGenTx blk -> NS WrapValidatedGenTx xs)
-> (Validated (GenTx blk) -> WrapValidatedGenTx blk)
-> Validated (GenTx blk)
-> NS WrapValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> WrapValidatedGenTx blk
forall blk. Validated (GenTx blk) -> WrapValidatedGenTx blk
WrapValidatedGenTx

injectGenTx ::
  SListI xs => Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
injectGenTx :: forall (xs :: [*]) blk.
SListI xs =>
Index xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
injectGenTx Index xs blk
index =
  OneEraGenTx xs -> GenTx (HardForkBlock xs)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
HardForkGenTx
    (OneEraGenTx xs -> GenTx (HardForkBlock xs))
-> (GenTx blk -> OneEraGenTx xs)
-> GenTx blk
-> GenTx (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS GenTx xs -> OneEraGenTx xs
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
OneEraGenTx
    (NS GenTx xs -> OneEraGenTx xs)
-> (GenTx blk -> NS GenTx xs) -> GenTx blk -> OneEraGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> GenTx blk -> NS GenTx xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
All Top xs =>
Index xs x -> f x -> NS f xs
injectNS Index xs blk
index