{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Bench.Consensus.Mempool.TestBlock (
    -- * Test block
    TestBlock
    -- * Initial parameters
  , initialLedgerState
  , sampleLedgerConfig
    -- * Transactions
  , Token (Token)
  , Tx (Tx)
  , mkTx
  , txSize
  ) where

import qualified Cardano.Slotting.Time as Time
import           Codec.Serialise (Serialise)
import           Control.DeepSeq (NFData)
import           Control.Monad.Trans.Except (except)
import           Data.Set (Set, (\\))
import qualified Data.Set as Set
import           Data.TreeDiff (ToExpr)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import qualified Ouroboros.Consensus.Block as Block
import           Ouroboros.Consensus.Config.SecurityParam as Consensus
import qualified Ouroboros.Consensus.HardFork.History as HardFork
import qualified Ouroboros.Consensus.Ledger.Basics as Ledger
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
import           Test.Util.TestBlock (LedgerState (TestLedger),
                     PayloadSemantics (PayloadDependentError, PayloadDependentState, applyPayload),
                     TestBlockWith, applyDirectlyToPayloadDependentState,
                     lastAppliedPoint, payloadDependentState,
                     testBlockLedgerConfigFrom)

{-------------------------------------------------------------------------------
  MempoolTestBlock
-------------------------------------------------------------------------------}

type TestBlock = TestBlockWith Tx

data Tx = Tx {
    Tx -> Set Token
consumed :: !(Set Token)
  , Tx -> Set Token
produced :: !(Set Token)
  }
  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)

newtype Token = Token { Token -> Int
unToken :: Int  }
  deriving stock (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Eq Token
Eq Token =>
(Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
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 :: Token -> Token -> Ordering
compare :: Token -> Token -> Ordering
$c< :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
>= :: Token -> Token -> Bool
$cmax :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
min :: Token -> Token -> Token
Ord, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Token -> Rep Token x
from :: forall x. Token -> Rep Token x
$cto :: forall x. Rep Token x -> Token
to :: forall x. Rep Token x -> Token
Generic)
  deriving anyclass (Context -> Token -> IO (Maybe ThunkInfo)
Proxy Token -> String
(Context -> Token -> IO (Maybe ThunkInfo))
-> (Context -> Token -> IO (Maybe ThunkInfo))
-> (Proxy Token -> String)
-> NoThunks Token
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Token -> IO (Maybe ThunkInfo)
noThunks :: Context -> Token -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Token -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Token -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Token -> String
showTypeOf :: Proxy Token -> String
NoThunks, [Token] -> Expr
Token -> Expr
(Token -> Expr) -> ([Token] -> Expr) -> ToExpr Token
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: Token -> Expr
toExpr :: Token -> Expr
$clistToExpr :: [Token] -> Expr
listToExpr :: [Token] -> Expr
ToExpr, [Token] -> Encoding
Token -> Encoding
(Token -> Encoding)
-> (forall s. Decoder s Token)
-> ([Token] -> Encoding)
-> (forall s. Decoder s [Token])
-> Serialise Token
forall s. Decoder s [Token]
forall s. Decoder s Token
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: Token -> Encoding
encode :: Token -> Encoding
$cdecode :: forall s. Decoder s Token
decode :: forall s. Decoder s Token
$cencodeList :: [Token] -> Encoding
encodeList :: [Token] -> Encoding
$cdecodeList :: forall s. Decoder s [Token]
decodeList :: forall s. Decoder s [Token]
Serialise, Token -> ()
(Token -> ()) -> NFData Token
forall a. (a -> ()) -> NFData a
$crnf :: Token -> ()
rnf :: Token -> ()
NFData)

{-------------------------------------------------------------------------------
  Initial parameters
-------------------------------------------------------------------------------}

initialLedgerState :: LedgerState (TestBlockWith Tx)
initialLedgerState :: LedgerState (TestBlockWith Tx)
initialLedgerState = TestLedger {
      lastAppliedPoint :: Point (TestBlockWith Tx)
lastAppliedPoint      = Point (TestBlockWith Tx)
forall {k} (block :: k). Point block
Block.GenesisPoint
    , payloadDependentState :: PayloadDependentState Tx
payloadDependentState = TestLedgerState {
          availableTokens :: Set Token
availableTokens = Set Token
forall a. Set a
Set.empty :: Set Token
        }
    }

sampleLedgerConfig :: Ledger.LedgerConfig TestBlock
sampleLedgerConfig :: LedgerConfig (TestBlockWith Tx)
sampleLedgerConfig = EraParams -> TestBlockLedgerConfig
testBlockLedgerConfigFrom (EraParams -> TestBlockLedgerConfig)
-> EraParams -> TestBlockLedgerConfig
forall a b. (a -> b) -> a -> b
$
  SecurityParam -> SlotLength -> EraParams
HardFork.defaultEraParams (Word64 -> SecurityParam
Consensus.SecurityParam Word64
10) (Integer -> SlotLength
Time.slotLengthFromSec Integer
2)

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

data TestLedgerState = TestLedgerState {
    TestLedgerState -> Set Token
availableTokens :: !(Set Token)
  }
  deriving stock ((forall x. TestLedgerState -> Rep TestLedgerState x)
-> (forall x. Rep TestLedgerState x -> TestLedgerState)
-> Generic TestLedgerState
forall x. Rep TestLedgerState x -> TestLedgerState
forall x. TestLedgerState -> Rep TestLedgerState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TestLedgerState -> Rep TestLedgerState x
from :: forall x. TestLedgerState -> Rep TestLedgerState x
$cto :: forall x. Rep TestLedgerState x -> TestLedgerState
to :: forall x. Rep TestLedgerState x -> TestLedgerState
Generic, TestLedgerState -> TestLedgerState -> Bool
(TestLedgerState -> TestLedgerState -> Bool)
-> (TestLedgerState -> TestLedgerState -> Bool)
-> Eq TestLedgerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestLedgerState -> TestLedgerState -> Bool
== :: TestLedgerState -> TestLedgerState -> Bool
$c/= :: TestLedgerState -> TestLedgerState -> Bool
/= :: TestLedgerState -> TestLedgerState -> Bool
Eq, Int -> TestLedgerState -> ShowS
[TestLedgerState] -> ShowS
TestLedgerState -> String
(Int -> TestLedgerState -> ShowS)
-> (TestLedgerState -> String)
-> ([TestLedgerState] -> ShowS)
-> Show TestLedgerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestLedgerState -> ShowS
showsPrec :: Int -> TestLedgerState -> ShowS
$cshow :: TestLedgerState -> String
show :: TestLedgerState -> String
$cshowList :: [TestLedgerState] -> ShowS
showList :: [TestLedgerState] -> ShowS
Show)
  deriving anyclass (Context -> TestLedgerState -> IO (Maybe ThunkInfo)
Proxy TestLedgerState -> String
(Context -> TestLedgerState -> IO (Maybe ThunkInfo))
-> (Context -> TestLedgerState -> IO (Maybe ThunkInfo))
-> (Proxy TestLedgerState -> String)
-> NoThunks TestLedgerState
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TestLedgerState -> IO (Maybe ThunkInfo)
noThunks :: Context -> TestLedgerState -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TestLedgerState -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TestLedgerState -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TestLedgerState -> String
showTypeOf :: Proxy TestLedgerState -> String
NoThunks, [TestLedgerState] -> Expr
TestLedgerState -> Expr
(TestLedgerState -> Expr)
-> ([TestLedgerState] -> Expr) -> ToExpr TestLedgerState
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: TestLedgerState -> Expr
toExpr :: TestLedgerState -> Expr
$clistToExpr :: [TestLedgerState] -> Expr
listToExpr :: [TestLedgerState] -> Expr
ToExpr, [TestLedgerState] -> Encoding
TestLedgerState -> Encoding
(TestLedgerState -> Encoding)
-> (forall s. Decoder s TestLedgerState)
-> ([TestLedgerState] -> Encoding)
-> (forall s. Decoder s [TestLedgerState])
-> Serialise TestLedgerState
forall s. Decoder s [TestLedgerState]
forall s. Decoder s TestLedgerState
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: TestLedgerState -> Encoding
encode :: TestLedgerState -> Encoding
$cdecode :: forall s. Decoder s TestLedgerState
decode :: forall s. Decoder s TestLedgerState
$cencodeList :: [TestLedgerState] -> Encoding
encodeList :: [TestLedgerState] -> Encoding
$cdecodeList :: forall s. Decoder s [TestLedgerState]
decodeList :: forall s. Decoder s [TestLedgerState]
Serialise)

data TxApplicationError =
    -- | The transaction could not be applied due to the given unavailable tokens.
    TxApplicationError { TxApplicationError -> Set Token
unavailable :: Set Token }
  deriving stock ((forall x. TxApplicationError -> Rep TxApplicationError x)
-> (forall x. Rep TxApplicationError x -> TxApplicationError)
-> Generic TxApplicationError
forall x. Rep TxApplicationError x -> TxApplicationError
forall x. TxApplicationError -> Rep TxApplicationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxApplicationError -> Rep TxApplicationError x
from :: forall x. TxApplicationError -> Rep TxApplicationError x
$cto :: forall x. Rep TxApplicationError x -> TxApplicationError
to :: forall x. Rep TxApplicationError x -> TxApplicationError
Generic, TxApplicationError -> TxApplicationError -> Bool
(TxApplicationError -> TxApplicationError -> Bool)
-> (TxApplicationError -> TxApplicationError -> Bool)
-> Eq TxApplicationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxApplicationError -> TxApplicationError -> Bool
== :: TxApplicationError -> TxApplicationError -> Bool
$c/= :: TxApplicationError -> TxApplicationError -> Bool
/= :: TxApplicationError -> TxApplicationError -> Bool
Eq, Int -> TxApplicationError -> ShowS
[TxApplicationError] -> ShowS
TxApplicationError -> String
(Int -> TxApplicationError -> ShowS)
-> (TxApplicationError -> String)
-> ([TxApplicationError] -> ShowS)
-> Show TxApplicationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxApplicationError -> ShowS
showsPrec :: Int -> TxApplicationError -> ShowS
$cshow :: TxApplicationError -> String
show :: TxApplicationError -> String
$cshowList :: [TxApplicationError] -> ShowS
showList :: [TxApplicationError] -> ShowS
Show)
  deriving anyclass (Context -> TxApplicationError -> IO (Maybe ThunkInfo)
Proxy TxApplicationError -> String
(Context -> TxApplicationError -> IO (Maybe ThunkInfo))
-> (Context -> TxApplicationError -> IO (Maybe ThunkInfo))
-> (Proxy TxApplicationError -> String)
-> NoThunks TxApplicationError
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxApplicationError -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxApplicationError -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxApplicationError -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxApplicationError -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TxApplicationError -> String
showTypeOf :: Proxy TxApplicationError -> String
NoThunks, [TxApplicationError] -> Expr
TxApplicationError -> Expr
(TxApplicationError -> Expr)
-> ([TxApplicationError] -> Expr) -> ToExpr TxApplicationError
forall a. (a -> Expr) -> ([a] -> Expr) -> ToExpr a
$ctoExpr :: TxApplicationError -> Expr
toExpr :: TxApplicationError -> Expr
$clistToExpr :: [TxApplicationError] -> Expr
listToExpr :: [TxApplicationError] -> Expr
ToExpr, [TxApplicationError] -> Encoding
TxApplicationError -> Encoding
(TxApplicationError -> Encoding)
-> (forall s. Decoder s TxApplicationError)
-> ([TxApplicationError] -> Encoding)
-> (forall s. Decoder s [TxApplicationError])
-> Serialise TxApplicationError
forall s. Decoder s [TxApplicationError]
forall s. Decoder s TxApplicationError
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: TxApplicationError -> Encoding
encode :: TxApplicationError -> Encoding
$cdecode :: forall s. Decoder s TxApplicationError
decode :: forall s. Decoder s TxApplicationError
$cencodeList :: [TxApplicationError] -> Encoding
encodeList :: [TxApplicationError] -> Encoding
$cdecodeList :: forall s. Decoder s [TxApplicationError]
decodeList :: forall s. Decoder s [TxApplicationError]
Serialise)

instance PayloadSemantics Tx where
  type PayloadDependentState Tx = TestLedgerState

  type PayloadDependentError Tx = TxApplicationError

  applyPayload :: PayloadDependentState Tx
-> Tx
-> Either (PayloadDependentError Tx) (PayloadDependentState Tx)
applyPayload st :: PayloadDependentState Tx
st@TestLedgerState { Set Token
availableTokens :: TestLedgerState -> Set Token
availableTokens :: Set Token
availableTokens } Tx { Set Token
consumed :: Tx -> Set Token
consumed :: Set Token
consumed, Set Token
produced :: Tx -> Set Token
produced :: Set Token
produced } =
    let
      notFound :: Set Token
notFound = (Token -> Bool) -> Set Token -> Set Token
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Token -> Bool) -> Token -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token -> Set Token -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Token
availableTokens)) Set Token
consumed
    in if Set Token -> Bool
forall a. Set a -> Bool
Set.null Set Token
notFound
       then PayloadDependentState Tx
-> Either (PayloadDependentError Tx) (PayloadDependentState Tx)
forall a b. b -> Either a b
Right (PayloadDependentState Tx
 -> Either (PayloadDependentError Tx) (PayloadDependentState Tx))
-> PayloadDependentState Tx
-> Either (PayloadDependentError Tx) (PayloadDependentState Tx)
forall a b. (a -> b) -> a -> b
$ PayloadDependentState Tx
st{ availableTokens = availableTokens \\ consumed <> produced }
       else TxApplicationError
-> Either TxApplicationError (PayloadDependentState Tx)
forall a b. a -> Either a b
Left  (TxApplicationError
 -> Either TxApplicationError (PayloadDependentState Tx))
-> TxApplicationError
-> Either TxApplicationError (PayloadDependentState Tx)
forall a b. (a -> b) -> a -> b
$ Set Token -> TxApplicationError
TxApplicationError Set Token
notFound

-- | TODO: for the time being 'TestBlock' does not have any codec config
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)

-- | TODO: for the time being 'TestBlock' does not have any storage config
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)

-- | For the mempool tests and benchmarks it is not imporant that we calculate
-- the actual size of the transaction in bytes.
txSize :: Ledger.GenTx TestBlock -> Ledger.ByteSize32
txSize :: GenTx (TestBlockWith Tx) -> ByteSize32
txSize (TestBlockGenTx Tx
tx) =
    Word32 -> ByteSize32
Ledger.ByteSize32
  (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set Token -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> Set Token
consumed Tx
tx) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set Token -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> Set Token
produced Tx
tx)

mkTx ::
     [Token]
     -- ^ Consumed
  -> [Token]
     -- ^ Produced
  -> Ledger.GenTx TestBlock
mkTx :: [Token] -> [Token] -> GenTx (TestBlockWith Tx)
mkTx [Token]
cons [Token]
prod = Tx -> GenTx (TestBlockWith Tx)
TestBlockGenTx (Tx -> GenTx (TestBlockWith Tx)) -> Tx -> GenTx (TestBlockWith Tx)
forall a b. (a -> b) -> a -> b
$ Tx { consumed :: Set Token
consumed = [Token] -> Set Token
forall a. Ord a => [a] -> Set a
Set.fromList [Token]
cons
                                     , produced :: Set Token
produced = [Token] -> Set Token
forall a. Ord a => [a] -> Set a
Set.fromList [Token]
prod
                                     }

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 (TestBlockGenTx Tx
tx) Ticked (LedgerState (TestBlockWith Tx))
tickedSt =
    Either
  (ApplyTxErr (TestBlockWith Tx))
  (Ticked (LedgerState (TestBlockWith Tx)),
   Validated (GenTx (TestBlockWith Tx)))
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either
   (ApplyTxErr (TestBlockWith Tx))
   (Ticked (LedgerState (TestBlockWith Tx)),
    Validated (GenTx (TestBlockWith Tx)))
 -> Except
      (ApplyTxErr (TestBlockWith Tx))
      (Ticked (LedgerState (TestBlockWith Tx)),
       Validated (GenTx (TestBlockWith Tx))))
-> Either
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall a b. (a -> b) -> a -> b
$ (Ticked (LedgerState (TestBlockWith Tx))
 -> (Ticked (LedgerState (TestBlockWith Tx)),
     Validated (GenTx (TestBlockWith Tx))))
-> Either
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)))
-> Either
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall a b.
(a -> b)
-> Either (ApplyTxErr (TestBlockWith Tx)) a
-> Either (ApplyTxErr (TestBlockWith Tx)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, GenTx (TestBlockWith Tx) -> Validated (GenTx (TestBlockWith Tx))
ValidatedGenTx (Tx -> GenTx (TestBlockWith Tx)
TestBlockGenTx Tx
tx))
           (Either
   (ApplyTxErr (TestBlockWith Tx))
   (Ticked (LedgerState (TestBlockWith Tx)))
 -> Either
      (ApplyTxErr (TestBlockWith Tx))
      (Ticked (LedgerState (TestBlockWith Tx)),
       Validated (GenTx (TestBlockWith Tx))))
-> Either
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)))
-> Either
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall a b. (a -> b) -> a -> b
$ Ticked (LedgerState (TestBlockWith Tx))
-> Tx
-> Either
     (PayloadDependentError Tx)
     (Ticked (LedgerState (TestBlockWith Tx)))
forall ptype.
PayloadSemantics ptype =>
Ticked (LedgerState (TestBlockWith ptype))
-> ptype
-> Either
     (PayloadDependentError ptype)
     (Ticked (LedgerState (TestBlockWith ptype)))
applyDirectlyToPayloadDependentState Ticked (LedgerState (TestBlockWith Tx))
tickedSt Tx
tx

  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 (ValidatedGenTx GenTx (TestBlockWith Tx)
genTx) Ticked (LedgerState (TestBlockWith Tx))
tickedSt =
    (Ticked (LedgerState (TestBlockWith Tx)),
 Validated (GenTx (TestBlockWith Tx)))
-> Ticked (LedgerState (TestBlockWith Tx))
forall a b. (a, b) -> a
fst ((Ticked (LedgerState (TestBlockWith Tx)),
  Validated (GenTx (TestBlockWith Tx)))
 -> Ticked (LedgerState (TestBlockWith Tx)))
-> ExceptT
     TxApplicationError
     Identity
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
-> ExceptT
     TxApplicationError
     Identity
     (Ticked (LedgerState (TestBlockWith Tx)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LedgerConfig (TestBlockWith Tx)
-> WhetherToIntervene
-> SlotNo
-> GenTx (TestBlockWith Tx)
-> Ticked (LedgerState (TestBlockWith Tx))
-> Except
     (ApplyTxErr (TestBlockWith Tx))
     (Ticked (LedgerState (TestBlockWith Tx)),
      Validated (GenTx (TestBlockWith Tx)))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except
     (ApplyTxErr blk) (Ticked (LedgerState blk), Validated (GenTx blk))
Ledger.applyTx LedgerConfig (TestBlockWith Tx)
cfg WhetherToIntervene
Ledger.DoNotIntervene SlotNo
slot GenTx (TestBlockWith Tx)
genTx Ticked (LedgerState (TestBlockWith Tx))
tickedSt
    -- FIXME: it is ok to use 'DoNotIntervene' here?

  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

  -- We tweaked this in such a way that we test the case in which we exceed the
  -- maximum mempool capacity. The value used here depends on 'txInBlockSize'.
  blockCapacityTxMeasure :: LedgerConfig (TestBlockWith Tx)
-> Ticked (LedgerState (TestBlockWith Tx))
-> TxMeasure (TestBlockWith Tx)
blockCapacityTxMeasure LedgerConfig (TestBlockWith Tx)
_cfg Ticked (LedgerState (TestBlockWith Tx))
_st =
    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
20

  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
     TxApplicationError Identity (IgnoringOverflow ByteSize32)
forall a. a -> ExceptT TxApplicationError Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IgnoringOverflow ByteSize32
 -> ExceptT
      TxApplicationError Identity (IgnoringOverflow ByteSize32))
-> (GenTx (TestBlockWith Tx) -> IgnoringOverflow ByteSize32)
-> GenTx (TestBlockWith Tx)
-> ExceptT
     TxApplicationError 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
. GenTx (TestBlockWith Tx) -> ByteSize32
txSize

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

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)

type instance Ledger.ApplyTxErr TestBlock = TxApplicationError