{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Test.Ouroboros.Network.PeerSelection.PeerGraph
  ( PeerGraph (..)
  , validPeerGraph
  , allPeers
  , peerShareReachablePeers
  , GovernorScripts (..)
  , PeerShareScript
  , ConnectionScript
  , PeerSharingScript
  , AsyncDemotion (..)
  , PeerShareTime (..)
  , interpretPeerShareTime
  , prop_shrink_GovernorScripts
  , prop_arbitrary_PeerGraph
  , prop_shrink_PeerGraph
  , prop_shrink_nonequal_PeerGraph
  , prop_shrink_nonequal_GovernorScripts
  ) where

import Data.Graph (Graph)
import Data.Graph qualified as Graph
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Tree qualified as Tree

import Control.Monad.Class.MonadTime.SI

import Ouroboros.Network.Testing.Data.Script (Script (..),
           ScriptDelay (NoDelay), TimedScript, arbitraryScriptOf)
import Ouroboros.Network.Testing.Utils (ShrinkCarefully (..),
           prop_shrink_nonequal, prop_shrink_valid, renderRanges)
import Test.Ouroboros.Network.PeerSelection.Instances

import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
import Test.QuickCheck


--
-- Mock environment types
--

-- | The peer graph is the graph of all the peers in the mock p2p network, in
-- traditional adjacency representation.
--
newtype PeerGraph = PeerGraph [(PeerAddr, [PeerAddr], PeerInfo)]
  deriving (PeerGraph -> PeerGraph -> Bool
(PeerGraph -> PeerGraph -> Bool)
-> (PeerGraph -> PeerGraph -> Bool) -> Eq PeerGraph
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerGraph -> PeerGraph -> Bool
== :: PeerGraph -> PeerGraph -> Bool
$c/= :: PeerGraph -> PeerGraph -> Bool
/= :: PeerGraph -> PeerGraph -> Bool
Eq, Int -> PeerGraph -> ShowS
[PeerGraph] -> ShowS
PeerGraph -> String
(Int -> PeerGraph -> ShowS)
-> (PeerGraph -> String)
-> ([PeerGraph] -> ShowS)
-> Show PeerGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerGraph -> ShowS
showsPrec :: Int -> PeerGraph -> ShowS
$cshow :: PeerGraph -> String
show :: PeerGraph -> String
$cshowList :: [PeerGraph] -> ShowS
showList :: [PeerGraph] -> ShowS
Show)

-- | For now the information associated with each node is just the peer sharing
-- script and connection script.
--
type PeerInfo = GovernorScripts

data GovernorScripts = GovernorScripts {
    GovernorScripts -> PeerShareScript
peerShareScript   :: PeerShareScript,
    GovernorScripts -> PeerSharingScript
peerSharingScript :: PeerSharingScript,
    GovernorScripts -> ConnectionScript
connectionScript  :: ConnectionScript
  }
  deriving (GovernorScripts -> GovernorScripts -> Bool
(GovernorScripts -> GovernorScripts -> Bool)
-> (GovernorScripts -> GovernorScripts -> Bool)
-> Eq GovernorScripts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernorScripts -> GovernorScripts -> Bool
== :: GovernorScripts -> GovernorScripts -> Bool
$c/= :: GovernorScripts -> GovernorScripts -> Bool
/= :: GovernorScripts -> GovernorScripts -> Bool
Eq, Int -> GovernorScripts -> ShowS
[GovernorScripts] -> ShowS
GovernorScripts -> String
(Int -> GovernorScripts -> ShowS)
-> (GovernorScripts -> String)
-> ([GovernorScripts] -> ShowS)
-> Show GovernorScripts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernorScripts -> ShowS
showsPrec :: Int -> GovernorScripts -> ShowS
$cshow :: GovernorScripts -> String
show :: GovernorScripts -> String
$cshowList :: [GovernorScripts] -> ShowS
showList :: [GovernorScripts] -> ShowS
Show)


-- | The peer sharing script is the script we interpret to provide answers to
-- peer share requests that the governor makes. After each peer share request
-- to a peer we move on to the next entry in the script, unless we get to the
-- end in which case that becomes the reply for all remaining peer share requests.
--
-- A @Nothing@ indicates failure. The @[PeerAddr]@ is the list of peers to
-- return which must always be a subset of the actual edges in the p2p graph.
--
-- This representation was chosen because it allows easy shrinking.
--
type PeerShareScript = Script (Maybe ([PeerAddr], PeerShareTime))

-- | The peer sharing time is our simulation of elapsed time to respond to peer
-- share requests. This is important because the governor uses timeouts and
-- behaves differently in these three cases.
--
data PeerShareTime = PeerShareTimeQuick | PeerShareTimeSlow | PeerShareTimeTimeout
  deriving (PeerShareTime -> PeerShareTime -> Bool
(PeerShareTime -> PeerShareTime -> Bool)
-> (PeerShareTime -> PeerShareTime -> Bool) -> Eq PeerShareTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerShareTime -> PeerShareTime -> Bool
== :: PeerShareTime -> PeerShareTime -> Bool
$c/= :: PeerShareTime -> PeerShareTime -> Bool
/= :: PeerShareTime -> PeerShareTime -> Bool
Eq, Int -> PeerShareTime -> ShowS
[PeerShareTime] -> ShowS
PeerShareTime -> String
(Int -> PeerShareTime -> ShowS)
-> (PeerShareTime -> String)
-> ([PeerShareTime] -> ShowS)
-> Show PeerShareTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerShareTime -> ShowS
showsPrec :: Int -> PeerShareTime -> ShowS
$cshow :: PeerShareTime -> String
show :: PeerShareTime -> String
$cshowList :: [PeerShareTime] -> ShowS
showList :: [PeerShareTime] -> ShowS
Show)

interpretPeerShareTime :: PeerShareTime -> DiffTime
interpretPeerShareTime :: PeerShareTime -> DiffTime
interpretPeerShareTime PeerShareTime
PeerShareTimeQuick   = DiffTime
1
interpretPeerShareTime PeerShareTime
PeerShareTimeSlow    = DiffTime
5
interpretPeerShareTime PeerShareTime
PeerShareTimeTimeout = DiffTime
25


-- | Connection script is the script which provides asynchronous demotions
-- either to cold or warm peer.
--
type ConnectionScript = TimedScript AsyncDemotion

data AsyncDemotion = ToWarm
                   | ToCooling
                   | ToCold
                   | Noop
  deriving (AsyncDemotion -> AsyncDemotion -> Bool
(AsyncDemotion -> AsyncDemotion -> Bool)
-> (AsyncDemotion -> AsyncDemotion -> Bool) -> Eq AsyncDemotion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AsyncDemotion -> AsyncDemotion -> Bool
== :: AsyncDemotion -> AsyncDemotion -> Bool
$c/= :: AsyncDemotion -> AsyncDemotion -> Bool
/= :: AsyncDemotion -> AsyncDemotion -> Bool
Eq, Int -> AsyncDemotion -> ShowS
[AsyncDemotion] -> ShowS
AsyncDemotion -> String
(Int -> AsyncDemotion -> ShowS)
-> (AsyncDemotion -> String)
-> ([AsyncDemotion] -> ShowS)
-> Show AsyncDemotion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AsyncDemotion -> ShowS
showsPrec :: Int -> AsyncDemotion -> ShowS
$cshow :: AsyncDemotion -> String
show :: AsyncDemotion -> String
$cshowList :: [AsyncDemotion] -> ShowS
showList :: [AsyncDemotion] -> ShowS
Show)

-- | PeerSharing script is the script which provides PeerSharing values
-- when a new connection is established.
--
type PeerSharingScript = Script PeerSharing

-- | Invariant. Used to check the QC generator and shrinker.
--
validPeerGraph :: PeerGraph -> Bool
validPeerGraph :: PeerGraph -> Bool
validPeerGraph g :: PeerGraph
g@(PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency) =
    [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Set PeerAddr
edgesSet  Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
allpeersSet Bool -> Bool -> Bool
&&
          Set PeerAddr
peerShareSet Set PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set PeerAddr
edgesSet
        | let allpeersSet :: Set PeerAddr
allpeersSet = PeerGraph -> Set PeerAddr
allPeers PeerGraph
g
        , (PeerAddr
_, [PeerAddr]
outedges, GovernorScripts { peerShareScript :: GovernorScripts -> PeerShareScript
peerShareScript = Script NonEmpty (Maybe ([PeerAddr], PeerShareTime))
script }) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency
        , let edgesSet :: Set PeerAddr
edgesSet  = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [PeerAddr]
outedges
              peerShareSet :: Set PeerAddr
peerShareSet = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
                            [ PeerAddr
x | Just ([PeerAddr]
xs, PeerShareTime
_) <- NonEmpty (Maybe ([PeerAddr], PeerShareTime))
-> [Maybe ([PeerAddr], PeerShareTime)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Maybe ([PeerAddr], PeerShareTime))
script
                                , PeerAddr
x <- [PeerAddr]
xs ]
        ]


--
-- Utils for properties
--

allPeers :: PeerGraph -> Set PeerAddr
allPeers :: PeerGraph -> Set PeerAddr
allPeers (PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
g) = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [ PeerAddr
addr | (PeerAddr
addr, [PeerAddr]
_, GovernorScripts
_) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
g ]

-- | The peers that are notionally reachable from the root set. It is notional
-- in the sense that it only takes account of the connectivity graph and not
-- the 'PeerShareScript's which determine what subset of edges the governor
-- actually sees when it tries to peer share.
--
_notionallyReachablePeers :: PeerGraph -> Set PeerAddr -> Set PeerAddr
_notionallyReachablePeers :: PeerGraph -> Set PeerAddr -> Set PeerAddr
_notionallyReachablePeers PeerGraph
pg Set PeerAddr
roots =
    [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
  ([PeerAddr] -> Set PeerAddr)
-> ([PeerAddr] -> [PeerAddr]) -> [PeerAddr] -> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PeerAddr) -> [Int] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map Int -> PeerAddr
vertexToAddr
  ([Int] -> [PeerAddr])
-> ([PeerAddr] -> [Int]) -> [PeerAddr] -> [PeerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree Int -> [Int]) -> [Tree Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Int -> [Int]
forall a. Tree a -> [a]
Tree.flatten
  ([Tree Int] -> [Int])
-> ([PeerAddr] -> [Tree Int]) -> [PeerAddr] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int] -> [Tree Int]
Graph.dfs Graph
graph
  ([Int] -> [Tree Int])
-> ([PeerAddr] -> [Int]) -> [PeerAddr] -> [Tree Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerAddr -> Int) -> [PeerAddr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PeerAddr -> Int
addrToVertex
  ([PeerAddr] -> Set PeerAddr) -> [PeerAddr] -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ Set PeerAddr -> [PeerAddr]
forall a. Set a -> [a]
Set.toList Set PeerAddr
roots
  where
    (Graph
graph, Int -> PeerAddr
vertexToAddr, PeerAddr -> Int
addrToVertex) = PeerGraph -> (Graph, Int -> PeerAddr, PeerAddr -> Int)
peerGraphAsGraph PeerGraph
pg

peerShareReachablePeers :: PeerGraph -> Set PeerAddr -> Set PeerAddr
peerShareReachablePeers :: PeerGraph -> Set PeerAddr -> Set PeerAddr
peerShareReachablePeers PeerGraph
pg Set PeerAddr
roots =
    [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
  ([PeerAddr] -> Set PeerAddr)
-> ([PeerAddr] -> [PeerAddr]) -> [PeerAddr] -> Set PeerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> PeerAddr) -> [Int] -> [PeerAddr]
forall a b. (a -> b) -> [a] -> [b]
map Int -> PeerAddr
vertexToAddr
  ([Int] -> [PeerAddr])
-> ([PeerAddr] -> [Int]) -> [PeerAddr] -> [PeerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree Int -> [Int]) -> [Tree Int] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree Int -> [Int]
forall a. Tree a -> [a]
Tree.flatten
  ([Tree Int] -> [Int])
-> ([PeerAddr] -> [Tree Int]) -> [PeerAddr] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph -> [Int] -> [Tree Int]
Graph.dfs Graph
graph
  ([Int] -> [Tree Int])
-> ([PeerAddr] -> [Int]) -> [PeerAddr] -> [Tree Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PeerAddr -> Int) -> [PeerAddr] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map PeerAddr -> Int
addrToVertex
  ([PeerAddr] -> Set PeerAddr) -> [PeerAddr] -> Set PeerAddr
forall a b. (a -> b) -> a -> b
$ Set PeerAddr -> [PeerAddr]
forall a. Set a -> [a]
Set.toList Set PeerAddr
roots
  where
    (Graph
graph, Int -> PeerAddr
vertexToAddr, PeerAddr -> Int
addrToVertex) = PeerGraph -> (Graph, Int -> PeerAddr, PeerAddr -> Int)
peerShareGraph PeerGraph
pg

peerGraphAsGraph :: PeerGraph
                 -> (Graph, Graph.Vertex -> PeerAddr, PeerAddr -> Graph.Vertex)
peerGraphAsGraph :: PeerGraph -> (Graph, Int -> PeerAddr, PeerAddr -> Int)
peerGraphAsGraph (PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency) =
    (Graph, Int -> ((), PeerAddr, [PeerAddr]), PeerAddr -> Maybe Int)
-> (Graph, Int -> PeerAddr, PeerAddr -> Int)
forall a n.
(Graph, Int -> (a, n, [n]), n -> Maybe Int)
-> (Graph, Int -> n, n -> Int)
simpleGraphRep ((Graph, Int -> ((), PeerAddr, [PeerAddr]), PeerAddr -> Maybe Int)
 -> (Graph, Int -> PeerAddr, PeerAddr -> Int))
-> (Graph, Int -> ((), PeerAddr, [PeerAddr]),
    PeerAddr -> Maybe Int)
-> (Graph, Int -> PeerAddr, PeerAddr -> Int)
forall a b. (a -> b) -> a -> b
$
      [((), PeerAddr, [PeerAddr])]
-> (Graph, Int -> ((), PeerAddr, [PeerAddr]),
    PeerAddr -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
Graph.graphFromEdges [ ((), PeerAddr
node, [PeerAddr]
edges) | (PeerAddr
node, [PeerAddr]
edges, GovernorScripts
_) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency ]

peerShareGraph :: PeerGraph
                 -> (Graph, Graph.Vertex -> PeerAddr, PeerAddr -> Graph.Vertex)
peerShareGraph :: PeerGraph -> (Graph, Int -> PeerAddr, PeerAddr -> Int)
peerShareGraph (PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency) =
    (Graph, Int -> ((), PeerAddr, [PeerAddr]), PeerAddr -> Maybe Int)
-> (Graph, Int -> PeerAddr, PeerAddr -> Int)
forall a n.
(Graph, Int -> (a, n, [n]), n -> Maybe Int)
-> (Graph, Int -> n, n -> Int)
simpleGraphRep ((Graph, Int -> ((), PeerAddr, [PeerAddr]), PeerAddr -> Maybe Int)
 -> (Graph, Int -> PeerAddr, PeerAddr -> Int))
-> (Graph, Int -> ((), PeerAddr, [PeerAddr]),
    PeerAddr -> Maybe Int)
-> (Graph, Int -> PeerAddr, PeerAddr -> Int)
forall a b. (a -> b) -> a -> b
$
      [((), PeerAddr, [PeerAddr])]
-> (Graph, Int -> ((), PeerAddr, [PeerAddr]),
    PeerAddr -> Maybe Int)
forall key node.
Ord key =>
[(node, key, [key])]
-> (Graph, Int -> (node, key, [key]), key -> Maybe Int)
Graph.graphFromEdges
        [ ((), PeerAddr
node, PeerShareScript -> [PeerAddr]
peerShareScriptEdges PeerShareScript
peerShareScript)
        | (PeerAddr
node, [PeerAddr]
_edges, GovernorScripts { PeerShareScript
peerShareScript :: GovernorScripts -> PeerShareScript
peerShareScript :: PeerShareScript
peerShareScript }) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
adjacency ]
  where
    peerShareScriptEdges :: PeerShareScript -> [PeerAddr]
    peerShareScriptEdges :: PeerShareScript -> [PeerAddr]
peerShareScriptEdges (Script (Maybe ([PeerAddr], PeerShareTime)
script :| [])) =
      case Maybe ([PeerAddr], PeerShareTime)
script of
        Maybe ([PeerAddr], PeerShareTime)
Nothing                        -> []
        Just ([PeerAddr]
_, PeerShareTime
PeerShareTimeTimeout) -> []
        Just ([PeerAddr]
edges, PeerShareTime
_)                -> [PeerAddr]
edges
    peerShareScriptEdges (Script (Maybe ([PeerAddr], PeerShareTime)
script :| (Maybe ([PeerAddr], PeerShareTime)
h:[Maybe ([PeerAddr], PeerShareTime)]
t))) =
      case Maybe ([PeerAddr], PeerShareTime)
script of
        Maybe ([PeerAddr], PeerShareTime)
Nothing                        -> PeerShareScript -> [PeerAddr]
peerShareScriptEdges (NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
h Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| [Maybe ([PeerAddr], PeerShareTime)]
t))
        Just ([PeerAddr]
_, PeerShareTime
PeerShareTimeTimeout) -> PeerShareScript -> [PeerAddr]
peerShareScriptEdges (NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
h Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| [Maybe ([PeerAddr], PeerShareTime)]
t))
        Just ([PeerAddr]
edges, PeerShareTime
_)                -> [PeerAddr]
edges
                                       [PeerAddr] -> [PeerAddr] -> [PeerAddr]
forall a. [a] -> [a] -> [a]
++ PeerShareScript -> [PeerAddr]
peerShareScriptEdges (NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script (Maybe ([PeerAddr], PeerShareTime)
h Maybe ([PeerAddr], PeerShareTime)
-> [Maybe ([PeerAddr], PeerShareTime)]
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> [a] -> NonEmpty a
:| [Maybe ([PeerAddr], PeerShareTime)]
t))

simpleGraphRep :: forall a n.
                  (Graph, Graph.Vertex -> (a, n, [n]), n -> Maybe Graph.Vertex)
               -> (Graph, Graph.Vertex -> n, n -> Graph.Vertex)
simpleGraphRep :: forall a n.
(Graph, Int -> (a, n, [n]), n -> Maybe Int)
-> (Graph, Int -> n, n -> Int)
simpleGraphRep (Graph
graph, Int -> (a, n, [n])
vertexInfo, n -> Maybe Int
lookupVertex) =
    (Graph
graph, Int -> n
vertexToAddr, n -> Int
addrToVertex)
  where
    vertexToAddr :: Graph.Vertex -> n
    vertexToAddr :: Int -> n
vertexToAddr Int
v = n
addr where (a
_,n
addr,[n]
_) = Int -> (a, n, [n])
vertexInfo Int
v

    addrToVertex :: n -> Graph.Vertex
    addrToVertex :: n -> Int
addrToVertex n
addr = Int
v where Just Int
v = n -> Maybe Int
lookupVertex n
addr


--
-- QuickCheck instances
--


instance Arbitrary AsyncDemotion where
    arbitrary :: Gen AsyncDemotion
arbitrary = [(Int, Gen AsyncDemotion)] -> Gen AsyncDemotion
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
2, AsyncDemotion -> Gen AsyncDemotion
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AsyncDemotion
ToWarm)
                          , (Int
2, AsyncDemotion -> Gen AsyncDemotion
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AsyncDemotion
ToCooling)
                          , (Int
2, AsyncDemotion -> Gen AsyncDemotion
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AsyncDemotion
ToCold)
                          , (Int
6, AsyncDemotion -> Gen AsyncDemotion
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AsyncDemotion
Noop)
                          ]
    shrink :: AsyncDemotion -> [AsyncDemotion]
shrink AsyncDemotion
ToWarm    = [AsyncDemotion
ToCooling, AsyncDemotion
Noop]
    shrink AsyncDemotion
ToCooling = [AsyncDemotion
ToCold, AsyncDemotion
Noop]
    shrink AsyncDemotion
ToCold    = [AsyncDemotion
Noop]
    shrink AsyncDemotion
Noop      = []


instance Arbitrary GovernorScripts where
    arbitrary :: Gen GovernorScripts
arbitrary = PeerShareScript
-> PeerSharingScript -> ConnectionScript -> GovernorScripts
GovernorScripts
            (PeerShareScript
 -> PeerSharingScript -> ConnectionScript -> GovernorScripts)
-> Gen PeerShareScript
-> Gen (PeerSharingScript -> ConnectionScript -> GovernorScripts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PeerShareScript
forall a. Arbitrary a => Gen a
arbitrary
            Gen (PeerSharingScript -> ConnectionScript -> GovernorScripts)
-> Gen PeerSharingScript
-> Gen (ConnectionScript -> GovernorScripts)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PeerSharingScript
forall a. Arbitrary a => Gen a
arbitrary
            Gen (ConnectionScript -> GovernorScripts)
-> Gen ConnectionScript -> Gen GovernorScripts
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ConnectionScript -> ConnectionScript
fixConnectionScript (ConnectionScript -> ConnectionScript)
-> Gen ConnectionScript -> Gen ConnectionScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ConnectionScript
forall a. Arbitrary a => Gen a
arbitrary)
    shrink :: GovernorScripts -> [GovernorScripts]
shrink GovernorScripts { PeerShareScript
peerShareScript :: GovernorScripts -> PeerShareScript
peerShareScript :: PeerShareScript
peerShareScript, PeerSharingScript
peerSharingScript :: GovernorScripts -> PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript, ConnectionScript
connectionScript :: GovernorScripts -> ConnectionScript
connectionScript :: ConnectionScript
connectionScript } =
      [ PeerShareScript
-> PeerSharingScript -> ConnectionScript -> GovernorScripts
GovernorScripts PeerShareScript
peerShareScript' PeerSharingScript
peerSharingScript ConnectionScript
connectionScript
      | PeerShareScript
peerShareScript' <- PeerShareScript -> [PeerShareScript]
forall a. Arbitrary a => a -> [a]
shrink PeerShareScript
peerShareScript
      ]
      [GovernorScripts] -> [GovernorScripts] -> [GovernorScripts]
forall a. [a] -> [a] -> [a]
++
      [ PeerShareScript
-> PeerSharingScript -> ConnectionScript -> GovernorScripts
GovernorScripts PeerShareScript
peerShareScript PeerSharingScript
peerSharingScript' ConnectionScript
connectionScript
      | PeerSharingScript
peerSharingScript' <- PeerSharingScript -> [PeerSharingScript]
forall a. Arbitrary a => a -> [a]
shrink PeerSharingScript
peerSharingScript
      ]
      [GovernorScripts] -> [GovernorScripts] -> [GovernorScripts]
forall a. [a] -> [a] -> [a]
++
      [ PeerShareScript
-> PeerSharingScript -> ConnectionScript -> GovernorScripts
GovernorScripts PeerShareScript
peerShareScript PeerSharingScript
peerSharingScript ConnectionScript
connectionScript'
      | ConnectionScript
connectionScript' <- (ConnectionScript -> ConnectionScript)
-> [ConnectionScript] -> [ConnectionScript]
forall a b. (a -> b) -> [a] -> [b]
map ConnectionScript -> ConnectionScript
fixConnectionScript (ConnectionScript -> [ConnectionScript]
forall a. Arbitrary a => a -> [a]
shrink ConnectionScript
connectionScript)
        -- fixConnectionScript can result in re-creating the same script
        -- which would cause shrinking to loop. Filter out such cases.
      , ConnectionScript
connectionScript' ConnectionScript -> ConnectionScript -> Bool
forall a. Eq a => a -> a -> Bool
/= ConnectionScript
connectionScript
      ]

-- | We ensure that eventually the connection script will allow to connect to
-- a given peer.  This simplifies test conditions.
--
fixConnectionScript :: ConnectionScript -> ConnectionScript
fixConnectionScript :: ConnectionScript -> ConnectionScript
fixConnectionScript (Script NonEmpty (AsyncDemotion, ScriptDelay)
script) =
    case NonEmpty (AsyncDemotion, ScriptDelay)
-> (AsyncDemotion, ScriptDelay)
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (AsyncDemotion, ScriptDelay)
script of
      (AsyncDemotion
Noop, ScriptDelay
_) -> NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script   NonEmpty (AsyncDemotion, ScriptDelay)
script
      (AsyncDemotion, ScriptDelay)
_         -> NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a. NonEmpty a -> Script a
Script (NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript)
-> NonEmpty (AsyncDemotion, ScriptDelay) -> ConnectionScript
forall a b. (a -> b) -> a -> b
$ NonEmpty (AsyncDemotion, ScriptDelay)
script NonEmpty (AsyncDemotion, ScriptDelay)
-> NonEmpty (AsyncDemotion, ScriptDelay)
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. Semigroup a => a -> a -> a
<> ((AsyncDemotion
Noop, ScriptDelay
NoDelay) (AsyncDemotion, ScriptDelay)
-> [(AsyncDemotion, ScriptDelay)]
-> NonEmpty (AsyncDemotion, ScriptDelay)
forall a. a -> [a] -> NonEmpty a
:| [])


instance Arbitrary PeerGraph where
  arbitrary :: Gen PeerGraph
arbitrary = (Int -> Gen PeerGraph) -> Gen PeerGraph
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen PeerGraph) -> Gen PeerGraph)
-> (Int -> Gen PeerGraph) -> Gen PeerGraph
forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
      numNodes <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
sz)
      numEdges <- choose (numNodes, numNodes * numNodes `div` 2)
      edges <- vectorOf numEdges $
                 (,) <$> choose (0, numNodes-1)
                     <*> choose (0, numNodes-1)
      let adjacency = (Set PeerAddr -> Set PeerAddr -> Set PeerAddr)
-> [(Int, Set PeerAddr)] -> Map Int (Set PeerAddr)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set PeerAddr -> Set PeerAddr -> Set PeerAddr
forall a. Semigroup a => a -> a -> a
(<>)
                        [ (Int
from, PeerAddr -> Set PeerAddr
forall a. a -> Set a
Set.singleton (Int -> PeerAddr
PeerAddr Int
to))
                        | (Int
from, Int
to) <- [(Int, Int)]
edges ]
      graph <- sequence [ do peerShareScript <- arbitraryPeerShareScript outedges
                             peerSharingScript <- arbitraryScriptOf (length outedges) arbitrary
                             connectionScript <- fixConnectionScript <$> arbitrary
                             let node = GovernorScripts { PeerShareScript
peerShareScript :: PeerShareScript
peerShareScript :: PeerShareScript
peerShareScript, PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript, ConnectionScript
connectionScript :: ConnectionScript
connectionScript :: ConnectionScript
connectionScript }
                             return (PeerAddr n, outedges, node)
                        | n <- [0..numNodes-1]
                        , let outedges = [PeerAddr]
-> (Set PeerAddr -> [PeerAddr])
-> Maybe (Set PeerAddr)
-> [PeerAddr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Set PeerAddr -> [PeerAddr]
forall a. Set a -> [a]
Set.toList
                                               (Int -> Map Int (Set PeerAddr) -> Maybe (Set PeerAddr)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int
n Map Int (Set PeerAddr)
adjacency) ]
      return (PeerGraph graph)

  shrink :: PeerGraph -> [PeerGraph]
shrink (PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
graph) =
      [ [(PeerAddr, [PeerAddr], GovernorScripts)] -> PeerGraph
PeerGraph ([(PeerAddr, [PeerAddr], GovernorScripts)]
-> [(PeerAddr, [PeerAddr], GovernorScripts)]
prunePeerGraphEdges [(PeerAddr, [PeerAddr], GovernorScripts)]
graph')
      | [(PeerAddr, [PeerAddr], GovernorScripts)]
graph' <- ((PeerAddr, [PeerAddr], GovernorScripts)
 -> [(PeerAddr, [PeerAddr], GovernorScripts)])
-> [(PeerAddr, [PeerAddr], GovernorScripts)]
-> [[(PeerAddr, [PeerAddr], GovernorScripts)]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList (PeerAddr, [PeerAddr], GovernorScripts)
-> [(PeerAddr, [PeerAddr], GovernorScripts)]
forall {t} {a} {a}. Arbitrary t => (a, [a], t) -> [(a, [a], t)]
shrinkNode [(PeerAddr, [PeerAddr], GovernorScripts)]
graph ]
    where
      shrinkNode :: (a, [a], t) -> [(a, [a], t)]
shrinkNode (a
nodeaddr, [a]
edges, t
script) =
          -- shrink edges before peer share script, and addr does not shrink
          [ (a
nodeaddr, [a]
edges', t
script)
          | [a]
edges' <- (a -> [a]) -> [a] -> [[a]]
forall a. (a -> [a]) -> [a] -> [[a]]
shrinkList a -> [a]
forall a. a -> [a]
shrinkNothing [a]
edges ]
       [(a, [a], t)] -> [(a, [a], t)] -> [(a, [a], t)]
forall a. [a] -> [a] -> [a]
++ [ (a
nodeaddr, [a]
edges, t
script')
          | t
script' <- t -> [t]
forall a. Arbitrary a => a -> [a]
shrink t
script ]

arbitraryPeerShareScript :: [PeerAddr] -> Gen PeerShareScript
arbitraryPeerShareScript :: [PeerAddr] -> Gen PeerShareScript
arbitraryPeerShareScript [PeerAddr]
peers =
    (Int -> Gen PeerShareScript) -> Gen PeerShareScript
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen PeerShareScript) -> Gen PeerShareScript)
-> (Int -> Gen PeerShareScript) -> Gen PeerShareScript
forall a b. (a -> b) -> a -> b
$ \Int
sz ->
      Int
-> Gen (Maybe ([PeerAddr], PeerShareTime)) -> Gen PeerShareScript
forall a. Int -> Gen a -> Gen (Script a)
arbitraryScriptOf (Int -> Int
isqrt Int
sz) Gen (Maybe ([PeerAddr], PeerShareTime))
peerShareResult
  where
    peerShareResult :: Gen (Maybe ([PeerAddr], PeerShareTime))
    peerShareResult :: Gen (Maybe ([PeerAddr], PeerShareTime))
peerShareResult =
      [(Int, Gen (Maybe ([PeerAddr], PeerShareTime)))]
-> Gen (Maybe ([PeerAddr], PeerShareTime))
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
1, Maybe ([PeerAddr], PeerShareTime)
-> Gen (Maybe ([PeerAddr], PeerShareTime))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ([PeerAddr], PeerShareTime)
forall a. Maybe a
Nothing)
                , (Int
4, ([PeerAddr], PeerShareTime) -> Maybe ([PeerAddr], PeerShareTime)
forall a. a -> Maybe a
Just (([PeerAddr], PeerShareTime) -> Maybe ([PeerAddr], PeerShareTime))
-> Gen ([PeerAddr], PeerShareTime)
-> Gen (Maybe ([PeerAddr], PeerShareTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) ([PeerAddr] -> PeerShareTime -> ([PeerAddr], PeerShareTime))
-> Gen [PeerAddr]
-> Gen (PeerShareTime -> ([PeerAddr], PeerShareTime))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PeerAddr] -> Gen [PeerAddr]
forall a. [a] -> Gen [a]
selectHalfRandomly [PeerAddr]
peers
                                    Gen (PeerShareTime -> ([PeerAddr], PeerShareTime))
-> Gen PeerShareTime -> Gen ([PeerAddr], PeerShareTime)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PeerShareTime
forall a. Arbitrary a => Gen a
arbitrary)) ]

    selectHalfRandomly :: [a] -> Gen [a]
    selectHalfRandomly :: forall a. [a] -> Gen [a]
selectHalfRandomly [a]
xs = do
        picked <- Int -> Gen Bool -> Gen [Bool]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        return [ x | (x, True) <- zip xs picked ]

isqrt :: Int -> Int
isqrt :: Int -> Int
isqrt = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Int -> Double) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> (Int -> Double) -> Int -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Double)

-- | Remove dangling graph edges and peer sharing results.
--
prunePeerGraphEdges :: [(PeerAddr, [PeerAddr], PeerInfo)]
                    -> [(PeerAddr, [PeerAddr], PeerInfo)]
prunePeerGraphEdges :: [(PeerAddr, [PeerAddr], GovernorScripts)]
-> [(PeerAddr, [PeerAddr], GovernorScripts)]
prunePeerGraphEdges [(PeerAddr, [PeerAddr], GovernorScripts)]
graph =
    [ (PeerAddr
nodeaddr, [PeerAddr]
edges', GovernorScripts
node)
    | let nodes :: Set PeerAddr
nodes   = [PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [ PeerAddr
nodeaddr | (PeerAddr
nodeaddr, [PeerAddr]
_, GovernorScripts
_) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
graph ]
    , (PeerAddr
nodeaddr, [PeerAddr]
edges, GovernorScripts { peerShareScript :: GovernorScripts -> PeerShareScript
peerShareScript = Script NonEmpty (Maybe ([PeerAddr], PeerShareTime))
peershare, PeerSharingScript
peerSharingScript :: GovernorScripts -> PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript, ConnectionScript
connectionScript :: GovernorScripts -> ConnectionScript
connectionScript :: ConnectionScript
connectionScript }) <- [(PeerAddr, [PeerAddr], GovernorScripts)]
graph
    , let edges' :: [PeerAddr]
edges'  = Set PeerAddr -> [PeerAddr] -> [PeerAddr]
pruneEdgeList Set PeerAddr
nodes [PeerAddr]
edges
          peershare' :: NonEmpty (Maybe ([PeerAddr], PeerShareTime))
peershare' = Set PeerAddr
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
prunePeerShareScript ([PeerAddr] -> Set PeerAddr
forall a. Ord a => [a] -> Set a
Set.fromList [PeerAddr]
edges') NonEmpty (Maybe ([PeerAddr], PeerShareTime))
peershare
          node :: GovernorScripts
node    = GovernorScripts {
                        peerShareScript :: PeerShareScript
peerShareScript = NonEmpty (Maybe ([PeerAddr], PeerShareTime)) -> PeerShareScript
forall a. NonEmpty a -> Script a
Script NonEmpty (Maybe ([PeerAddr], PeerShareTime))
peershare',
                        PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript :: PeerSharingScript
peerSharingScript,
                        ConnectionScript
connectionScript :: ConnectionScript
connectionScript :: ConnectionScript
connectionScript
                      }
    ]
  where
    pruneEdgeList :: Set PeerAddr -> [PeerAddr] -> [PeerAddr]
    pruneEdgeList :: Set PeerAddr -> [PeerAddr] -> [PeerAddr]
pruneEdgeList Set PeerAddr
nodes = (PeerAddr -> Bool) -> [PeerAddr] -> [PeerAddr]
forall a. (a -> Bool) -> [a] -> [a]
filter (PeerAddr -> Set PeerAddr -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set PeerAddr
nodes)

    prunePeerShareScript :: Set PeerAddr
                         -> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
                         -> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
    prunePeerShareScript :: Set PeerAddr
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
prunePeerShareScript Set PeerAddr
nodes =
      (Maybe ([PeerAddr], PeerShareTime)
 -> Maybe ([PeerAddr], PeerShareTime))
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
-> NonEmpty (Maybe ([PeerAddr], PeerShareTime))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map ((([PeerAddr], PeerShareTime) -> ([PeerAddr], PeerShareTime))
-> Maybe ([PeerAddr], PeerShareTime)
-> Maybe ([PeerAddr], PeerShareTime)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([PeerAddr]
es, PeerShareTime
t) -> (Set PeerAddr -> [PeerAddr] -> [PeerAddr]
pruneEdgeList Set PeerAddr
nodes [PeerAddr]
es, PeerShareTime
t)))


instance Arbitrary PeerShareTime where
  arbitrary :: Gen PeerShareTime
arbitrary = [(Int, Gen PeerShareTime)] -> Gen PeerShareTime
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
2, PeerShareTime -> Gen PeerShareTime
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerShareTime
PeerShareTimeQuick)
                        , (Int
2, PeerShareTime -> Gen PeerShareTime
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerShareTime
PeerShareTimeSlow)
                        , (Int
1, PeerShareTime -> Gen PeerShareTime
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PeerShareTime
PeerShareTimeTimeout) ]

  shrink :: PeerShareTime -> [PeerShareTime]
shrink PeerShareTime
PeerShareTimeTimeout = [PeerShareTime
PeerShareTimeQuick, PeerShareTime
PeerShareTimeSlow]
  shrink PeerShareTime
PeerShareTimeSlow    = [PeerShareTime
PeerShareTimeQuick]
  shrink PeerShareTime
PeerShareTimeQuick   = []



--
-- Tests for the QC Arbitrary instances
--

prop_shrink_GovernorScripts :: ShrinkCarefully GovernorScripts -> Property
prop_shrink_GovernorScripts :: ShrinkCarefully GovernorScripts -> Property
prop_shrink_GovernorScripts =
    ShrinkCarefully GovernorScripts -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal

prop_arbitrary_PeerGraph :: PeerGraph -> Property
prop_arbitrary_PeerGraph :: PeerGraph -> Property
prop_arbitrary_PeerGraph PeerGraph
pg =
    -- We are interested in the distribution of the graph size (in nodes)
    -- and the number of separate components so that we can see that we
    -- get some coverage of graphs that are not fully connected.
    String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate  String
"graph size"       [String
graphSize] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    String -> [String] -> Bool -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate  String
"graph components" [String
graphComponents] (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
    PeerGraph -> Bool
validPeerGraph PeerGraph
pg
  where
    graphSize :: String
graphSize       = Int -> String
renderGraphSize ([(PeerAddr, [PeerAddr], GovernorScripts)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PeerAddr, [PeerAddr], GovernorScripts)]
g) where PeerGraph [(PeerAddr, [PeerAddr], GovernorScripts)]
g = PeerGraph
pg
    graphComponents :: String
graphComponents = Int -> String
renderNumComponents
                        (PeerGraph -> Int
peerGraphNumStronglyConnectedComponents PeerGraph
pg)

    renderGraphSize :: Int -> String
renderGraphSize Int
n
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = String
"0"
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9    = String
"1 -- 9"
      | Bool
otherwise = Int -> Int -> String
renderRanges Int
10 Int
n

    renderNumComponents :: Int -> String
renderNumComponents Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4    = Int -> String
forall a. Show a => a -> String
show Int
n
      | Bool
otherwise = Int -> Int -> String
renderRanges Int
5 Int
n

peerGraphNumStronglyConnectedComponents :: PeerGraph -> Int
peerGraphNumStronglyConnectedComponents :: PeerGraph -> Int
peerGraphNumStronglyConnectedComponents PeerGraph
pg =
    [Tree Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Graph -> [Tree Int]
Graph.scc Graph
g)
  where
    (Graph
g,Int -> PeerAddr
_,PeerAddr -> Int
_) = PeerGraph -> (Graph, Int -> PeerAddr, PeerAddr -> Int)
peerGraphAsGraph PeerGraph
pg

prop_shrink_PeerGraph :: ShrinkCarefully PeerGraph -> Property
prop_shrink_PeerGraph :: ShrinkCarefully PeerGraph -> Property
prop_shrink_PeerGraph ShrinkCarefully PeerGraph
x =
      (PeerGraph -> Bool) -> ShrinkCarefully PeerGraph -> Property
forall a prop.
(Arbitrary a, Show a, Testable prop) =>
(a -> prop) -> ShrinkCarefully a -> Property
prop_shrink_valid PeerGraph -> Bool
validPeerGraph ShrinkCarefully PeerGraph
x
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. ShrinkCarefully PeerGraph -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal ShrinkCarefully PeerGraph
x

prop_shrink_nonequal_PeerGraph :: ShrinkCarefully PeerGraph -> Property
prop_shrink_nonequal_PeerGraph :: ShrinkCarefully PeerGraph -> Property
prop_shrink_nonequal_PeerGraph = ShrinkCarefully PeerGraph -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal

prop_shrink_nonequal_GovernorScripts :: ShrinkCarefully GovernorScripts -> Property
prop_shrink_nonequal_GovernorScripts :: ShrinkCarefully GovernorScripts -> Property
prop_shrink_nonequal_GovernorScripts = ShrinkCarefully GovernorScripts -> Property
forall a.
(Arbitrary a, Eq a, Show a) =>
ShrinkCarefully a -> Property
prop_shrink_nonequal