{-# 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 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.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.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 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 -> String
(Int -> CodecConfig TestBlock -> ShowS)
-> (CodecConfig TestBlock -> String)
-> ([CodecConfig TestBlock] -> ShowS)
-> Show (CodecConfig TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodecConfig TestBlock -> ShowS
showsPrec :: Int -> CodecConfig TestBlock -> ShowS
$cshow :: CodecConfig TestBlock -> String
show :: CodecConfig TestBlock -> String
$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) -> String
(Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> CodecConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig TestBlock) -> String)
-> NoThunks (CodecConfig TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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) -> String
showTypeOf :: Proxy (CodecConfig TestBlock) -> String
NoThunks)

data instance Block.StorageConfig TestBlock = TestBlockStorageConfig
  deriving (Int -> StorageConfig TestBlock -> ShowS
[StorageConfig TestBlock] -> ShowS
StorageConfig TestBlock -> String
(Int -> StorageConfig TestBlock -> ShowS)
-> (StorageConfig TestBlock -> String)
-> ([StorageConfig TestBlock] -> ShowS)
-> Show (StorageConfig TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StorageConfig TestBlock -> ShowS
showsPrec :: Int -> StorageConfig TestBlock -> ShowS
$cshow :: StorageConfig TestBlock -> String
show :: StorageConfig TestBlock -> String
$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) -> String
(Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> StorageConfig TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig TestBlock) -> String)
-> NoThunks (StorageConfig TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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) -> String
showTypeOf :: Proxy (StorageConfig TestBlock) -> String
NoThunks)

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

newtype instance Ledger.GenTx TestBlock = TestBlockGenTx {GenTx TestBlock -> Tx
unGenTx :: 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 -> String
(Int -> GenTx TestBlock -> ShowS)
-> (GenTx TestBlock -> String)
-> ([GenTx TestBlock] -> ShowS)
-> Show (GenTx TestBlock)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx TestBlock -> ShowS
showsPrec :: Int -> GenTx TestBlock -> ShowS
$cshow :: GenTx TestBlock -> String
show :: GenTx TestBlock -> String
$cshowList :: [GenTx TestBlock] -> ShowS
showList :: [GenTx TestBlock] -> ShowS
Show, Context -> GenTx TestBlock -> IO (Maybe ThunkInfo)
Proxy (GenTx TestBlock) -> String
(Context -> GenTx TestBlock -> IO (Maybe ThunkInfo))
-> (Context -> GenTx TestBlock -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx TestBlock) -> String)
-> NoThunks (GenTx TestBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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) -> String
showTypeOf :: Proxy (GenTx TestBlock) -> String
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) -> String
(Int -> Validated (GenTx TestBlock) -> ShowS)
-> (Validated (GenTx TestBlock) -> String)
-> ([Validated (GenTx TestBlock)] -> ShowS)
-> Show (Validated (GenTx TestBlock))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Validated (GenTx TestBlock) -> ShowS
showsPrec :: Int -> Validated (GenTx TestBlock) -> ShowS
$cshow :: Validated (GenTx TestBlock) -> String
show :: Validated (GenTx TestBlock) -> String
$cshowList :: [Validated (GenTx TestBlock)] -> ShowS
showList :: [Validated (GenTx TestBlock)] -> ShowS
Show, Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx TestBlock)) -> String
(Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Context -> Validated (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx TestBlock)) -> String)
-> NoThunks (Validated (GenTx TestBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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)) -> String
showTypeOf :: Proxy (Validated (GenTx TestBlock)) -> String
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) -> String
(Int -> TxId (GenTx TestBlock) -> ShowS)
-> (TxId (GenTx TestBlock) -> String)
-> ([TxId (GenTx TestBlock)] -> ShowS)
-> Show (TxId (GenTx TestBlock))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxId (GenTx TestBlock) -> ShowS
showsPrec :: Int -> TxId (GenTx TestBlock) -> ShowS
$cshow :: TxId (GenTx TestBlock) -> String
show :: TxId (GenTx TestBlock) -> String
$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)) -> String
(Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Context -> TxId (GenTx TestBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx TestBlock)) -> String)
-> NoThunks (TxId (GenTx TestBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> 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)) -> String
showTypeOf :: Proxy (TxId (GenTx TestBlock)) -> String
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

mkGenTx :: Int -> Ledger.ByteSize32 -> Ledger.GenTx TestBlock
mkGenTx :: Int -> ByteSize32 -> GenTx TestBlock
mkGenTx Int
anId ByteSize32
aSize = Tx -> GenTx TestBlock
TestBlockGenTx (Tx -> GenTx TestBlock) -> Tx -> GenTx TestBlock
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 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

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

  txWireSize :: GenTx TestBlock -> SizeInBytes
txWireSize = Word32 -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> SizeInBytes)
-> (GenTx TestBlock -> Word32) -> GenTx TestBlock -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
Ledger.unByteSize32 (ByteSize32 -> Word32)
-> (GenTx TestBlock -> ByteSize32) -> GenTx TestBlock -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> ByteSize32
txSize (Tx -> ByteSize32)
-> (GenTx TestBlock -> Tx) -> GenTx TestBlock -> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx TestBlock -> Tx
unGenTx
  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig TestBlock
-> TickedLedgerState TestBlock mk -> TxMeasure TestBlock
blockCapacityTxMeasure LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock 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 TestBlock
-> TickedLedgerState TestBlock ValuesMK
-> GenTx TestBlock
-> Except (ApplyTxErr TestBlock) (TxMeasure TestBlock)
txMeasure LedgerConfig TestBlock
_cfg TickedLedgerState TestBlock 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 TestBlock -> IgnoringOverflow ByteSize32)
-> GenTx TestBlock
-> 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 TestBlock -> ByteSize32)
-> GenTx TestBlock
-> IgnoringOverflow ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> ByteSize32
txSize (Tx -> ByteSize32)
-> (GenTx TestBlock -> Tx) -> GenTx TestBlock -> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx TestBlock -> Tx
unGenTx

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

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