{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
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
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
..} ->
(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
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
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
]
]
noPastHorizonException :: ArbitrarySummary
-> HF.Qry Property
-> Property
noPastHorizonException :: ArbitrarySummary -> Qry Property -> Property
noPastHorizonException ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
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
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
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
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
(slot , inSlot, timeLeft) <- RelativeTime -> Qry (SlotNo, NominalDiffTime, NominalDiffTime)
HF.wallclockToSlot RelativeTime
time
(time', slotLen) <- HF.slotToWallclock slot
return $ conjoin [
addRelTime inSlot time' === time
, inSlot + timeLeft === getSlotLength 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
(time , slotLen) <- SlotNo -> Qry (RelativeTime, SlotLength)
HF.slotToWallclock SlotNo
slot
(slot', inSlot, timeLeft) <- HF.wallclockToSlot time
return $ conjoin [
slot' === slot
, inSlot === 0
, inSlot + timeLeft === getSlotLength 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
(epoch , inEpoch, slotsLeft) <- SlotNo -> Qry (EpochNo, Word64, Word64)
HF.slotToEpoch SlotNo
slot
(slot' , epochSize) <- HF.epochToSlot epoch
return $ conjoin [
HF.addSlots inEpoch slot' === slot
, inEpoch + slotsLeft === unEpochSize 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
(slot , epochSize) <- EpochNo -> Qry (SlotNo, EpochSize)
HF.epochToSlot EpochNo
epoch
(epoch', inEpoch, slotsLeft) <- HF.slotToEpoch slot
return $ conjoin [
epoch' === epoch
, inEpoch === 0
, inEpoch + slotsLeft === unEpochSize epochSize
]
reportsPastHorizon :: ArbitrarySummary -> Property
reportsPastHorizon :: ArbitrarySummary -> Property
reportsPastHorizon s :: ArbitrarySummary
s@ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
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
]
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 <- Eras xs -> Gen (Summary xs)
forall (xs :: [*]). Eras xs -> Gen (Summary xs)
genSummary Eras xs
is
let summaryStart :: HF.Bound
mSummaryEnd :: HF.EraEnd
(summaryStart, mSummaryEnd) = HF.summaryBounds summary
case mSummaryEnd of
EraEnd
HF.EraUnbounded -> do
beforeHorizonSlots <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
100_000_000)
beforeHorizonEpochs <- choose (0, 1_000_000)
beforeHorizonSeconds <- choose (0, 1_000_000_000)
let beforeHorizonSlot :: SlotNo
beforeHorizonEpoch :: EpochNo
beforeHorizonTime :: RelativeTime
beforeHorizonSlot = Word64 -> SlotNo -> SlotNo
HF.addSlots
Word64
beforeHorizonSlots
(Bound -> SlotNo
HF.boundSlot Bound
summaryStart)
beforeHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
Word64
beforeHorizonEpochs
(Bound -> EpochNo
HF.boundEpoch Bound
summaryStart)
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)
return ArbitrarySummary{
arbitrarySummary = summary
, beforeHorizonTime
, beforeHorizonSlot
, beforeHorizonEpoch
, mPastHorizonTime = Nothing
, mPastHorizonSlot = Nothing
, mPastHorizonEpoch = 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
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)
beforeHorizonEpochs <- choose (0, summaryEpochs - 1)
beforeHorizonSeconds <- choose (0, summaryTimeSpanSeconds)
`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 = Word64 -> SlotNo -> SlotNo
HF.addSlots
Word64
beforeHorizonSlots
(Bound -> SlotNo
HF.boundSlot Bound
summaryStart)
beforeHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
Word64
beforeHorizonEpochs
(Bound -> EpochNo
HF.boundEpoch Bound
summaryStart)
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)
pastHorizonSlots :: Word64 <- choose (0, 10)
pastHorizonEpochs :: Word64 <- choose (0, 10)
pastHorizonSeconds :: Double <- choose (0, 10)
let pastHorizonSlot :: SlotNo
pastHorizonEpoch :: EpochNo
pastHorizonTime :: RelativeTime
pastHorizonSlot = Word64 -> SlotNo -> SlotNo
HF.addSlots
Word64
pastHorizonSlots
(Bound -> SlotNo
HF.boundSlot Bound
summaryEnd)
pastHorizonEpoch = Word64 -> EpochNo -> EpochNo
HF.addEpochs
Word64
pastHorizonEpochs
(Bound -> EpochNo
HF.boundEpoch Bound
summaryEnd)
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)
return ArbitrarySummary{
arbitrarySummary = summary
, beforeHorizonTime
, beforeHorizonSlot
, beforeHorizonEpoch
, mPastHorizonTime = Just pastHorizonTime
, mPastHorizonSlot = Just pastHorizonSlot
, mPastHorizonEpoch = Just pastHorizonEpoch
}
shrink :: ArbitrarySummary -> [ArbitrarySummary]
shrink summary :: ArbitrarySummary
summary@ArbitrarySummary{Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
Summary xs
mPastHorizonEpoch :: ArbitrarySummary -> Maybe EpochNo
mPastHorizonSlot :: ArbitrarySummary -> Maybe SlotNo
mPastHorizonTime :: ArbitrarySummary -> Maybe RelativeTime
beforeHorizonEpoch :: ArbitrarySummary -> EpochNo
beforeHorizonSlot :: ArbitrarySummary -> SlotNo
beforeHorizonTime :: ArbitrarySummary -> RelativeTime
arbitrarySummary :: ()
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 [
[ ArbitrarySummary
summary { beforeHorizonSlot = SlotNo s }
| Word64
s <- Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink (SlotNo -> Word64
unSlotNo SlotNo
beforeHorizonSlot)
]
, [ ArbitrarySummary
summary { beforeHorizonEpoch = EpochNo e }
| Word64
e <- Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink (EpochNo -> Word64
unEpochNo EpochNo
beforeHorizonEpoch)
]
, [ 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
]
, [ ArbitrarySummary { arbitrarySummary :: Summary xs
arbitrarySummary = Summary xs
summary', Maybe EpochNo
Maybe SlotNo
Maybe RelativeTime
EpochNo
SlotNo
RelativeTime
mPastHorizonEpoch :: Maybe EpochNo
mPastHorizonSlot :: Maybe SlotNo
mPastHorizonTime :: Maybe RelativeTime
beforeHorizonEpoch :: EpochNo
beforeHorizonSlot :: SlotNo
beforeHorizonTime :: RelativeTime
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)
]
]