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

-- | 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 Cardano.Ledger.BaseTypes (knownNonZeroBounded)
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 Test.Consensus.Mempool.Mocked (MockedMempool)
import qualified Test.Consensus.Mempool.Mocked as Mocked
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 =>
DecentralizationParam
-> SecurityParam
-> ByronSlotLengthInSeconds
-> ShelleySlotLengthInSeconds
-> ProtVer
-> CardanoHardForkTriggers
-> ProtocolInfo (CardanoBlock c)
mkSimpleTestProtocolInfo
            (Rational -> DecentralizationParam
Shelley.DecentralizationParam Rational
1)
            (NonZero Word64 -> SecurityParam
Consensus.SecurityParam (NonZero Word64 -> SecurityParam)
-> NonZero Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @10)
            (Word64 -> ByronSlotLengthInSeconds
ByronSlotLengthInSeconds Word64
1)
            (Word64 -> ShelleySlotLengthInSeconds
ShelleySlotLengthInSeconds Word64
1)
            ProtVer
protocolVersionZero
            (Era -> CardanoHardForkTriggers
hardForkInto Era
era)

        eraIndex :: Int
eraIndex =
          NS
  (Current (Flip LedgerState ValuesMK))
  (ByronBlock : CardanoShelleyEras StandardCrypto)
-> Int
forall {k} (f :: k -> *) (xs :: [k]). NS f xs -> Int
index_NS
            (NS
   (Current (Flip LedgerState ValuesMK))
   (ByronBlock : CardanoShelleyEras StandardCrypto)
 -> Int)
-> (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
    -> NS
         (Current (Flip LedgerState ValuesMK))
         (ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Telescope
  (K Past)
  (Current (Flip LedgerState ValuesMK))
  (ByronBlock : CardanoShelleyEras StandardCrypto)
-> NS
     (Current (Flip LedgerState ValuesMK))
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Telescope.tip
            (Telescope
   (K Past)
   (Current (Flip LedgerState ValuesMK))
   (ByronBlock : CardanoShelleyEras StandardCrypto)
 -> NS
      (Current (Flip LedgerState ValuesMK))
      (ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
    -> Telescope
         (K Past)
         (Current (Flip LedgerState ValuesMK))
         (ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> NS
     (Current (Flip LedgerState ValuesMK))
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardForkState
  (Flip LedgerState ValuesMK)
  (ByronBlock : CardanoShelleyEras StandardCrypto)
-> Telescope
     (K Past)
     (Current (Flip LedgerState ValuesMK))
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState
            (HardForkState
   (Flip LedgerState ValuesMK)
   (ByronBlock : CardanoShelleyEras StandardCrypto)
 -> Telescope
      (K Past)
      (Current (Flip LedgerState ValuesMK))
      (ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
    -> HardForkState
         (Flip LedgerState ValuesMK)
         (ByronBlock : CardanoShelleyEras StandardCrypto))
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> Telescope
     (K Past)
     (Current (Flip LedgerState ValuesMK))
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock StandardCrypto) ValuesMK
-> HardForkState
     (Flip LedgerState ValuesMK)
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall (xs :: [*]) (mk :: MapKind).
LedgerState (HardForkBlock xs) mk
-> HardForkState (Flip LedgerState mk) xs
hardForkLedgerStatePerEra
            (LedgerState (CardanoBlock StandardCrypto) ValuesMK
 -> HardForkState
      (Flip LedgerState ValuesMK)
      (ByronBlock : CardanoShelleyEras StandardCrypto))
-> (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
    -> LedgerState (CardanoBlock StandardCrypto) ValuesMK)
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> HardForkState
     (Flip LedgerState ValuesMK)
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> LedgerState (CardanoBlock StandardCrypto) ValuesMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState
            (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK -> Int)
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK -> Int
forall a b. (a -> b) -> a -> b
$ ProtocolInfo (CardanoBlock StandardCrypto)
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
forall b. ProtocolInfo b -> ExtLedgerState b ValuesMK
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) ValuesMK
Mocked.immpInitialState =
                ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> LedgerState (CardanoBlock StandardCrypto) ValuesMK
forall blk (mk :: MapKind).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState (ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
 -> LedgerState (CardanoBlock StandardCrypto) ValuesMK)
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
-> LedgerState (CardanoBlock StandardCrypto) ValuesMK
forall a b. (a -> b) -> a -> b
$ ProtocolInfo (CardanoBlock StandardCrypto)
-> ExtLedgerState (CardanoBlock StandardCrypto) ValuesMK
forall b. ProtocolInfo b -> ExtLedgerState b ValuesMK
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
            }

      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

      mempool `should_process` [_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
  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 = ((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 = ((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
  length actualResults @=? length expectedResults
  mapM_ (uncurry (@=?)) $ zip expectedResults actualResults
  pure ()