cardano-testnet | Fix cost models in genesis generation

Author: carbolymer

cabal.project

@@ -91,7 +91,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/IntersectMBO/cardano-api
-  tag: cee9b20505a407b55f3b7b335e857d61d71ae196
+  tag: 02a2274c7b1fd1c4d4d380328b87b3e81fa537de
   --sha256: sha256-ijMOji6MNupx6eewRJcWpuoxitp4rw8nnccr/Ay+tTo=
   subdir:
     cardano-api

cardano-testnet/src/Testnet/Blockfrost.hs

@@ -10,31 +10,31 @@ module Testnet.Blockfrost
   , blockfrostToGenesis
   ) where
 
-import           Cardano.Ledger.BaseTypes (EpochInterval, Nonce, NonNegativeInterval,
-                  UnitInterval, ProtVer(..), Version)
+import           Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import           Cardano.Ledger.Alonzo.PParams (CoinPerWord)
+import           Cardano.Ledger.BaseTypes (EpochInterval, NonNegativeInterval, Nonce, ProtVer (..),
+                   UnitInterval, Version)
 import           Cardano.Ledger.Coin (Coin)
-import           Cardano.Ledger.Core (PParams(..))
 import           Cardano.Ledger.Compactible (toCompactPartial)
-import           Cardano.Ledger.Shelley.Genesis (ShelleyGenesis(..))
-import           Cardano.Ledger.Shelley.PParams (ShelleyPParams(..))
-import           Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis(..))
-import           Cardano.Ledger.Alonzo.PParams (CoinPerWord)
-import           Cardano.Ledger.Conway.Genesis (ConwayGenesis(..))
-import           Cardano.Ledger.Conway.PParams (UpgradeConwayPParams(..),
-                  PoolVotingThresholds(..), DRepVotingThresholds(..))
-import           Cardano.Ledger.Plutus (CostModel, CostModels, ExUnits(..),
-                  Language(..), Prices(..))
+import           Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
+import           Cardano.Ledger.Conway.PParams (DRepVotingThresholds (..),
+                   PoolVotingThresholds (..), UpgradeConwayPParams (..))
+import           Cardano.Ledger.Core (PParams (..))
+import           Cardano.Ledger.Plutus (CostModel, CostModels, ExUnits (..), Language (..),
+                   Prices (..))
 import qualified Cardano.Ledger.Plutus.CostModels as CostModels
+import           Cardano.Ledger.Shelley.Genesis (ShelleyGenesis (..))
+import           Cardano.Ledger.Shelley.PParams (ShelleyPParams (..))
 
 import           Control.Applicative ((<|>))
+import           Data.Aeson (FromJSON (..), withObject, (.:))
 import qualified Data.Aeson as Aeson
-import           Data.Aeson (FromJSON(..), (.:), withObject)
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.Map.Strict as Map
-import           Text.Read (readMaybe)
 import           Data.Scientific (Scientific)
 import           Data.Word (Word16, Word32)
 import           Numeric.Natural (Natural)
+import           Text.Read (readMaybe)
 
 data BlockfrostParams = BlockfrostParams
   { -- Alonzo parameters
@@ -206,7 +206,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost
         { prMem = bfgPriceMem
         , prSteps = bfgPriceSteps
         }
-      , agCostModels = bfgAlonzoCostModels
+      , agCostModels = {- TODO trimCostModelToInitial PlutusV2  -} bfgAlonzoCostModels
       }
 
     -- Conway Params
@@ -237,7 +237,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost
       , ucppDRepDeposit = bfgDRepDeposit
       , ucppDRepActivity = bfgDRepActivity
       , ucppMinFeeRefScriptCostPerByte = bfgMinFeeRevScriptCostPerByte
-      , ucppPlutusV3CostModel = bfgConwayCostModel
+      , ucppPlutusV3CostModel = trimCostModelToInitial PlutusV3 bfgConwayCostModel
       }
     conwayGenesis = conwayGenesis'{cgUpgradePParams=conwayParams}
 
@@ -265,3 +265,14 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost
       , sppMinPoolCost = bfgMinPoolCost
       }
     shelleyGenesis = shelleyGenesis'{sgProtocolParams=shelleyParams}
+
+-- | Trims cost model to the initial number of parameters. The cost models in geneses can't
+-- have more parameters than the initial number.
+trimCostModelToInitial :: Language -> CostModel -> CostModel
+trimCostModelToInitial lang cm = do
+  let paramsCount = CostModels.costModelInitParamCount lang
+  either (error . ("Testnet.Blockfrost: Cost model trimming failure: " <>) . show) id
+    . CostModels.mkCostModel lang
+    . take paramsCount
+    $ CostModels.getCostModelParams cm
+

cardano-testnet/src/Testnet/Defaults.hs

@@ -53,19 +53,22 @@ import qualified Cardano.Ledger.BaseTypes as Ledger
 import           Cardano.Ledger.Binary.Version ()
 import           Cardano.Ledger.Coin
 import           Cardano.Ledger.Conway.Genesis
+import qualified Cardano.Ledger.Conway.Genesis as Ledger
 import           Cardano.Ledger.Conway.PParams
+import qualified Cardano.Ledger.Conway.PParams as Ledger
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Plutus as Ledger
+import qualified Cardano.Ledger.Plutus.CostModels as Ledger
 import qualified Cardano.Ledger.Shelley as Ledger
 import           Cardano.Ledger.Shelley.Genesis
 import           Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
 import           Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
+import           Cardano.Node.Configuration.Topology (RemoteAddress (..))
 import qualified Cardano.Node.Configuration.Topology as Topology
-import           Cardano.Node.Configuration.Topology (RemoteAddress(..))
-import qualified Cardano.Node.Configuration.TopologyP2P as P2P
-import           Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroups (..),
-                   LocalRootPeersGroup (..), NetworkTopology(..), PublicRootPeers (..),
+import           Cardano.Node.Configuration.TopologyP2P (LocalRootPeersGroup (..),
+                   LocalRootPeersGroups (..), NetworkTopology (..), PublicRootPeers (..),
                    RootConfig (..))
+import qualified Cardano.Node.Configuration.TopologyP2P as P2P
 import           Cardano.Tracing.Config
 import           Ouroboros.Network.NodeToNode (DiffusionMode (..), PeerAdvertise (..))
 import           Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers (..))
@@ -95,7 +98,6 @@ import           Numeric.Natural
 import           System.FilePath ((</>))
 
 import           Test.Cardano.Ledger.Core.Rational
-import           Test.Cardano.Ledger.Plutus (testingCostModelV3)
 import           Testnet.Start.Types
 import           Testnet.Types
 
@@ -126,7 +128,9 @@ defaultAlonzoGenesis = do
         Just s -> return s
 
 defaultConwayGenesis :: ConwayGenesis
-defaultConwayGenesis =
+defaultConwayGenesis = do
+  -- use the cost model from cardano-api, which is trimmed to the correct number of parameters
+  let ucppPlutusV3CostModel = Ledger.ucppPlutusV3CostModel $ Ledger.cgUpgradePParams Api.conwayGenesisDefaults
   let upPParams :: UpgradeConwayPParams Identity
       upPParams = UpgradeConwayPParams
                     { ucppPoolVotingThresholds = poolVotingThresholds
@@ -138,7 +142,7 @@ defaultConwayGenesis =
                     , ucppDRepDeposit = Coin 1_000_000
                     , ucppDRepActivity = EpochInterval 100
                     , ucppMinFeeRefScriptCostPerByte = 0 %! 1 -- FIXME GARBAGE VALUE
-                    , ucppPlutusV3CostModel = testingCostModelV3
+                    , ucppPlutusV3CostModel
                     }
       drepVotingThresholds = DRepVotingThresholds
         { dvtMotionNoConfidence = 0 %! 1
@@ -159,7 +163,7 @@ defaultConwayGenesis =
          , pvtHardForkInitiation = 1 %! 2
          , pvtPPSecurityGroup = 1 %! 2
          }
-  in ConwayGenesis
+  ConwayGenesis
       { cgUpgradePParams = upPParams
       , cgConstitution = DefaultClass.def
       , cgCommittee = DefaultClass.def