{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Tests for the hard fork summary.
--
-- This module verifies the property that /no matter how the summary is
-- constructed/, as long as it satisfies its invariants, we should have
-- roundtrip properties:
--
-- * Converting time to a slot and then back to time should be an identity
--   (modulo the time spent in that slot).
-- * Converting a slot to time and then back should be an identity.
-- * Converting slot to an epoch and then back to a slot should be an identity
--   (modulo the time spent in that epoch).
-- * Converting an epoch to a slot and then back should be an identity.
--
module Test.Consensus.HardFork.Summary (tests) where

import           Data.Time
import           Data.Word
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import qualified Ouroboros.Consensus.HardFork.History as HF
import           Test.Consensus.HardFork.Infra
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.Orphans.Arbitrary ()
import           Test.Util.QuickCheck

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"Summary" [
      TestName -> [TestTree] -> TestTree
testGroup TestName
"Sanity" [
          TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generator" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ (ArbitrarySummary -> Property) -> Property
forall a. (Arbitrary a, Show a) => (a -> Property) -> Property
checkGenerator ((ArbitrarySummary -> Property) -> Property)
-> (ArbitrarySummary -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
..} ->
            (Summary xs -> Except TestName ()) -> Summary xs -> Property
forall a. (a -> Except TestName ()) -> a -> Property
checkInvariant Summary xs -> Except TestName ()
forall (xs :: [*]). Summary xs -> Except TestName ()
HF.invariantSummary Summary xs
arbitrarySummary
        , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"shrinker"  (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ (ArbitrarySummary -> Property) -> Property
forall a. (Arbitrary a, Show a) => (a -> Property) -> Property
checkShrinker ((ArbitrarySummary -> Property) -> Property)
-> (ArbitrarySummary -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
..} ->
            (Summary xs -> Except TestName ()) -> Summary xs -> Property
forall a. (a -> Except TestName ()) -> a -> Property
checkInvariant Summary xs -> Except TestName ()
forall (xs :: [*]). Summary xs -> Except TestName ()
HF.invariantSummary Summary xs
arbitrarySummary
        ]
    , TestName -> [TestTree] -> TestTree
testGroup TestName
"Conversions" [
          TestName -> (ArbitrarySummary -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripWallclockSlot" ArbitrarySummary -> Property
roundtripWallclockSlot
        , TestName -> (ArbitrarySummary -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripSlotWallclock" ArbitrarySummary -> Property
roundtripSlotWallclock
        , TestName -> (ArbitrarySummary -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripSlotEpoch"     ArbitrarySummary -> Property
roundtripSlotEpoch
        , TestName -> (ArbitrarySummary -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtripEpochSlot"     ArbitrarySummary -> Property
roundtripEpochSlot
        , TestName -> (ArbitrarySummary -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"reportsPastHorizon"     ArbitrarySummary -> Property
reportsPastHorizon
        ]
    ]

{-------------------------------------------------------------------------------
  Dealing with the 'PastHorizonException'
-------------------------------------------------------------------------------}

noPastHorizonException :: ArbitrarySummary
                       -> HF.Qry Property
                       -> Property
noPastHorizonException :: ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
..} Qry Property
p =
    case Qry Property -> Summary xs -> Either PastHorizonException Property
forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
HF.runQuery Qry Property
p Summary xs
arbitrarySummary of
      Right Property
prop -> Property
prop
      Left  PastHorizonException
ex   -> TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"Unexpected " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ PastHorizonException -> TestName
forall a. Show a => a -> TestName
show PastHorizonException
ex) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                      Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

isPastHorizonException :: Show a
                       => ArbitrarySummary
                       -> HF.Qry a
                       -> Property
isPastHorizonException :: forall a. Show a => ArbitrarySummary -> Qry a -> Property
isPastHorizonException ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
..} Qry a
ma =
    case Qry a -> Summary xs -> Either PastHorizonException a
forall a (xs :: [*]).
HasCallStack =>
Qry a -> Summary xs -> Either PastHorizonException a
HF.runQuery Qry a
ma Summary xs
arbitrarySummary of
      Left  PastHorizonException
_ -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
      Right a
a -> TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"Unexpected " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ a -> TestName
forall a. Show a => a -> TestName
show a
a) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                   Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

{-------------------------------------------------------------------------------
  Tests using just 'Summary'
-------------------------------------------------------------------------------}

roundtripWallclockSlot :: ArbitrarySummary -> Property
roundtripWallclockSlot :: ArbitrarySummary -> Property
roundtripWallclockSlot s :: ArbitrarySummary
s@ArbitrarySummary{beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonTime = RelativeTime
time} =
    ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary
s (Qry Property -> Property) -> Qry Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      (SlotNo
slot , NominalDiffTime
inSlot, NominalDiffTime
timeLeft) <- RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
HF.wallclockToSlot RelativeTime
time
      (RelativeTime
time', SlotLength
slotLen) <- SlotNo -> Qry (RelativeTime, SlotLength)
HF.slotToWallclock SlotNo
slot
      Property -> Qry Property
forall a. a -> Qry a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Qry Property) -> Property -> Qry Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [
           NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime NominalDiffTime
inSlot RelativeTime
time' RelativeTime -> RelativeTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RelativeTime
time
         , NominalDiffTime
inSlot NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
timeLeft       NominalDiffTime -> NominalDiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLen
         ]

roundtripSlotWallclock :: ArbitrarySummary -> Property
roundtripSlotWallclock :: ArbitrarySummary -> Property
roundtripSlotWallclock s :: ArbitrarySummary
s@ArbitrarySummary{beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonSlot = SlotNo
slot} =
    ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary
s (Qry Property -> Property) -> Qry Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      (RelativeTime
time , SlotLength
slotLen)          <- SlotNo -> Qry (RelativeTime, SlotLength)
HF.slotToWallclock SlotNo
slot
      (SlotNo
slot', NominalDiffTime
inSlot, NominalDiffTime
timeLeft) <- RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
HF.wallclockToSlot RelativeTime
time
      Property -> Qry Property
forall a. a -> Qry a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Qry Property) -> Property -> Qry Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [
          SlotNo
slot'             SlotNo -> SlotNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotNo
slot
        , NominalDiffTime
inSlot            NominalDiffTime -> NominalDiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== NominalDiffTime
0
        , NominalDiffTime
inSlot NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
timeLeft NominalDiffTime -> NominalDiffTime -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLen
        ]

roundtripSlotEpoch :: ArbitrarySummary -> Property
roundtripSlotEpoch :: ArbitrarySummary -> Property
roundtripSlotEpoch s :: ArbitrarySummary
s@ArbitrarySummary{beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonSlot = SlotNo
slot} =
    ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary
s (Qry Property -> Property) -> Qry Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      (EpochNo
epoch , Word64
inEpoch, Word64
slotsLeft) <- SlotNo -> Qry (EpochNo, Word64, Word64)
HF.slotToEpoch SlotNo
slot
      (SlotNo
slot' , EpochSize
epochSize)          <- EpochNo -> Qry (SlotNo, EpochSize)
HF.epochToSlot EpochNo
epoch
      Property -> Qry Property
forall a. a -> Qry a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Qry Property) -> Property -> Qry Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [
          Word64 -> SlotNo -> SlotNo
HF.addSlots Word64
inEpoch SlotNo
slot' SlotNo -> SlotNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== SlotNo
slot
        , Word64
inEpoch Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
slotsLeft       Word64 -> Word64 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochSize -> Word64
unEpochSize EpochSize
epochSize
        ]

roundtripEpochSlot :: ArbitrarySummary -> Property
roundtripEpochSlot :: ArbitrarySummary -> Property
roundtripEpochSlot s :: ArbitrarySummary
s@ArbitrarySummary{beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonEpoch = EpochNo
epoch} =
    ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary
s (Qry Property -> Property) -> Qry Property -> Property
forall a b. (a -> b) -> a -> b
$ do
      (SlotNo
slot  , EpochSize
epochSize)          <- EpochNo -> Qry (SlotNo, EpochSize)
HF.epochToSlot EpochNo
epoch
      (EpochNo
epoch', Word64
inEpoch, Word64
slotsLeft) <- SlotNo -> Qry (EpochNo, Word64, Word64)
HF.slotToEpoch SlotNo
slot
      Property -> Qry Property
forall a. a -> Qry a
forall (m :: * -> *) a. Monad m => a -> m a
return (Property -> Qry Property) -> Property -> Qry Property
forall a b. (a -> b) -> a -> b
$ [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [
          EpochNo
epoch'              EpochNo -> EpochNo -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochNo
epoch
        , Word64
inEpoch             Word64 -> Word64 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Word64
0
        , Word64
inEpoch Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
slotsLeft Word64 -> Word64 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== EpochSize -> Word64
unEpochSize EpochSize
epochSize
        ]

reportsPastHorizon :: ArbitrarySummary -> Property
reportsPastHorizon :: ArbitrarySummary -> Property
reportsPastHorizon s :: ArbitrarySummary
s@ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
..} = [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin [
      case Maybe RelativeTime
mPastHorizonTime of
        Just RelativeTime
x  -> ArbitrarySummary
-> Qry (SlotNo, NominalDiffTime, NominalDiffTime) -> Property
forall a. Show a => ArbitrarySummary -> Qry a -> Property
isPastHorizonException ArbitrarySummary
s (Qry (SlotNo, NominalDiffTime, NominalDiffTime) -> Property)
-> Qry (SlotNo, NominalDiffTime, NominalDiffTime) -> Property
forall a b. (a -> b) -> a -> b
$ RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
HF.wallclockToSlot RelativeTime
x
        Maybe RelativeTime
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    , case Maybe SlotNo
mPastHorizonSlot of
        Just SlotNo
x  -> ArbitrarySummary -> Qry (RelativeTime, SlotLength) -> Property
forall a. Show a => ArbitrarySummary -> Qry a -> Property
isPastHorizonException ArbitrarySummary
s (Qry (RelativeTime, SlotLength) -> Property)
-> Qry (RelativeTime, SlotLength) -> Property
forall a b. (a -> b) -> a -> b
$ SlotNo -> Qry (RelativeTime, SlotLength)
HF.slotToWallclock SlotNo
x
        Maybe SlotNo
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    , case Maybe SlotNo
mPastHorizonSlot of
        Just SlotNo
x  -> ArbitrarySummary -> Qry (EpochNo, Word64, Word64) -> Property
forall a. Show a => ArbitrarySummary -> Qry a -> Property
isPastHorizonException ArbitrarySummary
s (Qry (EpochNo, Word64, Word64) -> Property)
-> Qry (EpochNo, Word64, Word64) -> Property
forall a b. (a -> b) -> a -> b
$ SlotNo -> Qry (EpochNo, Word64, Word64)
HF.slotToEpoch     SlotNo
x
        Maybe SlotNo
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    , case Maybe EpochNo
mPastHorizonEpoch of
        Just EpochNo
x  -> ArbitrarySummary -> Qry (SlotNo, EpochSize) -> Property
forall a. Show a => ArbitrarySummary -> Qry a -> Property
isPastHorizonException ArbitrarySummary
s (Qry (SlotNo, EpochSize) -> Property)
-> Qry (SlotNo, EpochSize) -> Property
forall a b. (a -> b) -> a -> b
$ EpochNo -> Qry (SlotNo, EpochSize)
HF.epochToSlot     EpochNo
x
        Maybe EpochNo
Nothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    ]

{-------------------------------------------------------------------------------
  Arbitrary 'Summary'

  We should be able to show properties of the conversion functions independent
  of how the 'Summary' that they use is derived.
-------------------------------------------------------------------------------}

data ArbitrarySummary = forall xs. ArbitrarySummary {
      ()
arbitrarySummary   :: HF.Summary xs
    , ArbitrarySummary -> RelativeTime
beforeHorizonTime  :: RelativeTime
    , ArbitrarySummary -> SlotNo
beforeHorizonSlot  :: SlotNo
    , ArbitrarySummary -> EpochNo
beforeHorizonEpoch :: EpochNo
    , ArbitrarySummary -> Maybe RelativeTime
mPastHorizonTime   :: Maybe RelativeTime
    , ArbitrarySummary -> Maybe SlotNo
mPastHorizonSlot   :: Maybe SlotNo
    , ArbitrarySummary -> Maybe EpochNo
mPastHorizonEpoch  :: Maybe EpochNo
    }

deriving instance Show ArbitrarySummary

instance Arbitrary ArbitrarySummary where
  arbitrary :: Gen ArbitrarySummary
arbitrary = (forall (xs :: [*]).
 (SListI xs, IsNonEmpty xs) =>
 Eras xs -> Gen ArbitrarySummary)
-> Gen ArbitrarySummary
forall r.
(forall (xs :: [*]).
 (SListI xs, IsNonEmpty xs) =>
 Eras xs -> Gen r)
-> Gen r
chooseEras ((forall (xs :: [*]).
  (SListI xs, IsNonEmpty xs) =>
  Eras xs -> Gen ArbitrarySummary)
 -> Gen ArbitrarySummary)
-> (forall (xs :: [*]).
    (SListI xs, IsNonEmpty xs) =>
    Eras xs -> Gen ArbitrarySummary)
-> Gen ArbitrarySummary
forall a b. (a -> b) -> a -> b
$ \is :: Eras xs
is@(Eras Exactly (x : xs) Era
_) -> do
      Summary xs
summary <- Eras xs -> Gen (Summary xs)
forall (xs :: [*]). Eras xs -> Gen (Summary xs)
genSummary Eras xs
is

      let summaryStart :: HF.Bound
          mSummaryEnd  :: HF.EraEnd
          (Bound
summaryStart, EraEnd
mSummaryEnd) = Summary xs -> (Bound, EraEnd)
forall (xs :: [*]). Summary xs -> (Bound, EraEnd)
HF.summaryBounds Summary xs
summary

      case EraEnd
mSummaryEnd of
        EraEnd
HF.EraUnbounded -> do
          -- Don't pick /too/ large numbers to avoid overflow
          Word64
beforeHorizonSlots   <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0,   Word64
100_000_000)
          Word64
beforeHorizonEpochs  <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0,     Word64
1_000_000)
          Double
beforeHorizonSeconds <- (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
1_000_000_000)

          let beforeHorizonSlot  :: SlotNo
              beforeHorizonEpoch :: EpochNo
              beforeHorizonTime  :: RelativeTime

              beforeHorizonSlot :: SlotNo
beforeHorizonSlot  = Word64 -> SlotNo -> SlotNo
HF.addSlots
                                     Word64
beforeHorizonSlots
                                     (Bound -> SlotNo
HF.boundSlot Bound
summaryStart)
              beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
                                     Word64
beforeHorizonEpochs
                                     (Bound -> EpochNo
HF.boundEpoch Bound
summaryStart)
              beforeHorizonTime :: RelativeTime
beforeHorizonTime  = NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime
                                     (Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double
beforeHorizonSeconds :: Double))
                                     (Bound -> RelativeTime
HF.boundTime Bound
summaryStart)

          ArbitrarySummary -> Gen ArbitrarySummary
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ArbitrarySummary{
                arbitrarySummary :: Summary xs
arbitrarySummary      = Summary xs
summary
              , RelativeTime
beforeHorizonTime :: RelativeTime
beforeHorizonTime :: RelativeTime
beforeHorizonTime
              , SlotNo
beforeHorizonSlot :: SlotNo
beforeHorizonSlot :: SlotNo
beforeHorizonSlot
              , EpochNo
beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch
              , mPastHorizonTime :: Maybe RelativeTime
mPastHorizonTime      = Maybe RelativeTime
forall a. Maybe a
Nothing
              , mPastHorizonSlot :: Maybe SlotNo
mPastHorizonSlot      = Maybe SlotNo
forall a. Maybe a
Nothing
              , mPastHorizonEpoch :: Maybe EpochNo
mPastHorizonEpoch     = Maybe EpochNo
forall a. Maybe a
Nothing
              }

        HF.EraEnd Bound
summaryEnd -> do
          let summarySlots, summaryEpochs :: Word64
              summarySlots :: Word64
summarySlots  = HasCallStack => SlotNo -> SlotNo -> Word64
SlotNo -> SlotNo -> Word64
HF.countSlots
                                (Bound -> SlotNo
HF.boundSlot Bound
summaryEnd)
                                (Bound -> SlotNo
HF.boundSlot Bound
summaryStart)
              summaryEpochs :: Word64
summaryEpochs = HasCallStack => EpochNo -> EpochNo -> Word64
EpochNo -> EpochNo -> Word64
HF.countEpochs
                                (Bound -> EpochNo
HF.boundEpoch Bound
summaryEnd)
                                (Bound -> EpochNo
HF.boundEpoch Bound
summaryStart)

              summaryTimeSpan :: NominalDiffTime
              summaryTimeSpan :: NominalDiffTime
summaryTimeSpan = RelativeTime -> RelativeTime -> NominalDiffTime
diffRelTime
                                  (Bound -> RelativeTime
HF.boundTime Bound
summaryEnd)
                                  (Bound -> RelativeTime
HF.boundTime Bound
summaryStart)

              summaryTimeSpanSeconds :: Double
              summaryTimeSpanSeconds :: Double
summaryTimeSpanSeconds = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
summaryTimeSpan

          -- Pick arbitrary values before the horizon

          Word64
beforeHorizonSlots   <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
summarySlots  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
          Word64
beforeHorizonEpochs  <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
summaryEpochs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
          Double
beforeHorizonSeconds <- (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
summaryTimeSpanSeconds)
                                    Gen Double -> (Double -> Bool) -> Gen Double
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` \Double
x -> Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
summaryTimeSpanSeconds

          let beforeHorizonSlot  :: SlotNo
              beforeHorizonEpoch :: EpochNo
              beforeHorizonTime  :: RelativeTime

              beforeHorizonSlot :: SlotNo
beforeHorizonSlot  = Word64 -> SlotNo -> SlotNo
HF.addSlots
                                     Word64
beforeHorizonSlots
                                     (Bound -> SlotNo
HF.boundSlot Bound
summaryStart)
              beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
                                     Word64
beforeHorizonEpochs
                                     (Bound -> EpochNo
HF.boundEpoch Bound
summaryStart)
              beforeHorizonTime :: RelativeTime
beforeHorizonTime  = NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime
                                     (Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
beforeHorizonSeconds)
                                     (Bound -> RelativeTime
HF.boundTime Bound
summaryStart)

          -- Pick arbitrary values past the horizon

          Word64
pastHorizonSlots   :: Word64 <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
10)
          Word64
pastHorizonEpochs  :: Word64 <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
10)
          Double
pastHorizonSeconds :: Double <- (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
10)

          let pastHorizonSlot  :: SlotNo
              pastHorizonEpoch :: EpochNo
              pastHorizonTime  :: RelativeTime

              pastHorizonSlot :: SlotNo
pastHorizonSlot  = Word64 -> SlotNo -> SlotNo
HF.addSlots
                                    Word64
pastHorizonSlots
                                    (Bound -> SlotNo
HF.boundSlot Bound
summaryEnd)
              pastHorizonEpoch :: EpochNo
pastHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
                                    Word64
pastHorizonEpochs
                                    (Bound -> EpochNo
HF.boundEpoch Bound
summaryEnd)
              pastHorizonTime :: RelativeTime
pastHorizonTime  = NominalDiffTime -> RelativeTime -> RelativeTime
addRelTime
                                    (Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
pastHorizonSeconds)
                                    (Bound -> RelativeTime
HF.boundTime Bound
summaryEnd)

          ArbitrarySummary -> Gen ArbitrarySummary
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ArbitrarySummary{
                arbitrarySummary :: Summary xs
arbitrarySummary      = Summary xs
summary
              , RelativeTime
beforeHorizonTime :: RelativeTime
beforeHorizonTime :: RelativeTime
beforeHorizonTime
              , SlotNo
beforeHorizonSlot :: SlotNo
beforeHorizonSlot :: SlotNo
beforeHorizonSlot
              , EpochNo
beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch :: EpochNo
beforeHorizonEpoch
              , mPastHorizonTime :: Maybe RelativeTime
mPastHorizonTime      = RelativeTime -> Maybe RelativeTime
forall a. a -> Maybe a
Just RelativeTime
pastHorizonTime
              , mPastHorizonSlot :: Maybe SlotNo
mPastHorizonSlot      = SlotNo -> Maybe SlotNo
forall a. a -> Maybe a
Just SlotNo
pastHorizonSlot
              , mPastHorizonEpoch :: Maybe EpochNo
mPastHorizonEpoch     = EpochNo -> Maybe EpochNo
forall a. a -> Maybe a
Just EpochNo
pastHorizonEpoch
              }

  shrink :: ArbitrarySummary -> [ArbitrarySummary]
shrink summary :: ArbitrarySummary
summary@ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
arbitrarySummary :: ()
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
arbitrarySummary :: Summary xs
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
..} = [[ArbitrarySummary]] -> [ArbitrarySummary]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        -- Reduce before-horizon slot
        [ ArbitrarySummary
summary { beforeHorizonSlot = SlotNo s }
        | Word64
s <- Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink (SlotNo -> Word64
unSlotNo SlotNo
beforeHorizonSlot)
        ]

        -- Reduce before-horizon epoch
      , [ ArbitrarySummary
summary { beforeHorizonEpoch = EpochNo e }
        | Word64
e <- Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink (EpochNo -> Word64
unEpochNo EpochNo
beforeHorizonEpoch)
        ]

        -- Reduce before-horizon time
      , [ ArbitrarySummary
summary { beforeHorizonTime = RelativeTime t }
        | NominalDiffTime
t <- NominalDiffTime -> [NominalDiffTime]
forall a. Arbitrary a => a -> [a]
shrink (RelativeTime -> NominalDiffTime
getRelativeTime RelativeTime
beforeHorizonTime)
        , NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= NominalDiffTime
0
        ]

        -- Drop an era /provided/ this doesn't cause of any of the before
        -- horizon values to become past horizon
      , [ ArbitrarySummary { arbitrarySummary :: Summary xs
arbitrarySummary = Summary xs
summary', Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
beforeHorizonTime :: RelativeTime
beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
mPastHorizonTime :: Maybe RelativeTime
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonEpoch :: Maybe EpochNo
.. }
        | (Just Summary xs
summary', EraSummary
lastEra) <- [Summary xs -> (Maybe (Summary xs), EraSummary)
forall (xs :: [*]). Summary xs -> (Maybe (Summary xs), EraSummary)
HF.summaryInit Summary xs
arbitrarySummary]
        , SlotNo
beforeHorizonSlot  SlotNo -> SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> SlotNo
HF.boundSlot  (EraSummary -> Bound
HF.eraStart EraSummary
lastEra)
        , EpochNo
beforeHorizonEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> EpochNo
HF.boundEpoch (EraSummary -> Bound
HF.eraStart EraSummary
lastEra)
        , RelativeTime
beforeHorizonTime  RelativeTime -> RelativeTime -> Bool
forall a. Ord a => a -> a -> Bool
< Bound -> RelativeTime
HF.boundTime  (EraSummary -> Bound
HF.eraStart EraSummary
lastEra)
        ]
      ]