Improve costModel generation and thus fix failing test

IntersectMBO · Oct 19, 2023 · 289d57e · 289d57e
1 parent 1307420
commit 289d57e
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 10 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -262,8 +262,7 @@ library gen
                       , cardano-binary >= 1.6 && < 1.8
                       , cardano-crypto-class ^>= 2.1.2
                       , cardano-crypto-test ^>= 1.5
-                      , cardano-ledger-alonzo >= 1.5.0
-                      , cardano-ledger-alonzo-test
+                      , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.5.0
                       , cardano-ledger-byron-test >= 1.5
                       , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0
                       , cardano-ledger-shelley >= 1.7.0

diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -161,7 +161,7 @@ import           Test.Gen.Cardano.Api.Metadata (genTxMetadata)
 
 import           Test.Cardano.Chain.UTxO.Gen (genVKWitness)
 import           Test.Cardano.Crypto.Gen (genProtocolMagicId)
-import qualified Test.Cardano.Ledger.Alonzo.PlutusScripts as Plutus
+import           Test.Cardano.Ledger.Alonzo.Arbitrary (genValidCostModel)
 import           Test.Cardano.Ledger.Conway.Arbitrary ()
 import           Test.Cardano.Ledger.Core.Arbitrary ()
 
@@ -972,15 +972,12 @@ genUpdateProposal era =
 
 genCostModel :: Gen Alonzo.CostModel
 genCostModel = do
-  let costModelParams = Alonzo.getCostModelParams Plutus.testingCostModelV1
-  eCostModel <- Alonzo.mkCostModel <$> genPlutusLanguage
-                                   <*> mapM (const $ Gen.integral (Range.linear 0 5000)) costModelParams
-  case eCostModel of
-    Left err -> error $ "genCostModel: " <> show err
-    Right cModel -> return cModel
+  lang <- genPlutusLanguage
+  cm <- Q.quickcheck (genValidCostModel lang)
+  pure cm
 
 genPlutusLanguage :: Gen Language
-genPlutusLanguage = Gen.element [PlutusV1, PlutusV2]
+genPlutusLanguage = Gen.element [PlutusV1, PlutusV2, PlutusV3]
 
 _genCostModels :: Gen (Map AnyPlutusScriptVersion CostModel)
 _genCostModels =