{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}

module Test.Cardano.Ledger.Shelley.Generator.Update (
  genPParams,
  genUpdate,
  genShelleyPParamsUpdate,
  genM,
  genDecentralisationParam,
) where

import Cardano.Ledger.BaseTypes (
  BoundedRational,
  EpochInterval (..),
  NonNegativeInterval,
  NonZero,
  Nonce (NeutralNonce),
  ProtVer (..),
  StrictMaybe (..),
  UnitInterval,
  Version,
  getVersion64,
  mkNonceFromNumber,
  mkVersion,
  mkVersion64,
  succVersion,
  unsafeNonZero,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  GenDelegs (..),
  KeyHash,
  KeyRole (..),
  asWitness,
  hashKey,
 )
import Cardano.Ledger.Shelley.API (
  ProposedPPUpdates,
  Update,
 )
import Cardano.Ledger.Shelley.LedgerState (
  CertState,
  DState (..),
  UTxOState (..),
  dsGenDelegsL,
 )
import Cardano.Ledger.Shelley.PParams
import Cardano.Ledger.Slot (EpochNo (EpochNo), SlotNo)
import Cardano.Ledger.State (EraCertState (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes)
import Data.Ratio (Ratio, (%))
import Data.Typeable (Typeable)
import Data.Word (Word16, Word32, Word64)
import GHC.Records
import GHC.Stack (HasCallStack)
import Lens.Micro
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Binary.Arbitrary (genVersion)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair, vKey)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (aikCold),
  genInteger,
  genNatural,
  genWord64,
  increasingProbabilityAt,
  tooLateInEpoch,
 )
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..))
import Test.Cardano.Ledger.Shelley.Utils (
  GenesisKeyPair,
  epochFromSlotNo,
  unsafeBoundRational,
 )
import Test.QuickCheck (Gen, choose, frequency)
import qualified Test.QuickCheck as QC

-- ====================================

genRationalInThousands :: HasCallStack => Integer -> Integer -> Gen Rational
genRationalInThousands :: HasCallStack => Integer -> Integer -> Gen Rational
genRationalInThousands Integer
lower Integer
upper =
  (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000) (Integer -> Rational) -> Gen Integer -> Gen Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
lower Integer
upper

genIntervalInThousands ::
  (Typeable a, BoundedRational a, HasCallStack) => Integer -> Integer -> Gen a
genIntervalInThousands :: forall a.
(Typeable a, BoundedRational a, HasCallStack) =>
Integer -> Integer -> Gen a
genIntervalInThousands Integer
lower Integer
upper =
  Rational -> a
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> a) -> Gen Rational -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Integer -> Integer -> Gen Rational
Integer -> Integer -> Gen Rational
genRationalInThousands Integer
lower Integer
upper

genPParams ::
  forall era.
  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
  Constants ->
  Gen (PParams era)
genPParams :: forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Constants -> Gen (PParams era)
genPParams c :: Constants
c@Constants {Coin
maxMinFeeA :: Coin
maxMinFeeA :: Constants -> Coin
maxMinFeeA, Coin
maxMinFeeB :: Coin
maxMinFeeB :: Constants -> Coin
maxMinFeeB} = do
  let lowMajorPV :: Version
lowMajorPV = forall era. Era era => Version
eraProtVerLow @era
      highMajorPV :: Version
highMajorPV = forall era. Era era => Version
eraProtVerHigh @era
  Integer
minFeeA <- Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeA)
  Integer
minFeeB <- Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeB)
  (Word32
maxBBSize, Word32
maxTxSize, Word16
maxBHSize) <- Gen (Word32, Word32, Word16)
szGen
  Coin
keyDeposit <- Gen Coin
HasCallStack => Gen Coin
genKeyDeposit
  Coin
poolDeposit <- Gen Coin
HasCallStack => Gen Coin
genPoolDeposit
  EpochInterval
eMax <- HasCallStack => Constants -> Gen EpochInterval
Constants -> Gen EpochInterval
genEMax Constants
c
  Word16
nOpt <- Gen Word16
HasCallStack => Gen Word16
genNOpt
  NonNegativeInterval
a0 <- Gen NonNegativeInterval
HasCallStack => Gen NonNegativeInterval
genA0
  UnitInterval
rho <- Gen UnitInterval
HasCallStack => Gen UnitInterval
genRho
  UnitInterval
tau <- Gen UnitInterval
HasCallStack => Gen UnitInterval
genTau
  UnitInterval
d <- Gen UnitInterval
HasCallStack => Gen UnitInterval
genDecentralisationParam
  Nonce
extraEntropy <- Gen Nonce
HasCallStack => Gen Nonce
genExtraEntropy
  ProtVer
protocolVersion <- HasCallStack => Version -> Version -> Gen ProtVer
Version -> Version -> Gen ProtVer
genProtocolVersion Version
lowMajorPV Version
highMajorPV
  Coin
minUTxOValue <- Gen Coin
HasCallStack => Gen Coin
genMinUTxOValue
  Coin
minPoolCost <- Gen Coin
HasCallStack => Gen Coin
genMinPoolCost
  PParams era -> Gen (PParams era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParams era -> Gen (PParams era))
-> PParams era -> Gen (PParams era)
forall a b. (a -> b) -> a -> b
$
    PParams era
forall era. EraPParams era => PParams era
emptyPParams
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeAL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
minFeeA
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinFeeBL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
minFeeB
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxBBSize
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxTxSize
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams era -> Identity (PParams era))
-> Word16 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
maxBHSize
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
keyDeposit
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
poolDeposit
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
eMax
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppNOptL ((Word16 -> Identity Word16)
 -> PParams era -> Identity (PParams era))
-> Word16 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
nOpt
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams era -> Identity (PParams era)
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppA0L ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams era -> Identity (PParams era))
-> NonNegativeInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Nonce -> Identity Nonce) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
Lens' (PParams era) Nonce
ppExtraEntropyL ((Nonce -> Identity Nonce)
 -> PParams era -> Identity (PParams era))
-> Nonce -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
extraEntropy
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams era -> Identity (PParams era))
-> ProtVer -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
protocolVersion
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinUTxOValueL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minUTxOValue
      PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinPoolCostL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minPoolCost
  where
    szGen :: Gen (Word32, Word32, Word16)
    szGen :: Gen (Word32, Word32, Word16)
szGen = do
      Word32
blockBodySize <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
low, Word32
hi)
      (Word32
blockBodySize,,)
        (Word32 -> Word16 -> (Word32, Word32, Word16))
-> Gen Word32 -> Gen (Word16 -> (Word32, Word32, Word16))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
blockBodySize, Word32
blockBodySize Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
2)
        Gen (Word16 -> (Word32, Word32, Word16))
-> Gen Word16 -> Gen (Word32, Word32, Word16)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
25000, Word16
forall a. Bounded a => a
maxBound :: Word16) -- Must stay in the range of Word16, but can't be too small

-- Note: we keep the lower bound high enough so that we can more likely
-- generate valid transactions and blocks
low, hi :: Word32
low :: Word32
low = Word32
50000
hi :: Word32
hi = Word32
200000

-- poolDeposit
-- NOTE: we need to keep these deposits small, otherwise
-- when we generate sequences of transactions we will bleed too
-- much funds into the deposit pool (i.e. funds not available as utxo)
genPoolDeposit :: HasCallStack => Gen Coin
genPoolDeposit :: HasCallStack => Gen Coin
genPoolDeposit =
  Gen Coin -> (Coin, Coin) -> Gen Coin
forall a. Gen a -> (a, a) -> Gen a
increasingProbabilityAt
    (Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
0 Integer
100)
    (Integer -> Coin
Coin Integer
0, Integer -> Coin
Coin Integer
100)

-- Generates a Neutral or actual Nonces with equal frequency
genExtraEntropy :: HasCallStack => Gen Nonce
genExtraEntropy :: HasCallStack => Gen Nonce
genExtraEntropy =
  [(Int, Gen Nonce)] -> Gen Nonce
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
    [ (Int
1, Nonce -> Gen Nonce
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
NeutralNonce)
    , (Int
1, Word64 -> Nonce
mkNonceFromNumber (Word64 -> Nonce) -> Gen Word64 -> Gen Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Word64 -> Gen Word64
genWord64 Word64
1 Word64
123)
    ]

-- eMax (for an epoch per 5 days, say, this is between a month and 7yrs)
genEMax ::
  HasCallStack =>
  Constants ->
  Gen EpochInterval
genEMax :: HasCallStack => Constants -> Gen EpochInterval
genEMax Constants {Word64
frequencyLowMaxEpoch :: Word64
frequencyLowMaxEpoch :: Constants -> Word64
frequencyLowMaxEpoch} =
  Word32 -> EpochInterval
EpochInterval (Word32 -> EpochInterval)
-> (Word64 -> Word32) -> Word64 -> EpochInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> EpochInterval) -> Gen Word64 -> Gen EpochInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Word64 -> Gen Word64
genWord64 Word64
frequencyLowMaxEpoch Word64
500

-- | nOpt
genNOpt :: HasCallStack => Gen Word16
genNOpt :: HasCallStack => Gen Word16
genNOpt = Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word16) -> Gen Natural -> Gen Word16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Natural -> Natural -> Gen Natural
genNatural Natural
1 Natural
100

-- | genKeyDeposit
-- NOTE: we need to keep these deposits small, otherwise
-- when we generate sequences of transactions we will bleed too
-- much funds into the deposit pool (i.e. funds not available as utxo)
genKeyDeposit :: HasCallStack => Gen Coin
genKeyDeposit :: HasCallStack => Gen Coin
genKeyDeposit =
  Gen Coin -> (Coin, Coin) -> Gen Coin
forall a. Gen a -> (a, a) -> Gen a
increasingProbabilityAt
    (Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
0 Integer
20)
    (Integer -> Coin
Coin Integer
0, Integer -> Coin
Coin Integer
20)

-- | a0: 0.01-1.0
genA0 :: HasCallStack => Gen NonNegativeInterval
genA0 :: HasCallStack => Gen NonNegativeInterval
genA0 = Integer -> Integer -> Gen NonNegativeInterval
forall a.
(Typeable a, BoundedRational a, HasCallStack) =>
Integer -> Integer -> Gen a
genIntervalInThousands Integer
10 Integer
1000

-- | rho: 0.001-0.009
genRho :: HasCallStack => Gen UnitInterval
genRho :: HasCallStack => Gen UnitInterval
genRho = Integer -> Integer -> Gen UnitInterval
forall a.
(Typeable a, BoundedRational a, HasCallStack) =>
Integer -> Integer -> Gen a
genIntervalInThousands Integer
1 Integer
9

-- | tau: 0.1-0.3
genTau :: HasCallStack => Gen UnitInterval
genTau :: HasCallStack => Gen UnitInterval
genTau = Integer -> Integer -> Gen UnitInterval
forall a.
(Typeable a, BoundedRational a, HasCallStack) =>
Integer -> Integer -> Gen a
genIntervalInThousands Integer
100 Integer
300

genDecentralisationParam :: HasCallStack => Gen UnitInterval
genDecentralisationParam :: HasCallStack => Gen UnitInterval
genDecentralisationParam = Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> UnitInterval) -> Gen Rational -> Gen UnitInterval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rational] -> Gen Rational
forall a. HasCallStack => [a] -> Gen a
QC.elements [Rational
0.1, Rational
0.2 .. Rational
1]
-- ^ ^ TODO jc - generating d=0 takes some care, if there are no registered
--  stake pools then d=0 deadlocks the system.

genProtocolVersion :: HasCallStack => Version -> Version -> Gen ProtVer
genProtocolVersion :: HasCallStack => Version -> Version -> Gen ProtVer
genProtocolVersion Version
minMajPV Version
maxMajPV =
  Version -> Natural -> ProtVer
ProtVer (Version -> Natural -> ProtVer)
-> Gen Version -> Gen (Natural -> ProtVer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Version -> Version -> Gen Version
Version -> Version -> Gen Version
genVersion Version
minMajPV Version
maxMajPV Gen (Natural -> ProtVer) -> Gen Natural -> Gen ProtVer
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Natural -> Natural -> Gen Natural
genNatural Natural
1 Natural
50

genMinUTxOValue :: HasCallStack => Gen Coin
genMinUTxOValue :: HasCallStack => Gen Coin
genMinUTxOValue = Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
1 Integer
20

genMinPoolCost :: HasCallStack => Gen Coin
genMinPoolCost :: HasCallStack => Gen Coin
genMinPoolCost = Integer -> Coin
Coin (Integer -> Coin) -> Gen Integer -> Gen Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Integer -> Gen Integer
genInteger Integer
10 Integer
50

-- | Generate a possible next Protocol version based on the previous version.
-- Increments the Major or Minor versions and possibly the Alt version.
genNextProtocolVersion :: EraPParams era => HasCallStack => PParams era -> Version -> Gen ProtVer
genNextProtocolVersion :: forall era.
(EraPParams era, HasCallStack) =>
PParams era -> Version -> Gen ProtVer
genNextProtocolVersion PParams era
pp Version
maxMajorPV = do
  [ProtVer] -> Gen ProtVer
forall a. HasCallStack => [a] -> Gen a
QC.elements ([ProtVer] -> Gen ProtVer) -> [ProtVer] -> Gen ProtVer
forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer Version
m (Natural
n Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
1) ProtVer -> [ProtVer] -> [ProtVer]
forall a. a -> [a] -> [a]
: [Version -> Natural -> ProtVer
ProtVer Version
m' Natural
0 | Just Version
m' <- [Version -> Maybe Version
forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion Version
m], Version
m' Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
<= Version
maxMajorPV]
  where
    ProtVer Version
m Natural
n = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL

genM :: Gen a -> Gen (StrictMaybe a)
genM :: forall a. Gen a -> Gen (StrictMaybe a)
genM Gen a
gen = [(Int, Gen (StrictMaybe a))] -> Gen (StrictMaybe a)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, a -> StrictMaybe a
forall a. a -> StrictMaybe a
SJust (a -> StrictMaybe a) -> Gen a -> Gen (StrictMaybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen), (Int
2, StrictMaybe a -> Gen (StrictMaybe a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe a
forall a. StrictMaybe a
SNothing)]

-- | This is only good in the Shelley Era, used to define the genShelleyEraPParamsUpdate method for (EraGen (ShelleyEra c))
genShelleyPParamsUpdate ::
  forall era.
  (ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8, EraPParams era) =>
  Constants ->
  PParams era ->
  Gen (PParamsUpdate era)
genShelleyPParamsUpdate :: forall era.
(ProtVerAtMost era 4, ProtVerAtMost era 6, ProtVerAtMost era 8,
 EraPParams era) =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genShelleyPParamsUpdate c :: Constants
c@Constants {Coin
maxMinFeeA :: Constants -> Coin
maxMinFeeA :: Coin
maxMinFeeA, Coin
maxMinFeeB :: Constants -> Coin
maxMinFeeB :: Coin
maxMinFeeB} PParams era
pp = do
  let highMajorPV :: Version
highMajorPV = Version -> Version
forall a. Enum a => a -> a
succ (forall era. Era era => Version
eraProtVerHigh @era)
  -- TODO generate Maybe types so not all updates are full
  StrictMaybe Integer
minFeeA <- Gen Integer -> Gen (StrictMaybe Integer)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Integer -> Gen (StrictMaybe Integer))
-> Gen Integer -> Gen (StrictMaybe Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeA)
  StrictMaybe Integer
minFeeB <- Gen Integer -> Gen (StrictMaybe Integer)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Integer -> Gen (StrictMaybe Integer))
-> Gen Integer -> Gen (StrictMaybe Integer)
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeB)
  StrictMaybe Word32
maxBBSize <- Gen Word32 -> Gen (StrictMaybe Word32)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Word32 -> Gen (StrictMaybe Word32))
-> Gen Word32 -> Gen (StrictMaybe Word32)
forall a b. (a -> b) -> a -> b
$ (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
low, Word32
hi)
  StrictMaybe Word32
maxTxSize <- Gen Word32 -> Gen (StrictMaybe Word32)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Word32 -> Gen (StrictMaybe Word32))
-> Gen Word32 -> Gen (StrictMaybe Word32)
forall a b. (a -> b) -> a -> b
$ (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
low, Word32
hi)
  -- Must stay in the range of Word16, but can't be too small
  StrictMaybe Word16
maxBHSize <- Gen Word16 -> Gen (StrictMaybe Word16)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Word16 -> Gen (StrictMaybe Word16))
-> Gen Word16 -> Gen (StrictMaybe Word16)
forall a b. (a -> b) -> a -> b
$ (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
25000, Word16
forall a. Bounded a => a
maxBound :: Word16)
  StrictMaybe Coin
keyDeposit <- Gen Coin -> Gen (StrictMaybe Coin)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Coin -> Gen (StrictMaybe Coin))
-> Gen Coin -> Gen (StrictMaybe Coin)
forall a b. (a -> b) -> a -> b
$ Gen Coin
HasCallStack => Gen Coin
genKeyDeposit
  StrictMaybe Coin
poolDeposit <- Gen Coin -> Gen (StrictMaybe Coin)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen Coin -> Gen (StrictMaybe Coin))
-> Gen Coin -> Gen (StrictMaybe Coin)
forall a b. (a -> b) -> a -> b
$ Gen Coin
HasCallStack => Gen Coin
genPoolDeposit
  StrictMaybe EpochInterval
eMax <- Gen EpochInterval -> Gen (StrictMaybe EpochInterval)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen EpochInterval -> Gen (StrictMaybe EpochInterval))
-> Gen EpochInterval -> Gen (StrictMaybe EpochInterval)
forall a b. (a -> b) -> a -> b
$ HasCallStack => Constants -> Gen EpochInterval
Constants -> Gen EpochInterval
genEMax Constants
c
  StrictMaybe Word16
nOpt <- Gen Word16 -> Gen (StrictMaybe Word16)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen Word16
HasCallStack => Gen Word16
genNOpt
  StrictMaybe NonNegativeInterval
a0 <- Gen NonNegativeInterval -> Gen (StrictMaybe NonNegativeInterval)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen NonNegativeInterval
HasCallStack => Gen NonNegativeInterval
genA0
  StrictMaybe UnitInterval
rho <- Gen UnitInterval -> Gen (StrictMaybe UnitInterval)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen UnitInterval
HasCallStack => Gen UnitInterval
genRho
  StrictMaybe UnitInterval
tau <- Gen UnitInterval -> Gen (StrictMaybe UnitInterval)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen UnitInterval
HasCallStack => Gen UnitInterval
genTau
  StrictMaybe UnitInterval
d <- Gen UnitInterval -> Gen (StrictMaybe UnitInterval)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen UnitInterval
HasCallStack => Gen UnitInterval
genDecentralisationParam
  StrictMaybe Nonce
extraEntropy <- Gen Nonce -> Gen (StrictMaybe Nonce)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen Nonce
HasCallStack => Gen Nonce
genExtraEntropy
  StrictMaybe ProtVer
protocolVersion <- Gen ProtVer -> Gen (StrictMaybe ProtVer)
forall a. Gen a -> Gen (StrictMaybe a)
genM (Gen ProtVer -> Gen (StrictMaybe ProtVer))
-> Gen ProtVer -> Gen (StrictMaybe ProtVer)
forall a b. (a -> b) -> a -> b
$ PParams era -> Version -> Gen ProtVer
forall era.
(EraPParams era, HasCallStack) =>
PParams era -> Version -> Gen ProtVer
genNextProtocolVersion PParams era
pp Version
highMajorPV
  StrictMaybe Coin
minUTxOValue <- Gen Coin -> Gen (StrictMaybe Coin)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen Coin
HasCallStack => Gen Coin
genMinUTxOValue
  StrictMaybe Coin
minPoolCost <- Gen Coin -> Gen (StrictMaybe Coin)
forall a. Gen a -> Gen (StrictMaybe a)
genM Gen Coin
HasCallStack => Gen Coin
genMinPoolCost
  PParamsUpdate era -> Gen (PParamsUpdate era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PParamsUpdate era -> Gen (PParamsUpdate era))
-> PParamsUpdate era -> Gen (PParamsUpdate era)
forall a b. (a -> b) -> a -> b
$
    PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Integer -> Coin) -> StrictMaybe Integer -> StrictMaybe Coin
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin StrictMaybe Integer
minFeeA
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Integer -> Coin) -> StrictMaybe Integer -> StrictMaybe Coin
forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin StrictMaybe Integer
minFeeB
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word32 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
maxBBSize
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word32 -> Identity (StrictMaybe Word32))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL ((StrictMaybe Word32 -> Identity (StrictMaybe Word32))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word32 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
maxTxSize
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word16 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word16
maxBHSize
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
keyDeposit
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
poolDeposit
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe EpochInterval -> Identity (StrictMaybe EpochInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuEMaxL ((StrictMaybe EpochInterval
  -> Identity (StrictMaybe EpochInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe EpochInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
eMax
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuNOptL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Word16 -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word16
nOpt
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe NonNegativeInterval
 -> Identity (StrictMaybe NonNegativeInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuA0L ((StrictMaybe NonNegativeInterval
  -> Identity (StrictMaybe NonNegativeInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe NonNegativeInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval
a0
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuRhoL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe UnitInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
rho
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuTauL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe UnitInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
tau
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuDL ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe UnitInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
d
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
ppuExtraEntropyL ((StrictMaybe Nonce -> Identity (StrictMaybe Nonce))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Nonce -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Nonce
extraEntropy
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe ProtVer -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ProtVer
protocolVersion
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinUTxOValueL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
minUTxOValue
      PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe Coin -> Identity (StrictMaybe Coin))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL ((StrictMaybe Coin -> Identity (StrictMaybe Coin))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe Coin -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
minPoolCost

-- | Generate a proposal for protocol parameter updates for all the given genesis keys.
-- Return an empty update if it is too late in the epoch for updates.
genPPUpdate ::
  forall era.
  EraGen era =>
  Constants ->
  PParams era ->
  [KeyHash 'Genesis] ->
  Gen (ProposedPPUpdates era)
genPPUpdate :: forall era.
EraGen era =>
Constants
-> PParams era -> [KeyHash 'Genesis] -> Gen (ProposedPPUpdates era)
genPPUpdate Constants
constants PParams era
pp [KeyHash 'Genesis]
genesisKeys = do
  PParamsUpdate era
pps <- forall era.
EraGen era =>
Constants -> PParams era -> Gen (PParamsUpdate era)
genEraPParamsUpdate @era Constants
constants PParams era
pp
  let ppUpdate :: [(KeyHash 'Genesis, PParamsUpdate era)]
ppUpdate = [KeyHash 'Genesis]
-> [PParamsUpdate era] -> [(KeyHash 'Genesis, PParamsUpdate era)]
forall a b. [a] -> [b] -> [(a, b)]
zip [KeyHash 'Genesis]
genesisKeys (PParamsUpdate era -> [PParamsUpdate era]
forall a. a -> [a]
repeat PParamsUpdate era
pps)
  ProposedPPUpdates era -> Gen (ProposedPPUpdates era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProposedPPUpdates era -> Gen (ProposedPPUpdates era))
-> ProposedPPUpdates era -> Gen (ProposedPPUpdates era)
forall a b. (a -> b) -> a -> b
$ Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> ([(KeyHash 'Genesis, PParamsUpdate era)]
    -> Map (KeyHash 'Genesis) (PParamsUpdate era))
-> [(KeyHash 'Genesis, PParamsUpdate era)]
-> ProposedPPUpdates era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(KeyHash 'Genesis, PParamsUpdate era)]
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Genesis, PParamsUpdate era)] -> ProposedPPUpdates era)
-> [(KeyHash 'Genesis, PParamsUpdate era)] -> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$ [(KeyHash 'Genesis, PParamsUpdate era)]
ppUpdate

-- | Generate an @Update (where all the given nodes participate)
genUpdateForNodes ::
  forall era.
  EraGen era =>
  Constants ->
  SlotNo ->
  EpochNo -> -- current epoch
  [KeyPair 'Genesis] ->
  PParams era ->
  Gen (Maybe (Update era))
genUpdateForNodes :: forall era.
EraGen era =>
Constants
-> SlotNo
-> EpochNo
-> [KeyPair 'Genesis]
-> PParams era
-> Gen (Maybe (Update era))
genUpdateForNodes Constants
c SlotNo
s EpochNo
e [KeyPair 'Genesis]
coreKeys PParams era
pp =
  Update era -> Maybe (Update era)
forall a. a -> Maybe a
Just (Update era -> Maybe (Update era))
-> Gen (Update era) -> Gen (Maybe (Update era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProposedPPUpdates era -> EpochNo -> Update era
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update (ProposedPPUpdates era -> EpochNo -> Update era)
-> Gen (ProposedPPUpdates era) -> Gen (EpochNo -> Update era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ProposedPPUpdates era)
genPPUpdate_ Gen (EpochNo -> Update era) -> Gen EpochNo -> Gen (Update era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EpochNo -> Gen EpochNo
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
e')
  where
    genesisKeys :: [KeyHash 'Genesis]
genesisKeys = VKey 'Genesis -> KeyHash 'Genesis
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Genesis -> KeyHash 'Genesis)
-> (KeyPair 'Genesis -> VKey 'Genesis)
-> KeyPair 'Genesis
-> KeyHash 'Genesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair 'Genesis -> VKey 'Genesis
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair 'Genesis -> KeyHash 'Genesis)
-> [KeyPair 'Genesis] -> [KeyHash 'Genesis]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Genesis]
coreKeys
    genPPUpdate_ :: Gen (ProposedPPUpdates era)
genPPUpdate_ = Constants
-> PParams era -> [KeyHash 'Genesis] -> Gen (ProposedPPUpdates era)
forall era.
EraGen era =>
Constants
-> PParams era -> [KeyHash 'Genesis] -> Gen (ProposedPPUpdates era)
genPPUpdate Constants
c PParams era
pp [KeyHash 'Genesis]
genesisKeys
    e' :: EpochNo
e' = if SlotNo -> Bool
tooLateInEpoch SlotNo
s then EpochNo
e EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
1 else EpochNo
e

-- | Occasionally generate an update and return with the witness keys
genUpdate ::
  EraGen era =>
  Constants ->
  SlotNo ->
  [(GenesisKeyPair c, AllIssuerKeys c 'GenesisDelegate)] ->
  Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate) ->
  PParams era ->
  (UTxOState era, CertState era) ->
  Gen (Maybe (Update era), [KeyPair 'Witness])
genUpdate :: forall era c.
EraGen era =>
Constants
-> SlotNo
-> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
-> Map
     (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
-> PParams era
-> (UTxOState era, CertState era)
-> Gen (Maybe (Update era), [KeyPair 'Witness])
genUpdate
  c :: Constants
c@Constants {Int
frequencyTxUpdates :: Int
frequencyTxUpdates :: Constants -> Int
frequencyTxUpdates}
  SlotNo
s
  [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
coreNodes
  Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
genesisDelegatesByHash
  PParams era
pp
  (UTxOState era
_utxoSt, CertState era
delegPoolSt) =
    do
      [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
nodes <- Int
-> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
-> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
forall a. Int -> [a] -> [a]
take Int
5 ([(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
 -> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)])
-> Gen [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
-> Gen [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
-> Gen [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
forall a. [a] -> Gen [a]
QC.shuffle [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
coreNodes

      let e :: EpochNo
e = SlotNo -> EpochNo
epochFromSlotNo SlotNo
s
          GenDelegs Map (KeyHash 'Genesis) GenDelegPair
genDelegs = CertState era
delegPoolSt CertState era
-> Getting GenDelegs (CertState era) GenDelegs -> GenDelegs
forall s a. s -> Getting a s a -> a
^. (DState era -> Const GenDelegs (DState era))
-> CertState era -> Const GenDelegs (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const GenDelegs (DState era))
 -> CertState era -> Const GenDelegs (CertState era))
-> ((GenDelegs -> Const GenDelegs GenDelegs)
    -> DState era -> Const GenDelegs (DState era))
-> Getting GenDelegs (CertState era) GenDelegs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDelegs -> Const GenDelegs GenDelegs)
-> DState era -> Const GenDelegs (DState era)
forall era (f :: * -> *).
Functor f =>
(GenDelegs -> f GenDelegs) -> DState era -> f (DState era)
dsGenDelegsL
          genesisKeys :: [KeyPair 'Genesis]
genesisKeys = (KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)
-> KeyPair 'Genesis
forall a b. (a, b) -> a
fst ((KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)
 -> KeyPair 'Genesis)
-> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
-> [KeyPair 'Genesis]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
nodes
          coreSigners :: [AllIssuerKeys c 'GenesisDelegate]
coreSigners =
            [Maybe (AllIssuerKeys c 'GenesisDelegate)]
-> [AllIssuerKeys c 'GenesisDelegate]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (AllIssuerKeys c 'GenesisDelegate)]
 -> [AllIssuerKeys c 'GenesisDelegate])
-> [Maybe (AllIssuerKeys c 'GenesisDelegate)]
-> [AllIssuerKeys c 'GenesisDelegate]
forall a b. (a -> b) -> a -> b
$
              (KeyHash 'GenesisDelegate
 -> Map
      (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
 -> Maybe (AllIssuerKeys c 'GenesisDelegate))
-> Map
     (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
-> KeyHash 'GenesisDelegate
-> Maybe (AllIssuerKeys c 'GenesisDelegate)
forall a b c. (a -> b -> c) -> b -> a -> c
flip KeyHash 'GenesisDelegate
-> Map
     (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
-> Maybe (AllIssuerKeys c 'GenesisDelegate)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (KeyHash 'GenesisDelegate) (AllIssuerKeys c 'GenesisDelegate)
genesisDelegatesByHash (KeyHash 'GenesisDelegate
 -> Maybe (AllIssuerKeys c 'GenesisDelegate))
-> (GenDelegPair -> KeyHash 'GenesisDelegate)
-> GenDelegPair
-> Maybe (AllIssuerKeys c 'GenesisDelegate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash (GenDelegPair -> Maybe (AllIssuerKeys c 'GenesisDelegate))
-> [GenDelegPair] -> [Maybe (AllIssuerKeys c 'GenesisDelegate)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash 'Genesis) GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Genesis) GenDelegPair
genDelegs
          failedWitnessLookup :: Bool
failedWitnessLookup = [AllIssuerKeys c 'GenesisDelegate] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AllIssuerKeys c 'GenesisDelegate]
coreSigners Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Map (KeyHash 'Genesis) GenDelegPair -> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'Genesis) GenDelegPair
genDelegs
      if Bool
failedWitnessLookup
        then -- discard
          (Maybe (Update era), [KeyPair 'Witness])
-> Gen (Maybe (Update era), [KeyPair 'Witness])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Update era)
forall a. Maybe a
Nothing, [])
        else
          let wits :: [KeyPair 'Witness]
wits = KeyPair 'GenesisDelegate -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (KeyPair 'GenesisDelegate -> KeyPair 'Witness)
-> (AllIssuerKeys c 'GenesisDelegate -> KeyPair 'GenesisDelegate)
-> AllIssuerKeys c 'GenesisDelegate
-> KeyPair 'Witness
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllIssuerKeys c 'GenesisDelegate -> KeyPair 'GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold (AllIssuerKeys c 'GenesisDelegate -> KeyPair 'Witness)
-> [AllIssuerKeys c 'GenesisDelegate] -> [KeyPair 'Witness]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys c 'GenesisDelegate]
coreSigners
           in [(Int, Gen (Maybe (Update era), [KeyPair 'Witness]))]
-> Gen (Maybe (Update era), [KeyPair 'Witness])
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
                [
                  ( Int
frequencyTxUpdates
                  , (,[KeyPair 'Witness]
wits) (Maybe (Update era) -> (Maybe (Update era), [KeyPair 'Witness]))
-> Gen (Maybe (Update era))
-> Gen (Maybe (Update era), [KeyPair 'Witness])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Constants
-> SlotNo
-> EpochNo
-> [KeyPair 'Genesis]
-> PParams era
-> Gen (Maybe (Update era))
forall era.
EraGen era =>
Constants
-> SlotNo
-> EpochNo
-> [KeyPair 'Genesis]
-> PParams era
-> Gen (Maybe (Update era))
genUpdateForNodes Constants
c SlotNo
s EpochNo
e [KeyPair 'Genesis]
genesisKeys PParams era
pp
                  )
                ,
                  ( Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
frequencyTxUpdates
                  , (Maybe (Update era), [KeyPair 'Witness])
-> Gen (Maybe (Update era), [KeyPair 'Witness])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Update era)
forall a. Maybe a
Nothing, [])
                  )
                ]