{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.Server (tests) where
import Control.Monad (void)
import Control.Tracer (Tracer, nullTracer, stdoutTracer)
import Data.Functor.Contravariant ((>$<))
import Data.SOP.Strict (index_NS)
import qualified Data.SOP.Telescope as Telescope
import Network.TypedProtocol.Proofs (connect)
import Ouroboros.Consensus.Cardano.Block
import Ouroboros.Consensus.Config (topLevelConfigLedger)
import qualified Ouroboros.Consensus.Config as Consensus
import Ouroboros.Consensus.HardFork.Combinator (getHardForkState,
hardForkLedgerStatePerEra)
import Ouroboros.Consensus.Ledger.Extended (ledgerState)
import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..))
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as Ledger
import qualified Ouroboros.Consensus.Ledger.SupportsMempool as LedgerSupportsMempool
import qualified Ouroboros.Consensus.Mempool.Capacity as Mempool
import Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
(TraceLocalTxSubmissionServerEvent,
localTxSubmissionServer)
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Network.Protocol.LocalTxSubmission.Client
(SubmitResult, localTxSubmissionClientPeer)
import Ouroboros.Network.Protocol.LocalTxSubmission.Examples
(localTxSubmissionClient)
import Ouroboros.Network.Protocol.LocalTxSubmission.Server
(localTxSubmissionServerPeer)
import Test.Consensus.Cardano.MiniProtocol.LocalTxSubmission.ByteStringTxParser
(deserialiseTx)
import Test.Consensus.Cardano.ProtocolInfo
(ByronSlotLengthInSeconds (..), Era (..),
ShelleySlotLengthInSeconds (..), hardForkInto,
mkSimpleTestProtocolInfo, protocolVersionZero)
import qualified Test.Consensus.Mempool.Mocked as Mocked
import Test.Consensus.Mempool.Mocked (MockedMempool)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@=?))
import qualified Test.ThreadNet.Infra.Shelley as Shelley
tests :: TestTree
tests :: TestTree
tests =
TestName -> [TestTree] -> TestTree
testGroup TestName
"LocalTxSubmissionServer"
([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$ (Era -> TestTree) -> [Era] -> [TestTree]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Era -> TestTree
localServerPassesRegressionTests [Era
Byron ..]
where
localServerPassesRegressionTests :: Era -> TestTree
localServerPassesRegressionTests Era
era =
TestName -> Assertion -> TestTree
testCase (TestName
"Passes the regression tests (" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Era -> TestName
forall a. Show a => a -> TestName
show Era
era TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
")") (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
let
pInfo :: ProtocolInfo (CardanoBlock StandardCrypto)
pInfo :: ProtocolInfo (CardanoBlock StandardCrypto)
pInfo = DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> ProtVer
-> HardForkSpec
-> ProtocolInfo (CardanoBlock StandardCrypto)
forall c.
(CardanoHardForkConstraints c, c ~ StandardCrypto) =>
DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> ProtVer
-> HardForkSpec
-> ProtocolInfo (CardanoBlock c)
mkSimpleTestProtocolInfo
(Rational -> DecentralizationParam
Shelley.DecentralizationParam Rational
1)
(Word64 -> SecurityParam
Consensus.SecurityParam Word64
10)
(Word64 -> ByronSlotLengthInSeconds
ByronSlotLengthInSeconds Word64
1)
(Word64 -> ShelleySlotLengthInSeconds
ShelleySlotLengthInSeconds Word64
1)
ProtVer
protocolVersionZero
(Era -> HardForkSpec
hardForkInto Era
era)
eraIndex :: Int
eraIndex = NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
-> Int
forall {k} (f :: k -> *) (xs :: [k]). NS f xs -> Int
index_NS
(NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
-> Int)
-> (ExtLedgerState (CardanoBlock StandardCrypto)
-> NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
-> NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip
(Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
-> NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto)
-> Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto)
-> NS
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto)
-> Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
(HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto)
-> Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto)
-> HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto)
-> Telescope
(K Past)
(Current LedgerState)
(ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock StandardCrypto)
-> HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto)
forall (xs :: [*]).
LedgerState (HardForkBlock xs) -> HardForkState LedgerState xs
hardForkLedgerStatePerEra
(LedgerState (CardanoBlock StandardCrypto)
-> HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto)
-> LedgerState (CardanoBlock StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto)
-> HardForkState
LedgerState (ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState (CardanoBlock StandardCrypto)
-> LedgerState (CardanoBlock StandardCrypto)
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState
(ExtLedgerState (CardanoBlock StandardCrypto) -> Int)
-> ExtLedgerState (CardanoBlock StandardCrypto) -> Int
forall a b. (a -> b) -> a -> b
$ ProtocolInfo (CardanoBlock StandardCrypto)
-> ExtLedgerState (CardanoBlock StandardCrypto)
forall b. ProtocolInfo b -> ExtLedgerState b
pInfoInitLedger ProtocolInfo (CardanoBlock StandardCrypto)
pInfo
Int
eraIndex Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? Era -> Int
forall a. Enum a => a -> Int
fromEnum Era
era
let
capcityBytesOverride :: MempoolCapacityBytesOverride
capcityBytesOverride =
ByteSize32 -> MempoolCapacityBytesOverride
Mempool.mkCapacityBytesOverride (Word32 -> ByteSize32
ByteSize32 Word32
100_000)
tracer :: Tracer IO a
tracer = Tracer IO a
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
mempoolParams :: InitialMempoolAndModelParams (CardanoBlock StandardCrypto)
mempoolParams = Mocked.MempoolAndModelParams {
immpInitialState :: LedgerState (CardanoBlock StandardCrypto)
Mocked.immpInitialState =
ExtLedgerState (CardanoBlock StandardCrypto)
-> LedgerState (CardanoBlock StandardCrypto)
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState (ExtLedgerState (CardanoBlock StandardCrypto)
-> LedgerState (CardanoBlock StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto)
-> LedgerState (CardanoBlock StandardCrypto)
forall a b. (a -> b) -> a -> b
$ ProtocolInfo (CardanoBlock StandardCrypto)
-> ExtLedgerState (CardanoBlock StandardCrypto)
forall b. ProtocolInfo b -> ExtLedgerState b
pInfoInitLedger ProtocolInfo (CardanoBlock StandardCrypto)
pInfo
, immpLedgerConfig :: LedgerConfig (CardanoBlock StandardCrypto)
Mocked.immpLedgerConfig =
TopLevelConfig (CardanoBlock StandardCrypto)
-> LedgerConfig (CardanoBlock StandardCrypto)
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger (TopLevelConfig (CardanoBlock StandardCrypto)
-> LedgerConfig (CardanoBlock StandardCrypto))
-> TopLevelConfig (CardanoBlock StandardCrypto)
-> LedgerConfig (CardanoBlock StandardCrypto)
forall a b. (a -> b) -> a -> b
$ ProtocolInfo (CardanoBlock StandardCrypto)
-> TopLevelConfig (CardanoBlock StandardCrypto)
forall b. ProtocolInfo b -> TopLevelConfig b
pInfoConfig ProtocolInfo (CardanoBlock StandardCrypto)
pInfo
}
MockedMempool IO (CardanoBlock StandardCrypto)
mempool <- MempoolCapacityBytesOverride
-> Tracer IO (TraceEventMempool (CardanoBlock StandardCrypto))
-> InitialMempoolAndModelParams (CardanoBlock StandardCrypto)
-> IO (MockedMempool IO (CardanoBlock StandardCrypto))
forall blk.
(LedgerSupportsMempool blk, HasTxId (GenTx blk),
ValidateEnvelope blk) =>
MempoolCapacityBytesOverride
-> Tracer IO (TraceEventMempool blk)
-> InitialMempoolAndModelParams blk
-> IO (MockedMempool IO blk)
Mocked.openMockedMempool
MempoolCapacityBytesOverride
capcityBytesOverride
Tracer IO (TraceEventMempool (CardanoBlock StandardCrypto))
forall {a}. Tracer IO a
tracer
InitialMempoolAndModelParams (CardanoBlock StandardCrypto)
mempoolParams
MockedMempool IO (CardanoBlock StandardCrypto)
mempool MockedMempool IO (CardanoBlock StandardCrypto)
-> [GenTx (CardanoBlock StandardCrypto)] -> Assertion
forall blk. MockedMempool IO blk -> [GenTx blk] -> Assertion
`should_process` [ GenTx (CardanoBlock StandardCrypto)
_137 ]
where
_137 :: GenTx (CardanoBlock StandardCrypto)
_137 :: GenTx (CardanoBlock StandardCrypto)
_137 = (DeserialiseFailure -> GenTx (CardanoBlock StandardCrypto))
-> ((ByteString, GenTx (CardanoBlock StandardCrypto))
-> GenTx (CardanoBlock StandardCrypto))
-> Either
DeserialiseFailure
(ByteString, GenTx (CardanoBlock StandardCrypto))
-> GenTx (CardanoBlock StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestName -> GenTx (CardanoBlock StandardCrypto)
forall a. HasCallStack => TestName -> a
error (TestName -> GenTx (CardanoBlock StandardCrypto))
-> (DeserialiseFailure -> TestName)
-> DeserialiseFailure
-> GenTx (CardanoBlock StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeserialiseFailure -> TestName
forall a. Show a => a -> TestName
show) (ByteString, GenTx (CardanoBlock StandardCrypto))
-> GenTx (CardanoBlock StandardCrypto)
forall a b. (a, b) -> b
snd (ByteString
-> Either
DeserialiseFailure
(ByteString, GenTx (CardanoBlock StandardCrypto))
deserialiseTx ByteString
_137_bs)
where
_137_bs :: ByteString
_137_bs = ByteString
"8205d818590210" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"84a400828258203a79a6a834e7779c67b0b3cbd3b7271883bbbeac15b1a89d78f057edc25e000b008258203a79a6a834e7779c67b0b3cbd3b7271883bbbeac15b1a89d78f057edc25e000b010182825839007d5a2560d23c3443b98d84c57b0c491311da4b3098de1945c7bcfc4c63ea8c5404f9ed9ae80d95b5544857b2011e3f26b63ddc3be1abd42d1a001e84808258390009ecea977429fa7a4993bc045ea618f3697e6b8eac9d5ea68bba7e4b63ea8c5404f9ed9ae80d95b5544857b2011e3f26b63ddc3be1abd42d821a560ea01ca4581c47be64fcc8a7fe5321b976282ce4e43e4d29015f6613cfabcea28eaba244546573741a3b97c0aa51576f52456d706972654c696368303037391a3443f4a0581c4cd2ea369880853541c5f446725f3e4ecaf141635f0c56c43104923ba14574464c41431b0de0b6b346d4b018581c85ef026c7da6a91f7acc1e662c50301bcce79eb401a3217690aa7044a14574464c41431b000000022eaca140581c92bd3be92d6a6eadd7c01ce9ff485809f3f2eb36845cd7a25c9177bfa14b546f20746865206d6f6f6e01021a0002b9b5031a05a18ef7a100818258202726733baa5c15d8d856c8d94e7d83bcfc7f5661ec7f952f052f311a2443feb258405f9d3d8a703baf700a3015994a3e8702fd7fe2e25d640487944b32ea999f36b314be9674be09b8b8f2c678976ecf994c83086180e854120d81243476c2b89e05f5f6"
should_process :: MockedMempool IO blk -> [Ledger.GenTx blk] -> IO ()
should_process :: forall blk. MockedMempool IO blk -> [GenTx blk] -> Assertion
should_process MockedMempool IO blk
mockedMempool [GenTx blk]
txs = do
IO [(GenTx blk, SubmitResult (ApplyTxErr blk))] -> Assertion
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [(GenTx blk, SubmitResult (ApplyTxErr blk))] -> Assertion)
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))] -> Assertion
forall a b. (a -> b) -> a -> b
$ Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [GenTx blk]
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall blk.
Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [GenTx blk]
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
processTxs Tracer IO (TraceLocalTxSubmissionServerEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer MockedMempool IO blk
mockedMempool [GenTx blk]
txs
processTxs ::
Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [Ledger.GenTx blk]
-> IO [(GenTx blk, SubmitResult (LedgerSupportsMempool.ApplyTxErr blk))]
processTxs :: forall blk.
Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [GenTx blk]
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
processTxs Tracer IO (TraceLocalTxSubmissionServerEvent blk)
tracer MockedMempool IO blk
mockedMempool [GenTx blk]
txs =
(\([(GenTx blk, SubmitResult (ApplyTxErr blk))]
a, ()
_, TerminalStates (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
_) -> [(GenTx blk, SubmitResult (ApplyTxErr blk))]
a) (([(GenTx blk, SubmitResult (ApplyTxErr blk))], (),
TerminalStates (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-> [(GenTx blk, SubmitResult (ApplyTxErr blk))])
-> IO
([(GenTx blk, SubmitResult (ApplyTxErr blk))], (),
TerminalStates (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
'AsClient
'StIdle
IO
[(GenTx blk, SubmitResult (ApplyTxErr blk))]
-> Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
(FlipAgency 'AsClient)
'StIdle
IO
()
-> IO
([(GenTx blk, SubmitResult (ApplyTxErr blk))], (),
TerminalStates (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, Protocol ps) =>
Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b -> m (a, b, TerminalStates ps)
connect (LocalTxSubmissionClient
(GenTx blk)
(ApplyTxErr blk)
IO
[(GenTx blk, SubmitResult (ApplyTxErr blk))]
-> Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
'AsClient
'StIdle
IO
[(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall tx reject (m :: * -> *) a.
Monad m =>
LocalTxSubmissionClient tx reject m a
-> Peer (LocalTxSubmission tx reject) 'AsClient 'StIdle m a
localTxSubmissionClientPeer LocalTxSubmissionClient
(GenTx blk)
(ApplyTxErr blk)
IO
[(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall {reject}.
LocalTxSubmissionClient
(GenTx blk) reject IO [(GenTx blk, SubmitResult reject)]
client) (IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ())
-> Peer
(LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
'AsServer
'StIdle
IO
()
forall tx reject (m :: * -> *) a.
Monad m =>
m (LocalTxSubmissionServer tx reject m a)
-> Peer (LocalTxSubmission tx reject) 'AsServer 'StIdle m a
localTxSubmissionServerPeer IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ())
mServer)
where
mServer :: IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ())
mServer = LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ()
-> IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ()
-> IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ()))
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ()
-> IO (LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ())
forall a b. (a -> b) -> a -> b
$ Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> Mempool IO blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) IO ()
forall (m :: * -> *) blk.
MonadSTM m =>
Tracer m (TraceLocalTxSubmissionServerEvent blk)
-> Mempool m blk
-> LocalTxSubmissionServer (GenTx blk) (ApplyTxErr blk) m ()
localTxSubmissionServer Tracer IO (TraceLocalTxSubmissionServerEvent blk)
tracer
(MockedMempool IO blk -> Mempool IO blk
forall (m :: * -> *) blk. MockedMempool m blk -> Mempool m blk
Mocked.getMempool MockedMempool IO blk
mockedMempool)
client :: LocalTxSubmissionClient
(GenTx blk) reject IO [(GenTx blk, SubmitResult reject)]
client = [GenTx blk]
-> LocalTxSubmissionClient
(GenTx blk) reject IO [(GenTx blk, SubmitResult reject)]
forall tx reject (m :: * -> *).
Applicative m =>
[tx]
-> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)]
localTxSubmissionClient [GenTx blk]
txs
_should_process_and_return ::
( Show (Ledger.GenTx blk)
, Eq (Ledger.ApplyTxErr blk)
, Show (SubmitResult (LedgerSupportsMempool.ApplyTxErr blk))
)
=> MockedMempool IO blk -> [(Ledger.GenTx blk, SubmitResult (LedgerSupportsMempool.ApplyTxErr blk))] -> IO ()
_should_process_and_return :: forall blk.
(Show (GenTx blk), Eq (ApplyTxErr blk),
Show (SubmitResult (ApplyTxErr blk))) =>
MockedMempool IO blk
-> [(GenTx blk, SubmitResult (ApplyTxErr blk))] -> Assertion
_should_process_and_return MockedMempool IO blk
mockedMempool [(GenTx blk, SubmitResult (ApplyTxErr blk))]
txs_ress = do
[(GenTx blk, SubmitResult (ApplyTxErr blk))]
processResult <- Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [GenTx blk]
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall blk.
Tracer IO (TraceLocalTxSubmissionServerEvent blk)
-> MockedMempool IO blk
-> [GenTx blk]
-> IO [(GenTx blk, SubmitResult (ApplyTxErr blk))]
processTxs (TraceLocalTxSubmissionServerEvent blk -> TestName
forall a. Show a => a -> TestName
show (TraceLocalTxSubmissionServerEvent blk -> TestName)
-> Tracer IO TestName
-> Tracer IO (TraceLocalTxSubmissionServerEvent blk)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
>$< Tracer IO TestName
forall (m :: * -> *). MonadIO m => Tracer m TestName
stdoutTracer) MockedMempool IO blk
mockedMempool (((GenTx blk, SubmitResult (ApplyTxErr blk)) -> GenTx blk)
-> [(GenTx blk, SubmitResult (ApplyTxErr blk))] -> [GenTx blk]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenTx blk, SubmitResult (ApplyTxErr blk)) -> GenTx blk
forall a b. (a, b) -> a
fst [(GenTx blk, SubmitResult (ApplyTxErr blk))]
txs_ress)
let
actualResults :: [SubmitResult (ApplyTxErr blk)]
actualResults = ((GenTx blk, SubmitResult (ApplyTxErr blk))
-> SubmitResult (ApplyTxErr blk))
-> [(GenTx blk, SubmitResult (ApplyTxErr blk))]
-> [SubmitResult (ApplyTxErr blk)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenTx blk, SubmitResult (ApplyTxErr blk))
-> SubmitResult (ApplyTxErr blk)
forall a b. (a, b) -> b
snd [(GenTx blk, SubmitResult (ApplyTxErr blk))]
processResult
expectedResults :: [SubmitResult (ApplyTxErr blk)]
expectedResults = ((GenTx blk, SubmitResult (ApplyTxErr blk))
-> SubmitResult (ApplyTxErr blk))
-> [(GenTx blk, SubmitResult (ApplyTxErr blk))]
-> [SubmitResult (ApplyTxErr blk)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenTx blk, SubmitResult (ApplyTxErr blk))
-> SubmitResult (ApplyTxErr blk)
forall a b. (a, b) -> b
snd [(GenTx blk, SubmitResult (ApplyTxErr blk))]
txs_ress
[SubmitResult (ApplyTxErr blk)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubmitResult (ApplyTxErr blk)]
actualResults Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@=? [SubmitResult (ApplyTxErr blk)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SubmitResult (ApplyTxErr blk)]
expectedResults
((SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))
-> Assertion)
-> [(SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))]
-> Assertion
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((SubmitResult (ApplyTxErr blk)
-> SubmitResult (ApplyTxErr blk) -> Assertion)
-> (SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))
-> Assertion
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SubmitResult (ApplyTxErr blk)
-> SubmitResult (ApplyTxErr blk) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
(@=?)) ([(SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))]
-> Assertion)
-> [(SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))]
-> Assertion
forall a b. (a -> b) -> a -> b
$ [SubmitResult (ApplyTxErr blk)]
-> [SubmitResult (ApplyTxErr blk)]
-> [(SubmitResult (ApplyTxErr blk), SubmitResult (ApplyTxErr blk))]
forall a b. [a] -> [b] -> [(a, b)]
zip [SubmitResult (ApplyTxErr blk)]
expectedResults [SubmitResult (ApplyTxErr blk)]
actualResults
() -> Assertion
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()