{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# 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 (
    HardForkApplyTxErr(..)
  , hardForkApplyTxErrToEither
  , hardForkApplyTxErrFromEither
  , GenTx(..)
  , TxId(..)
  ) where

import           Control.Monad.Except
import           Data.Functor.Product
import           Data.SOP.Strict
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)
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.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.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, 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, 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)

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)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)))
applyTx   = (forall blk.
 (SingleEraBlock blk, HasCallStack) =>
 LedgerConfig blk
 -> SlotNo
 -> GenTx blk
 -> TickedLedgerState blk
 -> Except (ApplyTxErr blk) (TickedLedgerState blk))
-> LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (HardForkApplyTxErr xs) (Ticked (LedgerState (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
(forall blk.
 (SingleEraBlock blk, HasCallStack) =>
 LedgerConfig blk
 -> SlotNo
 -> GenTx blk
 -> TickedLedgerState blk
 -> Except (ApplyTxErr blk) (TickedLedgerState blk))
-> LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
applyHelper forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
forall blk.
(SingleEraBlock blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except (ApplyTxErr blk) (TickedLedgerState blk)
applyTx
  reapplyTx :: LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (ApplyTxErr (HardForkBlock xs))
     (Ticked (LedgerState (HardForkBlock xs)))
reapplyTx = (forall blk.
 (SingleEraBlock blk, HasCallStack) =>
 LedgerConfig blk
 -> SlotNo
 -> GenTx blk
 -> TickedLedgerState blk
 -> Except (ApplyTxErr blk) (TickedLedgerState blk))
-> LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> Ticked (LedgerState (HardForkBlock xs))
-> Except
     (HardForkApplyTxErr xs) (Ticked (LedgerState (HardForkBlock xs)))
forall (xs :: [*]).
CanHardFork xs =>
(forall blk.
 (SingleEraBlock blk, HasCallStack) =>
 LedgerConfig blk
 -> SlotNo
 -> GenTx blk
 -> TickedLedgerState blk
 -> Except (ApplyTxErr blk) (TickedLedgerState blk))
-> LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
applyHelper forall blk.
(LedgerSupportsMempool blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
forall blk.
(SingleEraBlock blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except (ApplyTxErr blk) (TickedLedgerState blk)
reapplyTx

  maxTxCapacity :: Ticked (LedgerState (HardForkBlock xs)) -> Word32
maxTxCapacity =
        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
maxTxCapacity (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

applyHelper
  :: forall xs. CanHardFork xs
  => (    forall blk. (SingleEraBlock blk, HasCallStack)
       => LedgerConfig blk
       -> SlotNo
       -> GenTx blk
       -> TickedLedgerState blk
       -> Except (ApplyTxErr blk) (TickedLedgerState blk)
     )
  -> LedgerConfig (HardForkBlock xs)
  -> SlotNo
  -> GenTx (HardForkBlock xs)
  -> TickedLedgerState (HardForkBlock xs)
  -> Except (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
applyHelper :: (forall blk.
 (SingleEraBlock blk, HasCallStack) =>
 LedgerConfig blk
 -> SlotNo
 -> GenTx blk
 -> TickedLedgerState blk
 -> Except (ApplyTxErr blk) (TickedLedgerState blk))
-> LedgerConfig (HardForkBlock xs)
-> SlotNo
-> GenTx (HardForkBlock xs)
-> TickedLedgerState (HardForkBlock xs)
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
applyHelper forall blk.
(SingleEraBlock blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except (ApplyTxErr blk) (TickedLedgerState blk)
apply
            HardForkLedgerConfig{..}
            SlotNo
slot
            (HardForkGenTx (OneEraGenTx hardForkTx))
            (TickedHardForkLedgerState transition hardForkState) =
    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
injectTxs NS GenTx xs
hardForkTx HardForkState (Ticked :.: LedgerState) xs
hardForkState of
      Left Mismatch GenTx (Current (Ticked :.: LedgerState)) xs
mismatch ->
        HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HardForkApplyTxErr xs
 -> Except
      (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs)))
-> HardForkApplyTxErr xs
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (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 => GenTx x -> SingleEraInfo x)
-> (forall x.
    SingleEraBlock x =>
    Current (Ticked :.: LedgerState) x -> LedgerEraInfo x)
-> Mismatch GenTx (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 => GenTx 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 GenTx (Current (Ticked :.: LedgerState)) xs
mismatch
      Right HardForkState (Product GenTx (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.
        (HardForkState (Ticked :.: LedgerState) xs
 -> TickedLedgerState (HardForkBlock xs))
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (Ticked :.: LedgerState) xs)
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> TickedLedgerState (HardForkBlock xs)
forall (xs :: [*]).
TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> Ticked (LedgerState (HardForkBlock xs))
TickedHardForkLedgerState TransitionInfo
transition) (ExceptT
   (HardForkApplyTxErr xs)
   Identity
   (HardForkState (Ticked :.: LedgerState) xs)
 -> Except
      (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs)))
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (Ticked :.: LedgerState) xs)
-> Except
     (HardForkApplyTxErr xs) (TickedLedgerState (HardForkBlock xs))
forall a b. (a -> b) -> a -> b
$ HardForkState
  (ExceptT (HardForkApplyTxErr xs) Identity
   :.: (Ticked :.: LedgerState))
  xs
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (Ticked :.: LedgerState) 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
    :.: (Ticked :.: LedgerState))
   xs
 -> ExceptT
      (HardForkApplyTxErr xs)
      Identity
      (HardForkState (Ticked :.: LedgerState) xs))
-> HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity
      :.: (Ticked :.: LedgerState))
     xs
-> ExceptT
     (HardForkApplyTxErr xs)
     Identity
     (HardForkState (Ticked :.: LedgerState) xs)
forall a b. (a -> b) -> a -> b
$
          Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapLedgerConfig a
    -> Injection WrapApplyTxErr xs a
    -> Product GenTx (Ticked :.: LedgerState) a
    -> (:.:)
         (ExceptT (HardForkApplyTxErr xs) Identity)
         (Ticked :.: LedgerState)
         a)
-> Prod HardForkState WrapLedgerConfig xs
-> Prod HardForkState (Injection WrapApplyTxErr xs) xs
-> HardForkState (Product GenTx (Ticked :.: LedgerState)) xs
-> HardForkState
     (ExceptT (HardForkApplyTxErr xs) Identity
      :.: (Ticked :.: LedgerState))
     xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *) (f''' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a -> f''' a)
-> Prod h f xs
-> Prod h f' xs
-> h f'' xs
-> h f''' xs
hczipWith3 Proxy SingleEraBlock
proxySingle forall a.
SingleEraBlock a =>
WrapLedgerConfig a
-> Injection WrapApplyTxErr xs a
-> Product GenTx (Ticked :.: LedgerState) a
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity)
     (Ticked :.: LedgerState)
     a
applyCurrent Prod HardForkState WrapLedgerConfig xs
NP WrapLedgerConfig xs
cfgs Prod HardForkState (Injection WrapApplyTxErr xs) xs
NP (Injection WrapApplyTxErr xs) xs
errInjections HardForkState (Product GenTx (Ticked :.: LedgerState)) xs
matched
  where
    pcfgs :: NP WrapPartialLedgerConfig xs
pcfgs = PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
forall (xs :: [*]).
PerEraLedgerConfig xs -> NP WrapPartialLedgerConfig xs
getPerEraLedgerConfig PerEraLedgerConfig xs
hardForkLedgerConfigPerEra
    cfgs :: NP WrapLedgerConfig xs
cfgs  = Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    WrapPartialLedgerConfig a -> WrapLedgerConfig a)
-> NP WrapPartialLedgerConfig xs
-> NP WrapLedgerConfig xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap Proxy SingleEraBlock
proxySingle (EpochInfo Identity
-> WrapPartialLedgerConfig a -> WrapLedgerConfig a
forall blk.
HasPartialLedgerConfig blk =>
EpochInfo Identity
-> WrapPartialLedgerConfig blk -> WrapLedgerConfig blk
completeLedgerConfig'' EpochInfo Identity
ei) NP WrapPartialLedgerConfig xs
pcfgs
    ei :: EpochInfo Identity
ei    = Shape xs
-> TransitionInfo
-> HardForkState (Ticked :.: LedgerState) xs
-> EpochInfo Identity
forall (xs :: [*]) (f :: * -> *).
Shape xs
-> TransitionInfo -> HardForkState f xs -> EpochInfo Identity
State.epochInfoPrecomputedTransitionInfo
              Shape xs
hardForkLedgerConfigShape
              TransitionInfo
transition
              HardForkState (Ticked :.: LedgerState) xs
hardForkState

    injectTxs :: InPairs InjectTx xs
    injectTxs :: InPairs InjectTx xs
injectTxs = NP WrapLedgerConfig xs
-> InPairs (RequiringBoth WrapLedgerConfig InjectTx) xs
-> InPairs InjectTx 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 InjectTx) xs
forall (xs :: [*]).
CanHardFork xs =>
InPairs (RequiringBoth WrapLedgerConfig InjectTx) xs
hardForkInjectTxs

    errInjections :: NP (Injection WrapApplyTxErr xs) xs
    errInjections :: NP (Injection WrapApplyTxErr xs) xs
errInjections = NP (Injection WrapApplyTxErr xs) xs
forall k (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections

    applyCurrent
      :: forall blk. SingleEraBlock blk
      => WrapLedgerConfig                                              blk
      -> Injection WrapApplyTxErr xs                                   blk
      -> Product GenTx (Ticked :.: LedgerState)                        blk
      -> (Except (HardForkApplyTxErr xs) :.: (Ticked :.: LedgerState)) blk
    applyCurrent :: WrapLedgerConfig blk
-> Injection WrapApplyTxErr xs blk
-> Product GenTx (Ticked :.: LedgerState) blk
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity)
     (Ticked :.: LedgerState)
     blk
applyCurrent WrapLedgerConfig blk
cfg Injection WrapApplyTxErr xs blk
injectErr (Pair GenTx blk
tx (Comp Ticked (LedgerState blk)
st)) = ExceptT
  (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk)
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity)
     (Ticked :.: LedgerState)
     blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (ExceptT
   (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk)
 -> (:.:)
      (ExceptT (HardForkApplyTxErr xs) Identity)
      (Ticked :.: LedgerState)
      blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk)
-> (:.:)
     (ExceptT (HardForkApplyTxErr xs) Identity)
     (Ticked :.: LedgerState)
     blk
forall a b. (a -> b) -> a -> b
$ (Ticked (LedgerState blk) -> (:.:) Ticked LedgerState blk)
-> ExceptT
     (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk))
-> ExceptT
     (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ticked (LedgerState blk) -> (:.:) Ticked LedgerState blk
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp (ExceptT
   (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk))
 -> ExceptT
      (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk))
-> ExceptT
     (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk))
-> ExceptT
     (HardForkApplyTxErr xs) Identity ((:.:) Ticked LedgerState blk)
forall a b. (a -> b) -> a -> b
$
      (ApplyTxErr blk -> HardForkApplyTxErr xs)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
-> ExceptT
     (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk))
forall e e' a. (e -> e') -> Except e a -> Except e' a
withExcept (Injection WrapApplyTxErr xs blk
-> ApplyTxErr blk -> HardForkApplyTxErr xs
forall (xs :: [*]) blk.
Injection WrapApplyTxErr xs blk
-> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Injection WrapApplyTxErr xs blk
injectErr) (Except (ApplyTxErr blk) (Ticked (LedgerState blk))
 -> ExceptT
      (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk)))
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
-> ExceptT
     (HardForkApplyTxErr xs) Identity (Ticked (LedgerState blk))
forall a b. (a -> b) -> a -> b
$
        LedgerConfig blk
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
forall blk.
(SingleEraBlock blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk
-> Except (ApplyTxErr blk) (TickedLedgerState blk)
apply (WrapLedgerConfig blk -> LedgerConfig blk
forall blk. WrapLedgerConfig blk -> LedgerConfig blk
unwrapLedgerConfig WrapLedgerConfig blk
cfg) SlotNo
slot GenTx blk
tx Ticked (LedgerState blk)
st

newtype instance TxId (GenTx (HardForkBlock xs)) = HardForkGenTxId {
      TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId :: OneEraGenTxId xs
    }
  deriving (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, 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, 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, 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
. (forall a.
 Injection GenTx xs a
 -> (:.:) [] GenTx a -> K [GenTx (HardForkBlock xs)] a)
-> Prod NS (Injection GenTx xs) xs
-> NS ([] :.: GenTx) xs
-> NS (K [GenTx (HardForkBlock xs)]) xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(SListIN (Prod h) xs, HAp h, HAp (Prod h)) =>
(forall (a :: k). f a -> f' a -> f'' a)
-> Prod h f xs -> h f' xs -> h f'' xs
hzipWith (\Injection GenTx xs a
inj -> [GenTx (HardForkBlock xs)] -> K [GenTx (HardForkBlock xs)] a
forall k a (b :: k). a -> K a b
K ([GenTx (HardForkBlock xs)] -> K [GenTx (HardForkBlock xs)] a)
-> ((:.:) [] GenTx a -> [GenTx (HardForkBlock xs)])
-> (:.:) [] GenTx a
-> K [GenTx (HardForkBlock xs)] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenTx a -> GenTx (HardForkBlock xs))
-> [GenTx a] -> [GenTx (HardForkBlock xs)]
forall a b. (a -> b) -> [a] -> [b]
map (Injection GenTx xs a -> GenTx a -> GenTx (HardForkBlock xs)
forall blk.
Injection GenTx xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
mkTx Injection GenTx xs a
inj) ([GenTx a] -> [GenTx (HardForkBlock xs)])
-> ((:.:) [] GenTx a -> [GenTx a])
-> (:.:) [] GenTx a
-> [GenTx (HardForkBlock xs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.:) [] GenTx a -> [GenTx a]
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp) Prod NS (Injection GenTx xs) xs
forall k (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections
      (NS ([] :.: GenTx) xs -> NS (K [GenTx (HardForkBlock xs)]) xs)
-> (HardForkBlock xs -> NS ([] :.: GenTx) xs)
-> HardForkBlock xs
-> NS (K [GenTx (HardForkBlock xs)]) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy HasTxs
-> (forall a. HasTxs a => I a -> (:.:) [] GenTx a)
-> NS I 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 HasTxs
forall k (t :: k). Proxy t
Proxy @HasTxs) ([GenTx a] -> (:.:) [] GenTx a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp ([GenTx a] -> (:.:) [] GenTx a)
-> (I a -> [GenTx a]) -> I a -> (:.:) [] GenTx a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [GenTx a]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs (a -> [GenTx a]) -> (I a -> a) -> I a -> [GenTx a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I a -> a
forall a. I a -> a
unI)
      (NS I xs -> NS ([] :.: GenTx) xs)
-> (HardForkBlock xs -> NS I xs)
-> HardForkBlock xs
-> NS ([] :.: GenTx) 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
      mkTx :: Injection GenTx xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
      mkTx :: Injection GenTx xs blk -> GenTx blk -> GenTx (HardForkBlock xs)
mkTx Injection GenTx xs blk
inj = OneEraGenTx xs -> GenTx (HardForkBlock xs)
forall (xs :: [*]). OneEraGenTx xs -> GenTx (HardForkBlock xs)
HardForkGenTx (OneEraGenTx xs -> GenTx (HardForkBlock xs))
-> (GenTx blk -> OneEraGenTx xs)
-> GenTx blk
-> GenTx (HardForkBlock xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS GenTx xs -> OneEraGenTx xs
forall (xs :: [*]). NS GenTx xs -> OneEraGenTx xs
OneEraGenTx (NS GenTx xs -> OneEraGenTx xs)
-> (GenTx blk -> NS GenTx xs) -> GenTx blk -> OneEraGenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K (NS GenTx xs) blk -> NS GenTx xs
forall k a (b :: k). K a b -> a
unK (K (NS GenTx xs) blk -> NS GenTx xs)
-> (GenTx blk -> K (NS GenTx xs) blk) -> GenTx blk -> NS GenTx xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Injection GenTx xs blk -> GenTx blk -> K (NS GenTx xs) blk
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn Injection GenTx xs blk
inj

{-------------------------------------------------------------------------------
  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 :: Injection WrapApplyTxErr xs blk
                 -> ApplyTxErr blk
                 -> HardForkApplyTxErr xs
injectApplyTxErr :: Injection WrapApplyTxErr xs blk
-> ApplyTxErr blk -> HardForkApplyTxErr xs
injectApplyTxErr Injection WrapApplyTxErr xs blk
inj =
      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
. K (NS WrapApplyTxErr xs) blk -> NS WrapApplyTxErr xs
forall k a (b :: k). K a b -> a
unK
    (K (NS WrapApplyTxErr xs) blk -> NS WrapApplyTxErr xs)
-> (ApplyTxErr blk -> K (NS WrapApplyTxErr xs) blk)
-> ApplyTxErr blk
-> NS WrapApplyTxErr xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Injection WrapApplyTxErr xs blk
-> WrapApplyTxErr blk -> K (NS WrapApplyTxErr xs) blk
forall k (f :: k -> *) (g :: k -> *) (a :: k).
(-.->) f g a -> f a -> g a
apFn Injection WrapApplyTxErr xs blk
inj
    (WrapApplyTxErr blk -> K (NS WrapApplyTxErr xs) blk)
-> (ApplyTxErr blk -> WrapApplyTxErr blk)
-> ApplyTxErr blk
-> K (NS WrapApplyTxErr xs) blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr