{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# 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.Monad.Except
import           Data.Functor.Product
import           Data.Kind (Type)
import           Data.SOP.Strict
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Consensus.Util (ShowProxy)
import           Ouroboros.Consensus.Util.SOP

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 qualified Ouroboros.Consensus.HardFork.Combinator.State as State
import           Ouroboros.Consensus.HardFork.Combinator.Util.Functors
                     (Product2 (..))
import           Ouroboros.Consensus.HardFork.Combinator.Util.InPairs (InPairs)
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.InPairs as InPairs
import qualified Ouroboros.Consensus.HardFork.Combinator.Util.Match as Match

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
$cto :: forall (xs :: [*]) x.
Rep (HardForkApplyTxErr xs) x -> HardForkApplyTxErr xs
$cfrom :: forall (xs :: [*]) x.
HardForkApplyTxErr xs -> Rep (HardForkApplyTxErr xs) x
Generic)

instance Typeable xs => ShowProxy (HardForkApplyTxErr xs) where

hardForkApplyTxErrToEither :: HardForkApplyTxErr xs
                           -> Either (MismatchEraInfo xs) (OneEraApplyTxErr xs)
hardForkApplyTxErrToEither :: 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 :: 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 {
      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
/= :: 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
$c== :: forall (xs :: [*]).
CanHardFork xs =>
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
$cto :: forall (xs :: [*]) x.
Rep (GenTx (HardForkBlock xs)) x -> GenTx (HardForkBlock xs)
$cfrom :: forall (xs :: [*]) x.
GenTx (HardForkBlock xs) -> Rep (GenTx (HardForkBlock xs)) x
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
showList :: [GenTx (HardForkBlock xs)] -> ShowS
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[GenTx (HardForkBlock xs)] -> ShowS
show :: GenTx (HardForkBlock xs) -> String
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
GenTx (HardForkBlock xs) -> String
showsPrec :: Int -> GenTx (HardForkBlock xs) -> ShowS
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> 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
showTypeOf :: Proxy (GenTx (HardForkBlock xs)) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (GenTx (HardForkBlock xs)) -> String
wNoThunks :: Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> GenTx (HardForkBlock xs) -> IO (Maybe ThunkInfo)
NoThunks)

newtype instance Validated (GenTx (HardForkBlock xs)) = HardForkValidatedGenTx {
      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
/= :: 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
$c== :: forall (xs :: [*]).
CanHardFork xs =>
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
$cto :: forall (xs :: [*]) x.
Rep (Validated (GenTx (HardForkBlock xs))) x
-> Validated (GenTx (HardForkBlock xs))
$cfrom :: forall (xs :: [*]) x.
Validated (GenTx (HardForkBlock xs))
-> Rep (Validated (GenTx (HardForkBlock xs))) x
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
showList :: [Validated (GenTx (HardForkBlock xs))] -> ShowS
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[Validated (GenTx (HardForkBlock xs))] -> ShowS
show :: Validated (GenTx (HardForkBlock xs)) -> String
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
Validated (GenTx (HardForkBlock xs)) -> String
showsPrec :: Int -> Validated (GenTx (HardForkBlock xs)) -> ShowS
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> 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
showTypeOf :: Proxy (Validated (GenTx (HardForkBlock xs))) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (Validated (GenTx (HardForkBlock xs))) -> String
wNoThunks :: Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context
-> Validated (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
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 :: 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
     (HardForkApplyTxErr xs)
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (Ticked (LedgerState (HardForkBlock xs)))
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
   (HardForkApplyTxErr xs)
   (Ticked (LedgerState (HardForkBlock xs)),
    Validated (GenTx (HardForkBlock xs)))
 -> ExceptT
      (HardForkApplyTxErr xs)
      Identity
      (Ticked (LedgerState (HardForkBlock xs))))
-> Except
     (HardForkApplyTxErr xs)
     (Ticked (LedgerState (HardForkBlock xs)),
      Validated (GenTx (HardForkBlock xs)))
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (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

  txsMaxBytes :: Ticked (LedgerState (HardForkBlock xs)) -> Word32
txsMaxBytes =
        NS (K Word32) xs -> Word32
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K Word32) xs -> Word32)
-> (Ticked (LedgerState (HardForkBlock xs)) -> NS (K Word32) xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    (:.:) Ticked LedgerState a -> K Word32 a)
-> NS (Ticked :.: LedgerState) xs
-> NS (K Word32) 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 (Word32 -> K Word32 a
forall k a (b :: k). a -> K a b
K (Word32 -> K Word32 a)
-> ((:.:) Ticked LedgerState a -> Word32)
-> (:.:) Ticked LedgerState a
-> K Word32 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickedLedgerState a -> Word32
forall blk.
LedgerSupportsMempool blk =>
Ticked (LedgerState blk) -> Word32
txsMaxBytes (TickedLedgerState a -> Word32)
-> ((:.:) Ticked LedgerState a -> TickedLedgerState a)
-> (:.:) Ticked LedgerState a
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) Ticked LedgerState a -> TickedLedgerState a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp)
      (NS (Ticked :.: LedgerState) xs -> NS (K Word32) xs)
-> (Ticked (LedgerState (HardForkBlock xs))
    -> NS (Ticked :.: LedgerState) xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> NS (K Word32) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState (Ticked :.: LedgerState) xs
-> NS (Ticked :.: LedgerState) xs
forall (xs :: [*]) (f :: * -> *).
SListI xs =>
HardForkState f xs -> NS f xs
State.tip
      (HardForkState (Ticked :.: LedgerState) xs
 -> NS (Ticked :.: LedgerState) xs)
-> (Ticked (LedgerState (HardForkBlock xs))
    -> HardForkState (Ticked :.: LedgerState) xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> NS (Ticked :.: LedgerState) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (HardForkBlock xs))
-> HardForkState (Ticked :.: LedgerState) xs
forall (xs :: [*]).
Ticked (LedgerState (HardForkBlock xs))
-> HardForkState (Ticked :.: LedgerState) xs
tickedHardForkLedgerStatePerEra

  txInBlockSize :: GenTx (HardForkBlock xs) -> Word32
txInBlockSize =
        NS (K Word32) xs -> Word32
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K Word32) xs -> Word32)
-> (GenTx (HardForkBlock xs) -> NS (K Word32) xs)
-> GenTx (HardForkBlock xs)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy SingleEraBlock
-> (forall a. SingleEraBlock a => GenTx a -> K Word32 a)
-> NS GenTx xs
-> NS (K Word32) 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 (Word32 -> K Word32 a
forall k a (b :: k). a -> K a b
K (Word32 -> K Word32 a)
-> (GenTx a -> Word32) -> GenTx a -> K Word32 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx a -> Word32
forall blk. LedgerSupportsMempool blk => GenTx blk -> Word32
txInBlockSize)
      (NS GenTx xs -> NS (K Word32) xs)
-> (GenTx (HardForkBlock xs) -> NS GenTx xs)
-> GenTx (HardForkBlock xs)
-> NS (K Word32) 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

  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

-- | 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 {
    ApplyResult xs blk -> Ticked (LedgerState blk)
arState       :: Ticked (LedgerState 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 :: 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{..}
            WhetherToIntervene
wti
            SlotNo
slot
            txIn (HardForkBlock xs)
tx
            (TickedHardForkLedgerState transition 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 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 forall x. SingleEraBlock x => txIn x -> SingleEraInfo x
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
singleEraInfo 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 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 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 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 (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
          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 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
        ApplyHelperMode txIn
ModeReapply ->
              OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
forall (xs :: [*]).
OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs
getOneEraValidatedGenTx
            (OneEraValidatedGenTx xs -> NS WrapValidatedGenTx xs)
-> (WrapValidatedGenTx (HardForkBlock xs)
    -> OneEraValidatedGenTx xs)
-> WrapValidatedGenTx (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
            (Validated (GenTx (HardForkBlock xs)) -> OneEraValidatedGenTx xs)
-> (WrapValidatedGenTx (HardForkBlock xs)
    -> Validated (GenTx (HardForkBlock xs)))
-> WrapValidatedGenTx (HardForkBlock xs)
-> OneEraValidatedGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Product2 InjectTx InjectValidatedTx blk1 blk2
-> InjectPolyTx txIn blk1 blk2
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 :: Index xs blk
-> WrapLedgerConfig blk
-> Product txIn (Ticked :.: LedgerState) blk
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) blk
modeApplyCurrent Index xs blk
index WrapLedgerConfig blk
cfg (Pair txIn blk
tx' (Comp Ticked (LedgerState blk)
st)) =
          ExceptT (HardForkApplyTxErr xs) Identity (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
        (ExceptT (HardForkApplyTxErr xs) Identity (ApplyResult xs blk)
 -> (:.:)
      (ExceptT (HardForkApplyTxErr xs) Identity) (ApplyResult xs) blk)
-> ExceptT (HardForkApplyTxErr xs) Identity (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)
-> ExceptT (HardForkApplyTxErr xs) Identity (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)
 -> ExceptT (HardForkApplyTxErr xs) Identity (ApplyResult xs blk))
-> Except (ApplyTxErr blk) (ApplyResult xs blk)
-> ExceptT (HardForkApplyTxErr xs) Identity (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ApplyResult :: forall (xs :: [*]) blk.
Ticked (LedgerState blk)
-> Validated (GenTx (HardForkBlock xs)) -> ApplyResult xs blk
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 {
      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
/= :: 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
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
$cto :: forall (xs :: [*]) x.
Rep (TxId (GenTx (HardForkBlock xs))) x
-> TxId (GenTx (HardForkBlock xs))
$cfrom :: forall (xs :: [*]) x.
TxId (GenTx (HardForkBlock xs))
-> Rep (TxId (GenTx (HardForkBlock xs))) x
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
min :: 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))
max :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
$cmax :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs))
>= :: 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
$c< :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Bool
compare :: TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
$ccompare :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs))
-> TxId (GenTx (HardForkBlock xs)) -> Ordering
$cp1Ord :: forall (xs :: [*]).
CanHardFork xs =>
Eq (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
showList :: [TxId (GenTx (HardForkBlock xs))] -> ShowS
$cshowList :: forall (xs :: [*]).
CanHardFork xs =>
[TxId (GenTx (HardForkBlock xs))] -> ShowS
show :: TxId (GenTx (HardForkBlock xs)) -> String
$cshow :: forall (xs :: [*]).
CanHardFork xs =>
TxId (GenTx (HardForkBlock xs)) -> String
showsPrec :: Int -> TxId (GenTx (HardForkBlock xs)) -> ShowS
$cshowsPrec :: forall (xs :: [*]).
CanHardFork xs =>
Int -> 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
showTypeOf :: Proxy (TxId (GenTx (HardForkBlock xs))) -> String
$cshowTypeOf :: forall (xs :: [*]).
CanHardFork xs =>
Proxy (TxId (GenTx (HardForkBlock xs))) -> String
wNoThunks :: Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (xs :: [*]).
CanHardFork xs =>
Context -> TxId (GenTx (HardForkBlock xs)) -> IO (Maybe ThunkInfo)
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)]
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 (Proxy HasTxs
forall k (t :: k). Proxy t
Proxy @HasTxs) 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 :: Index xs blk -> I blk -> K [GenTx (HardForkBlock xs)] blk
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 a1 (f :: a1 -> *) a2 b (x :: a1) (xs :: [a1]).
(Coercible a2 (f x), Coercible b (NS f xs)) =>
Proxy f -> Index xs x -> a2 -> b
injectNS' (Proxy GenTx
forall k (t :: k). 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 :: Current (Ticked :.: LedgerState) blk -> LedgerEraInfo blk
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
singleEraInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk)

injectApplyTxErr :: Index xs blk -> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr :: 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 :: 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