{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Test that we can submit transactions to the mempool using the local
-- submission server, in different Cardano eras.
--
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
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock StandardCrypto)
forall c.
(CardanoHardForkConstraints c, c ~ StandardCrypto) =>
DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> ProtVer
-> CardanoHardForkTriggers
-> 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 -> CardanoHardForkTriggers
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
            -- We don't want the mempool to fill up during these tests.
            capcityBytesOverride :: MempoolCapacityBytesOverride
capcityBytesOverride =
              ByteSize32 -> MempoolCapacityBytesOverride
Mempool.mkCapacityBytesOverride (Word32 -> ByteSize32
ByteSize32 Word32
100_000)
            -- Use 'show >$< stdoutTracer' for debugging.
            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
        -- Reported in https://github.com/IntersectMBO/ouroboros-consensus/issues/137
        _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"

-- | Check that the given transactions can be processed, irrespective of whether
-- they were sucessfully validated.
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
  'NonPipelined
  'StIdle
  IO
  [(GenTx blk, SubmitResult (ApplyTxErr blk))]
-> Peer
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     (FlipAgency 'AsClient)
     'NonPipelined
     'StIdle
     IO
     ()
-> IO
     ([(GenTx blk, SubmitResult (ApplyTxErr blk))], (),
      TerminalStates (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)))
forall ps (pr :: PeerRole) (initSt :: ps) (m :: * -> *) a b.
(Monad m, SingI pr) =>
Peer ps pr 'NonPipelined initSt m a
-> Peer ps (FlipAgency pr) 'NonPipelined initSt 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
     'NonPipelined
     'StIdle
     IO
     [(GenTx blk, SubmitResult (ApplyTxErr blk))]
forall tx reject (m :: * -> *) a.
Monad m =>
LocalTxSubmissionClient tx reject m a
-> Client (LocalTxSubmission tx reject) 'NonPipelined '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 ())
-> Server
     (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
     'NonPipelined
     'StIdle
     IO
     ()
forall tx reject (m :: * -> *) a.
Monad m =>
m (LocalTxSubmissionServer tx reject m a)
-> Server (LocalTxSubmission tx reject) 'NonPipelined '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

-- TODO: this function is unused at the moment. We will use it once we add tests
-- for Cardano transactions that are supposed to succeed.
_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 ()