{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

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

import           Control.DeepSeq (NFData)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Block as Block
import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
import qualified Test.Util.TestBlock as TestBlock
import           Test.Util.TestBlock (TestBlockWith)

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
  type PayloadDependentState Tx = ()

  type PayloadDependentError Tx = ()

  applyPayload :: PayloadDependentState Tx
-> Tx
-> Either (PayloadDependentError Tx) (PayloadDependentState Tx)
applyPayload PayloadDependentState Tx
st Tx
_tx = () -> Either () ()
forall a b. b -> Either a b
Right ()
PayloadDependentState Tx
st


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)
-> Ticked (LedgerState (TestBlockWith Tx))
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
applyTx LedgerConfig (TestBlockWith Tx)
_cfg WhetherToIntervene
_shouldIntervene SlotNo
_slot GenTx (TestBlockWith Tx)
gtx Ticked (LedgerState (TestBlockWith Tx))
st = (Ticked (LedgerState (TestBlockWith Tx)),
 Validated (GenTx (TestBlockWith Tx)))
-> ExceptT
     ()
     Identity
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Ticked (LedgerState (TestBlockWith Tx))
st, GenTx (TestBlockWith Tx) -> Validated (GenTx (TestBlockWith Tx))
ValidatedGenTx GenTx (TestBlockWith Tx)
gtx)

  reapplyTx :: HasCallStack =>
LedgerConfig (TestBlockWith Tx)
-> SlotNo
-> Validated (GenTx (TestBlockWith Tx))
-> Ticked (LedgerState (TestBlockWith Tx))
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)))
reapplyTx LedgerConfig (TestBlockWith Tx)
_cfg SlotNo
_slot Validated (GenTx (TestBlockWith Tx))
_gtx Ticked (LedgerState (TestBlockWith Tx))
gst = Ticked (LedgerState (TestBlockWith Tx))
-> ExceptT () Identity (Ticked (LedgerState (TestBlockWith Tx)))
forall a. a -> ExceptT () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ticked (LedgerState (TestBlockWith Tx))
gst

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

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

  blockCapacityTxMeasure :: LedgerConfig (TestBlockWith Tx)
-> Ticked (LedgerState (TestBlockWith Tx))
-> TxMeasure (TestBlockWith Tx)
blockCapacityTxMeasure LedgerConfig (TestBlockWith Tx)
_cfg Ticked (LedgerState (TestBlockWith Tx))
_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)
-> Ticked (LedgerState (TestBlockWith Tx))
-> GenTx (TestBlockWith Tx)
-> Except
     (ApplyTxErr (TestBlockWith Tx)) (TxMeasure (TestBlockWith Tx))
txMeasure LedgerConfig (TestBlockWith Tx)
_cfg Ticked (LedgerState (TestBlockWith Tx))
_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
-------------------------------------------------------------------------------}

type instance Ledger.ApplyTxErr TestBlock = ()