{-# 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,
  Nonce (NeutralNonce),
  ProtVer (..),
  StrictMaybe (..),
  UnitInterval,
  Version,
  getVersion64,
  mkNonceFromNumber,
  mkVersion,
  mkVersion64,
  succVersion,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Era (EraCrypto)
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 (..),
 )
import Cardano.Ledger.Shelley.PParams
import Cardano.Ledger.Slot (EpochNo (EpochNo), SlotNo)
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.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 =
  (forall a. Integral a => a -> a -> Ratio a
% Integer
1000) 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 =
  forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => 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 :: Constants -> Coin
maxMinFeeA :: Coin
maxMinFeeA, Coin
maxMinFeeB :: Constants -> Coin
maxMinFeeB :: 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 <- HasCallStack => Gen Coin
genKeyDeposit
  Coin
poolDeposit <- HasCallStack => Gen Coin
genPoolDeposit
  EpochInterval
eMax <- HasCallStack => Constants -> Gen EpochInterval
genEMax Constants
c
  Natural
nOpt <- HasCallStack => Gen Natural
genNOpt
  NonNegativeInterval
a0 <- HasCallStack => Gen NonNegativeInterval
genA0
  UnitInterval
rho <- HasCallStack => Gen UnitInterval
genRho
  UnitInterval
tau <- HasCallStack => Gen UnitInterval
genTau
  UnitInterval
d <- HasCallStack => Gen UnitInterval
genDecentralisationParam
  Nonce
extraEntropy <- HasCallStack => Gen Nonce
genExtraEntropy
  ProtVer
protocolVersion <- HasCallStack => Version -> Version -> Gen ProtVer
genProtocolVersion Version
lowMajorPV Version
highMajorPV
  Coin
minUTxOValue <- HasCallStack => Gen Coin
genMinUTxOValue
  Coin
minPoolCost <- HasCallStack => Gen Coin
genMinPoolCost
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall era. EraPParams era => PParams era
emptyPParams
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
minFeeA
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
minFeeB
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxBBSize
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
maxTxSize
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
maxBHSize
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
keyDeposit
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
poolDeposit
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ EpochInterval
eMax
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Natural
ppNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural
nOpt
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppA0L forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonNegativeInterval
a0
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppRhoL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
rho
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppTauL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
tau
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
d
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) Nonce
ppExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Nonce
extraEntropy
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
protocolVersion
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
minUTxOValue
      forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL 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 <- forall a. Random a => (a, a) -> Gen a
choose (Word32
low, Word32
hi)
      (Word32
blockBodySize,,)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Word32
blockBodySize, Word32
blockBodySize forall a. Integral a => a -> a -> a
`div` Word32
2)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Random a => (a, a) -> Gen a
choose (Word16
25000, 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 =
  forall a. Gen a -> (a, a) -> Gen a
increasingProbabilityAt
    (Integer -> Coin
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 =
  forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
    [ (Int
1, forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
NeutralNonce)
    , (Int
1, Word64 -> Nonce
mkNonceFromNumber 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 :: Constants -> Word64
frequencyLowMaxEpoch :: Word64
frequencyLowMaxEpoch} =
  Word32 -> EpochInterval
EpochInterval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 Natural
genNOpt :: HasCallStack => Gen Natural
genNOpt = 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 =
  forall a. Gen a -> (a, a) -> Gen a
increasingProbabilityAt
    (Integer -> Coin
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 = 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 = 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 = 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 = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Version -> Version -> Gen Version
genVersion Version
minMajPV Version
maxMajPV 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 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 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
  forall a. HasCallStack => [a] -> Gen a
QC.elements forall a b. (a -> b) -> a -> b
$ Version -> Natural -> ProtVer
ProtVer Version
m (Natural
n forall a. Num a => a -> a -> a
+ Natural
1) forall a. a -> [a] -> [a]
: [Version -> Natural -> ProtVer
ProtVer Version
m' Natural
0 | Just Version
m' <- [forall (m :: * -> *). MonadFail m => Version -> m Version
succVersion Version
m], Version
m' forall a. Ord a => a -> a -> Bool
<= Version
maxMajorPV]
  where
    ProtVer Version
m Natural
n = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL

genM :: Gen a -> Gen (StrictMaybe a)
genM :: forall a. Gen a -> Gen (StrictMaybe a)
genM Gen a
gen = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, forall a. a -> StrictMaybe a
SJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
gen), (Int
2, forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: Coin
maxMinFeeA :: Constants -> Coin
maxMinFeeA, Coin
maxMinFeeB :: Coin
maxMinFeeB :: Constants -> Coin
maxMinFeeB} PParams era
pp = do
  let highMajorPV :: Version
highMajorPV = 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 <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeA)
  StrictMaybe Integer
minFeeB <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Gen Integer
genInteger Integer
0 (Coin -> Integer
unCoin Coin
maxMinFeeB)
  StrictMaybe Word32
maxBBSize <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
choose (Word32
low, Word32
hi)
  StrictMaybe Word32
maxTxSize <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ 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 <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
choose (Word16
25000, forall a. Bounded a => a
maxBound :: Word16)
  StrictMaybe Coin
keyDeposit <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ HasCallStack => Gen Coin
genKeyDeposit
  StrictMaybe Coin
poolDeposit <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ HasCallStack => Gen Coin
genPoolDeposit
  StrictMaybe EpochInterval
eMax <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ HasCallStack => Constants -> Gen EpochInterval
genEMax Constants
c
  StrictMaybe Natural
nOpt <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen Natural
genNOpt
  StrictMaybe NonNegativeInterval
a0 <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen NonNegativeInterval
genA0
  StrictMaybe UnitInterval
rho <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen UnitInterval
genRho
  StrictMaybe UnitInterval
tau <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen UnitInterval
genTau
  StrictMaybe UnitInterval
d <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen UnitInterval
genDecentralisationParam
  StrictMaybe Nonce
extraEntropy <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen Nonce
genExtraEntropy
  StrictMaybe ProtVer
protocolVersion <- forall a. Gen a -> Gen (StrictMaybe a)
genM forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, HasCallStack) =>
PParams era -> Version -> Gen ProtVer
genNextProtocolVersion PParams era
pp Version
highMajorPV
  StrictMaybe Coin
minUTxOValue <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen Coin
genMinUTxOValue
  StrictMaybe Coin
minPoolCost <- forall a. Gen a -> Gen (StrictMaybe a)
genM HasCallStack => Gen Coin
genMinPoolCost
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin StrictMaybe Integer
minFeeA
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Coin
Coin StrictMaybe Integer
minFeeB
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
maxBBSize
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word32
maxTxSize
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Word16
maxBHSize
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
keyDeposit
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
poolDeposit
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuEMaxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe EpochInterval
eMax
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Natural
nOpt
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuA0L forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval
a0
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuRhoL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
rho
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuTauL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
tau
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuDL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe UnitInterval
d
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParamsUpdate era) (StrictMaybe Nonce)
ppuExtraEntropyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Nonce
extraEntropy
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
ppuProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe ProtVer
protocolVersion
      forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe Coin
minUTxOValue
      forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL 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 (EraCrypto era)] ->
  Gen (ProposedPPUpdates era)
genPPUpdate :: forall era.
EraGen era =>
Constants
-> PParams era
-> [KeyHash 'Genesis (EraCrypto era)]
-> Gen (ProposedPPUpdates era)
genPPUpdate Constants
constants PParams era
pp [KeyHash 'Genesis (EraCrypto era)]
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 (EraCrypto era), PParamsUpdate era)]
ppUpdate = forall a b. [a] -> [b] -> [(a, b)]
zip [KeyHash 'Genesis (EraCrypto era)]
genesisKeys (forall a. a -> [a]
repeat PParamsUpdate era
pps)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ [(KeyHash 'Genesis (EraCrypto era), PParamsUpdate era)]
ppUpdate

-- | Generate an @Update (where all the given nodes participate)
genUpdateForNodes ::
  forall era.
  EraGen era =>
  Constants ->
  SlotNo ->
  EpochNo -> -- current epoch
  [KeyPair 'Genesis (EraCrypto era)] ->
  PParams era ->
  Gen (Maybe (Update era))
genUpdateForNodes :: forall era.
EraGen era =>
Constants
-> SlotNo
-> EpochNo
-> [KeyPair 'Genesis (EraCrypto era)]
-> PParams era
-> Gen (Maybe (Update era))
genUpdateForNodes Constants
c SlotNo
s EpochNo
e [KeyPair 'Genesis (EraCrypto era)]
coreKeys PParams era
pp =
  forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ProposedPPUpdates era)
genPPUpdate_ forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EpochNo
e')
  where
    genesisKeys :: [KeyHash 'Genesis (EraCrypto era)]
genesisKeys = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Genesis (EraCrypto era)]
coreKeys
    genPPUpdate_ :: Gen (ProposedPPUpdates era)
genPPUpdate_ = forall era.
EraGen era =>
Constants
-> PParams era
-> [KeyHash 'Genesis (EraCrypto era)]
-> Gen (ProposedPPUpdates era)
genPPUpdate Constants
c PParams era
pp [KeyHash 'Genesis (EraCrypto era)]
genesisKeys
    e' :: EpochNo
e' = if SlotNo -> Bool
tooLateInEpoch SlotNo
s then EpochNo
e 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 (EraCrypto era), AllIssuerKeys (EraCrypto era) 'GenesisDelegate)] ->
  Map (KeyHash 'GenesisDelegate (EraCrypto era)) (AllIssuerKeys (EraCrypto era) 'GenesisDelegate) ->
  PParams era ->
  (UTxOState era, CertState era) ->
  Gen (Maybe (Update era), [KeyPair 'Witness (EraCrypto era)])
genUpdate :: forall era.
EraGen era =>
Constants
-> SlotNo
-> [(GenesisKeyPair (EraCrypto era),
     AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
-> Map
     (KeyHash 'GenesisDelegate (EraCrypto era))
     (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
-> PParams era
-> (UTxOState era, CertState era)
-> Gen (Maybe (Update era), [KeyPair 'Witness (EraCrypto era)])
genUpdate
  c :: Constants
c@Constants {Int
frequencyTxUpdates :: Constants -> Int
frequencyTxUpdates :: Int
frequencyTxUpdates}
  SlotNo
s
  [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
coreNodes
  Map
  (KeyHash 'GenesisDelegate (EraCrypto era))
  (AllIssuerKeys (EraCrypto era) 'GenesisDelegate)
genesisDelegatesByHash
  PParams era
pp
  (UTxOState era
_utxoSt, CertState era
delegPoolSt) =
    do
      [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
nodes <- forall a. Int -> [a] -> [a]
take Int
5 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Gen [a]
QC.shuffle [(GenesisKeyPair (EraCrypto era),
  AllIssuerKeys (EraCrypto era) 'GenesisDelegate)]
coreNodes

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