Add PlutusV3 CostModel to UpgradeConwayPParams

Use `updateCostModels` to add them to Conway
PParams during tranlation/upgrade from Babbage

eras/conway/impl/CHANGELOG.md

@@ -1,5 +1,9 @@
 # Version history for `cardano-ledger-conway`
 
+## 1.14.0 0
+
+* Add `ucppPlutusV3CostModel` to `UpgradeConwayPParams` #4252
+
 ## 1.13.1.0
 
 * Fix typo in `ToJSON` instance of `ConwayGovState`

eras/conway/impl/cardano-ledger-conway.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               cardano-ledger-conway
-version:            1.13.1.0
+version:            1.14.0.0
 license:            Apache-2.0
 maintainer:         [email protected]
 author:             IOHK
@@ -90,7 +90,7 @@ library
         cardano-ledger-allegra ^>=1.4,
         cardano-ledger-alonzo ^>=1.7,
         cardano-ledger-babbage ^>=1.7,
-        cardano-ledger-core ^>=1.11,
+        cardano-ledger-core ^>=1.11.1,
         cardano-ledger-mary ^>=1.5,
         cardano-ledger-shelley ^>=1.10,
         cardano-slotting,
@@ -126,6 +126,7 @@ library testlib
         Test.Cardano.Ledger.Conway.Imp.RatifySpec
         Test.Cardano.Ledger.Conway.Proposals
         Test.Cardano.Ledger.Conway.TreeDiff
+        Test.Cardano.Ledger.Conway.Genesis
 
     visibility:       public
     hs-source-dirs:   testlib
@@ -183,7 +184,6 @@ test-suite tests
     build-depends:
         aeson,
         base,
-        cardano-data,
         cardano-ledger-core:testlib,
         cardano-ledger-allegra,
         cardano-ledger-alonzo:testlib,

eras/conway/impl/src/Cardano/Ledger/Conway/Genesis.hs

@@ -39,7 +39,6 @@ import Data.Aeson (
   (.:),
   (.:?),
  )
-import Data.Default.Class (Default (def))
 import Data.Functor.Identity (Identity)
 import Data.ListMap (ListMap)
 import GHC.Generics (Generic)
@@ -98,6 +97,3 @@ toConwayGenesisPairs cg@(ConwayGenesis _ _ _ _ _) =
         ++ ["delegs" .= cgDelegs | not (null cgDelegs)]
         ++ ["initialDReps" .= cgInitialDReps | not (null cgInitialDReps)]
         ++ toUpgradeConwayPParamsUpdatePairs cgUpgradePParams
-
-instance Crypto c => Default (ConwayGenesis c) where
-  def = ConwayGenesis def def def mempty mempty

eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs

@@ -99,14 +99,29 @@ import Cardano.Ledger.Coin (Coin (Coin))
 import Cardano.Ledger.Conway.Era (ConwayEra)
 import Cardano.Ledger.Core (EraPParams (..))
 import Cardano.Ledger.Crypto
-import Cardano.Ledger.HKD (HKD, HKDFunctor (..), HKDNoUpdate, NoUpdate (..))
-import Cardano.Ledger.Plutus.CostModels (decodeValidAndUnknownCostModels)
+import Cardano.Ledger.HKD (
+  HKD,
+  HKDApplicative (hkdLiftA2),
+  HKDFunctor (..),
+  HKDNoUpdate,
+  NoUpdate (..),
+ )
+import Cardano.Ledger.Plutus.CostModels (
+  CostModel,
+  decodeCostModelFailHard,
+  decodeValidAndUnknownCostModels,
+  encodeCostModel,
+  mkCostModel,
+  mkCostModels,
+ )
+import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData (..), rwhnf)
 import Data.Aeson hiding (Encoding, Value, decode, encode)
 import qualified Data.Aeson as Aeson
 import Data.Default.Class (Default (def))
 import Data.Functor.Identity (Identity)
+import qualified Data.Map.Strict as Map
 import Data.Maybe.Strict (StrictMaybe (..), isSNothing)
 import Data.Proxy
 import Data.Set (Set)
@@ -576,6 +591,7 @@ data UpgradeConwayPParams f = UpgradeConwayPParams
   , ucppDRepDeposit :: !(HKD f Coin)
   , ucppDRepActivity :: !(HKD f EpochInterval)
   , ucppMinFeeRefScriptCostPerByte :: !(HKD f NonNegativeInterval)
+  , ucppPlutusV3CostModel :: !(HKD f CostModel)
   }
   deriving (Generic)
 
@@ -599,20 +615,6 @@ instance NoThunks (UpgradeConwayPParams StrictMaybe)
 
 instance NFData (UpgradeConwayPParams StrictMaybe)
 
-instance Default (UpgradeConwayPParams Identity) where
-  def =
-    UpgradeConwayPParams
-      { ucppPoolVotingThresholds = def
-      , ucppDRepVotingThresholds = def
-      , ucppCommitteeMinSize = 0
-      , ucppCommitteeMaxTermLength = EpochInterval 0
-      , ucppGovActionLifetime = EpochInterval 0
-      , ucppGovActionDeposit = Coin 0
-      , ucppDRepDeposit = Coin 0
-      , ucppDRepActivity = EpochInterval 0
-      , ucppMinFeeRefScriptCostPerByte = minBound
-      }
-
 instance Default (UpgradeConwayPParams StrictMaybe) where
   def =
     UpgradeConwayPParams
@@ -625,6 +627,7 @@ instance Default (UpgradeConwayPParams StrictMaybe) where
       , ucppDRepDeposit = SNothing
       , ucppDRepActivity = SNothing
       , ucppMinFeeRefScriptCostPerByte = SNothing
+      , ucppPlutusV3CostModel = SNothing
       }
 
 instance EncCBOR (UpgradeConwayPParams Identity) where
@@ -640,6 +643,7 @@ instance EncCBOR (UpgradeConwayPParams Identity) where
         !> To ucppDRepDeposit
         !> To ucppDRepActivity
         !> To ucppMinFeeRefScriptCostPerByte
+        !> E encodeCostModel ucppPlutusV3CostModel
 
 instance DecCBOR (UpgradeConwayPParams Identity) where
   decCBOR =
@@ -654,6 +658,7 @@ instance DecCBOR (UpgradeConwayPParams Identity) where
         <! From
         <! From
         <! From
+        <! D (decodeCostModelFailHard PlutusV3)
 
 instance Crypto c => EraPParams (ConwayEra c) where
   type PParamsHKD f (ConwayEra c) = ConwayPParams f (ConwayEra c)
@@ -1140,6 +1145,7 @@ upgradeConwayPParamsHKDPairs UpgradeConwayPParams {..} =
   , ("dRepDeposit", (toJSON @Coin) ucppDRepDeposit)
   , ("dRepActivity", (toJSON @EpochInterval) ucppDRepActivity)
   , ("minFeeRefScriptCostPerByte", (toJSON @NonNegativeInterval) ucppMinFeeRefScriptCostPerByte)
+  , ("plutusV3CostModel", (toJSON @CostModel) ucppPlutusV3CostModel)
   ]
 
 instance FromJSON (UpgradeConwayPParams Identity) where
@@ -1155,10 +1161,15 @@ instance FromJSON (UpgradeConwayPParams Identity) where
         <*> o .: "dRepDeposit"
         <*> o .: "dRepActivity"
         <*> o .: "minFeeRefScriptCostPerByte"
+        <*> do
+          cm <- o .: "plutusV3CostModel"
+          case mkCostModel PlutusV3 cm of
+            Left e -> fail $ show e
+            Right cm' -> pure cm'
 
 upgradeConwayPParams ::
   forall f c.
-  HKDFunctor f =>
+  HKDApplicative f =>
   UpgradeConwayPParams f ->
   PParamsHKD f (BabbageEra c) ->
   ConwayPParams f (ConwayEra c)
@@ -1179,7 +1190,17 @@ upgradeConwayPParams UpgradeConwayPParams {..} BabbagePParams {..} =
     , cppProtocolVersion = toNoUpdate @f @ProtVer bppProtocolVersion
     , cppMinPoolCost = THKD bppMinPoolCost
     , cppCoinsPerUTxOByte = THKD bppCoinsPerUTxOByte
-    , cppCostModels = THKD bppCostModels
+    , cppCostModels =
+        THKD $
+          -- We add the PlutusV3 CostModel from ConwayGenesis to the ConwayPParams here
+          hkdLiftA2 @f
+            updateCostModels
+            bppCostModels
+            ( hkdMap
+                (Proxy @f)
+                (mkCostModels . Map.singleton PlutusV3)
+                ucppPlutusV3CostModel
+            )
     , cppPrices = THKD bppPrices
     , cppMaxTxExUnits = THKD bppMaxTxExUnits
     , cppMaxBlockExUnits = THKD bppMaxBlockExUnits

eras/conway/impl/test/Test/Cardano/Ledger/Conway/GenesisSpec.hs

@@ -1,141 +1,31 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Test.Cardano.Ledger.Conway.GenesisSpec (spec) where
+module Test.Cardano.Ledger.Conway.GenesisSpec (spec, expectedConwayGenesis) where
 
-import Cardano.Ledger.BaseTypes (textToUrl)
-import Cardano.Ledger.CertState (DRep (..), DRepState (..))
-import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Conway
-import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
-import Cardano.Ledger.Conway.Governance (Anchor (..), Committee (..))
-import Cardano.Ledger.Conway.TxCert (Delegatee (..))
-import Cardano.Ledger.Core
-import Cardano.Ledger.Credential
-import Cardano.Ledger.Crypto (StandardCrypto)
-import Cardano.Ledger.Keys
-import Cardano.Ledger.Slot (EpochNo (..))
 import Data.Aeson hiding (Encoding)
-import Data.Default.Class (Default (def))
-import qualified Data.ListMap as ListMap
-import Data.Map as Map
-import Data.Maybe (fromJust)
-import Data.Maybe.Strict (StrictMaybe (..))
-import Data.Ratio ((%))
 import Paths_cardano_ledger_conway (getDataFileName)
 import Test.Cardano.Ledger.Common
-import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
+import Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis)
 import Test.Cardano.Slotting.Numeric ()
 
 spec :: Spec
 spec = do
   describe "Genesis Golden Spec" $ do
     goldenConwayGenesisJSON
 
+fileName :: String
+fileName = "test/data/conway-genesis.json"
+
 goldenConwayGenesisJSON :: Spec
 goldenConwayGenesisJSON =
   it "should deserialize to the default value" $ do
-    let fileName = "test/data/conway-genesis.json"
-        credMember =
-          KeyHashObj
-            (KeyHash "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a") ::
-            Credential 'ColdCommitteeRole StandardCrypto
-        scriptMember =
-          ScriptHashObj
-            (ScriptHash "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a") ::
-            Credential 'ColdCommitteeRole StandardCrypto
-        comm =
-          Committee
-            ( Map.fromList
-                [
-                  ( credMember
-                  , EpochNo 1
-                  )
-                ,
-                  ( scriptMember
-                  , EpochNo 2
-                  )
-                ]
-            )
-            (unsafeBoundRational (1 % 2)) ::
-            Committee Conway
     file <- getDataFileName fileName
     dec <- eitherDecodeFileStrict' file
     cg <- case dec of
       Left err -> error ("Failed to deserialize JSON: " ++ err)
       Right x -> pure x
-    let
-      expectedCg =
-        def
-          { cgCommittee = comm
-          , cgInitialDReps =
-              ListMap.fromList
-                [
-                  ( KeyHashObj
-                      (KeyHash "78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd")
-                  , DRepState
-                      { drepExpiry = 1000
-                      , drepAnchor = SNothing
-                      , drepDeposit = Coin 5000
-                      }
-                  )
-                ,
-                  ( ScriptHashObj
-                      (ScriptHash "01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b")
-                  , DRepState
-                      { drepExpiry = 300
-                      , drepAnchor =
-                          SJust $
-                            Anchor
-                              { anchorUrl = fromJust $ textToUrl 99 "example.com"
-                              , anchorDataHash = def
-                              }
-                      , drepDeposit = Coin 6000
-                      }
-                  )
-                ]
-          , cgDelegs =
-              ListMap.fromList
-                [
-                  ( KeyHashObj
-                      (KeyHash "35bc5e86c42afbc593ab4cdd78301005df84ba67fa1f12f95f8ee103")
-                  , DelegVote DRepAlwaysNoConfidence
-                  )
-                ,
-                  ( KeyHashObj
-                      (KeyHash "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a")
-                  , DelegVote DRepAlwaysAbstain
-                  )
-                ,
-                  ( KeyHashObj
-                      (KeyHash "5df84bcdd7a5f8ee93aafbc500b435bc5e83067fa1f12f9110386c42")
-                  , DelegStake $ KeyHash "0335bc5e86c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd"
-                  )
-                ,
-                  ( KeyHashObj
-                      (KeyHash "8ee93a5df84bc42cdd7a5fafbc500b435bc5e83067fa1f12f9110386")
-                  , DelegStakeVote
-                      (KeyHash "086c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd335bc5e")
-                      DRepAlwaysAbstain
-                  )
-                ,
-                  ( KeyHashObj
-                      (KeyHash "df93ab435bc5eafbc500583067fa1f12f9110386c42cdd784ba5f8ee")
-                  , DelegVote $
-                      DRepCredential
-                        (ScriptHashObj (ScriptHash "01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b"))
-                  )
-                ,
-                  ( ScriptHashObj
-                      (ScriptHash "afbc5005df84ba5f8ee93ab435bc5e83067fa1f12f9c42cdd7110386")
-                  , DelegVote $
-                      DRepCredential
-                        (KeyHashObj (KeyHash "78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd"))
-                  )
-                ]
-          }
-    cg `shouldBe` expectedCg
+    cg `shouldBe` expectedConwayGenesis

eras/conway/impl/test/data/conway-genesis.json

@@ -25,6 +25,7 @@
   "dRepDeposit": 0,
   "dRepActivity": 0,
   "minFeeRefScriptCostPerByte": 0,
+  "plutusV3CostModel": [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
   "constitution": {
     "anchor": {
       "url": "",

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -51,6 +51,7 @@ import Cardano.Ledger.Conway.TxCert
 import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
 import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.HKD (HKD, NoUpdate (..))
+import Cardano.Ledger.Plutus (Language (PlutusV3))
 import Control.State.Transition.Extended (STS (Event))
 import Data.Default.Class (def)
 import Data.Foldable (toList)
@@ -67,6 +68,7 @@ import Test.Cardano.Data (genNonEmptyMap)
 import Test.Cardano.Data.Arbitrary ()
 import Test.Cardano.Ledger.Alonzo.Arbitrary (
   genValidAndUnknownCostModels,
+  genValidCostModel,
   unFlexibleCostModels,
  )
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
@@ -116,6 +118,7 @@ instance Arbitrary (UpgradeConwayPParams Identity) where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> genValidCostModel PlutusV3
 
 instance Crypto c => Arbitrary (Delegatee c) where
   arbitrary =