View on GitHub
File Changes
{
  "url": "https://github.com/input-output-hk/iohk-nix",
-
  "rev": "3c4710d65404d2bbdcc896f48e0f7b9ca6ed681b",
-
  "date": "2019-10-13T23:23:10-04:00",
-
  "sha256": "1lh148fhpq6m4rv7489h6b3awl91dphlmv60l1f2gg28j7krh5lr",
+
  "rev": "76009097392d1288b5bb7579f140e4a28c96da89",
+
  "date": "2019-10-15T08:05:18+00:00",
+
  "sha256": "1j5n1fipzxy24da09rlg1r3wa3g0f4gj3ym2500lk72zwfahb3wv",
  "fetchSubmodules": false
}
                         Generator.Core
                         Generator.LedgerTrace
                         Generator.Delegation
+
                         Generator.Update
                         Generator.Utxo
                         PropertyTests
                         STSTests
    (
      utxoSize
    , utxoMap
-
    , genBool
    , genNatural
    , genNonEmptyAndAdvanceTx
    , genNonEmptyAndAdvanceTx'

                      
import           BaseTypes
import           Coin
-
import           Generator.Core (findPayKeyPair)
+
import           Generator.Core (findPayKeyPair, genInteger, genNatural)
import           Keys (pattern KeyPair, hashKey, hashKeyVRF, vKey)
import           LedgerState (DState (..), pattern LedgerValidation, ValidationError (..),
                     asStateTransition, asStateTransition', dstate, genesisCoins, genesisState,
addrTxins :: KeyPairs -> [Addr]
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
-

                      
-- | Generator for List of 'Coin' values. Generates between 'lower' and 'upper'
-- coins, with values between 'minCoin' and 'maxCoin'.
genCoinList :: Integer -> Integer -> Int -> Int -> Gen [Coin]

                      
module Generator.Core
  ( findPayKeyPair
+
  , genBool
  , genCoin
+
  , genInteger
+
  , genNatural
  , genTxOut
  , genUtxo0
+
  , increasingProbabilityAt
  , mkGenesisLedgerState
  , traceKeyPairs
  , someKeyPairs
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)

                      
+
genBool :: Gen Bool
+
genBool = Gen.enumBounded
+

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

                      
+
-- | 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))
  utxo0 <- genUtxo0 5 10
  let (LedgerState utxoSt dpSt _) = genesisState utxo0
  pure (utxoSt, dpSt)
+

                      
+
-- | Generate values the given distribution in 90% of the cases, and values at
+
-- the bounds of the range in 10% of the cases.
+
--
+
-- This can be used to generate enough extreme values. The exponential and
+
-- linear distributions provided by @[email protected] will generate a small percentage
+
-- of these (0-1%).
+
increasingProbabilityAt
+
  :: Gen a
+
  -> (a, a)
+
  -> Gen a
+
increasingProbabilityAt gen (lower, upper)
+
  = Gen.frequency [ (5, pure lower)
+
                  , (90, gen)
+
                  , (5, pure upper)
+
                  ]
{-# 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 (genInteger, genNatural, increasingProbabilityAt)
+
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
+
                       <*> increasingProbabilityAt
+
                             (Coin <$> genInteger 0 50)
+
                             (Coin 0, Coin 50)
+
                       -- keyMinRefund: 0.1-0.5
+
                       <*> genIntervalInThousands 100 500
+
                       -- keyDecayRate: 0.001-0.1
+
                       <*> genRationalInThousands 1 100
+
                       -- poolDeposit
+
                       <*> increasingProbabilityAt
+
                             (Coin <$> genInteger 0 500)
+
                             (Coin 0, Coin 500)
+
                       -- poolMinRefund: 0.1-0.7
+
                       <*> genIntervalInThousands 100 700
+
                       -- poolDecayRate: 0.001-0.1
+
                       <*> genRationalInThousands 1 100
+
                       -- eMax (for an epoch per 5 days, say, this is between a month and 7yrs)
+
                       <*> (Epoch <$> genNatural 6 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
+
                       <*> increasingProbabilityAt
+
                             (genIntervalInThousands 0 1000)
+
                             (unsafeMkUnitInterval 0, unsafeMkUnitInterval 1)
+
                       -- decentralisation param: 0,0.1,0.2..1
+
                       <*> (unsafeMkUnitInterval <$> Gen.element [0, 0.1 .. 1])
+
                       <*> 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))]