{-# LANGUAGE TypeApplications #-}

-- | Common test utilities for Peras tests.
module Test.Util.Peras.Common
  ( genPerasParams
  , genRoundNo
  , genSeatIndex
  , genPoolId
  , genLedgerStake
  , ListWithUniqueIds (..)
  , NonEmptyListWithUniqueIds (..)
  , genListWithUniqueIds
  , genNonEmptyListWithUniqueIds
  , nonEmptyListOf
  , genRelativeTime
  , genWithArrivalTime
  , genPointTestBlock
  , mockSystemTime
  , mkBucket
  , divisorClosestToTarget
  , divisorClosestToQuotient
  ) where

import Cardano.Prelude (comparing)
import Data.Containers.ListUtils (nubOrdOn)
import Data.List (sortBy)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Word (Word64)
import Ouroboros.Consensus.Block.SupportsPeras
  ( PerasParams
  , PerasRoundNo (..)
  , defaultPerasParams
  )
import Ouroboros.Consensus.BlockchainTime
  ( RelativeTime (..)
  , SystemTime (..)
  , WithArrivalTime (..)
  )
import Ouroboros.Consensus.Committee.Types (LedgerStake (..), PoolId)
import Ouroboros.Consensus.Peras.Types (PerasSeatIndex (..))
import Ouroboros.Network.Block (Point (..), SlotNo (..))
import Ouroboros.Network.Point (Block (..), WithOrigin (..))
import Test.QuickCheck (Arbitrary (..), Gen, NonEmptyList (..), choose)
import Test.QuickCheck.Gen (frequency, listOf, listOf1)
import Test.Util.Committee (mkPoolId)
import Test.Util.TestBlock (TestBlock, TestHash (..))

genPerasParams :: Gen (PerasParams blk)
genPerasParams :: forall blk. Gen (PerasParams blk)
genPerasParams = PerasParams blk -> Gen (PerasParams blk)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasParams blk
forall blk. PerasParams blk
defaultPerasParams

genRoundNo :: Gen PerasRoundNo
genRoundNo :: Gen PerasRoundNo
genRoundNo = Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Gen Word64 -> Gen PerasRoundNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary

genSeatIndex :: Gen PerasSeatIndex
genSeatIndex :: Gen PerasSeatIndex
genSeatIndex = Word16 -> PerasSeatIndex
PerasSeatIndex (Word16 -> PerasSeatIndex) -> Gen Word16 -> Gen PerasSeatIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word16
forall a. Arbitrary a => Gen a
arbitrary

genPoolId :: Gen PoolId
genPoolId :: Gen PoolId
genPoolId = [Char] -> PoolId
mkPoolId ([Char] -> PoolId) -> Gen [Char] -> Gen PoolId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Char]
forall a. Arbitrary a => Gen a
arbitrary

genLedgerStake :: Gen LedgerStake
genLedgerStake :: Gen LedgerStake
genLedgerStake = Rational -> LedgerStake
LedgerStake (Rational -> LedgerStake)
-> (Int -> Rational) -> Int -> LedgerStake
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Rational
forall a. Real a => a -> Rational
toRational (Int -> LedgerStake) -> Gen Int -> Gen LedgerStake
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose @Int (Int
1, Int
100)

newtype ListWithUniqueIds a = ListWithUniqueIds [a]
  deriving (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
(ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> Eq (ListWithUniqueIds a)
forall a.
Eq a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
== :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
$c/= :: forall a.
Eq a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
/= :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
Eq, Int -> ListWithUniqueIds a -> ShowS
[ListWithUniqueIds a] -> ShowS
ListWithUniqueIds a -> [Char]
(Int -> ListWithUniqueIds a -> ShowS)
-> (ListWithUniqueIds a -> [Char])
-> ([ListWithUniqueIds a] -> ShowS)
-> Show (ListWithUniqueIds a)
forall a. Show a => Int -> ListWithUniqueIds a -> ShowS
forall a. Show a => [ListWithUniqueIds a] -> ShowS
forall a. Show a => ListWithUniqueIds a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ListWithUniqueIds a -> ShowS
showsPrec :: Int -> ListWithUniqueIds a -> ShowS
$cshow :: forall a. Show a => ListWithUniqueIds a -> [Char]
show :: ListWithUniqueIds a -> [Char]
$cshowList :: forall a. Show a => [ListWithUniqueIds a] -> ShowS
showList :: [ListWithUniqueIds a] -> ShowS
Show, Eq (ListWithUniqueIds a)
Eq (ListWithUniqueIds a) =>
(ListWithUniqueIds a -> ListWithUniqueIds a -> Ordering)
-> (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> (ListWithUniqueIds a -> ListWithUniqueIds a -> Bool)
-> (ListWithUniqueIds a
    -> ListWithUniqueIds a -> ListWithUniqueIds a)
-> (ListWithUniqueIds a
    -> ListWithUniqueIds a -> ListWithUniqueIds a)
-> Ord (ListWithUniqueIds a)
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
ListWithUniqueIds a -> ListWithUniqueIds a -> Ordering
ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
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
forall a. Ord a => Eq (ListWithUniqueIds a)
forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Ordering
forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
$ccompare :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Ordering
compare :: ListWithUniqueIds a -> ListWithUniqueIds a -> Ordering
$c< :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
< :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
$c<= :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
<= :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
$c> :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
> :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
$c>= :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
>= :: ListWithUniqueIds a -> ListWithUniqueIds a -> Bool
$cmax :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
max :: ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
$cmin :: forall a.
Ord a =>
ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
min :: ListWithUniqueIds a -> ListWithUniqueIds a -> ListWithUniqueIds a
Ord)

newtype NonEmptyListWithUniqueIds a = NonEmptyListWithUniqueIds (NonEmpty a)
  deriving (NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
(NonEmptyListWithUniqueIds a
 -> NonEmptyListWithUniqueIds a -> Bool)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> Bool)
-> Eq (NonEmptyListWithUniqueIds a)
forall a.
Eq a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
== :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
$c/= :: forall a.
Eq a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
/= :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
Eq, Int -> NonEmptyListWithUniqueIds a -> ShowS
[NonEmptyListWithUniqueIds a] -> ShowS
NonEmptyListWithUniqueIds a -> [Char]
(Int -> NonEmptyListWithUniqueIds a -> ShowS)
-> (NonEmptyListWithUniqueIds a -> [Char])
-> ([NonEmptyListWithUniqueIds a] -> ShowS)
-> Show (NonEmptyListWithUniqueIds a)
forall a. Show a => Int -> NonEmptyListWithUniqueIds a -> ShowS
forall a. Show a => [NonEmptyListWithUniqueIds a] -> ShowS
forall a. Show a => NonEmptyListWithUniqueIds a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> NonEmptyListWithUniqueIds a -> ShowS
showsPrec :: Int -> NonEmptyListWithUniqueIds a -> ShowS
$cshow :: forall a. Show a => NonEmptyListWithUniqueIds a -> [Char]
show :: NonEmptyListWithUniqueIds a -> [Char]
$cshowList :: forall a. Show a => [NonEmptyListWithUniqueIds a] -> ShowS
showList :: [NonEmptyListWithUniqueIds a] -> ShowS
Show, Eq (NonEmptyListWithUniqueIds a)
Eq (NonEmptyListWithUniqueIds a) =>
(NonEmptyListWithUniqueIds a
 -> NonEmptyListWithUniqueIds a -> Ordering)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> Bool)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> Bool)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> Bool)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> Bool)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a)
-> (NonEmptyListWithUniqueIds a
    -> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a)
-> Ord (NonEmptyListWithUniqueIds a)
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> Ordering
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
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
forall a. Ord a => Eq (NonEmptyListWithUniqueIds a)
forall a.
Ord a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
forall a.
Ord a =>
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> Ordering
forall a.
Ord a =>
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
$ccompare :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> Ordering
compare :: NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> Ordering
$c< :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
< :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
$c<= :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
<= :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
$c> :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
> :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
$c>= :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
>= :: NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a -> Bool
$cmax :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
max :: NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
$cmin :: forall a.
Ord a =>
NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
min :: NonEmptyListWithUniqueIds a
-> NonEmptyListWithUniqueIds a -> NonEmptyListWithUniqueIds a
Ord)

genListWithUniqueIds ::
  Ord idTy =>
  (a -> idTy) ->
  Gen a ->
  Gen (ListWithUniqueIds a)
genListWithUniqueIds :: forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (ListWithUniqueIds a)
genListWithUniqueIds a -> idTy
getId Gen a
genObject =
  [a] -> ListWithUniqueIds a
forall a. [a] -> ListWithUniqueIds a
ListWithUniqueIds ([a] -> ListWithUniqueIds a)
-> ([a] -> [a]) -> [a] -> ListWithUniqueIds a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> idTy) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn a -> idTy
getId ([a] -> ListWithUniqueIds a)
-> Gen [a] -> Gen (ListWithUniqueIds a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
listOf Gen a
genObject

genNonEmptyListWithUniqueIds ::
  Ord idTy =>
  (a -> idTy) ->
  Gen a ->
  Gen (NonEmptyListWithUniqueIds a)
genNonEmptyListWithUniqueIds :: forall idTy a.
Ord idTy =>
(a -> idTy) -> Gen a -> Gen (NonEmptyListWithUniqueIds a)
genNonEmptyListWithUniqueIds a -> idTy
getId Gen a
genObject =
  NonEmpty a -> NonEmptyListWithUniqueIds a
forall a. NonEmpty a -> NonEmptyListWithUniqueIds a
NonEmptyListWithUniqueIds (NonEmpty a -> NonEmptyListWithUniqueIds a)
-> ([a] -> NonEmpty a) -> [a] -> NonEmptyListWithUniqueIds a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> ([a] -> [a]) -> [a] -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> idTy) -> [a] -> [a]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn a -> idTy
getId
    ([a] -> NonEmptyListWithUniqueIds a)
-> Gen [a] -> Gen (NonEmptyListWithUniqueIds a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
listOf1 Gen a
genObject

nonEmptyListOf :: Gen a -> Gen (NonEmpty a)
nonEmptyListOf :: forall a. Gen a -> Gen (NonEmpty a)
nonEmptyListOf Gen a
genObject =
  [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList ([a] -> NonEmpty a) -> Gen [a] -> Gen (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
listOf1 Gen a
genObject

-- | Find the whole divisor of 'a' that is the closest to 'a/b'.
--
-- If there are multiple divisors with the same distance, the smallest one is
-- returned.
--
-- >>> divisorClosestToQuotient 10 3
-- 2
-- >>> divisorClosestToQuotient 10 5
-- 2
-- >>> divisorClosestToQuotient 6 10
-- 1
divisorClosestToQuotient :: Integral a => a -> a -> a
divisorClosestToQuotient :: forall a. Integral a => a -> a -> a
divisorClosestToQuotient a
num a
denom =
  a -> Double -> a
forall a. Integral a => a -> Double -> a
divisorClosestToTarget
    a
num
    ( (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
num :: Double)
        Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
denom :: Double)
    )

-- | Find the whole divisor of 'num' that is the closest to 'target'.
divisorClosestToTarget :: Integral a => a -> Double -> a
divisorClosestToTarget :: forall a. Integral a => a -> Double -> a
divisorClosestToTarget a
num Double
target =
  case ((a, Double) -> (a, Double) -> Ordering)
-> [(a, Double)] -> [(a, Double)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, Double) -> Double) -> (a, Double) -> (a, Double) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, Double) -> Double
forall a b. (a, b) -> b
snd) (a -> (a, Double)
forall {a}. Integral a => a -> (a, Double)
addDistance (a -> (a, Double)) -> [a] -> [(a, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
divisors) of
    [] -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible: divisorClosestToTarget found no divisors"
    (a
closestDivisor, Double
_dist) : [(a, Double)]
_ -> a
closestDivisor
 where
  divisors :: [a]
divisors = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\a
x -> a
num a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) [a
1 .. a
num]
  addDistance :: a -> (a, Double)
addDistance a
divisor = (a
divisor, a -> Double
forall {a}. Integral a => a -> Double
getDistance a
divisor)
  getDistance :: a -> Double
getDistance a
divisor = Double -> Double
forall a. Num a => a -> a
abs (Double
target Double -> Double -> Double
forall a. Num a => a -> a -> a
- a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
divisor)

-- * Shared generators for Peras smoke tests

genRelativeTime :: Gen RelativeTime
genRelativeTime :: Gen RelativeTime
genRelativeTime =
  NominalDiffTime -> RelativeTime
RelativeTime (NominalDiffTime -> RelativeTime)
-> (Word64 -> NominalDiffTime) -> Word64 -> RelativeTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Word64 -> RelativeTime) -> Gen Word64 -> Gen RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @Word64

genWithArrivalTime :: Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime :: forall a. Gen a -> Gen (WithArrivalTime a)
genWithArrivalTime Gen a
genA =
  RelativeTime -> a -> WithArrivalTime a
forall a. RelativeTime -> a -> WithArrivalTime a
WithArrivalTime
    (RelativeTime -> a -> WithArrivalTime a)
-> Gen RelativeTime -> Gen (a -> WithArrivalTime a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RelativeTime
genRelativeTime
    Gen (a -> WithArrivalTime a) -> Gen a -> Gen (WithArrivalTime a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
genA

genPointTestBlock :: Gen (Point TestBlock)
genPointTestBlock :: Gen (Point TestBlock)
genPointTestBlock =
  [(Int, Gen (Point TestBlock))] -> Gen (Point TestBlock)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [
      ( Int
1
      , Point TestBlock -> Gen (Point TestBlock)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithOrigin (Block SlotNo (HeaderHash TestBlock)) -> Point TestBlock
forall {k} (block :: k).
WithOrigin (Block SlotNo (HeaderHash block)) -> Point block
Point WithOrigin (Block SlotNo (HeaderHash TestBlock))
WithOrigin (Block SlotNo TestHash)
forall t. WithOrigin t
Origin)
      )
    ,
      ( Int
50
      , do
          slotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
          hash <- TestHash . NonEmpty.fromList . getNonEmpty <$> arbitrary
          pure (Point (At (Block slotNo hash)))
      )
    ]

-- | A static 'SystemTime' returning a constant time. The canonical mock system
-- time lives in 'Test.Util.LogicalClock.mockSystemTime', but it is a field of
-- 'LogicalClock' which requires a 'ResourceRegistry' and a background tick
-- thread — too heavyweight for simple property tests that don't need time
-- progression.
mockSystemTime :: Applicative m => SystemTime m
mockSystemTime :: forall (m :: * -> *). Applicative m => SystemTime m
mockSystemTime =
  SystemTime
    { systemTimeCurrent :: m RelativeTime
systemTimeCurrent = RelativeTime -> m RelativeTime
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> RelativeTime
RelativeTime NominalDiffTime
0)
    , systemTimeWait :: m ()
systemTimeWait = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }

-- * Tabulators

mkBucket :: Int -> Int -> String -> String
mkBucket :: Int -> Int -> ShowS
mkBucket Int
bucketSize Int
x [Char]
suffix
  | Int
lower Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
upper = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lower [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
suffix
  | Bool
otherwise = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lower [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"-" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
upper [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
suffix
 where
  lower :: Int
lower = (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bucketSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bucketSize
  upper :: Int
upper = Int
lower Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bucketSize