{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# 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.Functor.Product
import           Data.Kind (Type)
import qualified Data.Measure as Measure
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Functors (Product2 (..))
import           Data.SOP.Index
import           Data.SOP.InPairs (InPairs)
import qualified Data.SOP.InPairs as InPairs
import qualified Data.SOP.Match as Match
import           Data.SOP.Strict
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.Info
import           Ouroboros.Consensus.HardFork.Combinator.InjectTxs
import           Ouroboros.Consensus.HardFork.Combinator.Ledger (Ticked (..))
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
                     (WrapPartialLedgerConfig (..))
import qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util (ShowProxy)

data HardForkApplyTxErr xs =
    -- | Validation error from one of the eras
    HardForkApplyTxErrFromEra !(OneEraApplyTxErr xs)

    -- | We tried to apply a block 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) where

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)) where

type instance ApplyTxErr (HardForkBlock xs) = HardForkApplyTxErr xs

instance CanHardFork xs => LedgerSupportsMempool (HardForkBlock xs) where
  applyTx :: LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
applyTx   = ApplyHelperMode GenTx
-> LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (HardForkApplyTxErr xs)
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]) (txIn :: * -> *).
CanHardFork xs =>
ApplyHelperMode txIn
-> LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> txIn (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      Validated (GenTx (HardForkBlock xs)))
applyHelper ApplyHelperMode GenTx
ModeApply

  reapplyTx :: HasCallStack =>
LedgerConfig (HardForkBlock xs)
-> SlotNo
-> Validated (GenTx (HardForkBlock xs))
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)))
reapplyTx = \LedgerConfig (HardForkBlock xs)
cfg SlotNo
slot Validated (GenTx (HardForkBlock xs))
vtx Ticked (LedgerState (HardForkBlock xs))
tls ->
        ((Ticked (LedgerState (HardForkBlock xs)),
  Validated (GenTx (HardForkBlock xs)))
 -> Ticked (LedgerState (HardForkBlock xs)))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)))
forall a b.
(a -> b)
-> ExceptT (ApplyTxErr (HardForkBlock xs)) Identity a
-> ExceptT (ApplyTxErr (HardForkBlock xs)) Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Ticked (LedgerState (HardForkBlock xs))
tls', Validated (GenTx (HardForkBlock xs))
_vtx) -> Ticked (LedgerState (HardForkBlock xs))
tls')
      (Except
   (ApplyTxErr (HardForkBlock xs))
   (Ticked (LedgerState (HardForkBlock xs)),
    Validated (GenTx (HardForkBlock xs)))
 -> Except
      (ApplyTxErr (HardForkBlock xs))
      (Ticked (LedgerState (HardForkBlock xs))))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ ApplyHelperMode WrapValidatedGenTx
-> LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> WrapValidatedGenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (HardForkApplyTxErr xs)
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
forall (xs :: [*]) (txIn :: * -> *).
CanHardFork xs =>
ApplyHelperMode txIn
-> LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> txIn (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      Validated (GenTx (HardForkBlock xs)))
applyHelper
          ApplyHelperMode WrapValidatedGenTx
ModeReapply
          LedgerConfig (HardForkBlock xs)
cfg
          WhetherToIntervene
DoNotIntervene
          SlotNo
slot
          (Validated (GenTx (HardForkBlock xs))
-> WrapValidatedGenTx (HardForkBlock xs)
forall blk. Validated (GenTx blk) -> WrapValidatedGenTx blk
WrapValidatedGenTx Validated (GenTx (HardForkBlock xs))
vtx)
          Ticked (LedgerState (HardForkBlock xs))
tls

  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

instance CanHardFork xs => TxLimits (HardForkBlock xs) where
  type TxMeasure (HardForkBlock xs) = HardForkTxMeasure xs

  blockCapacityTxMeasure :: LedgerConfig (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> TxMeasure (HardForkBlock xs)
blockCapacityTxMeasure
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
..}
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (Ticked :.: LedgerState) xs
hardForkState)
      =
        HardForkState (K (HardForkTxMeasure xs)) xs
-> CollapseTo HardForkState (HardForkTxMeasure 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 (HardForkTxMeasure xs)) xs
 -> CollapseTo HardForkState (HardForkTxMeasure xs))
-> HardForkState (K (HardForkTxMeasure xs)) xs
-> CollapseTo HardForkState (HardForkTxMeasure xs)
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapPartialLedgerConfig a
    -> (:.:) Ticked LedgerState a
    -> K (HardForkTxMeasure xs) a)
-> NP WrapPartialLedgerConfig xs
-> HardForkState (Ticked :.: LedgerState) xs
-> HardForkState (K (HardForkTxMeasure 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
-> (:.:) Ticked LedgerState a
-> K (HardForkTxMeasure xs) a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapPartialLedgerConfig a
-> (:.:) Ticked LedgerState a
-> K (HardForkTxMeasure xs) a
aux NP WrapPartialLedgerConfig xs
pcfgs HardForkState (Ticked :.: LedgerState) 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 (Ticked :.: LedgerState) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
                Shape xs
hardForkLedgerConfigShape
                TransitionInfo
transition
                HardForkState (Ticked :.: LedgerState) xs
hardForkState

      aux ::
           SingleEraBlock blk
        => Index xs blk
        -> WrapPartialLedgerConfig blk
        -> (Ticked :.: LedgerState) blk
        -> K (HardForkTxMeasure xs) blk
      aux :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapPartialLedgerConfig a
-> (:.:) Ticked LedgerState a
-> K (HardForkTxMeasure xs) a
aux Index xs blk
idx WrapPartialLedgerConfig blk
pcfg (:.:) Ticked LedgerState blk
st' =
          HardForkTxMeasure xs -> K (HardForkTxMeasure xs) blk
forall k a (b :: k). a -> K a b
K
        (HardForkTxMeasure xs -> K (HardForkTxMeasure xs) blk)
-> HardForkTxMeasure xs -> K (HardForkTxMeasure xs) blk
forall a b. (a -> b) -> a -> b
$ NS WrapTxMeasure xs -> HardForkTxMeasure xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasure xs -> HardForkTxMeasure xs
hardForkInjTxMeasure (NS WrapTxMeasure xs -> HardForkTxMeasure xs)
-> (TxMeasure blk -> NS WrapTxMeasure xs)
-> TxMeasure blk
-> HardForkTxMeasure xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapTxMeasure blk -> NS WrapTxMeasure xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasure blk -> NS WrapTxMeasure xs)
-> (TxMeasure blk -> WrapTxMeasure blk)
-> TxMeasure blk
-> NS WrapTxMeasure xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasure blk -> WrapTxMeasure blk
forall blk. TxMeasure blk -> WrapTxMeasure blk
WrapTxMeasure
        (TxMeasure blk -> HardForkTxMeasure xs)
-> TxMeasure blk -> HardForkTxMeasure xs
forall a b. (a -> b) -> a -> b
$ LedgerConfig blk -> TickedLedgerState blk -> TxMeasure blk
forall blk.
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk -> 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)
            ((:.:) Ticked LedgerState blk -> TickedLedgerState blk
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp (:.:) Ticked LedgerState blk
st')

  txMeasure :: LedgerConfig (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> GenTx (HardForkBlock xs)
-> Except
     (ApplyTxErr (HardForkBlock xs)) (TxMeasure (HardForkBlock xs))
txMeasure
    HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
    (TickedHardForkLedgerState TransitionInfo
transition HardForkState (Ticked :.: LedgerState) xs
hardForkState)
    GenTx (HardForkBlock xs)
tx
      =
        case InPairs InjectTx xs
-> NS GenTx xs
-> HardForkState (Ticked :.: LedgerState) xs
-> Either
     (Mismatch GenTx (Current (Ticked :.: LedgerState)) xs)
     (HardForkState (Product GenTx (Ticked :.: LedgerState)) xs)
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
InPairs InjectTx xs
-> NS GenTx xs
-> HardForkState f xs
-> Either
     (Mismatch GenTx (Current f) xs)
     (HardForkState (Product GenTx f) xs)
matchTx InPairs InjectTx xs
injs (GenTx (HardForkBlock xs) -> NS GenTx xs
forall {xs :: [*]}. GenTx (HardForkBlock xs) -> NS GenTx xs
unwrapTx GenTx (HardForkBlock xs)
tx) HardForkState (Ticked :.: LedgerState) xs
hardForkState of
          Left{}     -> HardForkTxMeasure xs
-> ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)
forall a. a -> ExceptT (HardForkApplyTxErr xs) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HardForkTxMeasure xs
forall a. Measure a => a
Measure.zero   -- safe b/c the tx will be found invalid
          Right HardForkState (Product GenTx (Ticked :.: LedgerState)) xs
pair -> HardForkState
  (K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)))
  xs
-> CollapseTo
     HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure 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 (HardForkTxMeasure xs)))
   xs
 -> CollapseTo
      HardForkState
      (ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)))
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)))
     xs
-> CollapseTo
     HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Index xs a
    -> WrapLedgerConfig a
    -> Product GenTx (Ticked :.: LedgerState) a
    -> K (ExceptT
            (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
         a)
-> NP WrapLedgerConfig xs
-> HardForkState (Product GenTx (Ticked :.: LedgerState)) xs
-> HardForkState
     (K (ExceptT
           (HardForkApplyTxErr xs) Identity (HardForkTxMeasure 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 GenTx (Ticked :.: LedgerState) a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
     a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product GenTx (Ticked :.: LedgerState) a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
     a
aux NP WrapLedgerConfig xs
cfgs HardForkState (Product GenTx (Ticked :.: LedgerState)) 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 (Ticked :.: LedgerState) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
                Shape xs
hardForkLedgerConfigShape
                TransitionInfo
transition
                HardForkState (Ticked :.: LedgerState) 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

      injs :: InPairs (InjectPolyTx GenTx) xs
      injs :: InPairs InjectTx xs
injs =
          (forall x y.
 Product2 InjectTx InjectValidatedTx x y -> InjectPolyTx GenTx x y)
-> InPairs (Product2 InjectTx InjectValidatedTx) xs
-> InPairs InjectTx xs
forall {k} (xs :: [k]) (f :: k -> k -> *) (g :: k -> k -> *).
SListI xs =>
(forall (x :: k) (y :: k). f x y -> g x y)
-> InPairs f xs -> InPairs g xs
InPairs.hmap (\(Pair2 InjectPolyTx GenTx x y
injTx InjectValidatedTx x y
_injValidatedTx) -> InjectPolyTx GenTx x y
injTx)
        (InPairs (Product2 InjectTx InjectValidatedTx) xs
 -> InPairs InjectTx xs)
-> InPairs (Product2 InjectTx InjectValidatedTx) xs
-> InPairs InjectTx xs
forall a b. (a -> b) -> a -> b
$ NP WrapLedgerConfig xs
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
     xs
-> InPairs (Product2 InjectTx InjectValidatedTx) xs
forall {k} (h :: k -> *) (xs :: [k]) (f :: k -> k -> *).
NP h xs -> InPairs (RequiringBoth h f) xs -> InPairs f xs
InPairs.requiringBoth NP WrapLedgerConfig xs
cfgs InPairs
  (RequiringBoth
     WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
  xs
forall (xs :: [*]).
CanHardFork xs =>
InPairs
  (RequiringBoth
     WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
  xs
hardForkInjectTxs

      aux :: forall blk.
           SingleEraBlock blk
        => Index xs blk
        -> WrapLedgerConfig blk
        -> (Product GenTx (Ticked :.: LedgerState)) blk
        -> K (Except (HardForkApplyTxErr xs) (HardForkTxMeasure xs)) blk
      aux :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product GenTx (Ticked :.: LedgerState) a
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
     a
aux Index xs blk
idx WrapLedgerConfig blk
cfg (Pair GenTx blk
tx' (:.:) Ticked LedgerState blk
st') =
          ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
     blk
forall k a (b :: k). a -> K a b
K
        (ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)
 -> K (ExceptT
         (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
      blk)
-> ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)
-> K (ExceptT
        (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
     blk
forall a b. (a -> b) -> a -> b
$ (Either (ApplyTxErr blk) (TxMeasure blk)
 -> Either (HardForkApplyTxErr xs) (HardForkTxMeasure xs))
-> Except (ApplyTxErr blk) (TxMeasure blk)
-> ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure 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]).
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)
-> (TxMeasure blk -> HardForkTxMeasure xs)
-> Either (ApplyTxErr blk) (TxMeasure blk)
-> Either (HardForkApplyTxErr xs) (HardForkTxMeasure xs)
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++
                (NS WrapTxMeasure xs -> HardForkTxMeasure xs
forall (xs :: [*]).
CanHardFork xs =>
NS WrapTxMeasure xs -> HardForkTxMeasure xs
hardForkInjTxMeasure (NS WrapTxMeasure xs -> HardForkTxMeasure xs)
-> (TxMeasure blk -> NS WrapTxMeasure xs)
-> TxMeasure blk
-> HardForkTxMeasure xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index xs blk -> WrapTxMeasure blk -> NS WrapTxMeasure xs
forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
Index xs x -> f x -> NS f xs
injectNS Index xs blk
idx (WrapTxMeasure blk -> NS WrapTxMeasure xs)
-> (TxMeasure blk -> WrapTxMeasure blk)
-> TxMeasure blk
-> NS WrapTxMeasure xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasure blk -> WrapTxMeasure blk
forall blk. TxMeasure blk -> WrapTxMeasure blk
WrapTxMeasure)
            )
        (Except (ApplyTxErr blk) (TxMeasure blk)
 -> ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs))
-> Except (ApplyTxErr blk) (TxMeasure blk)
-> ExceptT (HardForkApplyTxErr xs) Identity (HardForkTxMeasure xs)
forall a b. (a -> b) -> a -> b
$ LedgerConfig blk
-> TickedLedgerState blk
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasure blk)
forall blk.
TxLimits blk =>
LedgerConfig blk
-> TickedLedgerState blk
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasure blk)
txMeasure
            (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg)
            ((:.:) Ticked LedgerState blk -> TickedLedgerState blk
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp (:.:) Ticked LedgerState blk
st')
            GenTx blk
tx'

-- | A private type used only to clarify the parameterization of 'applyHelper'
data ApplyHelperMode :: (Type -> Type) -> Type where
  ModeApply   :: ApplyHelperMode GenTx
  ModeReapply :: ApplyHelperMode WrapValidatedGenTx

-- | 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)
arState       :: Ticked (LedgerState blk)
  , 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 txIn. CanHardFork xs
  => ApplyHelperMode txIn
  -> LedgerConfig (HardForkBlock xs)
  -> WhetherToIntervene
  -> SlotNo
  -> txIn (HardForkBlock xs)
  -> TickedLedgerState (HardForkBlock xs)
  -> Except
      (HardForkApplyTxErr xs)
      ( TickedLedgerState (HardForkBlock xs)
      , Validated (GenTx (HardForkBlock xs))
      )
applyHelper :: forall (xs :: [*]) (txIn :: * -> *).
CanHardFork xs =>
ApplyHelperMode txIn
-> LedgerConfig (HardForkBlock xs)
-> WhetherToIntervene
-> SlotNo
-> txIn (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      Validated (GenTx (HardForkBlock xs)))
applyHelper ApplyHelperMode txIn
mode
            HardForkLedgerConfig{Shape xs
PerEraLedgerConfig xs
hardForkLedgerConfigShape :: forall (xs :: [*]). HardForkLedgerConfig xs -> Shape xs
hardForkLedgerConfigPerEra :: forall (xs :: [*]).
HardForkLedgerConfig xs -> PerEraLedgerConfig xs
hardForkLedgerConfigShape :: Shape xs
hardForkLedgerConfigPerEra :: PerEraLedgerConfig xs
..}
            WhetherToIntervene
wti
            SlotNo
slot
            txIn (HardForkBlock xs)
tx
            (TickedHardForkLedgerState TransitionInfo
transition HardForkState (Ticked :.: LedgerState) xs
hardForkState) =
    case InPairs (InjectPolyTx txIn) xs
-> NS txIn xs
-> HardForkState (Ticked :.: LedgerState) xs
-> Either
     (Mismatch txIn (Current (Ticked :.: LedgerState)) xs)
     (HardForkState (Product txIn (Ticked :.: LedgerState)) xs)
forall (xs :: [*]) (tx :: * -> *) (f :: * -> *).
SListI xs =>
InPairs (InjectPolyTx tx) xs
-> NS tx xs
-> HardForkState f xs
-> Either
     (Mismatch tx (Current f) xs) (HardForkState (Product tx f) xs)
matchPolyTx InPairs (InjectPolyTx txIn) xs
injs (txIn (HardForkBlock xs) -> NS txIn xs
modeGetTx txIn (HardForkBlock xs)
tx) HardForkState (Ticked :.: LedgerState) xs
hardForkState of
      Left Mismatch txIn (Current (Ticked :.: LedgerState)) xs
mismatch ->
        HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      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),
       Validated (GenTx (HardForkBlock xs))))
-> HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      Validated (GenTx (HardForkBlock xs)))
forall a b. (a -> b) -> a -> b
$ MismatchEraInfo xs -> HardForkApplyTxErr xs
forall (xs :: [*]). MismatchEraInfo xs -> HardForkApplyTxErr xs
HardForkApplyTxErrWrongEra (MismatchEraInfo xs -> HardForkApplyTxErr xs)
-> (Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs
-> HardForkApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo xs -> HardForkApplyTxErr xs)
-> Mismatch SingleEraInfo LedgerEraInfo xs -> HardForkApplyTxErr xs
forall a b. (a -> b) -> a -> b
$
          Proxy SingleEraBlock
-> (forall x. SingleEraBlock x => txIn x -> SingleEraInfo x)
-> (forall x.
    SingleEraBlock x =>
    Current (Ticked :.: LedgerState) x -> LedgerEraInfo x)
-> Mismatch txIn (Current (Ticked :.: LedgerState)) xs
-> Mismatch SingleEraInfo LedgerEraInfo xs
forall {k} (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> *) (f :: k -> *) (f' :: k -> *)
       (g :: k -> *) (g' :: k -> *).
All c xs =>
proxy c
-> (forall (x :: k). c x => f x -> f' x)
-> (forall (x :: k). c x => g x -> g' x)
-> Mismatch f g xs
-> Mismatch f' g' xs
Match.bihcmap Proxy SingleEraBlock
proxySingle txIn x -> SingleEraInfo x
forall x. SingleEraBlock x => txIn x -> SingleEraInfo x
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy x -> SingleEraInfo x
singleEraInfo Current (Ticked :.: LedgerState) x -> LedgerEraInfo x
forall x.
SingleEraBlock x =>
Current (Ticked :.: LedgerState) x -> LedgerEraInfo x
ledgerInfo Mismatch txIn (Current (Ticked :.: LedgerState)) xs
mismatch
      Right HardForkState (Product txIn (Ticked :.: LedgerState)) 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
          HardForkState (ApplyResult xs) xs
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 txIn (Ticked :.: LedgerState) a
    -> (:.:)
         (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a)
-> NP WrapLedgerConfig xs
-> HardForkState (Product txIn (Ticked :.: LedgerState)) 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 txIn (Ticked :.: LedgerState) a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product txIn (Ticked :.: LedgerState) a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
modeApplyCurrent NP WrapLedgerConfig xs
cfgs HardForkState (Product txIn (Ticked :.: LedgerState)) xs
matched
          let HardForkState (ApplyResult xs) xs
_ = HardForkState (ApplyResult xs) xs
result :: State.HardForkState (ApplyResult xs) xs

              st' :: State.HardForkState (Ticked :.: LedgerState) xs
              st' :: HardForkState (Ticked :.: LedgerState) xs
st' = (Ticked (LedgerState a) -> (:.:) Ticked LedgerState a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (Ticked (LedgerState a) -> (:.:) Ticked LedgerState a)
-> (ApplyResult xs a -> Ticked (LedgerState a))
-> ApplyResult xs a
-> (:.:) Ticked LedgerState a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyResult xs a -> Ticked (LedgerState a)
forall (xs :: [*]) blk.
ApplyResult xs blk -> Ticked (LedgerState blk)
arState) (forall {a}. ApplyResult xs a -> (:.:) Ticked LedgerState a)
-> HardForkState (ApplyResult xs) xs
-> HardForkState (Ticked :.: LedgerState) 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 :: 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

          (TickedLedgerState (HardForkBlock xs),
 Validated (GenTx (HardForkBlock xs)))
-> Except
     (HardForkApplyTxErr xs)
     (TickedLedgerState (HardForkBlock xs),
      Validated (GenTx (HardForkBlock xs)))
forall a. a -> ExceptT (HardForkApplyTxErr xs) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> TickedLedgerState (HardForkBlock xs)
forall (xs :: [*]).
TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> Ticked (LedgerState (HardForkBlock xs))
TickedHardForkLedgerState TransitionInfo
transition HardForkState (Ticked :.: LedgerState) xs
st', Validated (GenTx (HardForkBlock xs))
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 (Ticked :.: LedgerState) xs
-> EpochInfo (Except PastHorizonException)
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo
-> HardForkState f xs
-> EpochInfo (Except PastHorizonException)
State.epochInfoPrecomputedTransitionInfo
              Shape xs
hardForkLedgerConfigShape
              TransitionInfo
transition
              HardForkState (Ticked :.: LedgerState) xs
hardForkState

    injs :: InPairs (InjectPolyTx txIn) xs
    injs :: InPairs (InjectPolyTx txIn) xs
injs =
        (forall x y.
 Product2 InjectTx InjectValidatedTx x y -> InjectPolyTx txIn x y)
-> InPairs (Product2 InjectTx InjectValidatedTx) xs
-> InPairs (InjectPolyTx txIn) xs
forall {k} (xs :: [k]) (f :: k -> k -> *) (g :: k -> k -> *).
SListI xs =>
(forall (x :: k) (y :: k). f x y -> g x y)
-> InPairs f xs -> InPairs g xs
InPairs.hmap
          Product2 InjectTx InjectValidatedTx x y -> InjectPolyTx txIn x y
forall x y.
Product2 InjectTx InjectValidatedTx x y -> InjectPolyTx txIn x y
modeGetInjection
          (NP WrapLedgerConfig xs
-> InPairs
     (RequiringBoth
        WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
     xs
-> InPairs (Product2 InjectTx InjectValidatedTx) xs
forall {k} (h :: k -> *) (xs :: [k]) (f :: k -> k -> *).
NP h xs -> InPairs (RequiringBoth h f) xs -> InPairs f xs
InPairs.requiringBoth NP WrapLedgerConfig xs
cfgs InPairs
  (RequiringBoth
     WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
  xs
forall (xs :: [*]).
CanHardFork xs =>
InPairs
  (RequiringBoth
     WrapLedgerConfig (Product2 InjectTx InjectValidatedTx))
  xs
hardForkInjectTxs)

    modeGetTx :: txIn (HardForkBlock xs) -> NS txIn xs
    modeGetTx :: txIn (HardForkBlock xs) -> NS txIn xs
modeGetTx = case ApplyHelperMode txIn
mode of
        ApplyHelperMode txIn
ModeApply   ->
              OneEraGenTx xs -> NS txIn xs
OneEraGenTx xs -> NS GenTx xs
forall (xs :: [*]). OneEraGenTx xs -> NS GenTx xs
getOneEraGenTx
            (OneEraGenTx xs -> NS txIn xs)
-> (txIn (HardForkBlock xs) -> OneEraGenTx xs)
-> txIn (HardForkBlock xs)
-> NS txIn xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. txIn (HardForkBlock xs) -> OneEraGenTx xs
GenTx (HardForkBlock xs) -> OneEraGenTx xs
forall (xs :: [*]). GenTx (HardForkBlock xs) -> OneEraGenTx xs
getHardForkGenTx
        ApplyHelperMode txIn
ModeReapply ->
              OneEraValidatedGenTx xs -> NS txIn xs
OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
forall (xs :: [*]).
OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
getOneEraValidatedGenTx
            (OneEraValidatedGenTx xs -> NS txIn xs)
-> (txIn (HardForkBlock xs) -> OneEraValidatedGenTx xs)
-> txIn (HardForkBlock xs)
-> NS txIn 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
            (Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs)
-> (txIn (HardForkBlock xs)
    -> Validated (GenTx (HardForkBlock xs)))
-> txIn (HardForkBlock xs)
-> OneEraValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. txIn (HardForkBlock xs) -> Validated (GenTx (HardForkBlock xs))
WrapValidatedGenTx (HardForkBlock xs)
-> Validated (GenTx (HardForkBlock xs))
forall blk. WrapValidatedGenTx blk -> Validated (GenTx blk)
unwrapValidatedGenTx

    modeGetInjection :: forall blk1 blk2.
         Product2 InjectTx InjectValidatedTx blk1 blk2
      -> InjectPolyTx txIn                   blk1 blk2
    modeGetInjection :: forall x y.
Product2 InjectTx InjectValidatedTx x y -> InjectPolyTx txIn x y
modeGetInjection (Pair2 InjectTx blk1 blk2
injTx InjectValidatedTx blk1 blk2
injValidatedTx) = case ApplyHelperMode txIn
mode of
        ApplyHelperMode txIn
ModeApply   -> InjectPolyTx txIn blk1 blk2
InjectTx blk1 blk2
injTx
        ApplyHelperMode txIn
ModeReapply -> InjectPolyTx txIn blk1 blk2
InjectValidatedTx blk1 blk2
injValidatedTx

    modeApplyCurrent :: forall blk.
         SingleEraBlock                        blk
      => Index xs                              blk
      -> WrapLedgerConfig                      blk
      -> Product txIn (Ticked :.: LedgerState) blk
      -> (     Except (HardForkApplyTxErr xs)
           :.: ApplyResult xs
         ) blk
    modeApplyCurrent :: forall a.
SingleEraBlock a =>
Index xs a
-> WrapLedgerConfig a
-> Product txIn (Ticked :.: LedgerState) a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) a
modeApplyCurrent Index xs blk
index WrapLedgerConfig blk
cfg (Pair txIn blk
tx' (Comp Ticked (LedgerState blk)
st)) =
          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.
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
            (Ticked (LedgerState blk)
st', Validated (GenTx blk)
vtx) <- case ApplyHelperMode txIn
mode of
              ApplyHelperMode txIn
ModeApply   -> LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> ExceptT
     (ApplyTxErr blk)
     Identity
     (Ticked (LedgerState blk), Validated (GenTx blk))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except
     (ApplyTxErr blk) (Ticked (LedgerState blk), Validated (GenTx blk))
applyTx LedgerConfig blk
lcfg WhetherToIntervene
wti SlotNo
slot txIn blk
GenTx blk
tx' Ticked (LedgerState blk)
st
              ApplyHelperMode txIn
ModeReapply -> do
                  let vtx' :: Validated (GenTx blk)
vtx' = WrapValidatedGenTx blk -> Validated (GenTx blk)
forall blk. WrapValidatedGenTx blk -> Validated (GenTx blk)
unwrapValidatedGenTx txIn blk
WrapValidatedGenTx blk
tx'
                  Ticked (LedgerState blk)
st' <- LedgerConfig blk
-> SlotNo
-> Validated (GenTx blk)
-> Ticked (LedgerState blk)
-> ExceptT (ApplyTxErr blk) Identity (Ticked (LedgerState blk))
forall blk.
(LedgerSupportsMempool blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> Validated (GenTx blk)
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
reapplyTx LedgerConfig blk
lcfg SlotNo
slot Validated (GenTx blk)
vtx' Ticked (LedgerState blk)
st
                  -- provide the given transaction, which was already validated
                  (Ticked (LedgerState blk), Validated (GenTx blk))
-> ExceptT
     (ApplyTxErr blk)
     Identity
     (Ticked (LedgerState blk), Validated (GenTx blk))
forall a. a -> ExceptT (ApplyTxErr blk) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ticked (LedgerState blk)
st', Validated (GenTx blk)
vtx')
            ApplyResult xs blk -> Except (ApplyTxErr blk) (ApplyResult xs blk)
forall a. a -> ExceptT (ApplyTxErr blk) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplyResult {
                arValidatedTx :: Validated (GenTx (HardForkBlock xs))
arValidatedTx = Index xs blk
-> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
forall (xs :: [*]) blk.
Index xs blk
-> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
injectValidatedGenTx Index xs blk
index Validated (GenTx blk)
vtx
              , arState :: Ticked (LedgerState blk)
arState       = Ticked (LedgerState blk)
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))) where

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

{-------------------------------------------------------------------------------
  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]).
(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
-------------------------------------------------------------------------------}

ledgerInfo :: forall blk. SingleEraBlock blk
           => State.Current (Ticked :.: LedgerState) blk -> LedgerEraInfo blk
ledgerInfo :: forall x.
SingleEraBlock x =>
Current (Ticked :.: LedgerState) x -> LedgerEraInfo x
ledgerInfo Current (Ticked :.: LedgerState) blk
_ = SingleEraInfo blk -> LedgerEraInfo blk
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo blk -> LedgerEraInfo blk)
-> SingleEraInfo blk -> LedgerEraInfo blk
forall a b. (a -> b) -> a -> b
$ Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

injectApplyTxErr :: Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr :: forall (xs :: [*]) blk.
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]).
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 :: Index xs blk -> Validated (GenTx blk) -> Validated (GenTx (HardForkBlock xs))
injectValidatedGenTx :: forall (xs :: [*]) blk.
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]).
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