{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Network.Protocol.ChainSync.Codec.TimeLimits.Test where

import Control.Monad.Class.MonadTime.SI (DiffTime)
import System.Random (mkStdGen)

import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Cardano.Network.Protocol.ChainSync.Codec.TimeLimits (timeLimitsChainSync)

import Ouroboros.Network.Protocol.ChainSync.Codec (ChainSyncIdleTimeout (..),
           maxChainSyncTimeout, minChainSyncTimeout)
import Ouroboros.Network.Protocol.ChainSync.Type (SingChainSync (..),
           SingNextKind (..))
import Ouroboros.Network.Protocol.Limits (ProtocolTimeLimitsWithRnd (..),
           shortWait)

import Test.QuickCheck (Arbitrary (..), Property, elements, oneof, property)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty, (===))


tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup TestName
"Ouroboros.Network.Protocol.ChainSync.Timelimits"
    [ TestName
-> (PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"timeout in 'StIntersect'"
        PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_intersect
    , TestName
-> (PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"timeout in 'StNext' 'StCanWait'"
        PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_canwait
    , TestName
-> (PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"timeout in 'StIdle' state"
        PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_timeout_in_idle
    , TestName -> (ChainSyncIdleTimeout -> Int -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"timeout range for non-trustable peers in 'StNext' 'StMustReply' state"
        ChainSyncIdleTimeout -> Int -> Property
prop_timeout_range_for_not_trustable_in_mustreply
    , TestName -> (ChainSyncIdleTimeout -> Int -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"no timeout for trustable peers in 'StNext' 'StMustReply' state"
        ChainSyncIdleTimeout -> Int -> Property
prop_no_timeout_for_trustable_peers_in_mustreply
    ]

-- | For state 'StIntersect', the timeout is always 'shortWait'
prop_short_wait_timeout_in_intersect
  :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_intersect :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_intersect PeerTrustable
peerTrustable ChainSyncIdleTimeout
idleTimeout Int
seed =
  Maybe DiffTime
timeout Maybe DiffTime -> Maybe DiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe DiffTime
shortWait
  where
    limits :: ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits = ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
forall header point tip.
ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
timeLimitsChainSync ChainSyncIdleTimeout
idleTimeout PeerTrustable
peerTrustable
    (Maybe DiffTime
timeout, StdGen
_) =
      ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 12) (ZonkAny 13) (ZonkAny 14))
-> forall (st :: ChainSync (ZonkAny 12) (ZonkAny 13) (ZonkAny 14)).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
forall ps.
ProtocolTimeLimitsWithRnd ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
timeLimitForStateWithRnd ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 12) (ZonkAny 13) (ZonkAny 14))
forall {header} {point} {tip}.
ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits StateToken 'StIntersect
SingChainSync 'StIntersect
forall {header} {point} {tip}. SingChainSync 'StIntersect
SingIntersect (Int -> StdGen
mkStdGen Int
seed)

-- | For state 'StNext' 'StCanAwait', the timeout is always 'shortWait'
prop_short_wait_timeout_in_canwait
  :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_canwait :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_short_wait_timeout_in_canwait PeerTrustable
peerTrustable ChainSyncIdleTimeout
idleTimeout Int
seed =
  Maybe DiffTime
timeout Maybe DiffTime -> Maybe DiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe DiffTime
shortWait
  where
    limits :: ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits = ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
forall header point tip.
ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
timeLimitsChainSync ChainSyncIdleTimeout
idleTimeout PeerTrustable
peerTrustable
    (Maybe DiffTime
timeout, StdGen
_) =
      ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 9) (ZonkAny 10) (ZonkAny 11))
-> forall (st :: ChainSync (ZonkAny 9) (ZonkAny 10) (ZonkAny 11)).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
forall ps.
ProtocolTimeLimitsWithRnd ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
timeLimitForStateWithRnd ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 9) (ZonkAny 10) (ZonkAny 11))
forall {header} {point} {tip}.
ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits (SingNextKind 'StCanAwait -> SingChainSync ('StNext 'StCanAwait)
forall {header} {point} {tip} (k1 :: StNextKind).
SingNextKind k1 -> SingChainSync ('StNext k1)
SingNext SingNextKind 'StCanAwait
SingCanAwait) (Int -> StdGen
mkStdGen Int
seed)

-- | For state 'StIdle', the timeout is 'ChainSyncIdleTimeout'
prop_timeout_in_idle
  :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_timeout_in_idle :: PeerTrustable -> ChainSyncIdleTimeout -> Int -> Property
prop_timeout_in_idle PeerTrustable
peerTrustable ChainSyncIdleTimeout
idleTimeout Int
seed =
  Maybe DiffTime
timeout Maybe DiffTime -> Maybe DiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe DiffTime
timeout'
  where
    timeout' :: Maybe DiffTime
timeout' = case ChainSyncIdleTimeout
idleTimeout of
      ChainSyncIdleTimeout
ChainSyncNoIdleTimeout -> Maybe DiffTime
forall a. Maybe a
Nothing
      ChainSyncIdleTimeout DiffTime
t -> DiffTime -> Maybe DiffTime
forall a. a -> Maybe a
Just DiffTime
t
    limits :: ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits = ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
forall header point tip.
ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
timeLimitsChainSync ChainSyncIdleTimeout
idleTimeout PeerTrustable
peerTrustable
    (Maybe DiffTime
timeout, StdGen
_) = ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
-> forall (st :: ChainSync (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
forall ps.
ProtocolTimeLimitsWithRnd ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
timeLimitForStateWithRnd ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
forall {header} {point} {tip}.
ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits StateToken 'StIdle
SingChainSync 'StIdle
forall {header} {point} {tip}. SingChainSync 'StIdle
SingIdle (Int -> StdGen
mkStdGen Int
seed)

-- | For non-trustable peers and in 'StNext' 'StMustReply' state, the timeout is
-- always within the specified range
prop_timeout_range_for_not_trustable_in_mustreply
  :: ChainSyncIdleTimeout -> Int -> Property
prop_timeout_range_for_not_trustable_in_mustreply :: ChainSyncIdleTimeout -> Int -> Property
prop_timeout_range_for_not_trustable_in_mustreply ChainSyncIdleTimeout
idleTimeout Int
seed =
  Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
    Bool -> (DiffTime -> Bool) -> Maybe DiffTime -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      Bool
False
      (\DiffTime
t -> DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
minChainSyncTimeout Bool -> Bool -> Bool
&& DiffTime
t DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime
maxChainSyncTimeout)
      Maybe DiffTime
timeout
  where
    limits :: ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits = ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
forall header point tip.
ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
timeLimitsChainSync ChainSyncIdleTimeout
idleTimeout PeerTrustable
IsNotTrustable
    (Maybe DiffTime
timeout, StdGen
_) =
      ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 3) (ZonkAny 4) (ZonkAny 5))
-> forall (st :: ChainSync (ZonkAny 3) (ZonkAny 4) (ZonkAny 5)).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
forall ps.
ProtocolTimeLimitsWithRnd ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
timeLimitForStateWithRnd ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 3) (ZonkAny 4) (ZonkAny 5))
forall {header} {point} {tip}.
ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits (SingNextKind 'StMustReply -> SingChainSync ('StNext 'StMustReply)
forall {header} {point} {tip} (k1 :: StNextKind).
SingNextKind k1 -> SingChainSync ('StNext k1)
SingNext SingNextKind 'StMustReply
SingMustReply) (Int -> StdGen
mkStdGen Int
seed)

-- | For trustable peers, there's never a timeout in 'StNext' 'StMustReply'
-- state
prop_no_timeout_for_trustable_peers_in_mustreply
  :: ChainSyncIdleTimeout -> Int -> Property
prop_no_timeout_for_trustable_peers_in_mustreply :: ChainSyncIdleTimeout -> Int -> Property
prop_no_timeout_for_trustable_peers_in_mustreply ChainSyncIdleTimeout
idleTimeout Int
seed =
  Maybe DiffTime
timeout Maybe DiffTime -> Maybe DiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Maybe DiffTime
forall a. Maybe a
Nothing
  where
    limits :: ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits = ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
forall header point tip.
ChainSyncIdleTimeout
-> PeerTrustable
-> ProtocolTimeLimitsWithRnd (ChainSync header point tip)
timeLimitsChainSync ChainSyncIdleTimeout
idleTimeout PeerTrustable
IsTrustable
    (Maybe DiffTime
timeout, StdGen
_) =
      ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 0) (ZonkAny 1) (ZonkAny 2))
-> forall (st :: ChainSync (ZonkAny 0) (ZonkAny 1) (ZonkAny 2)).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
forall ps.
ProtocolTimeLimitsWithRnd ps
-> forall (st :: ps).
   ActiveState st =>
   StateToken st -> StdGen -> (Maybe DiffTime, StdGen)
timeLimitForStateWithRnd ProtocolTimeLimitsWithRnd
  (ChainSync (ZonkAny 0) (ZonkAny 1) (ZonkAny 2))
forall {header} {point} {tip}.
ProtocolTimeLimitsWithRnd (ChainSync header point tip)
limits (SingNextKind 'StMustReply -> SingChainSync ('StNext 'StMustReply)
forall {header} {point} {tip} (k1 :: StNextKind).
SingNextKind k1 -> SingChainSync ('StNext k1)
SingNext SingNextKind 'StMustReply
SingMustReply) (Int -> StdGen
mkStdGen Int
seed)


instance Arbitrary PeerTrustable where
  arbitrary :: Gen PeerTrustable
arbitrary = [PeerTrustable] -> Gen PeerTrustable
forall a. HasCallStack => [a] -> Gen a
elements [PeerTrustable
IsTrustable, PeerTrustable
IsNotTrustable]

instance Arbitrary ChainSyncIdleTimeout where
  arbitrary :: Gen ChainSyncIdleTimeout
arbitrary = [Gen ChainSyncIdleTimeout] -> Gen ChainSyncIdleTimeout
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ ChainSyncIdleTimeout -> Gen ChainSyncIdleTimeout
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ChainSyncIdleTimeout
ChainSyncNoIdleTimeout
    , DiffTime -> ChainSyncIdleTimeout
ChainSyncIdleTimeout (DiffTime -> ChainSyncIdleTimeout)
-> Gen DiffTime -> Gen ChainSyncIdleTimeout
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DiffTime
forall a. Arbitrary a => Gen a
arbitrary
    ]

instance Arbitrary DiffTime where
  arbitrary :: Gen DiffTime
arbitrary = Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> DiffTime) -> Gen Rational -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Rational
forall a. Arbitrary a => Gen a
arbitrary

instance Show ChainSyncIdleTimeout where
  show :: ChainSyncIdleTimeout -> TestName
show ChainSyncIdleTimeout
ChainSyncNoIdleTimeout   = TestName
"ChainSyncNoIdleTimeout"
  show (ChainSyncIdleTimeout DiffTime
t) = TestName
"ChainSyncIdleTimeout " TestName -> ShowS
forall a. [a] -> [a] -> [a]
++ DiffTime -> TestName
forall a. Show a => a -> TestName
show DiffTime
t