Skip to content
Permalink
Browse files

[867] Generate PParams

  • Loading branch information
uroboros committed Oct 14, 2019
1 parent 11b674a commit 890a0256492f9fa3991527bd7e26637d618dd596
@@ -94,6 +94,7 @@ test-suite delegation-test
Generator.Core
Generator.LedgerTrace
Generator.Delegation
Generator.Update
Generator.Utxo
PropertyTests
STSTests
@@ -37,7 +37,7 @@ import qualified Hedgehog.Range as Range

import BaseTypes
import Coin
import Generator.Core (findPayKeyPair)
import Generator.Core (findPayKeyPair, genNatural)
import Keys (pattern KeyPair, hashKey, hashKeyVRF, vKey)
import LedgerState (DState (..), pattern LedgerValidation, ValidationError (..),
asStateTransition, asStateTransition', dstate, genesisCoins, genesisState,
@@ -90,10 +90,6 @@ addrTxins keyPairs = uncurry AddrBase <$> hashKeyPairs keyPairs
genBool :: Gen Bool
genBool = Gen.enumBounded

-- | Generator for a natural number between 'lower' and 'upper'.
genNatural :: Natural -> Natural -> Gen Natural
genNatural lower upper = Gen.integral $ Range.linear lower upper

genInteger :: Integer -> Integer -> Gen Integer
genInteger lower upper = Gen.integral $ Range.linear lower upper

@@ -5,6 +5,7 @@
module Generator.Core
( findPayKeyPair
, genCoin
, genNatural
, genTxOut
, genUtxo0
, mkGenesisLedgerState
@@ -28,9 +29,14 @@ import Keys (pattern KeyPair, hashKey, vKey)
import LedgerState (pattern LedgerState, genesisCoins, genesisState)
import MockTypes (Addr, DPState, KeyPair, KeyPairs, LedgerEnv, TxOut, UTxO, UTxOState,
VKey)
import Numeric.Natural (Natural)
import Tx (pattern TxOut)
import TxData (pattern AddrBase, pattern KeyHashObj)

-- | Generator for a natural number between 'lower' and 'upper'
genNatural :: Natural -> Natural -> Gen Natural
genNatural lower upper = Gen.integral $ Range.linear lower upper

mkKeyPairs :: Word64 -> (KeyPair, KeyPair)
mkKeyPairs n
= (mkKeyPair_ (2*n), mkKeyPair_ (2*n+1))
@@ -1,13 +1,12 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Generator.Delegation
( genDCerts
, genPParams
)
( genDCerts )
where

import Data.Sequence (Seq)
@@ -19,37 +18,14 @@ import qualified Hedgehog.Gen as Gen

import Coin (Coin (..))
import Delegation.Certificates (pattern DeRegKey, pattern RegKey, decayKey, isDeRegKey)
import Examples (unsafeMkUnitInterval)
import Generator.Core (toCred)
import Ledger.Core (dom, (∈), (∉))
import LedgerState (dstate, keyRefund, stkCreds, _dstate, _pstate, _stkCreds, _stPools)
import MockTypes (DCert, DPState, DState, KeyPair, KeyPairs)
import PParams (PParams (..), emptyPParams)
import Slot (Epoch (Epoch), Slot)
import PParams (PParams (..))
import Slot (Slot)
import UTxO (deposits)

-- TODO @uroboros Generate a range of protocol params
-- TODO @uroboros for now, keeping minA/B at zero until we generate fees in genTx
genPParams :: Gen PParams
genPParams = pure $ emptyPParams {
_minfeeA = 0
, _minfeeB = 0
, _maxBBSize = 50000
, _maxBHSize = 10000
, _maxTxSize = 10000
, _eMax = Epoch 10000
, _keyDeposit = Coin 7
, _poolDeposit = Coin 250
, _d = unsafeMkUnitInterval 0.5
, _activeSlotCoeff = unsafeMkUnitInterval 0.1
, _tau = unsafeMkUnitInterval 0.2
, _rho = unsafeMkUnitInterval 0.0021
, _keyDecayRate = 0.002
, _keyMinRefund = unsafeMkUnitInterval 0.5
, _poolDecayRate = 0.001
, _poolMinRefund = unsafeMkUnitInterval 0.5
}

-- | Generate certificates and also return the associated witnesses and
-- deposits and refunds required.
genDCerts
@@ -16,7 +16,7 @@ import Cardano.Crypto.VRF.Fake (FakeVRF)

import Control.State.Transition.Generator (HasTrace, envGen, sigGen)
import Generator.Core (genCoin, traceKeyPairs)
import Generator.Delegation (genPParams)
import Generator.Update (genPParams)
import Generator.Utxo (genTx)
import Slot (Slot (..))
import STS.Ledger (LEDGER, LedgerEnv (..))
@@ -0,0 +1,92 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

module Generator.Update
( genPParams )
where

import Data.Ratio ((%))
import Hedgehog (Gen)

import qualified Hedgehog.Gen as Gen

import BaseTypes (Nonce (NeutralNonce), UnitInterval, mkNonce)
import Coin (Coin (..))
import Examples (unsafeMkUnitInterval)
import Generator.Core (genNatural)
import qualified Hedgehog.Range as Range
import Numeric.Natural (Natural)
import PParams (PParams (..))
import Slot (Epoch (Epoch))


genRationalInThousands :: Integer -> Integer -> Gen Rational
genRationalInThousands lower upper =
(% 1000) <$>
Gen.integral (Range.linear lower upper)

genIntervalInThousands :: Integer -> Integer -> Gen UnitInterval
genIntervalInThousands lower upper =
unsafeMkUnitInterval <$> genRationalInThousands lower upper

-- TODO @uroboros for now, keeping minA/B at zero until we generate fees in genTx
genPParams :: Gen PParams
genPParams = mkPParams <$> pure 0 -- _minfeeA
<*> pure 0 -- _minfeeB
<*> szGen -- (maxBBSize, maxBHSize, maxTxSize)
-- keyDeposit
<*> (Coin <$> Gen.integral (Range.linear 0 50))
-- keyMinRefund: 0.1-0.5
<*> genIntervalInThousands 100 500
-- keyDecayRate: 0.001-0.1
<*> genRationalInThousands 1 100
-- poolDeposit
<*> Gen.integral (Range.linear 0 500)
-- poolMinRefund: 0.1-0.7
<*> genIntervalInThousands 100 700
-- poolDecayRate: 0.001-0.1
<*> genRationalInThousands 1 100
-- eMax
<*> (Epoch <$> Gen.integral (Range.linear 20 500))
-- nOpt
<*> Gen.integral (Range.linear 1 100)
-- a0: 0.01-1.0
<*> genRationalInThousands 10 1000
-- rho: 0.001-0.009
<*> genIntervalInThousands 1 9
-- tau: 0.1-0.3
<*> genIntervalInThousands 100 300
-- activeSlotCoeff: 0-1
<*> genIntervalInThousands 0 1000
-- decentralisation param: 0-1
<*> genIntervalInThousands 0 1000
<*> genExtraEntropy
-- protocolVersion
<*> ((,,) <$> genNatural 1 10 <*> genNatural 1 50 <*> genNatural 1 100)
where
low = 1
hi = 200000

-- A wrapper to enable the dependent generators for the max sizes
mkPParams minFeeA minFeeB (maxBBSize, maxTxSize, maxBHSize) =
PParams minFeeA minFeeB maxBBSize maxTxSize maxBHSize

-- | Generates max block, header and transaction size. First generates the
-- body size and then header and tx sizes no larger than half the body size.
szGen :: Gen (Natural, Natural, Natural)
szGen = do
blockBodySize <- Gen.integral (Range.linear low hi)
(blockBodySize,,)
<$> rangeUpTo (blockBodySize `div` 2)
<*> rangeUpTo (blockBodySize `div` 2)

rangeUpTo :: Natural -> Gen Natural
rangeUpTo upper = Gen.integral (Range.linear low upper)

-- Generates a Neutral or actual Nonces with equal frequency
genExtraEntropy = Gen.frequency [ (1, pure NeutralNonce)
, (1, mkNonce <$> Gen.integral (Range.linear 1 123))]

0 comments on commit 890a025

Please sign in to comment.
You can’t perform that action at this time.