Try to fix costmodel test

IntersectMBO · Oct 17, 2023 · f2b6acf · f2b6acf
1 parent cb6f8db
commit f2b6acf
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 8 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -262,8 +262,8 @@ 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-alonzo-test
                       , 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
@@ -150,6 +150,7 @@ import qualified Data.ByteString.Short as SBS
 import           Data.Coerce
 import           Data.Int (Int64)
 import           Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
 import           Data.Maybe
 import           Data.Ratio (Ratio, (%))
 import           Data.String
@@ -161,7 +162,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 (FlexibleCostModels (..))
 import           Test.Cardano.Ledger.Conway.Arbitrary ()
 import           Test.Cardano.Ledger.Core.Arbitrary ()
 
@@ -972,12 +973,17 @@ 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
+  -- let _costModelParams = Alonzo.getCostModelParams Plutus.testingCostModelV1
+  flexibleCostModels <- Q.arbitrary @FlexibleCostModels
+  let validCostModels = Alonzo.costModelsValid (unFlexibleCostModels flexibleCostModels)
+  lang <- genPlutusLanguage
+  let eCostModel = Map.lookup lang validCostModels
+
+  -- 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
+    Nothing -> error $ "genCostModel: No valid cost model generated."
+    Just cModel -> return cModel
 
 genPlutusLanguage :: Gen Language
 genPlutusLanguage = Gen.element [PlutusV1, PlutusV2]