View on GitHub
File Changes
                         Generator.Core
                         Generator.LedgerTrace
                         Generator.Delegation
+
                         Generator.Update
                         Generator.Utxo
                         PropertyTests
                         STSTests

                      
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,
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

                      
module Generator.Core
  ( findPayKeyPair
  , genCoin
+
  , genNatural
  , genTxOut
  , genUtxo0
  , mkGenesisLedgerState
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))
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
+
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}

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

                      
import           Data.Sequence (Seq)

                      
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

                      
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 (..))
+
{-# 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))]