{-# LANGUAGE DataKinds      #-}
{-# LANGUAGE GADTs          #-}
{-# LANGUAGE NamedFieldPuns #-}

-- | Unit properties of `txSubmissionOutbound`, driven directly by the
-- requests of the inbound side.
--
module Test.Ouroboros.Network.TxSubmission.Outbound (tests) where

import Control.Monad.Class.MonadThrow (try)
import Control.Monad.IOSim (runSimOrThrow)
import Control.Tracer (nullTracer)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Word (Word16)

import Ouroboros.Network.ControlMessage (ControlMessage (..))
import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.TxSubmission.Outbound

import Test.Ouroboros.Network.TxSubmission.Types

import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Outbound"
    [ TestName
-> (ArbTxOutboundVersion
    -> Positive (Small Word16) -> Positive (Small Word16) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"blocking request with a zero window is a protocol error"
                   ArbTxOutboundVersion
-> Positive (Small Word16) -> Positive (Small Word16) -> Property
prop_blockingRequest_zeroWindow
    , TestName
-> (ArbTxOutboundVersion
    -> Positive (Small Word16)
    -> Positive (Small Word16)
    -> Positive (Small Word16)
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"blocking request with a positive window is replied"
                   ArbTxOutboundVersion
-> Positive (Small Word16)
-> Positive (Small Word16)
-> Positive (Small Word16)
-> Property
prop_blockingRequest_positiveWindow
    , TestName
-> (Positive (Small Word16)
    -> Positive (Small Word16) -> Positive (Small Word16) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"non-blocking requests are clamped to the window"
                   Positive (Small Word16)
-> Positive (Small Word16) -> Positive (Small Word16) -> Property
prop_nonBlockingRequests_clampedToWindow
    ]


-- | Send a blocking `MsgRequestTxIds` for `reqNo` txids to a fresh
-- `txSubmissionOutbound` whose mempool holds `n` txs.  Returns the protocol
-- error, or the txids of the reply (`Nothing` for `MsgDone`).
--
blockingRequest :: TxSubmissionConfig
                -> TxOutboundVersion
                -> NumTxIdsToReq
                -> Word16
                -> Either TxSubmissionProtocolError (Maybe [TxId])
blockingRequest :: TxSubmissionConfig
-> TxOutboundVersion
-> NumTxIdsToReq
-> Word16
-> Either TxSubmissionProtocolError (Maybe [TxId])
blockingRequest TxSubmissionConfig
config TxOutboundVersion
version NumTxIdsToReq
reqNo Word16
n = (forall s.
 IOSim s (Either TxSubmissionProtocolError (Maybe [TxId])))
-> Either TxSubmissionProtocolError (Maybe [TxId])
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s.
  IOSim s (Either TxSubmissionProtocolError (Maybe [TxId])))
 -> Either TxSubmissionProtocolError (Maybe [TxId]))
-> (forall s.
    IOSim s (Either TxSubmissionProtocolError (Maybe [TxId])))
-> Either TxSubmissionProtocolError (Maybe [TxId])
forall a b. (a -> b) -> a -> b
$ do
    mempool <- [Tx TxId] -> IOSim s (Mempool (IOSim s) TxId (Tx TxId))
forall (m :: * -> *) txid.
(MonadSTM m, Ord txid) =>
[Tx txid] -> m (Mempool m txid (Tx txid))
newMempool
                 [ Tx { getTxId :: TxId
getTxId      = TxId
txid,
                        getTxSize :: SizeInBytes
getTxSize    = SizeInBytes
100,
                        getTxAdvSize :: SizeInBytes
getTxAdvSize = SizeInBytes
100,
                        getTxValid :: Bool
getTxValid   = Bool
True,
                        getTxParent :: Maybe TxId
getTxParent  = Maybe TxId
forall a. Maybe a
Nothing }
                 | TxId
txid <- [TxId
1 .. Word16 -> TxId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n] ]
    ClientStIdle { recvMsgRequestTxIds } <-
      runTxSubmissionClient $
        txSubmissionOutbound nullTracer config (getMempoolReader mempool)
                             version (pure Continue)
    reply <- try (recvMsgRequestTxIds SingBlocking 0 reqNo)
    pure $ case reply of
      Left TxSubmissionProtocolError
err -> TxSubmissionProtocolError
-> Either TxSubmissionProtocolError (Maybe [TxId])
forall a b. a -> Either a b
Left TxSubmissionProtocolError
err
      Right (SendMsgReplyTxIds (BlockingReply NonEmpty (TxId, SizeInBytes)
txids) ClientStIdle TxId (Tx TxId) (IOSim s) ()
_) ->
        Maybe [TxId] -> Either TxSubmissionProtocolError (Maybe [TxId])
forall a b. b -> Either a b
Right ([TxId] -> Maybe [TxId]
forall a. a -> Maybe a
Just ((TxId, SizeInBytes) -> TxId
forall a b. (a, b) -> a
fst ((TxId, SizeInBytes) -> TxId) -> [(TxId, SizeInBytes)] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (TxId, SizeInBytes) -> [(TxId, SizeInBytes)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (TxId, SizeInBytes)
txids))
      Right (SendMsgDone ()) -> Maybe [TxId] -> Either TxSubmissionProtocolError (Maybe [TxId])
forall a b. b -> Either a b
Right Maybe [TxId]
forall a. Maybe a
Nothing


-- | A zero window is a misconfiguration of our own.  The first blocking
-- request is a protocol error under both versions: under `TxOutboundV_1`
-- because the request exceeds the window, under `TxOutboundV_2` because the
-- request is clamped to zero txids, which a blocking reply cannot carry.
--
prop_blockingRequest_zeroWindow :: ArbTxOutboundVersion
                                -> Positive (Small Word16)
                                -> Positive (Small Word16)
                                -> Property
prop_blockingRequest_zeroWindow :: ArbTxOutboundVersion
-> Positive (Small Word16) -> Positive (Small Word16) -> Property
prop_blockingRequest_zeroWindow (ArbTxOutboundVersion TxOutboundVersion
version)
                                (Positive (Small Word16
reqNo))
                                (Positive (Small Word16
n)) =
    let config :: TxSubmissionConfig
config = TxSubmissionConfig {
                   maxNumUnacknowledgedTxIds :: NumTxIdsToAck
maxNumUnacknowledgedTxIds = NumTxIdsToAck
0,
                   maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest      = Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
reqNo
                 }
    in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TxOutboundVersion -> TestName
forall a. Show a => a -> TestName
show TxOutboundVersion
version) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
       case TxSubmissionConfig
-> TxOutboundVersion
-> NumTxIdsToReq
-> Word16
-> Either TxSubmissionProtocolError (Maybe [TxId])
blockingRequest TxSubmissionConfig
config TxOutboundVersion
version (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
reqNo) Word16
n of
         Left ProtocolErrorRequestedTooManyTxids {} -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
         Either TxSubmissionProtocolError (Maybe [TxId])
result -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Either TxSubmissionProtocolError (Maybe [TxId]) -> TestName
forall a. Show a => a -> TestName
show Either TxSubmissionProtocolError (Maybe [TxId])
result) Bool
False


-- | With a positive window, a blocking request within it is replied with
-- the first txs in the mempool.  Under `TxOutboundV_2` a request above the
-- window is clamped to it.
--
prop_blockingRequest_positiveWindow :: ArbTxOutboundVersion
                                    -> Positive (Small Word16)
                                    -> Positive (Small Word16)
                                    -> Positive (Small Word16)
                                    -> Property
prop_blockingRequest_positiveWindow :: ArbTxOutboundVersion
-> Positive (Small Word16)
-> Positive (Small Word16)
-> Positive (Small Word16)
-> Property
prop_blockingRequest_positiveWindow (ArbTxOutboundVersion TxOutboundVersion
version)
                                    (Positive (Small Word16
window))
                                    (Positive (Small Word16
reqNo0))
                                    (Positive (Small Word16
n)) =
    let config :: TxSubmissionConfig
config = TxSubmissionConfig {
                   maxNumUnacknowledgedTxIds :: NumTxIdsToAck
maxNumUnacknowledgedTxIds = Word16 -> NumTxIdsToAck
NumTxIdsToAck Word16
window,
                   maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest      = Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
reqNo
                 }
        -- under `TxOutboundV_1` a request above the window is a protocol
        -- error
        reqNo :: Word16
reqNo = case TxOutboundVersion
version of
          TxOutboundVersion
TxOutboundV_1 -> Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
reqNo0 Word16
window
          TxOutboundVersion
TxOutboundV_2 -> Word16
reqNo0
        expected :: [TxId]
expected = TxId -> [TxId] -> [TxId]
forall a. TxId -> [a] -> [a]
take (Word16 -> TxId
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
reqNo Word16
window)) [TxId
1 .. Word16 -> TxId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n]
    in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TxOutboundVersion -> TestName
forall a. Show a => a -> TestName
show TxOutboundVersion
version) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
       Bool -> TestName -> Property -> Property
forall prop. Testable prop => Bool -> TestName -> prop -> Property
classify (Word16
reqNo Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
window) TestName
"request clamped" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
       case TxSubmissionConfig
-> TxOutboundVersion
-> NumTxIdsToReq
-> Word16
-> Either TxSubmissionProtocolError (Maybe [TxId])
blockingRequest TxSubmissionConfig
config TxOutboundVersion
version (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
reqNo) Word16
n of
         Right (Just [TxId]
txids) -> [TxId]
txids [TxId] -> [TxId] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [TxId]
expected
         Either TxSubmissionProtocolError (Maybe [TxId])
result             -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Either TxSubmissionProtocolError (Maybe [TxId]) -> TestName
forall a. Show a => a -> TestName
show Either TxSubmissionProtocolError (Maybe [TxId])
result) Bool
False


-- | A `MsgRequestTxIds`.
--
data Request = Blocking    NumTxIdsToAck NumTxIdsToReq
             | NonBlocking NumTxIdsToAck NumTxIdsToReq
  deriving TxId -> Request -> ShowS
[Request] -> ShowS
Request -> TestName
(TxId -> Request -> ShowS)
-> (Request -> TestName) -> ([Request] -> ShowS) -> Show Request
forall a.
(TxId -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: TxId -> Request -> ShowS
showsPrec :: TxId -> Request -> ShowS
$cshow :: Request -> TestName
show :: Request -> TestName
$cshowList :: [Request] -> ShowS
showList :: [Request] -> ShowS
Show

-- | Send the requests in turn to a fresh `txSubmissionOutbound` whose mempool
-- holds `n` txs.  Returns the txids of each reply, up to the first protocol
-- error or `MsgDone`.
--
runRequests :: TxSubmissionConfig
            -> TxOutboundVersion
            -> Word16
            -> [Request]
            -> ([[TxId]], Maybe TxSubmissionProtocolError)
runRequests :: TxSubmissionConfig
-> TxOutboundVersion
-> Word16
-> [Request]
-> ([[TxId]], Maybe TxSubmissionProtocolError)
runRequests TxSubmissionConfig
config TxOutboundVersion
version Word16
n [Request]
requests = (forall s. IOSim s ([[TxId]], Maybe TxSubmissionProtocolError))
-> ([[TxId]], Maybe TxSubmissionProtocolError)
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s ([[TxId]], Maybe TxSubmissionProtocolError))
 -> ([[TxId]], Maybe TxSubmissionProtocolError))
-> (forall s. IOSim s ([[TxId]], Maybe TxSubmissionProtocolError))
-> ([[TxId]], Maybe TxSubmissionProtocolError)
forall a b. (a -> b) -> a -> b
$ do
    mempool <- [Tx TxId] -> IOSim s (Mempool (IOSim s) TxId (Tx TxId))
forall (m :: * -> *) txid.
(MonadSTM m, Ord txid) =>
[Tx txid] -> m (Mempool m txid (Tx txid))
newMempool
                 [ Tx { getTxId :: TxId
getTxId      = TxId
txid,
                        getTxSize :: SizeInBytes
getTxSize    = SizeInBytes
100,
                        getTxAdvSize :: SizeInBytes
getTxAdvSize = SizeInBytes
100,
                        getTxValid :: Bool
getTxValid   = Bool
True,
                        getTxParent :: Maybe TxId
getTxParent  = Maybe TxId
forall a. Maybe a
Nothing }
                 | TxId
txid <- [TxId
1 .. Word16 -> TxId
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
n] ]
    client <-
      runTxSubmissionClient $
        txSubmissionOutbound nullTracer config (getMempoolReader mempool)
                             version (pure Continue)
    go client requests []
  where
    go :: ClientStIdle txid tx f ()
-> [Request] -> [[txid]] -> f ([[txid]], Maybe a)
go ClientStIdle txid tx f ()
_ [] [[txid]]
replies = ([[txid]], Maybe a) -> f ([[txid]], Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[txid]] -> [[txid]]
forall a. [a] -> [a]
reverse [[txid]]
replies, Maybe a
forall a. Maybe a
Nothing)
    go ClientStIdle { forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds blocking txid tx f ())
recvMsgRequestTxIds :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a
-> forall (blocking :: StBlockingStyle).
   SingBlockingStyle blocking
   -> NumTxIdsToAck
   -> NumTxIdsToReq
   -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds :: forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds blocking txid tx f ())
recvMsgRequestTxIds } (Request
request : [Request]
rest) [[txid]]
replies = do
      reply <- f (Maybe ([txid], ClientStIdle txid tx f ()))
-> f (Either a (Maybe ([txid], ClientStIdle txid tx f ())))
forall e a. Exception e => f a -> f (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try (f (Maybe ([txid], ClientStIdle txid tx f ()))
 -> f (Either a (Maybe ([txid], ClientStIdle txid tx f ()))))
-> f (Maybe ([txid], ClientStIdle txid tx f ()))
-> f (Either a (Maybe ([txid], ClientStIdle txid tx f ())))
forall a b. (a -> b) -> a -> b
$ case Request
request of
        Blocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo -> do
          r <- SingBlockingStyle 'StBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds 'StBlocking txid tx f ())
forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds blocking txid tx f ())
recvMsgRequestTxIds SingBlockingStyle 'StBlocking
SingBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo
          pure $ case r of
            SendMsgReplyTxIds (BlockingReply NonEmpty (txid, SizeInBytes)
txids) ClientStIdle txid tx f ()
k ->
              ([txid], ClientStIdle txid tx f ())
-> Maybe ([txid], ClientStIdle txid tx f ())
forall a. a -> Maybe a
Just ((txid, SizeInBytes) -> txid
forall a b. (a, b) -> a
fst ((txid, SizeInBytes) -> txid) -> [(txid, SizeInBytes)] -> [txid]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (txid, SizeInBytes) -> [(txid, SizeInBytes)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (txid, SizeInBytes)
txids, ClientStIdle txid tx f ()
k)
            SendMsgDone () -> Maybe ([txid], ClientStIdle txid tx f ())
forall a. Maybe a
Nothing
        NonBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo -> do
          SendMsgReplyTxIds (NonBlockingReply txids) k <-
            SingBlockingStyle 'StNonBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds 'StNonBlocking txid tx f ())
forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> f (ClientStTxIds blocking txid tx f ())
recvMsgRequestTxIds SingBlockingStyle 'StNonBlocking
SingNonBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo
          pure (Just (fst <$> txids, k))
      case reply of
        Left a
err                -> ([[txid]], Maybe a) -> f ([[txid]], Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[txid]] -> [[txid]]
forall a. [a] -> [a]
reverse [[txid]]
replies, a -> Maybe a
forall a. a -> Maybe a
Just a
err)
        Right Maybe ([txid], ClientStIdle txid tx f ())
Nothing           -> ([[txid]], Maybe a) -> f ([[txid]], Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[txid]] -> [[txid]]
forall a. [a] -> [a]
reverse [[txid]]
replies, Maybe a
forall a. Maybe a
Nothing)
        Right (Just ([txid]
txids, ClientStIdle txid tx f ()
k)) -> ClientStIdle txid tx f ()
-> [Request] -> [[txid]] -> f ([[txid]], Maybe a)
go ClientStIdle txid tx f ()
k [Request]
rest ([txid]
txids [txid] -> [[txid]] -> [[txid]]
forall a. a -> [a] -> [a]
: [[txid]]
replies)


-- | With a full window, `TxOutboundV_2` clamps non-blocking requests to the
-- room left in the window:
--
-- 1. a blocking request fills the window of `w` txids;
-- 2. a request which acknowledges nothing is clamped to zero: the reply is
--    empty and the window stays full;
-- 3. a request which acknowledges `k` txids gets at most `k` new txids;
-- 4. a request which only acknowledges a txid gets an empty reply;
-- 5. the next request gets the room freed by steps 3 and 4.
--
prop_nonBlockingRequests_clampedToWindow :: Positive (Small Word16)
                                         -> Positive (Small Word16)
                                         -> Positive (Small Word16)
                                         -> Property
prop_nonBlockingRequests_clampedToWindow :: Positive (Small Word16)
-> Positive (Small Word16) -> Positive (Small Word16) -> Property
prop_nonBlockingRequests_clampedToWindow (Positive (Small Word16
w0))
                                         (Positive (Small Word16
k0))
                                         (Positive (Small Word16
r)) =
    let -- `w >= 2` and `k < w` keep at least two txids unacknowledged
        -- after step 3, so that step 4 leaves the queue non-empty, as
        -- a non-blocking request requires
        w :: Word16
w = Word16
1 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
w0
        k :: Word16
k = Word16
1 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ (Word16
k0 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1) Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` (Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
1)
        config :: TxSubmissionConfig
config = TxSubmissionConfig {
                   maxNumUnacknowledgedTxIds :: NumTxIdsToAck
maxNumUnacknowledgedTxIds = Word16 -> NumTxIdsToAck
NumTxIdsToAck Word16
w,
                   maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest      = Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
r
                 }
        txid :: Word16 -> TxId
        txid :: Word16 -> TxId
txid = Word16 -> TxId
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        -- txids returned in step 3
        m :: Word16
m = Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
r Word16
k
        -- room left after step 4: `w - (w - k + m - 1)`
        room :: Word16
room = Word16
k Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
m Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
        requests :: [Request]
requests =
          [ NumTxIdsToAck -> NumTxIdsToReq -> Request
Blocking    NumTxIdsToAck
0                 (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
w)
          , NumTxIdsToAck -> NumTxIdsToReq -> Request
NonBlocking NumTxIdsToAck
0                 (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
r)
          , NumTxIdsToAck -> NumTxIdsToReq -> Request
NonBlocking (Word16 -> NumTxIdsToAck
NumTxIdsToAck Word16
k) (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
r)
          , NumTxIdsToAck -> NumTxIdsToReq -> Request
NonBlocking NumTxIdsToAck
1                 NumTxIdsToReq
0
          , NumTxIdsToAck -> NumTxIdsToReq -> Request
NonBlocking NumTxIdsToAck
0                 (Word16 -> NumTxIdsToReq
NumTxIdsToReq Word16
r)
          ]
        expected :: [[TxId]]
expected =
          [ Word16 -> TxId
txid (Word16 -> TxId) -> [Word16] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word16
1 .. Word16
w]
          , []
          , Word16 -> TxId
txid (Word16 -> TxId) -> [Word16] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 .. Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
m]
          , []
          , Word16 -> TxId
txid (Word16 -> TxId) -> [Word16] -> [TxId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
m Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1 .. Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
m Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
min Word16
r Word16
room]
          ]
    in Bool -> TestName -> Property -> Property
forall prop. Testable prop => Bool -> TestName -> prop -> Property
classify (Word16
r Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
k) TestName
"step 3 clamped" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
       Bool -> TestName -> Property -> Property
forall prop. Testable prop => Bool -> TestName -> prop -> Property
classify (Word16
r Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
room) TestName
"step 5 clamped" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
       case TxSubmissionConfig
-> TxOutboundVersion
-> Word16
-> [Request]
-> ([[TxId]], Maybe TxSubmissionProtocolError)
runRequests TxSubmissionConfig
config TxOutboundVersion
TxOutboundV_2 (Word16
3 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
w Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
r) [Request]
requests of
         ([[TxId]]
replies, Maybe TxSubmissionProtocolError
Nothing) -> [[TxId]]
replies [[TxId]] -> [[TxId]] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [[TxId]]
expected
         ([[TxId]], Maybe TxSubmissionProtocolError)
result             -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (([[TxId]], Maybe TxSubmissionProtocolError) -> TestName
forall a. Show a => a -> TestName
show ([[TxId]], Maybe TxSubmissionProtocolError)
result) Bool
False