{-# 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)
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Natural, Natural, Natural, Natural)
szGen
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Double
doubleInc -- bkSgnCntT
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (SlotCount, SlotCount)
slotBlockGen
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear (Natural
0 :: Natural) Natural
1000) -- scriptVersion
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (forall a. a -> a -> Range a
Range.constant Double
0 Double
1) -- cfmThd
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (forall a. a -> a -> Range a
Range.constant Double
0 Double
1) -- upAdptThd
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int (forall a. Integral a => a -> a -> Range a
Range.linear Int
0 Int
100) -- factor @a@
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.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 :: Gen (Natural, Natural, Natural, Natural)
szGen = do
      Natural
bkSize <- forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Natural
1 Natural
hi)
      (Natural
bkSize,,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Gen Natural
gRange Natural
bkSize
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Gen Natural
gRange Natural
bkSize
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Gen 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 -> Gen Natural
gRange Natural
upper = forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Natural
lo Natural
upper)

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