{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | The mempool capacity counts the endorser-block capacity.
--
-- Only Dijkstra has a non-zero 'Ledger.ebCapacityTxMeasure', and its
-- parameters come from an arbitrary ledger state. A test block with fixed
-- capacities pins the formula to a number.
module Test.Consensus.Mempool.Capacity (tests) where

import Cardano.Ledger.BaseTypes (knownNonZeroBounded)
import qualified Cardano.Slotting.Time as Time
import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise
import Control.DeepSeq (NFData)
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Block as Block
import Ouroboros.Consensus.Block.SupportsPeras (pattern PerasEnabled)
import Ouroboros.Consensus.Config.SecurityParam (SecurityParam (..))
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import Ouroboros.Consensus.Ledger.Abstract
  ( LedgerTables (..)
  , ValuesMK (..)
  , convertMapKind
  )
import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Mempool
  ( MempoolCapacityBytesOverride (..)
  , computeMempoolCapacity
  )
import Ouroboros.Consensus.Storage.LedgerDB
import Ouroboros.Consensus.Ticked (Ticked)
import Ouroboros.Consensus.Util.IndexedMemPack
import Test.Tasty
import Test.Tasty.QuickCheck
import Test.Util.TestBlock
  ( TestBlockLedgerConfig
  , TestBlockWith
  , testBlockLedgerConfigFrom
  , testInitLedgerWithState
  )
import qualified Test.Util.TestBlock as TestBlock

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Mempool capacity"
    [ TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"the mempool holds two blocks and two endorser blocks"
        Property
prop_mempoolCapacityCountsEbCapacity
    ]

-- | Without an override the mempool holds two blocks and two endorser blocks:
-- 2 * ('blockCapacity' + 'ebCapacity') bytes.
prop_mempoolCapacityCountsEbCapacity :: Property
prop_mempoolCapacityCountsEbCapacity :: Property
prop_mempoolCapacityCountsEbCapacity =
  Property -> Property
forall prop. Testable prop => prop -> Property
once (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    LedgerConfig TestBlock
-> TickedLedgerState TestBlock EmptyMK
-> MempoolCapacityBytesOverride
-> TxMeasure TestBlock
forall blk (mk :: MapKind).
LedgerSupportsMempool blk =>
LedgerConfig blk
-> TickedLedgerState blk mk
-> MempoolCapacityBytesOverride
-> TxMeasure blk
computeMempoolCapacity LedgerConfig TestBlock
TestBlockLedgerConfig
cfg TickedLedgerState TestBlock EmptyMK
st MempoolCapacityBytesOverride
NoMempoolCapacityBytesOverride
      TxMeasure TestBlock -> TxMeasure TestBlock -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxMeasurePhase1 TestBlock
-> TxMeasurePhase2 TestBlock -> TxMeasure TestBlock
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
Ledger.TxMeasure
        (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow (Word32 -> ByteSize32
Ledger.ByteSize32 Word32
10240))
        TrivialTxMeasurePhase2
TxMeasurePhase2 TestBlock
Ledger.TrivialTxMeasurePhase2
 where
  cfg :: TestBlockLedgerConfig
  cfg :: TestBlockLedgerConfig
cfg =
    EraParams -> TestBlockLedgerConfig
testBlockLedgerConfigFrom (EraParams -> TestBlockLedgerConfig)
-> EraParams -> TestBlockLedgerConfig
forall a b. (a -> b) -> a -> b
$
      SecurityParam -> SlotLength -> PerasEnabled () -> EraParams
HardFork.defaultEraParams
        (NonZero Word64 -> SecurityParam
SecurityParam (NonZero Word64 -> SecurityParam)
-> NonZero Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @10)
        (Integer -> SlotLength
Time.slotLengthFromSec Integer
2)
        (() -> PerasEnabled ()
forall a. a -> PerasEnabled a
PerasEnabled ())

  st :: Ledger.TickedLedgerState TestBlock Ledger.EmptyMK
  st :: TickedLedgerState TestBlock EmptyMK
st = LedgerState TestBlock EmptyMK
-> TickedLedgerState TestBlock EmptyMK
forall ptype (mk :: MapKind).
LedgerState (TestBlockWith ptype) mk
-> Ticked LedgerState (TestBlockWith ptype) mk
TestBlock.TickedTestLedger (LedgerState TestBlock EmptyMK
 -> TickedLedgerState TestBlock EmptyMK)
-> LedgerState TestBlock EmptyMK
-> TickedLedgerState TestBlock EmptyMK
forall a b. (a -> b) -> a -> b
$ PayloadDependentState Tx EmptyMK -> LedgerState TestBlock EmptyMK
forall ptype (mk :: MapKind).
PayloadDependentState ptype mk
-> LedgerState (TestBlockWith ptype) mk
testInitLedgerWithState PayloadDependentState Tx EmptyMK
forall (mk :: MapKind). PayloadDependentState Tx mk
NoPayLoadDependentState

type TestBlock = TestBlockWith Tx

-- | The capacity test needs no transaction content, only a block type whose
-- 'Ledger.TxLimits' instance it controls.
data Tx = Tx
  deriving stock (Tx -> Tx -> Bool
(Tx -> Tx -> Bool) -> (Tx -> Tx -> Bool) -> Eq Tx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tx -> Tx -> Bool
== :: Tx -> Tx -> Bool
$c/= :: Tx -> Tx -> Bool
/= :: Tx -> Tx -> Bool
Eq, Eq Tx
Eq Tx =>
(Tx -> Tx -> Ordering)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Bool)
-> (Tx -> Tx -> Tx)
-> (Tx -> Tx -> Tx)
-> Ord Tx
Tx -> Tx -> Bool
Tx -> Tx -> Ordering
Tx -> Tx -> Tx
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Tx -> Tx -> Ordering
compare :: Tx -> Tx -> Ordering
$c< :: Tx -> Tx -> Bool
< :: Tx -> Tx -> Bool
$c<= :: Tx -> Tx -> Bool
<= :: Tx -> Tx -> Bool
$c> :: Tx -> Tx -> Bool
> :: Tx -> Tx -> Bool
$c>= :: Tx -> Tx -> Bool
>= :: Tx -> Tx -> Bool
$cmax :: Tx -> Tx -> Tx
max :: Tx -> Tx -> Tx
$cmin :: Tx -> Tx -> Tx
min :: Tx -> Tx -> Tx
Ord, (forall x. Tx -> Rep Tx x)
-> (forall x. Rep Tx x -> Tx) -> Generic Tx
forall x. Rep Tx x -> Tx
forall x. Tx -> Rep Tx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Tx -> Rep Tx x
from :: forall x. Tx -> Rep Tx x
$cto :: forall x. Rep Tx x -> Tx
to :: forall x. Rep Tx x -> Tx
Generic, Int -> Tx -> ShowS
[Tx] -> ShowS
Tx -> TestName
(Int -> Tx -> ShowS)
-> (Tx -> TestName) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tx -> ShowS
showsPrec :: Int -> Tx -> ShowS
$cshow :: Tx -> TestName
show :: Tx -> TestName
$cshowList :: [Tx] -> ShowS
showList :: [Tx] -> ShowS
Show)
  deriving anyclass (Context -> Tx -> IO (Maybe ThunkInfo)
Proxy Tx -> TestName
(Context -> Tx -> IO (Maybe ThunkInfo))
-> (Context -> Tx -> IO (Maybe ThunkInfo))
-> (Proxy Tx -> TestName)
-> NoThunks Tx
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> Tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> Tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Tx -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Tx -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Tx -> TestName
showTypeOf :: Proxy Tx -> TestName
NoThunks, Tx -> ()
(Tx -> ()) -> NFData Tx
forall a. (a -> ()) -> NFData a
$crnf :: Tx -> ()
rnf :: Tx -> ()
NFData)

blockCapacity :: Ledger.ByteSize32
blockCapacity :: ByteSize32
blockCapacity = Word32 -> ByteSize32
Ledger.ByteSize32 Word32
4096

-- | Non-zero, so that a mempool capacity that ignores it differs from one that
-- counts it.
ebCapacity :: Ledger.ByteSize32
ebCapacity :: ByteSize32
ebCapacity = Word32 -> ByteSize32
Ledger.ByteSize32 Word32
1024

instance Ledger.TxLimits TestBlock where
  type TxMeasurePhase1 TestBlock = Ledger.IgnoringOverflow Ledger.ByteSize32
  type TxMeasurePhase2 TestBlock = Ledger.TrivialTxMeasurePhase2

  txWireSize :: GenTx TestBlock -> SizeInBytes
txWireSize GenTx TestBlock
_ = SizeInBytes
0

  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig TestBlock
-> TickedLedgerState TestBlock mk -> TxMeasure TestBlock
blockCapacityTxMeasure LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock mk
_st =
    TxMeasurePhase1 TestBlock
-> TxMeasurePhase2 TestBlock -> TxMeasure TestBlock
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
Ledger.TxMeasure
      (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow ByteSize32
blockCapacity)
      TrivialTxMeasurePhase2
TxMeasurePhase2 TestBlock
Ledger.TrivialTxMeasurePhase2

  txMeasurePhase1 :: LedgerConfig TestBlock
-> TickedLedgerState TestBlock EmptyMK
-> GenTx TestBlock
-> Except (ApplyTxErr TestBlock) (TxMeasurePhase1 TestBlock)
txMeasurePhase1 LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock EmptyMK
_st GenTx TestBlock
_tx = TxMeasurePhase1 TestBlock
-> Except (ApplyTxErr TestBlock) (TxMeasurePhase1 TestBlock)
forall a. a -> ExceptT (ApplyTxErr TestBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeasurePhase1 TestBlock
 -> Except (ApplyTxErr TestBlock) (TxMeasurePhase1 TestBlock))
-> TxMeasurePhase1 TestBlock
-> Except (ApplyTxErr TestBlock) (TxMeasurePhase1 TestBlock)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow ByteSize32
forall a. Monoid a => a
mempty
  txMeasurePhase2 :: LedgerConfig TestBlock
-> TickedLedgerState TestBlock ValuesMK
-> GenTx TestBlock
-> Except (ApplyTxErr TestBlock) (TxMeasurePhase2 TestBlock)
txMeasurePhase2 LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock ValuesMK
_st GenTx TestBlock
_tx = TrivialTxMeasurePhase2
-> ExceptT () Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
Ledger.TrivialTxMeasurePhase2

  type TxEbMeasure TestBlock = Ledger.TxMeasure TestBlock

  txEbMeasure :: forall (proxy :: * -> *).
proxy TestBlock -> TxMeasure TestBlock -> TxEbMeasure TestBlock
txEbMeasure proxy TestBlock
_ = TxMeasure TestBlock -> TxEbMeasure TestBlock
TxMeasure TestBlock -> TxMeasure TestBlock
forall a. a -> a
id

  ebCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig TestBlock
-> TickedLedgerState TestBlock mk -> TxEbMeasure TestBlock
ebCapacityTxMeasure LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock mk
_st =
    TxMeasurePhase1 TestBlock
-> TxMeasurePhase2 TestBlock -> TxMeasure TestBlock
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
Ledger.TxMeasure
      (ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow ByteSize32
ebCapacity)
      TrivialTxMeasurePhase2
TxMeasurePhase2 TestBlock
Ledger.TrivialTxMeasurePhase2

  mempoolEbReservation :: forall (proxy :: * -> *).
proxy TestBlock -> TxEbMeasure TestBlock -> TxMeasure TestBlock
mempoolEbReservation proxy TestBlock
_ = TxEbMeasure TestBlock -> TxMeasure TestBlock
TxMeasure TestBlock -> TxMeasure TestBlock
forall a. a -> a
id

{-------------------------------------------------------------------------------
  Block scaffolding

  Copied from 'Test.Consensus.Mempool.Fairness.TestBlock'. That block fixes its
  block capacity at one byte, which this property cannot use.
-------------------------------------------------------------------------------}

instance TestBlock.PayloadSemantics Tx where
  data PayloadDependentState Tx mk = NoPayLoadDependentState
    deriving (Int -> PayloadDependentState Tx mk -> ShowS
[PayloadDependentState Tx mk] -> ShowS
PayloadDependentState Tx mk -> TestName
(Int -> PayloadDependentState Tx mk -> ShowS)
-> (PayloadDependentState Tx mk -> TestName)
-> ([PayloadDependentState Tx mk] -> ShowS)
-> Show (PayloadDependentState Tx mk)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
forall (mk :: MapKind). Int -> PayloadDependentState Tx mk -> ShowS
forall (mk :: MapKind). [PayloadDependentState Tx mk] -> ShowS
forall (mk :: MapKind). PayloadDependentState Tx mk -> TestName
$cshowsPrec :: forall (mk :: MapKind). Int -> PayloadDependentState Tx mk -> ShowS
showsPrec :: Int -> PayloadDependentState Tx mk -> ShowS
$cshow :: forall (mk :: MapKind). PayloadDependentState Tx mk -> TestName
show :: PayloadDependentState Tx mk -> TestName
$cshowList :: forall (mk :: MapKind). [PayloadDependentState Tx mk] -> ShowS
showList :: [PayloadDependentState Tx mk] -> ShowS
Show, PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
(PayloadDependentState Tx mk
 -> PayloadDependentState Tx mk -> Bool)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> Bool)
-> Eq (PayloadDependentState Tx mk)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$c== :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
== :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$c/= :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
/= :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
Eq, Eq (PayloadDependentState Tx mk)
Eq (PayloadDependentState Tx mk) =>
(PayloadDependentState Tx mk
 -> PayloadDependentState Tx mk -> Ordering)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> Bool)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> Bool)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> Bool)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> Bool)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> PayloadDependentState Tx mk)
-> (PayloadDependentState Tx mk
    -> PayloadDependentState Tx mk -> PayloadDependentState Tx mk)
-> Ord (PayloadDependentState Tx mk)
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> Ordering
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
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
forall (mk :: MapKind). Eq (PayloadDependentState Tx mk)
forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
forall (mk :: MapKind).
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> Ordering
forall (mk :: MapKind).
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
$ccompare :: forall (mk :: MapKind).
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> Ordering
compare :: PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> Ordering
$c< :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
< :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$c<= :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
<= :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$c> :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
> :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$c>= :: forall (mk :: MapKind).
PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
>= :: PayloadDependentState Tx mk -> PayloadDependentState Tx mk -> Bool
$cmax :: forall (mk :: MapKind).
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
max :: PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
$cmin :: forall (mk :: MapKind).
PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
min :: PayloadDependentState Tx mk
-> PayloadDependentState Tx mk -> PayloadDependentState Tx mk
Ord, (forall x.
 PayloadDependentState Tx mk -> Rep (PayloadDependentState Tx mk) x)
-> (forall x.
    Rep (PayloadDependentState Tx mk) x -> PayloadDependentState Tx mk)
-> Generic (PayloadDependentState Tx mk)
forall x.
Rep (PayloadDependentState Tx mk) x -> PayloadDependentState Tx mk
forall x.
PayloadDependentState Tx mk -> Rep (PayloadDependentState Tx mk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (mk :: MapKind) x.
Rep (PayloadDependentState Tx mk) x -> PayloadDependentState Tx mk
forall (mk :: MapKind) x.
PayloadDependentState Tx mk -> Rep (PayloadDependentState Tx mk) x
$cfrom :: forall (mk :: MapKind) x.
PayloadDependentState Tx mk -> Rep (PayloadDependentState Tx mk) x
from :: forall x.
PayloadDependentState Tx mk -> Rep (PayloadDependentState Tx mk) x
$cto :: forall (mk :: MapKind) x.
Rep (PayloadDependentState Tx mk) x -> PayloadDependentState Tx mk
to :: forall x.
Rep (PayloadDependentState Tx mk) x -> PayloadDependentState Tx mk
Generic, Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
Proxy (PayloadDependentState Tx mk) -> TestName
(Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo))
-> (Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo))
-> (Proxy (PayloadDependentState Tx mk) -> TestName)
-> NoThunks (PayloadDependentState Tx mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
forall (mk :: MapKind).
Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (PayloadDependentState Tx mk) -> TestName
$cnoThunks :: forall (mk :: MapKind).
Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
noThunks :: Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (mk :: MapKind).
Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (mk :: MapKind).
Proxy (PayloadDependentState Tx mk) -> TestName
showTypeOf :: Proxy (PayloadDependentState Tx mk) -> TestName
NoThunks)
    deriving anyclass [PayloadDependentState Tx mk] -> Encoding
PayloadDependentState Tx mk -> Encoding
(PayloadDependentState Tx mk -> Encoding)
-> (forall s. Decoder s (PayloadDependentState Tx mk))
-> ([PayloadDependentState Tx mk] -> Encoding)
-> (forall s. Decoder s [PayloadDependentState Tx mk])
-> Serialise (PayloadDependentState Tx mk)
forall s. Decoder s [PayloadDependentState Tx mk]
forall s. Decoder s (PayloadDependentState Tx mk)
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall (mk :: MapKind). [PayloadDependentState Tx mk] -> Encoding
forall (mk :: MapKind). PayloadDependentState Tx mk -> Encoding
forall (mk :: MapKind) s. Decoder s [PayloadDependentState Tx mk]
forall (mk :: MapKind) s. Decoder s (PayloadDependentState Tx mk)
$cencode :: forall (mk :: MapKind). PayloadDependentState Tx mk -> Encoding
encode :: PayloadDependentState Tx mk -> Encoding
$cdecode :: forall (mk :: MapKind) s. Decoder s (PayloadDependentState Tx mk)
decode :: forall s. Decoder s (PayloadDependentState Tx mk)
$cencodeList :: forall (mk :: MapKind). [PayloadDependentState Tx mk] -> Encoding
encodeList :: [PayloadDependentState Tx mk] -> Encoding
$cdecodeList :: forall (mk :: MapKind) s. Decoder s [PayloadDependentState Tx mk]
decodeList :: forall s. Decoder s [PayloadDependentState Tx mk]
Serialise

  type PayloadDependentError Tx = ()

  applyPayload :: PayloadDependentState Tx ValuesMK
-> Tx
-> Either
     (PayloadDependentError Tx) (PayloadDependentState Tx TrackingMK)
applyPayload PayloadDependentState Tx ValuesMK
R:PayloadDependentStateTxmk ValuesMK
NoPayLoadDependentState Tx
_tx = PayloadDependentState Tx TrackingMK
-> Either () (PayloadDependentState Tx TrackingMK)
forall a b. b -> Either a b
Right PayloadDependentState Tx TrackingMK
forall (mk :: MapKind). PayloadDependentState Tx mk
NoPayLoadDependentState

  getPayloadKeySets :: Tx -> LedgerTables TestBlock KeysMK
getPayloadKeySets = LedgerTables TestBlock KeysMK
-> Tx -> LedgerTables TestBlock KeysMK
forall a b. a -> b -> a
const LedgerTables TestBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

data instance Block.CodecConfig TestBlock = TestBlockCodecConfig
  deriving (Int -> CodecConfig TestBlock -> ShowS
[CodecConfig TestBlock] -> ShowS
CodecConfig TestBlock -> TestName
(Int -> CodecConfig TestBlock -> ShowS)
-> (CodecConfig TestBlock -> TestName)
-> ([CodecConfig TestBlock] -> ShowS)
-> Show (CodecConfig TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodecConfig TestBlock -> ShowS
showsPrec :: Int -> CodecConfig TestBlock -> ShowS
$cshow :: CodecConfig TestBlock -> TestName
show :: CodecConfig TestBlock -> TestName
$cshowList :: [CodecConfig TestBlock] -> ShowS
showList :: [CodecConfig TestBlock] -> ShowS
Show, (forall x. CodecConfig TestBlock -> Rep (CodecConfig TestBlock) x)
-> (forall x.
    Rep (CodecConfig TestBlock) x -> CodecConfig TestBlock)
-> Generic (CodecConfig TestBlock)
forall x. Rep (CodecConfig TestBlock) x -> CodecConfig TestBlock
forall x. CodecConfig TestBlock -> Rep (CodecConfig TestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CodecConfig TestBlock -> Rep (CodecConfig TestBlock) x
from :: forall x. CodecConfig TestBlock -> Rep (CodecConfig TestBlock) x
$cto :: forall x. Rep (CodecConfig TestBlock) x -> CodecConfig TestBlock
to :: forall x. Rep (CodecConfig TestBlock) x -> CodecConfig TestBlock
Generic, Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo)
Proxy (CodecConfig TestBlock) -> TestName
(Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig TestBlock) -> TestName)
-> NoThunks (CodecConfig TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CodecConfig TestBlock) -> TestName
showTypeOf :: Proxy (CodecConfig TestBlock) -> TestName
NoThunks)

data instance Block.StorageConfig TestBlock = TestBlockStorageConfig
  deriving (Int -> StorageConfig TestBlock -> ShowS
[StorageConfig TestBlock] -> ShowS
StorageConfig TestBlock -> TestName
(Int -> StorageConfig TestBlock -> ShowS)
-> (StorageConfig TestBlock -> TestName)
-> ([StorageConfig TestBlock] -> ShowS)
-> Show (StorageConfig TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageConfig TestBlock -> ShowS
showsPrec :: Int -> StorageConfig TestBlock -> ShowS
$cshow :: StorageConfig TestBlock -> TestName
show :: StorageConfig TestBlock -> TestName
$cshowList :: [StorageConfig TestBlock] -> ShowS
showList :: [StorageConfig TestBlock] -> ShowS
Show, (forall x.
 StorageConfig TestBlock -> Rep (StorageConfig TestBlock) x)
-> (forall x.
    Rep (StorageConfig TestBlock) x -> StorageConfig TestBlock)
-> Generic (StorageConfig TestBlock)
forall x.
Rep (StorageConfig TestBlock) x -> StorageConfig TestBlock
forall x.
StorageConfig TestBlock -> Rep (StorageConfig TestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
StorageConfig TestBlock -> Rep (StorageConfig TestBlock) x
from :: forall x.
StorageConfig TestBlock -> Rep (StorageConfig TestBlock) x
$cto :: forall x.
Rep (StorageConfig TestBlock) x -> StorageConfig TestBlock
to :: forall x.
Rep (StorageConfig TestBlock) x -> StorageConfig TestBlock
Generic, Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo)
Proxy (StorageConfig TestBlock) -> TestName
(Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig TestBlock) -> TestName)
-> NoThunks (StorageConfig TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (StorageConfig TestBlock) -> TestName
showTypeOf :: Proxy (StorageConfig TestBlock) -> TestName
NoThunks)

newtype instance Ledger.GenTx TestBlock = TestBlockGenTx Tx
  deriving stock (forall x. GenTx TestBlock -> Rep (GenTx TestBlock) x)
-> (forall x. Rep (GenTx TestBlock) x -> GenTx TestBlock)
-> Generic (GenTx TestBlock)
forall x. Rep (GenTx TestBlock) x -> GenTx TestBlock
forall x. GenTx TestBlock -> Rep (GenTx TestBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenTx TestBlock -> Rep (GenTx TestBlock) x
from :: forall x. GenTx TestBlock -> Rep (GenTx TestBlock) x
$cto :: forall x. Rep (GenTx TestBlock) x -> GenTx TestBlock
to :: forall x. Rep (GenTx TestBlock) x -> GenTx TestBlock
Generic
  deriving newtype (Int -> GenTx TestBlock -> ShowS
[GenTx TestBlock] -> ShowS
GenTx TestBlock -> TestName
(Int -> GenTx TestBlock -> ShowS)
-> (GenTx TestBlock -> TestName)
-> ([GenTx TestBlock] -> ShowS)
-> Show (GenTx TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx TestBlock -> ShowS
showsPrec :: Int -> GenTx TestBlock -> ShowS
$cshow :: GenTx TestBlock -> TestName
show :: GenTx TestBlock -> TestName
$cshowList :: [GenTx TestBlock] -> ShowS
showList :: [GenTx TestBlock] -> ShowS
Show, Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
Proxy (GenTx TestBlock) -> TestName
(Context -> GenTx TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> GenTx TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx TestBlock) -> TestName)
-> NoThunks (GenTx TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (GenTx TestBlock) -> TestName
showTypeOf :: Proxy (GenTx TestBlock) -> TestName
NoThunks, GenTx TestBlock -> GenTx TestBlock -> Bool
(GenTx TestBlock -> GenTx TestBlock -> Bool)
-> (GenTx TestBlock -> GenTx TestBlock -> Bool)
-> Eq (GenTx TestBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx TestBlock -> GenTx TestBlock -> Bool
== :: GenTx TestBlock -> GenTx TestBlock -> Bool
$c/= :: GenTx TestBlock -> GenTx TestBlock -> Bool
/= :: GenTx TestBlock -> GenTx TestBlock -> Bool
Eq, Eq (GenTx TestBlock)
Eq (GenTx TestBlock) =>
(GenTx TestBlock -> GenTx TestBlock -> Ordering)
-> (GenTx TestBlock -> GenTx TestBlock -> Bool)
-> (GenTx TestBlock -> GenTx TestBlock -> Bool)
-> (GenTx TestBlock -> GenTx TestBlock -> Bool)
-> (GenTx TestBlock -> GenTx TestBlock -> Bool)
-> (GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock)
-> (GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock)
-> Ord (GenTx TestBlock)
GenTx TestBlock -> GenTx TestBlock -> Bool
GenTx TestBlock -> GenTx TestBlock -> Ordering
GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GenTx TestBlock -> GenTx TestBlock -> Ordering
compare :: GenTx TestBlock -> GenTx TestBlock -> Ordering
$c< :: GenTx TestBlock -> GenTx TestBlock -> Bool
< :: GenTx TestBlock -> GenTx TestBlock -> Bool
$c<= :: GenTx TestBlock -> GenTx TestBlock -> Bool
<= :: GenTx TestBlock -> GenTx TestBlock -> Bool
$c> :: GenTx TestBlock -> GenTx TestBlock -> Bool
> :: GenTx TestBlock -> GenTx TestBlock -> Bool
$c>= :: GenTx TestBlock -> GenTx TestBlock -> Bool
>= :: GenTx TestBlock -> GenTx TestBlock -> Bool
$cmax :: GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock
max :: GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock
$cmin :: GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock
min :: GenTx TestBlock -> GenTx TestBlock -> GenTx TestBlock
Ord, GenTx TestBlock -> ()
(GenTx TestBlock -> ()) -> NFData (GenTx TestBlock)
forall a. (a -> ()) -> NFData a
$crnf :: GenTx TestBlock -> ()
rnf :: GenTx TestBlock -> ()
NFData)

newtype instance Ledger.Validated (Ledger.GenTx TestBlock)
  = ValidatedGenTx (Ledger.GenTx TestBlock)
  deriving stock (forall x.
 Validated (GenTx TestBlock) -> Rep (Validated (GenTx TestBlock)) x)
-> (forall x.
    Rep (Validated (GenTx TestBlock)) x -> Validated (GenTx TestBlock))
-> Generic (Validated (GenTx TestBlock))
forall x.
Rep (Validated (GenTx TestBlock)) x -> Validated (GenTx TestBlock)
forall x.
Validated (GenTx TestBlock) -> Rep (Validated (GenTx TestBlock)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
Validated (GenTx TestBlock) -> Rep (Validated (GenTx TestBlock)) x
from :: forall x.
Validated (GenTx TestBlock) -> Rep (Validated (GenTx TestBlock)) x
$cto :: forall x.
Rep (Validated (GenTx TestBlock)) x -> Validated (GenTx TestBlock)
to :: forall x.
Rep (Validated (GenTx TestBlock)) x -> Validated (GenTx TestBlock)
Generic
  deriving newtype (Int -> Validated (GenTx TestBlock) -> ShowS
[Validated (GenTx TestBlock)] -> ShowS
Validated (GenTx TestBlock) -> TestName
(Int -> Validated (GenTx TestBlock) -> ShowS)
-> (Validated (GenTx TestBlock) -> TestName)
-> ([Validated (GenTx TestBlock)] -> ShowS)
-> Show (Validated (GenTx TestBlock))
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Validated (GenTx TestBlock) -> ShowS
showsPrec :: Int -> Validated (GenTx TestBlock) -> ShowS
$cshow :: Validated (GenTx TestBlock) -> TestName
show :: Validated (GenTx TestBlock) -> TestName
$cshowList :: [Validated (GenTx TestBlock)] -> ShowS
showList :: [Validated (GenTx TestBlock)] -> ShowS
Show, Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx TestBlock)) -> TestName
(Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx TestBlock)) -> TestName)
-> NoThunks (Validated (GenTx TestBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Validated (GenTx TestBlock)) -> TestName
showTypeOf :: Proxy (Validated (GenTx TestBlock)) -> TestName
NoThunks)

newtype instance Ledger.TxId (Ledger.GenTx TestBlock) = TestBlockTxId Tx
  deriving stock (forall x.
 TxId (GenTx TestBlock) -> Rep (TxId (GenTx TestBlock)) x)
-> (forall x.
    Rep (TxId (GenTx TestBlock)) x -> TxId (GenTx TestBlock))
-> Generic (TxId (GenTx TestBlock))
forall x. Rep (TxId (GenTx TestBlock)) x -> TxId (GenTx TestBlock)
forall x. TxId (GenTx TestBlock) -> Rep (TxId (GenTx TestBlock)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxId (GenTx TestBlock) -> Rep (TxId (GenTx TestBlock)) x
from :: forall x. TxId (GenTx TestBlock) -> Rep (TxId (GenTx TestBlock)) x
$cto :: forall x. Rep (TxId (GenTx TestBlock)) x -> TxId (GenTx TestBlock)
to :: forall x. Rep (TxId (GenTx TestBlock)) x -> TxId (GenTx TestBlock)
Generic
  deriving newtype (Int -> TxId (GenTx TestBlock) -> ShowS
[TxId (GenTx TestBlock)] -> ShowS
TxId (GenTx TestBlock) -> TestName
(Int -> TxId (GenTx TestBlock) -> ShowS)
-> (TxId (GenTx TestBlock) -> TestName)
-> ([TxId (GenTx TestBlock)] -> ShowS)
-> Show (TxId (GenTx TestBlock))
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId (GenTx TestBlock) -> ShowS
showsPrec :: Int -> TxId (GenTx TestBlock) -> ShowS
$cshow :: TxId (GenTx TestBlock) -> TestName
show :: TxId (GenTx TestBlock) -> TestName
$cshowList :: [TxId (GenTx TestBlock)] -> ShowS
showList :: [TxId (GenTx TestBlock)] -> ShowS
Show, Eq (TxId (GenTx TestBlock))
Eq (TxId (GenTx TestBlock)) =>
(TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Ordering)
-> (TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> (TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> (TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> (TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> (TxId (GenTx TestBlock)
    -> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock))
-> (TxId (GenTx TestBlock)
    -> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock))
-> Ord (TxId (GenTx TestBlock))
TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Ordering
TxId (GenTx TestBlock)
-> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Ordering
compare :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Ordering
$c< :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
< :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
$c<= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
<= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
$c> :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
> :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
$c>= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
>= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
$cmax :: TxId (GenTx TestBlock)
-> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock)
max :: TxId (GenTx TestBlock)
-> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock)
$cmin :: TxId (GenTx TestBlock)
-> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock)
min :: TxId (GenTx TestBlock)
-> TxId (GenTx TestBlock) -> TxId (GenTx TestBlock)
Ord, TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
(TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> (TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool)
-> Eq (TxId (GenTx TestBlock))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
== :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
$c/= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
/= :: TxId (GenTx TestBlock) -> TxId (GenTx TestBlock) -> Bool
Eq)
  deriving anyclass Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx TestBlock)) -> TestName
(Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx TestBlock)) -> TestName)
-> NoThunks (TxId (GenTx TestBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> TestName)
-> NoThunks a
$cnoThunks :: Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (TxId (GenTx TestBlock)) -> TestName
showTypeOf :: Proxy (TxId (GenTx TestBlock)) -> TestName
NoThunks

instance Ledger.HasTxId (Ledger.GenTx TestBlock) where
  txId :: GenTx TestBlock -> TxId (GenTx TestBlock)
txId (TestBlockGenTx Tx
tx) = Tx -> TxId (GenTx TestBlock)
TestBlockTxId Tx
tx

instance Ledger.LedgerSupportsMempool TestBlock where
  applyTx :: LedgerConfig TestBlock
-> WhetherToIntervene
-> SlotNo
-> GenTx TestBlock
-> TickedLedgerState TestBlock ValuesMK
-> Except
     (ApplyTxErr TestBlock)
     (TickedLedgerState TestBlock DiffMK, Validated (GenTx TestBlock))
applyTx LedgerConfig TestBlock
_cfg WhetherToIntervene
_shouldIntervene SlotNo
_slot GenTx TestBlock
gtx TickedLedgerState TestBlock ValuesMK
st =
    (TickedLedgerState TestBlock DiffMK, Validated (GenTx TestBlock))
-> ExceptT
     ()
     Identity
     (TickedLedgerState TestBlock DiffMK, Validated (GenTx TestBlock))
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( LedgerState TestBlock DiffMK -> TickedLedgerState TestBlock DiffMK
forall ptype (mk :: MapKind).
LedgerState (TestBlockWith ptype) mk
-> Ticked LedgerState (TestBlockWith ptype) mk
TestBlock.TickedTestLedger (LedgerState TestBlock DiffMK
 -> TickedLedgerState TestBlock DiffMK)
-> LedgerState TestBlock DiffMK
-> TickedLedgerState TestBlock DiffMK
forall a b. (a -> b) -> a -> b
$
          LedgerState TestBlock ValuesMK -> LedgerState TestBlock DiffMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind (LedgerState TestBlock ValuesMK -> LedgerState TestBlock DiffMK)
-> LedgerState TestBlock ValuesMK -> LedgerState TestBlock DiffMK
forall a b. (a -> b) -> a -> b
$
            TickedLedgerState TestBlock ValuesMK
-> LedgerState TestBlock ValuesMK
forall ptype (mk :: MapKind).
Ticked LedgerState (TestBlockWith ptype) mk
-> LedgerState (TestBlockWith ptype) mk
TestBlock.getTickedTestLedger TickedLedgerState TestBlock ValuesMK
st
      , GenTx TestBlock -> Validated (GenTx TestBlock)
ValidatedGenTx GenTx TestBlock
gtx
      )

  reapplyTx :: HasCallStack =>
LedgerConfig TestBlock
-> SlotNo
-> Validated (GenTx TestBlock)
-> TickedLedgerState TestBlock ValuesMK
-> Except
     (ApplyTxErr TestBlock) (TickedLedgerState TestBlock ValuesMK)
reapplyTx LedgerConfig TestBlock
_cfg SlotNo
_slot Validated (GenTx TestBlock)
_gtx TickedLedgerState TestBlock ValuesMK
gst = TickedLedgerState TestBlock ValuesMK
-> ExceptT () Identity (TickedLedgerState TestBlock ValuesMK)
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TickedLedgerState TestBlock ValuesMK
gst

  txForgetValidated :: Validated (GenTx TestBlock) -> GenTx TestBlock
txForgetValidated (ValidatedGenTx GenTx TestBlock
tx) = GenTx TestBlock
tx

  getTransactionKeySets :: GenTx TestBlock -> LedgerTables TestBlock KeysMK
getTransactionKeySets GenTx TestBlock
_ = LedgerTables TestBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

  mkMempoolApplyTxError :: forall (mk :: MapKind).
TickedLedgerState TestBlock mk
-> Text -> Maybe (ApplyTxErr TestBlock)
mkMempoolApplyTxError = TickedLedgerState TestBlock mk
-> Text -> Maybe (ApplyTxErr TestBlock)
forall blk (mk :: MapKind).
TickedLedgerState blk mk -> Text -> Maybe (ApplyTxErr blk)
Ledger.nothingMkMempoolApplyTxError

type instance Ledger.ApplyTxErr TestBlock = ()

type instance Ledger.TxIn TestBlock = Void
type instance Ledger.TxOut TestBlock = Void

instance Ledger.LedgerTablesAreTrivial Ledger.LedgerState TestBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
convertMapKind (TestBlock.TestLedger Point TestBlock
x PayloadDependentState Tx mk
R:PayloadDependentStateTxmk mk
NoPayLoadDependentState) =
    Point TestBlock
-> PayloadDependentState Tx mk' -> LedgerState TestBlock mk'
forall ptype (mk :: MapKind).
Point (TestBlockWith ptype)
-> PayloadDependentState ptype mk
-> LedgerState (TestBlockWith ptype) mk
TestBlock.TestLedger Point TestBlock
x PayloadDependentState Tx mk'
forall (mk :: MapKind). PayloadDependentState Tx mk
NoPayLoadDependentState

instance Ledger.LedgerTablesAreTrivial (Ticked Ledger.LedgerState) TestBlock where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState TestBlock mk -> Ticked LedgerState TestBlock mk'
convertMapKind (TestBlock.TickedTestLedger LedgerState TestBlock mk
x) =
    LedgerState TestBlock mk' -> Ticked LedgerState TestBlock mk'
forall ptype (mk :: MapKind).
LedgerState (TestBlockWith ptype) mk
-> Ticked LedgerState (TestBlockWith ptype) mk
TestBlock.TickedTestLedger (LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
Ledger.convertMapKind LedgerState TestBlock mk
x)

deriving via Void instance IndexedMemPack Ledger.LedgerState TestBlock Void

instance Ledger.HasLedgerTables Ledger.LedgerState TestBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState TestBlock mk -> LedgerTables TestBlock mk
projectLedgerTables LedgerState TestBlock mk
_ = LedgerTables TestBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
LedgerState TestBlock any
-> LedgerTables TestBlock mk -> LedgerState TestBlock mk
withLedgerTables LedgerState TestBlock any
st LedgerTables TestBlock mk
_ = LedgerState TestBlock any -> LedgerState TestBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind LedgerState TestBlock any
st

instance Ledger.HasLedgerTables (Ticked Ledger.LedgerState) TestBlock where
  projectLedgerTables :: forall (mk :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState TestBlock mk -> LedgerTables TestBlock mk
projectLedgerTables Ticked LedgerState TestBlock mk
_ = LedgerTables TestBlock mk
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables
  withLedgerTables :: forall (mk :: MapKind) (any :: MapKind).
(CanMapMK mk, CanMapKeysMK mk, ZeroableMK mk) =>
Ticked LedgerState TestBlock any
-> LedgerTables TestBlock mk -> Ticked LedgerState TestBlock mk
withLedgerTables Ticked LedgerState TestBlock any
st LedgerTables TestBlock mk
_ = Ticked LedgerState TestBlock any -> Ticked LedgerState TestBlock mk
forall (mk :: MapKind) (mk' :: MapKind).
Ticked LedgerState TestBlock mk -> Ticked LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind Ticked LedgerState TestBlock any
st

instance Ledger.CanStowLedgerTables (Ledger.LedgerState TestBlock) where
  stowLedgerTables :: LedgerState TestBlock ValuesMK -> LedgerState TestBlock EmptyMK
stowLedgerTables = LedgerState TestBlock ValuesMK -> LedgerState TestBlock EmptyMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind
  unstowLedgerTables :: LedgerState TestBlock EmptyMK -> LedgerState TestBlock ValuesMK
unstowLedgerTables = LedgerState TestBlock EmptyMK -> LedgerState TestBlock ValuesMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState TestBlock mk -> LedgerState TestBlock mk'
forall (l :: * -> MapKind -> *) blk (mk :: MapKind)
       (mk' :: MapKind).
LedgerTablesAreTrivial l blk =>
l blk mk -> l blk mk'
convertMapKind

instance CanUpgradeLedgerTables Ledger.LedgerState TestBlock where
  upgradeTables :: forall (mk1 :: MapKind) (mk2 :: MapKind).
LedgerState TestBlock mk1
-> LedgerState TestBlock mk2
-> LedgerTables TestBlock ValuesMK
-> LedgerTables TestBlock ValuesMK
upgradeTables LedgerState TestBlock mk1
_ LedgerState TestBlock mk2
_ = LedgerTables TestBlock ValuesMK -> LedgerTables TestBlock ValuesMK
forall a. a -> a
id

instance Ledger.SerializeTablesWithHint Ledger.LedgerState TestBlock where
  decodeTablesWithHint :: forall s.
LedgerState TestBlock EmptyMK
-> Decoder s (LedgerTables TestBlock ValuesMK)
decodeTablesWithHint LedgerState TestBlock EmptyMK
_ = do
    _ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeMapLen
    pure (LedgerTables $ ValuesMK Map.empty)
  encodeTablesWithHint :: LedgerState TestBlock EmptyMK
-> LedgerTables TestBlock ValuesMK -> Encoding
encodeTablesWithHint LedgerState TestBlock EmptyMK
_ LedgerTables TestBlock ValuesMK
_ = Word -> Encoding
CBOR.encodeMapLen Word
0