{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Ouroboros.Network.PeerSelection.LocalRootPeers
  ( arbitraryLocalRootPeers
  , AdvertiseChange
  , governorAdvertiseChanges
  , restrictKeys
  , tests
  , LocalRootPeers (..)
  , HotValency (..)
  , WarmValency (..)
  ) where

import Control.Applicative ((<|>))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe.Strict (StrictMaybe (..))
import System.Random (mkStdGen)

import Control.Monad.Class.MonadSTM (STM, atomically)
import Control.Monad.Class.MonadTime.SI (Time (..))
import Control.Monad.IOSim (IOSim, runSimOrThrow)
import Data.Set (Set)
import Data.Set qualified as Set

import Ouroboros.Network.PeerSelection.Governor
import Ouroboros.Network.PeerSelection.Governor.Monitor qualified as Monitor
import Ouroboros.Network.PeerSelection.Governor.Types (Guarded (..))
import Ouroboros.Network.PeerSelection.Governor.Types qualified as Governor
import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
import Ouroboros.Network.PeerSelection.State.KnownPeers (KnownPeerInfo (..))
import Ouroboros.Network.PeerSelection.State.KnownPeers qualified as KnownPeers
import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..),
           LocalRootConfig (..), LocalRootPeers (..), WarmValency (..))
import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRootPeers
import Ouroboros.Network.PeerSelection.Types (PublicExtraPeersAPI,
           nullPublicExtraPeersAPI)

import Test.Ouroboros.Network.PeerSelection.Instances
import Test.Ouroboros.Network.Utils (ShrinkCarefully, prop_shrink_nonequal,
           prop_shrink_valid, renderRanges)

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


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.PeerSelection"
  [ TestName -> [TestTree] -> TestTree
testGroup TestName
"LocalRootPeers"
    [ TestName
-> (LocalRootPeers NoExtraFlags PeerAddr -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"arbitrary"    (forall extraFlags.
Arbitrary extraFlags =>
LocalRootPeers extraFlags PeerAddr -> Property
prop_arbitrary_LocalRootPeers @NoExtraFlags)
    , TestName
-> (LocalRootPeers NoExtraFlags PeerAddr -> Bool) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"fromToGroups" (forall extraFlags.
Eq extraFlags =>
LocalRootPeers extraFlags PeerAddr -> Bool
prop_fromToGroups @NoExtraFlags)
    , TestName
-> ([(HotValency, WarmValency,
      Map PeerAddr (LocalRootConfig NoExtraFlags))]
    -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"fromGroups"   (forall extraFlags.
[(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> Bool
prop_fromGroups @NoExtraFlags)
    , TestName
-> (ShrinkCarefully (LocalRootPeers NoExtraFlags PeerAddr)
    -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrink"       (forall extraFlags.
(Eq extraFlags, Show extraFlags, Arbitrary extraFlags) =>
ShrinkCarefully (LocalRootPeers extraFlags PeerAddr) -> Property
prop_shrink_LocalRootPeers @NoExtraFlags)
    , TestName
-> (LocalRootPeers NoExtraFlags PeerAddr
    -> PeerSelectionTargets -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"clampToLimit" (forall extraFlags.
Arbitrary extraFlags =>
LocalRootPeers extraFlags PeerAddr
-> PeerSelectionTargets -> Property
prop_clampToLimit @NoExtraFlags)
    , TestName -> (AdvertiseChange NoExtraFlags -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"the governor gives the known peers the new flags"
                   AdvertiseChange NoExtraFlags -> Property
prop_governor_advertiseChanges
    ]
  ]

type NoExtraFlags = ()

-- | Check that we can forcibly bring the localRootPeers into compliance
-- with the governor's state invariant, which requires that the local
-- root peers fit within the current targets.
--
-- The precondition on the targets is that they are sane.
-- See sanePeerSelectionTargets.
prop_clampToLimit
  :: Arbitrary extraFlags
  => LocalRootPeers extraFlags PeerAddr
  -> PeerSelectionTargets
  -> Property
prop_clampToLimit :: forall extraFlags.
Arbitrary extraFlags =>
LocalRootPeers extraFlags PeerAddr
-> PeerSelectionTargets -> Property
prop_clampToLimit LocalRootPeers extraFlags PeerAddr
localRootPeers PeerSelectionTargets
targets =

    let sizeLimit :: Int
sizeLimit       = PeerSelectionTargets -> Int
targetNumberOfKnownPeers PeerSelectionTargets
targets
        localRootPeers' :: LocalRootPeers extraFlags PeerAddr
localRootPeers' = Int
-> LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
Int
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.clampToLimit Int
sizeLimit LocalRootPeers extraFlags PeerAddr
localRootPeers

     in TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"sizeLimit   = " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Int -> TestName
forall a. Show a => a -> TestName
show Int
sizeLimit) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$

        LocalRootPeers extraFlags PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size LocalRootPeers extraFlags PeerAddr
localRootPeers'
          Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
sizeLimit
                 (LocalRootPeers extraFlags PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size LocalRootPeers extraFlags PeerAddr
localRootPeers)

-- | A change of local roots, with the known peers before it: the old local
-- roots with their flags, and other peers.
data AdvertiseChange extraFlags = AdvertiseChange {
    forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acOld    :: LocalRootPeers extraFlags PeerAddr,
    forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acNew    :: LocalRootPeers extraFlags PeerAddr,
    forall extraFlags.
AdvertiseChange extraFlags
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
acOthers :: Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
  }
  deriving Int -> AdvertiseChange extraFlags -> TestName -> TestName
[AdvertiseChange extraFlags] -> TestName -> TestName
AdvertiseChange extraFlags -> TestName
(Int -> AdvertiseChange extraFlags -> TestName -> TestName)
-> (AdvertiseChange extraFlags -> TestName)
-> ([AdvertiseChange extraFlags] -> TestName -> TestName)
-> Show (AdvertiseChange extraFlags)
forall extraFlags.
Show extraFlags =>
Int -> AdvertiseChange extraFlags -> TestName -> TestName
forall extraFlags.
Show extraFlags =>
[AdvertiseChange extraFlags] -> TestName -> TestName
forall extraFlags.
Show extraFlags =>
AdvertiseChange extraFlags -> TestName
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: forall extraFlags.
Show extraFlags =>
Int -> AdvertiseChange extraFlags -> TestName -> TestName
showsPrec :: Int -> AdvertiseChange extraFlags -> TestName -> TestName
$cshow :: forall extraFlags.
Show extraFlags =>
AdvertiseChange extraFlags -> TestName
show :: AdvertiseChange extraFlags -> TestName
$cshowList :: forall extraFlags.
Show extraFlags =>
[AdvertiseChange extraFlags] -> TestName -> TestName
showList :: [AdvertiseChange extraFlags] -> TestName -> TestName
Show

-- | The new local roots are mostly an edit of the old ones: entries dropped,
-- flags flipped, a group of new peers added. Shrinking removes a peer from
-- both, or undoes a flag's change, so a kept peer stays kept.
instance (Arbitrary extraFlags, Eq extraFlags)
      => Arbitrary (AdvertiseChange extraFlags) where
    arbitrary :: Gen (AdvertiseChange extraFlags)
arbitrary = do
      old <- Gen (LocalRootPeers extraFlags PeerAddr)
forall a. Arbitrary a => Gen a
arbitrary
      new <- frequency
        [ (1, arbitrary)
        , (4, do groups <- traverse edit (LocalRootPeers.toGroups old)
                 extra  <- frequency [ (2, pure [])
                                     , (1, LocalRootPeers.toGroups
                                             <$> arbitraryLocalRootPeers (fresh old)) ]
                 return (LocalRootPeers.fromGroups (groups ++ extra)))
        ]
      AdvertiseChange old new <$> arbitrary
      where
        fresh :: LocalRootPeers extraFlags PeerAddr -> Set PeerAddr
fresh LocalRootPeers extraFlags PeerAddr
lrps = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [ Int -> PeerAddr
PeerAddr (Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) | Int
i <- [Int
1 .. Int
3] ]
          where top :: Int
top = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [ Int
a | PeerAddr Int
a <- Set PeerAddr -> [PeerAddr]
forall a. Set a -> [a]
Set.toList (LocalRootPeers extraFlags PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags PeerAddr
lrps) ])
        edit :: (a, b, Map k (LocalRootConfig extraFlags))
-> Gen (a, b, Map k (LocalRootConfig extraFlags))
edit (a
h, b
w, Map k (LocalRootConfig extraFlags)
m) = do
          m' <- [(k, LocalRootConfig extraFlags)]
-> Map k (LocalRootConfig extraFlags)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, LocalRootConfig extraFlags)]
 -> Map k (LocalRootConfig extraFlags))
-> Gen [(k, LocalRootConfig extraFlags)]
-> Gen (Map k (LocalRootConfig extraFlags))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(k, LocalRootConfig extraFlags)]
-> Gen [(k, LocalRootConfig extraFlags)]
forall a. [a] -> Gen [a]
sublistOf (Map k (LocalRootConfig extraFlags)
-> [(k, LocalRootConfig extraFlags)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k (LocalRootConfig extraFlags)
m) Gen [(k, LocalRootConfig extraFlags)]
-> ([(k, LocalRootConfig extraFlags)]
    -> Gen [(k, LocalRootConfig extraFlags)])
-> Gen [(k, LocalRootConfig extraFlags)]
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((k, LocalRootConfig extraFlags)
 -> Gen (k, LocalRootConfig extraFlags))
-> [(k, LocalRootConfig extraFlags)]
-> Gen [(k, LocalRootConfig extraFlags)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (k, LocalRootConfig extraFlags)
-> Gen (k, LocalRootConfig extraFlags)
forall {a} {extraFlags}.
(a, LocalRootConfig extraFlags)
-> Gen (a, LocalRootConfig extraFlags)
flip')
          return (h, w, m')
        flip' :: (a, LocalRootConfig extraFlags)
-> Gen (a, LocalRootConfig extraFlags)
flip' (a
p, LocalRootConfig extraFlags
c) = do
          b <- Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
          return (p, if b then c { peerAdvertise = otherAdvertise (peerAdvertise c) } else c)

    shrink :: AdvertiseChange extraFlags -> [AdvertiseChange extraFlags]
shrink (AdvertiseChange LocalRootPeers extraFlags PeerAddr
old LocalRootPeers extraFlags PeerAddr
new Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others) =
         [ LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
forall extraFlags.
LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
AdvertiseChange (PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
forall {peeraddr} {extraFlags}.
Ord peeraddr =>
peeraddr
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
without PeerAddr
p LocalRootPeers extraFlags PeerAddr
old) (PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
forall {peeraddr} {extraFlags}.
Ord peeraddr =>
peeraddr
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
without PeerAddr
p LocalRootPeers extraFlags PeerAddr
new) Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others
         | PeerAddr
p <- Set PeerAddr -> [PeerAddr]
forall a. Set a -> [a]
Set.toList (LocalRootPeers extraFlags PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags PeerAddr
old Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
<> LocalRootPeers extraFlags PeerAddr -> Set PeerAddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags PeerAddr
new) ]
      [AdvertiseChange extraFlags]
-> [AdvertiseChange extraFlags] -> [AdvertiseChange extraFlags]
forall a. [a] -> [a] -> [a]
++ [ LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
forall extraFlags.
LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
AdvertiseChange LocalRootPeers extraFlags PeerAddr
old (PeerAddr -> PeerAdvertise -> LocalRootPeers extraFlags PeerAddr
restore PeerAddr
p PeerAdvertise
a) Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others
         | (PeerAddr
p, PeerAdvertise
a) <- Map PeerAddr (PeerAdvertise, PeerAdvertise)
-> [(PeerAddr, (PeerAdvertise, PeerAdvertise))]
forall k a. Map k a -> [(k, a)]
Map.toList ((LocalRootConfig extraFlags
 -> LocalRootConfig extraFlags -> (PeerAdvertise, PeerAdvertise))
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (PeerAdvertise, PeerAdvertise)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (\LocalRootConfig extraFlags
o LocalRootConfig extraFlags
n -> (LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
o, LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
n))
                                                      (LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
old)
                                                      (LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
new))
                       [(PeerAddr, (PeerAdvertise, PeerAdvertise))]
-> ((PeerAddr, (PeerAdvertise, PeerAdvertise))
    -> [(PeerAddr, PeerAdvertise)])
-> [(PeerAddr, PeerAdvertise)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(PeerAddr
p, (PeerAdvertise
o, PeerAdvertise
n)) -> [ (PeerAddr
p, PeerAdvertise
o) | PeerAdvertise
o PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
/= PeerAdvertise
n ] ]
      [AdvertiseChange extraFlags]
-> [AdvertiseChange extraFlags] -> [AdvertiseChange extraFlags]
forall a. [a] -> [a] -> [a]
++ [ LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
forall extraFlags.
LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> AdvertiseChange extraFlags
AdvertiseChange LocalRootPeers extraFlags PeerAddr
old LocalRootPeers extraFlags PeerAddr
new Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others' | Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others' <- Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> [Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)]
forall a. Arbitrary a => a -> [a]
shrink Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
others ]
      where
        without :: peeraddr
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
without peeraddr
p LocalRootPeers extraFlags peeraddr
lrps = LocalRootPeers extraFlags peeraddr
-> Set peeraddr -> LocalRootPeers extraFlags peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> Set peeraddr -> LocalRootPeers extraFlags peeraddr
restrictKeys LocalRootPeers extraFlags peeraddr
lrps (peeraddr -> Set peeraddr -> Set peeraddr
forall a. Ord a => a -> Set a -> Set a
Set.delete peeraddr
p (LocalRootPeers extraFlags peeraddr -> Set peeraddr
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Set peeraddr
LocalRootPeers.keysSet LocalRootPeers extraFlags peeraddr
lrps))
        restore :: PeerAddr -> PeerAdvertise -> LocalRootPeers extraFlags PeerAddr
restore PeerAddr
p PeerAdvertise
a = [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
                        [ (HotValency
h, WarmValency
w, (LocalRootConfig extraFlags -> LocalRootConfig extraFlags)
-> PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\LocalRootConfig extraFlags
c -> LocalRootConfig extraFlags
c { peerAdvertise = a }) PeerAddr
p Map PeerAddr (LocalRootConfig extraFlags)
m)
                        | (HotValency
h, WarmValency
w, Map PeerAddr (LocalRootConfig extraFlags)
m) <- LocalRootPeers extraFlags PeerAddr
-> [(HotValency, WarmValency,
     Map PeerAddr (LocalRootConfig extraFlags))]
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers extraFlags PeerAddr
new ]

otherAdvertise :: PeerAdvertise -> PeerAdvertise
otherAdvertise :: PeerAdvertise -> PeerAdvertise
otherAdvertise PeerAdvertise
DoAdvertisePeer    = PeerAdvertise
DoNotAdvertisePeer
otherAdvertise PeerAdvertise
DoNotAdvertisePeer = PeerAdvertise
DoAdvertisePeer

-- | The known peers before the change: the governor inserted each old local
-- root with its flag.
knownPeersBefore :: AdvertiseChange extraFlags -> KnownPeers.KnownPeers PeerAddr
knownPeersBefore :: forall extraFlags.
AdvertiseChange extraFlags -> KnownPeers PeerAddr
knownPeersBefore AdvertiseChange { LocalRootPeers extraFlags PeerAddr
acOld :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acOld :: LocalRootPeers extraFlags PeerAddr
acOld, Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
acOthers :: forall extraFlags.
AdvertiseChange extraFlags
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
acOthers :: Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
acOthers } =
    Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers PeerAddr -> KnownPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert ((LocalRootConfig extraFlags
 -> (Maybe PeerSharing, Maybe PeerAdvertise))
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (\LocalRootConfig extraFlags
c -> (Maybe PeerSharing
forall a. Maybe a
Nothing, PeerAdvertise -> Maybe PeerAdvertise
forall a. a -> Maybe a
Just (LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
c)))
                               (LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
acOld))
                      (Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers PeerAddr -> KnownPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
Map peeraddr (Maybe PeerSharing, Maybe PeerAdvertise)
-> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.insert Map PeerAddr (Maybe PeerSharing, Maybe PeerAdvertise)
acOthers KnownPeers PeerAddr
forall peeraddr. KnownPeers peeraddr
KnownPeers.empty)

-- | The kinds of change the properties must see.
coverAdvertiseChange :: AdvertiseChange extraFlags -> Property -> Property
coverAdvertiseChange :: forall extraFlags.
AdvertiseChange extraFlags -> Property -> Property
coverAdvertiseChange AdvertiseChange { LocalRootPeers extraFlags PeerAddr
acOld :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acOld :: LocalRootPeers extraFlags PeerAddr
acOld, LocalRootPeers extraFlags PeerAddr
acNew :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acNew :: LocalRootPeers extraFlags PeerAddr
acNew } =
      Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
5 (((LocalRootConfig extraFlags, LocalRootConfig extraFlags) -> Bool)
-> Map
     PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(LocalRootConfig extraFlags
o, LocalRootConfig extraFlags
n) -> LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
o PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
== PeerAdvertise
DoAdvertisePeer
                               Bool -> Bool -> Bool
&& LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
n PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
== PeerAdvertise
DoNotAdvertisePeer) Map
  PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
kept)
              TestName
"advertising revoked"
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
5 (((LocalRootConfig extraFlags, LocalRootConfig extraFlags) -> Bool)
-> Map
     PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(LocalRootConfig extraFlags
o, LocalRootConfig extraFlags
n) -> LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
o PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
== PeerAdvertise
DoNotAdvertisePeer
                               Bool -> Bool -> Bool
&& LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
n PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
== PeerAdvertise
DoAdvertisePeer) Map
  PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
kept)
              TestName
"advertising granted"
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
5 (Bool -> Bool
not (Map PeerAddr (LocalRootConfig extraFlags) -> Bool
forall k a. Map k a -> Bool
Map.null (Map PeerAddr (LocalRootConfig extraFlags)
newMap Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map PeerAddr (LocalRootConfig extraFlags)
oldMap))) TestName
"a peer added"
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool -> TestName -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> TestName -> prop -> Property
cover Double
5 (Bool -> Bool
not (Map PeerAddr (LocalRootConfig extraFlags) -> Bool
forall k a. Map k a -> Bool
Map.null (Map PeerAddr (LocalRootConfig extraFlags)
oldMap Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map PeerAddr (LocalRootConfig extraFlags)
newMap))) TestName
"a peer removed"
  where
    newMap :: Map PeerAddr (LocalRootConfig extraFlags)
newMap = LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
acNew
    oldMap :: Map PeerAddr (LocalRootConfig extraFlags)
oldMap = LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
acOld
    kept :: Map
  PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
kept   = (LocalRootConfig extraFlags
 -> LocalRootConfig extraFlags
 -> (LocalRootConfig extraFlags, LocalRootConfig extraFlags))
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map PeerAddr (LocalRootConfig extraFlags)
-> Map
     PeerAddr (LocalRootConfig extraFlags, LocalRootConfig extraFlags)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map PeerAddr (LocalRootConfig extraFlags)
oldMap Map PeerAddr (LocalRootConfig extraFlags)
newMap

-- | The known peers after the change hold the new flag of each new local
-- root, and nothing changed about any other peer. With every peer connected
-- once and never failed, a new local root is then shared exactly when it is
-- advertised: one whose flag was revoked is no longer.
knownPeersAfter :: AdvertiseChange extraFlags
                -> KnownPeers.KnownPeers PeerAddr
                -> Property
knownPeersAfter :: forall extraFlags.
AdvertiseChange extraFlags -> KnownPeers PeerAddr -> Property
knownPeersAfter change :: AdvertiseChange extraFlags
change@AdvertiseChange { LocalRootPeers extraFlags PeerAddr
acNew :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acNew :: LocalRootPeers extraFlags PeerAddr
acNew } KnownPeers PeerAddr
known1 =
       [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
p TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" holds " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Maybe (StrictMaybe PeerAdvertise) -> TestName
forall a. Show a => a -> TestName
show (KnownPeerInfo -> StrictMaybe PeerAdvertise
knownPeerAdvertise (KnownPeerInfo -> StrictMaybe PeerAdvertise)
-> Maybe KnownPeerInfo -> Maybe (StrictMaybe PeerAdvertise)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KnownPeerInfo
info)
                                 TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
", configured " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PeerAdvertise -> TestName
forall a. Show a => a -> TestName
show (LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
c))
                   ((KnownPeerInfo -> StrictMaybe PeerAdvertise)
-> Maybe KnownPeerInfo -> Maybe (StrictMaybe PeerAdvertise)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KnownPeerInfo -> StrictMaybe PeerAdvertise
knownPeerAdvertise Maybe KnownPeerInfo
info Maybe (StrictMaybe PeerAdvertise)
-> Maybe (StrictMaybe PeerAdvertise) -> Bool
forall a. Eq a => a -> a -> Bool
== StrictMaybe PeerAdvertise -> Maybe (StrictMaybe PeerAdvertise)
forall a. a -> Maybe a
Just (PeerAdvertise -> StrictMaybe PeerAdvertise
forall a. a -> StrictMaybe a
SJust (LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
c)))
               | (PeerAddr
p, LocalRootConfig extraFlags
c) <- Map PeerAddr (LocalRootConfig extraFlags)
-> [(PeerAddr, LocalRootConfig extraFlags)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PeerAddr (LocalRootConfig extraFlags)
newMap
               , let info :: Maybe KnownPeerInfo
info = PeerAddr -> Map PeerAddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
p (KnownPeers PeerAddr -> Map PeerAddr KnownPeerInfo
forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
KnownPeers.allPeers KnownPeers PeerAddr
known1) ]
  Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
p TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" changed: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ KnownPeerInfo -> TestName
forall a. Show a => a -> TestName
show KnownPeerInfo
info0
                                 TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" became " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Maybe KnownPeerInfo -> TestName
forall a. Show a => a -> TestName
show Maybe KnownPeerInfo
info1)
                   (KnownPeerInfo -> Maybe KnownPeerInfo
forall a. a -> Maybe a
Just KnownPeerInfo
info0 Maybe KnownPeerInfo -> Maybe KnownPeerInfo -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe KnownPeerInfo
info1)
               | (PeerAddr
p, KnownPeerInfo
info0) <- Map PeerAddr KnownPeerInfo -> [(PeerAddr, KnownPeerInfo)]
forall k a. Map k a -> [(k, a)]
Map.toList (KnownPeers PeerAddr -> Map PeerAddr KnownPeerInfo
forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
KnownPeers.allPeers KnownPeers PeerAddr
known0)
               , PeerAddr
p PeerAddr -> Map PeerAddr (LocalRootConfig extraFlags) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map PeerAddr (LocalRootConfig extraFlags)
newMap
               , let info1 :: Maybe KnownPeerInfo
info1 = PeerAddr -> Map PeerAddr KnownPeerInfo -> Maybe KnownPeerInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerAddr
p (KnownPeers PeerAddr -> Map PeerAddr KnownPeerInfo
forall peeraddr. KnownPeers peeraddr -> Map peeraddr KnownPeerInfo
KnownPeers.allPeers KnownPeers PeerAddr
known1) ]
  Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [ TestName -> Bool -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (PeerAddr -> TestName
forall a. Show a => a -> TestName
show PeerAddr
p TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" shared: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Bool -> TestName
forall a. Show a => a -> TestName
show (PeerAddr
p PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PeerAddr
shared))
                   ((PeerAddr
p PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PeerAddr
shared) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (LocalRootConfig extraFlags -> PeerAdvertise
forall extraFlags. LocalRootConfig extraFlags -> PeerAdvertise
peerAdvertise LocalRootConfig extraFlags
c PeerAdvertise -> PeerAdvertise -> Bool
forall a. Eq a => a -> a -> Bool
== PeerAdvertise
DoAdvertisePeer))
               | (PeerAddr
p, LocalRootConfig extraFlags
c) <- Map PeerAddr (LocalRootConfig extraFlags)
-> [(PeerAddr, LocalRootConfig extraFlags)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PeerAddr (LocalRootConfig extraFlags)
newMap ]
  where
    known0 :: KnownPeers PeerAddr
known0 = AdvertiseChange extraFlags -> KnownPeers PeerAddr
forall extraFlags.
AdvertiseChange extraFlags -> KnownPeers PeerAddr
knownPeersBefore AdvertiseChange extraFlags
change
    newMap :: Map PeerAddr (LocalRootConfig extraFlags)
newMap = LocalRootPeers extraFlags PeerAddr
-> Map PeerAddr (LocalRootConfig extraFlags)
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> Map peeraddr (LocalRootConfig extraFlags)
LocalRootPeers.toMap LocalRootPeers extraFlags PeerAddr
acNew
    shared :: Set PeerAddr
shared = KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.getPeerSharingResponsePeers
               (Set PeerAddr -> KnownPeers PeerAddr -> KnownPeers PeerAddr
forall peeraddr.
Ord peeraddr =>
Set peeraddr -> KnownPeers peeraddr -> KnownPeers peeraddr
KnownPeers.setSuccessfulConnectionFlag
                  (KnownPeers PeerAddr -> Set PeerAddr
forall peeraddr. KnownPeers peeraddr -> Set peeraddr
KnownPeers.toSet KnownPeers PeerAddr
known1) KnownPeers PeerAddr
known1)

-- | The governor's local roots monitor, from a state holding the old local
-- roots and known peers with their flags, reads the new ones and leaves the
-- known peers as 'knownPeersAfter' requires; it does not fire when nothing
-- changed.
prop_governor_advertiseChanges :: AdvertiseChange NoExtraFlags -> Property
prop_governor_advertiseChanges :: AdvertiseChange NoExtraFlags -> Property
prop_governor_advertiseChanges =
    (forall s.
 PeerSelectionActions
   NoExtraFlags
   NoExtraFlags
   NoExtraFlags
   NoExtraFlags
   PeerAddr
   NoExtraFlags
   (IOSim s)
 -> PeerSelectionState
      NoExtraFlags NoExtraFlags NoExtraFlags PeerAddr NoExtraFlags
 -> Guarded
      (STM (IOSim s))
      (TimedDecision
         (IOSim s)
         NoExtraFlags
         NoExtraFlags
         NoExtraFlags
         NoExtraFlags
         PeerAddr
         NoExtraFlags))
-> NoExtraFlags
-> NoExtraFlags
-> PublicExtraPeersAPI NoExtraFlags PeerAddr
-> AdvertiseChange NoExtraFlags
-> Property
forall extraState extraFlags extraPeers.
(Eq extraFlags, Show extraFlags) =>
(forall s.
 PeerSelectionActions
   extraState
   extraFlags
   extraPeers
   NoExtraFlags
   PeerAddr
   NoExtraFlags
   (IOSim s)
 -> PeerSelectionState
      extraState extraFlags extraPeers PeerAddr NoExtraFlags
 -> Guarded
      (STM (IOSim s))
      (TimedDecision
         (IOSim s)
         extraState
         NoExtraFlags
         extraFlags
         extraPeers
         PeerAddr
         NoExtraFlags))
-> extraState
-> extraPeers
-> PublicExtraPeersAPI extraPeers PeerAddr
-> AdvertiseChange extraFlags
-> Property
governorAdvertiseChanges PeerSelectionActions
  NoExtraFlags
  NoExtraFlags
  NoExtraFlags
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
-> PeerSelectionState
     NoExtraFlags NoExtraFlags NoExtraFlags PeerAddr NoExtraFlags
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        NoExtraFlags
        NoExtraFlags
        NoExtraFlags
        NoExtraFlags
        PeerAddr
        NoExtraFlags)
forall s.
PeerSelectionActions
  NoExtraFlags
  NoExtraFlags
  NoExtraFlags
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
-> PeerSelectionState
     NoExtraFlags NoExtraFlags NoExtraFlags PeerAddr NoExtraFlags
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        NoExtraFlags
        NoExtraFlags
        NoExtraFlags
        NoExtraFlags
        PeerAddr
        NoExtraFlags)
forall extraState extraDebugState extraFlags extraPeers extraAPI
       peeraddr peerconn (m :: * -> *).
(MonadTimer m, Ord peeraddr, Eq extraFlags) =>
PeerSelectionActions
  extraState extraFlags extraPeers extraAPI peeraddr peerconn m
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
-> Guarded
     (STM m)
     (TimedDecision
        m
        extraState
        extraDebugState
        extraFlags
        extraPeers
        peeraddr
        peerconn)
Monitor.localRoots () () PublicExtraPeersAPI NoExtraFlags PeerAddr
forall extraPeers peeraddr.
Monoid extraPeers =>
PublicExtraPeersAPI extraPeers peeraddr
nullPublicExtraPeersAPI

-- | A governor's local roots monitor, from a state holding the old local
-- roots and known peers with their flags, reads the new ones and leaves the
-- known peers as 'knownPeersAfter' requires; it does not fire when nothing
-- changed. The monitor runs once, on a state with the given extra state and
-- extra peers.
governorAdvertiseChanges
  :: forall extraState extraFlags extraPeers.
     (Eq extraFlags, Show extraFlags)
  => (forall s. Governor.PeerSelectionActions extraState extraFlags extraPeers ()
                                               PeerAddr () (IOSim s)
             -> Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr ()
             -> Guarded (STM (IOSim s))
                        (Governor.TimedDecision (IOSim s) extraState () extraFlags extraPeers
                                                PeerAddr ()))
  -> extraState
  -> extraPeers
  -> PublicExtraPeersAPI extraPeers PeerAddr
  -> AdvertiseChange extraFlags
  -> Property
governorAdvertiseChanges :: forall extraState extraFlags extraPeers.
(Eq extraFlags, Show extraFlags) =>
(forall s.
 PeerSelectionActions
   extraState
   extraFlags
   extraPeers
   NoExtraFlags
   PeerAddr
   NoExtraFlags
   (IOSim s)
 -> PeerSelectionState
      extraState extraFlags extraPeers PeerAddr NoExtraFlags
 -> Guarded
      (STM (IOSim s))
      (TimedDecision
         (IOSim s)
         extraState
         NoExtraFlags
         extraFlags
         extraPeers
         PeerAddr
         NoExtraFlags))
-> extraState
-> extraPeers
-> PublicExtraPeersAPI extraPeers PeerAddr
-> AdvertiseChange extraFlags
-> Property
governorAdvertiseChanges forall s.
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr NoExtraFlags
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        extraState
        NoExtraFlags
        extraFlags
        extraPeers
        PeerAddr
        NoExtraFlags)
monitor extraState
extraState extraPeers
extraPeers PublicExtraPeersAPI extraPeers PeerAddr
extraPeersAPI
                         change :: AdvertiseChange extraFlags
change@AdvertiseChange { LocalRootPeers extraFlags PeerAddr
acOld :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acOld :: LocalRootPeers extraFlags PeerAddr
acOld, LocalRootPeers extraFlags PeerAddr
acNew :: forall extraFlags.
AdvertiseChange extraFlags -> LocalRootPeers extraFlags PeerAddr
acNew :: LocalRootPeers extraFlags PeerAddr
acNew } =
    Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    AdvertiseChange extraFlags -> Property -> Property
forall extraFlags.
AdvertiseChange extraFlags -> Property -> Property
coverAdvertiseChange AdvertiseChange extraFlags
change (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    case (forall s. IOSim s (Maybe (KnownPeers PeerAddr)))
-> Maybe (KnownPeers PeerAddr)
forall a. (forall s. IOSim s a) -> a
runSimOrThrow IOSim s (Maybe (KnownPeers PeerAddr))
forall s. IOSim s (Maybe (KnownPeers PeerAddr))
run of
      Maybe (KnownPeers PeerAddr)
Nothing     -> TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"the monitor did not fire" (LocalRootPeers extraFlags PeerAddr
acNew LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== LocalRootPeers extraFlags PeerAddr
acOld)
      Just KnownPeers PeerAddr
known1 -> AdvertiseChange extraFlags -> KnownPeers PeerAddr -> Property
forall extraFlags.
AdvertiseChange extraFlags -> KnownPeers PeerAddr -> Property
knownPeersAfter AdvertiseChange extraFlags
change KnownPeers PeerAddr
known1
  where
    targets :: PeerSelectionTargets
targets = PeerSelectionTargets
nullPeerSelectionTargets { targetNumberOfKnownPeers = 10000 }

    run :: IOSim s (Maybe (KnownPeers.KnownPeers PeerAddr))
    run :: forall s. IOSim s (Maybe (KnownPeers PeerAddr))
run =
      case PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr NoExtraFlags
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        extraState
        NoExtraFlags
        extraFlags
        extraPeers
        PeerAddr
        NoExtraFlags)
forall s.
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr NoExtraFlags
-> Guarded
     (STM (IOSim s))
     (TimedDecision
        (IOSim s)
        extraState
        NoExtraFlags
        extraFlags
        extraPeers
        PeerAddr
        NoExtraFlags)
monitor PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
forall s.
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
actions PeerSelectionState
  extraState extraFlags extraPeers PeerAddr NoExtraFlags
state of
        Guarded Maybe Time
_ STM
  s
  (TimedDecision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags)
decide ->
          STM (IOSim s) (Maybe (KnownPeers PeerAddr))
-> IOSim s (Maybe (KnownPeers PeerAddr))
forall a. HasCallStack => STM (IOSim s) a -> IOSim s a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (IOSim s) (Maybe (KnownPeers PeerAddr))
 -> IOSim s (Maybe (KnownPeers PeerAddr)))
-> STM (IOSim s) (Maybe (KnownPeers PeerAddr))
-> IOSim s (Maybe (KnownPeers PeerAddr))
forall a b. (a -> b) -> a -> b
$ (KnownPeers PeerAddr -> Maybe (KnownPeers PeerAddr)
forall a. a -> Maybe a
Just (KnownPeers PeerAddr -> Maybe (KnownPeers PeerAddr))
-> (TimedDecision
      (IOSim s)
      extraState
      NoExtraFlags
      extraFlags
      extraPeers
      PeerAddr
      NoExtraFlags
    -> KnownPeers PeerAddr)
-> TimedDecision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags
-> Maybe (KnownPeers PeerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decision
  (IOSim s)
  extraState
  NoExtraFlags
  extraFlags
  extraPeers
  PeerAddr
  NoExtraFlags
-> KnownPeers PeerAddr
forall s.
Decision
  (IOSim s)
  extraState
  NoExtraFlags
  extraFlags
  extraPeers
  PeerAddr
  NoExtraFlags
-> KnownPeers PeerAddr
knownPeersOf (Decision
   (IOSim s)
   extraState
   NoExtraFlags
   extraFlags
   extraPeers
   PeerAddr
   NoExtraFlags
 -> KnownPeers PeerAddr)
-> (TimedDecision
      (IOSim s)
      extraState
      NoExtraFlags
      extraFlags
      extraPeers
      PeerAddr
      NoExtraFlags
    -> Decision
         (IOSim s)
         extraState
         NoExtraFlags
         extraFlags
         extraPeers
         PeerAddr
         NoExtraFlags)
-> TimedDecision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags
-> KnownPeers PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimedDecision
  (IOSim s)
  extraState
  NoExtraFlags
  extraFlags
  extraPeers
  PeerAddr
  NoExtraFlags
-> TimedDecision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags
forall a b. (a -> b) -> a -> b
$ DiffTime -> Time
Time DiffTime
0) (TimedDecision
   (IOSim s)
   extraState
   NoExtraFlags
   extraFlags
   extraPeers
   PeerAddr
   NoExtraFlags
 -> Maybe (KnownPeers PeerAddr))
-> STM
     s
     (TimedDecision
        (IOSim s)
        extraState
        NoExtraFlags
        extraFlags
        extraPeers
        PeerAddr
        NoExtraFlags)
-> STM s (Maybe (KnownPeers PeerAddr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM
  s
  (TimedDecision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags)
decide) STM s (Maybe (KnownPeers PeerAddr))
-> STM s (Maybe (KnownPeers PeerAddr))
-> STM s (Maybe (KnownPeers PeerAddr))
forall a. STM s a -> STM s a -> STM s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (KnownPeers PeerAddr) -> STM s (Maybe (KnownPeers PeerAddr))
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (KnownPeers PeerAddr)
forall a. Maybe a
Nothing
        GuardedSkip Maybe Time
_ -> Maybe (KnownPeers PeerAddr)
-> IOSim s (Maybe (KnownPeers PeerAddr))
forall a. a -> IOSim s a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (KnownPeers PeerAddr)
forall a. Maybe a
Nothing

    knownPeersOf :: Governor.Decision (IOSim s) extraState () extraFlags extraPeers PeerAddr ()
                 -> KnownPeers.KnownPeers PeerAddr
    knownPeersOf :: forall s.
Decision
  (IOSim s)
  extraState
  NoExtraFlags
  extraFlags
  extraPeers
  PeerAddr
  NoExtraFlags
-> KnownPeers PeerAddr
knownPeersOf = PeerSelectionState
  extraState extraFlags extraPeers PeerAddr NoExtraFlags
-> KnownPeers PeerAddr
forall extraState extraFlags extraPeers peeraddr peerconn.
PeerSelectionState
  extraState extraFlags extraPeers peeraddr peerconn
-> KnownPeers peeraddr
Governor.knownPeers (PeerSelectionState
   extraState extraFlags extraPeers PeerAddr NoExtraFlags
 -> KnownPeers PeerAddr)
-> (Decision
      (IOSim s)
      extraState
      NoExtraFlags
      extraFlags
      extraPeers
      PeerAddr
      NoExtraFlags
    -> PeerSelectionState
         extraState extraFlags extraPeers PeerAddr NoExtraFlags)
-> Decision
     (IOSim s)
     extraState
     NoExtraFlags
     extraFlags
     extraPeers
     PeerAddr
     NoExtraFlags
-> KnownPeers PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decision
  (IOSim s)
  extraState
  NoExtraFlags
  extraFlags
  extraPeers
  PeerAddr
  NoExtraFlags
-> PeerSelectionState
     extraState extraFlags extraPeers PeerAddr NoExtraFlags
forall (m :: * -> *) extraState extraDebugState extraFlags
       extraPeers peeraddr peerconn.
Decision
  m
  extraState
  extraDebugState
  extraFlags
  extraPeers
  peeraddr
  peerconn
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
Governor.decisionState

    state :: Governor.PeerSelectionState extraState extraFlags extraPeers PeerAddr ()
    state :: PeerSelectionState
  extraState extraFlags extraPeers PeerAddr NoExtraFlags
state = (StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState (ZonkAny 0) extraPeers PeerAddr NoExtraFlags
forall extraState extraPeers extraFlags peeraddr peerconn.
StdGen
-> extraState
-> extraPeers
-> PeerSelectionState
     extraState extraFlags extraPeers peeraddr peerconn
Governor.emptyPeerSelectionState (Int -> StdGen
mkStdGen Int
0) extraState
extraState extraPeers
extraPeers) {
              Governor.localRootPeers = acOld,
              Governor.knownPeers     = knownPeersBefore change,
              Governor.targets        = targets
            }

    actions :: Governor.PeerSelectionActions extraState extraFlags extraPeers () PeerAddr () (IOSim s)
    actions :: forall s.
PeerSelectionActions
  extraState
  extraFlags
  extraPeers
  NoExtraFlags
  PeerAddr
  NoExtraFlags
  (IOSim s)
actions = Governor.PeerSelectionActions {
                peerSelectionTargets :: PeerSelectionTargets
Governor.peerSelectionTargets       = PeerSelectionTargets
targets,
                readPeerSelectionTargets :: STM (IOSim s) PeerSelectionTargets
Governor.readPeerSelectionTargets   = PeerSelectionTargets -> STM s PeerSelectionTargets
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerSelectionTargets
targets,
                readLocalRootPeersFromFile :: STM (IOSim s) (Config extraFlags RelayAccessPoint)
Governor.readLocalRootPeersFromFile = TestName -> STM s (Config extraFlags RelayAccessPoint)
forall a. HasCallStack => TestName -> a
error TestName
"readLocalRootPeersFromFile",
                readLocalRootPeers :: STM (IOSim s) (Config extraFlags PeerAddr)
Governor.readLocalRootPeers         = Config extraFlags PeerAddr -> STM s (Config extraFlags PeerAddr)
forall a. a -> STM s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalRootPeers extraFlags PeerAddr -> Config extraFlags PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers extraFlags PeerAddr
acNew),
                readInboundPeers :: IOSim s (Map PeerAddr PeerSharing)
Governor.readInboundPeers           = TestName -> IOSim s (Map PeerAddr PeerSharing)
forall a. HasCallStack => TestName -> a
error TestName
"readInboundPeers",
                peerSharing :: PeerSharing
Governor.peerSharing                = TestName -> PeerSharing
forall a. HasCallStack => TestName -> a
error TestName
"peerSharing",
                peerConnToPeerSharing :: NoExtraFlags -> PeerSharing
Governor.peerConnToPeerSharing      = TestName -> NoExtraFlags -> PeerSharing
forall a. HasCallStack => TestName -> a
error TestName
"peerConnToPeerSharing",
                extraPeersAPI :: PublicExtraPeersAPI extraPeers PeerAddr
Governor.extraPeersAPI              = PublicExtraPeersAPI extraPeers PeerAddr
extraPeersAPI,
                requestPublicRootPeers :: SomeLedgerPeersKind
-> StdGen
-> Int
-> IOSim s (PublicRootPeers extraPeers PeerAddr, DiffTime)
Governor.requestPublicRootPeers     = TestName
-> SomeLedgerPeersKind
-> StdGen
-> Int
-> IOSim s (PublicRootPeers extraPeers PeerAddr, DiffTime)
forall a. HasCallStack => TestName -> a
error TestName
"requestPublicRootPeers",
                requestPeerShare :: PeerSharingAmount
-> PeerAddr -> IOSim s (PeerSharingResult PeerAddr)
Governor.requestPeerShare           = TestName
-> PeerSharingAmount
-> PeerAddr
-> IOSim s (PeerSharingResult PeerAddr)
forall a. HasCallStack => TestName -> a
error TestName
"requestPeerShare",
                peerStateActions :: PeerStateActions PeerAddr extraFlags NoExtraFlags (IOSim s)
Governor.peerStateActions           = TestName
-> PeerStateActions PeerAddr extraFlags NoExtraFlags (IOSim s)
forall a. HasCallStack => TestName -> a
error TestName
"peerStateActions",
                getLedgerStateCtx :: LedgerPeersConsensusInterface NoExtraFlags (IOSim s)
Governor.getLedgerStateCtx          = TestName -> LedgerPeersConsensusInterface NoExtraFlags (IOSim s)
forall a. HasCallStack => TestName -> a
error TestName
"getLedgerStateCtx",
                readLedgerPeerSnapshot :: STM (IOSim s) (Maybe (LedgerPeerSnapshot BigLedgerPeers))
Governor.readLedgerPeerSnapshot     = TestName -> STM s (Maybe (LedgerPeerSnapshot BigLedgerPeers))
forall a. HasCallStack => TestName -> a
error TestName
"readLedgerPeerSnapshot"
              }

arbitraryLocalRootPeers :: (Ord peeraddr, Arbitrary extraFlags)
                        => Set peeraddr -> Gen (LocalRootPeers extraFlags peeraddr)
arbitraryLocalRootPeers :: forall peeraddr extraFlags.
(Ord peeraddr, Arbitrary extraFlags) =>
Set peeraddr -> Gen (LocalRootPeers extraFlags peeraddr)
arbitraryLocalRootPeers Set peeraddr
peeraddrs = do
    -- divide into a few disjoint groups
    ngroups     <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
5 :: Int)
    gassignment <- vectorOf (Set.size peeraddrs) (choose (1, ngroups))
    advertise   <- vectorOf (Set.size peeraddrs) arbitrary
    let groups = Map Int (Map peeraddr (LocalRootConfig extraFlags))
-> [Map peeraddr (LocalRootConfig extraFlags)]
forall k a. Map k a -> [a]
Map.elems (Map Int (Map peeraddr (LocalRootConfig extraFlags))
 -> [Map peeraddr (LocalRootConfig extraFlags)])
-> Map Int (Map peeraddr (LocalRootConfig extraFlags))
-> [Map peeraddr (LocalRootConfig extraFlags)]
forall a b. (a -> b) -> a -> b
$
                 (Map peeraddr (LocalRootConfig extraFlags)
 -> Map peeraddr (LocalRootConfig extraFlags)
 -> Map peeraddr (LocalRootConfig extraFlags))
-> [(Int, Map peeraddr (LocalRootConfig extraFlags))]
-> Map Int (Map peeraddr (LocalRootConfig extraFlags))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Map peeraddr (LocalRootConfig extraFlags)
-> Map peeraddr (LocalRootConfig extraFlags)
-> Map peeraddr (LocalRootConfig extraFlags)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union
                   [ (Int
gn, peeraddr
-> LocalRootConfig extraFlags
-> Map peeraddr (LocalRootConfig extraFlags)
forall k a. k -> a -> Map k a
Map.singleton peeraddr
p LocalRootConfig extraFlags
a)
                   | (peeraddr
p, Int
gn, LocalRootConfig extraFlags
a) <- [peeraddr]
-> [Int]
-> [LocalRootConfig extraFlags]
-> [(peeraddr, Int, LocalRootConfig extraFlags)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (Set peeraddr -> [peeraddr]
forall a. Set a -> [a]
Set.toList Set peeraddr
peeraddrs)
                                         [Int]
gassignment
                                         [LocalRootConfig extraFlags]
advertise
                   ]
    targets <- mapM (\Map peeraddr (LocalRootConfig extraFlags)
g -> do
                      warmValency <- Int -> WarmValency
WarmValency (Int -> WarmValency) -> Gen Int -> Gen WarmValency
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Map peeraddr (LocalRootConfig extraFlags) -> Int
forall k a. Map k a -> Int
Map.size Map peeraddr (LocalRootConfig extraFlags)
g)
                      hotValency <- HotValency <$> choose (0, getWarmValency warmValency)
                      return (hotValency, warmValency)
                    ) groups

    return (LocalRootPeers.fromGroups (zipWith (\(HotValency
h, WarmValency
w) Map peeraddr (LocalRootConfig extraFlags)
g -> (HotValency
h, WarmValency
w, Map peeraddr (LocalRootConfig extraFlags)
g))
                                               targets
                                               groups))

instance (Arbitrary extraFlags, Arbitrary peeraddr, Ord peeraddr) =>
         Arbitrary (LocalRootPeers extraFlags peeraddr) where
    arbitrary :: Gen (LocalRootPeers extraFlags peeraddr)
arbitrary = do
        peeraddrs <- (Int -> Int) -> Gen (Set peeraddr) -> Gen (Set peeraddr)
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Gen (Set peeraddr)
forall a. Arbitrary a => Gen a
arbitrary
        arbitraryLocalRootPeers peeraddrs

    shrink :: LocalRootPeers extraFlags peeraddr
-> [LocalRootPeers extraFlags peeraddr]
shrink LocalRootPeers extraFlags peeraddr
lrps =
        ([(HotValency, WarmValency,
   Map peeraddr (LocalRootConfig extraFlags))]
 -> LocalRootPeers extraFlags peeraddr)
-> [[(HotValency, WarmValency,
      Map peeraddr (LocalRootConfig extraFlags))]]
-> [LocalRootPeers extraFlags peeraddr]
forall a b. (a -> b) -> [a] -> [b]
map [(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups ([(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> [[(HotValency, WarmValency,
      Map peeraddr (LocalRootConfig extraFlags))]]
forall a. Arbitrary a => a -> [a]
shrink (LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers extraFlags peeraddr
lrps))

restrictKeys :: Ord peeraddr
             => LocalRootPeers extraFlags peeraddr
             -> Set peeraddr
             -> LocalRootPeers extraFlags peeraddr
restrictKeys :: forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> Set peeraddr -> LocalRootPeers extraFlags peeraddr
restrictKeys LocalRootPeers extraFlags peeraddr
lrps Set peeraddr
ks =
    [(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups
  ([(HotValency, WarmValency,
   Map peeraddr (LocalRootConfig extraFlags))]
 -> LocalRootPeers extraFlags peeraddr)
-> (LocalRootPeers extraFlags peeraddr
    -> [(HotValency, WarmValency,
         Map peeraddr (LocalRootConfig extraFlags))])
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))
 -> (HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags)))
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
forall a b. (a -> b) -> [a] -> [b]
map (\(HotValency
h, WarmValency
w, Map peeraddr (LocalRootConfig extraFlags)
g) -> (HotValency
h, WarmValency
w, Map peeraddr (LocalRootConfig extraFlags)
-> Set peeraddr -> Map peeraddr (LocalRootConfig extraFlags)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map peeraddr (LocalRootConfig extraFlags)
g Set peeraddr
ks))
  ([(HotValency, WarmValency,
   Map peeraddr (LocalRootConfig extraFlags))]
 -> [(HotValency, WarmValency,
      Map peeraddr (LocalRootConfig extraFlags))])
-> (LocalRootPeers extraFlags peeraddr
    -> [(HotValency, WarmValency,
         Map peeraddr (LocalRootConfig extraFlags))])
-> LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups
  (LocalRootPeers extraFlags peeraddr
 -> LocalRootPeers extraFlags peeraddr)
-> LocalRootPeers extraFlags peeraddr
-> LocalRootPeers extraFlags peeraddr
forall a b. (a -> b) -> a -> b
$ LocalRootPeers extraFlags peeraddr
lrps

prop_arbitrary_LocalRootPeers :: Arbitrary extraFlags => LocalRootPeers extraFlags PeerAddr -> Property
prop_arbitrary_LocalRootPeers :: forall extraFlags.
Arbitrary extraFlags =>
LocalRootPeers extraFlags PeerAddr -> Property
prop_arbitrary_LocalRootPeers LocalRootPeers extraFlags PeerAddr
lrps =
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"total size"    [TestName
size] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"num groups"    [TestName
numGroups] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"group size"    [TestName]
sizeGroups (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestName] -> Bool -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate TestName
"targets"       [TestName]
targets (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$

    LocalRootPeers extraFlags PeerAddr -> Bool
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.invariant LocalRootPeers extraFlags PeerAddr
lrps
  where
    thrd :: (a, b, c) -> c
thrd (a
_, b
_, c
c) = c
c
    size :: TestName
size       = Int -> Int -> TestName
renderRanges Int
5 (LocalRootPeers extraFlags PeerAddr -> Int
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr -> Int
LocalRootPeers.size LocalRootPeers extraFlags PeerAddr
lrps)
    numGroups :: TestName
numGroups  = Int -> TestName
forall a. Show a => a -> TestName
show ([(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (LocalRootPeers extraFlags PeerAddr
-> [(HotValency, WarmValency,
     Map PeerAddr (LocalRootConfig extraFlags))]
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers extraFlags PeerAddr
lrps))
    sizeGroups :: [TestName]
sizeGroups = ((HotValency, WarmValency, Set PeerAddr) -> TestName)
-> [(HotValency, WarmValency, Set PeerAddr)] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TestName
forall a. Show a => a -> TestName
show (Int -> TestName)
-> ((HotValency, WarmValency, Set PeerAddr) -> Int)
-> (HotValency, WarmValency, Set PeerAddr)
-> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set PeerAddr -> Int
forall a. Set a -> Int
Set.size (Set PeerAddr -> Int)
-> ((HotValency, WarmValency, Set PeerAddr) -> Set PeerAddr)
-> (HotValency, WarmValency, Set PeerAddr)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HotValency, WarmValency, Set PeerAddr) -> Set PeerAddr
forall {a} {b} {c}. (a, b, c) -> c
thrd) (LocalRootPeers extraFlags PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers extraFlags PeerAddr
lrps)
    targets :: [TestName]
targets    = [ case () of
                    NoExtraFlags
_ | HotValency
h HotValency -> HotValency -> Bool
forall a. Eq a => a -> a -> Bool
== HotValency
0                        -> TestName
"none active"
                      | WarmValency
w WarmValency -> WarmValency -> Bool
forall a. Eq a => a -> a -> Bool
== WarmValency
0                        -> TestName
"none established"
                      | HotValency
h HotValency -> HotValency -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> HotValency
HotValency (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
g)  -> TestName
"all active"
                      | WarmValency
w WarmValency -> WarmValency -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> WarmValency
WarmValency (Set PeerAddr -> Int
forall a. Set a -> Int
Set.size Set PeerAddr
g) -> TestName
"all established"
                      | Bool
otherwise                     -> TestName
"some"
                 | (HotValency
h, WarmValency
w, Set PeerAddr
g) <- LocalRootPeers extraFlags PeerAddr
-> [(HotValency, WarmValency, Set PeerAddr)]
forall extraFlags peeraddr.
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency, Set peeraddr)]
LocalRootPeers.toGroupSets LocalRootPeers extraFlags PeerAddr
lrps ]


prop_shrink_LocalRootPeers
  :: ( Eq extraFlags
     , Show extraFlags
     , Arbitrary extraFlags
     )
  => ShrinkCarefully (LocalRootPeers extraFlags PeerAddr)
  -> Property
prop_shrink_LocalRootPeers :: forall extraFlags.
(Eq extraFlags, Show extraFlags, Arbitrary extraFlags) =>
ShrinkCarefully (LocalRootPeers extraFlags PeerAddr) -> Property
prop_shrink_LocalRootPeers ShrinkCarefully (LocalRootPeers extraFlags PeerAddr)
x =
      (LocalRootPeers extraFlags PeerAddr -> Bool)
-> ShrinkCarefully (LocalRootPeers extraFlags PeerAddr) -> Property
forall a prop.
(Arbitrary a, Show a, Testable prop) =>
(a -> prop) -> ShrinkCarefully a -> Property
prop_shrink_valid LocalRootPeers extraFlags PeerAddr -> Bool
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.invariant ShrinkCarefully (LocalRootPeers extraFlags PeerAddr)
x
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. ShrinkCarefully (LocalRootPeers extraFlags PeerAddr) -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal ShrinkCarefully (LocalRootPeers extraFlags PeerAddr)
x

prop_fromGroups :: [(HotValency, WarmValency, Map PeerAddr (LocalRootConfig extraFlags))]
                -> Bool
prop_fromGroups :: forall extraFlags.
[(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> Bool
prop_fromGroups = LocalRootPeers extraFlags PeerAddr -> Bool
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr -> Bool
LocalRootPeers.invariant (LocalRootPeers extraFlags PeerAddr -> Bool)
-> ([(HotValency, WarmValency,
      Map PeerAddr (LocalRootConfig extraFlags))]
    -> LocalRootPeers extraFlags PeerAddr)
-> [(HotValency, WarmValency,
     Map PeerAddr (LocalRootConfig extraFlags))]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups

prop_fromToGroups
  :: Eq extraFlags
  => LocalRootPeers extraFlags PeerAddr
  -> Bool
prop_fromToGroups :: forall extraFlags.
Eq extraFlags =>
LocalRootPeers extraFlags PeerAddr -> Bool
prop_fromToGroups LocalRootPeers extraFlags PeerAddr
lrps =
    [(HotValency, WarmValency,
  Map PeerAddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags PeerAddr
forall peeraddr extraFlags.
Ord peeraddr =>
[(HotValency, WarmValency,
  Map peeraddr (LocalRootConfig extraFlags))]
-> LocalRootPeers extraFlags peeraddr
LocalRootPeers.fromGroups (LocalRootPeers extraFlags PeerAddr
-> [(HotValency, WarmValency,
     Map PeerAddr (LocalRootConfig extraFlags))]
forall peeraddr extraFlags.
Ord peeraddr =>
LocalRootPeers extraFlags peeraddr
-> [(HotValency, WarmValency,
     Map peeraddr (LocalRootConfig extraFlags))]
LocalRootPeers.toGroups LocalRootPeers extraFlags PeerAddr
lrps) LocalRootPeers extraFlags PeerAddr
-> LocalRootPeers extraFlags PeerAddr -> Bool
forall a. Eq a => a -> a -> Bool
== LocalRootPeers extraFlags PeerAddr
lrps