{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# 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.MonadSTM qualified as Lazy
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad (void)
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, mkTracer, nullTracer)

import Data.ByteString.Lazy qualified as BSL
import Data.Foldable (traverse_)
import Data.Function (on)
import Data.IntMap.Strict qualified as IntMap
import Data.IntSet qualified as IntSet
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 Data.Word (Word64)

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.Tx (HasRawTxId)
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.Impaired (Impairment (..),
           applyImpairment, genOneImpairment, kindOf, noImpairment,
           shrinkImpairment, validImpairment)
import Test.Ouroboros.Network.TxSubmission.TxLogic hiding (tests)
import Test.Ouroboros.Network.TxSubmission.Types
import Test.Ouroboros.Network.Utils hiding (debugTracer)

import Test.Cardano.Base.QuickCheck qualified as BaseQC
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.HUnit (Assertion, assertBool, assertEqual, testCase)
import Test.Tasty.QuickCheck (testProperty)


tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"AppV2"
  [ String -> [TestTree] -> TestTree
testGroup String
"Generators"
      [ String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionState/validGen"
          TxSubmissionState -> Property
prop_TxSubmissionState_validGen
      , String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionState/shrinkValid"
          TxSubmissionState -> Property
prop_TxSubmissionState_shrinkValid
      , String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionState/shrinkSmaller"
          TxSubmissionState -> Property
prop_TxSubmissionState_shrinkSmaller
      , String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionState/shrinkNoDups"
          TxSubmissionState -> Property
prop_TxSubmissionState_shrinkNoDups
      , String -> (TxSubmissionImpairmentState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionImpairmentState/validGen"
          TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_validGen
      , String -> (TxSubmissionImpairmentState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionImpairmentState/shrinkValid"
          TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkValid
      , String -> (TxSubmissionImpairmentState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionImpairmentState/shrinkSmaller"
          TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkSmaller
      , String -> (TxSubmissionImpairmentState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionImpairmentState/shrinkNoDups"
          TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkNoDups
      , String -> (TxSubmissionDisconnectState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionDisconnectState/validGen"
          TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_validGen
      , String -> (TxSubmissionDisconnectState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionDisconnectState/shrinkValid"
          TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkValid
      , String -> (TxSubmissionDisconnectState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionDisconnectState/shrinkSmaller"
          TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkSmaller
      , String -> (TxSubmissionDisconnectState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"TxSubmissionDisconnectState/shrinkNoDups"
          TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkNoDups
      ]
  , String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"txSubmission"          TxSubmissionState -> Property
prop_txSubmission
  , String -> (TxSubmissionState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"inflight"              TxSubmissionState -> Property
prop_txSubmission_inflight
  , String -> (TxSubmissionImpairmentState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"resilientToImpairment" TxSubmissionImpairmentState -> Property
prop_txSubmission_resilientToImpairment
  , String -> (TxSubmissionDisconnectState -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"peerDisconnect"        TxSubmissionDisconnectState -> Property
prop_txSubmission_peerDisconnect
  , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"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
BaseQC.withNumTests Int
25
                                 TxSubmissionState -> Property
prop_sharedTxStateInvariant
  , String -> Assertion -> TestTree
testCase     String
"counterEmission/cadence"      Assertion
unit_counterEmission_cadence
  , String -> Assertion -> TestTree
testCase     String
"score/wellBehavedStaysAtZero" Assertion
unit_score_wellBehavedStaysAtZero
  , String -> Assertion -> TestTree
testCase     String
"score/persistentBadStaysHigh" Assertion
unit_score_persistentBadStaysHigh
  , String -> Assertion -> TestTree
testCase     String
"score/recoversAfterBurst"     Assertion
unit_score_recoversAfterBurst
  ]

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 -> String
(Int -> TestVersion -> ShowS)
-> (TestVersion -> String)
-> ([TestVersion] -> ShowS)
-> Show TestVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestVersion -> ShowS
showsPrec :: Int -> TestVersion -> ShowS
$cshow :: TestVersion -> String
show :: TestVersion -> String
$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 -> Map Int Impairment
peerImpairment :: Map Int Impairment
    , TxSubmissionState -> TxDecisionPolicy
decisionPolicy :: TxDecisionPolicy
  } deriving (TxSubmissionState -> TxSubmissionState -> Bool
(TxSubmissionState -> TxSubmissionState -> Bool)
-> (TxSubmissionState -> TxSubmissionState -> Bool)
-> Eq TxSubmissionState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionState -> TxSubmissionState -> Bool
== :: TxSubmissionState -> TxSubmissionState -> Bool
$c/= :: TxSubmissionState -> TxSubmissionState -> Bool
/= :: TxSubmissionState -> TxSubmissionState -> Bool
Eq, Int -> TxSubmissionState -> ShowS
[TxSubmissionState] -> ShowS
TxSubmissionState -> String
(Int -> TxSubmissionState -> ShowS)
-> (TxSubmissionState -> String)
-> ([TxSubmissionState] -> ShowS)
-> Show TxSubmissionState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionState -> ShowS
showsPrec :: Int -> TxSubmissionState -> ShowS
$cshow :: TxSubmissionState -> String
show :: TxSubmissionState -> String
$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),
                                peerImpairment = Map.empty,
                                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, Map Int Impairment
peerImpairment :: TxSubmissionState -> Map Int Impairment
peerImpairment :: Map Int Impairment
peerImpairment, TxDecisionPolicy
decisionPolicy :: TxSubmissionState -> TxDecisionPolicy
decisionPolicy :: TxDecisionPolicy
decisionPolicy } =
       [ Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Map Int Impairment -> TxDecisionPolicy -> TxSubmissionState
TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap' Map Int Impairment
peerImpairment TxDecisionPolicy
decisionPolicy
       | Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap' <- Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> [Map
      Int
      ([Tx Int], Maybe (Positive SmallDelay),
       Maybe (Positive SmallDelay))]
forall v k.
(Eq 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
       ]
    [TxSubmissionState] -> [TxSubmissionState] -> [TxSubmissionState]
forall a. [a] -> [a] -> [a]
++ [ Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Map Int Impairment -> TxDecisionPolicy -> TxSubmissionState
TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap Map Int Impairment
peerImpairment TxDecisionPolicy
policy
       | ArbTxDecisionPolicy TxDecisionPolicy
policy <- ArbTxDecisionPolicy -> [ArbTxDecisionPolicy]
forall a. Arbitrary a => a -> [a]
shrink (TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy TxDecisionPolicy
decisionPolicy)
       ]
    where
      shrinkMap1 :: (Eq v, Ord k, Arbitrary k, Arbitrary v) => Map k v -> [Map k v]
      shrinkMap1 :: forall v k.
(Eq 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 = []
        | Bool
otherwise       =
            [Map k v] -> [Map k v]
forall a. Eq a => [a] -> [a]
List.nub ([Map k v] -> [Map k v]) -> [Map k v] -> [Map k v]
forall a b. (a -> b) -> a -> b
$ [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)
type TxStateTraceType = TxStateTrace PeerAddr TxId

-- | Per-peer inbound trace event, tagging each 'TraceTxSubmissionInbound'
-- value with the peer it was emitted for.  Tests extract these from the
-- simulation trace via 'traceSelectTraceEventsDynamic' to observe per-peer
-- score evolution (carried in 'TraceTxSubmissionProcessed') and other
-- inbound protocol events.
data PeerInboundTrace peeraddr txid tx =
    PeerInboundTrace peeraddr (TraceTxSubmissionInbound txid tx)
  deriving Int -> PeerInboundTrace peeraddr txid tx -> ShowS
[PeerInboundTrace peeraddr txid tx] -> ShowS
PeerInboundTrace peeraddr txid tx -> String
(Int -> PeerInboundTrace peeraddr txid tx -> ShowS)
-> (PeerInboundTrace peeraddr txid tx -> String)
-> ([PeerInboundTrace peeraddr txid tx] -> ShowS)
-> Show (PeerInboundTrace peeraddr txid tx)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
Int -> PeerInboundTrace peeraddr txid tx -> ShowS
forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
[PeerInboundTrace peeraddr txid tx] -> ShowS
forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
PeerInboundTrace peeraddr txid tx -> String
$cshowsPrec :: forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
Int -> PeerInboundTrace peeraddr txid tx -> ShowS
showsPrec :: Int -> PeerInboundTrace peeraddr txid tx -> ShowS
$cshow :: forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
PeerInboundTrace peeraddr txid tx -> String
show :: PeerInboundTrace peeraddr txid tx -> String
$cshowList :: forall peeraddr txid tx.
(Show peeraddr, Show txid) =>
[PeerInboundTrace peeraddr txid tx] -> ShowS
showList :: [PeerInboundTrace peeraddr txid tx] -> ShowS
Show

type PeerInboundTraceType = PeerInboundTrace PeerAddr TxId (Tx TxId)


runTxSubmission
  :: forall m peeraddr txid.
     ( MonadAsync m
     , MonadDelay m
     , MonadEvaluate m
     , MonadFork  m
     , MonadMask  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
     , Typeable peeraddr

     , txid ~ Int
     )
  => Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
  -> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
  -> Tracer m TxSubmissionCounters
  -> Tracer m (PeerInboundTrace peeraddr txid (Tx txid))
  -> Map peeraddr ( [Tx txid]
                  , ControlMessageSTM m
                  , Maybe DiffTime
                  , Maybe DiffTime
                  )
  -> Map peeraddr Impairment
  -> Map peeraddr DiffTime
     -- ^ cancel the server async for each listed peer at the given
     --   time, simulating an abrupt disconnect mid-protocol
  -> TxDecisionPolicy
  -> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid)
  -- ^ inbound mempool, outbound mempools, final shared state
runTxSubmission :: forall (m :: * -> *) peeraddr txid.
(MonadAsync m, MonadDelay m, MonadEvaluate m, MonadFork m,
 MonadMask 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, Typeable peeraddr, txid ~ Int) =>
Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
-> Tracer m TxSubmissionCounters
-> Tracer m (PeerInboundTrace peeraddr txid (Tx txid))
-> Map
     peeraddr
     ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> Map peeraddr Impairment
-> Map peeraddr DiffTime
-> TxDecisionPolicy
-> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid)
runTxSubmission Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
tracer Tracer m (TraceTxLogic peeraddr txid (Tx txid))
tracerTxLogic Tracer m TxSubmissionCounters
countersTracer Tracer m (PeerInboundTrace peeraddr txid (Tx txid))
inboundTracer Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0
                Map peeraddr Impairment
peerImpairmentMap Map peeraddr DiffTime
cancelSchedule 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 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]

    duplicateTxIdsVar <- Lazy.newTVarIO []
    sharedTxStateVar <- newSharedTxStateVar emptySharedTxState
    inFlightRegistry <- newPeerTxRegistry
    txCountersVar <- newTxSubmissionCountersVar mempty
    traceTVarIO sharedTxStateVar \Maybe (SharedTxState peeraddr 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 -> TraceValue)
-> SharedTxState peeraddr 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 -> TxStateTrace peeraddr txid)
-> SharedTxState peeraddr txid
-> TraceValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedTxState peeraddr txid -> TxStateTrace peeraddr txid
forall peeraddr txid.
SharedTxState peeraddr txid -> TxStateTrace peeraddr txid
TxStateTrace
    labelTVarIO sharedTxStateVar "shared-tx-state"

    let clients = (\(peeraddr
addr, (Mempool m Int (Tx Int)
mempool {- txs -}, ControlMessageSTM m
ctrlMsgSTM, Maybe DiffTime
outDelay, Maybe DiffTime
_, Channel m ByteString
outChannel, Channel m ByteString
_)) -> do
                    let baseClient :: TxSubmissionClient Int (Tx Int) m ()
baseClient = Tracer m (TraceTxSubmissionOutbound Int (Tx Int))
-> NumTxIdsToAck
-> TxSubmissionMempoolReader Int (Tx Int) Integer m
-> TestVersion
-> ControlMessageSTM m
-> TxSubmissionClient Int (Tx Int) 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 Int (Tx Int) -> m ())
-> Tracer m (TraceTxSubmissionOutbound Int (Tx Int))
forall (m :: * -> *) a. Applicative m => (a -> m ()) -> Tracer m a
mkTracer ((TraceTxSubmissionOutbound Int (Tx Int) -> m ())
 -> Tracer m (TraceTxSubmissionOutbound Int (Tx Int)))
-> (TraceTxSubmissionOutbound Int (Tx Int) -> m ())
-> Tracer m (TraceTxSubmissionOutbound Int (Tx Int))
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadSay m => String -> m ()
say (String -> m ())
-> (TraceTxSubmissionOutbound Int (Tx Int) -> String)
-> TraceTxSubmissionOutbound Int (Tx Int)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceTxSubmissionOutbound Int (Tx Int) -> String
forall a. Show a => a -> String
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 Int (Tx Int)
-> TxSubmissionMempoolReader Int (Tx Int) 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 Int (Tx Int)
mempool)
                                       (TestVersion
forall a. Bounded a => a
maxBound :: TestVersion)
                                       ControlMessageSTM m
ctrlMsgSTM
                        imp :: Impairment
imp        = Impairment -> peeraddr -> Map peeraddr Impairment -> Impairment
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Impairment
noImpairment peeraddr
addr Map peeraddr Impairment
peerImpairmentMap
                    client <- Impairment
-> ([Int] -> Tx Int -> Tx Int)
-> TxSubmissionClient Int (Tx Int) m ()
-> m (TxSubmissionClient Int (Tx Int) m ())
forall (m :: * -> *) txid tx a.
(MonadDelay m, MonadSTM m) =>
Impairment
-> ([txid] -> tx -> tx)
-> TxSubmissionClient txid tx m a
-> m (TxSubmissionClient txid tx m a)
applyImpairment Impairment
imp [Int] -> Tx Int -> Tx Int
mkUnrequested TxSubmissionClient Int (Tx Int) m ()
baseClient
                    runPeerWithLimits (("OUTBOUND " ++ show addr,) `contramap` tracer)
                                      txSubmissionCodec2
                                      (byteLimitsTxSubmission2 (fromIntegral . BSL.length))
                                      timeLimitsTxSubmission2
                                      (maybe id delayChannel outDelay outChannel)
                                      (txSubmissionClientPeer client)
                  )
                 ((peeraddr,
  (Mempool m Int (Tx Int), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString))
 -> m ((), Maybe ByteString))
-> [(peeraddr,
     (Mempool m Int (Tx Int), 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 Int (Tx Int), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
-> [(peeraddr,
     (Mempool m Int (Tx Int), 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)
Map
  peeraddr
  (Mempool m Int (Tx Int), ControlMessageSTM m, Maybe DiffTime,
   Maybe DiffTime, Channel m ByteString, Channel m ByteString)
st

        servers = (\(peeraddr
addr, (Mempool m txid (Tx txid)
_, ControlMessageSTM m
_, Maybe DiffTime
_, Maybe DiffTime
inDelay, Channel m ByteString
_, Channel m ByteString
inChannel)) ->
                     TxDecisionPolicy
-> TxSubmissionMempoolReader txid (Tx txid) Integer m
-> SharedTxStateVar m peeraddr txid
-> PeerTxRegistry m peeraddr
-> TxSubmissionCountersVar m
-> peeraddr
-> (PeerTxAPI m txid (Tx txid) -> m ((), Maybe ByteString))
-> m ((), Maybe ByteString)
forall peeraddr txid tx idx (m :: * -> *) a.
(MonadMask m, MonadTimer m, Ord peeraddr, Show peeraddr, Ord txid,
 HasRawTxId txid) =>
TxDecisionPolicy
-> TxSubmissionMempoolReader txid tx idx m
-> SharedTxStateVar m peeraddr txid
-> PeerTxRegistry m peeraddr
-> TxSubmissionCountersVar m
-> peeraddr
-> (PeerTxAPI m txid tx -> m a)
-> m a
withPeer 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)
inboundMempool)
                              SharedTxStateVar m peeraddr txid
sharedTxStateVar
                              PeerTxRegistry m peeraddr
inFlightRegistry
                              TxSubmissionCountersVar m
txCountersVar
                              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
-> TxDecisionPolicy
-> TxSubmissionMempoolWriter txid (Tx txid) Integer m InvalidTx
-> (Tx txid -> SizeInBytes)
-> PeerTxAPI m txid (Tx txid)
-> TxSubmissionServerPipelined txid (Tx txid) m ()
forall txid tx idx (m :: * -> *) err.
(MonadDelay m, MonadTimer m, MonadThrow m, Ord txid, Show txid,
 Typeable txid) =>
Tracer m (TraceTxSubmissionInbound txid tx)
-> TxSubmissionInitDelay
-> TxDecisionPolicy
-> TxSubmissionMempoolWriter txid tx idx m err
-> (tx -> SizeInBytes)
-> PeerTxAPI m txid tx
-> TxSubmissionServerPipelined txid tx m ()
txSubmissionInboundV2
                                        (peeraddr
-> TraceTxSubmissionInbound txid (Tx txid)
-> PeerInboundTrace peeraddr txid (Tx txid)
forall peeraddr txid tx.
peeraddr
-> TraceTxSubmissionInbound txid tx
-> PeerInboundTrace peeraddr txid tx
PeerInboundTrace peeraddr
addr (TraceTxSubmissionInbound txid (Tx txid)
 -> PeerInboundTrace peeraddr txid (Tx txid))
-> Tracer m (PeerInboundTrace peeraddr txid (Tx txid))
-> Tracer m (TraceTxSubmissionInbound 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 (PeerInboundTrace peeraddr txid (Tx txid))
inboundTracer)
                                        TxSubmissionInitDelay
NoTxSubmissionInitDelay
                                        TxDecisionPolicy
txDecisionPolicy
                                        (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
                                        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
                                  ((String
"INBOUND " String -> ShowS
forall a. [a] -> [a] -> [a]
++ peeraddr -> String
forall a. Show a => a -> String
show peeraddr
addr,) (TraceSendRecv (TxSubmission2 Int (Tx Int))
 -> (String, TraceSendRecv (TxSubmission2 Int (Tx Int))))
-> Tracer m (String, 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 (String, 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

    withAsync (txCountersThreadV2 txDecisionPolicy countersTracer tracerTxLogic
                                  txCountersVar sharedTxStateVar inFlightRegistry)
              \Async m Void
countersAid ->
      [(m ((), Maybe ByteString), m ((), Maybe ByteString))]
-> ([(Async m ((), Maybe ByteString),
      Async m ((), Maybe ByteString))]
    -> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid))
-> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr 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]], SharedTxState peeraddr txid))
 -> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid))
-> ([(Async m ((), Maybe ByteString),
      Async m ((), Maybe ByteString))]
    -> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid))
-> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid)
forall a b. (a -> b) -> a -> b
$ \[(Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))]
as -> do
        let serverAsyncs :: Map peeraddr (Async m ((), Maybe ByteString))
serverAsyncs = [(peeraddr, Async m ((), Maybe ByteString))]
-> Map peeraddr (Async m ((), Maybe ByteString))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                         ([(peeraddr, Async m ((), Maybe ByteString))]
 -> Map peeraddr (Async m ((), Maybe ByteString)))
-> [(peeraddr, Async m ((), Maybe ByteString))]
-> Map peeraddr (Async m ((), Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ [peeraddr]
-> [Async m ((), Maybe ByteString)]
-> [(peeraddr, Async m ((), Maybe ByteString))]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map
  peeraddr
  ([Tx Int], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> [peeraddr]
forall k a. Map k a -> [k]
Map.keys Map
  peeraddr
  ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
Map
  peeraddr
  ([Tx Int], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
st0) ((Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))
-> Async m ((), Maybe ByteString)
forall a b. (a, b) -> b
snd ((Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))
 -> Async m ((), Maybe ByteString))
-> [(Async m ((), Maybe ByteString),
     Async m ((), Maybe ByteString))]
-> [Async m ((), Maybe ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Async m ((), Maybe ByteString), Async m ((), Maybe ByteString))]
as)
        cancelAids <- ((peeraddr, DiffTime) -> m (Async m ()))
-> [(peeraddr, DiffTime)] -> m [Async m ()]
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) -> [a] -> f [b]
traverse
                        (\(peeraddr
addr, DiffTime
t) -> m () -> m (Async m ())
forall a. m a -> m (Async m a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m () -> m (Async m ())) -> m () -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ do
                           DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
t
                           (Async m ((), Maybe ByteString) -> m ())
-> Maybe (Async m ((), Maybe ByteString)) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async m ((), Maybe ByteString) -> m ()
forall a. Async m a -> m ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel (peeraddr
-> Map peeraddr (Async m ((), Maybe ByteString))
-> Maybe (Async m ((), Maybe ByteString))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peeraddr
addr Map peeraddr (Async m ((), Maybe ByteString))
serverAsyncs))
                        (Map peeraddr DiffTime -> [(peeraddr, DiffTime)]
forall k a. Map k a -> [(k, a)]
Map.toList Map peeraddr DiffTime
cancelSchedule)
        _ <- waitAllServers as

        -- All peers have scrubbed their per-peer state via the
        -- 'withPeer' bracket finalizer.  Wait long enough for retained
        -- entries to expire so a sweep tick (still firing inside the
        -- running counters thread) can clear them along with any
        -- orphans and stale lookups.
        threadDelay (bufferedTxsMinLifetime txDecisionPolicy + 1)

        cancel countersAid
        traverse_ cancel cancelAids

        finalSharedState <- readTVarIO sharedTxStateVar
        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, finalSharedState)
  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]], SharedTxState PeerAddr TxId)
                       -- ^ inbound mempool, outbound mempools, final shared state
txSubmissionSimulation :: forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation (TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state Map Int Impairment
peerImpairment 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) (String, TraceSendRecv (TxSubmission2 Int (Tx Int)))
-> Tracer (IOSim s) (TraceTxLogic Int Int (Tx Int))
-> Tracer (IOSim s) TxSubmissionCounters
-> Tracer (IOSim s) PeerInboundTraceType
-> Map
     Int
     ([Tx Int], STM (IOSim s) ControlMessage, Maybe DiffTime,
      Maybe DiffTime)
-> Map Int Impairment
-> Map Int DiffTime
-> TxDecisionPolicy
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall (m :: * -> *) peeraddr txid.
(MonadAsync m, MonadDelay m, MonadEvaluate m, MonadFork m,
 MonadMask 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, Typeable peeraddr, txid ~ Int) =>
Tracer m (String, TraceSendRecv (TxSubmission2 txid (Tx txid)))
-> Tracer m (TraceTxLogic peeraddr txid (Tx txid))
-> Tracer m TxSubmissionCounters
-> Tracer m (PeerInboundTrace peeraddr txid (Tx txid))
-> Map
     peeraddr
     ([Tx txid], ControlMessageSTM m, Maybe DiffTime, Maybe DiffTime)
-> Map peeraddr Impairment
-> Map peeraddr DiffTime
-> TxDecisionPolicy
-> m ([Tx txid], [[Tx txid]], SharedTxState peeraddr txid)
runTxSubmission Tracer
  (IOSim s) (String, 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 Tracer (IOSim s) TxSubmissionCounters
forall a. (Show a, Typeable a) => Tracer (IOSim s) a
tracer Tracer (IOSim s) PeerInboundTraceType
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'' Map Int Impairment
peerImpairment
                      Map Int DiffTime
forall k a. Map k a
Map.empty 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)

-- | Mutator passed to 'applyImpairment' for the @unrequestedTx@ wrapper.
-- Returns a clone of the given body with its txid replaced by 'maxBound',
-- which is well outside the @Arbitrary Int@ range used by the generators
-- and so is guaranteed not to collide with any requested txid.
mkUnrequested :: [Int] -> Tx Int -> Tx Int
mkUnrequested :: [Int] -> Tx Int -> Tx Int
mkUnrequested [Int]
_reqs Tx Int
tx = Tx Int
tx { getTxId = maxBound }

-- | Pretty-print only the say-tracer events of an IOSim trace, prefixed
-- with their simulation time.  The full 'ppTrace' includes scheduling
-- noise (ThreadDelay, Deschedule, TxCommitted, etc.) that obscures the
-- protocol-relevant events; this helper restricts the output to the
-- events that the test infrastructure forwards through 'sayTracer'
-- (protocol messages, counter snapshots, shared-state changes).
ppSayTrace :: SimTrace a -> String
ppSayTrace :: forall a. SimTrace a -> String
ppSayTrace SimTrace a
tr =
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
"\n"
  ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Time, String) -> String) -> [(Time, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Time DiffTime
t, String
ev) -> DiffTime -> String
forall a. Show a => a -> String
show DiffTime
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
ev)
  ([(Time, String)] -> [String]) -> [(Time, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ SimTrace a -> [(Time, String)]
forall a. Trace a SimEvent -> [(Time, String)]
selectTraceEventsSayWithTime' SimTrace a
tr

-- | Documented invariants of a 'TxSubmissionState' produced by the
-- 'Arbitrary' instance.  Used by the generator/shrinker meta-tests.
validTxSubmissionState :: TxSubmissionState -> Bool
validTxSubmissionState :: TxSubmissionState -> Bool
validTxSubmissionState (TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap Map Int Impairment
peerImpairment TxDecisionPolicy
policy) =
     Bool -> Bool
not (Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Bool
forall k a. Map k a -> Bool
Map.null Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap)
  Bool -> Bool -> Bool
&& Map Int Impairment -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int Impairment
peerImpairment Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap
  Bool -> Bool -> Bool
&& (([Tx Int], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> Bool)
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([Tx Int], Maybe (Positive SmallDelay),
 Maybe (Positive SmallDelay))
-> Bool
forall {a} {b} {c}. Ord a => ([Tx a], b, c) -> Bool
validPeer (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))
peerMap)
  Bool -> Bool -> Bool
&& TxDecisionPolicy -> Bool
validPolicy TxDecisionPolicy
policy
  where
    validPeer :: ([Tx a], b, c) -> Bool
validPeer ([Tx a]
txs, b
_, c
_) =
      let txids :: [a]
txids = Tx a -> a
forall txid. Tx txid -> txid
getTxId (Tx a -> a) -> [Tx a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx a]
txs in
         Bool -> Bool
not ([Tx a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tx a]
txs)
      Bool -> Bool -> Bool
&& [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
txids Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Set a -> Int
forall a. Set a -> Int
Set.size ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
txids)

validPolicy :: TxDecisionPolicy -> Bool
validPolicy :: TxDecisionPolicy -> Bool
validPolicy TxDecisionPolicy
            { NumTxIdsToReq
maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest :: TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest, NumTxIdsToReq
maxUnacknowledgedTxIds :: TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds :: NumTxIdsToReq
maxUnacknowledgedTxIds
            , SizeInBytes
txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer :: TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer, Int
maxOutstandingTxBatchesPerPeer :: Int
maxOutstandingTxBatchesPerPeer :: TxDecisionPolicy -> Int
maxOutstandingTxBatchesPerPeer
            , Int
txInflightMultiplicity :: Int
txInflightMultiplicity :: TxDecisionPolicy -> Int
txInflightMultiplicity, DiffTime
bufferedTxsMinLifetime :: TxDecisionPolicy -> DiffTime
bufferedTxsMinLifetime :: DiffTime
bufferedTxsMinLifetime
            , Double
scoreRate :: Double
scoreRate :: TxDecisionPolicy -> Double
scoreRate, Double
scoreMax :: Double
scoreMax :: TxDecisionPolicy -> Double
scoreMax, DiffTime
interTxSpace :: DiffTime
interTxSpace :: TxDecisionPolicy -> DiffTime
interTxSpace, DiffTime
inflightTimeout :: DiffTime
inflightTimeout :: TxDecisionPolicy -> DiffTime
inflightTimeout
            } =
     NumTxIdsToReq -> Word16
getNumTxIdsToReq NumTxIdsToReq
maxNumTxIdsToRequest    Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
1
  Bool -> Bool -> Bool
&& NumTxIdsToReq -> Word16
getNumTxIdsToReq NumTxIdsToReq
maxUnacknowledgedTxIds  Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
1
  Bool -> Bool -> Bool
&& SizeInBytes -> Word32
getSizeInBytes SizeInBytes
txsSizeInflightPerPeer    Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
1
  Bool -> Bool -> Bool
&& Int
maxOutstandingTxBatchesPerPeer           Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
  Bool -> Bool -> Bool
&& Int
txInflightMultiplicity                   Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
  Bool -> Bool -> Bool
&& DiffTime
bufferedTxsMinLifetime                   DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0
  Bool -> Bool -> Bool
&& Double
scoreRate                                Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
  Bool -> Bool -> Bool
&& Double
scoreMax                                 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
  Bool -> Bool -> Bool
&& DiffTime
interTxSpace                             DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0
  Bool -> Bool -> Bool
&& DiffTime
inflightTimeout                          DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>  DiffTime
interTxSpace

prop_TxSubmissionState_validGen :: TxSubmissionState -> Property
prop_TxSubmissionState_validGen :: TxSubmissionState -> Property
prop_TxSubmissionState_validGen TxSubmissionState
st =
    String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionState -> String
forall a. Show a => a -> String
show TxSubmissionState
st)
  (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ TxSubmissionState -> Bool
validTxSubmissionState TxSubmissionState
st

prop_TxSubmissionState_shrinkValid :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkValid :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkValid TxSubmissionState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionState -> String
forall a. Show a => a -> String
show TxSubmissionState
s) (TxSubmissionState -> Bool
validTxSubmissionState TxSubmissionState
s)
  | TxSubmissionState
s <- TxSubmissionState -> [TxSubmissionState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionState
st
  ]

-- | Every shrunk state differs from the input. Catches base cases like
-- 'shrinkMap1 = [m]' that re-emit the original.
prop_TxSubmissionState_shrinkSmaller :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkSmaller :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkSmaller TxSubmissionState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"shrink emitted self: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxSubmissionState -> String
forall a. Show a => a -> String
show TxSubmissionState
s) (TxSubmissionState
s TxSubmissionState -> TxSubmissionState -> Bool
forall a. Eq a => a -> a -> Bool
/= TxSubmissionState
st)
  | TxSubmissionState
s <- TxSubmissionState -> [TxSubmissionState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionState
st
  ]

-- | Shrink output contains no duplicates. Catches 'shrinkMap1' generating
-- the same singleton via different paths and the cross-product producing
-- equivalent candidates.
prop_TxSubmissionState_shrinkNoDups :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkNoDups :: TxSubmissionState -> Property
prop_TxSubmissionState_shrinkNoDups TxSubmissionState
st =
  let shrunk :: [TxSubmissionState]
shrunk = TxSubmissionState -> [TxSubmissionState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionState
st in
      String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"duplicates: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TxSubmissionState] -> String
forall a. Show a => a -> String
show ([TxSubmissionState]
shrunk [TxSubmissionState] -> [TxSubmissionState] -> [TxSubmissionState]
forall a. Eq a => [a] -> [a] -> [a]
List.\\ [TxSubmissionState] -> [TxSubmissionState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionState]
shrunk))
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [TxSubmissionState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxSubmissionState] -> [TxSubmissionState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionState]
shrunk) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [TxSubmissionState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxSubmissionState]
shrunk


-- | Asserts that the 'SharedTxState' has been fully reclaimed after
-- all peers have exited and retained entries have been allowed to
-- expire.  Catches leaks in scrub-on-disconnect, sweep orphan
-- detection, retained-set expiry, and lookup-table cleanup.
prop_sharedStateClean :: (Show peeraddr, Show txid, HasRawTxId txid)
                      => SharedTxState peeraddr txid -> Property
prop_sharedStateClean :: forall peeraddr txid.
(Show peeraddr, Show txid, HasRawTxId txid) =>
SharedTxState peeraddr txid -> Property
prop_sharedStateClean SharedTxState peeraddr txid
st =
    String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"final shared state: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SharedTxState peeraddr txid -> String
forall a. Show a => a -> String
show SharedTxState peeraddr txid
st)
  (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"sharedTxTable not empty" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
          IntMap (TxEntry peeraddr) -> Bool
forall a. IntMap a -> Bool
IntMap.null (SharedTxState peeraddr txid -> IntMap (TxEntry peeraddr)
forall peeraddr txid.
SharedTxState peeraddr txid -> IntMap (TxEntry peeraddr)
sharedTxTable SharedTxState peeraddr txid
st)
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"sharedRetainedTxs not empty" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
          IntSet -> Bool
IntSet.null (RetainedTxs -> IntSet
retainedKeysSet (SharedTxState peeraddr txid -> RetainedTxs
forall peeraddr txid. SharedTxState peeraddr txid -> RetainedTxs
sharedRetainedTxs SharedTxState peeraddr txid
st))
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"sharedTxIdToKey not empty" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
          Map (RawTxId txid) TxKey -> Bool
forall k a. Map k a -> Bool
Map.null (SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey
forall peeraddr txid.
SharedTxState peeraddr txid -> Map (RawTxId txid) TxKey
sharedTxIdToKey SharedTxState peeraddr txid
st)
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"sharedKeyToTxId not empty" (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
          IntMap txid -> Bool
forall a. IntMap a -> Bool
IntMap.null (SharedTxState peeraddr txid -> IntMap txid
forall peeraddr txid. SharedTxState peeraddr txid -> IntMap txid
sharedKeyToTxId SharedTxState peeraddr txid
st)
      ]


-- | Pin the cadence of 'txCountersThreadV2'.  After a single counter
-- bump at thread start, exactly one emission must fire at exactly the
-- first 'countersInterval' deadline.  Beyond that, with no further
-- counter activity, the 'current /= previous' guard must suppress
-- subsequent emissions.  Targets:
--
-- * the 'now >= nextEmitAt' boundary,
-- * the 'when (current /= previous)' guard,
-- * the 'previous' update.
unit_counterEmission_cadence :: Assertion
unit_counterEmission_cadence :: Assertion
unit_counterEmission_cadence =
    let (Time
threadStart, [(Time, TxSubmissionCounters)]
timeline) = (forall s. IOSim s (Time, [(Time, TxSubmissionCounters)]))
-> (Time, [(Time, TxSubmissionCounters)])
forall a. (forall s. IOSim s a) -> a
runSimOrThrow IOSim s (Time, [(Time, TxSubmissionCounters)])
forall s. IOSim s (Time, [(Time, TxSubmissionCounters)])
simulation
        timestamps :: [Time]
timestamps              = ((Time, TxSubmissionCounters) -> Time)
-> [(Time, TxSubmissionCounters)] -> [Time]
forall a b. (a -> b) -> [a] -> [b]
map (Time, TxSubmissionCounters) -> Time
forall a b. (a, b) -> a
fst [(Time, TxSubmissionCounters)]
timeline in
    String -> [Time] -> [Time] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual (String
"timeline: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Time, TxSubmissionCounters)] -> String
forall a. Show a => a -> String
show [(Time, TxSubmissionCounters)]
timeline)
                [DiffTime -> Time -> Time
addTime DiffTime
7 Time
threadStart]
                [Time]
timestamps
  where
    simulation :: forall s. IOSim s (Time, [(Time, TxSubmissionCounters)])
    simulation :: forall s. IOSim s (Time, [(Time, TxSubmissionCounters)])
simulation = do
      sharedTxStateVar <- SharedTxState Int Int
-> IOSim s (SharedTxStateVar (IOSim s) Int Int)
forall (m :: * -> *) peeraddr txid.
MonadSTM m =>
SharedTxState peeraddr txid -> m (SharedTxStateVar m peeraddr txid)
newSharedTxStateVar
                            (SharedTxState Int Int
forall peeraddr txid. SharedTxState peeraddr txid
emptySharedTxState :: SharedTxState Int Int)
      inFlightRegistry <- newPeerTxRegistry
                            :: IOSim s (PeerTxRegistry (IOSim s) Int)
      txCountersVar    <- newTxSubmissionCountersVar mempty
      recorder         <- newTVarIO []

      let policy = TxDecisionPolicy
defaultTxDecisionPolicy
          tracer = (TxSubmissionCounters -> IOSim s ())
-> Tracer (IOSim s) TxSubmissionCounters
forall (m :: * -> *) a. Applicative m => (a -> m ()) -> Tracer m a
mkTracer ((TxSubmissionCounters -> IOSim s ())
 -> Tracer (IOSim s) TxSubmissionCounters)
-> (TxSubmissionCounters -> IOSim s ())
-> Tracer (IOSim s) TxSubmissionCounters
forall a b. (a -> b) -> a -> b
$ \TxSubmissionCounters
counters -> do
                     now <- IOSim s Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                     atomically (modifyTVar recorder ((now, counters):))

      threadStart <- getMonotonicTime
      atomically (modifyTVar txCountersVar
                    (<> mempty { txIdMessagesSent = 1 }))

      withAsync (txCountersThreadV2 policy tracer nullTracer txCountersVar
                                    sharedTxStateVar inFlightRegistry)
                \Async (IOSim s) Void
countersAid -> do
        -- Run past the second emission boundary (threadStart + 14s) so
        -- any spurious second emission shows up in the recorder.
        DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
14.5
        Async (IOSim s) Void -> IOSim s ()
forall a. Async (IOSim s) a -> IOSim s ()
forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async (IOSim s) Void
countersAid

      timeline <- readTVarIO recorder
      pure (threadStart, reverse timeline)


-- | Invariants over the counter snapshots emitted by 'txCountersThreadV2'.
-- Asserts monotonicity of every field, protocol-level causality bounds,
-- decomposition of total txid sends into blocking and pipelined, and body
-- accounting (received bounded by requested, classified bounded by received).
prop_counterInvariants :: SimTrace a -> Property
prop_counterInvariants :: forall a. SimTrace a -> Property
prop_counterInvariants SimTrace a
tr =
    let snapshots :: [TxSubmissionCounters]
        snapshots :: [TxSubmissionCounters]
snapshots = SimTrace a -> [TxSubmissionCounters]
forall a b. Typeable b => SimTrace a -> [b]
selectTraceEventsDynamic SimTrace a
tr in
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"snapshots: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([TxSubmissionCounters] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxSubmissionCounters]
snapshots))
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
          [ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"monotonicity"  ([TxSubmissionCounters] -> Property
checkMonotonic [TxSubmissionCounters]
snapshots)
          , String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"causality"     ([Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin (TxSubmissionCounters -> Property
checkCausality       (TxSubmissionCounters -> Property)
-> [TxSubmissionCounters] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSubmissionCounters]
snapshots))
          , String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"decomposition" ([Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin (TxSubmissionCounters -> Property
checkDecomp          (TxSubmissionCounters -> Property)
-> [TxSubmissionCounters] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSubmissionCounters]
snapshots))
          , String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"body-accounting"
              ([Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin (TxSubmissionCounters -> Property
checkBodyAccounting (TxSubmissionCounters -> Property)
-> [TxSubmissionCounters] -> [Property]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSubmissionCounters]
snapshots))
          ]
  where
    counterFields :: [(String, TxSubmissionCounters -> Word64)]
    counterFields :: [(String, TxSubmissionCounters -> Word64)]
counterFields =
      [ (String
"txIdMessagesSent",      TxSubmissionCounters -> Word64
txIdMessagesSent)
      , (String
"txIdsRequested",        TxSubmissionCounters -> Word64
txIdsRequested)
      , (String
"txIdRepliesReceived",   TxSubmissionCounters -> Word64
txIdRepliesReceived)
      , (String
"txIdsReceived",         TxSubmissionCounters -> Word64
txIdsReceived)
      , (String
"txMessagesSent",        TxSubmissionCounters -> Word64
txMessagesSent)
      , (String
"txsRequested",          TxSubmissionCounters -> Word64
txsRequested)
      , (String
"txRepliesReceived",     TxSubmissionCounters -> Word64
txRepliesReceived)
      , (String
"txsReceived",           TxSubmissionCounters -> Word64
txsReceived)
      , (String
"txsOmitted",            TxSubmissionCounters -> Word64
txsOmitted)
      , (String
"lateBodies",            TxSubmissionCounters -> Word64
lateBodies)
      , (String
"txsAccepted",           TxSubmissionCounters -> Word64
txsAccepted)
      , (String
"txsRejected",           TxSubmissionCounters -> Word64
txsRejected)
      , (String
"txIdBlockingReqsSent",  TxSubmissionCounters -> Word64
txIdBlockingReqsSent)
      , (String
"txIdPipelinedReqsSent", TxSubmissionCounters -> Word64
txIdPipelinedReqsSent)
      , (String
"txIdBlockingWaitMs",    TxSubmissionCounters -> Word64
txIdBlockingWaitMs)
      , (String
"txPipelineWaitMs",      TxSubmissionCounters -> Word64
txPipelineWaitMs)
      , (String
"txSubmissionWaitMs",    TxSubmissionCounters -> Word64
txSubmissionWaitMs)
      ]

    checkMonotonic :: [TxSubmissionCounters] -> Property
checkMonotonic [TxSubmissionCounters]
xs = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (TxSubmissionCounters -> Word64
f TxSubmissionCounters
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" > " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show (TxSubmissionCounters -> Word64
f TxSubmissionCounters
b))
          (TxSubmissionCounters -> Word64
f TxSubmissionCounters
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
f TxSubmissionCounters
b)
      | (String
name, TxSubmissionCounters -> Word64
f) <- [(String, TxSubmissionCounters -> Word64)]
counterFields
      , (TxSubmissionCounters
a, TxSubmissionCounters
b)    <- [TxSubmissionCounters]
-> [TxSubmissionCounters]
-> [(TxSubmissionCounters, TxSubmissionCounters)]
forall a b. [a] -> [b] -> [(a, b)]
zip [TxSubmissionCounters]
xs (Int -> [TxSubmissionCounters] -> [TxSubmissionCounters]
forall a. Int -> [a] -> [a]
drop Int
1 [TxSubmissionCounters]
xs)
      ]

    checkCausality :: TxSubmissionCounters -> Property
checkCausality TxSubmissionCounters
s = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
      [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"txIdRepliesReceived > txIdMessagesSent"
          (TxSubmissionCounters -> Word64
txIdRepliesReceived TxSubmissionCounters
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
txIdMessagesSent TxSubmissionCounters
s)
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"txRepliesReceived > txMessagesSent"
          (TxSubmissionCounters -> Word64
txRepliesReceived TxSubmissionCounters
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
txMessagesSent TxSubmissionCounters
s)
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"txIdsReceived > txIdsRequested"
          (TxSubmissionCounters -> Word64
txIdsReceived TxSubmissionCounters
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
txIdsRequested TxSubmissionCounters
s)
      , String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"txsReceived > txsRequested"
          (TxSubmissionCounters -> Word64
txsReceived TxSubmissionCounters
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
txsRequested TxSubmissionCounters
s)
      ]

    checkDecomp :: TxSubmissionCounters -> Property
checkDecomp TxSubmissionCounters
s =
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"txIdMessagesSent /= blocking + pipelined"
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TxSubmissionCounters -> Word64
txIdMessagesSent TxSubmissionCounters
s
      Word64 -> Word64 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxSubmissionCounters -> Word64
txIdBlockingReqsSent TxSubmissionCounters
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txIdPipelinedReqsSent TxSubmissionCounters
s

    checkBodyAccounting :: TxSubmissionCounters -> Property
checkBodyAccounting TxSubmissionCounters
s =
        String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
          (String
"accepted + rejected + late > received: "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word64, Word64, Word64, Word64) -> String
forall a. Show a => a -> String
show (TxSubmissionCounters -> Word64
txsAccepted TxSubmissionCounters
s, TxSubmissionCounters -> Word64
txsRejected TxSubmissionCounters
s, TxSubmissionCounters -> Word64
lateBodies TxSubmissionCounters
s, TxSubmissionCounters -> Word64
txsReceived TxSubmissionCounters
s))
          (TxSubmissionCounters -> Word64
txsAccepted TxSubmissionCounters
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
txsRejected TxSubmissionCounters
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ TxSubmissionCounters -> Word64
lateBodies TxSubmissionCounters
s Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSubmissionCounters -> Word64
txsReceived TxSubmissionCounters
s)


-- | 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 Map Int Impairment
_ TxDecisionPolicy
_) =
    let tr :: SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr = (forall s. IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int))
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int 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
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"number of peers: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String
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
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"number of txs: "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++
              Int -> Int -> String
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
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"number of peers with wrongly sized tx: "
             String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numPeersWithWronglySizedTx)
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ case Bool
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> Either Failure ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr of
         Left Failure
e ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Failure -> String
forall a. Show a => a -> String
show Failure
e)
           (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr)
           (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
         Right ([Tx Int]
inmp, [[Tx Int]]
outmps, SharedTxState Int Int
finalState) ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int 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)
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> Property
forall a. SimTrace a -> Property
prop_counterInvariants SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SharedTxState Int Int -> Property
forall peeraddr txid.
(Show peeraddr, Show txid, HasRawTxId txid) =>
SharedTxState peeraddr txid -> Property
prop_sharedStateClean SharedTxState Int Int
finalState
  where
    -- | Asserts that every txid produced is present in the consumer set.
    -- On failure the counterexample names the missing txids so the
    -- diagnostic points directly at what's wrong.
    checkMempools :: [Tx Int] -> [Tx Int] -> Property
    checkMempools :: [Tx Int] -> [Tx Int] -> Property
checkMempools [Tx Int]
consumer [Tx Int]
producer =
      let producer' :: Set Int
producer' = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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 (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)
          missing :: Set Int
missing   = Set Int
producer' Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
consumer' in
        String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"missing from inbound mempool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
missing))
      (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Set Int -> Bool
forall a. Set a -> Bool
Set.null Set Int
missing

    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
         String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"inbound mempool: "  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (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]
inmp))
       (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"outbound mempool: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (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]
outmp))
       (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ 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
         (Bool
True, Bool
True) ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
               String
"case (unique-txids, all-valid): every valid tx must reach inbound"
           (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Property
checkMempools [Tx Int]
inmp [Tx Int]
outValidTxs

         (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 ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
               String
"case (unique-txids, has-invalid, sizes-match): every valid tx must reach inbound"
           (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Property
checkMempools [Tx Int]
inmp [Tx Int]
outValidTxs

         (Bool
True, Bool
False) ->
             -- One tx has a wrong advertised size: the peer is cheating, no
             -- guarantee on how much we download.
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
               String
"case (unique-txids, has-invalid, has-size-mismatch): peer cheating, no guarantee"
           (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

         (Bool
False, Bool
True) ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
               String
"case (duplicate-txids, all-valid): some version of every valid txid must reach inbound"
           (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [Tx Int] -> [Tx Int] -> Property
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 Map Int Impairment
_ 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]], SharedTxState Int Int)
trace = (forall s. IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int))
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
st)
      pTrace :: String
pTrace = SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
trace
  in case Bool
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> Either Failure ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
trace of
       Left Failure
err -> String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
pTrace
                 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Failure -> String
forall a. Show a => a -> String
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]]
_, SharedTxState Int Int
finalState) ->
         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 String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (if Bool
hasInvalidSize then String
"has wrongly sized tx" else String
"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
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
pTrace
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"hasInvalidSize: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bool -> String
forall a. Show a => a -> String
show Bool
hasInvalidSize)
          (Property -> Property)
-> (Map Int Bool -> Property) -> Map Int Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Result valid [(txid, repeated)]:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map Int Int -> String
forall a. Show a => a -> String
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
. String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Testcase max valid [(txid, repeated)]:\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Map Int Int -> String
forall a. Show a => a -> String
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
. (\Property
p -> Property
p Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> Property
forall a. SimTrace a -> Property
prop_counterInvariants SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
trace
                     Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SharedTxState Int Int -> Property
forall peeraddr txid.
(Show peeraddr, Show txid, HasRawTxId txid) =>
SharedTxState peeraddr txid -> Property
prop_sharedStateClean SharedTxState Int Int
finalState)
          (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  -> String -> Bool
forall a. HasCallStack => String -> a
error String
"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` Int
inflightLimit)
                         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  -> String -> Bool
forall a. HasCallStack => String -> a
error String
"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` Int
inflightLimit)
                         Map Int Int
resultRepeatedValidTxs
                         Map Int Int
maxRepeatedValidTxs
  where
    -- Loosened from txInflightMultiplicity to account for the per-tx
    -- 'currentMaxInflightMultiplicity' bumps that fire when a peer holds
    -- a lease past 'inflightTimeout'. Each peer can contribute at most one
    -- bump per stuck claim, so 'cap + peers' is a safe static upper bound.
    inflightLimit :: Int
inflightLimit = TxDecisionPolicy -> Int
txInflightMultiplicity TxDecisionPolicy
policy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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))
state

    -- 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'


-- | Resilience to per-peer impairment. With a non-empty subset of peers
-- wrapped in any combination of 'omitBodies' and 'delayBodies', every tx
-- contributed by a well-behaved peer must still reach the inbound mempool.
-- Exercises V2's cross-peer retry path (omission) and stuck-leaseholder
-- bump path (delay).
--
-- Contributions from an impaired peer are not asserted: omitted bodies
-- may never reach the mempool, and severely delayed bodies may not arrive
-- before the simulation terminates.
-- | A 'TxSubmissionState' carrying the additional invariants required by
-- 'prop_txSubmission_resilientToImpairment': at least two peers, with a
-- non-empty proper subset of them assigned an 'Impairment'.
newtype TxSubmissionImpairmentState =
    TxSubmissionImpairmentState
      { TxSubmissionImpairmentState -> TxSubmissionState
unTxSubmissionImpairmentState :: TxSubmissionState }
  deriving (TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
(TxSubmissionImpairmentState
 -> TxSubmissionImpairmentState -> Bool)
-> (TxSubmissionImpairmentState
    -> TxSubmissionImpairmentState -> Bool)
-> Eq TxSubmissionImpairmentState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
== :: TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
$c/= :: TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
/= :: TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
Eq, Int -> TxSubmissionImpairmentState -> ShowS
[TxSubmissionImpairmentState] -> ShowS
TxSubmissionImpairmentState -> String
(Int -> TxSubmissionImpairmentState -> ShowS)
-> (TxSubmissionImpairmentState -> String)
-> ([TxSubmissionImpairmentState] -> ShowS)
-> Show TxSubmissionImpairmentState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionImpairmentState -> ShowS
showsPrec :: Int -> TxSubmissionImpairmentState -> ShowS
$cshow :: TxSubmissionImpairmentState -> String
show :: TxSubmissionImpairmentState -> String
$cshowList :: [TxSubmissionImpairmentState] -> ShowS
showList :: [TxSubmissionImpairmentState] -> ShowS
Show)

instance Arbitrary TxSubmissionImpairmentState where
  arbitrary :: Gen TxSubmissionImpairmentState
arbitrary = do
    base <- Gen TxSubmissionState
forall a. Arbitrary a => Gen a
arbitrary Gen TxSubmissionState
-> (TxSubmissionState -> Bool) -> Gen TxSubmissionState
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Int -> Bool)
-> (TxSubmissionState -> Int) -> TxSubmissionState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
 -> Int)
-> (TxSubmissionState
    -> Map
         Int
         ([Tx Int], Maybe (Positive SmallDelay),
          Maybe (Positive SmallDelay)))
-> TxSubmissionState
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap)
    imp  <- genImpairment (Map.keys (peerMap base))
    pure $ TxSubmissionImpairmentState base { peerImpairment = imp }

  shrink :: TxSubmissionImpairmentState -> [TxSubmissionImpairmentState]
shrink (TxSubmissionImpairmentState TxSubmissionState
st) =
       [ TxSubmissionState -> TxSubmissionImpairmentState
TxSubmissionImpairmentState TxSubmissionState
st' { peerImpairment = imp' }
       | TxSubmissionState
st' <- TxSubmissionState -> [TxSubmissionState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionState
st
       , Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
       , let imp' :: Map Int Impairment
imp' = Map Int Impairment -> Set Int -> Map Int Impairment
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys (TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st)
                                     (Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st'))
       , Bool -> Bool
not (Map Int Impairment -> Bool
forall k a. Map k a -> Bool
Map.null Map Int Impairment
imp')
       , Map Int Impairment -> Int
forall k a. Map k a -> Int
Map.size Map Int Impairment
imp' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st')
       ]
    [TxSubmissionImpairmentState]
-> [TxSubmissionImpairmentState] -> [TxSubmissionImpairmentState]
forall a. [a] -> [a] -> [a]
++ [ TxSubmissionState -> TxSubmissionImpairmentState
TxSubmissionImpairmentState TxSubmissionState
st { peerImpairment = imp' }
       | Map Int Impairment
imp' <- Map Int Impairment -> [Map Int Impairment]
shrinkImpairmentMap (TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st)
       , Bool -> Bool
not (Map Int Impairment -> Bool
forall k a. Map k a -> Bool
Map.null Map Int Impairment
imp')
       ]

validTxSubmissionImpairmentState :: TxSubmissionImpairmentState -> Bool
validTxSubmissionImpairmentState :: TxSubmissionImpairmentState -> Bool
validTxSubmissionImpairmentState (TxSubmissionImpairmentState TxSubmissionState
st) =
     TxSubmissionState -> Bool
validTxSubmissionState TxSubmissionState
st
  Bool -> Bool -> Bool
&& Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
  Bool -> Bool -> Bool
&& Bool -> Bool
not (Map Int Impairment -> Bool
forall k a. Map k a -> Bool
Map.null (TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st))
  Bool -> Bool -> Bool
&& Map Int Impairment -> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
  Bool -> Bool -> Bool
&& (Impairment -> Bool) -> [Impairment] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Impairment -> Bool
validImpairment (Map Int Impairment -> [Impairment]
forall k a. Map k a -> [a]
Map.elems (TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st))

-- Pick a non-empty proper subset of peers to impair, each given some
-- mix of body delay, per-body omission, txid-overflow, or unrequested
-- body injection.
genImpairment :: [Int] -> Gen (Map Int Impairment)
genImpairment :: [Int] -> Gen (Map Int Impairment)
genImpairment [Int]
addrs
  | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
addrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Map Int Impairment -> Gen (Map Int Impairment)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Int Impairment
forall k a. Map k a
Map.empty
  | Bool
otherwise = do
      n        <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
addrs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      shuffled <- shuffle addrs
      let impaired = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n [Int]
shuffled
      imps <- traverse (const genOneImpairment) impaired
      pure (Map.fromList (zip impaired imps))

shrinkImpairmentMap :: Map Int Impairment -> [Map Int Impairment]
shrinkImpairmentMap :: Map Int Impairment -> [Map Int Impairment]
shrinkImpairmentMap Map Int Impairment
m =
     [ Int -> Map Int Impairment -> Map Int Impairment
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int
k Map Int Impairment
m | Map Int Impairment -> Int
forall k a. Map k a -> Int
Map.size Map Int Impairment
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Int
k <- Map Int Impairment -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int Impairment
m ]
  [Map Int Impairment]
-> [Map Int Impairment] -> [Map Int Impairment]
forall a. [a] -> [a] -> [a]
++ [ Int -> Impairment -> Map Int Impairment -> Map Int Impairment
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
k Impairment
imp' Map Int Impairment
m
     | (Int
k, Impairment
imp) <- Map Int Impairment -> [(Int, Impairment)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int Impairment
m
     , Impairment
imp' <- Impairment -> [Impairment]
shrinkImpairment Impairment
imp
     ]

prop_txSubmission_resilientToImpairment :: TxSubmissionImpairmentState -> Property
prop_txSubmission_resilientToImpairment :: TxSubmissionImpairmentState -> Property
prop_txSubmission_resilientToImpairment (TxSubmissionImpairmentState TxSubmissionState
st) =
    let imp :: Map Int Impairment
imp       = TxSubmissionState -> Map Int Impairment
peerImpairment TxSubmissionState
st
        allAddrs :: Set Int
allAddrs  = Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
        wbAddrs :: Set Int
wbAddrs   = Set Int
allAddrs Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map Int Impairment -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int Impairment
imp
        wbPeerTxs :: [[Tx Int]]
wbPeerTxs = [ [Tx Int]
txs | Int
addr <- Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
wbAddrs
                          , let ([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) = TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
forall k a. Ord k => Map k a -> k -> a
Map.! Int
addr ]
        allOutIds :: Set Int
allOutIds = [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], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> [Int])
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([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 (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
        tr :: SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr        = (forall s. IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int))
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
st)
    in String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"impaired peers: "     String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map Int Impairment -> Int
forall k a. Map k a -> Int
Map.size Map Int Impairment
imp))
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"well-behaved peers: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set Int -> Int
forall a. Set a -> Int
Set.size Set Int
wbAddrs))
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"impairment kind" (Impairment -> String
kindOf (Impairment -> String) -> [Impairment] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int Impairment -> [Impairment]
forall k a. Map k a -> [a]
Map.elems Map Int Impairment
imp)
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ case Bool
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> Either Failure ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr of
         Left Failure
e -> String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Failure -> String
forall a. Show a => a -> String
show Failure
e)
                 (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr)
                 (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
         Right ([Tx Int]
inmp, [[Tx Int]]
_, SharedTxState Int Int
finalState) ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int 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
validateWellBehaved [Tx Int]
inmp ([Tx Int] -> Property) -> [[Tx Int]] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
`map` [[Tx Int]]
wbPeerTxs)
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Set Int -> [Tx Int] -> Property
noContamination Set Int
allOutIds [Tx Int]
inmp
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> Property
forall a. SimTrace a -> Property
prop_counterInvariants SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SharedTxState Int Int -> Property
forall peeraddr txid.
(Show peeraddr, Show txid, HasRawTxId txid) =>
SharedTxState peeraddr txid -> Property
prop_sharedStateClean SharedTxState Int Int
finalState
  where
    -- Same shape as 'validate' inside 'prop_txSubmission'. Only assert
    -- coverage when the peer's stream is all-unique-and-all-valid; the
    -- duplicate / invalid-prefix cases are out of scope here and covered
    -- by the existing 'prop_txSubmission'.
    validateWellBehaved :: [Tx Int] -> [Tx Int] -> Property
    validateWellBehaved :: [Tx Int] -> [Tx Int] -> Property
validateWellBehaved [Tx Int]
inmp [Tx Int]
outmp =
      let outUnique :: [Tx Int]
outUnique = (Tx Int -> Tx Int -> Bool) -> [Tx Int] -> [Tx Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Tx Int -> Int) -> Tx Int -> Tx Int -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tx Int -> Int
forall txid. Tx txid -> txid
getTxId) [Tx Int]
outmp
          outValid :: [Tx Int]
outValid  = [Tx Int] -> [Tx Int]
forall txid. [Tx txid] -> [Tx txid]
filterValidTxs [Tx Int]
outmp in
      if [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outUnique 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 Bool -> Bool -> Bool
&& [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outValid 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
        then
          let outIds :: Set Int
outIds  = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
outValid)
              inIds :: Set Int
inIds   = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
inmp)
              missing :: Set Int
missing = Set Int
outIds Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
inIds in
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"missing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
missing))
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property (Set Int -> Bool
forall a. Set a -> Bool
Set.null Set Int
missing)
        else
          Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

    -- Inbound mempool must not contain any txid no peer ever advertised.
    -- Catches adversarial bodies (e.g. injected by 'unrequestedTx') that
    -- would slip past the inbound's protocol checks.
    noContamination :: Set.Set Int -> [Tx Int] -> Property
    noContamination :: Set Int -> [Tx Int] -> Property
noContamination Set Int
allOutIds [Tx Int]
inmp =
      let inIds :: Set Int
inIds  = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
inmp)
          extras :: Set Int
extras = Set Int
inIds Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
allOutIds in
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"contaminating txids: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
extras))
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property (Set Int -> Bool
forall a. Set a -> Bool
Set.null Set Int
extras)

prop_TxSubmissionImpairmentState_validGen :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_validGen :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_validGen TxSubmissionImpairmentState
st =
    String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionImpairmentState -> String
forall a. Show a => a -> String
show TxSubmissionImpairmentState
st)
  (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ TxSubmissionImpairmentState -> Bool
validTxSubmissionImpairmentState TxSubmissionImpairmentState
st

prop_TxSubmissionImpairmentState_shrinkValid :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkValid :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkValid TxSubmissionImpairmentState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionImpairmentState -> String
forall a. Show a => a -> String
show TxSubmissionImpairmentState
s) (TxSubmissionImpairmentState -> Bool
validTxSubmissionImpairmentState TxSubmissionImpairmentState
s)
  | TxSubmissionImpairmentState
s <- TxSubmissionImpairmentState -> [TxSubmissionImpairmentState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionImpairmentState
st
  ]

prop_TxSubmissionImpairmentState_shrinkSmaller :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkSmaller :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkSmaller TxSubmissionImpairmentState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"shrink emitted self: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxSubmissionImpairmentState -> String
forall a. Show a => a -> String
show TxSubmissionImpairmentState
s) (TxSubmissionImpairmentState
s TxSubmissionImpairmentState -> TxSubmissionImpairmentState -> Bool
forall a. Eq a => a -> a -> Bool
/= TxSubmissionImpairmentState
st)
  | TxSubmissionImpairmentState
s <- TxSubmissionImpairmentState -> [TxSubmissionImpairmentState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionImpairmentState
st
  ]

prop_TxSubmissionImpairmentState_shrinkNoDups :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkNoDups :: TxSubmissionImpairmentState -> Property
prop_TxSubmissionImpairmentState_shrinkNoDups TxSubmissionImpairmentState
st =
  let shrunk :: [TxSubmissionImpairmentState]
shrunk = TxSubmissionImpairmentState -> [TxSubmissionImpairmentState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionImpairmentState
st in
      String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"duplicates: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TxSubmissionImpairmentState] -> String
forall a. Show a => a -> String
show ([TxSubmissionImpairmentState]
shrunk [TxSubmissionImpairmentState]
-> [TxSubmissionImpairmentState] -> [TxSubmissionImpairmentState]
forall a. Eq a => [a] -> [a] -> [a]
List.\\ [TxSubmissionImpairmentState] -> [TxSubmissionImpairmentState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionImpairmentState]
shrunk))
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [TxSubmissionImpairmentState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxSubmissionImpairmentState] -> [TxSubmissionImpairmentState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionImpairmentState]
shrunk) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [TxSubmissionImpairmentState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxSubmissionImpairmentState]
shrunk


-- | How a disconnected peer leaves the simulation.
data ExitMethod = ExitClean | ExitCancel
  deriving (ExitMethod -> ExitMethod -> Bool
(ExitMethod -> ExitMethod -> Bool)
-> (ExitMethod -> ExitMethod -> Bool) -> Eq ExitMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExitMethod -> ExitMethod -> Bool
== :: ExitMethod -> ExitMethod -> Bool
$c/= :: ExitMethod -> ExitMethod -> Bool
/= :: ExitMethod -> ExitMethod -> Bool
Eq, Int -> ExitMethod -> ShowS
[ExitMethod] -> ShowS
ExitMethod -> String
(Int -> ExitMethod -> ShowS)
-> (ExitMethod -> String)
-> ([ExitMethod] -> ShowS)
-> Show ExitMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExitMethod -> ShowS
showsPrec :: Int -> ExitMethod -> ShowS
$cshow :: ExitMethod -> String
show :: ExitMethod -> String
$cshowList :: [ExitMethod] -> ShowS
showList :: [ExitMethod] -> ShowS
Show, ExitMethod
ExitMethod -> ExitMethod -> Bounded ExitMethod
forall a. a -> a -> Bounded a
$cminBound :: ExitMethod
minBound :: ExitMethod
$cmaxBound :: ExitMethod
maxBound :: ExitMethod
Bounded, Int -> ExitMethod
ExitMethod -> Int
ExitMethod -> [ExitMethod]
ExitMethod -> ExitMethod
ExitMethod -> ExitMethod -> [ExitMethod]
ExitMethod -> ExitMethod -> ExitMethod -> [ExitMethod]
(ExitMethod -> ExitMethod)
-> (ExitMethod -> ExitMethod)
-> (Int -> ExitMethod)
-> (ExitMethod -> Int)
-> (ExitMethod -> [ExitMethod])
-> (ExitMethod -> ExitMethod -> [ExitMethod])
-> (ExitMethod -> ExitMethod -> [ExitMethod])
-> (ExitMethod -> ExitMethod -> ExitMethod -> [ExitMethod])
-> Enum ExitMethod
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 :: ExitMethod -> ExitMethod
succ :: ExitMethod -> ExitMethod
$cpred :: ExitMethod -> ExitMethod
pred :: ExitMethod -> ExitMethod
$ctoEnum :: Int -> ExitMethod
toEnum :: Int -> ExitMethod
$cfromEnum :: ExitMethod -> Int
fromEnum :: ExitMethod -> Int
$cenumFrom :: ExitMethod -> [ExitMethod]
enumFrom :: ExitMethod -> [ExitMethod]
$cenumFromThen :: ExitMethod -> ExitMethod -> [ExitMethod]
enumFromThen :: ExitMethod -> ExitMethod -> [ExitMethod]
$cenumFromTo :: ExitMethod -> ExitMethod -> [ExitMethod]
enumFromTo :: ExitMethod -> ExitMethod -> [ExitMethod]
$cenumFromThenTo :: ExitMethod -> ExitMethod -> ExitMethod -> [ExitMethod]
enumFromThenTo :: ExitMethod -> ExitMethod -> ExitMethod -> [ExitMethod]
Enum)

-- | A 'TxSubmissionState' plus a per-peer early-exit schedule.
-- Invariants (encoded in the 'Arbitrary' instance):
--
-- * @peerMap@ has at least two peers.
-- * The schedule covers a non-empty proper subset of @peerMap@'s keys
--   (at least one peer runs to the end).
-- * Each scheduled time is in @[0.5, 5.0]@ seconds.
data TxSubmissionDisconnectState =
    TxSubmissionDisconnectState
      { TxSubmissionDisconnectState -> TxSubmissionState
tdsBase     :: TxSubmissionState
      , TxSubmissionDisconnectState -> Map Int (DiffTime, ExitMethod)
tdsSchedule :: Map Int (DiffTime, ExitMethod)
      }
  deriving (TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
(TxSubmissionDisconnectState
 -> TxSubmissionDisconnectState -> Bool)
-> (TxSubmissionDisconnectState
    -> TxSubmissionDisconnectState -> Bool)
-> Eq TxSubmissionDisconnectState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
== :: TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
$c/= :: TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
/= :: TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
Eq, Int -> TxSubmissionDisconnectState -> ShowS
[TxSubmissionDisconnectState] -> ShowS
TxSubmissionDisconnectState -> String
(Int -> TxSubmissionDisconnectState -> ShowS)
-> (TxSubmissionDisconnectState -> String)
-> ([TxSubmissionDisconnectState] -> ShowS)
-> Show TxSubmissionDisconnectState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSubmissionDisconnectState -> ShowS
showsPrec :: Int -> TxSubmissionDisconnectState -> ShowS
$cshow :: TxSubmissionDisconnectState -> String
show :: TxSubmissionDisconnectState -> String
$cshowList :: [TxSubmissionDisconnectState] -> ShowS
showList :: [TxSubmissionDisconnectState] -> ShowS
Show)

instance Arbitrary TxSubmissionDisconnectState where
  arbitrary :: Gen TxSubmissionDisconnectState
arbitrary = do
    base <- Gen TxSubmissionState
forall a. Arbitrary a => Gen a
arbitrary Gen TxSubmissionState
-> (TxSubmissionState -> Bool) -> Gen TxSubmissionState
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2) (Int -> Bool)
-> (TxSubmissionState -> Int) -> TxSubmissionState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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))
 -> Int)
-> (TxSubmissionState
    -> Map
         Int
         ([Tx Int], Maybe (Positive SmallDelay),
          Maybe (Positive SmallDelay)))
-> TxSubmissionState
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap)
    sch  <- genDisconnectSchedule (Map.keys (peerMap base))
    pure (TxSubmissionDisconnectState base sch)

  shrink :: TxSubmissionDisconnectState -> [TxSubmissionDisconnectState]
shrink (TxSubmissionDisconnectState TxSubmissionState
st Map Int (DiffTime, ExitMethod)
sch) =
       [ TxSubmissionState
-> Map Int (DiffTime, ExitMethod) -> TxSubmissionDisconnectState
TxSubmissionDisconnectState TxSubmissionState
st' Map Int (DiffTime, ExitMethod)
sch'
       | TxSubmissionState
st' <- TxSubmissionState -> [TxSubmissionState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionState
st
       , Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st') Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
       , let sch' :: Map Int (DiffTime, ExitMethod)
sch' = Map Int (DiffTime, ExitMethod)
-> Set Int -> Map Int (DiffTime, ExitMethod)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Int (DiffTime, ExitMethod)
sch (Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st'))
       , Bool -> Bool
not (Map Int (DiffTime, ExitMethod) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (DiffTime, ExitMethod)
sch')
       , Map Int (DiffTime, ExitMethod) -> Int
forall k a. Map k a -> Int
Map.size Map Int (DiffTime, ExitMethod)
sch' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st')
       ]
    [TxSubmissionDisconnectState]
-> [TxSubmissionDisconnectState] -> [TxSubmissionDisconnectState]
forall a. [a] -> [a] -> [a]
++ [ TxSubmissionState
-> Map Int (DiffTime, ExitMethod) -> TxSubmissionDisconnectState
TxSubmissionDisconnectState TxSubmissionState
st Map Int (DiffTime, ExitMethod)
sch'
       | Map Int (DiffTime, ExitMethod)
sch' <- Map Int (DiffTime, ExitMethod) -> [Map Int (DiffTime, ExitMethod)]
shrinkDisconnectSchedule Map Int (DiffTime, ExitMethod)
sch
       , Bool -> Bool
not (Map Int (DiffTime, ExitMethod) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (DiffTime, ExitMethod)
sch')
       ]

validTxSubmissionDisconnectState :: TxSubmissionDisconnectState -> Bool
validTxSubmissionDisconnectState :: TxSubmissionDisconnectState -> Bool
validTxSubmissionDisconnectState (TxSubmissionDisconnectState TxSubmissionState
st Map Int (DiffTime, ExitMethod)
sch) =
     TxSubmissionState -> Bool
validTxSubmissionState TxSubmissionState
st
  Bool -> Bool -> Bool
&& Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
  Bool -> Bool -> Bool
&& Bool -> Bool
not (Map Int (DiffTime, ExitMethod) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (DiffTime, ExitMethod)
sch)
  Bool -> Bool -> Bool
&& Map Int (DiffTime, ExitMethod) -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int (DiffTime, ExitMethod)
sch Set Int -> Set Int -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
  Bool -> Bool -> Bool
&& Map Int (DiffTime, ExitMethod) -> Int
forall k a. Map k a -> Int
Map.size Map Int (DiffTime, ExitMethod)
sch Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
forall k a. Map k a -> Int
Map.size (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
  Bool -> Bool -> Bool
&& ((DiffTime, ExitMethod) -> Bool)
-> [(DiffTime, ExitMethod)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(DiffTime
t, ExitMethod
_) -> DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
0.5) (Map Int (DiffTime, ExitMethod) -> [(DiffTime, ExitMethod)]
forall k a. Map k a -> [a]
Map.elems Map Int (DiffTime, ExitMethod)
sch)

genDisconnectSchedule :: [Int] -> Gen (Map Int (DiffTime, ExitMethod))
genDisconnectSchedule :: [Int] -> Gen (Map Int (DiffTime, ExitMethod))
genDisconnectSchedule [Int]
addrs
  | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
addrs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = Map Int (DiffTime, ExitMethod)
-> Gen (Map Int (DiffTime, ExitMethod))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Int (DiffTime, ExitMethod)
forall k a. Map k a
Map.empty
  | Bool
otherwise = do
      n        <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
addrs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      shuffled <- shuffle addrs
      let chosen = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
n [Int]
shuffled
      entries <- traverse (const genEntry) chosen
      pure (Map.fromList (zip chosen entries))
  where
    genEntry :: Gen (DiffTime, ExitMethod)
genEntry = do
      t <- [(Int, Gen Double)] -> Gen Double
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
             [ (Int
1, (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0.5 :: Double,  Double
3.0))
             , (Int
1, (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
3.0 :: Double,  Double
5.0))
             , (Int
3, (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
5.0 :: Double, Double
10.0))
             ]
      m <- elements [ExitClean, ExitCancel]
      pure (realToFrac t, m)

-- Drop a scheduled peer, simplify 'ExitCancel' to 'ExitClean', or
-- shrink the scheduled time toward 0.5 (the generator floor).
shrinkDisconnectSchedule :: Map Int (DiffTime, ExitMethod)
                    -> [Map Int (DiffTime, ExitMethod)]
shrinkDisconnectSchedule :: Map Int (DiffTime, ExitMethod) -> [Map Int (DiffTime, ExitMethod)]
shrinkDisconnectSchedule Map Int (DiffTime, ExitMethod)
m = [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
forall a. Eq a => [a] -> [a]
List.nub ([Map Int (DiffTime, ExitMethod)]
 -> [Map Int (DiffTime, ExitMethod)])
-> [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
forall a b. (a -> b) -> a -> b
$
     [ Int
-> Map Int (DiffTime, ExitMethod) -> Map Int (DiffTime, ExitMethod)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int
k Map Int (DiffTime, ExitMethod)
m | Map Int (DiffTime, ExitMethod) -> Int
forall k a. Map k a -> Int
Map.size Map Int (DiffTime, ExitMethod)
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1, Int
k <- Map Int (DiffTime, ExitMethod) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (DiffTime, ExitMethod)
m ]
  [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
forall a. [a] -> [a] -> [a]
++ [ Int
-> (DiffTime, ExitMethod)
-> Map Int (DiffTime, ExitMethod)
-> Map Int (DiffTime, ExitMethod)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
k (DiffTime
t, ExitMethod
ExitClean) Map Int (DiffTime, ExitMethod)
m
     | (Int
k, (DiffTime
t, ExitMethod
ExitCancel)) <- Map Int (DiffTime, ExitMethod) -> [(Int, (DiffTime, ExitMethod))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (DiffTime, ExitMethod)
m
     ]
  [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
-> [Map Int (DiffTime, ExitMethod)]
forall a. [a] -> [a] -> [a]
++ [ Int
-> (DiffTime, ExitMethod)
-> Map Int (DiffTime, ExitMethod)
-> Map Int (DiffTime, ExitMethod)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int
k (Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
t', ExitMethod
method) Map Int (DiffTime, ExitMethod)
m
     | (Int
k, (DiffTime
t, ExitMethod
method)) <- Map Int (DiffTime, ExitMethod) -> [(Int, (DiffTime, ExitMethod))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (DiffTime, ExitMethod)
m
     , Double
t' <- Double -> [Double]
forall a. Arbitrary a => a -> [a]
shrink (DiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
t :: Double)
     , Double
t' Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0.5
     , Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
t' DiffTime -> DiffTime -> Bool
forall a. Eq a => a -> a -> Bool
/= DiffTime
t
     ]

-- | Variant of 'txSubmissionSimulation' that lets each peer exit early
-- via the supplied schedule.
--
-- * 'ExitClean' peers get a second per-peer control TVar; their control
--   STM combines it with the global one so a 'Terminate' from either
--   source makes the outbound send 'MsgDone'.
-- * 'ExitCancel' peers are passed through to 'runTxSubmission' which
--   cancels the server async at the scheduled time, simulating an
--   abrupt disconnect.
txSubmissionSimulationDisconnect
  :: forall s. TxSubmissionDisconnectState
  -> IOSim s ( [Tx Int], [[Tx Int]], SharedTxState PeerAddr TxId )
txSubmissionSimulationDisconnect :: forall s.
TxSubmissionDisconnectState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulationDisconnect
    (TxSubmissionDisconnectState
       (TxSubmissionState Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
state Map Int Impairment
peerImpairment TxDecisionPolicy
txDecisionPolicy) Map Int (DiffTime, ExitMethod)
schedule) = 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

  -- Per-peer disconnect TVar for the clean-exit subset.
  disconnectVars <- Map.fromList <$> sequence
                  [ (addr,) <$> newTVarIO Continue
                  | (addr, (_, ExitClean)) <- Map.toList schedule
                  ]

  let cancelSchedule = [(Int, DiffTime)] -> Map Int DiffTime
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                         [ (Int
addr, DiffTime
t)
                         | (Int
addr, (DiffTime
t, ExitMethod
ExitCancel)) <- Map Int (DiffTime, ExitMethod) -> [(Int, (DiffTime, ExitMethod))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (DiffTime, ExitMethod)
schedule
                         ]

      -- Build a per-peer combined control STM that yields 'Terminate'
      -- when either the global or the per-peer disconnect TVar says so.
      combinedState :: Map PeerAddr ([Tx TxId], ControlMessageSTM (IOSim s), Maybe DiffTime, Maybe DiffTime)
      combinedState = (Int
 -> ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
     Maybe DiffTime)
 -> ([Tx Int], STM s ControlMessage, Maybe DiffTime,
     Maybe DiffTime))
-> Map
     Int
     ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
      Maybe DiffTime)
-> Map
     Int
     ([Tx Int], STM s ControlMessage, Maybe DiffTime, Maybe DiffTime)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey
        (\Int
addr ([Tx Int]
txs, StrictTVar (IOSim s) ControlMessage
var, Maybe DiffTime
mbOutDelay, Maybe DiffTime
mbInDelay) ->
           let stm :: ControlMessageSTM (IOSim s)
stm = case Int
-> Map Int (StrictTVar (IOSim s) ControlMessage)
-> Maybe (StrictTVar (IOSim s) ControlMessage)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
addr Map Int (StrictTVar (IOSim s) ControlMessage)
disconnectVars of
                       Maybe (StrictTVar (IOSim s) ControlMessage)
Nothing       -> StrictTVar (IOSim s) ControlMessage -> ControlMessageSTM (IOSim s)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) ControlMessage
var
                       Just StrictTVar (IOSim s) ControlMessage
disconnectVar -> do
                         g <- StrictTVar (IOSim s) ControlMessage -> ControlMessageSTM (IOSim s)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar (IOSim s) ControlMessage
var
                         c <- readTVar disconnectVar
                         pure (if g == Terminate || c == Terminate
                                  then Terminate else g)
           in ([Tx Int]
txs, ControlMessageSTM (IOSim s)
STM s ControlMessage
stm, Maybe DiffTime
mbOutDelay, Maybe DiffTime
mbInDelay))
        Map
  Int
  ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
   Maybe DiffTime)
state'

      simDelayTime = (DiffTime
 -> ([Tx Int], StrictTVar (IOSim s) ControlMessage, Maybe DiffTime,
     Maybe DiffTime)
 -> DiffTime)
-> DiffTime
-> Map
     Int
     ([Tx Int], StrictTVar (IOSim 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, StrictTVar (IOSim 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], StrictTVar (IOSim 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
      disconnectAids <-
        ((Int, (DiffTime, ExitMethod)) -> IOSim s (Async s ()))
-> [(Int, (DiffTime, ExitMethod))] -> IOSim s [Async s ()]
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) -> [a] -> f [b]
traverse (\(Int
addr, (DiffTime
t, ExitMethod
_)) ->
                    case Int
-> Map Int (StrictTVar (IOSim s) ControlMessage)
-> Maybe (StrictTVar (IOSim s) ControlMessage)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
addr Map Int (StrictTVar (IOSim s) ControlMessage)
disconnectVars of
                      Just StrictTVar (IOSim s) ControlMessage
v -> IOSim s () -> IOSim s (Async (IOSim s) ())
forall a. IOSim s a -> IOSim s (Async (IOSim s) a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (IOSim s () -> IOSim s (Async (IOSim s) ()))
-> IOSim s () -> IOSim s (Async (IOSim s) ())
forall a b. (a -> b) -> a -> b
$ do
                                  DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
t
                                  STM (IOSim s) () -> IOSim s ()
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar (IOSim s) ControlMessage
-> ControlMessage -> STM (IOSim s) ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar (IOSim s) ControlMessage
v ControlMessage
Terminate)
                      Maybe (StrictTVar (IOSim s) ControlMessage)
Nothing -> IOSim s () -> IOSim s (Async (IOSim s) ())
forall a. IOSim s a -> IOSim s (Async (IOSim s) a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (() -> IOSim s ()
forall a. a -> IOSim s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))
                 [ (Int, (DiffTime, ExitMethod))
x | x :: (Int, (DiffTime, ExitMethod))
x@(Int
_, (DiffTime
_, ExitMethod
ExitClean)) <- Map Int (DiffTime, ExitMethod) -> [(Int, (DiffTime, ExitMethod))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (DiffTime, ExitMethod)
schedule ]
      let 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
      result <- runTxSubmission tracer tracer tracer tracer combinedState peerImpairment
                                cancelSchedule txDecisionPolicy
      traverse_ cancel disconnectAids
      pure result


-- | Resilience to peer disconnects: with a non-empty proper subset of peers
-- exiting early (cleanly via 'MsgDone' or abruptly via cancellation),
-- the surviving peers' valid txs still reach the inbound mempool, no
-- adversarial txid leaks in, counters stay consistent, and the
-- 'SharedTxState' is fully reclaimed at end of simulation.
--
-- Exercises the 'withPeer' bracket finalizer scrub on mid-protocol
-- exit, including 'pifSubmitting'-non-empty paths reached when a peer
-- is cancelled while bodies are in submission.
prop_txSubmission_peerDisconnect :: TxSubmissionDisconnectState -> Property
prop_txSubmission_peerDisconnect :: TxSubmissionDisconnectState -> Property
prop_txSubmission_peerDisconnect cs :: TxSubmissionDisconnectState
cs@(TxSubmissionDisconnectState TxSubmissionState
st Map Int (DiffTime, ExitMethod)
schedule) =
    let allAddrs :: Set Int
allAddrs    = Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Set Int
forall k a. Map k a -> Set k
Map.keysSet (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
        disconnected :: Set Int
disconnected = Map Int (DiffTime, ExitMethod) -> Set Int
forall k a. Map k a -> Set k
Map.keysSet Map Int (DiffTime, ExitMethod)
schedule
        survivors :: Set Int
survivors    = Set Int
allAddrs Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
disconnected
        survivorTxs :: [[Tx Int]]
survivorTxs = [ [Tx Int]
txs | Int
addr <- Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
survivors
                            , let ([Tx Int]
txs, Maybe (Positive SmallDelay)
_, Maybe (Positive SmallDelay)
_) = TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
-> Int
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
forall k a. Ord k => Map k a -> k -> a
Map.! Int
addr ]
        allOutIds :: Set Int
allOutIds   = [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], Maybe (Positive SmallDelay),
  Maybe (Positive SmallDelay))
 -> [Int])
-> [([Tx Int], Maybe (Positive SmallDelay),
     Maybe (Positive SmallDelay))]
-> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([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 (TxSubmissionState
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
peerMap TxSubmissionState
st)
        tr :: SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr          = (forall s. IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int))
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (TxSubmissionDisconnectState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionDisconnectState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulationDisconnect TxSubmissionDisconnectState
cs)
        -- Earliest inbound trace time per peer. A 'cancel-active'
        -- classification means the inbound emitted at least one event
        -- before the scheduled cancel, so the bracket finalizer
        -- exercised the scrub-with-non-empty-state path; 'cancel-idle'
        -- means the cancel hit a server that had not progressed past
        -- 'serverIdle'.
        inboundFirstActivity :: Map Int Time
        inboundFirstActivity :: Map Int Time
inboundFirstActivity =
          (Time -> Time -> Time) -> [(Int, Time)] -> Map Int Time
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Time -> Time -> Time
forall a. Ord a => a -> a -> a
min
            [ (Int
addr, Time
t)
            | (Time
t, PeerInboundTrace Int
addr TraceTxSubmissionInbound Int (Tx Int)
_)
                <- SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> [(Time, PeerInboundTraceType)]
forall a b. Typeable b => SimTrace a -> [(Time, b)]
selectTraceEventsDynamicWithTime SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr
                    :: [(Time, PeerInboundTraceType)]
            ]
        cancelClassifications :: [String]
        cancelClassifications :: [String]
cancelClassifications =
          [ case Int -> Map Int Time -> Maybe Time
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
addr Map Int Time
inboundFirstActivity of
              Just Time
firstActivity
                | Time
firstActivity Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< DiffTime -> Time
Time DiffTime
t -> String
"cancel-active"
              Maybe Time
_                          -> String
"cancel-idle"
          | (Int
addr, (DiffTime
t, ExitMethod
ExitCancel)) <- Map Int (DiffTime, ExitMethod) -> [(Int, (DiffTime, ExitMethod))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (DiffTime, ExitMethod)
schedule
          ]
    in String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"disconnected peers: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Map Int (DiffTime, ExitMethod) -> Int
forall k a. Map k a -> Int
Map.size Map Int (DiffTime, ExitMethod)
schedule))
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"surviving peers: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Set Int -> Int
forall a. Set a -> Int
Set.size Set Int
survivors))
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"exit method" (ExitMethod -> String
forall a. Show a => a -> String
show (ExitMethod -> String)
-> ((DiffTime, ExitMethod) -> ExitMethod)
-> (DiffTime, ExitMethod)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime, ExitMethod) -> ExitMethod
forall a b. (a, b) -> b
snd ((DiffTime, ExitMethod) -> String)
-> [(DiffTime, ExitMethod)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Int (DiffTime, ExitMethod) -> [(DiffTime, ExitMethod)]
forall k a. Map k a -> [a]
Map.elems Map Int (DiffTime, ExitMethod)
schedule)
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"cancel timing" [String]
cancelClassifications
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ case Bool
-> SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> Either Failure ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
True SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr of
         Left Failure
e -> String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Failure -> String
forall a. Show a => a -> String
show Failure
e)
                 (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr)
                 (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
         Right ([Tx Int]
inmp, [[Tx Int]]
_, SharedTxState Int Int
finalState) ->
             String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> String
forall a. SimTrace a -> String
ppSayTrace SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int 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
validateSurvivor [Tx Int]
inmp ([Tx Int] -> Property) -> [[Tx Int]] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
`map` [[Tx Int]]
survivorTxs)
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. Set Int -> [Tx Int] -> Property
noContamination Set Int
allOutIds [Tx Int]
inmp
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> Property
forall a. SimTrace a -> Property
prop_counterInvariants SimTrace ([Tx Int], [[Tx Int]], SharedTxState Int Int)
tr
             Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. SharedTxState Int Int -> Property
forall peeraddr txid.
(Show peeraddr, Show txid, HasRawTxId txid) =>
SharedTxState peeraddr txid -> Property
prop_sharedStateClean SharedTxState Int Int
finalState
  where
    validateSurvivor :: [Tx Int] -> [Tx Int] -> Property
    validateSurvivor :: [Tx Int] -> [Tx Int] -> Property
validateSurvivor [Tx Int]
inmp [Tx Int]
outmp =
      let outUnique :: [Tx Int]
outUnique = (Tx Int -> Tx Int -> Bool) -> [Tx Int] -> [Tx Int]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool) -> (Tx Int -> Int) -> Tx Int -> Tx Int -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Tx Int -> Int
forall txid. Tx txid -> txid
getTxId) [Tx Int]
outmp
          outValid :: [Tx Int]
outValid  = [Tx Int] -> [Tx Int]
forall txid. [Tx txid] -> [Tx txid]
filterValidTxs [Tx Int]
outmp in
      if [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outUnique 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 Bool -> Bool -> Bool
&& [Tx Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx Int]
outValid 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
        then
          let outIds :: Set Int
outIds  = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
outValid)
              inIds :: Set Int
inIds   = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
inmp)
              missing :: Set Int
missing = Set Int
outIds Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
inIds in
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"missing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
missing))
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property (Set Int -> Bool
forall a. Set a -> Bool
Set.null Set Int
missing)
        else
          Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True

    noContamination :: Set.Set Int -> [Tx Int] -> Property
    noContamination :: Set Int -> [Tx Int] -> Property
noContamination Set Int
allOutIds [Tx Int]
inmp =
      let inIds :: Set Int
inIds  = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList (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]
inmp)
          extras :: Set Int
extras = Set Int
inIds Set Int -> Set Int -> Set Int
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Int
allOutIds in
        String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"contaminating txids: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (Set Int -> [Int]
forall a. Set a -> [a]
Set.toList Set Int
extras))
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Bool -> Property
forall prop. Testable prop => prop -> Property
property (Set Int -> Bool
forall a. Set a -> Bool
Set.null Set Int
extras)

prop_TxSubmissionDisconnectState_validGen :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_validGen :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_validGen TxSubmissionDisconnectState
st =
    String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionDisconnectState -> String
forall a. Show a => a -> String
show TxSubmissionDisconnectState
st) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ TxSubmissionDisconnectState -> Bool
validTxSubmissionDisconnectState TxSubmissionDisconnectState
st

prop_TxSubmissionDisconnectState_shrinkValid :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkValid :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkValid TxSubmissionDisconnectState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (TxSubmissionDisconnectState -> String
forall a. Show a => a -> String
show TxSubmissionDisconnectState
s) (TxSubmissionDisconnectState -> Bool
validTxSubmissionDisconnectState TxSubmissionDisconnectState
s) | TxSubmissionDisconnectState
s <- TxSubmissionDisconnectState -> [TxSubmissionDisconnectState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionDisconnectState
st ]

prop_TxSubmissionDisconnectState_shrinkSmaller :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkSmaller :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkSmaller TxSubmissionDisconnectState
st = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
  [ String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"shrink emitted self: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxSubmissionDisconnectState -> String
forall a. Show a => a -> String
show TxSubmissionDisconnectState
s) (TxSubmissionDisconnectState
s TxSubmissionDisconnectState -> TxSubmissionDisconnectState -> Bool
forall a. Eq a => a -> a -> Bool
/= TxSubmissionDisconnectState
st) | TxSubmissionDisconnectState
s <- TxSubmissionDisconnectState -> [TxSubmissionDisconnectState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionDisconnectState
st ]

prop_TxSubmissionDisconnectState_shrinkNoDups :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkNoDups :: TxSubmissionDisconnectState -> Property
prop_TxSubmissionDisconnectState_shrinkNoDups TxSubmissionDisconnectState
st =
  let shrunk :: [TxSubmissionDisconnectState]
shrunk = TxSubmissionDisconnectState -> [TxSubmissionDisconnectState]
forall a. Arbitrary a => a -> [a]
shrink TxSubmissionDisconnectState
st in
      String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"duplicates: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TxSubmissionDisconnectState] -> String
forall a. Show a => a -> String
show ([TxSubmissionDisconnectState]
shrunk [TxSubmissionDisconnectState]
-> [TxSubmissionDisconnectState] -> [TxSubmissionDisconnectState]
forall a. Eq a => [a] -> [a] -> [a]
List.\\ [TxSubmissionDisconnectState] -> [TxSubmissionDisconnectState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionDisconnectState]
shrunk))
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [TxSubmissionDisconnectState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxSubmissionDisconnectState] -> [TxSubmissionDisconnectState]
forall a. Eq a => [a] -> [a]
List.nub [TxSubmissionDisconnectState]
shrunk) Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [TxSubmissionDisconnectState] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxSubmissionDisconnectState]
shrunk


--
-- Score-related unit tests (decrement-on-accept tuning of peerScore).
--

-- | Build a 'Tx' with the given id, size, and validity.  Used by the
-- score tests to construct deterministic per-peer tx lists that
-- include known-valid and known-invalid bodies (the test mempool
-- rejects @getTxValid = False@ via 'getMempoolWriter').
mkTx :: TxId -> Bool -> Tx TxId
mkTx :: Int -> Bool -> Tx Int
mkTx Int
i Bool
valid = Tx { getTxId :: Int
getTxId      = Int
i
                  , getTxSize :: SizeInBytes
getTxSize    = SizeInBytes
100
                  , getTxAdvSize :: SizeInBytes
getTxAdvSize = SizeInBytes
100
                  , getTxValid :: Bool
getTxValid   = Bool
valid
                  , getTxParent :: Maybe Int
getTxParent  = Maybe Int
forall a. Maybe a
Nothing
                  }

-- | Pick out the per-peer @ptxcScore@ values from the simulation
-- trace, keyed by the peer the inbound side attributed the event to.
-- The aggregator @combine@ is invoked as @combine new old@ (matching
-- 'Map.insertWith' semantics) and controls reduction across multiple
-- events for the same peer.
peerScoresBy :: (Double -> Double -> Double)
             -> SimTrace a
             -> Map PeerAddr Double
peerScoresBy :: forall a.
(Double -> Double -> Double) -> SimTrace a -> Map Int Double
peerScoresBy Double -> Double -> Double
combine SimTrace a
tr =
    (Double -> Double -> Double) -> [(Int, Double)] -> Map Int Double
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Double -> Double -> Double
combine
      [ (Int
peer, ProcessedTxCount -> Double
ptxcScore ProcessedTxCount
ptxc)
      | PeerInboundTrace Int
peer (TraceTxSubmissionProcessed ProcessedTxCount
ptxc) <- [PeerInboundTraceType]
events
      ]
  where
    events :: [PeerInboundTraceType]
    events :: [PeerInboundTraceType]
events = Trace (SimResult a) PeerInboundTraceType -> [PeerInboundTraceType]
forall a b. Trace a b -> [b]
Trace.toList (Trace (SimResult a) PeerInboundTraceType
 -> [PeerInboundTraceType])
-> Trace (SimResult a) PeerInboundTraceType
-> [PeerInboundTraceType]
forall a b. (a -> b) -> a -> b
$ SimTrace a -> Trace (SimResult a) PeerInboundTraceType
forall a b. Typeable b => Trace a SimEvent -> Trace a b
traceSelectTraceEventsDynamic SimTrace a
tr

peerPeakScore, peerFinalScore :: SimTrace a -> Map PeerAddr Double
peerPeakScore :: forall a. SimTrace a -> Map Int Double
peerPeakScore  = (Double -> Double -> Double) -> SimTrace a -> Map Int Double
forall a.
(Double -> Double -> Double) -> SimTrace a -> Map Int Double
peerScoresBy Double -> Double -> Double
forall a. Ord a => a -> a -> a
max
peerFinalScore :: forall a. SimTrace a -> Map Int Double
peerFinalScore = (Double -> Double -> Double) -> SimTrace a -> Map Int Double
forall a.
(Double -> Double -> Double) -> SimTrace a -> Map Int Double
peerScoresBy Double -> Double -> Double
forall a b. a -> b -> a
const


-- | A peer that delivers only invalid bodies accumulates a non-zero
-- score from the mempool-reject penalty path. Sole advertiser, so no
-- multiplicity races: the score gain comes purely from the rejection
-- count attributed to this peer. With no accepts to offset, the score
-- cannot drain back to zero before the run ends.
unit_score_persistentBadStaysHigh :: Assertion
unit_score_persistentBadStaysHigh :: Assertion
unit_score_persistentBadStaysHigh = do
    let st :: TxSubmissionState
st = TxSubmissionState
              { peerMap :: Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap        = Int
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
forall k a. k -> a -> Map k a
Map.singleton Int
1
                                   ([ Int -> Bool -> Tx Int
mkTx Int
i Bool
False | Int
i <- [Int
0..Int
9] ], Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing, Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing)
              , peerImpairment :: Map Int Impairment
peerImpairment = Map Int Impairment
forall k a. Map k a
Map.empty
              , decisionPolicy :: TxDecisionPolicy
decisionPolicy = TxDecisionPolicy
defaultTxDecisionPolicy
              }
        tr :: SimTrace ()
tr          = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> IOSim s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
 -> IOSim s ())
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
st)
        peakScores :: Map Int Double
peakScores  = SimTrace () -> Map Int Double
forall a. SimTrace a -> Map Int Double
peerPeakScore SimTrace ()
tr
        finalScores :: Map Int Double
finalScores = SimTrace () -> Map Int Double
forall a. SimTrace a -> Map Int Double
peerFinalScore SimTrace ()
tr
        peakPeer1 :: Double
peakPeer1   = Double -> Int -> Map Int Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Double
0 Int
1 Map Int Double
peakScores
        finalPeer1 :: Double
finalPeer1  = Double -> Int -> Map Int Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Double
0 Int
1 Map Int Double
finalScores
        ctx :: String
        ctx :: String
ctx = String
"peak score:  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map Int Double -> String
forall a. Show a => a -> String
show Map Int Double
peakScores
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nfinal score: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map Int Double -> String
forall a. Show a => a -> String
show Map Int Double
finalScores
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 must accumulate score from mempool rejects")
               (Double
peakPeer1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 score must stay within scoreMax")
               (Double
peakPeer1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= TxDecisionPolicy -> Double
scoreMax TxDecisionPolicy
defaultTxDecisionPolicy)
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 has no accepts to offset the rejections, score must stay above zero")
               (Double
finalPeer1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)

-- | A peer that delivers a burst of invalid bodies and then valid
-- bodies recovers via decrement-on-accept: the score climbs during
-- the invalid phase, then drops back to zero as the accepts cancel
-- the rejection accumulation (with default 'scoreAcceptDecrement' of
-- 1 and equal-or-greater valid count).
unit_score_recoversAfterBurst :: Assertion
unit_score_recoversAfterBurst :: Assertion
unit_score_recoversAfterBurst = do
    let invalids :: Int
invalids = Int
5
        valids :: Int
valids   = Int
10
        st :: TxSubmissionState
st = TxSubmissionState
              { peerMap :: Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap        = Int
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
forall k a. k -> a -> Map k a
Map.singleton Int
1
                                   ( [ Int -> Bool -> Tx Int
mkTx Int
i Bool
False | Int
i <- [Int
0..Int
invalids Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
                                  [Tx Int] -> [Tx Int] -> [Tx Int]
forall a. [a] -> [a] -> [a]
++ [ Int -> Bool -> Tx Int
mkTx Int
i Bool
True  | Int
i <- [Int
invalids .. Int
invalids Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
valids Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ]
                                   , Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing, Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing)
              , peerImpairment :: Map Int Impairment
peerImpairment = Map Int Impairment
forall k a. Map k a
Map.empty
              , decisionPolicy :: TxDecisionPolicy
decisionPolicy = TxDecisionPolicy
defaultTxDecisionPolicy
              }
        tr :: SimTrace ()
tr          = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> IOSim s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
 -> IOSim s ())
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
st)
        peakScores :: Map Int Double
peakScores  = SimTrace () -> Map Int Double
forall a. SimTrace a -> Map Int Double
peerPeakScore SimTrace ()
tr
        finalScores :: Map Int Double
finalScores = SimTrace () -> Map Int Double
forall a. SimTrace a -> Map Int Double
peerFinalScore SimTrace ()
tr
        peakPeer1 :: Double
peakPeer1   = Double -> Int -> Map Int Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Double
0 Int
1 Map Int Double
peakScores
        finalPeer1 :: Double
finalPeer1  = Double -> Int -> Map Int Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Double
0 Int
1 Map Int Double
finalScores
        ctx :: String
        ctx :: String
ctx = String
"peak score:  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map Int Double -> String
forall a. Show a => a -> String
show Map Int Double
peakScores
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nfinal score: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map Int Double -> String
forall a. Show a => a -> String
show Map Int Double
finalScores
    HasCallStack => String -> Bool -> Assertion
String -> Bool -> Assertion
assertBool (String
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 must briefly accumulate score during the invalid burst")
               (Double
peakPeer1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
    String -> Double -> Double -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual (String
ctx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 must end at zero once valid accepts have drained the rejections")
                Double
0
                Double
finalPeer1

-- | A well-behaved peer that is the sole advertiser of every tx it
-- carries never sees a late or rejected event, so its score stays at
-- zero throughout the run.  Documents that decrement-on-accept does
-- not push the score below the floor when there is nothing to drain.
unit_score_wellBehavedStaysAtZero :: Assertion
unit_score_wellBehavedStaysAtZero :: Assertion
unit_score_wellBehavedStaysAtZero = do
    let st :: TxSubmissionState
st = TxSubmissionState
              { peerMap :: Map
  Int
  ([Tx Int], Maybe (Positive SmallDelay),
   Maybe (Positive SmallDelay))
peerMap        = Int
-> ([Tx Int], Maybe (Positive SmallDelay),
    Maybe (Positive SmallDelay))
-> Map
     Int
     ([Tx Int], Maybe (Positive SmallDelay),
      Maybe (Positive SmallDelay))
forall k a. k -> a -> Map k a
Map.singleton Int
1
                                   ([ Int -> Bool -> Tx Int
mkTx Int
i Bool
True | Int
i <- [Int
0..Int
9] ], Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing, Maybe (Positive SmallDelay)
forall a. Maybe a
Nothing)
              , peerImpairment :: Map Int Impairment
peerImpairment = Map Int Impairment
forall k a. Map k a
Map.empty
              , decisionPolicy :: TxDecisionPolicy
decisionPolicy = TxDecisionPolicy
defaultTxDecisionPolicy
              }
        tr :: SimTrace ()
tr         = (forall s. IOSim s ()) -> SimTrace ()
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int) -> IOSim s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
 -> IOSim s ())
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
st)
        peakScores :: Map Int Double
peakScores = SimTrace () -> Map Int Double
forall a. SimTrace a -> Map Int Double
peerPeakScore SimTrace ()
tr
        peakPeer1 :: Double
peakPeer1  = Double -> Int -> Map Int Double -> Double
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Double
0 Int
1 Map Int Double
peakScores
    String -> Double -> Double -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual (String
"peak score: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map Int Double -> String
forall a. Show a => a -> String
show Map Int Double
peakScores
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\npeer1 must never accumulate any score")
                Double
0
                Double
peakPeer1


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 Map Int Impairment
_ 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]], SharedTxState Int Int) -> IOSim s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
 -> IOSim s ())
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
forall s.
TxSubmissionState
-> IOSim s ([Tx Int], [[Tx Int]], SharedTxState Int Int)
txSubmissionSimulation TxSubmissionState
initialState)
      pTrace :: String
pTrace = SimTrace () -> String
forall a. SimTrace a -> String
ppSayTrace 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 -> String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
pTrace
              (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Failure -> String
forall a. Show a => a -> String
show Failure
err)
              (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
    Right ()
_ ->
      let tracedStates :: [TxStateTraceType]
          tracedStates :: [TxStateTraceType]
tracedStates = 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

          -- Fold over the trace, tracking the previous state so we can
          -- assert 'sharedGenerationBumpInvariant' between each pair of
          -- consecutive writes captured by 'traceTVarIO' on the shared
          -- state TVar.
          step
            :: (Maybe (SharedTxState PeerAddr TxId), (Every, Sum Int))
            -> TxStateTraceType
            -> (Maybe (SharedTxState PeerAddr TxId), (Every, Sum Int))
          step :: (Maybe (SharedTxState Int Int), (Every, Sum Int))
-> TxStateTraceType
-> (Maybe (SharedTxState Int Int), (Every, Sum Int))
step (Maybe (SharedTxState Int Int)
mPrev, (Every, Sum Int)
acc) (TxStateTrace SharedTxState Int Int
st) =
            let stateInv :: Every
stateInv = Property -> Every
forall p. Testable p => p -> Every
Every (String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (SharedTxState Int Int -> String
forall a. Show a => a -> String
show SharedTxState Int Int
st)
                                    (SharedTxState Int Int -> Property
forall peeraddr txid.
(Ord peeraddr, Ord txid, HasRawTxId txid, Show peeraddr,
 Show txid) =>
SharedTxState peeraddr txid -> Property
sharedTxStateInvariant SharedTxState Int Int
st))
                bumpInv :: Every
bumpInv  = case Maybe (SharedTxState Int Int)
mPrev of
                             Maybe (SharedTxState Int Int)
Nothing   -> Every
forall a. Monoid a => a
mempty
                             Just SharedTxState Int Int
prev ->
                               Property -> Every
forall p. Testable p => p -> Every
Every (SharedTxState Int Int -> SharedTxState Int Int -> Property
forall peeraddr txid.
(Eq peeraddr, Eq txid, HasRawTxId txid) =>
SharedTxState peeraddr txid
-> SharedTxState peeraddr txid -> Property
sharedGenerationBumpInvariant SharedTxState Int Int
prev SharedTxState Int Int
st) in
            (SharedTxState Int Int -> Maybe (SharedTxState Int Int)
forall a. a -> Maybe a
Just SharedTxState Int Int
st, (Every, Sum Int)
acc (Every, Sum Int) -> (Every, Sum Int) -> (Every, Sum Int)
forall a. Semigroup a => a -> a -> a
<> (Every
stateInv Every -> Every -> Every
forall a. Semigroup a => a -> a -> a
<> Every
bumpInv, Int -> Sum Int
forall a. a -> Sum a
Sum Int
1))

          (Maybe (SharedTxState Int Int)
_, (Every
p, Sum Int
c)) =
            ((Maybe (SharedTxState Int Int), (Every, Sum Int))
 -> TxStateTraceType
 -> (Maybe (SharedTxState Int Int), (Every, Sum Int)))
-> (Maybe (SharedTxState Int Int), (Every, Sum Int))
-> [TxStateTraceType]
-> (Maybe (SharedTxState Int Int), (Every, Sum Int))
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Maybe (SharedTxState Int Int), (Every, Sum Int))
-> TxStateTraceType
-> (Maybe (SharedTxState Int Int), (Every, Sum Int))
step (Maybe (SharedTxState Int Int)
forall a. Maybe a
Nothing, (Every, Sum Int)
forall a. Monoid a => a
mempty) [TxStateTraceType]
tracedStates in
      String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
pTrace
       (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"number of txs: "
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 Int -> Int -> String
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
. String -> Every -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"number of evaluated states: "
                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String
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)