{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Ouroboros.Network.TxSubmission.AppV2 (tests) where

import Prelude hiding (seq)

import NoThunks.Class

import Control.Concurrent.Class.MonadMVar.Strict
import Control.Concurrent.Class.MonadSTM qualified as Lazy
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadAsync
import Control.Monad.Class.MonadFork
import Control.Monad.Class.MonadSay
import Control.Monad.Class.MonadST
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI
import Control.Monad.Class.MonadTimer.SI
import Control.Monad.IOSim
import Control.Tracer (Tracer (..), contramap)

import Data.ByteString.Lazy qualified as BSL
import Data.Foldable (traverse_)
import Data.Function (on)
import Data.Hashable
import Data.List (nubBy)
import Data.List qualified as List
import Data.List.Trace qualified as Trace
import Data.Map.Merge.Strict
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid (Sum (..))
import Data.Set qualified as Set
import Data.Typeable (Typeable)
import System.Random (mkStdGen)

import Ouroboros.Network.Channel
import Ouroboros.Network.ControlMessage (ControlMessage (..), ControlMessageSTM)
import Ouroboros.Network.Driver
import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Codec
import Ouroboros.Network.Protocol.TxSubmission2.Server
import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.TxSubmission.Inbound.V2 (txSubmissionInboundV2)
import Ouroboros.Network.TxSubmission.Inbound.V2.Policy
import Ouroboros.Network.TxSubmission.Inbound.V2.Registry
import Ouroboros.Network.TxSubmission.Inbound.V2.Types
import Ouroboros.Network.TxSubmission.Outbound
import Ouroboros.Network.Util.ShowProxy

import Test.Ouroboros.Network.TxSubmission.TxLogic hiding (tests)
import Test.Ouroboros.Network.TxSubmission.Types
import Test.Ouroboros.Network.Utils hiding (debugTracer)

import Test.QuickCheck
#if !MIN_VERSION_QuickCheck(2,16,0)
import "quickcheck-monoids" Test.QuickCheck.Monoids
#endif
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)


tests :: TestTree
tests :: TestTree
tests = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"AppV2"
  [ [Char] -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"txSubmission"  TxSubmissionState -> Property
prop_txSubmission
  , [Char] -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"inflight"      TxSubmissionState -> Property
prop_txSubmission_inflight
  , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"SharedTxState" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSize Int
25
                                 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Int -> (TxSubmissionState -> Property) -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
25
                                 TxSubmissionState -> Property
prop_sharedTxStateInvariant
  ]

data TestVersion = TestVersion
  deriving (TestVersion -> TestVersion -> Bool
(TestVersion -> TestVersion -> Bool)
-> (TestVersion -> TestVersion -> Bool) -> Eq TestVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestVersion -> TestVersion -> Bool
== :: TestVersion -> TestVersion -> Bool
$c/= :: TestVersion -> TestVersion -> Bool
/= :: TestVersion -> TestVersion -> Bool
Eq, Eq TestVersion
Eq TestVersion =>
(TestVersion -> TestVersion -> Ordering)
-> (TestVersion -> TestVersion -> Bool)
-> (TestVersion -> TestVersion -> Bool)
-> (TestVersion -> TestVersion -> Bool)
-> (TestVersion -> TestVersion -> Bool)
-> (TestVersion -> TestVersion -> TestVersion)
-> (TestVersion -> TestVersion -> TestVersion)
-> Ord TestVersion
TestVersion -> TestVersion -> Bool
TestVersion -> TestVersion -> Ordering
TestVersion -> TestVersion -> TestVersion
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 :: TestVersion -> TestVersion -> Ordering
compare :: TestVersion -> TestVersion -> Ordering
$c< :: TestVersion -> TestVersion -> Bool
< :: TestVersion -> TestVersion -> Bool
$c<= :: TestVersion -> TestVersion -> Bool
<= :: TestVersion -> TestVersion -> Bool
$c> :: TestVersion -> TestVersion -> Bool
> :: TestVersion -> TestVersion -> Bool
$c>= :: TestVersion -> TestVersion -> Bool
>= :: TestVersion -> TestVersion -> Bool
$cmax :: TestVersion -> TestVersion -> TestVersion
max :: TestVersion -> TestVersion -> TestVersion
$cmin :: TestVersion -> TestVersion -> TestVersion
min :: TestVersion -> TestVersion -> TestVersion
Ord, TestVersion
TestVersion -> TestVersion -> Bounded TestVersion
forall a. a -> a -> Bounded a
$cminBound :: TestVersion
minBound :: TestVersion
$cmaxBound :: TestVersion
maxBound :: TestVersion
Bounded, Int -> TestVersion
TestVersion -> Int
TestVersion -> [TestVersion]
TestVersion -> TestVersion
TestVersion -> TestVersion -> [TestVersion]
TestVersion -> TestVersion -> TestVersion -> [TestVersion]
(TestVersion -> TestVersion)
-> (TestVersion -> TestVersion)
-> (Int -> TestVersion)
-> (TestVersion -> Int)
-> (TestVersion -> [TestVersion])
-> (TestVersion -> TestVersion -> [TestVersion])
-> (TestVersion -> TestVersion -> [TestVersion])
-> (TestVersion -> TestVersion -> TestVersion -> [TestVersion])
-> Enum TestVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TestVersion -> TestVersion
succ :: TestVersion -> TestVersion
$cpred :: TestVersion -> TestVersion
pred :: TestVersion -> TestVersion
$ctoEnum :: Int -> TestVersion
toEnum :: Int -> TestVersion
$cfromEnum :: TestVersion -> Int
fromEnum :: TestVersion -> Int
$cenumFrom :: TestVersion -> [TestVersion]
enumFrom :: TestVersion -> [TestVersion]
$cenumFromThen :: TestVersion -> TestVersion -> [TestVersion]
enumFromThen :: TestVersion -> TestVersion -> [TestVersion]
$cenumFromTo :: TestVersion -> TestVersion -> [TestVersion]
enumFromTo :: TestVersion -> TestVersion -> [TestVersion]
$cenumFromThenTo :: TestVersion -> TestVersion -> TestVersion -> [TestVersion]
enumFromThenTo :: TestVersion -> TestVersion -> TestVersion -> [TestVersion]
Enum, Int -> TestVersion -> ShowS
[TestVersion] -> ShowS
TestVersion -> [Char]
(Int -> TestVersion -> ShowS)
-> (TestVersion -> [Char])
-> ([TestVersion] -> ShowS)
-> Show TestVersion
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestVersion -> ShowS
showsPrec :: Int -> TestVersion -> ShowS
$cshow :: TestVersion -> [Char]
show :: TestVersion -> [Char]
$cshowList :: [TestVersion] -> ShowS
showList :: [TestVersion] -> ShowS
Show)

data TxSubmissionState =
  TxSubmissionState {
      TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap :: Map Int ( [Tx Int]
                         , Maybe (Positive SmallDelay)
                         , Maybe (Positive SmallDelay)
                         -- ^ The delay must be smaller (<) than 5s, so that overall
                         -- delay is less than 10s, otherwise 'smallDelay' in
                         -- 'timeLimitsTxSubmission2' will kick in.
                         )
    , TxSubmissionState -> TxDecisionPolicy
decisionPolicy :: TxDecisionPolicy
  } deriving (Int -> TxSubmissionState -> ShowS
[TxSubmissionState] -> ShowS
TxSubmissionState -> [Char]
(Int -> TxSubmissionState -> ShowS)
-> (TxSubmissionState -> [Char])
-> ([TxSubmissionState] -> ShowS)
-> Show TxSubmissionState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionState -> ShowS
showsPrec :: Int -> TxSubmissionState -> ShowS
$cshow :: TxSubmissionState -> [Char]
show :: TxSubmissionState -> [Char]
$cshowList :: [TxSubmissionState] -> ShowS
showList :: [TxSubmissionState] -> ShowS
Show)

instance Arbitrary TxSubmissionState where
  arbitrary :: Gen TxSubmissionState
arbitrary = do
    ArbTxDecisionPolicy decisionPolicy <- Gen ArbTxDecisionPolicy
forall a. Arbitrary a => Gen a
arbitrary
    peersN <- choose (1, 10)
    txsN <- choose (1, 10)
    -- NOTE: using sortOn would forces tx-decision logic to download txs in the
    -- order of unacknowledgedTxIds.  This could be useful to get better
    -- properties when wrongly sized txs are present.
    txs <- fmap (nubBy (on (==) getTxId)) . divvy txsN {- . List.sortOn getTxId -} <$> vectorOf (peersN * txsN) arbitrary
    peers <- vectorOf peersN arbitrary
    peersState <- zipWith (curry (\([Tx Int]
a, (Maybe (Positive SmallDelay)
b, Maybe (Positive SmallDelay)
c)) -> ([Tx Int]
a, Maybe (Positive SmallDelay)
b, Maybe (Positive SmallDelay)
c))) txs
              <$> vectorOf peersN arbitrary
    return TxSubmissionState  { peerMap = Map.fromList (zip peers peersState),
                                decisionPolicy
                              }
  shrink :: TxSubmissionState -> [TxSubmissionState]
shrink TxSubmissionState { Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap :: TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap :: Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap, TxDecisionPolicy
decisionPolicy :: TxSubmissionState -> TxDecisionPolicy
decisionPolicy :: TxDecisionPolicy
decisionPolicy } =
    Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> TxDecisionPolicy -> TxSubmissionState
TxSubmissionState (Map
   Int
   ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
 -> TxDecisionPolicy -> TxSubmissionState)
-> [Map
      Int
      ([Tx Int], Maybe (Positive SmallDelay),
       Maybe (Positive SmallDelay))]
-> [TxDecisionPolicy -> TxSubmissionState]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> [Map
      Int
      ([Tx Int], Maybe (Positive SmallDelay),
       Maybe (Positive SmallDelay))]
forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
Map k v -> [Map k v]
shrinkMap1 Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap
                      [TxDecisionPolicy -> TxSubmissionState]
-> [TxDecisionPolicy] -> [TxSubmissionState]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ TxDecisionPolicy
policy
                          | ArbTxDecisionPolicy TxDecisionPolicy
policy <- ArbTxDecisionPolicy -> [ArbTxDecisionPolicy]
forall a. Arbitrary a => a -> [a]
shrink (TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy TxDecisionPolicy
decisionPolicy)
                          ]
    where
      shrinkMap1 :: (Ord k, Arbitrary k, Arbitrary v) => Map k v -> [Map k v]
      shrinkMap1 :: forall k v.
(Ord k, Arbitrary k, Arbitrary v) =>
Map k v -> [Map k v]
shrinkMap1 Map k v
m
        | Map k v -> Int
forall k a. Map k a -> Int
Map.size Map k v
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = [Map k v
m]
        | Bool
otherwise       = [k -> Map k v -> Map k v
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
k Map k v
m | k
k <- Map k v -> [k]
forall k a. Map k a -> [k]
Map.keys Map k v
m] [Map k v] -> [Map k v] -> [Map k v]
forall a. [a] -> [a] -> [a]
++ [Map k v]
singletonMaps
        where
          singletonMaps :: [Map k v]
singletonMaps = [k -> v -> Map k v
forall k a. k -> a -> Map k a
Map.singleton k
k v
v | (k
k, v
v) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m]


newtype TxStateTrace peeraddr txid =
    TxStateTrace (SharedTxState peeraddr txid (Tx txid))
type TxStateTraceType = TxStateTrace PeerAddr TxId


runTxSubmission
  :: forall m peeraddr txid.
     ( MonadAsync m
     , MonadDelay m
     , MonadEvaluate m
     , MonadFork  m
     , MonadMask  m
     , MonadMVar  m
     , MonadSay   m
     , MonadST    m
     , MonadLabelledSTM m
     , MonadTime  m
     , MonadTimer m
     , MonadThrow m
     , MonadThrow (STM m)
     , MonadMonotonicTime m
     , MonadTraceSTM m
     , Ord txid
     , Eq  txid
     , ShowProxy txid
     , NoThunks (Tx txid)
     , Typeable txid
     , Show peeraddr
     , Ord peeraddr
     , Hashable peeraddr
     , Typeable peeraddr

     , txid ~ Int
     )
  => Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
  -> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
  -> Map peeraddr ( [Tx txid]
                  , ControlMessageSTM m
                  , Maybe DiffTime
                  , Maybe DiffTime
                  )
  -> TxDecisionPolicy
  -> m ([Tx txid], [[Tx txid]])
  -- ^ inbound and outbound mempools
runTxSubmission :: forall (m :: * -> *) peeraddr txid.
(MonadAsync m, MonadDelay m, MonadEvaluate m, MonadFork m,
 MonadMask m, MonadMVar m, MonadSay m, MonadST m,
 MonadLabelledSTM m, MonadTime m, MonadTimer m, MonadThrow m,
 MonadThrow (STM m), MonadMonotonicTime m, MonadTraceSTM m,
 Ord txid, Eq txid, ShowProxy txid, NoThunks (Tx txid),
 Typeable txid, Show peeraddr, Ord peeraddr, Hashable peeraddr,
 Typeable peeraddr, txid ~ Int) =>
Tracer m ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
-> Map
     peeraddr
     ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> TxDecisionPolicy
-> m ([Tx txid], [[Tx txid]])
runTxSubmission Tracer m ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid)))
tracer Tracer m (TraceTxLogic peeraddr txid (Tx txid))
tracerTxLogic Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0 TxDecisionPolicy
txDecisionPolicy = do
    st <- (([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
 -> m (Mempool m txid (Tx txid), ControlMessageSTM m,
       Maybe DiffTime, Maybe DiffTime, Channel m ByteString,
       Channel m ByteString))
-> Map
     peeraddr
     ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> m (Map
        peeraddr
        (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
         Maybe DiffTime, Channel m ByteString, Channel m ByteString))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map peeraddr a -> f (Map peeraddr b)
traverse (\([Tx txid]
b, ControlMessageSTM m
c, Maybe DiffTime
d, Maybe DiffTime
e) -> do
        mempool <- [Tx txid] -> m (Mempool m txid (Tx txid))
forall (m :: * -> *) txid.
(MonadSTM m, Ord txid) =>
[Tx txid] -> m (Mempool m txid (Tx txid))
newMempool [Tx txid]
b
        (outChannel, inChannel) <- createConnectedChannels
        return (mempool, c, d, e, outChannel, inChannel)
        ) Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0
    inboundMempool <- emptyMempool
    let txRng = Int -> StdGen
mkStdGen Int
42 -- TODO
        txMap = [(txid, Tx txid)] -> Map txid (Tx txid)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Tx txid -> txid
forall txid. Tx txid -> txid
getTxId Tx txid
tx, Tx txid
tx)
                             | ([Tx txid]
txs, ControlMessageSTM m
_, Maybe DiffTime
_, Maybe DiffTime
_) <- Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> [([Tx txid], ControlMessageSTM m, Maybe DiffTime,
     Maybe DiffTime)]
forall k a. Map k a -> [a]
Map.elems Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0
                             , Tx txid
tx <- [Tx txid]
txs]


    txChannelsVar <- newMVar (TxChannels Map.empty)
    txMempoolSem <- newTxMempoolSem
    duplicateTxIdsVar <- Lazy.newTVarIO []
    sharedTxStateVar <- newSharedTxStateVar txRng
    traceTVarIO sharedTxStateVar \Maybe (SharedTxState peeraddr txid (Tx txid))
_ -> TraceValue -> InspectMonadSTM m TraceValue
forall a. a -> InspectMonadSTM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (TraceValue -> InspectMonadSTM m TraceValue)
-> (SharedTxState peeraddr txid (Tx txid) -> TraceValue)
-> SharedTxState peeraddr txid (Tx txid)
-> InspectMonadSTM m TraceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxStateTrace peeraddr txid -> TraceValue
forall tr. Typeable tr => tr -> TraceValue
TraceDynamic (TxStateTrace peeraddr txid -> TraceValue)
-> (SharedTxState peeraddr txid (Tx txid)
    -> TxStateTrace peeraddr txid)
-> SharedTxState peeraddr txid (Tx txid)
-> TraceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedTxState peeraddr txid (Tx txid) -> TxStateTrace peeraddr txid
forall peeraddr txid.
SharedTxState peeraddr txid (Tx txid) -> TxStateTrace peeraddr txid
TxStateTrace
    labelTVarIO sharedTxStateVar "shared-tx-state"

    withAsync (decisionLogicThreads tracerTxLogic sayTracer
                                    txDecisionPolicy txChannelsVar sharedTxStateVar) $ \Async m Void
a -> do
          -- Construct txSubmission outbound client
      let clients :: [m ((), Maybe ByteString)]
clients = (\(peeraddr
addr, (Mempool m txid (Tx txid)
mempool {- txs -}, ControlMessageSTM m
ctrlMsgSTM, Maybe DiffTime
outDelay, Maybe DiffTime
_, Channel m ByteString
outChannel, Channel m ByteString
_)) -> do
                      let client :: TxSubmissionClient txid (Tx txid) m ()
client = Tracer m (TraceTxSubmissionOutbound txid (Tx txid))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
-> TestVersion
-> ControlMessageSTM m
-> TxSubmissionClient txid (Tx txid) m ()
forall version txid tx idx (m :: * -> *).
(Ord txid, Ord idx, MonadSTM m, MonadThrow m) =>
Tracer m (TraceTxSubmissionOutbound txid tx)
-> NumTxIdsToAck
-> TxSubmissionMempoolReader txid tx idx m
-> version
-> ControlMessageSTM m
-> TxSubmissionClient txid tx m ()
txSubmissionOutbound
                                     ((TraceTxSubmissionOutbound txid (Tx txid) -> m ())
-> Tracer m (TraceTxSubmissionOutbound txid (Tx txid))
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer ((TraceTxSubmissionOutbound txid (Tx txid) -> m ())
 -> Tracer m (TraceTxSubmissionOutbound txid (Tx txid)))
-> (TraceTxSubmissionOutbound txid (Tx txid) -> m ())
-> Tracer m (TraceTxSubmissionOutbound txid (Tx txid))
forall a b. (a -> b) -> a -> b
$ [Char] -> m ()
forall (m :: * -> *). MonadSay m => [Char] -> m ()
say ([Char] -> m ())
-> (TraceTxSubmissionOutbound txid (Tx txid) -> [Char])
-> TraceTxSubmissionOutbound txid (Tx txid)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceTxSubmissionOutbound txid (Tx txid) -> [Char]
forall a. Show a => a -> [Char]
show)
                                     (Word16 -> NumTxIdsToAck
NumTxIdsToAck (Word16 -> NumTxIdsToAck) -> Word16 -> NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$ NumTxIdsToReq -> Word16
getNumTxIdsToReq
                                       (NumTxIdsToReq -> Word16) -> NumTxIdsToReq -> Word16
forall a b. (a -> b) -> a -> b
$ TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds TxDecisionPolicy
txDecisionPolicy)
                                     (Mempool m txid (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
forall txid (m :: * -> *).
(MonadSTM m, Ord txid, Show txid) =>
Mempool m txid (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
getMempoolReader Mempool m txid (Tx txid)
mempool)
                                     (TestVersion
forall a. Bounded a => a
maxBound :: TestVersion)
                                     ControlMessageSTM m
ctrlMsgSTM
                      Tracer m (TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Codec
     (TxSubmission2 txid (Tx txid)) DeserialiseFailure m ByteString
-> ProtocolSizeLimits (TxSubmission2 txid (Tx txid)) ByteString
-> ProtocolTimeLimits (TxSubmission2 txid (Tx txid))
-> Channel m ByteString
-> Peer
     (TxSubmission2 txid (Tx txid)) 'AsClient 'NonPipelined 'StInit m ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadThrow (STM m), MonadTimer m, ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> Peer ps pr 'NonPipelined st m a
-> m (a, Maybe bytes)
runPeerWithLimits (([Char]
"OUTBOUND " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ peeraddr -> [Char]
forall a. Show a => a -> [Char]
show peeraddr
addr,) (TraceSendRecv (TxSubmission2 txid (Tx txid))
 -> ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid))))
-> Tracer m ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Tracer m (TraceSendRecv (TxSubmission2 txid (Tx txid)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid)))
tracer)
                                        Codec
  (TxSubmission2 txid (Tx txid)) DeserialiseFailure m ByteString
Codec (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
txSubmissionCodec2
                                        ((ByteString -> Word)
-> ProtocolSizeLimits (TxSubmission2 txid (Tx txid)) ByteString
forall bytes txid tx.
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length))
                                        ProtocolTimeLimits (TxSubmission2 txid (Tx txid))
forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
                                        ((Channel m ByteString -> Channel m ByteString)
-> (DiffTime -> Channel m ByteString -> Channel m ByteString)
-> Maybe DiffTime
-> Channel m ByteString
-> Channel m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Channel m ByteString -> Channel m ByteString
forall a. a -> a
id DiffTime -> Channel m ByteString -> Channel m ByteString
forall (m :: * -> *) a.
MonadDelay m =>
DiffTime -> Channel m a -> Channel m a
delayChannel Maybe DiffTime
outDelay Channel m ByteString
outChannel)
                                        (TxSubmissionClient txid (Tx txid) m ()
-> Peer
     (TxSubmission2 txid (Tx txid)) 'AsClient 'NonPipelined 'StInit m ()
forall txid tx (m :: * -> *) a.
Monad m =>
TxSubmissionClient txid tx m a
-> Client (TxSubmission2 txid tx) 'NonPipelined 'StInit m a
txSubmissionClientPeer TxSubmissionClient txid (Tx txid) m ()
client)
                    )
                   ((peeraddr,
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString))
 -> m ((), Maybe ByteString))
-> [(peeraddr,
     (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
      Maybe DiffTime, Channel m ByteString, Channel m ByteString))]
-> [m ((), Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  peeraddr
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
-> [(peeraddr,
     (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
      Maybe DiffTime, Channel m ByteString, Channel m ByteString))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map
  peeraddr
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
st

          -- Construct txSubmission inbound server
          servers :: [m ((), Maybe ByteString)]
servers = (\(peeraddr
addr, (Mempool m txid (Tx txid)
_, ControlMessageSTM m
_, Maybe DiffTime
_, Maybe DiffTime
inDelay, Channel m ByteString
_, Channel m ByteString
inChannel)) ->
                       Tracer m (TraceTxLogic peeraddr txid (Tx txid))
-> StrictMVar m (TxChannels m peeraddr txid (Tx txid))
-> TxMempoolSem m
-> TxDecisionPolicy
-> SharedTxStateVar m peeraddr txid (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
-> (Tx txid -> SizeInBytes)
-> peeraddr
-> (PeerTxAPI m txid (Tx txid) -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall tx peeraddr txid idx (m :: * -> *) err a.
(MonadMask m, MonadMVar m, MonadSTM m, MonadMonotonicTime m,
 Ord txid, Show txid, Typeable txid, Ord peeraddr, Show peeraddr) =>
Tracer m (TraceTxLogic peeraddr txid tx)
-> TxChannelsVar m peeraddr txid tx
-> TxMempoolSem m
-> TxDecisionPolicy
-> SharedTxStateVar m peeraddr txid tx
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolWriter txid tx idx m err
-> (tx -> SizeInBytes)
-> peeraddr
-> (PeerTxAPI m txid tx -> m a)
-> m a
withPeer Tracer m (TraceTxLogic peeraddr txid (Tx txid))
tracerTxLogic
                                StrictMVar m (TxChannels m peeraddr txid (Tx txid))
txChannelsVar
                                TxMempoolSem m
txMempoolSem
                                TxDecisionPolicy
txDecisionPolicy
                                SharedTxStateVar m peeraddr txid (Tx txid)
sharedTxStateVar
                                (Mempool m txid (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
forall txid (m :: * -> *).
(MonadSTM m, Ord txid, Show txid) =>
Mempool m txid (Tx txid)
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
getMempoolReader Mempool m txid (Tx txid)
inboundMempool)
                                (TVar m [txid]
-> Mempool m txid (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
forall txid (m :: * -> *).
(MonadSTM m, MonadTime m, MonadThrow m, Ord txid, Eq txid,
 Typeable txid, Show txid) =>
TVar m [txid]
-> Mempool m txid (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
getMempoolWriter TVar m [txid]
TVar m [Int]
duplicateTxIdsVar Mempool m txid (Tx txid)
inboundMempool)
                                Tx txid -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize
                                peeraddr
addr ((PeerTxAPI m txid (Tx txid) -> m ((), Maybe ByteString))
 -> m ((), Maybe ByteString))
-> (PeerTxAPI m txid (Tx txid) -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \PeerTxAPI m txid (Tx txid)
api -> do
                                  let server :: TxSubmissionServerPipelined txid (Tx txid) m ()
server =
                                        Tracer m (TraceTxSubmissionInbound txid (Tx txid))
-> TxSubmissionInitDelay
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
-> PeerTxAPI m txid (Tx txid)
-> TxSubmissionServerPipelined txid (Tx txid) m ()
forall txid tx idx (m :: * -> *) err.
(MonadDelay m, MonadThrow m, Ord txid) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> TxSubmissionInitDelay
-> TxSubmissionMempoolWriter txid tx idx m err
-> PeerTxAPI m txid tx
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInboundV2 Tracer m (TraceTxSubmissionInbound txid (Tx txid))
forall a (m :: * -> *). (Show a, MonadSay m) => Tracer m a
sayTracer --verboseTracer
                                                              TxSubmissionInitDelay
NoTxSubmissionInitDelay
                                                              (TVar m [txid]
-> Mempool m txid (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
forall txid (m :: * -> *).
(MonadSTM m, MonadTime m, MonadThrow m, Ord txid, Eq txid,
 Typeable txid, Show txid) =>
TVar m [txid]
-> Mempool m txid (Tx txid)
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
getMempoolWriter TVar m [txid]
TVar m [Int]
duplicateTxIdsVar
                                                                                Mempool m txid (Tx txid)
inboundMempool)
                                                              PeerTxAPI m txid (Tx txid)
api
                                  Tracer m (TraceSendRecv (TxSubmission2 Int (Tx Int)))
-> Codec
     (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
-> ProtocolSizeLimits (TxSubmission2 Int (Tx Int)) ByteString
-> ProtocolTimeLimits (TxSubmission2 Int (Tx Int))
-> Channel m ByteString
-> PeerPipelined
     (TxSubmission2 Int (Tx Int)) 'AsServer 'StInit m ()
-> m ((), Maybe ByteString)
forall ps (st :: ps) (pr :: PeerRole) failure bytes (m :: * -> *)
       a.
(MonadAsync m, MonadEvaluate m, MonadFork m, MonadMask m,
 MonadTimer m, MonadThrow (STM m), ShowProxy ps,
 forall (st' :: ps) stok. (stok ~ StateToken st') => Show stok,
 NFData a, NFData failure, Show failure) =>
Tracer m (TraceSendRecv ps)
-> Codec ps failure m bytes
-> ProtocolSizeLimits ps bytes
-> ProtocolTimeLimits ps
-> Channel m bytes
-> PeerPipelined ps pr st m a
-> m (a, Maybe bytes)
runPipelinedPeerWithLimits

                                    (([Char]
"INBOUND " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ peeraddr -> [Char]
forall a. Show a => a -> [Char]
show peeraddr
addr,) (TraceSendRecv (TxSubmission2 Int (Tx Int))
 -> ([Char], TraceSendRecv (TxSubmission2 Int (Tx Int))))
-> Tracer m ([Char], TraceSendRecv (TxSubmission2 Int (Tx Int)))
-> Tracer m (TraceSendRecv (TxSubmission2 Int (Tx Int)))
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m ([Char], TraceSendRecv (TxSubmission2 Int (Tx Int)))
forall a (m :: * -> *). (Show a, MonadSay m) => Tracer m a
sayTracer)
                                    Codec (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
forall (m :: * -> *).
MonadST m =>
Codec (TxSubmission2 Int (Tx Int)) DeserialiseFailure m ByteString
txSubmissionCodec2
                                    ((ByteString -> Word)
-> ProtocolSizeLimits (TxSubmission2 Int (Tx Int)) ByteString
forall bytes txid tx.
(bytes -> Word) -> ProtocolSizeLimits (TxSubmission2 txid tx) bytes
byteLimitsTxSubmission2 (Int64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word) -> (ByteString -> Int64) -> ByteString -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length))
                                    ProtocolTimeLimits (TxSubmission2 Int (Tx Int))
forall txid tx. ProtocolTimeLimits (TxSubmission2 txid tx)
timeLimitsTxSubmission2
                                    ((Channel m ByteString -> Channel m ByteString)
-> (DiffTime -> Channel m ByteString -> Channel m ByteString)
-> Maybe DiffTime
-> Channel m ByteString
-> Channel m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Channel m ByteString -> Channel m ByteString
forall a. a -> a
id DiffTime -> Channel m ByteString -> Channel m ByteString
forall (m :: * -> *) a.
MonadDelay m =>
DiffTime -> Channel m a -> Channel m a
delayChannel Maybe DiffTime
inDelay Channel m ByteString
inChannel)
                                    (TxSubmissionServerPipelined Int (Tx Int) m ()
-> PeerPipelined
     (TxSubmission2 Int (Tx Int)) 'AsServer 'StInit m ()
forall txid tx (m :: * -> *) a.
Functor m =>
TxSubmissionServerPipelined txid tx m a
-> ServerPipelined (TxSubmission2 txid tx) 'StInit m a
txSubmissionServerPeerPipelined TxSubmissionServerPipelined txid (Tx txid) m ()
TxSubmissionServerPipelined Int (Tx Int) m ()
server)
                    ) ((peeraddr,
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString))
 -> m ((), Maybe ByteString))
-> [(peeraddr,
     (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
      Maybe DiffTime, Channel m ByteString, Channel m ByteString))]
-> [m ((), Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  peeraddr
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
-> [(peeraddr,
     (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
      Maybe DiffTime, Channel m ByteString, Channel m ByteString))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map
  peeraddr
  (Mempool m txid (Tx txid), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
st

      -- Run clients and servers
      [(m ((), Maybe ByteString), m ((), Maybe ByteString))]
-> ([(Async m ((), Maybe ByteString),
      Async m ((), Maybe ByteString))]
    -> m ([Tx txid], [[Tx txid]]))
-> m ([Tx txid], [[Tx txid]])
forall a b.
MonadAsync m =>
[(m a, m a)] -> ([(Async m a, Async m a)] -> m b) -> m b
withAsyncAll ([m ((), Maybe ByteString)]
-> [m ((), Maybe ByteString)]
-> [(m ((), Maybe ByteString), m ((), Maybe ByteString))]
forall a b. [a] -> [b] -> [(a, b)]
zip [m ((), Maybe ByteString)]
clients [m ((), Maybe ByteString)]
servers) (([(Async m ((), Maybe ByteString),
    Async m ((), Maybe ByteString))]
  -> m ([Tx txid], [[Tx txid]]))
 -> m ([Tx txid], [[Tx txid]]))
-> ([(Async m ((), Maybe ByteString),
      Async m ((), Maybe ByteString))]
    -> m ([Tx txid], [[Tx txid]]))
-> m ([Tx txid], [[Tx txid]])
forall a b. (a -> b) -> a -> b
$ \[(Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))]
as -> do
        _ <- [(Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))]
-> m [Either SomeException ((), Maybe ByteString)]
forall x. [(Async m x, Async m x)] -> m [Either SomeException x]
waitAllServers [(Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))]
as
        -- cancel decision logic thread
        cancel a

        inmp <- readMempool inboundMempool
        dupTxIds <- Lazy.readTVarIO duplicateTxIdsVar
        let outmp = (([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
 -> [Tx txid])
-> [([Tx txid], ControlMessageSTM m, Maybe DiffTime,
     Maybe DiffTime)]
-> [[Tx txid]]
forall a b. (a -> b) -> [a] -> [b]
map (\([Tx txid]
txs, ControlMessageSTM m
_, Maybe DiffTime
_, Maybe DiffTime
_) -> [Tx txid]
txs)
                  ([([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)]
 -> [[Tx txid]])
-> [([Tx txid], ControlMessageSTM m, Maybe DiffTime,
     Maybe DiffTime)]
-> [[Tx txid]]
forall a b. (a -> b) -> a -> b
$ Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> [([Tx txid], ControlMessageSTM m, Maybe DiffTime,
     Maybe DiffTime)]
forall k a. Map k a -> [a]
Map.elems Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0
            dupTxs = [ Map txid (Tx txid)
txMap Map txid (Tx txid) -> txid -> Tx txid
forall k a. Ord k => Map k a -> k -> a
Map.! txid
txid | txid
txid <- [txid]
dupTxIds]

        return (inmp <> dupTxs, outmp)
  where
    waitAllServers :: [(Async m x, Async m x)] -> m [Either SomeException x]
    waitAllServers :: forall x. [(Async m x, Async m x)] -> m [Either SomeException x]
waitAllServers [] = [Either SomeException x] -> m [Either SomeException x]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    waitAllServers ((Async m x
client, Async m x
server):[(Async m x, Async m x)]
as) = do
      r <- Async m x -> m (Either SomeException x)
forall a. Async m a -> m (Either SomeException a)
forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Either SomeException a)
waitCatch Async m x
server
      -- cancel client as soon as the server exits
      cancel client
      rs <- waitAllServers as
      return (r : rs)

    withAsyncAll :: MonadAsync m
                 => [(m a, m a)]
                 -> ([(Async m a, Async m a)] -> m b)
                 -> m b
    withAsyncAll :: forall a b.
MonadAsync m =>
[(m a, m a)] -> ([(Async m a, Async m a)] -> m b) -> m b
withAsyncAll [(m a, m a)]
xs0 [(Async m a, Async m a)] -> m b
action = [(Async m a, Async m a)] -> [(m a, m a)] -> m b
go [] [(m a, m a)]
xs0
      where
        go :: [(Async m a, Async m a)] -> [(m a, m a)] -> m b
go [(Async m a, Async m a)]
as []         = [(Async m a, Async m a)] -> m b
action ([(Async m a, Async m a)] -> [(Async m a, Async m a)]
forall a. [a] -> [a]
reverse [(Async m a, Async m a)]
as)
        go [(Async m a, Async m a)]
as ((m a
x,m a
y):[(m a, m a)]
xs) = m a -> (Async m a -> m b) -> m b
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m a
x (\Async m a
a -> m a -> (Async m a -> m b) -> m b
forall a b. m a -> (Async m a -> m b) -> m b
forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m a
y (\Async m a
b -> [(Async m a, Async m a)] -> [(m a, m a)] -> m b
go ((Async m a
a, Async m a
b)(Async m a, Async m a)
-> [(Async m a, Async m a)] -> [(Async m a, Async m a)]
forall a. a -> [a] -> [a]
:[(Async m a, Async m a)]
as) [(m a, m a)]
xs))


txSubmissionSimulation :: forall s . TxSubmissionState
                       -> IOSim s ([Tx Int], [[Tx Int]])
                       -- ^ inbound & outbound mempools
txSubmissionSimulation :: forall s. TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
txSubmissionSimulation (TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state TxDecisionPolicy
txDecisionPolicy) = do
  state' <- (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> IOSim
      s
      ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
       Maybe DiffTime))
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
-> IOSim
     s
     (Map
        Int
        ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
         Maybe DiffTime))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map Int a -> f (Map Int b)
traverse (\([Tx Int]
txs, Maybe (Positive SmallDelay)
mbOutDelay, Maybe (Positive SmallDelay)
mbInDelay) -> do
                      let mbOutDelayTime :: Maybe DiffTime
mbOutDelayTime = SmallDelay -> DiffTime
getSmallDelay (SmallDelay -> DiffTime)
-> (Positive SmallDelay -> SmallDelay)
-> Positive SmallDelay
-> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive SmallDelay -> SmallDelay
forall a. Positive a -> a
getPositive (Positive SmallDelay -> DiffTime)
-> Maybe (Positive SmallDelay) -> Maybe DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Positive SmallDelay)
mbOutDelay
                          mbInDelayTime :: Maybe DiffTime
mbInDelayTime  = SmallDelay -> DiffTime
getSmallDelay (SmallDelay -> DiffTime)
-> (Positive SmallDelay -> SmallDelay)
-> Positive SmallDelay
-> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive SmallDelay -> SmallDelay
forall a. Positive a -> a
getPositive (Positive SmallDelay -> DiffTime)
-> Maybe (Positive SmallDelay) -> Maybe DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Positive SmallDelay)
mbInDelay
                      controlMessageVar <- ControlMessage -> IOSim s (StrictTVar (IOSim s) ControlMessage)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO ControlMessage
Continue
                      return ( txs
                             , controlMessageVar
                             , mbOutDelayTime
                             , mbInDelayTime
                             )
                    )
                    Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state

  state'' <- traverse (\([Tx Int]
txs, StrictTVar (IOSim s) ControlMessage
var, Maybe DiffTime
mbOutDelay, Maybe DiffTime
mbInDelay) -> do
                       ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
-> IOSim
     s ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
forall a. a -> IOSim s a
forall (m :: * -> *) a. Monad m => a -> m a
return ( [Tx Int]
txs
                              , StrictTVar (IOSim s) ControlMessage -> STM (IOSim s) ControlMessage
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) ControlMessage
var
                              , Maybe DiffTime
mbOutDelay
                              , Maybe DiffTime
mbInDelay
                              )
                    )
                    state'

  let simDelayTime = (DiffTime
 -> ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
 -> DiffTime)
-> DiffTime
-> Map
     Int
     ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
-> DiffTime
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' (\DiffTime
m ([Tx Int]
txs, STM s ControlMessage
_, Maybe DiffTime
mbInDelay, Maybe DiffTime
mbOutDelay) ->
                                  DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
m ( DiffTime -> Maybe DiffTime -> DiffTime
forall a. a -> Maybe a -> a
fromMaybe DiffTime
1 (DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max (DiffTime -> DiffTime -> DiffTime)
-> Maybe DiffTime -> Maybe (DiffTime -> DiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe DiffTime
mbInDelay Maybe (DiffTime -> DiffTime) -> Maybe DiffTime -> Maybe DiffTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe DiffTime
mbOutDelay)
                                        DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* Int -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac ([Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
txs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
                                        )
                                )
                                DiffTime
0
                                Map
  Int
  ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
state''
      controlMessageVars = (\([Tx Int]
_, StrictTVar (IOSim s) ControlMessage
x, Maybe DiffTime
_, Maybe DiffTime
_) -> StrictTVar (IOSim s) ControlMessage
x)
                        (([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
  Maybe DiffTime)
 -> StrictTVar (IOSim s) ControlMessage)
-> [([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
     Maybe DiffTime)]
-> [StrictTVar (IOSim s) ControlMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  Int
  ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
   Maybe DiffTime)
-> [([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
     Maybe DiffTime)]
forall k a. Map k a -> [a]
Map.elems Map
  Int
  ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
   Maybe DiffTime)
state'

  withAsync
    (do threadDelay (simDelayTime + 1000)
        atomically (traverse_ (`writeTVar` Terminate) controlMessageVars)
    ) \Async (IOSim s) ()
_ -> do
      let tracer :: forall a. (Show a, Typeable a) => Tracer (IOSim s) a
          tracer :: forall a. (Show a, Typeable a) => Tracer (IOSim s) a
tracer = Tracer (IOSim s) a
forall a s. Typeable a => Tracer (IOSim s) a
dynamicTracer Tracer (IOSim s) a -> Tracer (IOSim s) a -> Tracer (IOSim s) a
forall a. Semigroup a => a -> a -> a
<> Tracer (IOSim s) a
forall a (m :: * -> *). (Show a, MonadSay m) => Tracer m a
sayTracer -- <> verboseTracer <> debugTracer
      Tracer
  (IOSim s) ([Char], TraceSendRecv (TxSubmission2 Int (Tx Int)))
-> Tracer (IOSim s) (TraceTxLogic Int Int (Tx Int))
-> Map
     Int
     ([Tx Int], STM (IOSim s) ControlMessage, Maybe DiffTime,
      Maybe DiffTime)
-> TxDecisionPolicy
-> IOSim s ([Tx Int], [[Tx Int]])
forall (m :: * -> *) peeraddr txid.
(MonadAsync m, MonadDelay m, MonadEvaluate m, MonadFork m,
 MonadMask m, MonadMVar m, MonadSay m, MonadST m,
 MonadLabelledSTM m, MonadTime m, MonadTimer m, MonadThrow m,
 MonadThrow (STM m), MonadMonotonicTime m, MonadTraceSTM m,
 Ord txid, Eq txid, ShowProxy txid, NoThunks (Tx txid),
 Typeable txid, Show peeraddr, Ord peeraddr, Hashable peeraddr,
 Typeable peeraddr, txid ~ Int) =>
Tracer m ([Char], TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
-> Map
     peeraddr
     ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> TxDecisionPolicy
-> m ([Tx txid], [[Tx txid]])
runTxSubmission Tracer
  (IOSim s) ([Char], TraceSendRecv (TxSubmission2 Int (Tx Int)))
forall a. (Show a, Typeable a) => Tracer (IOSim s) a
tracer Tracer (IOSim s) (TraceTxLogic Int Int (Tx Int))
forall a. (Show a, Typeable a) => Tracer (IOSim s) a
tracer Map
  Int
  ([Tx Int], STM (IOSim s) ControlMessage, Maybe DiffTime,
   Maybe DiffTime)
Map
  Int
  ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
state'' TxDecisionPolicy
txDecisionPolicy

filterValidTxs :: [Tx txid] -> [Tx txid]
filterValidTxs :: forall txid. [Tx txid] -> [Tx txid]
filterValidTxs
  = (Tx txid -> Bool) -> [Tx txid] -> [Tx txid]
forall a. (a -> Bool) -> [a] -> [a]
filter Tx txid -> Bool
forall txid. Tx txid -> Bool
getTxValid
  ([Tx txid] -> [Tx txid])
-> ([Tx txid] -> [Tx txid]) -> [Tx txid] -> [Tx txid]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tx txid -> Bool) -> [Tx txid] -> [Tx txid]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Tx{SizeInBytes
getTxSize :: forall txid. Tx txid -> SizeInBytes
getTxSize :: SizeInBytes
getTxSize, SizeInBytes
getTxAdvSize :: SizeInBytes
getTxAdvSize :: forall txid. Tx txid -> SizeInBytes
getTxAdvSize} -> SizeInBytes
getTxSize SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
== SizeInBytes
getTxAdvSize)

-- | Tests overall tx submission semantics. The properties checked in this
-- property test are the same as for tx submission v1. We need this to know we
-- didn't regress.
--
prop_txSubmission :: TxSubmissionState -> Property
prop_txSubmission :: TxSubmissionState -> Property
prop_txSubmission st :: TxSubmissionState
st@(TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peers TxDecisionPolicy
_) =
    let tr :: SimTrace ([Tx Int], [[Tx Int]])
tr = (forall s. IOSim s ([Tx Int], [[Tx Int]]))
-> SimTrace ([Tx Int], [[Tx Int]])
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
forall s. TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
txSubmissionSimulation TxSubmissionState
st)
        numPeersWithWronglySizedTx :: Int
        numPeersWithWronglySizedTx :: Int
numPeersWithWronglySizedTx =
          (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Int -> Int)
-> Int
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
-> Int
forall a b. (a -> b -> b) -> b -> Map Int a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (\([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) Int
r ->
              case (Tx Int -> Bool) -> [Tx Int] -> Maybe (Tx Int)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Tx Int
tx -> Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx Int
tx SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx Int
tx) [Tx Int]
txs of
                Just {} -> Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                Maybe (Tx Int)
Nothing -> Int
r
            ) Int
0 Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peers
    in
        [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"number of peers: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
renderRanges Int
3 (Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peers))
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"number of txs: "
              [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
              Int -> Int -> [Char]
renderRanges Int
10
                ( Set Int -> Int
forall a. Set a -> Int
Set.size
                (Set Int -> Int)
-> ([([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))]
    -> Set Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Set Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Set Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int)
-> (([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))
    -> [Int])
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
-> Set Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) -> Tx Int -> Int
forall txid. Tx txid -> txid
getTxId (Tx Int -> Int) -> [Tx Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx Int]
txs))
                ([([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))]
 -> Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Int
forall a b. (a -> b) -> a -> b
$ Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
forall k a. Map k a -> [a]
Map.elems Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peers
                ))
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"number of peers with wrongly sized tx: "
             [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
numPeersWithWronglySizedTx)
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ case Bool
-> SimTrace ([Tx Int], [[Tx Int]])
-> Either Failure ([Tx Int], [[Tx Int]])
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]])
tr of
         Left Failure
e ->
             [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Failure -> [Char]
forall a. Show a => a -> [Char]
show Failure
e)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]]) -> [Char]
forall a. Show a => SimTrace a -> [Char]
ppTrace SimTrace ([Tx Int], [[Tx Int]])
tr)
           (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
         Right ([Tx Int]
inmp, [[Tx Int]]
outmps) ->
             [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]]) -> [Char]
forall a. Show a => SimTrace a -> [Char]
ppTrace SimTrace ([Tx Int], [[Tx Int]])
tr)
           (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Tx Int] -> [Tx Int] -> Property
validate [Tx Int]
inmp ([Tx Int] -> Property) -> [[Tx Int]] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
`map` [[Tx Int]]
outmps)
  where
    checkMempools :: [Tx Int] -> [Tx Int] -> Bool
    checkMempools :: [Tx Int] -> [Tx Int] -> Bool
checkMempools [Tx Int]
consumer [Tx Int]
producer =
      let producer' :: Set Int
producer' = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ Tx Int -> Int
forall txid. Tx txid -> txid
getTxId (Tx Int -> Int) -> [Tx Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx Int]
producer
          consumer' :: Set Int
consumer' = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ Tx Int -> Int
forall txid. Tx txid -> txid
getTxId (Tx Int -> Int) -> [Tx Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx Int]
consumer
      in Set Int
producer' Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Int
consumer'

    validate :: [Tx Int] -- the inbound mempool
             -> [Tx Int] -- one of the outbound mempools
             -> Property
    validate :: [Tx Int] -> [Tx Int] -> Property
validate [Tx Int]
inmp [Tx Int]
outmp =
       let outUniqueTxIds :: [Tx Int]
outUniqueTxIds = (Tx Int -> Tx Int -> Bool) -> [Tx Int] -> [Tx Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ((Int -> Int -> Bool) -> (Tx Int -> Int) -> Tx Int -> Tx Int -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) Tx Int -> Int
forall txid. Tx txid -> txid
getTxId) [Tx Int]
outmp
           outValidTxs :: [Tx Int]
outValidTxs    = [Tx Int] -> [Tx Int]
forall txid. [Tx txid] -> [Tx txid]
filterValidTxs [Tx Int]
outmp
       in
       case ( [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outUniqueTxIds Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outmp
            , [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outValidTxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outmp
            ) of
         x :: (Bool, Bool)
x@(Bool
True, Bool
True) ->
           -- If we are presented with a stream of unique txids for valid
           -- transactions the inbound transactions should match the outbound
           -- transactions exactly.
             [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((Bool, Bool) -> [Char]
forall a. Show a => a -> [Char]
show (Bool, Bool)
x)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
inmp)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
outmp)
           (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Bool
checkMempools [Tx Int]
inmp [Tx Int]
outValidTxs

         x :: (Bool, Bool)
x@(Bool
True, Bool
False) | Maybe (Tx Int)
Nothing <- (Tx Int -> Bool) -> [Tx Int] -> Maybe (Tx Int)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Tx Int
tx -> Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx Int
tx SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx Int
tx) [Tx Int]
outmp  ->
           -- If we are presented with a stream of unique txids then we should have
           -- fetched all valid transactions if all txs have valid sizes.
             [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((Bool, Bool) -> [Char]
forall a. Show a => a -> [Char]
show (Bool, Bool)
x)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
inmp)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
outValidTxs)

           (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Bool
checkMempools [Tx Int]
inmp [Tx Int]
outValidTxs
                         | Bool
otherwise ->
             -- If there's one tx with an invalid size, we will download only
             -- some of them, but we don't guarantee how many we will download.
             --
             -- This is ok, the peer is cheating.
             Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True


         x :: (Bool, Bool)
x@(Bool
False, Bool
True) ->
           -- If we are presented with a stream of valid txids then we should have
           -- fetched some version of those transactions.
             [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ((Bool, Bool) -> [Char]
forall a. Show a => a -> [Char]
show (Bool, Bool)
x)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
inmp)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Tx Int] -> [Char]
forall a. Show a => a -> [Char]
show [Tx Int]
outmp)
           (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Bool
checkMempools [Tx Int]
inmp
                           ([Tx Int] -> [Tx Int]
forall txid. [Tx txid] -> [Tx txid]
filterValidTxs [Tx Int]
outUniqueTxIds)

         (Bool
False, Bool
False) ->
           -- If we are presented with a stream of valid and invalid Txs with
           -- duplicate txids we're content with completing the protocol
           -- without error.
           Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True


-- | This test checks that all txs are downloaded from all available peers if
-- available.
--
-- TODO: have we generated enough outbound mempools which interact in interesting
-- ways?
prop_txSubmission_inflight :: TxSubmissionState -> Property
prop_txSubmission_inflight :: TxSubmissionState -> Property
prop_txSubmission_inflight st :: TxSubmissionState
st@(TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state TxDecisionPolicy
policy) =
  let maxRepeatedValidTxs :: Map Int Int
maxRepeatedValidTxs = (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Map Int Int -> Map Int Int)
-> Map Int Int
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
-> Map Int Int
forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr (\([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) Map Int Int
r -> (Tx Int -> Map Int Int -> Map Int Int)
-> Map Int Int -> [Tx Int] -> Map Int Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tx Int -> Map Int Int -> Map Int Int
fn Map Int Int
r [Tx Int]
txs)
                                      Map Int Int
forall k a. Map k a
Map.empty
                                      Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state
      hasInvalidSize :: Bool
hasInvalidSize =
          Maybe
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Bool
forall a. Maybe a -> Bool
isJust
        (Maybe
   ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
 -> Bool)
-> Maybe
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
-> Bool
forall a b. (a -> b) -> a -> b
$ (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Bool)
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
-> Maybe
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) ->
                    Maybe (Tx Int) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Tx Int) -> Bool) -> Maybe (Tx Int) -> Bool
forall a b. (a -> b) -> a -> b
$ (Tx Int -> Bool) -> [Tx Int] -> Maybe (Tx Int)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (\Tx Int
tx -> Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx Int
tx SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx Int -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx Int
tx) [Tx Int]
txs
                  )
                  Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state
      trace :: SimTrace ([Tx Int], [[Tx Int]])
trace = (forall s. IOSim s ([Tx Int], [[Tx Int]]))
-> SimTrace ([Tx Int], [[Tx Int]])
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
forall s. TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
txSubmissionSimulation TxSubmissionState
st)
      pTrace :: [Char]
pTrace = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, [Char]) -> [Char]) -> [(Time, [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Time DiffTime
t, [Char]
ev) -> DiffTime -> [Char]
forall a. Show a => a -> [Char]
show DiffTime
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ev) ([(Time, [Char])] -> [[Char]]) -> [(Time, [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
        SimTrace ([Tx Int], [[Tx Int]]) -> [(Time, [Char])]
forall a. Trace a SimEvent -> [(Time, [Char])]
selectTraceEventsSayWithTime' SimTrace ([Tx Int], [[Tx Int]])
trace
  in case Bool
-> SimTrace ([Tx Int], [[Tx Int]])
-> Either Failure ([Tx Int], [[Tx Int]])
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]])
trace of
       Left Failure
err -> [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
pTrace --(ppTrace trace)
                 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Failure -> [Char]
forall a. Show a => a -> [Char]
show Failure
err)
                 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
       Right ([Tx Int]
inmp, [[Tx Int]]
_) ->
         let resultRepeatedValidTxs :: Map Int Int
resultRepeatedValidTxs =
               (Tx Int -> Map Int Int -> Map Int Int)
-> Map Int Int -> [Tx Int] -> Map Int Int
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Tx Int -> Map Int Int -> Map Int Int
fn Map Int Int
forall k a. Map k a
Map.empty [Tx Int]
inmp
         in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label (if Bool
hasInvalidSize then [Char]
"has wrongly sized tx" else [Char]
"has no wrongly sized tx")
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
pTrace --(ppTrace trace)
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"hasInvalidSize: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char]
forall a. Show a => a -> [Char]
show Bool
hasInvalidSize)
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"Result valid [(txid, repeated)]:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map Int Int -> [Char]
forall a. Show a => a -> [Char]
show Map Int Int
resultRepeatedValidTxs)
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"Testcase max valid [(txid, repeated)]:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map Int Int -> [Char]
forall a. Show a => a -> [Char]
show Map Int Int
maxRepeatedValidTxs)
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin ([Bool] -> Property)
-> (Map Int Bool -> [Bool]) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Int Bool -> [Bool]
forall k a. Map k a -> [a]
Map.elems (Map Int Bool -> Property) -> Map Int Bool -> Property
forall a b. (a -> b) -> a -> b
$ if Bool
hasInvalidSize
              then SimpleWhenMissing Int Int Bool
-> SimpleWhenMissing Int Int Bool
-> SimpleWhenMatched Int Int Int Bool
-> Map Int Int
-> Map Int Int
-> Map Int Bool
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge ((Int -> Int -> Bool) -> SimpleWhenMissing Int Int Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Int
_txid Int
_left  -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
                         ((Int -> Int -> Bool) -> SimpleWhenMissing Int Int Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Int
_txid Int
_right -> Bool
True)
                         ((Int -> Int -> Int -> Bool) -> SimpleWhenMatched Int Int Int Bool
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched \Int
_txid Int
left Int
right ->
                             Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
right Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` TxDecisionPolicy -> Int
txInflightMultiplicity TxDecisionPolicy
policy)
                         Map Int Int
resultRepeatedValidTxs
                         Map Int Int
maxRepeatedValidTxs
              else SimpleWhenMissing Int Int Bool
-> SimpleWhenMissing Int Int Bool
-> SimpleWhenMatched Int Int Int Bool
-> Map Int Int
-> Map Int Int
-> Map Int Bool
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
merge ((Int -> Int -> Bool) -> SimpleWhenMissing Int Int Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Int
_txid Int
_left  -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible")
                         ((Int -> Int -> Bool) -> SimpleWhenMissing Int Int Bool
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
mapMissing \Int
_txid Int
_right -> Bool
False)
                         ((Int -> Int -> Int -> Bool) -> SimpleWhenMatched Int Int Int Bool
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
zipWithMatched \Int
_txid Int
left Int
right ->
                             Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
right Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` TxDecisionPolicy -> Int
txInflightMultiplicity TxDecisionPolicy
policy)
                         Map Int Int
resultRepeatedValidTxs
                         Map Int Int
maxRepeatedValidTxs
  where
    -- we work with txid's because a repeated tx may have different advertised/actual
    -- byte size by different peers in this test, but otherwise multiplicity
    -- should be determined by txid.
    fn :: Tx TxId -> Map TxId Int -> Map TxId Int
    fn :: Tx Int -> Map Int Int -> Map Int Int
fn Tx Int
tx Map Int Int
r' -- | getTxAdvSize tx /= getTxSize tx
             -- = empty
             -- ^ that is too severe
             | Tx Int -> Bool
forall txid. Tx txid -> Bool
getTxValid Tx Int
tx
             = (Maybe Int -> Maybe Int) -> Int -> Map Int Int -> Map Int Int
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Maybe Int -> Int) -> Maybe Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 Int -> Int
forall a. Enum a => a -> a
succ) (Tx Int -> Int
forall txid. Tx txid -> txid
getTxId Tx Int
tx) Map Int Int
r'
             | Bool
otherwise
             = Map Int Int
r'


prop_sharedTxStateInvariant :: TxSubmissionState -> Property
prop_sharedTxStateInvariant :: TxSubmissionState -> Property
prop_sharedTxStateInvariant initialState :: TxSubmissionState
initialState@(TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
st0 TxDecisionPolicy
_) =
  let tr :: SimTrace ()
tr = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (() () -> IOSim s ([Tx Int], [[Tx Int]]) -> IOSim s ()
forall a b. a -> IOSim s b -> IOSim s a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
forall s. TxSubmissionState -> IOSim s ([Tx Int], [[Tx Int]])
txSubmissionSimulation TxSubmissionState
initialState)
      pTrace :: [Char]
pTrace = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"\n" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Time, [Char]) -> [Char]) -> [(Time, [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Time DiffTime
t, [Char]
ev) -> DiffTime -> [Char]
forall a. Show a => a -> [Char]
show DiffTime
t [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
ev) ([(Time, [Char])] -> [[Char]]) -> [(Time, [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
        SimTrace () -> [(Time, [Char])]
forall a. Trace a SimEvent -> [(Time, [Char])]
selectTraceEventsSayWithTime' SimTrace ()
tr
  in case Bool -> SimTrace () -> Either Failure ()
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ()
tr of
    Left Failure
err -> [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
pTrace --(ppTrace tr)
              (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Bool -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (Failure -> [Char]
forall a. Show a => a -> [Char]
show Failure
err)
              (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
    Right ()
_ ->
      let lookBack, tr' :: [TxStateTraceType]
          lookBack :: [TxStateTraceType]
lookBack = Trace (SimResult ()) TxStateTraceType -> [TxStateTraceType]
forall a b. Trace a b -> [b]
Trace.toList (Trace (SimResult ()) TxStateTraceType -> [TxStateTraceType])
-> Trace (SimResult ()) TxStateTraceType -> [TxStateTraceType]
forall a b. (a -> b) -> a -> b
$ SimTrace () -> Trace (SimResult ()) TxStateTraceType
forall a b. Typeable b => Trace a SimEvent -> Trace a b
traceSelectTraceEventsDynamic SimTrace ()
tr
          tr' :: [TxStateTraceType]
tr' = Int -> [TxStateTraceType] -> [TxStateTraceType]
forall a. Int -> [a] -> [a]
drop Int
1 [TxStateTraceType]
lookBack
      in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
pTrace case
           ((TxStateTraceType, TxStateTraceType) -> (Every, Sum Int))
-> [(TxStateTraceType, TxStateTraceType)] -> (Every, Sum Int)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\case
                        (TxStateTrace SharedTxState Int Int (Tx Int)
stBack, TxStateTrace SharedTxState Int Int (Tx Int)
st)->
                          (Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> (Property -> Property) -> Property -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample (SharedTxState Int Int (Tx Int) -> [Char]
forall a. Show a => a -> [Char]
show SharedTxState Int Int (Tx Int)
st) (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$
                                  InvariantStrength -> SharedTxState Int Int (Tx Int) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
WeakInvariant SharedTxState Int Int (Tx Int)
st
                             Property -> Bool -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. let inflight :: Set Int
inflight = Map Int Int -> Set Int
forall k a. Map k a -> Set k
Map.keysSet (Map Int Int -> Set Int) -> Map Int Int -> Set Int
forall a b. (a -> b) -> a -> b
$ SharedTxState Int Int (Tx Int) -> Map Int Int
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid Int
inflightTxs SharedTxState Int Int (Tx Int)
st
                                      buffered :: Set Int
buffered = Map Int (Maybe (Tx Int)) -> Set Int
forall k a. Map k a -> Set k
Map.keysSet (Map Int (Maybe (Tx Int)) -> Set Int)
-> Map Int (Maybe (Tx Int)) -> Set Int
forall a b. (a -> b) -> a -> b
$ SharedTxState Int Int (Tx Int) -> Map Int (Maybe (Tx Int))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs SharedTxState Int Int (Tx Int)
st
                                      inflightBack :: Set Int
inflightBack = Map Int Int -> Set Int
forall k a. Map k a -> Set k
Map.keysSet (Map Int Int -> Set Int) -> Map Int Int -> Set Int
forall a b. (a -> b) -> a -> b
$ SharedTxState Int Int (Tx Int) -> Map Int Int
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid Int
inflightTxs SharedTxState Int Int (Tx Int)
stBack
                                  in
                                    -- here we account for a very slow peer from whom we requested
                                    -- a transaction, but it didn't arrive until we have also requested
                                    -- it from another peer, received it, and placed it into the mempool,
                                    -- and so it ended up in bufferedTxs when the first one is still
                                    -- in flight. It is an error when the opposite happens.
                                    Set Int -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set Int -> Bool) -> Set Int -> Bool
forall a b. (a -> b) -> a -> b
$ (Set Int
inflight Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set Int
inflightBack) Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set Int
buffered
                          , Int -> Sum Int
forall a. a -> Sum a
Sum Int
1
                          )
                   )
                   ([TxStateTraceType]
-> [TxStateTraceType] -> [(TxStateTraceType, TxStateTraceType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxStateTraceType]
lookBack [TxStateTraceType]
tr')
           of (Every
p, Sum Int
c) ->
                 [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"number of txs: "
                         [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
                         Int -> Int -> [Char]
renderRanges Int
10
                           ( Set Int -> Int
forall a. Set a -> Int
Set.size
                           (Set Int -> Int)
-> ([([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))]
    -> Set Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Set Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Set Int
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList ([Int] -> Set Int)
-> (([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))
    -> [Int])
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
-> Set Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) -> Tx Int -> Int
forall txid. Tx txid -> txid
getTxId (Tx Int -> Int) -> [Tx Int] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx Int]
txs))
                           ([([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))]
 -> Int)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Int
forall a b. (a -> b) -> a -> b
$ Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
forall k a. Map k a -> [a]
Map.elems Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
st0
                           ))
               (Property -> Property) -> (Every -> Property) -> Every -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Every -> Property
forall prop. Testable prop => [Char] -> prop -> Property
label ([Char]
"number of evaluated states: "
                         [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
renderRanges Int
100 Int
c)
               (Every -> Property) -> Every -> Property
forall a b. (a -> b) -> a -> b
$ Every
p


--
-- Utils
--

-- | Split a list into sub list of at most `n` elements.
--
divvy :: Int -> [a] -> [[a]]
divvy :: forall a. Int -> [a] -> [[a]]
divvy Int
_ [] = []
divvy Int
n [a]
as = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
as [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
divvy Int
n (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
n [a]
as)