{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

-- | Generators for the 'Ledger.Update' values.
module Byron.Spec.Ledger.Update.Generators (pparamsGen) where

import Byron.Spec.Ledger.Core (
  BlockCount (BlockCount),
  SlotCount (SlotCount),
  unBlockCount,
  unSlotCount,
 )
import Byron.Spec.Ledger.Update (
  BkSgnCntT (..),
  FactorA (..),
  FactorB (..),
  PParams (PParams),
  UpAdptThd (..),
 )
import Data.Word (Word64)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import Hedgehog.Gen.Double (doubleInc)
import qualified Hedgehog.Range as Range
import Numeric.Natural (Natural)

-- | Generates valid protocol parameters
--
-- TODO: The protocol parameters still need to be aligned with the formal
-- spec.
pparamsGen :: Gen PParams
pparamsGen :: Gen PParams
pparamsGen =
  ( \((Natural
maxBkSz, Natural
maxHdrSz, Natural
maxTxSz, Natural
maxPropSz) :: (Natural, Natural, Natural, Natural))
     (Double
bkSgnCntTDouble :: Double)
     ((SlotCount
bkSlotsPerEpoch, SlotCount
upTtl) :: (SlotCount, SlotCount))
     (Natural
scriptVersion :: Natural)
     (Double
_cfmThd :: Double)
     (Double
upAdptThdDouble :: Double)
     (Int
factorAInt :: Int)
     (Int
factorBInt :: Int) ->
        Natural
-> Natural
-> Natural
-> Natural
-> BkSgnCntT
-> SlotCount
-> SlotCount
-> Natural
-> UpAdptThd
-> FactorA
-> FactorB
-> PParams
PParams
          Natural
maxBkSz
          Natural
maxHdrSz
          Natural
maxTxSz
          Natural
maxPropSz
          (Double -> BkSgnCntT
BkSgnCntT Double
bkSgnCntTDouble)
          SlotCount
bkSlotsPerEpoch
          SlotCount
upTtl
          Natural
scriptVersion
          (Double -> UpAdptThd
UpAdptThd Double
upAdptThdDouble)
          (Int -> FactorA
FactorA Int
factorAInt)
          (Int -> FactorB
FactorB Int
factorBInt)
  )
    ((Natural, Natural, Natural, Natural)
 -> Double
 -> (SlotCount, SlotCount)
 -> Natural
 -> Double
 -> Double
 -> Int
 -> Int
 -> PParams)
-> GenT Identity (Natural, Natural, Natural, Natural)
-> GenT
     Identity
     (Double
      -> (SlotCount, SlotCount)
      -> Natural
      -> Double
      -> Double
      -> Int
      -> Int
      -> PParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Natural, Natural, Natural, Natural)
szGen
    GenT
  Identity
  (Double
   -> (SlotCount, SlotCount)
   -> Natural
   -> Double
   -> Double
   -> Int
   -> Int
   -> PParams)
-> GenT Identity Double
-> GenT
     Identity
     ((SlotCount, SlotCount)
      -> Natural -> Double -> Double -> Int -> Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity Double
doubleInc -- bkSgnCntT
    GenT
  Identity
  ((SlotCount, SlotCount)
   -> Natural -> Double -> Double -> Int -> Int -> PParams)
-> GenT Identity (SlotCount, SlotCount)
-> GenT
     Identity (Natural -> Double -> Double -> Int -> Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity (SlotCount, SlotCount)
slotBlockGen
    GenT
  Identity (Natural -> Double -> Double -> Int -> Int -> PParams)
-> GenT Identity Natural
-> GenT Identity (Double -> Double -> Int -> Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear (Natural
0 :: Natural) Natural
1000) -- scriptVersion
    GenT Identity (Double -> Double -> Int -> Int -> PParams)
-> GenT Identity Double
-> GenT Identity (Double -> Int -> Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Double -> GenT Identity Double
forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range.constant Double
0 Double
1) -- cfmThd
    GenT Identity (Double -> Int -> Int -> PParams)
-> GenT Identity Double -> GenT Identity (Int -> Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Double -> GenT Identity Double
forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (Double -> Double -> Range Double
forall a. a -> a -> Range a
Range.constant Double
0 Double
1) -- upAdptThd
    GenT Identity (Int -> Int -> PParams)
-> GenT Identity Int -> GenT Identity (Int -> PParams)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100) -- factor @a@
    GenT Identity (Int -> PParams) -> GenT Identity Int -> Gen PParams
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
10) -- factor @b@
  where
    szGen :: Gen (Natural, Natural, Natural, Natural)
    szGen :: GenT Identity (Natural, Natural, Natural, Natural)
szGen = do
      Natural
bkSize <- Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear Natural
1 Natural
hi)
      (Natural
bkSize,,,)
        (Natural
 -> Natural -> Natural -> (Natural, Natural, Natural, Natural))
-> GenT Identity Natural
-> GenT
     Identity
     (Natural -> Natural -> (Natural, Natural, Natural, Natural))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> GenT Identity Natural
gRange Natural
bkSize
        GenT
  Identity
  (Natural -> Natural -> (Natural, Natural, Natural, Natural))
-> GenT Identity Natural
-> GenT Identity (Natural -> (Natural, Natural, Natural, Natural))
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> GenT Identity Natural
gRange Natural
bkSize
        GenT Identity (Natural -> (Natural, Natural, Natural, Natural))
-> GenT Identity Natural
-> GenT Identity (Natural, Natural, Natural, Natural)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> GenT Identity Natural
gRange Natural
bkSize
      where
        lo :: Natural
lo = Natural
1 :: Natural
        -- In mainnet the maximum header size is set to 2000000 and the maximum
        -- block size is also set to 2000000, so we have to make sure we cover
        -- those values here. The upper bound is arbitrary though.
        hi :: Natural
hi = Natural
4000000 :: Natural
        gRange :: Natural -> Gen Natural
        gRange :: Natural -> GenT Identity Natural
gRange Natural
upper = Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear Natural
lo Natural
upper)

    slotBlockGen :: Gen (SlotCount, SlotCount)
    slotBlockGen :: GenT Identity (SlotCount, SlotCount)
slotBlockGen = do
      -- The number of slots per epoch is computed from 'k':
      -- slots per-epoch = k * 10
      BlockCount
k <- Word64 -> BlockCount
BlockCount (Word64 -> BlockCount)
-> GenT Identity Word64 -> GenT Identity BlockCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Word64 -> GenT Identity Word64
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
1 Word64
10000)
      let perEpoch :: SlotCount
perEpoch = Word64 -> SlotCount
SlotCount (Word64 -> SlotCount) -> Word64 -> SlotCount
forall a b. (a -> b) -> a -> b
$ BlockCount -> Word64
unBlockCount BlockCount
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10
      (SlotCount
perEpoch,)
        (SlotCount -> (SlotCount, SlotCount))
-> GenT Identity SlotCount -> GenT Identity (SlotCount, SlotCount)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> SlotCount
SlotCount (Word64 -> SlotCount)
-> GenT Identity Word64 -> GenT Identity SlotCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotCount -> GenT Identity Word64
gRange SlotCount
perEpoch)
      where
        gRange :: SlotCount -> Gen Word64
        gRange :: SlotCount -> GenT Identity Word64
gRange SlotCount
hi = Range Word64 -> GenT Identity Word64
forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (Word64 -> Word64 -> Range Word64
forall a. Integral a => a -> a -> Range a
Range.linear Word64
1 (SlotCount -> Word64
unSlotCount SlotCount
hi))