{-# 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 (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 (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 (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 (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 (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 (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 (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
  -- | Generates maxBkSz, maxHdrSz, maxTxSz and maxPropSz
  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 (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 (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)

  -- | Generates bkSlotsPerEpoch, upTtl and stableAfter
  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))