Restrict languages in Alonzo cost model parsing

Only allow `PlutusV1` when parsing cost models in `AlonzoGenesis`
and `UpgradeAlonzoPParams`.

Author: Lucsanszky

eras/alonzo/impl/CHANGELOG.md

@@ -2,6 +2,10 @@
 
 ## 1.15.0.0
 
+* Renamed `uappCostModels` to `uappPlutusV1CostModel`
+  and changed its type from `CostModels` to `CostModel`
+* Renamed `agCostModels` to `agPlutusV1CostModel`
+  and changed its type from `CostModels` to `CostModel`
 * Updated `AlonzoGenesis` with `extraConfig` field
 * Added `AlonzoExtraConfig` and its instances
 * Remove deprecated functions `nullRedeemers`, `lookupRedeemers`, `nullDats`

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs

@@ -21,7 +21,7 @@ module Cardano.Ledger.Alonzo.Genesis (
     extraConfig,
     AlonzoGenesis,
     agCoinsPerUTxOWord,
-    agCostModels,
+    agPlutusV1CostModel,
     agPrices,
     agMaxTxExUnits,
     agMaxBlockExUnits,
@@ -38,25 +38,29 @@ import Cardano.Ledger.Alonzo.PParams (
   CoinPerWord,
   UpgradeAlonzoPParams (..),
  )
-import Cardano.Ledger.Alonzo.Scripts (CostModels, ExUnits (..), Prices (..))
+import Cardano.Ledger.Alonzo.Scripts (
+  CostModel,
+  CostModels,
+  ExUnits (..),
+  Prices (..),
+  decodeCostModel,
+  decodeCostModelsLenient,
+  encodeCostModel,
+ )
 import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
 import Cardano.Ledger.Binary (
-  DecCBOR,
-  EncCBOR,
+  DecCBOR (..),
+  EncCBOR (..),
   FromCBOR (..),
   ToCBOR (..),
+  decodeNullMaybe,
+  encodeNullMaybe,
  )
-import Cardano.Ledger.Binary.Coders (
-  Decode (From, RecD),
-  Encode (Rec, To),
-  decode,
-  encode,
-  (!>),
-  (<!),
- )
+import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Core
 import Cardano.Ledger.Genesis (EraGenesis (..))
-import Cardano.Ledger.Plutus.CostModels (parseCostModels)
+import Cardano.Ledger.Plutus.CostModels (parseCostModelAsArray, parseCostModels)
+import Cardano.Ledger.Plutus.Language (Language (..))
 import Control.DeepSeq (NFData)
 import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
@@ -81,20 +85,38 @@ newtype AlonzoExtraConfig = AlonzoExtraConfig
   { aecCostModels :: Maybe CostModels
   }
   deriving (Eq)
-  deriving newtype (EncCBOR, DecCBOR, NFData, NoThunks, Show)
+  deriving newtype (NFData, NoThunks, Show)
+
+instance DecCBOR AlonzoExtraConfig
+
+instance EncCBOR AlonzoExtraConfig
+
+instance FromCBOR AlonzoExtraConfig where
+  fromCBOR =
+    eraDecoder @AlonzoEra $
+      decode $
+        RecD AlonzoExtraConfig
+          <! D (decodeNullMaybe decodeCostModelsLenient)
+
+instance ToCBOR AlonzoExtraConfig where
+  toCBOR x@(AlonzoExtraConfig _) =
+    let AlonzoExtraConfig {..} = x
+     in toEraCBOR @AlonzoEra . encode $
+          Rec AlonzoExtraConfig
+            !> E (encodeNullMaybe encCBOR) aecCostModels
 
 instance FromJSON AlonzoExtraConfig where
   parseJSON = Aeson.withObject "Extra Config" $ \o ->
     o .:? "costModels" >>= \case
       Nothing -> pure $ AlonzoExtraConfig Nothing
-      Just val -> AlonzoExtraConfig . Just <$> parseCostModels True [] val
+      Just val -> AlonzoExtraConfig . Just <$> parseCostModels True val
 
 instance ToJSON AlonzoExtraConfig where
   toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms]
 
 pattern AlonzoGenesis ::
   CoinPerWord ->
-  CostModels ->
+  CostModel ->
   Prices ->
   ExUnits ->
   ExUnits ->
@@ -105,7 +127,7 @@ pattern AlonzoGenesis ::
   AlonzoGenesis
 pattern AlonzoGenesis
   { agCoinsPerUTxOWord
-  , agCostModels
+  , agPlutusV1CostModel
   , agPrices
   , agMaxTxExUnits
   , agMaxBlockExUnits
@@ -118,7 +140,7 @@ pattern AlonzoGenesis
     { unAlonzoGenesisWrapper =
       UpgradeAlonzoPParams
         { uappCoinsPerUTxOWord = agCoinsPerUTxOWord
-        , uappCostModels = agCostModels
+        , uappPlutusV1CostModel = agPlutusV1CostModel
         , uappPrices = agPrices
         , uappMaxTxExUnits = agMaxTxExUnits
         , uappMaxBlockExUnits = agMaxBlockExUnits
@@ -142,7 +164,7 @@ pattern AlonzoGenesis
         AlonzoGenesisWrapper
           ( UpgradeAlonzoPParams
               { uappCoinsPerUTxOWord = coinsPerUTxOWord_
-              , uappCostModels = costModels_
+              , uappPlutusV1CostModel = costModels_
               , uappPrices = prices_
               , uappMaxTxExUnits = maxTxExUnits_
               , uappMaxBlockExUnits = maxBlockExUnits_
@@ -169,7 +191,7 @@ instance FromCBOR AlonzoGenesis where
       decode $
         RecD AlonzoGenesis
           <! From
-          <! From
+          <! D (decodeCostModel PlutusV1)
           <! From
           <! From
           <! From
@@ -179,33 +201,24 @@ instance FromCBOR AlonzoGenesis where
           <! From
 
 instance ToCBOR AlonzoGenesis where
-  toCBOR
-    AlonzoGenesis
-      { agCoinsPerUTxOWord
-      , agCostModels
-      , agPrices
-      , agMaxTxExUnits
-      , agMaxBlockExUnits
-      , agMaxValSize
-      , agCollateralPercentage
-      , agMaxCollateralInputs
-      } =
-      toEraCBOR @AlonzoEra
-        . encode
-        $ Rec AlonzoGenesis
-          !> To agCoinsPerUTxOWord
-          !> To agCostModels
-          !> To agPrices
-          !> To agMaxTxExUnits
-          !> To agMaxBlockExUnits
-          !> To agMaxValSize
-          !> To agCollateralPercentage
-          !> To agMaxCollateralInputs
+  toCBOR x@(AlonzoGenesis _ _ _ _ _ _ _ _ _) =
+    let AlonzoGenesis {..} = x
+     in toEraCBOR @AlonzoEra . encode $
+          Rec AlonzoGenesis
+            !> To agCoinsPerUTxOWord
+            !> E encodeCostModel agPlutusV1CostModel
+            !> To agPrices
+            !> To agMaxTxExUnits
+            !> To agMaxBlockExUnits
+            !> To agMaxValSize
+            !> To agCollateralPercentage
+            !> To agMaxCollateralInputs
+            !> To agExtraConfig
 
 instance FromJSON AlonzoGenesis where
   parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do
     agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord"
-    agCostModels <- parseCostModels False =<< o .: "costModels"
+    agPlutusV1CostModel <- parseCostModelAsArray False PlutusV1 =<< o .: "plutusV1CostModel"
     agPrices <- o .: "executionPrices"
     agMaxTxExUnits <- o .: "maxTxExUnits"
     agMaxBlockExUnits <- o .: "maxBlockExUnits"
@@ -218,7 +231,7 @@ instance FromJSON AlonzoGenesis where
 instance ToKeyValuePairs AlonzoGenesis where
   toKeyValuePairs ag =
     [ "lovelacePerUTxOWord" .= agCoinsPerUTxOWord ag
-    , "costModels" .= agCostModels ag
+    , "plutusV1CostModel" .= agPlutusV1CostModel ag
     , "executionPrices" .= agPrices ag
     , "maxTxExUnits" .= agMaxTxExUnits ag
     , "maxBlockExUnits" .= agMaxBlockExUnits ag

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs

@@ -97,6 +97,7 @@ import Cardano.Ledger.Plutus.CostModels (
   emptyCostModels,
   getCostModelLanguage,
   getCostModelParams,
+  mkCostModels,
  )
 import Cardano.Ledger.Plutus.ExUnits (
   ExUnits (..),
@@ -408,7 +409,7 @@ instance Ord OrdExUnits where
 -- | Parameters that were added in Alonzo
 data UpgradeAlonzoPParams f = UpgradeAlonzoPParams
   { uappCoinsPerUTxOWord :: !(HKD f CoinPerWord)
-  , uappCostModels :: !(HKD f CostModels)
+  , uappPlutusV1CostModel :: !(HKD f CostModel)
   , uappPrices :: !(HKD f Prices)
   , uappMaxTxExUnits :: !(HKD f ExUnits)
   , uappMaxBlockExUnits :: !(HKD f ExUnits)
@@ -442,7 +443,7 @@ instance Default (UpgradeAlonzoPParams StrictMaybe) where
   def =
     UpgradeAlonzoPParams
       { uappCoinsPerUTxOWord = SNothing
-      , uappCostModels = SNothing
+      , uappPlutusV1CostModel = SNothing
       , uappPrices = SNothing
       , uappMaxTxExUnits = SNothing
       , uappMaxBlockExUnits = SNothing
@@ -611,7 +612,7 @@ upgradeAlonzoPParams UpgradeAlonzoPParams {..} ShelleyPParams {..} =
     , appMinPoolCost = sppMinPoolCost
     , -- new in alonzo
       appCoinsPerUTxOWord = uappCoinsPerUTxOWord
-    , appCostModels = uappCostModels
+    , appCostModels = hkdMap (Proxy @f) (mkCostModels . Map.singleton PlutusV1) uappPlutusV1CostModel
     , appPrices = uappPrices
     , appMaxTxExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxTxExUnits
     , appMaxBlockExUnits = hkdMap (Proxy @f) OrdExUnits uappMaxBlockExUnits

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Arbitrary.hs

@@ -425,7 +425,7 @@ instance Arbitrary AlonzoGenesis where
   arbitrary =
     AlonzoGenesis
       <$> arbitrary
-      <*> genValidCostModels [PlutusV1, PlutusV2]
+      <*> genValidCostModel PlutusV1
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Examples.hs

@@ -30,7 +30,6 @@ import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Keys (asWitness)
 import Cardano.Ledger.Mary.Value (MaryValue (..))
-import Cardano.Ledger.Plutus.CostModels (mkCostModels)
 import Cardano.Ledger.Plutus.Data (Data (..), hashData)
 import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Shelley.API (
@@ -211,7 +210,7 @@ exampleAlonzoGenesis :: AlonzoGenesis
 exampleAlonzoGenesis =
   AlonzoGenesis
     { agCoinsPerUTxOWord = CoinPerWord $ Coin 1
-    , agCostModels = mkCostModels (Map.fromList [(PlutusV1, zeroTestingCostModelV1)])
+    , agPlutusV1CostModel = zeroTestingCostModelV1
     , agPrices = Prices (unsafeBoundRational 90) (unsafeBoundRational 91)
     , agMaxTxExUnits = ExUnits 123 123
     , agMaxBlockExUnits = ExUnits 223 223

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs

@@ -112,7 +112,7 @@ import Test.Cardano.Ledger.Mary.ImpTest
 import Test.Cardano.Ledger.Plutus (
   PlutusArgs (..),
   ScriptTestContext (..),
-  testingCostModels,
+  testingCostModel,
  )
 import Test.Cardano.Ledger.Plutus.Examples
 import Test.Cardano.Ledger.Plutus.Guardrail (guardrailScript)
@@ -413,7 +413,7 @@ instance ShelleyEraImp AlonzoEra where
     pure
       AlonzoGenesis
         { agCoinsPerUTxOWord = CoinPerWord (Coin 34_482)
-        , agCostModels = testingCostModels [PlutusV1]
+        , agPlutusV1CostModel = testingCostModel PlutusV1
         , agPrices =
             Prices
               { prMem = 577 %! 10_000