{-# LANGUAGE OverloadedStrings #-}

module Test.Byron.Spec.Ledger.Core.Generators.Properties (relevantKValuesAreGenerated) where

import qualified Byron.Spec.Ledger.Core.Generators as CoreGen
import qualified Byron.Spec.Ledger.GlobalParams as GP
import Control.Monad (when)
import Data.Word (Word64)
import Hedgehog (Property, cover, forAll, property, withTests)

-- | Coverage test to check that we're generating relevant 'k' values.
relevantKValuesAreGenerated :: Property
relevantKValuesAreGenerated :: Property
relevantKValuesAreGenerated = TestLimit -> Property -> Property
withTests TestLimit
500 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
  HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    let chainLength :: Word64
chainLength = Word64
1000 :: Word64

    BlockCount
k <- Gen BlockCount -> PropertyT IO BlockCount
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen BlockCount -> PropertyT IO BlockCount)
-> Gen BlockCount -> PropertyT IO BlockCount
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Gen BlockCount
CoreGen.k Word64
chainLength (Word64
chainLength Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
10)

    let slotsPerEpoch :: Word64
        slotsPerEpoch :: Word64
slotsPerEpoch = BlockCount -> Word64
forall n. Integral n => BlockCount -> n
GP.slotsPerEpoch BlockCount
k

    Bool -> PropertyT IO () -> PropertyT IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
slotsPerEpoch Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0) (PropertyT IO () -> PropertyT IO ())
-> PropertyT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ do
      let epochs :: Word64
          epochs :: Word64
epochs = Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
chainLength Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
slotsPerEpoch :: Double)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover
        CoverPercentage
5
        LabelName
"1 epochs "
        (Word64
epochs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
1)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover
        CoverPercentage
20
        LabelName
"epochs in [2, 25)"
        (Word64
2 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
epochs Bool -> Bool -> Bool
&& Word64
epochs Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
25)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover
        CoverPercentage
5
        LabelName
"epochs in [25, 50)"
        (Word64
25 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
epochs Bool -> Bool -> Bool
&& Word64
epochs Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
50)

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover
        CoverPercentage
5
        LabelName
"50 epochs "
        (Word64
epochs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
50)

      -- Note that we will not get any epochs between 50 and 100 since this will require the value of
      -- @k@ to be a fraction. For instance, to get a @k@ value that will produce 70 epochs for a
      -- chain of length 1000, we need (assuming @10k@ slots per-epoch):
      --
      -- > 1000 / (10 * 70) ~ 1.428
      --
      -- So if we round this value up, we get 50 epochs:
      --
      -- > 1000 / (10 * 2) == 50
      --
      -- And if we round this value down we get 100 epochs.

      CoverPercentage -> LabelName -> Bool -> PropertyT IO ()
forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
CoverPercentage -> LabelName -> Bool -> m ()
cover
        CoverPercentage
6
        LabelName
"100 epochs "
        (Word64
epochs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
100)