{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE BlockArguments      #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingVia         #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Ouroboros.Network.TxSubmission.TxLogic
  ( tests
  , ArbTxDecisionPolicy (..)
  , PeerAddr
  , sharedTxStateInvariant
  , InvariantStrength (..)
  ) where

import Prelude hiding (seq)

import Control.Exception (assert)
import Control.Monad.Class.MonadTime.SI (Time (..))

import Data.Foldable as Foldable (fold, foldl', toList)
import Data.List (intercalate, isPrefixOf, isSuffixOf, mapAccumR, nub,
           stripPrefix)
import Data.Map.Merge.Strict qualified as Map
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum (..))
import Data.Sequence.Strict qualified as StrictSeq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable
import System.Random (StdGen, mkStdGen)

import NoThunks.Class

import Ouroboros.Network.Protocol.TxSubmission2.Type
import Ouroboros.Network.TxSubmission.Inbound.V2.Decision (TxDecision (..))
import Ouroboros.Network.TxSubmission.Inbound.V2.Decision qualified as TXS
import Ouroboros.Network.TxSubmission.Inbound.V2.Policy
import Ouroboros.Network.TxSubmission.Inbound.V2.State (PeerTxState (..),
           SharedTxState (..))
import Ouroboros.Network.TxSubmission.Inbound.V2.State qualified as TXS
import Ouroboros.Network.TxSubmission.Inbound.V2.Types qualified as TXS

import Test.Ouroboros.Network.TxSubmission.Types

import Test.QuickCheck
import Test.QuickCheck.Function (apply)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Text.Pretty.Simple


tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"TxLogic"
  [ TestName -> [TestTree] -> TestTree
testGroup TestName
"State"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"Arbitrary"
      [ TestName -> [TestTree] -> TestTree
testGroup TestName
"ArbSharedTxState"
        [ TestName -> (ArbSharedTxState -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generator"              ArbSharedTxState -> Property
prop_SharedTxState_generator
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrinker"             (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ PeerAddr -> (Fixed ArbSharedTxState -> Property) -> Property
forall prop. Testable prop => PeerAddr -> prop -> Property
withMaxSuccess PeerAddr
10
                                                Fixed ArbSharedTxState -> Property
prop_SharedTxState_shrinker
        , TestName -> (ArbSharedTxState -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"nothunks"               ArbSharedTxState -> Property
prop_SharedTxState_nothunks
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"ArbReceivedTxIds"
        [ TestName -> (ArbReceivedTxIds -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generator"              ArbReceivedTxIds -> Property
prop_receivedTxIds_generator
        ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"ArbCollectTxs"
        [ TestName -> (ArbCollectTxs -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generator"              ArbCollectTxs -> Property
prop_collectTxs_generator
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrinker"             (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ PeerAddr -> (Fixed ArbCollectTxs -> Property) -> Property
forall prop. Testable prop => PeerAddr -> prop -> Property
withMaxSuccess PeerAddr
10
                                                Fixed ArbCollectTxs -> Property
prop_collectTxs_shrinker
        ]
      ]
    , TestName
-> (ArbDecisionContextWithReceivedTxIds -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"acknowledgeTxIds"           ArbDecisionContextWithReceivedTxIds -> Property
prop_acknowledgeTxIds
    , TestName -> (ArbReceivedTxIds -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"receivedTxIdsImpl"          ArbReceivedTxIds -> Property
prop_receivedTxIdsImpl
    , TestName -> (ArbCollectTxs -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"collectTxsImpl"             ArbCollectTxs -> Property
prop_collectTxsImpl
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"splitAcknowledgedTxIds"     ArbDecisionContexts PeerAddr -> Property
prop_splitAcknowledgedTxIds
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"NoThunks"
      [ TestName -> (ArbReceivedTxIds -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"receivedTxIdsImpl"        ArbReceivedTxIds -> Property
prop_receivedTxIdsImpl_nothunks
      , TestName -> (ArbCollectTxs -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"collectTxsImpl"           ArbCollectTxs -> Property
prop_collectTxsImpl_nothunks
      ]
    ]
  , TestName -> [TestTree] -> TestTree
testGroup TestName
"Decisions"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"ArbDecisionContexts"
      [ TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generator"               ArbDecisionContexts PeerAddr -> Property
prop_ArbDecisionContexts_generator
      , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrinker"              (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ PeerAddr -> (ArbDecisionContexts PeerAddr -> Every) -> Property
forall prop. Testable prop => PeerAddr -> prop -> Property
withMaxSuccess PeerAddr
33
                                               ArbDecisionContexts PeerAddr -> Every
prop_ArbDecisionContexts_shrinker
      ]
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shared state invariant"    ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_sharedstate
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"inflight"                  ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_inflight
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"policy"                    ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_policy
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"acknowledged"              ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_acknowledged
    , TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"exhaustive"                ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_exhaustive
    ]
  , TestName -> [TestTree] -> TestTree
testGroup TestName
"Registry"
    [ TestName -> [TestTree] -> TestTree
testGroup TestName
"filterActivePeers"
      [ TestName -> (ArbDecisionContexts PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"not limiting decisions"  ArbDecisionContexts PeerAddr -> Property
prop_filterActivePeers_not_limitting_decisions
      ]
    ]
  ]


--
-- InboundState properties
--

type PeerAddr = Int

data InvariantStrength = WeakInvariant
                       | StrongInvariant

-- | 'InboundState` invariant.
--
sharedTxStateInvariant
  :: forall peeraddr txid tx.
     ( Ord txid
     , Show txid
     , Show tx
     )
  => InvariantStrength
  -> SharedTxState peeraddr txid tx
  -> Property
sharedTxStateInvariant :: forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
invariantStrength
                       SharedTxState {
                         Map peeraddr (PeerTxState txid tx)
peerTxStates :: Map peeraddr (PeerTxState txid tx)
peerTxStates :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates,
                         Map txid PeerAddr
inflightTxs :: Map txid PeerAddr
inflightTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs,
                         SizeInBytes
inflightTxsSize :: SizeInBytes
inflightTxsSize :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> SizeInBytes
inflightTxsSize,
                         Map txid (Maybe tx)
bufferedTxs :: Map txid (Maybe tx)
bufferedTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs,
                         Map txid PeerAddr
referenceCounts :: Map txid PeerAddr
referenceCounts :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
referenceCounts,
                         Map Time [txid]
timedTxs :: Map Time [txid]
timedTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map Time [txid]
timedTxs
                       } =

         -- `inflightTxs` and `bufferedTxs` are disjoint
         TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"inflightTxs not disjoint with bufferedTxs"
         (Set txid -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map txid PeerAddr -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid PeerAddr
inflightTxs Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set txid
bufferedTxsSet))
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
         TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"bufferedTxs txid not a subset of unacknowledged txids"
         let unacknowledgedSet :: Set txid
unacknowledgedSet =
               (PeerTxState txid tx -> Set txid -> Set txid)
-> Set txid -> [PeerTxState txid tx] -> Set txid
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PeerTxState { StrictSeq txid
unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds } Set txid
r ->
                       Set txid
r Set txid -> Set txid -> Set txid
forall a. Semigroup a => a -> a -> a
<> [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList (StrictSeq txid -> [txid]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq txid
unacknowledgedTxIds))
                     Set txid
forall a. Set a
Set.empty [PeerTxState txid tx]
txStates
             timedSet :: Set txid
timedSet = ([txid] -> Set txid) -> Map Time [txid] -> Set txid
forall m a. Monoid m => (a -> m) -> Map Time a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList Map Time [txid]
timedTxs
         in case InvariantStrength
invariantStrength of
           InvariantStrength
WeakInvariant   ->
             -- `submitTxToMempool` caches buffered `txs`, we check here that
             -- they do not leak
             TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"unacknowledgedSet: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show Set txid
unacknowledgedSet) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
             TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"bufferedTxsSet: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show Set txid
bufferedTxsSet) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
             TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"timedTxsSet: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show Set txid
timedSet) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
             (Set txid
bufferedTxsSet Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unacknowledgedSet)
             Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf`
             Set txid
timedSet

           InvariantStrength
StrongInvariant -> Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
             -- the set of buffered txids must be a subset of sum of the sets of
             -- unacknowledged txids
             Set txid
bufferedTxsSet
             Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf`
             Set txid
unacknowledgedSet

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"referenceCounts invariant violation"
         (
             Map txid PeerAddr
referenceCounts
             Map txid PeerAddr -> Map txid PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
             -- fold unacknowledgedTxIds
             (Map txid PeerAddr -> PeerTxState txid tx -> Map txid PeerAddr)
-> Map txid PeerAddr -> [PeerTxState txid tx] -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
               (\Map txid PeerAddr
m PeerTxState { unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds = StrictSeq txid
unacked } ->
                 (Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> Map txid PeerAddr -> StrictSeq txid -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
                   ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr -> txid -> Map txid PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
 -> Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> (txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr
-> txid
-> Map txid PeerAddr
forall a b. (a -> b) -> a -> b
$
                     (Maybe PeerAddr -> Maybe PeerAddr)
-> txid -> Map txid PeerAddr -> Map txid PeerAddr
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (\case
                                  Maybe PeerAddr
Nothing  -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr
1
                                  Just PeerAddr
cnt -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr -> PeerAddr
forall a. Enum a => a -> a
succ PeerAddr
cnt)
                   )
                   Map txid PeerAddr
m
                   StrictSeq txid
unacked
               )
               -- fold timedTxs
               ((Map txid PeerAddr -> [txid] -> Map txid PeerAddr)
-> Map txid PeerAddr -> Map Time [txid] -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> Map Time a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
                  ((Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> Map txid PeerAddr -> [txid] -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
                     ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr -> txid -> Map txid PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
 -> Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> (txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr
-> txid
-> Map txid PeerAddr
forall a b. (a -> b) -> a -> b
$
                       (Maybe PeerAddr -> Maybe PeerAddr)
-> txid -> Map txid PeerAddr -> Map txid PeerAddr
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (\case
                                    Maybe PeerAddr
Nothing  -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr
1
                                    Just PeerAddr
cnt -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr -> PeerAddr
forall a. Enum a => a -> a
succ PeerAddr
cnt)
                     )
                  )
                  Map txid PeerAddr
forall k a. Map k a
Map.empty
                  Map Time [txid]
timedTxs
               )
               [PeerTxState txid tx]
txStates
         )

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"bufferedTxs contain tx which should be gc-ed: "
                         TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show (Map txid (Maybe tx) -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid (Maybe tx)
bufferedTxs Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set txid
liveSet))
         (Map txid (Maybe tx) -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid (Maybe tx)
bufferedTxs Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set txid
liveSet)

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"inflightTxs must be a sum of requestedTxInflight sets"
        (Map txid PeerAddr
inflightTxs
          Map txid PeerAddr -> Map txid PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
          (PeerTxState txid tx -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr
-> Map peeraddr (PeerTxState txid tx)
-> Map txid PeerAddr
forall a b. (a -> b -> b) -> b -> Map peeraddr a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PeerTxState { Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight } Map txid PeerAddr
m ->
                 (PeerAddr -> PeerAddr -> PeerAddr)
-> Map txid PeerAddr -> Map txid PeerAddr -> Map txid PeerAddr
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith PeerAddr -> PeerAddr -> PeerAddr
forall a. Num a => a -> a -> a
(+) ((txid -> PeerAddr) -> Set txid -> Map txid PeerAddr
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (\txid
_ -> PeerAddr
1) Set txid
requestedTxsInflight) Map txid PeerAddr
m)
                Map txid PeerAddr
forall k a. Map k a
Map.empty
                Map peeraddr (PeerTxState txid tx)
peerTxStates)

         -- PeerTxState invariants
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Every -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"PeerTxState invariant violation"
         ((PeerTxState txid tx -> Every)
-> Map peeraddr (PeerTxState txid tx) -> Every
forall m a. Monoid m => (a -> m) -> Map peeraddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\PeerTxState txid tx
ps -> Property -> Every
forall p. Testable p => p -> Every
Every
                        (Property -> Every)
-> (PeerTxState txid tx -> Property)
-> PeerTxState txid tx
-> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerTxState txid tx -> TestName
forall a. Show a => a -> TestName
show PeerTxState txid tx
ps)
                        (Property -> Property)
-> (PeerTxState txid tx -> Property)
-> PeerTxState txid tx
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState txid tx -> Property
peerTxStateInvariant
                        (PeerTxState txid tx -> Every) -> PeerTxState txid tx -> Every
forall a b. (a -> b) -> a -> b
$ PeerTxState txid tx
ps
                  )
                  Map peeraddr (PeerTxState txid tx)
peerTxStates)

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"inflightTxsSize invariant violation"
         (SizeInBytes
inflightTxsSize SizeInBytes -> SizeInBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (PeerTxState txid tx -> SizeInBytes)
-> Map peeraddr (PeerTxState txid tx) -> SizeInBytes
forall m a. Monoid m => (a -> m) -> Map peeraddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PeerTxState txid tx -> SizeInBytes
forall txid tx. PeerTxState txid tx -> SizeInBytes
requestedTxsInflightSize Map peeraddr (PeerTxState txid tx)
peerTxStates)



  where
    peerTxStateInvariant :: PeerTxState txid tx -> Property
    peerTxStateInvariant :: PeerTxState txid tx -> Property
peerTxStateInvariant PeerTxState { Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds,
                                       StrictSeq txid
unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds,
                                       Set txid
unknownTxs :: Set txid
unknownTxs :: forall txid tx. PeerTxState txid tx -> Set txid
unknownTxs,
                                       NumTxIdsToReq
requestedTxIdsInflight :: NumTxIdsToReq
requestedTxIdsInflight :: forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
requestedTxIdsInflight,
                                       Set txid
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight,
                                       SizeInBytes
requestedTxsInflightSize :: forall txid tx. PeerTxState txid tx -> SizeInBytes
requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize } =


             TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"unknownTxs is not a subset of unacknowledgedTxIds: "
                              TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show (Set txid
unknownTxs Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unacknowledgedTxIdsSet))
             (Set txid
unknownTxs Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set txid
unacknowledgedTxIdsSet)

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"availableTxs is not a subset of unacknowledgedTxIds: "
                              TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show (Set txid
availableTxIdsSet Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unacknowledgedTxIdsSet))
             (Set txid
availableTxIdsSet Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set txid
unacknowledgedTxIdsSet)

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"unacknowledged tx must be either available, unknown or buffered: "
                              TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show (Set txid
unacknowledgedTxIdsSet
                                        Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
availableTxIdsSet
                                        Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unknownTxs
                                        Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
bufferedTxsSet
                                        Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
downloadedTxsSet))
             (Set txid
unacknowledgedTxIdsSet
                 Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
availableTxIdsSet
                 Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unknownTxs
                 Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
downloadedTxsSet
               Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf`
               Set txid
bufferedTxsSet
             )

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"requestedTxIdsInflight invariant violation"
             (NumTxIdsToReq
requestedTxIdsInflight NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
>= NumTxIdsToReq
0)

             -- a requested tx is either available or buffered
        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"requestedTxsInflight invariant violation: "
                             TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set txid -> TestName
forall a. Show a => a -> TestName
show (Set txid
requestedTxsInflight
                                       Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
availableTxIdsSet
                                       Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
bufferedTxsSet))
             (Set txid
requestedTxsInflight Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
availableTxIdsSet Set txid -> Set txid -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set txid
bufferedTxsSet)

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"requestedTxsInfightSize"
             (SizeInBytes
requestedTxsInflightSize
               SizeInBytes -> SizeInBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
              Map txid SizeInBytes -> SizeInBytes
forall m. Monoid m => Map txid m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map txid SizeInBytes
availableTxIds Map txid SizeInBytes -> Set txid -> Map txid SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set txid
requestedTxsInflight))

      where
        availableTxIdsSet :: Set txid
        availableTxIdsSet :: Set txid
availableTxIdsSet = Map txid SizeInBytes -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid SizeInBytes
availableTxIds

        unacknowledgedTxIdsSet :: Set txid
        unacknowledgedTxIdsSet :: Set txid
unacknowledgedTxIdsSet = [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList (StrictSeq txid -> [txid]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq txid
unacknowledgedTxIds)

        downloadedTxsSet :: Set txid
        downloadedTxsSet :: Set txid
downloadedTxsSet = [Set txid] -> Set txid
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set txid] -> Set txid) -> [Set txid] -> Set txid
forall a b. (a -> b) -> a -> b
$ (PeerTxState txid tx -> Set txid)
-> [PeerTxState txid tx] -> [Set txid]
forall a b. (a -> b) -> [a] -> [b]
map (Map txid tx -> Set txid
forall k a. Map k a -> Set k
Map.keysSet (Map txid tx -> Set txid)
-> (PeerTxState txid tx -> Map txid tx)
-> PeerTxState txid tx
-> Set txid
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState txid tx -> Map txid tx
forall txid tx. PeerTxState txid tx -> Map txid tx
downloadedTxs) [PeerTxState txid tx]
txStates

    bufferedTxsSet :: Set txid
bufferedTxsSet = Map txid (Maybe tx) -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid (Maybe tx)
bufferedTxs     :: Set txid
    liveSet :: Set txid
liveSet        = Map txid PeerAddr -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid PeerAddr
referenceCounts :: Set txid
    txStates :: [PeerTxState txid tx]
txStates       = Map peeraddr (PeerTxState txid tx) -> [PeerTxState txid tx]
forall k a. Map k a -> [a]
Map.elems   Map peeraddr (PeerTxState txid tx)
peerTxStates    :: [PeerTxState txid tx]

--
-- Generate `InboundState`
--

-- | PeerTxState generator.
--
-- `mkArbPeerTxState` is the smart constructor.
--
data ArbPeerTxState txid tx =
    ArbPeerTxState { forall txid tx. ArbPeerTxState txid tx -> PeerTxState txid tx
arbPeerTxState :: PeerTxState txid tx,
                     forall txid tx. ArbPeerTxState txid tx -> Set tx
arbInflightSet :: Set tx,
                     -- ^ in-flight txs
                     forall txid tx. ArbPeerTxState txid tx -> Map txid (Maybe tx)
arbBufferedMap :: Map txid (Maybe tx)
                   }

data TxStatus = Available | Inflight | Unknown

instance Arbitrary TxStatus where
    arbitrary :: Gen TxStatus
arbitrary = [Gen TxStatus] -> Gen TxStatus
forall a. HasCallStack => [Gen a] -> Gen a
oneof [ TxStatus -> Gen TxStatus
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxStatus
Available
                      , TxStatus -> Gen TxStatus
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxStatus
Inflight
                      , TxStatus -> Gen TxStatus
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxStatus
Unknown
                      ]

data TxMask tx = TxAvailable tx TxStatus
                 -- ^ available txid with its size, the Bool indicates if it's
                 -- in-flight or not
               | TxBuffered tx

fixupTxMask :: txid -> TxMask (Tx txid) -> TxMask (Tx txid)
fixupTxMask :: forall txid. txid -> TxMask (Tx txid) -> TxMask (Tx txid)
fixupTxMask txid
txid (TxAvailable Tx txid
tx TxStatus
status) = Tx txid -> TxStatus -> TxMask (Tx txid)
forall tx. tx -> TxStatus -> TxMask tx
TxAvailable Tx txid
tx { getTxId = txid } TxStatus
status
fixupTxMask txid
txid (TxBuffered Tx txid
tx)         = Tx txid -> TxMask (Tx txid)
forall tx. tx -> TxMask tx
TxBuffered  Tx txid
tx { getTxId = txid }


instance Arbitrary tx => Arbitrary (TxMask tx) where
    arbitrary :: Gen (TxMask tx)
arbitrary = [Gen (TxMask tx)] -> Gen (TxMask tx)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [ tx -> TxStatus -> TxMask tx
forall tx. tx -> TxStatus -> TxMask tx
TxAvailable
                          (tx -> TxStatus -> TxMask tx)
-> Gen tx -> Gen (TxStatus -> TxMask tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen tx
forall a. Arbitrary a => Gen a
arbitrary
                          Gen (TxStatus -> TxMask tx) -> Gen TxStatus -> Gen (TxMask tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen TxStatus
forall a. Arbitrary a => Gen a
arbitrary
                      , tx -> TxMask tx
forall tx. tx -> TxMask tx
TxBuffered (tx -> TxMask tx) -> Gen tx -> Gen (TxMask tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen tx
forall a. Arbitrary a => Gen a
arbitrary
                      ]

    -- TODO: implement shrinker; this can be done by writing an inverse of
    -- `mkArbPeerTxState` and shrinking the unacknowledged txs & mask map.


-- | Smart constructor for `ArbPeerTxState`.
--
mkArbPeerTxState :: Ord txid
                 => Fun txid Bool
                 -> Int -- ^ txids in-flight
                 -> [txid]
                 -> Map txid (TxMask (Tx txid))
                 -> ArbPeerTxState txid (Tx txid)
mkArbPeerTxState :: forall txid.
Ord txid =>
Fun txid Bool
-> PeerAddr
-> [txid]
-> Map txid (TxMask (Tx txid))
-> ArbPeerTxState txid (Tx txid)
mkArbPeerTxState Fun txid Bool
mempoolHasTxFun PeerAddr
txIdsInflight [txid]
unacked Map txid (TxMask (Tx txid))
txMaskMap =
    PeerTxState txid (Tx txid)
-> Set (Tx txid)
-> Map txid (Maybe (Tx txid))
-> ArbPeerTxState txid (Tx txid)
forall txid tx.
PeerTxState txid tx
-> Set tx -> Map txid (Maybe tx) -> ArbPeerTxState txid tx
ArbPeerTxState
      PeerTxState { unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds = [txid] -> StrictSeq txid
forall a. [a] -> StrictSeq a
StrictSeq.fromList [txid]
unacked,
                    Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds,
                    NumTxIdsToReq
requestedTxIdsInflight :: NumTxIdsToReq
requestedTxIdsInflight :: NumTxIdsToReq
requestedTxIdsInflight,
                    Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight,
                    SizeInBytes
requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize,
                    Set txid
unknownTxs :: Set txid
unknownTxs :: Set txid
unknownTxs,
                    score :: Double
score = Double
0,
                    scoreTs :: Time
scoreTs = DiffTime -> Time
Time DiffTime
0,
                    downloadedTxs :: Map txid (Tx txid)
downloadedTxs = Map txid (Tx txid)
forall k a. Map k a
Map.empty,
                    toMempoolTxs :: Map txid (Tx txid)
toMempoolTxs = Map txid (Tx txid)
forall k a. Map k a
Map.empty }
      ([Tx txid] -> Set (Tx txid)
forall a. Ord a => [a] -> Set a
Set.fromList ([Tx txid] -> Set (Tx txid)) -> [Tx txid] -> Set (Tx txid)
forall a b. (a -> b) -> a -> b
$ Map txid (Tx txid) -> [Tx txid]
forall k a. Map k a -> [a]
Map.elems Map txid (Tx txid)
inflightMap)
      Map txid (Maybe (Tx txid))
bufferedMap
  where
    mempoolHasTx :: txid -> Bool
mempoolHasTx   = Fun txid Bool -> txid -> Bool
forall a b. Fun a b -> a -> b
apply Fun txid Bool
mempoolHasTxFun
    availableTxIds :: Map txid SizeInBytes
availableTxIds = [(txid, SizeInBytes)] -> Map txid SizeInBytes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                   [ (txid
txid, Tx txid -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx txid
tx) | (txid
txid, TxAvailable Tx txid
tx TxStatus
_) <- Map txid (TxMask (Tx txid)) -> [(txid, TxMask (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map txid (TxMask (Tx txid))
txMaskMap
                   , Bool -> Bool
not (txid -> Bool
mempoolHasTx txid
txid)
                   ]
    unknownTxs :: Set txid
unknownTxs     = [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList
                   [ txid
txid | (txid
txid, TxAvailable Tx txid
_ TxStatus
Unknown) <- Map txid (TxMask (Tx txid)) -> [(txid, TxMask (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map txid (TxMask (Tx txid))
txMaskMap
                   , Bool -> Bool
not (txid -> Bool
mempoolHasTx txid
txid)
                   ]

    requestedTxIdsInflight :: NumTxIdsToReq
requestedTxIdsInflight   = PeerAddr -> NumTxIdsToReq
forall a b. (Integral a, Num b) => a -> b
fromIntegral PeerAddr
txIdsInflight
    requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize = (Tx txid -> SizeInBytes) -> Map txid (Tx txid) -> SizeInBytes
forall m a. Monoid m => (a -> m) -> Map txid a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Tx txid -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Map txid (Tx txid)
inflightMap
    requestedTxsInflight :: Set txid
requestedTxsInflight     = Map txid (Tx txid) -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid (Tx txid)
inflightMap

    -- exclude `txid`s which are already in the mempool, we never request such
    -- `txid`s
    --
    -- TODO: this should be lifted, we might have the same txid in-flight from
    -- multiple peers, one will win the race and land in the mempool first
    inflightMap :: Map txid (Tx txid)
inflightMap = [(txid, Tx txid)] -> Map txid (Tx txid)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (txid
txid, Tx txid
tx)
                | (txid
txid, TxAvailable Tx txid
tx TxStatus
Inflight) <- Map txid (TxMask (Tx txid)) -> [(txid, TxMask (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map txid (TxMask (Tx txid))
txMaskMap
                , Bool -> Bool
not (txid -> Bool
mempoolHasTx txid
txid)
                ]

    bufferedMap :: Map txid (Maybe (Tx txid))
bufferedMap = [(txid, Maybe (Tx txid))] -> Map txid (Maybe (Tx txid))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (txid
txid, Maybe (Tx txid)
forall a. Maybe a
Nothing)
                  | txid
txid <- Map txid (TxMask (Tx txid)) -> [txid]
forall k a. Map k a -> [k]
Map.keys Map txid (TxMask (Tx txid))
txMaskMap
                  , txid -> Bool
mempoolHasTx txid
txid
                  ]
                Map txid (Maybe (Tx txid))
-> Map txid (Maybe (Tx txid)) -> Map txid (Maybe (Tx txid))
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union`
                  [(txid, Maybe (Tx txid))] -> Map txid (Maybe (Tx txid))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (txid
txid, Maybe (Tx txid)
mtx)
                  | (txid
txid, TxBuffered Tx txid
tx) <- Map txid (TxMask (Tx txid)) -> [(txid, TxMask (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map txid (TxMask (Tx txid))
txMaskMap
                  , let !mtx :: Maybe (Tx txid)
mtx = if txid -> Bool
mempoolHasTx txid
txid
                               then Maybe (Tx txid)
forall a. Maybe a
Nothing
                               else Tx txid -> Maybe (Tx txid)
forall a. a -> Maybe a
Just (Tx txid -> Maybe (Tx txid)) -> Tx txid -> Maybe (Tx txid)
forall a b. (a -> b) -> a -> b
$! Tx txid
tx { getTxId = txid }
                  ]


genArbPeerTxState
  :: forall txid.
     ( Arbitrary txid
     , Ord txid
     )
  => Fun txid Bool
  -> Int -- ^ max txids inflight
  -> Gen (ArbPeerTxState txid (Tx txid))
genArbPeerTxState :: forall txid.
(Arbitrary txid, Ord txid) =>
Fun txid Bool -> PeerAddr -> Gen (ArbPeerTxState txid (Tx txid))
genArbPeerTxState Fun txid Bool
mempoolHasTxFun PeerAddr
maxTxIdsInflight = do
    -- unacknowledged sequence
    unacked <- Gen [txid]
forall a. Arbitrary a => Gen a
arbitrary
    -- generate `Map txid (TxMask tx)`
    txIdsInflight <- choose (0, maxTxIdsInflight)
    txMap <- Map.fromList
         <$> traverse (\txid
txid -> (\TxMask (Tx txid)
a -> (txid
txid, txid -> TxMask (Tx txid) -> TxMask (Tx txid)
forall txid. txid -> TxMask (Tx txid) -> TxMask (Tx txid)
fixupTxMask txid
txid TxMask (Tx txid)
a)) (TxMask (Tx txid) -> (txid, TxMask (Tx txid)))
-> Gen (TxMask (Tx txid)) -> Gen (txid, TxMask (Tx txid))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxMask (Tx txid))
forall a. Arbitrary a => Gen a
arbitrary)
                      (nub unacked)
    return $ mkArbPeerTxState mempoolHasTxFun txIdsInflight unacked txMap


genSharedTxState
  :: forall txid.
     ( Arbitrary txid
     , Ord txid
     , Function txid
     , CoArbitrary txid
     )
  => Int -- ^ max txids inflight
  -> Gen ( Fun txid Bool
         , (PeerAddr, PeerTxState txid (Tx txid))
         , SharedTxState PeerAddr txid (Tx txid)
         , Map PeerAddr (ArbPeerTxState txid (Tx txid))
         )
genSharedTxState :: forall txid.
(Arbitrary txid, Ord txid, Function txid, CoArbitrary txid) =>
PeerAddr
-> Gen
     (Fun txid Bool, (PeerAddr, PeerTxState txid (Tx txid)),
      SharedTxState PeerAddr txid (Tx txid),
      Map PeerAddr (ArbPeerTxState txid (Tx txid)))
genSharedTxState PeerAddr
maxTxIdsInflight = do
    _mempoolHasTxFun@(Fun (_, _, x) _) <- Gen (Fun Bool Bool)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (Fun Bool Bool)
    let mempoolHasTxFun = (txid :-> Bool, Bool, Shrunk) -> (txid -> Bool) -> Fun txid Bool
forall a b. (a :-> b, b, Shrunk) -> (a -> b) -> Fun a b
Fun ((txid -> Bool) -> txid :-> Bool
forall a b. Function a => (a -> b) -> a :-> b
forall b. (txid -> b) -> txid :-> b
function (Bool -> txid -> Bool
forall a b. a -> b -> a
const Bool
False), Bool
False, Shrunk
x) (Bool -> txid -> Bool
forall a b. a -> b -> a
const Bool
False)
    pss <- listOf1 (genArbPeerTxState mempoolHasTxFun maxTxIdsInflight)
    seed <- arbitrary

    let pss' :: [(PeerAddr, ArbPeerTxState txid (Tx txid))]
        pss' = [PeerAddr
0..] [PeerAddr]
-> [ArbPeerTxState txid (Tx txid)]
-> [(PeerAddr, ArbPeerTxState txid (Tx txid))]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [ArbPeerTxState txid (Tx txid)]
pss

    peer <- choose (0, length pss - 1)

    let st :: SharedTxState PeerAddr txid (Tx txid)
        st = (txid -> Bool)
-> SharedTxState PeerAddr txid (Tx txid)
-> SharedTxState PeerAddr txid (Tx txid)
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState
               (Fun txid Bool -> txid -> Bool
forall a b. Fun a b -> a -> b
apply Fun txid Bool
mempoolHasTxFun)
               SharedTxState {
                 peerTxStates :: Map PeerAddr (PeerTxState txid (Tx txid))
peerTxStates    = [(PeerAddr, PeerTxState txid (Tx txid))]
-> Map PeerAddr (PeerTxState txid (Tx txid))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                 [ (PeerAddr
peeraddr, PeerTxState txid (Tx txid)
arbPeerTxState)
                                 | (PeerAddr
peeraddr, ArbPeerTxState { PeerTxState txid (Tx txid)
arbPeerTxState :: forall txid tx. ArbPeerTxState txid tx -> PeerTxState txid tx
arbPeerTxState :: PeerTxState txid (Tx txid)
arbPeerTxState })
                                   <- [(PeerAddr, ArbPeerTxState txid (Tx txid))]
pss'
                                 ],
                 inflightTxs :: Map txid PeerAddr
inflightTxs     = (Map txid PeerAddr -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr -> [Map txid PeerAddr] -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((PeerAddr -> PeerAddr -> PeerAddr)
-> Map txid PeerAddr -> Map txid PeerAddr -> Map txid PeerAddr
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith PeerAddr -> PeerAddr -> PeerAddr
forall a. Num a => a -> a -> a
(+)) Map txid PeerAddr
forall k a. Map k a
Map.empty
                                 [ (txid -> PeerAddr) -> Set txid -> Map txid PeerAddr
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (PeerAddr -> txid -> PeerAddr
forall a b. a -> b -> a
const PeerAddr
1) ((Tx txid -> txid) -> Set (Tx txid) -> Set txid
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map Tx txid -> txid
forall txid. Tx txid -> txid
getTxId Set (Tx txid)
arbInflightSet)
                                 | ArbPeerTxState { Set (Tx txid)
arbInflightSet :: forall txid tx. ArbPeerTxState txid tx -> Set tx
arbInflightSet :: Set (Tx txid)
arbInflightSet }
                                   <- [ArbPeerTxState txid (Tx txid)]
pss
                                 ],
                 inflightTxsSize :: SizeInBytes
inflightTxsSize = SizeInBytes
0, -- It is set by fixupSharedTxState
                 bufferedTxs :: Map txid (Maybe (Tx txid))
bufferedTxs     = [Map txid (Maybe (Tx txid))] -> Map txid (Maybe (Tx txid))
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                                 [ Map txid (Maybe (Tx txid))
arbBufferedMap
                                 | ArbPeerTxState { Map txid (Maybe (Tx txid))
arbBufferedMap :: forall txid tx. ArbPeerTxState txid tx -> Map txid (Maybe tx)
arbBufferedMap :: Map txid (Maybe (Tx txid))
arbBufferedMap }
                                   <- [ArbPeerTxState txid (Tx txid)]
pss
                                 ],
                 referenceCounts :: Map txid PeerAddr
referenceCounts = Map txid PeerAddr
forall k a. Map k a
Map.empty,
                 timedTxs :: Map Time [txid]
timedTxs        = Map Time [txid]
forall k a. Map k a
Map.empty,
                 inSubmissionToMempoolTxs :: Map txid PeerAddr
inSubmissionToMempoolTxs
                                 = Map txid PeerAddr
forall k a. Map k a
Map.empty,
                 peerRng :: StdGen
peerRng         = PeerAddr -> StdGen
mkStdGen PeerAddr
seed
               }

    return ( mempoolHasTxFun
           , (peer, peerTxStates st Map.! peer)
           , st
           , Map.fromList pss'
           )


-- |  Make sure `SharedTxState` is well formed.
--
fixupSharedTxState
  :: Ord txid
  => (txid -> Bool) -- ^ mempoolHasTx
  -> SharedTxState peeraddr txid tx
  -> SharedTxState peeraddr txid tx
fixupSharedTxState :: forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState txid -> Bool
_mempoolHasTx st :: SharedTxState peeraddr txid tx
st@SharedTxState { Map peeraddr (PeerTxState txid tx)
peerTxStates :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates :: Map peeraddr (PeerTxState txid tx)
peerTxStates } =
    SharedTxState peeraddr txid tx
st { peerTxStates    = peerTxStates',
         inflightTxs     = inflightTxs',
         inflightTxsSize = foldMap requestedTxsInflightSize peerTxStates',
         bufferedTxs     = bufferedTxs',
         referenceCounts = referenceCounts'
       }
  where
    peerTxStates' :: Map peeraddr (PeerTxState txid tx)
peerTxStates' =
      (PeerTxState txid tx -> PeerTxState txid tx)
-> Map peeraddr (PeerTxState txid tx)
-> Map peeraddr (PeerTxState txid tx)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\ps :: PeerTxState txid tx
ps@PeerTxState { Map txid SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds,
                                 Set txid
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight } ->

        let -- requested txs must not be buffered
            requestedTxsInflight' :: Set txid
requestedTxsInflight'     = Set txid
requestedTxsInflight
                                 Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Map txid (Maybe tx) -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid (Maybe tx)
bufferedTxs'
            requestedTxsInflightSize' :: SizeInBytes
requestedTxsInflightSize' = Map txid SizeInBytes -> SizeInBytes
forall m. Monoid m => Map txid m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map txid SizeInBytes -> SizeInBytes)
-> Map txid SizeInBytes -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ Map txid SizeInBytes
availableTxIds
                                               Map txid SizeInBytes -> Set txid -> Map txid SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys`
                                               Set txid
requestedTxsInflight'

        in PeerTxState txid tx
ps { requestedTxsInflight     = requestedTxsInflight',
                requestedTxsInflightSize = requestedTxsInflightSize' }
      )
      Map peeraddr (PeerTxState txid tx)
peerTxStates

    inflightTxs' :: Map txid PeerAddr
inflightTxs' = (PeerTxState txid tx -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr
-> Map peeraddr (PeerTxState txid tx)
-> Map txid PeerAddr
forall a b. (a -> b -> b) -> b -> Map peeraddr a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PeerTxState { Set txid
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight } Map txid PeerAddr
m ->
                           (PeerAddr -> PeerAddr -> PeerAddr)
-> Map txid PeerAddr -> Map txid PeerAddr -> Map txid PeerAddr
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith PeerAddr -> PeerAddr -> PeerAddr
forall a. Num a => a -> a -> a
(+)
                             ((txid -> PeerAddr) -> Set txid -> Map txid PeerAddr
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (PeerAddr -> txid -> PeerAddr
forall a b. a -> b -> a
const PeerAddr
1) Set txid
requestedTxsInflight)
                             Map txid PeerAddr
m
                         )
                         Map txid PeerAddr
forall k a. Map k a
Map.empty
                         Map peeraddr (PeerTxState txid tx)
peerTxStates'

    bufferedTxs' :: Map txid (Maybe tx)
bufferedTxs' =
      SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs SharedTxState peeraddr txid tx
st
      Map txid (Maybe tx) -> Set txid -> Map txid (Maybe tx)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys`
        (PeerTxState txid tx -> Set txid -> Set txid)
-> Set txid -> [PeerTxState txid tx] -> Set txid
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\PeerTxState {unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds = StrictSeq txid
unacked } Set txid
r ->
                Set txid
r Set txid -> Set txid -> Set txid
forall a. Semigroup a => a -> a -> a
<> [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList (StrictSeq txid -> [txid]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq txid
unacked))
              Set txid
forall a. Set a
Set.empty (Map peeraddr (PeerTxState txid tx) -> [PeerTxState txid tx]
forall k a. Map k a -> [a]
Map.elems Map peeraddr (PeerTxState txid tx)
peerTxStates)


    referenceCounts' :: Map txid PeerAddr
referenceCounts' =
      (Map txid PeerAddr -> PeerTxState txid tx -> Map txid PeerAddr)
-> Map txid PeerAddr -> [PeerTxState txid tx] -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
        (\Map txid PeerAddr
m PeerTxState { StrictSeq txid
unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds } ->
          (Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> Map txid PeerAddr -> StrictSeq txid -> Map txid PeerAddr
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
            ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr -> txid -> Map txid PeerAddr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((txid -> Map txid PeerAddr -> Map txid PeerAddr)
 -> Map txid PeerAddr -> txid -> Map txid PeerAddr)
-> (txid -> Map txid PeerAddr -> Map txid PeerAddr)
-> Map txid PeerAddr
-> txid
-> Map txid PeerAddr
forall a b. (a -> b) -> a -> b
$
              (Maybe PeerAddr -> Maybe PeerAddr)
-> txid -> Map txid PeerAddr -> Map txid PeerAddr
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (\case
                           Maybe PeerAddr
Nothing  -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr
1
                           Just PeerAddr
cnt -> PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr -> PeerAddr
forall a. Enum a => a -> a
succ PeerAddr
cnt)
            )
            Map txid PeerAddr
m
            StrictSeq txid
unacknowledgedTxIds
        )
        Map txid PeerAddr
forall k a. Map k a
Map.empty
        (Map peeraddr (PeerTxState txid tx) -> [PeerTxState txid tx]
forall k a. Map k a -> [a]
Map.elems Map peeraddr (PeerTxState txid tx)
peerTxStates)


shrinkSharedTxState :: ( Arbitrary txid
                       , Ord txid
                       , Function txid
                       , Ord peeraddr
                       )
                    => (txid -> Bool)
                    ->  SharedTxState peeraddr txid (Tx txid)
                    -> [SharedTxState peeraddr txid (Tx txid)]
shrinkSharedTxState :: forall txid peeraddr.
(Arbitrary txid, Ord txid, Function txid, Ord peeraddr) =>
(txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> [SharedTxState peeraddr txid (Tx txid)]
shrinkSharedTxState txid -> Bool
mempoolHasTx st :: SharedTxState peeraddr txid (Tx txid)
st@SharedTxState { Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates :: Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates,
                                                    Map txid PeerAddr
inflightTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs :: Map txid PeerAddr
inflightTxs,
                                                    Map txid (Maybe (Tx txid))
bufferedTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs :: Map txid (Maybe (Tx txid))
bufferedTxs } =
  [ SharedTxState peeraddr txid (Tx txid)
st'
  | Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates' <- [(peeraddr, PeerTxState txid (Tx txid))]
-> Map peeraddr (PeerTxState txid (Tx txid))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(peeraddr, PeerTxState txid (Tx txid))]
 -> Map peeraddr (PeerTxState txid (Tx txid)))
-> [[(peeraddr, PeerTxState txid (Tx txid))]]
-> [Map peeraddr (PeerTxState txid (Tx txid))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((peeraddr, PeerTxState txid (Tx txid))
 -> [(peeraddr, PeerTxState txid (Tx txid))])
-> [(peeraddr, PeerTxState txid (Tx txid))]
-> [[(peeraddr, PeerTxState txid (Tx txid))]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (\(peeraddr, PeerTxState txid (Tx txid))
_ -> []) (Map peeraddr (PeerTxState txid (Tx txid))
-> [(peeraddr, PeerTxState txid (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.toList Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates)
  , Bool -> Bool
not (Map peeraddr (PeerTxState txid (Tx txid)) -> Bool
forall k a. Map k a -> Bool
Map.null Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates')
  , let st' :: SharedTxState peeraddr txid (Tx txid)
st' = (txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> SharedTxState peeraddr txid (Tx txid)
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState txid -> Bool
mempoolHasTx SharedTxState peeraddr txid (Tx txid)
st { peerTxStates = peerTxStates' }
  , SharedTxState peeraddr txid (Tx txid)
st' SharedTxState peeraddr txid (Tx txid)
-> SharedTxState peeraddr txid (Tx txid) -> Bool
forall a. Eq a => a -> a -> Bool
/= SharedTxState peeraddr txid (Tx txid)
st
  ]
  [SharedTxState peeraddr txid (Tx txid)]
-> [SharedTxState peeraddr txid (Tx txid)]
-> [SharedTxState peeraddr txid (Tx txid)]
forall a. [a] -> [a] -> [a]
++
  [ (txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> SharedTxState peeraddr txid (Tx txid)
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState txid -> Bool
mempoolHasTx SharedTxState peeraddr txid (Tx txid)
st { inflightTxs = inflightTxs' }
  | Map txid PeerAddr
inflightTxs' <- [(txid, PeerAddr)] -> Map txid PeerAddr
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(txid, PeerAddr)] -> Map txid PeerAddr)
-> [[(txid, PeerAddr)]] -> [Map txid PeerAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((txid, PeerAddr) -> [(txid, PeerAddr)])
-> [(txid, PeerAddr)] -> [[(txid, PeerAddr)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (\(txid, PeerAddr)
_ -> []) (Map txid PeerAddr -> [(txid, PeerAddr)]
forall k a. Map k a -> [(k, a)]
Map.toList Map txid PeerAddr
inflightTxs)
  ]
  [SharedTxState peeraddr txid (Tx txid)]
-> [SharedTxState peeraddr txid (Tx txid)]
-> [SharedTxState peeraddr txid (Tx txid)]
forall a. [a] -> [a] -> [a]
++
  [ SharedTxState peeraddr txid (Tx txid)
st
  | Map txid (Maybe (Tx txid))
bufferedTxs' <- [(txid, Maybe (Tx txid))] -> Map txid (Maybe (Tx txid))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                ([(txid, Maybe (Tx txid))] -> Map txid (Maybe (Tx txid)))
-> [[(txid, Maybe (Tx txid))]] -> [Map txid (Maybe (Tx txid))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((txid, Maybe (Tx txid)) -> [(txid, Maybe (Tx txid))])
-> [(txid, Maybe (Tx txid))] -> [[(txid, Maybe (Tx txid))]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (\(txid, Maybe (Tx txid))
_ -> []) (Map txid (Maybe (Tx txid)) -> [(txid, Maybe (Tx txid))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map txid (Maybe (Tx txid))
bufferedTxs)
  , let minBuffered :: Set txid
minBuffered =
          (PeerTxState txid (Tx txid) -> Set txid)
-> Map peeraddr (PeerTxState txid (Tx txid)) -> Set txid
forall m a. Monoid m => (a -> m) -> Map peeraddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
            (\PeerTxState {
                StrictSeq txid
unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds,
                Map txid SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds,
                Set txid
unknownTxs :: forall txid tx. PeerTxState txid tx -> Set txid
unknownTxs :: Set txid
unknownTxs
              }
              ->
              [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList (StrictSeq txid -> [txid]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq txid
unacknowledgedTxIds)
                Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Map txid SizeInBytes -> Set txid
forall k a. Map k a -> Set k
Map.keysSet Map txid SizeInBytes
availableTxIds
                Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set txid
unknownTxs
            )
            Map peeraddr (PeerTxState txid (Tx txid))
peerTxStates
        bufferedTxs'' :: Map txid (Maybe (Tx txid))
bufferedTxs'' = Map txid (Maybe (Tx txid))
bufferedTxs'
                        Map txid (Maybe (Tx txid))
-> Map txid (Maybe (Tx txid)) -> Map txid (Maybe (Tx txid))
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union`
                        (Map txid (Maybe (Tx txid))
bufferedTxs Map txid (Maybe (Tx txid))
-> Set txid -> Map txid (Maybe (Tx txid))
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set txid
minBuffered)
        st' :: SharedTxState peeraddr txid (Tx txid)
st' = (txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> SharedTxState peeraddr txid (Tx txid)
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState txid -> Bool
mempoolHasTx SharedTxState peeraddr txid (Tx txid)
st { bufferedTxs = bufferedTxs'' }
  , SharedTxState peeraddr txid (Tx txid)
st' SharedTxState peeraddr txid (Tx txid)
-> SharedTxState peeraddr txid (Tx txid) -> Bool
forall a. Eq a => a -> a -> Bool
/= SharedTxState peeraddr txid (Tx txid)
st
  ]

--
-- Arbitrary `SharaedTxState` instance
--

data ArbSharedTxState =
    ArbSharedTxState
      (Fun TxId Bool)
      (SharedTxState PeerAddr TxId (Tx TxId))
  deriving PeerAddr -> ArbSharedTxState -> TestName -> TestName
[ArbSharedTxState] -> TestName -> TestName
ArbSharedTxState -> TestName
(PeerAddr -> ArbSharedTxState -> TestName -> TestName)
-> (ArbSharedTxState -> TestName)
-> ([ArbSharedTxState] -> TestName -> TestName)
-> Show ArbSharedTxState
forall a.
(PeerAddr -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: PeerAddr -> ArbSharedTxState -> TestName -> TestName
showsPrec :: PeerAddr -> ArbSharedTxState -> TestName -> TestName
$cshow :: ArbSharedTxState -> TestName
show :: ArbSharedTxState -> TestName
$cshowList :: [ArbSharedTxState] -> TestName -> TestName
showList :: [ArbSharedTxState] -> TestName -> TestName
Show

instance Arbitrary ArbSharedTxState where
  arbitrary :: Gen ArbSharedTxState
arbitrary = do
    Small maxTxIdsInflight <- Gen (Small PeerAddr)
forall a. Arbitrary a => Gen a
arbitrary
    (mempoolHasTx, _, sharedTxState, _) <- genSharedTxState maxTxIdsInflight
    return $ ArbSharedTxState mempoolHasTx sharedTxState

  shrink :: ArbSharedTxState -> [ArbSharedTxState]
shrink (ArbSharedTxState Fun PeerAddr Bool
mempoolHasTx SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
    [ Fun PeerAddr Bool
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbSharedTxState
ArbSharedTxState Fun PeerAddr Bool
mempoolHasTx SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'
    | SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' <- (PeerAddr -> Bool)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> [SharedTxState PeerAddr PeerAddr (Tx PeerAddr)]
forall txid peeraddr.
(Arbitrary txid, Ord txid, Function txid, Ord peeraddr) =>
(txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> [SharedTxState peeraddr txid (Tx txid)]
shrinkSharedTxState (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTx) SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
    ]


-- | Verify that generated `SharedTxState` has no thunks if it's evaluated to
-- WHNF.
--
prop_SharedTxState_nothunks :: ArbSharedTxState -> Property
prop_SharedTxState_nothunks :: ArbSharedTxState -> Property
prop_SharedTxState_nothunks (ArbSharedTxState Fun PeerAddr Bool
_ !SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
    case SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Maybe ThunkInfo
forall a. NoThunks a => a -> Maybe ThunkInfo
unsafeNoThunks SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st of
      Maybe ThunkInfo
Nothing  -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
      Just ThunkInfo
ctx -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (ThunkInfo -> TestName
forall a. Show a => a -> TestName
show ThunkInfo
ctx) Bool
False


prop_SharedTxState_generator
  :: ArbSharedTxState
  -> Property
prop_SharedTxState_generator :: ArbSharedTxState -> Property
prop_SharedTxState_generator (ArbSharedTxState Fun PeerAddr Bool
_ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) = InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st


prop_SharedTxState_shrinker
  :: Fixed ArbSharedTxState
  -> Property
prop_SharedTxState_shrinker :: Fixed ArbSharedTxState -> Property
prop_SharedTxState_shrinker =
    Every -> Property
forall prop. Testable prop => prop -> Property
property
  (Every -> Property)
-> (Fixed ArbSharedTxState -> Every)
-> Fixed ArbSharedTxState
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ArbSharedTxState -> Every) -> [ArbSharedTxState] -> Every
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ArbSharedTxState Fun PeerAddr Bool
_ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) -> Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$ InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)
  ([ArbSharedTxState] -> Every)
-> (Fixed ArbSharedTxState -> [ArbSharedTxState])
-> Fixed ArbSharedTxState
-> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArbSharedTxState -> [ArbSharedTxState]
forall a. Arbitrary a => a -> [a]
shrink
  (ArbSharedTxState -> [ArbSharedTxState])
-> (Fixed ArbSharedTxState -> ArbSharedTxState)
-> Fixed ArbSharedTxState
-> [ArbSharedTxState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixed ArbSharedTxState -> ArbSharedTxState
forall a. Fixed a -> a
getFixed


--
-- `receivedTxIdsImpl` properties
--


data ArbReceivedTxIds =
     ArbReceivedTxIds (Fun TxId Bool) -- ^ mempoolHasTx
                      [Tx TxId]       -- ^ some txs to acknowledge
                      PeerAddr        -- ^ peer address
                      (PeerTxState TxId (Tx TxId))
                                      -- ^ peer state
                      (SharedTxState PeerAddr TxId (Tx TxId))
                                      -- ^ initial state
  deriving PeerAddr -> ArbReceivedTxIds -> TestName -> TestName
[ArbReceivedTxIds] -> TestName -> TestName
ArbReceivedTxIds -> TestName
(PeerAddr -> ArbReceivedTxIds -> TestName -> TestName)
-> (ArbReceivedTxIds -> TestName)
-> ([ArbReceivedTxIds] -> TestName -> TestName)
-> Show ArbReceivedTxIds
forall a.
(PeerAddr -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: PeerAddr -> ArbReceivedTxIds -> TestName -> TestName
showsPrec :: PeerAddr -> ArbReceivedTxIds -> TestName -> TestName
$cshow :: ArbReceivedTxIds -> TestName
show :: ArbReceivedTxIds -> TestName
$cshowList :: [ArbReceivedTxIds] -> TestName -> TestName
showList :: [ArbReceivedTxIds] -> TestName -> TestName
Show

instance  Arbitrary ArbReceivedTxIds where
    arbitrary :: Gen ArbReceivedTxIds
arbitrary = do
        Small maxTxIdsInflight <- Gen (Small PeerAddr)
forall a. Arbitrary a => Gen a
arbitrary
        (mempoolHasTxFun, (peeraddr, ps), st, psMap) <- genSharedTxState maxTxIdsInflight
        txsToAck <- sublistOf (Set.toList $ arbInflightSet (psMap Map.! peeraddr))
        pure $ ArbReceivedTxIds
                 mempoolHasTxFun
                 txsToAck
                 peeraddr
                 ps
                 st

    shrink :: ArbReceivedTxIds -> [ArbReceivedTxIds]
shrink (ArbReceivedTxIds Fun PeerAddr Bool
mempoolHasTxFun [Tx PeerAddr]
txs PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
      [ Fun PeerAddr Bool
-> [Tx PeerAddr]
-> PeerAddr
-> PeerTxState PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbReceivedTxIds
ArbReceivedTxIds Fun PeerAddr Bool
mempoolHasTxFun [Tx PeerAddr]
txs' PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
      | [Tx PeerAddr]
txs' <- [Tx PeerAddr] -> [[Tx PeerAddr]]
forall a. Arbitrary a => a -> [a]
shrink [Tx PeerAddr]
txs
      ]
      [ArbReceivedTxIds] -> [ArbReceivedTxIds] -> [ArbReceivedTxIds]
forall a. [a] -> [a] -> [a]
++
      [ Fun PeerAddr Bool
-> [Tx PeerAddr]
-> PeerAddr
-> PeerTxState PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbReceivedTxIds
ArbReceivedTxIds
        Fun PeerAddr Bool
mempoolHasTxFun' [Tx PeerAddr]
txs PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps
        ((PeerAddr -> Bool)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTxFun') SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)
      | Fun PeerAddr Bool
mempoolHasTxFun' <- Fun PeerAddr Bool -> [Fun PeerAddr Bool]
forall a. Arbitrary a => a -> [a]
shrink Fun PeerAddr Bool
mempoolHasTxFun
      ]


prop_receivedTxIds_generator
  :: ArbReceivedTxIds
  -> Property
prop_receivedTxIds_generator :: ArbReceivedTxIds -> Property
prop_receivedTxIds_generator (ArbReceivedTxIds Fun PeerAddr Bool
_ [Tx PeerAddr]
someTxsToAck PeerAddr
_peeraddr PeerTxState PeerAddr (Tx PeerAddr)
_ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
    TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TestName
"numToAck " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> PeerAddr -> PeerAddr -> TestName
forall a.
(Integral a, Eq a, Ord a, Show a) =>
a -> a -> a -> TestName
labelInt PeerAddr
100 PeerAddr
10 ([Tx PeerAddr] -> PeerAddr
forall a. [a] -> PeerAddr
forall (t :: * -> *) a. Foldable t => t a -> PeerAddr
length [Tx PeerAddr]
someTxsToAck))
  (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)
  (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st


-- | This property verifies that `acknowledgeTxIds` acknowledges a prefix of
-- unacknowledged txs, and that the `numTxIdsToAck` as well as `RefCoundDiff`
-- are correct.
--
-- It doesn't validate the returned `PeerTxState` holds it's properties as this
-- needs to be done in the context of updated `SharedTxState`.  This is verified
-- by `prop_receivedTxIdsImpl`, `prop_collectTxsImpl` and
-- `prop_makeDecisions_acknowledged`.
--
prop_acknowledgeTxIds :: ArbDecisionContextWithReceivedTxIds
                      -> Property
prop_acknowledgeTxIds :: ArbDecisionContextWithReceivedTxIds -> Property
prop_acknowledgeTxIds (ArbDecisionContextWithReceivedTxIds TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st PeerTxState PeerAddr (Tx PeerAddr)
ps Fun PeerAddr Bool
_ [Tx PeerAddr]
_ PeerAddr
_) =
    case TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> (NumTxIdsToAck, NumTxIdsToReq,
    TxsToMempool PeerAddr (Tx PeerAddr), RefCountDiff PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr tx txid.
(Ord txid, HasCallStack) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> PeerTxState txid tx
-> (NumTxIdsToAck, NumTxIdsToReq, TxsToMempool txid tx,
    RefCountDiff txid, PeerTxState txid tx)
TXS.acknowledgeTxIds TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st PeerTxState PeerAddr (Tx PeerAddr)
ps of
      (NumTxIdsToAck
numTxIdsToAck, NumTxIdsToReq
txIdsToRequest, TXS.TxsToMempool [(PeerAddr, Tx PeerAddr)]
txIdsTxs, TXS.RefCountDiff { Map PeerAddr PeerAddr
txIdsToAck :: Map PeerAddr PeerAddr
txIdsToAck :: forall txid. RefCountDiff txid -> Map txid PeerAddr
TXS.txIdsToAck }, PeerTxState PeerAddr (Tx PeerAddr)
ps') | NumTxIdsToReq
txIdsToRequest NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
> NumTxIdsToReq
0 ->
             TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"number of tx ids to ack must agree with RefCountDiff"
             ( NumTxIdsToAck -> PeerAddr
forall a b. (Integral a, Num b) => a -> b
fromIntegral NumTxIdsToAck
numTxIdsToAck
               PeerAddr -> PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
               Sum PeerAddr -> PeerAddr
forall a. Sum a -> a
getSum ((PeerAddr -> Sum PeerAddr) -> Map PeerAddr PeerAddr -> Sum PeerAddr
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PeerAddr -> Sum PeerAddr
forall a. a -> Sum a
Sum Map PeerAddr PeerAddr
txIdsToAck)
             )

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"acknowledged txs must form a prefix"
             let unacked :: [PeerAddr]
unacked  = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps)
                 unacked' :: [PeerAddr]
unacked' = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps')
             in case [PeerAddr]
unacked [PeerAddr] -> [PeerAddr] -> Maybe [PeerAddr]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripSuffix` [PeerAddr]
unacked' of
               Maybe [PeerAddr]
Nothing -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"acknowledged txs are not a prefix" Bool
False
               Just [PeerAddr]
txIdsToAck' ->
                    Map PeerAddr PeerAddr
txIdsToAck
                    Map PeerAddr PeerAddr -> Map PeerAddr PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
                    (PeerAddr -> PeerAddr -> PeerAddr)
-> [(PeerAddr, PeerAddr)] -> Map PeerAddr PeerAddr
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith PeerAddr -> PeerAddr -> PeerAddr
forall a. Num a => a -> a -> a
(+) ((,PeerAddr
1) (PeerAddr -> (PeerAddr, PeerAddr))
-> [PeerAddr] -> [(PeerAddr, PeerAddr)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PeerAddr]
txIdsToAck')

        Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"acknowledged txs" (TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"numTxIdsToAck = " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ NumTxIdsToAck -> TestName
forall a. Show a => a -> TestName
show NumTxIdsToAck
numTxIdsToAck)
             let acked :: Set TxId
                 acked :: Set PeerAddr
acked = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ([PeerAddr] -> Set PeerAddr) -> [PeerAddr] -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ PeerAddr -> [PeerAddr] -> [PeerAddr]
forall a. PeerAddr -> [a] -> [a]
take (NumTxIdsToAck -> PeerAddr
forall a b. (Integral a, Num b) => a -> b
fromIntegral NumTxIdsToAck
numTxIdsToAck) (StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps)
             in Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf ([PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ([PeerAddr] -> Set PeerAddr) -> [PeerAddr] -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ ((PeerAddr, Tx PeerAddr) -> PeerAddr)
-> [(PeerAddr, Tx PeerAddr)] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map (PeerAddr, Tx PeerAddr) -> PeerAddr
forall a b. (a, b) -> a
fst [(PeerAddr, Tx PeerAddr)]
txIdsTxs) Set PeerAddr
acked)

      (NumTxIdsToAck, NumTxIdsToReq, TxsToMempool PeerAddr (Tx PeerAddr),
 RefCountDiff PeerAddr, PeerTxState PeerAddr (Tx PeerAddr))
_otherwise -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
  where
    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
as [a]
suffix =
        [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [a]
forall a. [a] -> [a]
reverse [a]
suffix [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
`stripPrefix` [a] -> [a]
forall a. [a] -> [a]
reverse [a]
as


-- | Verify 'inboundStateInvariant' when acknowledging a sequence of txs.
--
prop_receivedTxIdsImpl
  :: ArbReceivedTxIds
  -> Property
prop_receivedTxIdsImpl :: ArbReceivedTxIds -> Property
prop_receivedTxIdsImpl (ArbReceivedTxIds Fun PeerAddr Bool
mempoolHasTxFun [Tx PeerAddr]
txs PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
       -- InboundState invariant
       TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
         (  TestName
"Unacknowledged in mempool: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
             [Bool] -> TestName
forall a. Show a => a -> TestName
show (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTxFun (PeerAddr -> Bool) -> [PeerAddr] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps)) TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n"
         TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"InboundState invariant violation:\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
            SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'
         )
         (InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st')

         -- unacknowledged txs are well formed
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"unacknowledged txids are not well formed"
         (  let unacked :: [PeerAddr]
unacked  = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps StrictSeq PeerAddr -> StrictSeq PeerAddr -> StrictSeq PeerAddr
forall a. Semigroup a => a -> a -> a
<> StrictSeq PeerAddr
txidSeq
                unacked' :: [PeerAddr]
unacked' = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps'
            in TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"old & received: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ [PeerAddr] -> TestName
forall a. Show a => a -> TestName
show [PeerAddr]
unacked TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++
                               TestName
"new:            " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ [PeerAddr] -> TestName
forall a. Show a => a -> TestName
show [PeerAddr]
unacked') (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
               [PeerAddr]
unacked' [PeerAddr] -> [PeerAddr] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` [PeerAddr]
unacked
         )

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. -- `receivedTxIdsImpl` doesn't acknowledge any `txids`
         TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"acknowledged property violation"
         (  let unacked :: [PeerAddr]
unacked  = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps
                unacked' :: [PeerAddr]
unacked' = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps'
            in [PeerAddr]
unacked [PeerAddr] -> [PeerAddr] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [PeerAddr]
unacked'
         )
  where
    st' :: SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' = (PeerAddr -> Bool)
-> PeerAddr
-> NumTxIdsToReq
-> StrictSeq PeerAddr
-> Map PeerAddr SizeInBytes
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
forall peeraddr tx txid.
(Ord txid, Ord peeraddr, HasCallStack) =>
(txid -> Bool)
-> peeraddr
-> NumTxIdsToReq
-> StrictSeq txid
-> Map txid SizeInBytes
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
TXS.receivedTxIdsImpl (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTxFun)
                               PeerAddr
peeraddr NumTxIdsToReq
0 StrictSeq PeerAddr
txidSeq Map PeerAddr SizeInBytes
txidMap SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
    ps' :: PeerTxState PeerAddr (Tx PeerAddr)
ps' = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> PeerAddr -> PeerTxState PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
peeraddr

    txidSeq :: StrictSeq PeerAddr
txidSeq = [PeerAddr] -> StrictSeq PeerAddr
forall a. [a] -> StrictSeq a
StrictSeq.fromList (Tx PeerAddr -> PeerAddr
forall txid. Tx txid -> txid
getTxId (Tx PeerAddr -> PeerAddr) -> [Tx PeerAddr] -> [PeerAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx PeerAddr]
txs)
    txidMap :: Map PeerAddr SizeInBytes
txidMap = [(PeerAddr, SizeInBytes)] -> Map PeerAddr SizeInBytes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Tx PeerAddr -> PeerAddr
forall txid. Tx txid -> txid
getTxId Tx PeerAddr
tx, Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx PeerAddr
tx) | Tx PeerAddr
tx <- [Tx PeerAddr]
txs ]


-- | Verify that `SharedTxState` returned by `receivedTxIdsImpl` if evaluated
-- to WHNF it doesn't contain any thunks.
--
prop_receivedTxIdsImpl_nothunks
  :: ArbReceivedTxIds
  -> Property
prop_receivedTxIdsImpl_nothunks :: ArbReceivedTxIds -> Property
prop_receivedTxIdsImpl_nothunks (ArbReceivedTxIds Fun PeerAddr Bool
mempoolHasTxFun [Tx PeerAddr]
txs PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
_ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
    case (PeerAddr -> Bool)
-> PeerAddr
-> NumTxIdsToReq
-> StrictSeq PeerAddr
-> Map PeerAddr SizeInBytes
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
forall peeraddr tx txid.
(Ord txid, Ord peeraddr, HasCallStack) =>
(txid -> Bool)
-> peeraddr
-> NumTxIdsToReq
-> StrictSeq txid
-> Map txid SizeInBytes
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
TXS.receivedTxIdsImpl (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTxFun)
                               PeerAddr
peeraddr NumTxIdsToReq
0 StrictSeq PeerAddr
txidSeq Map PeerAddr SizeInBytes
txidMap SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st of
      !SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' -> case SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Maybe ThunkInfo
forall a. NoThunks a => a -> Maybe ThunkInfo
unsafeNoThunks SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' of
        Maybe ThunkInfo
Nothing  -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
        Just ThunkInfo
ctx -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (ThunkInfo -> TestName
forall a. Show a => a -> TestName
show ThunkInfo
ctx) Bool
False
  where
    txidSeq :: StrictSeq PeerAddr
txidSeq = [PeerAddr] -> StrictSeq PeerAddr
forall a. [a] -> StrictSeq a
StrictSeq.fromList (Tx PeerAddr -> PeerAddr
forall txid. Tx txid -> txid
getTxId (Tx PeerAddr -> PeerAddr) -> [Tx PeerAddr] -> [PeerAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tx PeerAddr]
txs)
    txidMap :: Map PeerAddr SizeInBytes
txidMap = [(PeerAddr, SizeInBytes)] -> Map PeerAddr SizeInBytes
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Tx PeerAddr -> PeerAddr
forall txid. Tx txid -> txid
getTxId Tx PeerAddr
tx, Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx PeerAddr
tx) | Tx PeerAddr
tx <- [Tx PeerAddr]
txs ]


--
-- `collectTxs` properties
--


data ArbCollectTxs =
    ArbCollectTxs (Fun TxId Bool)        -- ^ mempoolHasTx
                  (Map TxId SizeInBytes) -- ^ requested txid's
                  (Map TxId (Tx TxId))   -- ^ received txs
                  PeerAddr               -- ^ peeraddr
                  (PeerTxState TxId (Tx TxId))
                  (SharedTxState PeerAddr TxId (Tx TxId))
                                         -- ^ 'InboundState'
    deriving PeerAddr -> ArbCollectTxs -> TestName -> TestName
[ArbCollectTxs] -> TestName -> TestName
ArbCollectTxs -> TestName
(PeerAddr -> ArbCollectTxs -> TestName -> TestName)
-> (ArbCollectTxs -> TestName)
-> ([ArbCollectTxs] -> TestName -> TestName)
-> Show ArbCollectTxs
forall a.
(PeerAddr -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: PeerAddr -> ArbCollectTxs -> TestName -> TestName
showsPrec :: PeerAddr -> ArbCollectTxs -> TestName -> TestName
$cshow :: ArbCollectTxs -> TestName
show :: ArbCollectTxs -> TestName
$cshowList :: [ArbCollectTxs] -> TestName -> TestName
showList :: [ArbCollectTxs] -> TestName -> TestName
Show


instance Arbitrary ArbCollectTxs where
    arbitrary :: Gen ArbCollectTxs
arbitrary = do
        Small maxTxIdsInflight <- Gen (Small PeerAddr)
forall a. Arbitrary a => Gen a
arbitrary
        (   mempoolHasTxFun
          , (peeraddr, ps@PeerTxState { availableTxIds,
                                        requestedTxIdsInflight,
                                        requestedTxsInflight,
                                        requestedTxsInflightSize })
          , st
          , _
          )
          <- genSharedTxState maxTxIdsInflight
        requestedTxIds <- take (fromIntegral requestedTxIdsInflight)
                      <$> sublistOf (toList requestedTxsInflight)

        -- Limit the requested `txid`s to satisfy `requestedTxsInflightSize`.
        let requestedTxIds' = ((PeerAddr, SizeInBytes) -> PeerAddr)
-> [(PeerAddr, SizeInBytes)] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PeerAddr, SizeInBytes) -> PeerAddr
forall a b. (a, b) -> a
fst
                            ([(PeerAddr, SizeInBytes)] -> [PeerAddr])
-> [(PeerAddr, SizeInBytes)] -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ ((PeerAddr, SizeInBytes) -> Bool)
-> [(PeerAddr, SizeInBytes)] -> [(PeerAddr, SizeInBytes)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\(PeerAddr
_,SizeInBytes
s) -> SizeInBytes
s SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= SizeInBytes
requestedTxsInflightSize)
                            ([(PeerAddr, SizeInBytes)] -> [(PeerAddr, SizeInBytes)])
-> [(PeerAddr, SizeInBytes)] -> [(PeerAddr, SizeInBytes)]
forall a b. (a -> b) -> a -> b
$ [PeerAddr] -> [SizeInBytes] -> [(PeerAddr, SizeInBytes)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PeerAddr]
requestedTxIds
                                  ((SizeInBytes -> SizeInBytes -> SizeInBytes)
-> [SizeInBytes] -> [SizeInBytes]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Semigroup a => a -> a -> a
(<>) [Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes -> PeerAddr -> SizeInBytes
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
txid | PeerAddr
txid <- [PeerAddr]
requestedTxIds ])

        receivedTx <- sublistOf requestedTxIds'
                  >>= traverse (\PeerAddr
txid -> do
                                  -- real size, which might be different from
                                  -- the advertised size
                                  size <- [(PeerAddr, Gen SizeInBytes)] -> Gen SizeInBytes
forall a. HasCallStack => [(PeerAddr, Gen a)] -> Gen a
frequency [ (PeerAddr
9, SizeInBytes -> Gen SizeInBytes
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes -> PeerAddr -> SizeInBytes
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
txid))
                                                    , (PeerAddr
1, (SizeInBytes, SizeInBytes) -> Gen SizeInBytes
forall a. Enum a => (a, a) -> Gen a
chooseEnum (SizeInBytes
0, SizeInBytes
maxTxSize))
                                                    ]

                                  valid <- frequency [(4, pure True), (1, pure False)]
                                  pure $ Tx { getTxId      = txid,
                                              getTxSize    = size,
                                              -- `availableTxIds` contains advertised sizes
                                              getTxAdvSize = availableTxIds Map.! txid,
                                              getTxValid   = valid })

        pure $ assert (foldMap getTxAdvSize receivedTx <= requestedTxsInflightSize)
             $ ArbCollectTxs mempoolHasTxFun
                              (Map.fromList [ (txid, advSize)
                                            | txid <- requestedTxIds'
                                            , let advSize = Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes -> PeerAddr -> SizeInBytes
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
txid
                                            ])
                              (Map.fromList [ (getTxId tx, tx) | tx <- receivedTx ])
                              peeraddr
                              ps
                              st

    shrink :: ArbCollectTxs -> [ArbCollectTxs]
shrink (ArbCollectTxs Fun PeerAddr Bool
mempoolHasTx Map PeerAddr SizeInBytes
requestedTxs Map PeerAddr (Tx PeerAddr)
receivedTxs PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
      [ Fun PeerAddr Bool
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> PeerAddr
-> PeerTxState PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbCollectTxs
ArbCollectTxs Fun PeerAddr Bool
mempoolHasTx
                      (Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map PeerAddr SizeInBytes
requestedTxs Set PeerAddr
requestedTxs')
                      (Map PeerAddr (Tx PeerAddr)
receivedTxs Map PeerAddr (Tx PeerAddr)
-> Set PeerAddr -> Map PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
requestedTxs')
                      PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
      | Set PeerAddr
requestedTxs' <- [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ([PeerAddr] -> Set PeerAddr) -> [[PeerAddr]] -> [Set PeerAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PeerAddr -> [PeerAddr]) -> [PeerAddr] -> [[PeerAddr]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (\PeerAddr
_ -> []) (Map PeerAddr SizeInBytes -> [PeerAddr]
forall k a. Map k a -> [k]
Map.keys Map PeerAddr SizeInBytes
requestedTxs)
      ]
      [ArbCollectTxs] -> [ArbCollectTxs] -> [ArbCollectTxs]
forall a. [a] -> [a] -> [a]
++
      [ Fun PeerAddr Bool
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> PeerAddr
-> PeerTxState PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbCollectTxs
ArbCollectTxs Fun PeerAddr Bool
mempoolHasTx
                      Map PeerAddr SizeInBytes
requestedTxs
                      (Map PeerAddr (Tx PeerAddr)
receivedTxs Map PeerAddr (Tx PeerAddr)
-> Set PeerAddr -> Map PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
receivedTxIds)
                      PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
      | Set PeerAddr
receivedTxIds <- [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ([PeerAddr] -> Set PeerAddr) -> [[PeerAddr]] -> [Set PeerAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PeerAddr -> [PeerAddr]) -> [PeerAddr] -> [[PeerAddr]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (\PeerAddr
_ -> []) (Map PeerAddr (Tx PeerAddr) -> [PeerAddr]
forall k a. Map k a -> [k]
Map.keys Map PeerAddr (Tx PeerAddr)
receivedTxs)
      ]
      [ArbCollectTxs] -> [ArbCollectTxs] -> [ArbCollectTxs]
forall a. [a] -> [a] -> [a]
++
      [ Fun PeerAddr Bool
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> PeerAddr
-> PeerTxState PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> ArbCollectTxs
ArbCollectTxs Fun PeerAddr Bool
mempoolHasTx
                     (Map PeerAddr SizeInBytes
requestedTxs
                       Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
unacked
                       Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
inflightTxSet)
                     (Map PeerAddr (Tx PeerAddr)
receivedTxs
                       Map PeerAddr (Tx PeerAddr)
-> Set PeerAddr -> Map PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
unacked
                       Map PeerAddr (Tx PeerAddr)
-> Set PeerAddr -> Map PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
inflightTxSet)
                     PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps
                     SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'
      | let unacked :: Set PeerAddr
unacked = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
                    ([PeerAddr] -> Set PeerAddr)
-> (PeerTxState PeerAddr (Tx PeerAddr) -> [PeerAddr])
-> PeerTxState PeerAddr (Tx PeerAddr)
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
                    (StrictSeq PeerAddr -> [PeerAddr])
-> (PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> [PeerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds
                    (PeerTxState PeerAddr (Tx PeerAddr) -> Set PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr) -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr)
ps
      , st' :: SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'@SharedTxState { Map PeerAddr PeerAddr
inflightTxs :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs :: Map PeerAddr PeerAddr
inflightTxs } <- (PeerAddr -> Bool)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> [SharedTxState PeerAddr PeerAddr (Tx PeerAddr)]
forall txid peeraddr.
(Arbitrary txid, Ord txid, Function txid, Ord peeraddr) =>
(txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> [SharedTxState peeraddr txid (Tx txid)]
shrinkSharedTxState (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTx) SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
      , let inflightTxSet :: Set PeerAddr
inflightTxSet = Map PeerAddr PeerAddr -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr PeerAddr
inflightTxs
      , PeerAddr
peeraddr PeerAddr
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'
      , SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Bool
forall a. Eq a => a -> a -> Bool
/= SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
      ]


prop_collectTxs_generator
  :: ArbCollectTxs
  -> Property
prop_collectTxs_generator :: ArbCollectTxs -> Property
prop_collectTxs_generator (ArbCollectTxs Fun PeerAddr Bool
_ Map PeerAddr SizeInBytes
requestedTxIds Map PeerAddr (Tx PeerAddr)
receivedTxs PeerAddr
peeraddr
                                            ps :: PeerTxState PeerAddr (Tx PeerAddr)
ps@PeerTxState { Map PeerAddr SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map PeerAddr SizeInBytes
availableTxIds,
                                                             SizeInBytes
requestedTxsInflightSize :: forall txid tx. PeerTxState txid tx -> SizeInBytes
requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize }
                                            SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
         TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"size of requested txs must not be larger than requestedTxsInflightSize"
         (SizeInBytes
requestedSize SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= SizeInBytes
requestedTxsInflightSize)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"inflightTxsSize must be greater than requestedSize"
         (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> SizeInBytes
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> SizeInBytes
inflightTxsSize SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
>= SizeInBytes
requestedSize)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"receivedTxs must be a subset of requestedTxIds "
                         TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show (Map PeerAddr (Tx PeerAddr) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (Tx PeerAddr)
receivedTxs Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set PeerAddr
requestedTxIdsSet))
         (Map PeerAddr (Tx PeerAddr) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (Tx PeerAddr)
receivedTxs Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
requestedTxIdsSet)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"peerTxState"
         (PeerAddr
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Maybe (PeerTxState PeerAddr (Tx PeerAddr))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
peeraddr (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) Maybe (PeerTxState PeerAddr (Tx PeerAddr))
-> Maybe (PeerTxState PeerAddr (Tx PeerAddr)) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PeerTxState PeerAddr (Tx PeerAddr)
-> Maybe (PeerTxState PeerAddr (Tx PeerAddr))
forall a. a -> Maybe a
Just PeerTxState PeerAddr (Tx PeerAddr)
ps)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. -- advertised sizes should agree with `getTxAdvSize of received txs.
         Every -> Property
forall prop. Testable prop => prop -> Property
property ( (Property -> Every) -> Map PeerAddr Property -> Every
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Property -> Every
forall p. Testable p => p -> Every
Every
                  (Map PeerAddr Property -> Every) -> Map PeerAddr Property -> Every
forall a b. (a -> b) -> a -> b
$ (SizeInBytes -> Tx PeerAddr -> Property)
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> Map PeerAddr Property
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
                      (\SizeInBytes
advSize Tx {PeerAddr
getTxId :: forall txid. Tx txid -> txid
getTxId :: PeerAddr
getTxId, SizeInBytes
getTxAdvSize :: forall txid. Tx txid -> SizeInBytes
getTxAdvSize :: SizeInBytes
getTxAdvSize} ->
                          TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
getTxId)
                        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ SizeInBytes
advSize SizeInBytes -> SizeInBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SizeInBytes
getTxAdvSize)
                      Map PeerAddr SizeInBytes
requestedTxIds
                      Map PeerAddr (Tx PeerAddr)
receivedTxs
                  )
  where
    requestedTxIdsSet :: Set PeerAddr
requestedTxIdsSet = Map PeerAddr SizeInBytes -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr SizeInBytes
requestedTxIds
    requestedSize :: SizeInBytes
requestedSize = Map PeerAddr SizeInBytes -> SizeInBytes
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
requestedTxIdsSet)


prop_collectTxs_shrinker
  :: Fixed ArbCollectTxs
  -- ^ disabled shrinking
  -> Property
prop_collectTxs_shrinker :: Fixed ArbCollectTxs -> Property
prop_collectTxs_shrinker (Fixed ArbCollectTxs
txs) =
    Every -> Property
forall prop. Testable prop => prop -> Property
property (Every -> Property) -> Every -> Property
forall a b. (a -> b) -> a -> b
$ (ArbCollectTxs -> Every) -> [ArbCollectTxs] -> Every
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a :: ArbCollectTxs
a@(ArbCollectTxs Fun PeerAddr Bool
_ Map PeerAddr SizeInBytes
_ Map PeerAddr (Tx PeerAddr)
_ PeerAddr
_ PeerTxState PeerAddr (Tx PeerAddr)
_ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) ->
                         Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> (Property -> Property) -> Property -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$
                                 ArbCollectTxs
-> (Map PeerAddr SizeInBytes, Map PeerAddr (Tx PeerAddr), PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr),
    SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
f ArbCollectTxs
a (Map PeerAddr SizeInBytes, Map PeerAddr (Tx PeerAddr), PeerAddr,
 PeerTxState PeerAddr (Tx PeerAddr),
 SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
-> (Map PeerAddr SizeInBytes, Map PeerAddr (Tx PeerAddr), PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr),
    SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
=/= ArbCollectTxs
-> (Map PeerAddr SizeInBytes, Map PeerAddr (Tx PeerAddr), PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr),
    SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
f ArbCollectTxs
txs
                          Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
                       ) (ArbCollectTxs -> [ArbCollectTxs]
forall a. Arbitrary a => a -> [a]
shrink ArbCollectTxs
txs)
  where
    f :: ArbCollectTxs
-> (Map PeerAddr SizeInBytes, Map PeerAddr (Tx PeerAddr), PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr),
    SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
f (ArbCollectTxs Fun PeerAddr Bool
_ Map PeerAddr SizeInBytes
reqSet Map PeerAddr (Tx PeerAddr)
recvMap PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) = (Map PeerAddr SizeInBytes
reqSet, Map PeerAddr (Tx PeerAddr)
recvMap, PeerAddr
peeraddr, PeerTxState PeerAddr (Tx PeerAddr)
ps, SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)


-- | Verify `collectTxsImpl` properties:
--
-- * verify `SharedTxState` invariant;
-- * unacknowledged txids after `collectTxsImpl` must be a suffix of the
--   original ones;
-- * progress property: we acknowledge as many `txid`s as possible
--
prop_collectTxsImpl
  :: ArbCollectTxs
  -> Property
prop_collectTxsImpl :: ArbCollectTxs -> Property
prop_collectTxsImpl (ArbCollectTxs Fun PeerAddr Bool
_mempoolHasTxFun Map PeerAddr SizeInBytes
txidsRequested Map PeerAddr (Tx PeerAddr)
txsReceived PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
ps SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =

      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TestName
"number of txids inflight "  TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> PeerAddr -> PeerAddr -> TestName
forall a.
(Integral a, Eq a, Ord a, Show a) =>
a -> a -> a -> TestName
labelInt PeerAddr
25 PeerAddr
5 (Map PeerAddr PeerAddr -> PeerAddr
forall k a. Map k a -> PeerAddr
Map.size (Map PeerAddr PeerAddr -> PeerAddr)
-> Map PeerAddr PeerAddr -> PeerAddr
forall a b. (a -> b) -> a -> b
$ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr PeerAddr
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TestName
"number of txids requested " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> PeerAddr -> PeerAddr -> TestName
forall a.
(Integral a, Eq a, Ord a, Show a) =>
a -> a -> a -> TestName
labelInt PeerAddr
25 PeerAddr
5 (Map PeerAddr SizeInBytes -> PeerAddr
forall k a. Map k a -> PeerAddr
Map.size Map PeerAddr SizeInBytes
txidsRequested)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TestName
"number of txids received "  TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> PeerAddr -> PeerAddr -> TestName
forall a.
(Integral a, Eq a, Ord a, Show a) =>
a -> a -> a -> TestName
labelInt PeerAddr
10 PeerAddr
2 (Map PeerAddr (Tx PeerAddr) -> PeerAddr
forall k a. Map k a -> PeerAddr
Map.size Map PeerAddr (Tx PeerAddr)
txsReceived)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
label (TestName
"hasTxSizeError " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Bool -> TestName
forall a. Show a => a -> TestName
show Bool
hasTxSizeErr) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

      case (Tx PeerAddr -> SizeInBytes)
-> PeerAddr
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Either
     TxSubmissionProtocolError
     (SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
forall peeraddr tx txid.
(Ord peeraddr, Ord txid, Show txid, Typeable txid) =>
(tx -> SizeInBytes)
-> peeraddr
-> Map txid SizeInBytes
-> Map txid tx
-> SharedTxState peeraddr txid tx
-> Either
     TxSubmissionProtocolError (SharedTxState peeraddr txid tx)
TXS.collectTxsImpl Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize PeerAddr
peeraddr Map PeerAddr SizeInBytes
txidsRequested Map PeerAddr (Tx PeerAddr)
txsReceived SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st of
        Right SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' | Bool -> Bool
not Bool
hasTxSizeErr ->
          let ps' :: PeerTxState PeerAddr (Tx PeerAddr)
ps' = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> PeerAddr -> PeerTxState PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
peeraddr in
               -- InboundState invariant
               TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
                 (  TestName
"InboundState invariant violation:\n" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"\n"
                 TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerTxState PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show PeerTxState PeerAddr (Tx PeerAddr)
ps'
                 )
                 (InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st')

          Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
               -- `collectTxsImpl` doesn't modify unacknowledged TxId's
               TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"acknowledged property violation"
               ( let unacked :: [PeerAddr]
unacked  = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps
                     unacked' :: [PeerAddr]
unacked' = StrictSeq PeerAddr -> [PeerAddr]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq PeerAddr -> [PeerAddr])
-> StrictSeq PeerAddr -> [PeerAddr]
forall a b. (a -> b) -> a -> b
$ PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps'
                 in [PeerAddr]
unacked [PeerAddr] -> [PeerAddr] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [PeerAddr]
unacked'
               )

        Right SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
_ ->
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"collectTxsImpl should return Left"
          (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Map PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (Tx PeerAddr)
txsReceived)
          (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Bool
False
        Left TxSubmissionProtocolError
e | Bool -> Bool
not Bool
hasTxSizeErr ->
          TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"collectTxsImpl should return Right" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TxSubmissionProtocolError -> TestName
forall a. Show a => a -> TestName
show TxSubmissionProtocolError
e) Bool
False

        Left (TXS.ProtocolErrorTxSizeError [(txid, SizeInBytes, SizeInBytes)]
as) ->
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ([(txid, SizeInBytes, SizeInBytes)] -> TestName
forall a. Show a => a -> TestName
show [(txid, SizeInBytes, SizeInBytes)]
as)
          (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ((\(txid
txid, SizeInBytes
_, SizeInBytes
_) -> txid -> PeerAddr
forall txid. Typeable txid => txid -> PeerAddr
coerceTxId txid
txid) ((txid, SizeInBytes, SizeInBytes) -> PeerAddr)
-> [(txid, SizeInBytes, SizeInBytes)] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
`map` [(txid, SizeInBytes, SizeInBytes)]
as)
            Set PeerAddr -> Set PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
            Map PeerAddr (Tx PeerAddr) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet ((Tx PeerAddr -> Bool)
-> Map PeerAddr (Tx PeerAddr) -> Map PeerAddr (Tx PeerAddr)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\Tx PeerAddr
tx -> Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx PeerAddr
tx SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx PeerAddr
tx) Map PeerAddr (Tx PeerAddr)
txsReceived)
        Left TxSubmissionProtocolError
e ->
          TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"unexpected error: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TxSubmissionProtocolError -> TestName
forall a. Show a => a -> TestName
show TxSubmissionProtocolError
e) Bool
False
  where
    hasTxSizeErr :: Bool
hasTxSizeErr = (Tx PeerAddr -> Bool) -> Map PeerAddr (Tx PeerAddr) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Tx PeerAddr
tx -> Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize Tx PeerAddr
tx SizeInBytes -> SizeInBytes -> Bool
forall a. Eq a => a -> a -> Bool
/= Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxAdvSize Tx PeerAddr
tx) Map PeerAddr (Tx PeerAddr)
txsReceived

    -- The `ProtocolErrorTxSizeError` type is an existential type.  We know that
    -- the type of `txid` is `TxId`, we just don't have evidence for it.
    coerceTxId :: Typeable txid => txid -> TxId
    coerceTxId :: forall txid. Typeable txid => txid -> PeerAddr
coerceTxId txid
txid = case txid -> Maybe PeerAddr
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast txid
txid of
      Just PeerAddr
a  -> PeerAddr
a
      Maybe PeerAddr
Nothing -> TestName -> PeerAddr
forall a. HasCallStack => TestName -> a
error TestName
"impossible happened! Is the test still using `TxId` for `txid`?"



deriving via OnlyCheckWhnfNamed "StdGen" StdGen instance NoThunks StdGen

-- | Verify that `SharedTxState` returned by `collectTxsImpl` if evaluated to
-- WHNF, it doesn't contain any thunks.
--
prop_collectTxsImpl_nothunks
  :: ArbCollectTxs
  -> Property
prop_collectTxsImpl_nothunks :: ArbCollectTxs -> Property
prop_collectTxsImpl_nothunks (ArbCollectTxs Fun PeerAddr Bool
_mempoolHasTxFun Map PeerAddr SizeInBytes
txidsRequested Map PeerAddr (Tx PeerAddr)
txsReceived PeerAddr
peeraddr PeerTxState PeerAddr (Tx PeerAddr)
_ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st) =
    case (Tx PeerAddr -> SizeInBytes)
-> PeerAddr
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Either
     TxSubmissionProtocolError
     (SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
forall peeraddr tx txid.
(Ord peeraddr, Ord txid, Show txid, Typeable txid) =>
(tx -> SizeInBytes)
-> peeraddr
-> Map txid SizeInBytes
-> Map txid tx
-> SharedTxState peeraddr txid tx
-> Either
     TxSubmissionProtocolError (SharedTxState peeraddr txid tx)
TXS.collectTxsImpl Tx PeerAddr -> SizeInBytes
forall txid. Tx txid -> SizeInBytes
getTxSize PeerAddr
peeraddr Map PeerAddr SizeInBytes
txidsRequested Map PeerAddr (Tx PeerAddr)
txsReceived SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st of
      Right SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' -> case SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Maybe ThunkInfo
forall a. NoThunks a => a -> Maybe ThunkInfo
unsafeNoThunks (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Maybe ThunkInfo)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Maybe ThunkInfo
forall a b. (a -> b) -> a -> b
$! SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' of
        Maybe ThunkInfo
Nothing  -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
        Just ThunkInfo
ctx -> TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (ThunkInfo -> TestName
forall a. Show a => a -> TestName
show ThunkInfo
ctx) Bool
False
      Left TxSubmissionProtocolError
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True


newtype ArbTxDecisionPolicy = ArbTxDecisionPolicy TxDecisionPolicy
  deriving PeerAddr -> ArbTxDecisionPolicy -> TestName -> TestName
[ArbTxDecisionPolicy] -> TestName -> TestName
ArbTxDecisionPolicy -> TestName
(PeerAddr -> ArbTxDecisionPolicy -> TestName -> TestName)
-> (ArbTxDecisionPolicy -> TestName)
-> ([ArbTxDecisionPolicy] -> TestName -> TestName)
-> Show ArbTxDecisionPolicy
forall a.
(PeerAddr -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: PeerAddr -> ArbTxDecisionPolicy -> TestName -> TestName
showsPrec :: PeerAddr -> ArbTxDecisionPolicy -> TestName -> TestName
$cshow :: ArbTxDecisionPolicy -> TestName
show :: ArbTxDecisionPolicy -> TestName
$cshowList :: [ArbTxDecisionPolicy] -> TestName -> TestName
showList :: [ArbTxDecisionPolicy] -> TestName -> TestName
Show

instance Arbitrary ArbTxDecisionPolicy where
    arbitrary :: Gen ArbTxDecisionPolicy
arbitrary =
          TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> (TxDecisionPolicy -> TxDecisionPolicy)
-> TxDecisionPolicy
-> ArbTxDecisionPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy
      (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> Gen TxDecisionPolicy -> Gen ArbTxDecisionPolicy
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( NumTxIdsToReq
-> NumTxIdsToReq
-> SizeInBytes
-> SizeInBytes
-> PeerAddr
-> DiffTime
-> Double
-> Double
-> TxDecisionPolicy
TxDecisionPolicy
            (NumTxIdsToReq
 -> NumTxIdsToReq
 -> SizeInBytes
 -> SizeInBytes
 -> PeerAddr
 -> DiffTime
 -> Double
 -> Double
 -> TxDecisionPolicy)
-> Gen NumTxIdsToReq
-> Gen
     (NumTxIdsToReq
      -> SizeInBytes
      -> SizeInBytes
      -> PeerAddr
      -> DiffTime
      -> Double
      -> Double
      -> TxDecisionPolicy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Small NumTxIdsToReq -> NumTxIdsToReq
forall a. Small a -> a
getSmall (Small NumTxIdsToReq -> NumTxIdsToReq)
-> (Positive (Small NumTxIdsToReq) -> Small NumTxIdsToReq)
-> Positive (Small NumTxIdsToReq)
-> NumTxIdsToReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive (Small NumTxIdsToReq) -> Small NumTxIdsToReq
forall a. Positive a -> a
getPositive (Positive (Small NumTxIdsToReq) -> NumTxIdsToReq)
-> Gen (Positive (Small NumTxIdsToReq)) -> Gen NumTxIdsToReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small NumTxIdsToReq))
forall a. Arbitrary a => Gen a
arbitrary)
            Gen
  (NumTxIdsToReq
   -> SizeInBytes
   -> SizeInBytes
   -> PeerAddr
   -> DiffTime
   -> Double
   -> Double
   -> TxDecisionPolicy)
-> Gen NumTxIdsToReq
-> Gen
     (SizeInBytes
      -> SizeInBytes
      -> PeerAddr
      -> DiffTime
      -> Double
      -> Double
      -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Small NumTxIdsToReq -> NumTxIdsToReq
forall a. Small a -> a
getSmall (Small NumTxIdsToReq -> NumTxIdsToReq)
-> (Positive (Small NumTxIdsToReq) -> Small NumTxIdsToReq)
-> Positive (Small NumTxIdsToReq)
-> NumTxIdsToReq
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive (Small NumTxIdsToReq) -> Small NumTxIdsToReq
forall a. Positive a -> a
getPositive (Positive (Small NumTxIdsToReq) -> NumTxIdsToReq)
-> Gen (Positive (Small NumTxIdsToReq)) -> Gen NumTxIdsToReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small NumTxIdsToReq))
forall a. Arbitrary a => Gen a
arbitrary)
            Gen
  (SizeInBytes
   -> SizeInBytes
   -> PeerAddr
   -> DiffTime
   -> Double
   -> Double
   -> TxDecisionPolicy)
-> Gen SizeInBytes
-> Gen
     (SizeInBytes
      -> PeerAddr -> DiffTime -> Double -> Double -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> SizeInBytes
SizeInBytes (Word32 -> SizeInBytes)
-> (Positive Word32 -> Word32) -> Positive Word32 -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Word32 -> Word32
forall a. Positive a -> a
getPositive (Positive Word32 -> SizeInBytes)
-> Gen (Positive Word32) -> Gen SizeInBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Word32)
forall a. Arbitrary a => Gen a
arbitrary)
            Gen
  (SizeInBytes
   -> PeerAddr -> DiffTime -> Double -> Double -> TxDecisionPolicy)
-> Gen SizeInBytes
-> Gen
     (PeerAddr -> DiffTime -> Double -> Double -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> SizeInBytes
SizeInBytes (Word32 -> SizeInBytes)
-> (Positive Word32 -> Word32) -> Positive Word32 -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Word32 -> Word32
forall a. Positive a -> a
getPositive (Positive Word32 -> SizeInBytes)
-> Gen (Positive Word32) -> Gen SizeInBytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Word32)
forall a. Arbitrary a => Gen a
arbitrary)
            Gen (PeerAddr -> DiffTime -> Double -> Double -> TxDecisionPolicy)
-> Gen PeerAddr
-> Gen (DiffTime -> Double -> Double -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Small PeerAddr -> PeerAddr
forall a. Small a -> a
getSmall (Small PeerAddr -> PeerAddr)
-> (Positive (Small PeerAddr) -> Small PeerAddr)
-> Positive (Small PeerAddr)
-> PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive (Small PeerAddr) -> Small PeerAddr
forall a. Positive a -> a
getPositive (Positive (Small PeerAddr) -> PeerAddr)
-> Gen (Positive (Small PeerAddr)) -> Gen PeerAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive (Small PeerAddr))
forall a. Arbitrary a => Gen a
arbitrary)
            Gen (DiffTime -> Double -> Double -> TxDecisionPolicy)
-> Gen DiffTime -> Gen (Double -> Double -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Double -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> DiffTime) -> Gen Double -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0 :: Double, Double
2))
            Gen (Double -> Double -> TxDecisionPolicy)
-> Gen Double -> Gen (Double -> TxDecisionPolicy)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1))
            Gen (Double -> TxDecisionPolicy)
-> Gen Double -> Gen TxDecisionPolicy
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1800)))

    shrink :: ArbTxDecisionPolicy -> [ArbTxDecisionPolicy]
shrink (ArbTxDecisionPolicy a :: TxDecisionPolicy
a@TxDecisionPolicy {
              NumTxIdsToReq
maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest :: TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest,
              SizeInBytes
txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer :: TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer,
              SizeInBytes
maxTxsSizeInflight :: SizeInBytes
maxTxsSizeInflight :: TxDecisionPolicy -> SizeInBytes
maxTxsSizeInflight,
              PeerAddr
txInflightMultiplicity :: PeerAddr
txInflightMultiplicity :: TxDecisionPolicy -> PeerAddr
txInflightMultiplicity }) =
      [ TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy TxDecisionPolicy
a { maxNumTxIdsToRequest = NumTxIdsToReq x }
      | (Positive (Small Word16
x)) <- Positive (Small Word16) -> [Positive (Small Word16)]
forall a. Arbitrary a => a -> [a]
shrink (Small Word16 -> Positive (Small Word16)
forall a. a -> Positive a
Positive (Word16 -> Small Word16
forall a. a -> Small a
Small (NumTxIdsToReq -> Word16
getNumTxIdsToReq NumTxIdsToReq
maxNumTxIdsToRequest)))
      ]
      [ArbTxDecisionPolicy]
-> [ArbTxDecisionPolicy] -> [ArbTxDecisionPolicy]
forall a. [a] -> [a] -> [a]
++
      [ TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> (TxDecisionPolicy -> TxDecisionPolicy)
-> TxDecisionPolicy
-> ArbTxDecisionPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy
      (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> TxDecisionPolicy -> ArbTxDecisionPolicy
forall a b. (a -> b) -> a -> b
$ TxDecisionPolicy
a { txsSizeInflightPerPeer = SizeInBytes s }
      | Positive Word32
s <- Positive Word32 -> [Positive Word32]
forall a. Arbitrary a => a -> [a]
shrink (Word32 -> Positive Word32
forall a. a -> Positive a
Positive (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
txsSizeInflightPerPeer))
      ]
      [ArbTxDecisionPolicy]
-> [ArbTxDecisionPolicy] -> [ArbTxDecisionPolicy]
forall a. [a] -> [a] -> [a]
++
      [ TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> (TxDecisionPolicy -> TxDecisionPolicy)
-> TxDecisionPolicy
-> ArbTxDecisionPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy
      (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> TxDecisionPolicy -> ArbTxDecisionPolicy
forall a b. (a -> b) -> a -> b
$ TxDecisionPolicy
a { maxTxsSizeInflight = SizeInBytes s }
      | Positive Word32
s <- Positive Word32 -> [Positive Word32]
forall a. Arbitrary a => a -> [a]
shrink (Word32 -> Positive Word32
forall a. a -> Positive a
Positive (SizeInBytes -> Word32
getSizeInBytes SizeInBytes
maxTxsSizeInflight))
      ]
      [ArbTxDecisionPolicy]
-> [ArbTxDecisionPolicy] -> [ArbTxDecisionPolicy]
forall a. [a] -> [a] -> [a]
++
      [ TxDecisionPolicy -> ArbTxDecisionPolicy
ArbTxDecisionPolicy (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> (TxDecisionPolicy -> TxDecisionPolicy)
-> TxDecisionPolicy
-> ArbTxDecisionPolicy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy
      (TxDecisionPolicy -> ArbTxDecisionPolicy)
-> TxDecisionPolicy -> ArbTxDecisionPolicy
forall a b. (a -> b) -> a -> b
$ TxDecisionPolicy
a { txInflightMultiplicity = x }
      | Positive (Small PeerAddr
x) <- Positive (Small PeerAddr) -> [Positive (Small PeerAddr)]
forall a. Arbitrary a => a -> [a]
shrink (Small PeerAddr -> Positive (Small PeerAddr)
forall a. a -> Positive a
Positive (PeerAddr -> Small PeerAddr
forall a. a -> Small a
Small PeerAddr
txInflightMultiplicity))
      ]


fixupTxDecisionPolicy :: TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy :: TxDecisionPolicy -> TxDecisionPolicy
fixupTxDecisionPolicy a :: TxDecisionPolicy
a@TxDecisionPolicy { SizeInBytes
txsSizeInflightPerPeer :: TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer,
                                           SizeInBytes
maxTxsSizeInflight :: TxDecisionPolicy -> SizeInBytes
maxTxsSizeInflight :: SizeInBytes
maxTxsSizeInflight }
 = TxDecisionPolicy
a { txsSizeInflightPerPeer = txsSizeInflightPerPeer',
       maxTxsSizeInflight     = maxTxsSizeInflight' }
 where
   txsSizeInflightPerPeer' :: SizeInBytes
txsSizeInflightPerPeer' = SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Ord a => a -> a -> a
min SizeInBytes
txsSizeInflightPerPeer SizeInBytes
maxTxsSizeInflight
   maxTxsSizeInflight' :: SizeInBytes
maxTxsSizeInflight'     = SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Ord a => a -> a -> a
max SizeInBytes
txsSizeInflightPerPeer SizeInBytes
maxTxsSizeInflight


prop_splitAcknowledgedTxIds
  :: ArbDecisionContexts TxId
  -> Property
prop_splitAcknowledgedTxIds :: ArbDecisionContexts PeerAddr -> Property
prop_splitAcknowledgedTxIds
    ArbDecisionContexts {
      arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = policy :: TxDecisionPolicy
policy@TxDecisionPolicy { NumTxIdsToReq
maxNumTxIdsToRequest :: TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest,
                                                    NumTxIdsToReq
maxUnacknowledgedTxIds :: NumTxIdsToReq
maxUnacknowledgedTxIds :: TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds },
      arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState  = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
    }
    =
           TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"ackedTxIds <> unackedTxIds ≠ unacknowledgedTxIds ps"
           (StrictSeq PeerAddr
ackedTxIds StrictSeq PeerAddr -> StrictSeq PeerAddr -> StrictSeq PeerAddr
forall a. Semigroup a => a -> a -> a
<> StrictSeq PeerAddr
unackedTxIds StrictSeq PeerAddr -> StrictSeq PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PeerTxState PeerAddr (Tx PeerAddr) -> StrictSeq PeerAddr
forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds PeerTxState PeerAddr (Tx PeerAddr)
ps)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"unackedAndRequested ≰ maxUnacknowledgedTxIds"
           (NumTxIdsToReq
unackedAndRequested NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
<= NumTxIdsToReq
maxUnacknowledgedTxIds)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"requestedTxIdsInflight ps ≰ maxNumTxIdsToRequest"
           (PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
requestedTxIdsInflight PeerTxState PeerAddr (Tx PeerAddr)
ps NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
<= NumTxIdsToReq
maxNumTxIdsToRequest)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"numTxIdsToReq ≰ maxNumTxIdsToRequest - requestedTxIdsInflight ps"
           (NumTxIdsToReq
numTxIdsToReq NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
<= NumTxIdsToReq
maxNumTxIdsToRequest NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Num a => a -> a -> a
- PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
requestedTxIdsInflight PeerTxState PeerAddr (Tx PeerAddr)
ps)
      Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"numTxIdsToReq ≰ maxUnacknowledgedTxIds - unackedAndRequested + fromIntegral numOfAckedTxIds"
           (NumTxIdsToReq
numTxIdsToReq NumTxIdsToReq -> NumTxIdsToReq -> Bool
forall a. Ord a => a -> a -> Bool
<= NumTxIdsToReq
maxUnacknowledgedTxIds NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Num a => a -> a -> a
- NumTxIdsToReq
unackedAndRequested NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Num a => a -> a -> a
+ PeerAddr -> NumTxIdsToReq
forall a b. (Integral a, Num b) => a -> b
fromIntegral PeerAddr
numOfAckedTxIds)
  where
    ps :: PeerTxState PeerAddr (Tx PeerAddr)
ps = case Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> [PeerTxState PeerAddr (Tx PeerAddr)]
forall k a. Map k a -> [a]
Map.elems (Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
 -> [PeerTxState PeerAddr (Tx PeerAddr)])
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> [PeerTxState PeerAddr (Tx PeerAddr)]
forall a b. (a -> b) -> a -> b
$ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
TXS.peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st of
      PeerTxState PeerAddr (Tx PeerAddr)
a : [PeerTxState PeerAddr (Tx PeerAddr)]
_ -> PeerTxState PeerAddr (Tx PeerAddr)
a
      []    -> TestName -> PeerTxState PeerAddr (Tx PeerAddr)
forall a. HasCallStack => TestName -> a
error TestName
"generator invariant violation: empty peerTxStates map"
    (NumTxIdsToReq
numTxIdsToReq, StrictSeq PeerAddr
ackedTxIds, StrictSeq PeerAddr
unackedTxIds)
      = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> (NumTxIdsToReq, StrictSeq PeerAddr, StrictSeq PeerAddr)
forall txid peer tx.
(Ord txid, HasCallStack) =>
TxDecisionPolicy
-> SharedTxState peer txid tx
-> PeerTxState txid tx
-> (NumTxIdsToReq, StrictSeq txid, StrictSeq txid)
TXS.splitAcknowledgedTxIds TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st PeerTxState PeerAddr (Tx PeerAddr)
ps
    numOfAckedTxIds :: PeerAddr
numOfAckedTxIds     = StrictSeq PeerAddr -> PeerAddr
forall a. StrictSeq a -> PeerAddr
StrictSeq.length StrictSeq PeerAddr
ackedTxIds
    numOfUnackedTxIds :: PeerAddr
numOfUnackedTxIds   = StrictSeq PeerAddr -> PeerAddr
forall a. StrictSeq a -> PeerAddr
StrictSeq.length StrictSeq PeerAddr
unackedTxIds
    unackedAndRequested :: NumTxIdsToReq
unackedAndRequested = PeerAddr -> NumTxIdsToReq
forall a b. (Integral a, Num b) => a -> b
fromIntegral PeerAddr
numOfUnackedTxIds NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Num a => a -> a -> a
+ PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
requestedTxIdsInflight PeerTxState PeerAddr (Tx PeerAddr)
ps


data ArbDecisionContexts txid = ArbDecisionContexts {
    forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy :: TxDecisionPolicy,

    forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    :: SharedTxState PeerAddr txid (Tx txid),

    forall txid. ArbDecisionContexts txid -> Fun txid Bool
arbMempoolHasTx   :: Fun txid Bool
    -- ^ needed just for shrinking
  }

instance Show txid => Show (ArbDecisionContexts txid) where
  show :: ArbDecisionContexts txid -> TestName
show ArbDecisionContexts {
      TxDecisionPolicy
arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy :: TxDecisionPolicy
arbDecisionPolicy,
      arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState = SharedTxState PeerAddr txid (Tx txid)
st,
      Fun txid Bool
arbMempoolHasTx :: forall txid. ArbDecisionContexts txid -> Fun txid Bool
arbMempoolHasTx :: Fun txid Bool
arbMempoolHasTx
    }
    =
    TestName -> Context -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
"\n\t"
    [ TestName
"ArbDecisionContext"
    , TxDecisionPolicy -> TestName
forall a. Show a => a -> TestName
show TxDecisionPolicy
arbDecisionPolicy
    , SharedTxState PeerAddr txid (Tx txid) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr txid (Tx txid)
st
    , Fun txid Bool -> TestName
forall a. Show a => a -> TestName
show Fun txid Bool
arbMempoolHasTx
    ]

-- | Fix-up `PeerTxState` according to `TxDecisionPolicy`.
--
fixupPeerTxStateWithPolicy :: Ord txid
                           => TxDecisionPolicy
                           -> PeerTxState txid tx
                           -> PeerTxState txid tx
fixupPeerTxStateWithPolicy :: forall txid tx.
Ord txid =>
TxDecisionPolicy -> PeerTxState txid tx -> PeerTxState txid tx
fixupPeerTxStateWithPolicy
    TxDecisionPolicy { NumTxIdsToReq
maxUnacknowledgedTxIds :: TxDecisionPolicy -> NumTxIdsToReq
maxUnacknowledgedTxIds :: NumTxIdsToReq
maxUnacknowledgedTxIds,
                       NumTxIdsToReq
maxNumTxIdsToRequest :: TxDecisionPolicy -> NumTxIdsToReq
maxNumTxIdsToRequest :: NumTxIdsToReq
maxNumTxIdsToRequest }
    ps :: PeerTxState txid tx
ps@PeerTxState { StrictSeq txid
unacknowledgedTxIds :: forall txid tx. PeerTxState txid tx -> StrictSeq txid
unacknowledgedTxIds :: StrictSeq txid
unacknowledgedTxIds,
                     Map txid SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map txid SizeInBytes
availableTxIds,
                     Set txid
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set txid
requestedTxsInflight,
                     NumTxIdsToReq
requestedTxIdsInflight :: forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
requestedTxIdsInflight :: NumTxIdsToReq
requestedTxIdsInflight,
                     Set txid
unknownTxs :: forall txid tx. PeerTxState txid tx -> Set txid
unknownTxs :: Set txid
unknownTxs
                   }
    =
    PeerTxState txid tx
ps { unacknowledgedTxIds    = unacknowledgedTxIds',
         availableTxIds         = availableTxIds',
         requestedTxsInflight   = requestedTxsInflight',
         requestedTxIdsInflight = requestedTxIdsInflight',
         unknownTxs             = unknownTxs'
       }
  where
    -- limit the number of unacknowledged txids, and then fix-up all the other
    -- sets.
    unacknowledgedTxIds' :: StrictSeq txid
unacknowledgedTxIds'    = PeerAddr -> StrictSeq txid -> StrictSeq txid
forall a. PeerAddr -> StrictSeq a -> StrictSeq a
StrictSeq.take (NumTxIdsToReq -> PeerAddr
forall a b. (Integral a, Num b) => a -> b
fromIntegral NumTxIdsToReq
maxUnacknowledgedTxIds)
                                             StrictSeq txid
unacknowledgedTxIds
    unackedSet :: Set txid
unackedSet              = [txid] -> Set txid
forall a. Ord a => [a] -> Set a
Set.fromList (StrictSeq txid -> [txid]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq txid
unacknowledgedTxIds')
    availableTxIds' :: Map txid SizeInBytes
availableTxIds'         = Map txid SizeInBytes
availableTxIds Map txid SizeInBytes -> Set txid -> Map txid SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set txid
unackedSet
    requestedTxsInflight' :: Set txid
requestedTxsInflight'   = Set txid
requestedTxsInflight Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set txid
unackedSet
    -- requestedTxIdsInflight must be smaller than `maxNumTxIdsToRequest, and
    -- also `requestedTxIdsInflight` and the number of `unacknowledgedTxIds'`
    -- must be smaller or equal to `maxUnacknowledgedTxIds`.
    requestedTxIdsInflight' :: NumTxIdsToReq
requestedTxIdsInflight' = NumTxIdsToReq
requestedTxIdsInflight
                              NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Ord a => a -> a -> a
`min` NumTxIdsToReq
maxNumTxIdsToRequest
                              NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Ord a => a -> a -> a
`min` (NumTxIdsToReq
maxUnacknowledgedTxIds NumTxIdsToReq -> NumTxIdsToReq -> NumTxIdsToReq
forall a. Num a => a -> a -> a
- PeerAddr -> NumTxIdsToReq
forall a b. (Integral a, Num b) => a -> b
fromIntegral (StrictSeq txid -> PeerAddr
forall a. StrictSeq a -> PeerAddr
StrictSeq.length StrictSeq txid
unacknowledgedTxIds'))
    unknownTxs' :: Set txid
unknownTxs'             = Set txid
unknownTxs Set txid -> Set txid -> Set txid
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set txid
unackedSet



-- | Fix-up `SharedTxState` so it satisfies `TxDecisionPolicy`.
--
fixupSharedTxStateForPolicy
  :: forall peeraddr txid tx.
     Ord txid
  => (txid -> Bool) -- ^ mempoolHasTx
  -> TxDecisionPolicy
  -> SharedTxState peeraddr txid tx
  -> SharedTxState peeraddr txid tx
fixupSharedTxStateForPolicy :: forall peeraddr txid tx.
Ord txid =>
(txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
fixupSharedTxStateForPolicy
    txid -> Bool
mempoolHasTx
    policy :: TxDecisionPolicy
policy@TxDecisionPolicy {
      SizeInBytes
txsSizeInflightPerPeer :: TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer,
      SizeInBytes
maxTxsSizeInflight :: TxDecisionPolicy -> SizeInBytes
maxTxsSizeInflight :: SizeInBytes
maxTxsSizeInflight,
      PeerAddr
txInflightMultiplicity :: TxDecisionPolicy -> PeerAddr
txInflightMultiplicity :: PeerAddr
txInflightMultiplicity
    }
    st :: SharedTxState peeraddr txid tx
st@SharedTxState { Map peeraddr (PeerTxState txid tx)
peerTxStates :: forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates :: Map peeraddr (PeerTxState txid tx)
peerTxStates }
    =
    (txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
forall txid peeraddr tx.
Ord txid =>
(txid -> Bool)
-> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx
fixupSharedTxState
      txid -> Bool
mempoolHasTx
      SharedTxState peeraddr txid tx
st { peerTxStates = snd . mapAccumR fn (0, Map.empty) $ peerTxStates }
  where
    -- fixup `PeerTxState` and accumulate size of all `tx`'s in-flight across
    -- all peers.
    fn :: (SizeInBytes, Map txid Int)
       -> PeerTxState txid tx
       -> ((SizeInBytes, Map txid Int), PeerTxState txid tx)
    fn :: (SizeInBytes, Map txid PeerAddr)
-> PeerTxState txid tx
-> ((SizeInBytes, Map txid PeerAddr), PeerTxState txid tx)
fn
        (SizeInBytes
sizeInflightAll, Map txid PeerAddr
inflightMap)
        PeerTxState txid tx
ps
        =
        ( ( SizeInBytes
sizeInflightAll SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
requestedTxsInflightSize'
          , Map txid PeerAddr
inflightMap'
          )
        , PeerTxState txid tx
ps' { requestedTxsInflight     = requestedTxsInflight',
                requestedTxsInflightSize = requestedTxsInflightSize'
              }
        )
      where
        ps' :: PeerTxState txid tx
ps' = TxDecisionPolicy -> PeerTxState txid tx -> PeerTxState txid tx
forall txid tx.
Ord txid =>
TxDecisionPolicy -> PeerTxState txid tx -> PeerTxState txid tx
fixupPeerTxStateWithPolicy TxDecisionPolicy
policy PeerTxState txid tx
ps

        (SizeInBytes
requestedTxsInflightSize', Set txid
requestedTxsInflight', Map txid PeerAddr
inflightMap') =
          (txid
 -> SizeInBytes
 -> (SizeInBytes, Set txid, Map txid PeerAddr)
 -> (SizeInBytes, Set txid, Map txid PeerAddr))
-> (SizeInBytes, Set txid, Map txid PeerAddr)
-> Map txid SizeInBytes
-> (SizeInBytes, Set txid, Map txid PeerAddr)
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
            (\txid
txid SizeInBytes
txSize r :: (SizeInBytes, Set txid, Map txid PeerAddr)
r@(!SizeInBytes
inflightSize, !Set txid
inflightSet, !Map txid PeerAddr
inflight) ->
              let (PeerAddr
multiplicity, Map txid PeerAddr
inflight') =
                    (Maybe PeerAddr -> (PeerAddr, Maybe PeerAddr))
-> txid -> Map txid PeerAddr -> (PeerAddr, Map txid PeerAddr)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
                      (\case
                          Maybe PeerAddr
Nothing -> (PeerAddr
1, PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just PeerAddr
1)
                          Just PeerAddr
x  -> let x' :: PeerAddr
x' = PeerAddr
x PeerAddr -> PeerAddr -> PeerAddr
forall a. Num a => a -> a -> a
+ PeerAddr
1 in (PeerAddr
x',  PeerAddr -> Maybe PeerAddr
forall a. a -> Maybe a
Just (PeerAddr -> Maybe PeerAddr) -> PeerAddr -> Maybe PeerAddr
forall a b. (a -> b) -> a -> b
$! PeerAddr
x'))
                      txid
txid Map txid PeerAddr
inflight
              in if SizeInBytes
inflightSize SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= SizeInBytes
txsSizeInflightPerPeer
                 Bool -> Bool -> Bool
&& SizeInBytes
sizeInflightAll SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
inflightSize SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= SizeInBytes
maxTxsSizeInflight
                 Bool -> Bool -> Bool
&& PeerAddr
multiplicity PeerAddr -> PeerAddr -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerAddr
txInflightMultiplicity
                then (SizeInBytes
txSize SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
inflightSize, txid -> Set txid -> Set txid
forall a. Ord a => a -> Set a -> Set a
Set.insert txid
txid Set txid
inflightSet, Map txid PeerAddr
inflight')
                else (SizeInBytes, Set txid, Map txid PeerAddr)
r
            )
            (SizeInBytes
0, Set txid
forall a. Set a
Set.empty, Map txid PeerAddr
inflightMap)
            (PeerTxState txid tx -> Map txid SizeInBytes
forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds PeerTxState txid tx
ps' Map txid SizeInBytes -> Set txid -> Map txid SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` PeerTxState txid tx -> Set txid
forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight PeerTxState txid tx
ps')

instance (Arbitrary txid, Ord txid, Function txid, CoArbitrary txid)
      => Arbitrary (ArbDecisionContexts txid) where

    arbitrary :: Gen (ArbDecisionContexts txid)
arbitrary = do
      ArbTxDecisionPolicy policy <- Gen ArbTxDecisionPolicy
forall a. Arbitrary a => Gen a
arbitrary
      (mempoolHasTx, _ps, st, _) <-
        genSharedTxState (fromIntegral $ maxNumTxIdsToRequest policy)
      let st' = (txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState PeerAddr txid (Tx txid)
-> SharedTxState PeerAddr txid (Tx txid)
forall peeraddr txid tx.
Ord txid =>
(txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
fixupSharedTxStateForPolicy
                  (Fun txid Bool -> txid -> Bool
forall a b. Fun a b -> a -> b
apply Fun txid Bool
mempoolHasTx) TxDecisionPolicy
policy SharedTxState PeerAddr txid (Tx txid)
st

      return $ ArbDecisionContexts {
          arbDecisionPolicy    = policy,
          arbMempoolHasTx      = mempoolHasTx,
          arbSharedState       = st'
        }

    shrink :: ArbDecisionContexts txid -> [ArbDecisionContexts txid]
shrink a :: ArbDecisionContexts txid
a@ArbDecisionContexts {
               arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
               arbMempoolHasTx :: forall txid. ArbDecisionContexts txid -> Fun txid Bool
arbMempoolHasTx   = Fun txid Bool
mempoolHasTx,
               arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr txid (Tx txid)
sharedState
             } =
        -- shrink shared state
        [ ArbDecisionContexts txid
a { arbSharedState = sharedState'' }
        | SharedTxState PeerAddr txid (Tx txid)
sharedState' <- (txid -> Bool)
-> SharedTxState PeerAddr txid (Tx txid)
-> [SharedTxState PeerAddr txid (Tx txid)]
forall txid peeraddr.
(Arbitrary txid, Ord txid, Function txid, Ord peeraddr) =>
(txid -> Bool)
-> SharedTxState peeraddr txid (Tx txid)
-> [SharedTxState peeraddr txid (Tx txid)]
shrinkSharedTxState (Fun txid Bool -> txid -> Bool
forall a b. Fun a b -> a -> b
apply Fun txid Bool
mempoolHasTx) SharedTxState PeerAddr txid (Tx txid)
sharedState
        , let sharedState'' :: SharedTxState PeerAddr txid (Tx txid)
sharedState'' = (txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState PeerAddr txid (Tx txid)
-> SharedTxState PeerAddr txid (Tx txid)
forall peeraddr txid tx.
Ord txid =>
(txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
fixupSharedTxStateForPolicy
                                (Fun txid Bool -> txid -> Bool
forall a b. Fun a b -> a -> b
apply Fun txid Bool
mempoolHasTx) TxDecisionPolicy
policy SharedTxState PeerAddr txid (Tx txid)
sharedState'
        , SharedTxState PeerAddr txid (Tx txid)
sharedState'' SharedTxState PeerAddr txid (Tx txid)
-> SharedTxState PeerAddr txid (Tx txid) -> Bool
forall a. Eq a => a -> a -> Bool
/= SharedTxState PeerAddr txid (Tx txid)
sharedState
        ]


prop_ArbDecisionContexts_generator
  :: ArbDecisionContexts TxId
  -> Property
prop_ArbDecisionContexts_generator :: ArbDecisionContexts PeerAddr -> Property
prop_ArbDecisionContexts_generator
  ArbDecisionContexts { arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st }
  =
  -- whenFail (pPrint a) $
  InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st


prop_ArbDecisionContexts_shrinker
  :: ArbDecisionContexts TxId
  -> Every
prop_ArbDecisionContexts_shrinker :: ArbDecisionContexts PeerAddr -> Every
prop_ArbDecisionContexts_shrinker
  ArbDecisionContexts PeerAddr
ctx
  =
  (ArbDecisionContexts PeerAddr -> Every)
-> [ArbDecisionContexts PeerAddr] -> Every
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ArbDecisionContexts PeerAddr
a ->
            Property -> Every
forall p. Testable p => p -> Every
Every
          (Property -> Every)
-> (ArbDecisionContexts PeerAddr -> Property)
-> ArbDecisionContexts PeerAddr
-> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (ArbDecisionContexts PeerAddr -> TestName
forall a. Show a => a -> TestName
show ArbDecisionContexts PeerAddr
a)
          (Property -> Property)
-> (ArbDecisionContexts PeerAddr -> Property)
-> ArbDecisionContexts PeerAddr
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant
          (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property)
-> (ArbDecisionContexts PeerAddr
    -> SharedTxState PeerAddr PeerAddr (Tx PeerAddr))
-> ArbDecisionContexts PeerAddr
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArbDecisionContexts PeerAddr
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState
          (ArbDecisionContexts PeerAddr -> Every)
-> ArbDecisionContexts PeerAddr -> Every
forall a b. (a -> b) -> a -> b
$ ArbDecisionContexts PeerAddr
a)
        ([ArbDecisionContexts PeerAddr] -> Every)
-> [ArbDecisionContexts PeerAddr] -> Every
forall a b. (a -> b) -> a -> b
$ ArbDecisionContexts PeerAddr -> [ArbDecisionContexts PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink ArbDecisionContexts PeerAddr
ctx


-- | Verify that `makeDecisions` preserves the `SharedTxState` invariant.
--
prop_makeDecisions_sharedstate
  :: ArbDecisionContexts TxId
  -> Property
prop_makeDecisions_sharedstate :: ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_sharedstate
    ArbDecisionContexts { arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
                          arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState } =
    let (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState, Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions) = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)
    in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState)
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions)
     (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ InvariantStrength
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> Property
forall peeraddr txid tx.
(Ord txid, Show txid, Show tx) =>
InvariantStrength -> SharedTxState peeraddr txid tx -> Property
sharedTxStateInvariant InvariantStrength
StrongInvariant SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState


-- | Verify that `makeDecisions`:
--
-- * modifies `inflightTxs` map by adding `tx`s which are inflight;
-- * updates `requestedTxsInflightSize` correctly;
-- * in-flight `tx`s set is disjoint with `bufferedTxs`;
-- * requested `tx`s are coming from `availableTxIds`.
--
prop_makeDecisions_inflight
  :: ArbDecisionContexts TxId
  -> Property
prop_makeDecisions_inflight :: ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_inflight
    ArbDecisionContexts {
      arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
      arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState
    }
    =
    let (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState', Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions) = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)

        inflightSet :: Set TxId
        inflightSet :: Set PeerAddr
inflightSet = (TxDecision PeerAddr (Tx PeerAddr) -> Set PeerAddr)
-> Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> Set PeerAddr
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map PeerAddr SizeInBytes -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (Map PeerAddr SizeInBytes -> Set PeerAddr)
-> (TxDecision PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes)
-> TxDecision PeerAddr (Tx PeerAddr)
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxDecision PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes
forall txid tx. TxDecision txid tx -> Map txid SizeInBytes
txdTxsToRequest) Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions

        inflightSize :: Map PeerAddr SizeInBytes
        inflightSize :: Map PeerAddr SizeInBytes
inflightSize = (PeerAddr
 -> TxDecision PeerAddr (Tx PeerAddr)
 -> Map PeerAddr SizeInBytes
 -> Map PeerAddr SizeInBytes)
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
-> Map PeerAddr SizeInBytes
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey
                        (\PeerAddr
peer TxDecision { Map PeerAddr SizeInBytes
txdTxsToRequest :: forall txid tx. TxDecision txid tx -> Map txid SizeInBytes
txdTxsToRequest :: Map PeerAddr SizeInBytes
txdTxsToRequest } Map PeerAddr SizeInBytes
m ->
                          PeerAddr
-> SizeInBytes
-> Map PeerAddr SizeInBytes
-> Map PeerAddr SizeInBytes
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PeerAddr
peer
                            ((PeerAddr -> SizeInBytes) -> Set PeerAddr -> SizeInBytes
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\PeerAddr
txid -> SizeInBytes -> Maybe SizeInBytes -> SizeInBytes
forall a. a -> Maybe a -> a
fromMaybe SizeInBytes
0 (Maybe SizeInBytes -> SizeInBytes)
-> Maybe SizeInBytes -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ PeerAddr
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Maybe (PeerTxState PeerAddr (Tx PeerAddr))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
peer (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)
                                                         Maybe (PeerTxState PeerAddr (Tx PeerAddr))
-> (PeerTxState PeerAddr (Tx PeerAddr) -> Maybe SizeInBytes)
-> Maybe SizeInBytes
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PeerAddr -> Map PeerAddr SizeInBytes -> Maybe SizeInBytes
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
txid (Map PeerAddr SizeInBytes -> Maybe SizeInBytes)
-> (PeerTxState PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> Maybe SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes
forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds)
                                     (Map PeerAddr SizeInBytes -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr SizeInBytes
txdTxsToRequest))
                            Map PeerAddr SizeInBytes
m
                        ) Map PeerAddr SizeInBytes
forall k a. Map k a
Map.empty Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions

        bufferedSet :: Set TxId
        bufferedSet :: Set PeerAddr
bufferedSet = Map PeerAddr (Maybe (Tx PeerAddr)) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (Maybe (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)
    in
        TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState') (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        -- 'inflightTxs' set is increased by exactly the requested txs
        TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Context -> TestName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                          [ Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show Set PeerAddr
inflightSet
                          , TestName
" not a subset of "
                          , Map PeerAddr PeerAddr -> TestName
forall a. Show a => a -> TestName
show (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr PeerAddr
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')
                          ])
                       ( Set PeerAddr
inflightSet Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> Map PeerAddr PeerAddr -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr PeerAddr
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')
                         Set PeerAddr -> Set PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
                         Map PeerAddr PeerAddr -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr PeerAddr
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')
                       )

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.

        -- for each peer size in flight is equal to the original size in flight
        -- plus size of all requested txs
        Every -> Property
forall prop. Testable prop => prop -> Property
property
          (Map PeerAddr Every -> Every
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            (SimpleWhenMissing PeerAddr SizeInBytes Every
-> SimpleWhenMissing
     PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) Every
-> SimpleWhenMatched
     PeerAddr SizeInBytes (PeerTxState PeerAddr (Tx PeerAddr)) Every
-> Map PeerAddr SizeInBytes
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Map PeerAddr Every
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
Map.merge
              ((PeerAddr -> SizeInBytes -> Maybe Every)
-> SimpleWhenMissing PeerAddr SizeInBytes Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing
                (\PeerAddr
peer SizeInBytes
a ->
                  Every -> Maybe Every
forall a. a -> Maybe a
Just ( Property -> Every
forall p. Testable p => p -> Every
Every
                       (Property -> Every) -> (Property -> Property) -> Property -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
                           (TestName
"missing peer in requestedTxsInflightSize: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
peer)
                       (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$ (SizeInBytes
a SizeInBytes -> SizeInBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SizeInBytes
0))))
              ((PeerAddr -> PeerTxState PeerAddr (Tx PeerAddr) -> Maybe Every)
-> SimpleWhenMissing
     PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> Maybe y) -> WhenMissing f k x y
Map.mapMaybeMissing (\PeerAddr
_ PeerTxState PeerAddr (Tx PeerAddr)
_ -> Maybe Every
forall a. Maybe a
Nothing))
              ((PeerAddr
 -> SizeInBytes
 -> PeerTxState PeerAddr (Tx PeerAddr)
 -> Maybe Every)
-> SimpleWhenMatched
     PeerAddr SizeInBytes (PeerTxState PeerAddr (Tx PeerAddr)) Every
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched
                (\PeerAddr
peer SizeInBytes
delta PeerTxState { SizeInBytes
requestedTxsInflightSize :: forall txid tx. PeerTxState txid tx -> SizeInBytes
requestedTxsInflightSize :: SizeInBytes
requestedTxsInflightSize } ->
                  let original :: SizeInBytes
original =
                        case PeerAddr
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Maybe (PeerTxState PeerAddr (Tx PeerAddr))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
peer (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState) of
                          Maybe (PeerTxState PeerAddr (Tx PeerAddr))
Nothing                                           -> SizeInBytes
0
                          Just PeerTxState { requestedTxsInflightSize :: forall txid tx. PeerTxState txid tx -> SizeInBytes
requestedTxsInflightSize = SizeInBytes
a } -> SizeInBytes
a
                  in Every -> Maybe Every
forall a. a -> Maybe a
Just ( Property -> Every
forall p. Testable p => p -> Every
Every
                          (Property -> Every) -> (Property -> Property) -> Property -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
peer)
                          (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$ SizeInBytes
original SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
delta
                            SizeInBytes -> SizeInBytes -> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
                            SizeInBytes
requestedTxsInflightSize
                          )
                ))
              Map PeerAddr SizeInBytes
inflightSize
              (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')))

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"requested txs must not be buffered: "
                         TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show (Set PeerAddr
inflightSet Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set PeerAddr
bufferedSet))
         (Set PeerAddr
inflightSet Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.disjoint` Set PeerAddr
bufferedSet)

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TestName -> Every -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"requested txs must be available"
         ( Map PeerAddr Every -> Every
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map PeerAddr Every -> Every) -> Map PeerAddr Every -> Every
forall a b. (a -> b) -> a -> b
$
           SimpleWhenMissing PeerAddr (Set PeerAddr) Every
-> SimpleWhenMissing PeerAddr (Set PeerAddr) Every
-> SimpleWhenMatched PeerAddr (Set PeerAddr) (Set PeerAddr) Every
-> Map PeerAddr (Set PeerAddr)
-> Map PeerAddr (Set PeerAddr)
-> Map PeerAddr Every
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
Map.merge
             ((PeerAddr -> Set PeerAddr -> Every)
-> SimpleWhenMissing PeerAddr (Set PeerAddr) Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PeerAddr
peeraddr Set PeerAddr
_ ->
                               Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$
                               TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"peer missing in peerTxStates " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
peeraddr)
                               Bool
False))
             ((PeerAddr -> Set PeerAddr -> Every)
-> SimpleWhenMissing PeerAddr (Set PeerAddr) Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PeerAddr
_ Set PeerAddr
_ -> Bool -> Every
forall p. Testable p => p -> Every
Every Bool
True))
             ((PeerAddr -> Set PeerAddr -> Set PeerAddr -> Every)
-> SimpleWhenMatched PeerAddr (Set PeerAddr) (Set PeerAddr) Every
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\PeerAddr
peeraddr Set PeerAddr
a Set PeerAddr
b -> Property -> Every
forall p. Testable p => p -> Every
Every
                                                 (Property -> Every) -> (Bool -> Property) -> Bool -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
peeraddr)
                                                 (Bool -> Every) -> Bool -> Every
forall a b. (a -> b) -> a -> b
$ Set PeerAddr
a Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
b))
             -- map of requested txs
             ([(PeerAddr, Set PeerAddr)] -> Map PeerAddr (Set PeerAddr)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (PeerAddr
peeraddr, Map PeerAddr SizeInBytes -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr SizeInBytes
txids)
                           | (PeerAddr
peeraddr, TxDecision { txdTxsToRequest :: forall txid tx. TxDecision txid tx -> Map txid SizeInBytes
txdTxsToRequest = Map PeerAddr SizeInBytes
txids })
                             <- Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
-> [(PeerAddr, TxDecision PeerAddr (Tx PeerAddr))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions
                           ])
             -- map of available txs
             ((PeerTxState PeerAddr (Tx PeerAddr) -> Set PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Map PeerAddr (Set PeerAddr)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Map PeerAddr SizeInBytes -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet (Map PeerAddr SizeInBytes -> Set PeerAddr)
-> (PeerTxState PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState PeerAddr (Tx PeerAddr) -> Map PeerAddr SizeInBytes
forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds)
                      (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)))


-- | Verify that `makeTxDecisions` obeys `TxDecisionPolicy`.
--
prop_makeDecisions_policy
  :: ArbDecisionContexts TxId
  -> Property
prop_makeDecisions_policy :: ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_policy
    ArbDecisionContexts {
      arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = policy :: TxDecisionPolicy
policy@TxDecisionPolicy { SizeInBytes
maxTxsSizeInflight :: TxDecisionPolicy -> SizeInBytes
maxTxsSizeInflight :: SizeInBytes
maxTxsSizeInflight,
                                                    SizeInBytes
txsSizeInflightPerPeer :: TxDecisionPolicy -> SizeInBytes
txsSizeInflightPerPeer :: SizeInBytes
txsSizeInflightPerPeer,
                                                    PeerAddr
txInflightMultiplicity :: TxDecisionPolicy -> PeerAddr
txInflightMultiplicity :: PeerAddr
txInflightMultiplicity },
      arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState
    } =
    let (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState', Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
_decisions) = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)
        maxTxsSizeInflightEff :: SizeInBytes
maxTxsSizeInflightEff      = SizeInBytes
maxTxsSizeInflight SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
maxTxSize
        txsSizeInflightPerPeerEff :: SizeInBytes
txsSizeInflightPerPeerEff  = SizeInBytes
txsSizeInflightPerPeer SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
maxTxSize

        sizeInflight :: SizeInBytes
sizeInflight =
          (PeerTxState PeerAddr (Tx PeerAddr) -> SizeInBytes)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) -> SizeInBytes
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\PeerTxState { Map PeerAddr SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map PeerAddr SizeInBytes
availableTxIds, Set PeerAddr
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set PeerAddr
requestedTxsInflight } ->
                     Map PeerAddr SizeInBytes -> SizeInBytes
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
requestedTxsInflight))
                  (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')

    in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState') (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

         -- size of txs inflight cannot exceed `maxTxsSizeInflight` by more
         -- than maximal tx size.
         TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"txs inflight exceed limit " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ (SizeInBytes, SizeInBytes) -> TestName
forall a. Show a => a -> TestName
show (SizeInBytes
sizeInflight, SizeInBytes
maxTxsSizeInflightEff))
         (SizeInBytes
sizeInflight SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= SizeInBytes
maxTxsSizeInflightEff)
    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
         -- size in flight for each peer cannot exceed `txsSizeInflightPerPeer`
         TestName -> Every -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"size in flight per peer vaiolation" (
           (PeerTxState PeerAddr (Tx PeerAddr) -> Every)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) -> Every
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
             (\PeerTxState { Map PeerAddr SizeInBytes
availableTxIds :: forall txid tx. PeerTxState txid tx -> Map txid SizeInBytes
availableTxIds :: Map PeerAddr SizeInBytes
availableTxIds, Set PeerAddr
requestedTxsInflight :: forall txid tx. PeerTxState txid tx -> Set txid
requestedTxsInflight :: Set PeerAddr
requestedTxsInflight } ->
               let inflight :: SizeInBytes
inflight = Map PeerAddr SizeInBytes -> SizeInBytes
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map PeerAddr SizeInBytes
availableTxIds Map PeerAddr SizeInBytes
-> Set PeerAddr -> Map PeerAddr SizeInBytes
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set PeerAddr
requestedTxsInflight)
               in Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ((SizeInBytes, SizeInBytes) -> TestName
forall a. Show a => a -> TestName
show (SizeInBytes
inflight, SizeInBytes
txsSizeInflightPerPeerEff)) (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
                 SizeInBytes
inflight
                 SizeInBytes -> SizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<=
                 SizeInBytes
txsSizeInflightPerPeerEff
             )
             (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState')
         )

    Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
         (
         -- none of the multiplicities should go above the
         -- `txInflightMultiplicity`
         let inflight :: Map PeerAddr PeerAddr
inflight = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr PeerAddr
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid PeerAddr
inflightTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedState'
         in
              TestName -> Every -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"multiplicities violation: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr PeerAddr -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr PeerAddr
inflight)
            (Every -> Property)
-> (Map PeerAddr PeerAddr -> Every)
-> Map PeerAddr PeerAddr
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerAddr -> Every) -> Map PeerAddr PeerAddr -> Every
forall m a. Monoid m => (a -> m) -> Map PeerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool -> Every
forall p. Testable p => p -> Every
Every (Bool -> Every) -> (PeerAddr -> Bool) -> PeerAddr -> Every
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerAddr -> PeerAddr -> Bool
forall a. Ord a => a -> a -> Bool
<= PeerAddr
txInflightMultiplicity))
            (Map PeerAddr PeerAddr -> Property)
-> Map PeerAddr PeerAddr -> Property
forall a b. (a -> b) -> a -> b
$ Map PeerAddr PeerAddr
inflight
         )


-- | Verify that `makeDecisions` and `acknowledgeTxIds` are compatible.
--
prop_makeDecisions_acknowledged
  :: ArbDecisionContexts TxId
  -> Property
prop_makeDecisions_acknowledged :: ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_acknowledged
    ArbDecisionContexts { arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
                          arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState
                        } =
    IO () -> Property -> Property
forall prop. Testable prop => IO () -> prop -> Property
whenFail (CheckColorTty
-> OutputOptions
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt CheckColorTty
CheckColorTty OutputOptions
defaultOutputOptionsDarkBg { outputOptionsCompact = True } SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    let (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
_, Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions) = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)

        ackFromDecisions :: Map PeerAddr NumTxIdsToAck
        ackFromDecisions :: Map PeerAddr NumTxIdsToAck
ackFromDecisions = [(PeerAddr, NumTxIdsToAck)] -> Map PeerAddr NumTxIdsToAck
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                         [ (PeerAddr
peer, NumTxIdsToAck
txdTxIdsToAcknowledge)
                         | (PeerAddr
peer, TxDecision { NumTxIdsToAck
txdTxIdsToAcknowledge :: NumTxIdsToAck
txdTxIdsToAcknowledge :: forall txid tx. TxDecision txid tx -> NumTxIdsToAck
txdTxIdsToAcknowledge })
                           <- Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
-> [(PeerAddr, TxDecision PeerAddr (Tx PeerAddr))]
forall k a. Map k a -> [(k, a)]
Map.assocs Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions
                         ]

        ackFromState :: Map PeerAddr NumTxIdsToAck
        ackFromState :: Map PeerAddr NumTxIdsToAck
ackFromState =
            (PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToAck)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> Map PeerAddr NumTxIdsToAck
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\PeerTxState PeerAddr (Tx PeerAddr)
ps -> case TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> (NumTxIdsToAck, NumTxIdsToReq,
    TxsToMempool PeerAddr (Tx PeerAddr), RefCountDiff PeerAddr,
    PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr tx txid.
(Ord txid, HasCallStack) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> PeerTxState txid tx
-> (NumTxIdsToAck, NumTxIdsToReq, TxsToMempool txid tx,
    RefCountDiff txid, PeerTxState txid tx)
TXS.acknowledgeTxIds TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState PeerTxState PeerAddr (Tx PeerAddr)
ps of
                              (NumTxIdsToAck
a, NumTxIdsToReq
_, TxsToMempool PeerAddr (Tx PeerAddr)
_, RefCountDiff PeerAddr
_, PeerTxState PeerAddr (Tx PeerAddr)
_) -> NumTxIdsToAck
a)
          (Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
 -> Map PeerAddr NumTxIdsToAck)
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
    -> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)))
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr NumTxIdsToAck
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates
          (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
 -> Map PeerAddr NumTxIdsToAck)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr NumTxIdsToAck
forall a b. (a -> b) -> a -> b
$ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState

    in TestName -> Every -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ((Map PeerAddr NumTxIdsToAck, Map PeerAddr NumTxIdsToAck)
-> TestName
forall a. Show a => a -> TestName
show (Map PeerAddr NumTxIdsToAck
ackFromDecisions, Map PeerAddr NumTxIdsToAck
ackFromState))
     (Every -> Property)
-> (Map PeerAddr Every -> Every) -> Map PeerAddr Every -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map PeerAddr Every -> Every
forall m. Monoid m => Map PeerAddr m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
     (Map PeerAddr Every -> Property) -> Map PeerAddr Every -> Property
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing PeerAddr NumTxIdsToAck Every
-> SimpleWhenMissing PeerAddr NumTxIdsToAck Every
-> SimpleWhenMatched PeerAddr NumTxIdsToAck NumTxIdsToAck Every
-> Map PeerAddr NumTxIdsToAck
-> Map PeerAddr NumTxIdsToAck
-> Map PeerAddr Every
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
Map.merge
        -- it is an error if `ackFromDecisions` contains a result which is
        -- missing in `ackFromState`
        ((PeerAddr -> NumTxIdsToAck -> Every)
-> SimpleWhenMissing PeerAddr NumTxIdsToAck Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PeerAddr
addr NumTxIdsToAck
num -> Property -> Every
forall p. Testable p => p -> Every
Every (Property -> Every) -> Property -> Every
forall a b. (a -> b) -> a -> b
$ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"missing " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ (PeerAddr, NumTxIdsToAck) -> TestName
forall a. Show a => a -> TestName
show (PeerAddr
addr, NumTxIdsToAck
num)) Bool
False))
        -- if `ackFromState` contains an enty which is missing in
        -- `ackFromDecisions` it must be `0`; `makeDecisions` might want to
        -- download some `tx`s even if there's nothing to acknowledge
        ((PeerAddr -> NumTxIdsToAck -> Every)
-> SimpleWhenMissing PeerAddr NumTxIdsToAck Every
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing (\PeerAddr
_ NumTxIdsToAck
d -> Property -> Every
forall p. Testable p => p -> Every
Every (NumTxIdsToAck
d NumTxIdsToAck -> NumTxIdsToAck -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== NumTxIdsToAck
0)))
        -- if both entries exists they must be equal
        ((PeerAddr -> NumTxIdsToAck -> NumTxIdsToAck -> Every)
-> SimpleWhenMatched PeerAddr NumTxIdsToAck NumTxIdsToAck Every
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> z) -> WhenMatched f k x y z
Map.zipWithMatched (\PeerAddr
_ NumTxIdsToAck
a NumTxIdsToAck
b -> Property -> Every
forall p. Testable p => p -> Every
Every (NumTxIdsToAck
a NumTxIdsToAck -> NumTxIdsToAck -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== NumTxIdsToAck
b)))
        Map PeerAddr NumTxIdsToAck
ackFromDecisions
        Map PeerAddr NumTxIdsToAck
ackFromState


-- | `makeDecision` is exhaustive in the sense that it returns an empty
-- decision list on a state returned by a prior call of `makeDecision`.
--
prop_makeDecisions_exhaustive
  :: ArbDecisionContexts TxId
  -> Property
prop_makeDecisions_exhaustive :: ArbDecisionContexts PeerAddr -> Property
prop_makeDecisions_exhaustive
  ArbDecisionContexts {
    arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
    arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState
  }
  =
  let (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState',  Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions')
        = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy
                            SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState
                            (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState)
      (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState'', Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions'')
        = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy
                            SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState'
                            (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState')
  in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"decisions':  " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions')
   (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"state':      " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState')
   (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"decisions'': " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions'')
   (Property -> Property) -> (Bool -> Property) -> Bool -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"state'':     " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ SharedTxState PeerAddr PeerAddr (Tx PeerAddr) -> TestName
forall a. Show a => a -> TestName
show SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
sharedTxState'')
   (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> Bool
forall a. Map PeerAddr a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions''


data ArbDecisionContextWithReceivedTxIds = ArbDecisionContextWithReceivedTxIds {
      ArbDecisionContextWithReceivedTxIds -> TxDecisionPolicy
adcrDecisionPolicy :: TxDecisionPolicy,
      ArbDecisionContextWithReceivedTxIds
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
adcrSharedState    :: SharedTxState PeerAddr TxId (Tx TxId),
      ArbDecisionContextWithReceivedTxIds
-> PeerTxState PeerAddr (Tx PeerAddr)
adcrPeerTxState    :: PeerTxState TxId (Tx TxId),
      ArbDecisionContextWithReceivedTxIds -> Fun PeerAddr Bool
adcrMempoolHasTx   :: Fun TxId Bool,
      ArbDecisionContextWithReceivedTxIds -> [Tx PeerAddr]
adcrTxsToAck       :: [Tx TxId],
      -- txids to acknowledge
      ArbDecisionContextWithReceivedTxIds -> PeerAddr
adcrPeerAddr       :: PeerAddr
      -- the peer which owns the acknowledged txids
    }
    deriving PeerAddr
-> ArbDecisionContextWithReceivedTxIds -> TestName -> TestName
[ArbDecisionContextWithReceivedTxIds] -> TestName -> TestName
ArbDecisionContextWithReceivedTxIds -> TestName
(PeerAddr
 -> ArbDecisionContextWithReceivedTxIds -> TestName -> TestName)
-> (ArbDecisionContextWithReceivedTxIds -> TestName)
-> ([ArbDecisionContextWithReceivedTxIds] -> TestName -> TestName)
-> Show ArbDecisionContextWithReceivedTxIds
forall a.
(PeerAddr -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: PeerAddr
-> ArbDecisionContextWithReceivedTxIds -> TestName -> TestName
showsPrec :: PeerAddr
-> ArbDecisionContextWithReceivedTxIds -> TestName -> TestName
$cshow :: ArbDecisionContextWithReceivedTxIds -> TestName
show :: ArbDecisionContextWithReceivedTxIds -> TestName
$cshowList :: [ArbDecisionContextWithReceivedTxIds] -> TestName -> TestName
showList :: [ArbDecisionContextWithReceivedTxIds] -> TestName -> TestName
Show


instance Arbitrary ArbDecisionContextWithReceivedTxIds where
    arbitrary :: Gen ArbDecisionContextWithReceivedTxIds
arbitrary = do
      ArbTxDecisionPolicy policy <- Gen ArbTxDecisionPolicy
forall a. Arbitrary a => Gen a
arbitrary
      ArbReceivedTxIds mempoolHasTx
                       txIdsToAck
                       peeraddr
                       ps
                       st
        <- arbitrary

      let st' = (PeerAddr -> Bool)
-> TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
forall peeraddr txid tx.
Ord txid =>
(txid -> Bool)
-> TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> SharedTxState peeraddr txid tx
fixupSharedTxStateForPolicy
                  (Fun PeerAddr Bool -> PeerAddr -> Bool
forall a b. Fun a b -> a -> b
apply Fun PeerAddr Bool
mempoolHasTx)
                  TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
          ps' = TxDecisionPolicy
-> PeerTxState PeerAddr (Tx PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr)
forall txid tx.
Ord txid =>
TxDecisionPolicy -> PeerTxState txid tx -> PeerTxState txid tx
fixupPeerTxStateWithPolicy TxDecisionPolicy
policy PeerTxState PeerAddr (Tx PeerAddr)
ps
          txIdsToAck' = PeerAddr -> [Tx PeerAddr] -> [Tx PeerAddr]
forall a. PeerAddr -> [a] -> [a]
take (NumTxIdsToReq -> PeerAddr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
TXS.requestedTxIdsInflight (PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq)
-> PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall a b. (a -> b) -> a -> b
$ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> PeerAddr -> PeerTxState PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
peeraddr)) [Tx PeerAddr]
txIdsToAck

      downTxsNum <- choose (0, length txIdsToAck')
      let downloadedTxs = (Map PeerAddr (Tx PeerAddr)
 -> (PeerAddr, Maybe (Tx PeerAddr)) -> Map PeerAddr (Tx PeerAddr))
-> Map PeerAddr (Tx PeerAddr)
-> [(PeerAddr, Maybe (Tx PeerAddr))]
-> Map PeerAddr (Tx PeerAddr)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' Map PeerAddr (Tx PeerAddr)
-> (PeerAddr, Maybe (Tx PeerAddr)) -> Map PeerAddr (Tx PeerAddr)
forall tx.
Map PeerAddr tx -> (PeerAddr, Maybe tx) -> Map PeerAddr tx
pruneTx Map PeerAddr (Tx PeerAddr)
forall k a. Map k a
Map.empty ([(PeerAddr, Maybe (Tx PeerAddr))] -> Map PeerAddr (Tx PeerAddr))
-> [(PeerAddr, Maybe (Tx PeerAddr))] -> Map PeerAddr (Tx PeerAddr)
forall a b. (a -> b) -> a -> b
$ PeerAddr
-> [(PeerAddr, Maybe (Tx PeerAddr))]
-> [(PeerAddr, Maybe (Tx PeerAddr))]
forall a. PeerAddr -> [a] -> [a]
take PeerAddr
downTxsNum ([(PeerAddr, Maybe (Tx PeerAddr))]
 -> [(PeerAddr, Maybe (Tx PeerAddr))])
-> [(PeerAddr, Maybe (Tx PeerAddr))]
-> [(PeerAddr, Maybe (Tx PeerAddr))]
forall a b. (a -> b) -> a -> b
$ Map PeerAddr (Maybe (Tx PeerAddr))
-> [(PeerAddr, Maybe (Tx PeerAddr))]
forall k a. Map k a -> [(k, a)]
Map.toList (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (Maybe (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx -> Map txid (Maybe tx)
bufferedTxs SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st')
          ps'' = PeerTxState PeerAddr (Tx PeerAddr)
ps' { downloadedTxs = downloadedTxs }

      return ArbDecisionContextWithReceivedTxIds {
          adcrDecisionPolicy = policy,
          adcrSharedState    = st',
          adcrPeerTxState    = ps'',
          adcrMempoolHasTx   = mempoolHasTx,
          adcrTxsToAck       = txIdsToAck',
          adcrPeerAddr       = peeraddr
        }
      where
        pruneTx :: Map TxId tx -> (TxId, Maybe tx) -> Map TxId tx
        pruneTx :: forall tx.
Map PeerAddr tx -> (PeerAddr, Maybe tx) -> Map PeerAddr tx
pruneTx Map PeerAddr tx
m (PeerAddr
_, Maybe tx
Nothing)    = Map PeerAddr tx
m
        pruneTx Map PeerAddr tx
m (PeerAddr
txid, Just tx
tx) = PeerAddr -> tx -> Map PeerAddr tx -> Map PeerAddr tx
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert PeerAddr
txid tx
tx Map PeerAddr tx
m

    shrink :: ArbDecisionContextWithReceivedTxIds
-> [ArbDecisionContextWithReceivedTxIds]
shrink ArbDecisionContextWithReceivedTxIds {
        adcrDecisionPolicy :: ArbDecisionContextWithReceivedTxIds -> TxDecisionPolicy
adcrDecisionPolicy = TxDecisionPolicy
policy,
        adcrSharedState :: ArbDecisionContextWithReceivedTxIds
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
adcrSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st,
        adcrPeerTxState :: ArbDecisionContextWithReceivedTxIds
-> PeerTxState PeerAddr (Tx PeerAddr)
adcrPeerTxState    = PeerTxState PeerAddr (Tx PeerAddr)
ps,
        adcrMempoolHasTx :: ArbDecisionContextWithReceivedTxIds -> Fun PeerAddr Bool
adcrMempoolHasTx   = Fun PeerAddr Bool
mempoolHasTx,
        adcrTxsToAck :: ArbDecisionContextWithReceivedTxIds -> [Tx PeerAddr]
adcrTxsToAck       = [Tx PeerAddr]
txIdsToAck,
        adcrPeerAddr :: ArbDecisionContextWithReceivedTxIds -> PeerAddr
adcrPeerAddr       = PeerAddr
peeraddr
      }
      =
      [ ArbDecisionContextWithReceivedTxIds {
          adcrDecisionPolicy :: TxDecisionPolicy
adcrDecisionPolicy = TxDecisionPolicy
policy',
          adcrSharedState :: SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
adcrSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st',
          adcrPeerTxState :: PeerTxState PeerAddr (Tx PeerAddr)
adcrPeerTxState    = PeerTxState PeerAddr (Tx PeerAddr)
ps,
          adcrMempoolHasTx :: Fun PeerAddr Bool
adcrMempoolHasTx   = Fun PeerAddr Bool
mempoolHasTx',
          adcrTxsToAck :: [Tx PeerAddr]
adcrTxsToAck       = [Tx PeerAddr]
txIdsToAck',
          adcrPeerAddr :: PeerAddr
adcrPeerAddr       = PeerAddr
peeraddr
        }
      | ArbDecisionContexts {
          arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy',
          arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st',
          arbMempoolHasTx :: forall txid. ArbDecisionContexts txid -> Fun txid Bool
arbMempoolHasTx   = Fun PeerAddr Bool
mempoolHasTx'
        }
          <- ArbDecisionContexts PeerAddr -> [ArbDecisionContexts PeerAddr]
forall a. Arbitrary a => a -> [a]
shrink ArbDecisionContexts {
                 arbDecisionPolicy :: TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
                 arbSharedState :: SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st,
                 arbMempoolHasTx :: Fun PeerAddr Bool
arbMempoolHasTx   = Fun PeerAddr Bool
mempoolHasTx
               }
      , PeerAddr
peeraddr PeerAddr
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st'
      , let txIdsToAck' :: [Tx PeerAddr]
txIdsToAck' = PeerAddr -> [Tx PeerAddr] -> [Tx PeerAddr]
forall a. PeerAddr -> [a] -> [a]
take ( NumTxIdsToReq -> PeerAddr
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                               (NumTxIdsToReq -> PeerAddr)
-> (PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq)
-> PeerTxState PeerAddr (Tx PeerAddr)
-> PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PeerTxState PeerAddr (Tx PeerAddr) -> NumTxIdsToReq
forall txid tx. PeerTxState txid tx -> NumTxIdsToReq
TXS.requestedTxIdsInflight
                               (PeerTxState PeerAddr (Tx PeerAddr) -> PeerAddr)
-> PeerTxState PeerAddr (Tx PeerAddr) -> PeerAddr
forall a b. (a -> b) -> a -> b
$ SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st' Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> PeerAddr -> PeerTxState PeerAddr (Tx PeerAddr)
forall k a. Ord k => Map k a -> k -> a
Map.! PeerAddr
peeraddr
                               )
                               [Tx PeerAddr]
txIdsToAck
      ]


-- | `filterActivePeers` should not change decisions made by `makeDecisions`
--
prop_filterActivePeers_not_limitting_decisions
    :: ArbDecisionContexts TxId
    -> Property
prop_filterActivePeers_not_limitting_decisions :: ArbDecisionContexts PeerAddr -> Property
prop_filterActivePeers_not_limitting_decisions
    ArbDecisionContexts {
        arbDecisionPolicy :: forall txid. ArbDecisionContexts txid -> TxDecisionPolicy
arbDecisionPolicy = TxDecisionPolicy
policy,
        arbSharedState :: forall txid.
ArbDecisionContexts txid -> SharedTxState PeerAddr txid (Tx txid)
arbSharedState    = SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
    }
    =
    TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (Context -> TestName
unlines
                   [TestName
"decisions:        " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions
                   ,TestName
"                  " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show Set PeerAddr
decisionPeers
                   ,TestName
"active decisions: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisionsOfActivePeers
                   ,TestName
"                  " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Set PeerAddr -> TestName
forall a. Show a => a -> TestName
show Set PeerAddr
activePeers]) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

    TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"active peers does not restrict the total number of valid decisions available"
                     TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> TestName
forall a. Show a => a -> TestName
show (Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisionsOfActivePeers  Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
-> Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
-> Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions)
                   )
                   (Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisionsOfActivePeers  Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions)
  where
    activePeersMap :: Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
activePeersMap    = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
(Ord txid, HasCallStack) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
TXS.filterActivePeers TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st
    activePeers :: Set PeerAddr
activePeers       = Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr)) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
activePeersMap
    (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
_, Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisionsOfActivePeers)
                      = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
activePeersMap

    (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
_, Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions)    = TxDecisionPolicy
-> SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
-> (SharedTxState PeerAddr PeerAddr (Tx PeerAddr),
    Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)))
forall peeraddr txid tx.
(Ord peeraddr, Ord txid, Hashable peeraddr) =>
TxDecisionPolicy
-> SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
-> (SharedTxState peeraddr txid tx,
    Map peeraddr (TxDecision txid tx))
TXS.makeDecisions TxDecisionPolicy
policy SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st (SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
-> Map PeerAddr (PeerTxState PeerAddr (Tx PeerAddr))
forall peeraddr txid tx.
SharedTxState peeraddr txid tx
-> Map peeraddr (PeerTxState txid tx)
peerTxStates SharedTxState PeerAddr PeerAddr (Tx PeerAddr)
st)
    decisionPeers :: Set PeerAddr
decisionPeers     = Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr)) -> Set PeerAddr
forall k a. Map k a -> Set k
Map.keysSet Map PeerAddr (TxDecision PeerAddr (Tx PeerAddr))
decisions


-- TODO: makeDecisions property: all peers which have txid's to ack are
-- included, this would catch the other bug, and it's important for the system
-- to run well.

--
-- Auxiliary functions
--

labelInt :: (Integral a, Eq a, Ord a, Show a)
         => a -- ^ upper bound
         -> a -- ^ width
         -> a -- ^ value
         -> String
labelInt :: forall a.
(Integral a, Eq a, Ord a, Show a) =>
a -> a -> a -> TestName
labelInt a
_ a
_ a
0 = TestName
"[0, 0]"
labelInt a
bound a
_ a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
bound = TestName
"[" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ a -> TestName
forall a. Show a => a -> TestName
show a
bound TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
", inf)"
labelInt a
_ a
a a
b =
    let l :: a
l = a
a a -> a -> a
forall a. Num a => a -> a -> a
* (a
b a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
a)
        u :: a
u = a
l a -> a -> a
forall a. Num a => a -> a -> a
+ a
a
    in (if a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then TestName
"(" else TestName
"[")
       TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ a -> TestName
forall a. Show a => a -> TestName
show a
l TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
", "
       TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ a -> TestName
forall a. Show a => a -> TestName
show a
u TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
")"