{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Ouroboros.Network.PeerSelection.Instances
  ( -- test types
    PeerAddr (..)
  , TestSeed (..)
    -- generator tests
  , prop_arbitrary_PeerSelectionTargets
  , prop_shrink_PeerSelectionTargets
  ) where

import Data.Hashable

import Ouroboros.Network.PeerSelection.Governor

import Test.Ouroboros.Network.OrphanInstances ()
import Test.Ouroboros.Network.Utils (ShrinkCarefully, prop_shrink_nonequal,
           prop_shrink_valid)
import Test.QuickCheck

--
-- QuickCheck instances
--

-- | Seed for domain lookups
--
newtype TestSeed = TestSeed { TestSeed -> Int
unTestSeed :: Int }
  deriving (TestSeed -> TestSeed -> Bool
(TestSeed -> TestSeed -> Bool)
-> (TestSeed -> TestSeed -> Bool) -> Eq TestSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TestSeed -> TestSeed -> Bool
== :: TestSeed -> TestSeed -> Bool
$c/= :: TestSeed -> TestSeed -> Bool
/= :: TestSeed -> TestSeed -> Bool
Eq, Int -> TestSeed -> ShowS
[TestSeed] -> ShowS
TestSeed -> String
(Int -> TestSeed -> ShowS)
-> (TestSeed -> String) -> ([TestSeed] -> ShowS) -> Show TestSeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TestSeed -> ShowS
showsPrec :: Int -> TestSeed -> ShowS
$cshow :: TestSeed -> String
show :: TestSeed -> String
$cshowList :: [TestSeed] -> ShowS
showList :: [TestSeed] -> ShowS
Show)

instance Arbitrary TestSeed where
  arbitrary :: Gen TestSeed
arbitrary = Int -> TestSeed
TestSeed (Int -> TestSeed) -> Gen Int -> Gen TestSeed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
chooseInt(Int
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
  shrink :: TestSeed -> [TestSeed]
shrink TestSeed
_ = []

-- | Simple address representation for the tests
--
newtype PeerAddr = PeerAddr Int
  deriving (PeerAddr -> PeerAddr -> Bool
(PeerAddr -> PeerAddr -> Bool)
-> (PeerAddr -> PeerAddr -> Bool) -> Eq PeerAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerAddr -> PeerAddr -> Bool
== :: PeerAddr -> PeerAddr -> Bool
$c/= :: PeerAddr -> PeerAddr -> Bool
/= :: PeerAddr -> PeerAddr -> Bool
Eq, Eq PeerAddr
Eq PeerAddr =>
(PeerAddr -> PeerAddr -> Ordering)
-> (PeerAddr -> PeerAddr -> Bool)
-> (PeerAddr -> PeerAddr -> Bool)
-> (PeerAddr -> PeerAddr -> Bool)
-> (PeerAddr -> PeerAddr -> Bool)
-> (PeerAddr -> PeerAddr -> PeerAddr)
-> (PeerAddr -> PeerAddr -> PeerAddr)
-> Ord PeerAddr
PeerAddr -> PeerAddr -> Bool
PeerAddr -> PeerAddr -> Ordering
PeerAddr -> PeerAddr -> PeerAddr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PeerAddr -> PeerAddr -> Ordering
compare :: PeerAddr -> PeerAddr -> Ordering
$c< :: PeerAddr -> PeerAddr -> Bool
< :: PeerAddr -> PeerAddr -> Bool
$c<= :: PeerAddr -> PeerAddr -> Bool
<= :: PeerAddr -> PeerAddr -> Bool
$c> :: PeerAddr -> PeerAddr -> Bool
> :: PeerAddr -> PeerAddr -> Bool
$c>= :: PeerAddr -> PeerAddr -> Bool
>= :: PeerAddr -> PeerAddr -> Bool
$cmax :: PeerAddr -> PeerAddr -> PeerAddr
max :: PeerAddr -> PeerAddr -> PeerAddr
$cmin :: PeerAddr -> PeerAddr -> PeerAddr
min :: PeerAddr -> PeerAddr -> PeerAddr
Ord, Int -> PeerAddr -> ShowS
[PeerAddr] -> ShowS
PeerAddr -> String
(Int -> PeerAddr -> ShowS)
-> (PeerAddr -> String) -> ([PeerAddr] -> ShowS) -> Show PeerAddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerAddr -> ShowS
showsPrec :: Int -> PeerAddr -> ShowS
$cshow :: PeerAddr -> String
show :: PeerAddr -> String
$cshowList :: [PeerAddr] -> ShowS
showList :: [PeerAddr] -> ShowS
Show, Eq PeerAddr
Eq PeerAddr =>
(Int -> PeerAddr -> Int) -> (PeerAddr -> Int) -> Hashable PeerAddr
Int -> PeerAddr -> Int
PeerAddr -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> PeerAddr -> Int
hashWithSalt :: Int -> PeerAddr -> Int
$chash :: PeerAddr -> Int
hash :: PeerAddr -> Int
Hashable)

-- | We mostly avoid using this instance since we need careful control over
-- the peer addrs, e.g. to make graphs work, and sets overlap etc. But it's
-- here for the few cases that need it, and it is used for (lack-of) shrinking.
--
instance Arbitrary PeerAddr where
  arbitrary :: Gen PeerAddr
arbitrary = Int -> PeerAddr
PeerAddr (Int -> PeerAddr) -> Gen Int -> Gen PeerAddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Integral a => Gen a
arbitrarySizedNatural
  shrink :: PeerAddr -> [PeerAddr]
shrink PeerAddr
_  = []

instance Arbitrary PeerSelectionTargets where
  arbitrary :: Gen PeerSelectionTargets
arbitrary = do
    targetNumberOfKnownPeers       <- NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Int) -> Gen (NonNegative Int) -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (NonNegative Int) -> Gen (NonNegative Int)
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
1000 Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    targetNumberOfRootPeers        <- choose (0, min 100  targetNumberOfKnownPeers)
    targetNumberOfEstablishedPeers <- choose (0, min 1000 targetNumberOfKnownPeers)
    targetNumberOfActivePeers      <- choose (0, min 100  targetNumberOfEstablishedPeers)

    targetNumberOfKnownBigLedgerPeers
      <- getNonNegative <$> resize 1000 arbitrary
    targetNumberOfEstablishedBigLedgerPeers
      <- choose (0 , min 1000 targetNumberOfKnownBigLedgerPeers)
    targetNumberOfActiveBigLedgerPeers
      <- choose (0, min 100 targetNumberOfEstablishedBigLedgerPeers)

    return PeerSelectionTargets {
      targetNumberOfRootPeers,
      targetNumberOfKnownPeers,
      targetNumberOfEstablishedPeers,
      targetNumberOfActivePeers,
      targetNumberOfKnownBigLedgerPeers,
      targetNumberOfEstablishedBigLedgerPeers,
      targetNumberOfActiveBigLedgerPeers
    }

  shrink :: PeerSelectionTargets -> [PeerSelectionTargets]
shrink (PeerSelectionTargets Int
r Int
k Int
e Int
a Int
kb Int
eb Int
ab) =
    [ PeerSelectionTargets
targets'
    | (Int
r',Int
k',Int
e',Int
a',Int
kb',Int
eb',Int
ab') <- (Int, Int, Int, Int, Int, Int, Int)
-> [(Int, Int, Int, Int, Int, Int, Int)]
forall a. Arbitrary a => a -> [a]
shrink (Int
r,Int
k,Int
e,Int
a,Int
kb,Int
eb,Int
ab)
    , let targets' :: PeerSelectionTargets
targets' = Int
-> Int -> Int -> Int -> Int -> Int -> Int -> PeerSelectionTargets
PeerSelectionTargets Int
r' Int
k' Int
e' Int
a' Int
kb' Int
eb' Int
ab'
    , PeerSelectionTargets -> Bool
sanePeerSelectionTargets PeerSelectionTargets
targets' ]


prop_arbitrary_PeerSelectionTargets :: PeerSelectionTargets -> Bool
prop_arbitrary_PeerSelectionTargets :: PeerSelectionTargets -> Bool
prop_arbitrary_PeerSelectionTargets =
    PeerSelectionTargets -> Bool
sanePeerSelectionTargets

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