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

module Test.Consensus.Mempool.Fairness.TestBlock
  ( TestBlock
  , TestBlock.PayloadDependentState (..)
  , Tx
  , mkGenTx
  , txSize
  , unGenTx
  ) where

import Codec.Serialise
import Control.DeepSeq (NFData)
import Data.Void (Void)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Block as Block
import Ouroboros.Consensus.Ledger.Abstract
  ( EmptyMK
  , LedgerState
  , convertMapKind
  , trivialLedgerTables
  )
import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
import Ouroboros.Consensus.Storage.LedgerDB
import Ouroboros.Consensus.Ticked (Ticked)
import Ouroboros.Consensus.Util.IndexedMemPack
import Test.Util.TestBlock (TestBlockWith)
import qualified Test.Util.TestBlock as TestBlock

type TestBlock = TestBlockWith Tx

-- We use 'Test.Util.TestBlock' because, even though it contains a lot of
-- information we do not actually need for the mempool fairness tests, it
-- already defines most of the many type classes that are needed to open a
-- mempool.

-- | The fairness test for transaction sizes only cares about said aspect.
--
-- We do need to keep track of the transaction id.
--
-- All transactions will be accepted by the mempool.
data Tx = Tx {Tx -> Int
txNumber :: Int, Tx -> ByteSize32
txSize :: Ledger.ByteSize32}
  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 -> String
(Int -> Tx -> ShowS)
-> (Tx -> String) -> ([Tx] -> ShowS) -> Show Tx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tx -> ShowS
showsPrec :: Int -> Tx -> ShowS
$cshow :: Tx -> String
show :: Tx -> String
$cshowList :: [Tx] -> ShowS
showList :: [Tx] -> ShowS
Show)
  deriving anyclass (Context -> Tx -> IO (Maybe ThunkInfo)
Proxy Tx -> String
(Context -> Tx -> IO (Maybe ThunkInfo))
-> (Context -> Tx -> IO (Maybe ThunkInfo))
-> (Proxy Tx -> String)
-> NoThunks Tx
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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 -> String
showTypeOf :: Proxy Tx -> String
NoThunks, Tx -> ()
(Tx -> ()) -> NFData Tx
forall a. (a -> ()) -> NFData a
$crnf :: Tx -> ()
rnf :: Tx -> ()
NFData)

{-------------------------------------------------------------------------------
  Payload semantics
-------------------------------------------------------------------------------}

instance TestBlock.PayloadSemantics Tx where
  data PayloadDependentState Tx mk = NoPayLoadDependentState
    deriving (Int -> PayloadDependentState Tx mk -> ShowS
[PayloadDependentState Tx mk] -> ShowS
PayloadDependentState Tx mk -> String
(Int -> PayloadDependentState Tx mk -> ShowS)
-> (PayloadDependentState Tx mk -> String)
-> ([PayloadDependentState Tx mk] -> ShowS)
-> Show (PayloadDependentState Tx mk)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([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 -> String
$cshowsPrec :: forall (mk :: MapKind). Int -> PayloadDependentState Tx mk -> ShowS
showsPrec :: Int -> PayloadDependentState Tx mk -> ShowS
$cshow :: forall (mk :: MapKind). PayloadDependentState Tx mk -> String
show :: PayloadDependentState Tx mk -> String
$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) -> String
(Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo))
-> (Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo))
-> (Proxy (PayloadDependentState Tx mk) -> String)
-> NoThunks (PayloadDependentState Tx mk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (mk :: MapKind).
Context -> PayloadDependentState Tx mk -> IO (Maybe ThunkInfo)
forall (mk :: MapKind).
Proxy (PayloadDependentState Tx mk) -> String
$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) -> String
showTypeOf :: Proxy (PayloadDependentState Tx mk) -> String
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 (LedgerState (TestBlockWith Tx)) KeysMK
getPayloadKeySets = LedgerTables (LedgerState (TestBlockWith Tx)) KeysMK
-> Tx -> LedgerTables (LedgerState (TestBlockWith Tx)) KeysMK
forall a b. a -> b -> a
const LedgerTables (LedgerState (TestBlockWith Tx)) KeysMK
forall (mk :: MapKind) (l :: MapKind -> *).
(ZeroableMK mk, LedgerTablesAreTrivial l) =>
LedgerTables l mk
trivialLedgerTables

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

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

{-------------------------------------------------------------------------------
  Mempool support
-------------------------------------------------------------------------------}

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

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

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

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

mkGenTx :: Int -> Ledger.ByteSize32 -> Ledger.GenTx TestBlock
mkGenTx :: Int -> ByteSize32 -> GenTx (TestBlockWith Tx)
mkGenTx Int
anId ByteSize32
aSize = Tx -> GenTx (TestBlockWith Tx)
TestBlockGenTx (Tx -> GenTx (TestBlockWith Tx)) -> Tx -> GenTx (TestBlockWith Tx)
forall a b. (a -> b) -> a -> b
$ Tx{txNumber :: Int
txNumber = Int
anId, txSize :: ByteSize32
txSize = ByteSize32
aSize}

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

  reapplyTx :: HasCallStack =>
ComputeDiffs
-> LedgerConfig (TestBlockWith Tx)
-> SlotNo
-> Validated (GenTx (TestBlockWith Tx))
-> TickedLedgerState (TestBlockWith Tx) ValuesMK
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (TickedLedgerState (TestBlockWith Tx) TrackingMK)
reapplyTx ComputeDiffs
_ LedgerConfig (TestBlockWith Tx)
_cfg SlotNo
_slot Validated (GenTx (TestBlockWith Tx))
_gtx TickedLedgerState (TestBlockWith Tx) ValuesMK
gst =
    TickedLedgerState (TestBlockWith Tx) TrackingMK
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (TickedLedgerState (TestBlockWith Tx) TrackingMK)
forall a. a -> ExceptT (ApplyTxErr (TestBlockWith Tx)) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TickedLedgerState (TestBlockWith Tx) TrackingMK
 -> Except
      (ApplyTxErr (TestBlockWith Tx))
      (TickedLedgerState (TestBlockWith Tx) TrackingMK))
-> TickedLedgerState (TestBlockWith Tx) TrackingMK
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (TickedLedgerState (TestBlockWith Tx) TrackingMK)
forall a b. (a -> b) -> a -> b
$
      LedgerState (TestBlockWith Tx) TrackingMK
-> TickedLedgerState (TestBlockWith Tx) TrackingMK
forall ptype (mk :: MapKind).
LedgerState (TestBlockWith ptype) mk
-> Ticked (LedgerState (TestBlockWith ptype)) mk
TestBlock.TickedTestLedger (LedgerState (TestBlockWith Tx) TrackingMK
 -> TickedLedgerState (TestBlockWith Tx) TrackingMK)
-> LedgerState (TestBlockWith Tx) TrackingMK
-> TickedLedgerState (TestBlockWith Tx) TrackingMK
forall a b. (a -> b) -> a -> b
$
        LedgerState (TestBlockWith Tx) ValuesMK
-> LedgerState (TestBlockWith Tx) TrackingMK
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState (TestBlockWith Tx) mk
-> LedgerState (TestBlockWith Tx) mk'
forall (l :: MapKind -> *) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
convertMapKind (LedgerState (TestBlockWith Tx) ValuesMK
 -> LedgerState (TestBlockWith Tx) TrackingMK)
-> LedgerState (TestBlockWith Tx) ValuesMK
-> LedgerState (TestBlockWith Tx) TrackingMK
forall a b. (a -> b) -> a -> b
$
          TickedLedgerState (TestBlockWith Tx) ValuesMK
-> LedgerState (TestBlockWith Tx) ValuesMK
forall ptype (mk :: MapKind).
Ticked (LedgerState (TestBlockWith ptype)) mk
-> LedgerState (TestBlockWith ptype) mk
TestBlock.getTickedTestLedger
            TickedLedgerState (TestBlockWith Tx) ValuesMK
gst

  txForgetValidated :: Validated (GenTx (TestBlockWith Tx)) -> GenTx (TestBlockWith Tx)
txForgetValidated (ValidatedGenTx GenTx (TestBlockWith Tx)
tx) = GenTx (TestBlockWith Tx)
tx

  getTransactionKeySets :: GenTx (TestBlockWith Tx)
-> LedgerTables (LedgerState (TestBlockWith Tx)) KeysMK
getTransactionKeySets GenTx (TestBlockWith Tx)
_ = LedgerTables (LedgerState (TestBlockWith Tx)) KeysMK
forall (mk :: MapKind) (l :: MapKind -> *).
(ZeroableMK mk, LedgerTablesAreTrivial l) =>
LedgerTables l mk
trivialLedgerTables

instance Ledger.TxLimits TestBlock where
  type TxMeasure TestBlock = Ledger.IgnoringOverflow Ledger.ByteSize32

  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig (TestBlockWith Tx)
-> TickedLedgerState (TestBlockWith Tx) mk
-> TxMeasure (TestBlockWith Tx)
blockCapacityTxMeasure LedgerConfig (TestBlockWith Tx)
_cfg TickedLedgerState (TestBlockWith Tx) mk
_st =
    -- The tests will override this value. By using 1, @computeMempoolCapacity@
    -- can be exactly what each test requests.
    ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
Ledger.ByteSize32 Word32
1

  txMeasure :: LedgerConfig (TestBlockWith Tx)
-> TickedLedgerState (TestBlockWith Tx) ValuesMK
-> GenTx (TestBlockWith Tx)
-> Except
     (ApplyTxErr (TestBlockWith Tx)) (TxMeasure (TestBlockWith Tx))
txMeasure LedgerConfig (TestBlockWith Tx)
_cfg TickedLedgerState (TestBlockWith Tx) ValuesMK
_st = IgnoringOverflow ByteSize32
-> ExceptT () Identity (IgnoringOverflow ByteSize32)
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IgnoringOverflow ByteSize32
 -> ExceptT () Identity (IgnoringOverflow ByteSize32))
-> (GenTx (TestBlockWith Tx) -> IgnoringOverflow ByteSize32)
-> GenTx (TestBlockWith Tx)
-> ExceptT () Identity (IgnoringOverflow ByteSize32)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
Ledger.IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> (GenTx (TestBlockWith Tx) -> ByteSize32)
-> GenTx (TestBlockWith Tx)
-> IgnoringOverflow ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> ByteSize32
txSize (Tx -> ByteSize32)
-> (GenTx (TestBlockWith Tx) -> Tx)
-> GenTx (TestBlockWith Tx)
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (TestBlockWith Tx) -> Tx
unGenTx

{-------------------------------------------------------------------------------
  Ledger support (empty tables)
-------------------------------------------------------------------------------}

type instance Ledger.ApplyTxErr TestBlock = ()

type instance Ledger.TxIn (Ledger.LedgerState TestBlock) = Void
type instance Ledger.TxOut (Ledger.LedgerState TestBlock) = Void

deriving via
  Ledger.TrivialLedgerTables (Ledger.LedgerState TestBlock)
  instance
    Ledger.HasLedgerTables (Ledger.LedgerState TestBlock)

deriving via
  Ledger.TrivialLedgerTables (Ledger.LedgerState TestBlock)
  instance
    Ledger.HasLedgerTables (Ticked (Ledger.LedgerState TestBlock))

deriving via
  Void
  instance
    IndexedMemPack (LedgerState TestBlock EmptyMK) Void

instance Ledger.LedgerTablesAreTrivial (Ledger.LedgerState TestBlock) where
  convertMapKind :: forall (mk :: MapKind) (mk' :: MapKind).
LedgerState (TestBlockWith Tx) mk
-> LedgerState (TestBlockWith Tx) mk'
convertMapKind (TestBlock.TestLedger Point (TestBlockWith Tx)
x PayloadDependentState Tx mk
R:PayloadDependentStateTxmk mk
NoPayLoadDependentState) =
    Point (TestBlockWith Tx)
-> PayloadDependentState Tx mk'
-> LedgerState (TestBlockWith Tx) mk'
forall ptype (mk :: MapKind).
Point (TestBlockWith ptype)
-> PayloadDependentState ptype mk
-> LedgerState (TestBlockWith ptype) mk
TestBlock.TestLedger Point (TestBlockWith Tx)
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 (TestBlockWith Tx)) mk
-> Ticked (LedgerState (TestBlockWith Tx)) mk'
convertMapKind (TestBlock.TickedTestLedger LedgerState (TestBlockWith Tx) mk
x) =
    LedgerState (TestBlockWith Tx) mk'
-> Ticked (LedgerState (TestBlockWith Tx)) mk'
forall ptype (mk :: MapKind).
LedgerState (TestBlockWith ptype) mk
-> Ticked (LedgerState (TestBlockWith ptype)) mk
TestBlock.TickedTestLedger (LedgerState (TestBlockWith Tx) mk
-> LedgerState (TestBlockWith Tx) mk'
forall (mk :: MapKind) (mk' :: MapKind).
LedgerState (TestBlockWith Tx) mk
-> LedgerState (TestBlockWith Tx) mk'
forall (l :: MapKind -> *) (mk :: MapKind) (mk' :: MapKind).
LedgerTablesAreTrivial l =>
l mk -> l mk'
Ledger.convertMapKind LedgerState (TestBlockWith Tx) mk
x)
deriving via
  Ledger.TrivialLedgerTables (Ledger.LedgerState TestBlock)
  instance
    Ledger.CanStowLedgerTables (Ledger.LedgerState TestBlock)
deriving via
  Ledger.TrivialLedgerTables (Ledger.LedgerState TestBlock)
  instance
    CanUpgradeLedgerTables (Ledger.LedgerState TestBlock)