Generate protocolUpdateUTxOCostPerByte only if it is supported in era.

IntersectMBO · Apr 7, 2023 · 4c7cc37 · 4c7cc37
1 parent b08c26e
commit 4c7cc37
Showing 1 changed file with 10 additions and 7 deletions.
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -147,6 +147,7 @@ import           Cardano.Ledger.Alonzo.Language (Language (..))
 import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
 import           Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
 
+import           Data.Functor (($>))
 import           Test.Cardano.Chain.UTxO.Gen (genVKWitness)
 import           Test.Cardano.Crypto.Gen (genProtocolMagicId)
 import           Test.Gen.Cardano.Api.Metadata (genTxMetadata)
@@ -840,8 +841,8 @@ genProtocolParameters =
     <*> Gen.maybe genNat
     <*> Gen.maybe genLovelace
 
-genProtocolParametersUpdate :: Gen ProtocolParametersUpdate
-genProtocolParametersUpdate = do
+genProtocolParametersUpdate :: CardanoEra era -> Gen ProtocolParametersUpdate
+genProtocolParametersUpdate era = do
   protocolUpdateProtocolVersion     <- Gen.maybe ((,) <$> genNat <*> genNat)
   protocolUpdateDecentralization    <- Gen.maybe genRational
   protocolUpdateExtraPraosEntropy   <- Gen.maybe genMaybePraosNonce
@@ -869,16 +870,18 @@ genProtocolParametersUpdate = do
   protocolUpdateMaxValueSize        <- Gen.maybe genNat
   protocolUpdateCollateralPercent   <- Gen.maybe genNat
   protocolUpdateMaxCollateralInputs <- Gen.maybe genNat
-  protocolUpdateUTxOCostPerByte     <- Gen.maybe genLovelace
-  pure ProtocolParametersUpdate{..}
+  protocolUpdateUTxOCostPerByte     <- sequence $ protocolUpdateUTxOCostPerByteSupportedInEra era $> genLovelace
 
+  pure ProtocolParametersUpdate{..}
 
 genUpdateProposal :: CardanoEra era -> Gen UpdateProposal
-genUpdateProposal _era = -- TODO Make era specific
+genUpdateProposal era =
   UpdateProposal
     <$> Gen.map (Range.constant 1 3)
-                ((,) <$> genVerificationKeyHash AsGenesisKey
-                     <*> genProtocolParametersUpdate)
+        ( (,)
+          <$> genVerificationKeyHash AsGenesisKey
+          <*> genProtocolParametersUpdate era
+        )
     <*> genEpochNo
 
 genCostModel :: Gen CostModel