Add ability to inject any cost models via AlonzoGenesis

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

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -25,13 +26,18 @@ module Cardano.Ledger.Alonzo.Genesis (
     agMaxBlockExUnits,
     agMaxValSize,
     agCollateralPercentage,
-    agMaxCollateralInputs
+    agMaxCollateralInputs,
+    agExtraConfig
   ),
   toAlonzoGenesisPairs,
+  AlonzoExtraConfig (..),
 ) where
 
 import Cardano.Ledger.Alonzo.Era (AlonzoEra)
-import Cardano.Ledger.Alonzo.PParams (CoinPerWord, UpgradeAlonzoPParams (..))
+import Cardano.Ledger.Alonzo.PParams (
+  CoinPerWord,
+  UpgradeAlonzoPParams (..),
+ )
 import Cardano.Ledger.Alonzo.Scripts (CostModels, ExUnits (..), Prices (..))
 import Cardano.Ledger.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
 import Cardano.Ledger.Binary (
@@ -51,22 +57,42 @@ import Cardano.Ledger.Binary.Coders (
 import Cardano.Ledger.Core
 import Cardano.Ledger.Genesis (EraGenesis (..))
 import Cardano.Ledger.Plutus.CostModels (parseCostModels)
+import Cardano.Ledger.Plutus.Language (Language (..))
 import Control.DeepSeq (NFData)
-import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=))
+import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.:?), (.=))
 import qualified Data.Aeson as Aeson
 import Data.Functor.Identity (Identity)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
 import Numeric.Natural (Natural)
 
 -- | All configuration that is necessary to bootstrap AlonzoEra from ShelleyGenesis
-newtype AlonzoGenesis = AlonzoGenesisWrapper
+data AlonzoGenesis = AlonzoGenesisWrapper
   { unAlonzoGenesisWrapper :: UpgradeAlonzoPParams Identity
+  , extraConfig :: AlonzoExtraConfig
   }
-  deriving stock (Eq, Generic)
-  deriving newtype (Show, NoThunks, NFData)
+  deriving stock (Eq, Show, Generic)
   deriving (ToJSON) via KeyValuePairs AlonzoGenesis
 
+instance NoThunks AlonzoGenesis
+
+instance NFData AlonzoGenesis
+
+newtype AlonzoExtraConfig = AlonzoExtraConfig
+  { aecCostModels :: Maybe CostModels
+  }
+  deriving (Eq)
+  deriving newtype (EncCBOR, DecCBOR, NFData, NoThunks, Show)
+
+instance FromJSON AlonzoExtraConfig where
+  parseJSON = Aeson.withObject "Extra Config" $ \o ->
+    o .:? "costModels" >>= \case
+      Nothing -> pure $ AlonzoExtraConfig Nothing
+      Just val -> AlonzoExtraConfig . Just <$> parseCostModels True [] val
+
+instance ToJSON AlonzoExtraConfig where
+  toJSON (AlonzoExtraConfig cms) = Aeson.object ["costModels" .= cms]
+
 pattern AlonzoGenesis ::
   CoinPerWord ->
   CostModels ->
@@ -76,6 +102,7 @@ pattern AlonzoGenesis ::
   Natural ->
   Natural ->
   Natural ->
+  AlonzoExtraConfig ->
   AlonzoGenesis
 pattern AlonzoGenesis
   { agCoinsPerUTxOWord
@@ -86,8 +113,10 @@ pattern AlonzoGenesis
   , agMaxValSize
   , agCollateralPercentage
   , agMaxCollateralInputs
+  , agExtraConfig
   } <-
-  ( unAlonzoGenesisWrapper ->
+  AlonzoGenesisWrapper
+    { unAlonzoGenesisWrapper =
       UpgradeAlonzoPParams
         { uappCoinsPerUTxOWord = agCoinsPerUTxOWord
         , uappCostModels = agCostModels
@@ -98,7 +127,8 @@ pattern AlonzoGenesis
         , uappCollateralPercentage = agCollateralPercentage
         , uappMaxCollateralInputs = agMaxCollateralInputs
         }
-    )
+    , extraConfig = agExtraConfig
+    }
   where
     AlonzoGenesis
       coinsPerUTxOWord_
@@ -108,18 +138,21 @@ pattern AlonzoGenesis
       maxBlockExUnits_
       maxValSize_
       collateralPercentage_
-      maxCollateralInputs_ =
-        AlonzoGenesisWrapper $
-          UpgradeAlonzoPParams
-            { uappCoinsPerUTxOWord = coinsPerUTxOWord_
-            , uappCostModels = costModels_
-            , uappPrices = prices_
-            , uappMaxTxExUnits = maxTxExUnits_
-            , uappMaxBlockExUnits = maxBlockExUnits_
-            , uappMaxValSize = maxValSize_
-            , uappCollateralPercentage = collateralPercentage_
-            , uappMaxCollateralInputs = maxCollateralInputs_
-            }
+      maxCollateralInputs_
+      extraConfig_ =
+        AlonzoGenesisWrapper
+          ( UpgradeAlonzoPParams
+              { uappCoinsPerUTxOWord = coinsPerUTxOWord_
+              , uappCostModels = costModels_
+              , uappPrices = prices_
+              , uappMaxTxExUnits = maxTxExUnits_
+              , uappMaxBlockExUnits = maxBlockExUnits_
+              , uappMaxValSize = maxValSize_
+              , uappCollateralPercentage = collateralPercentage_
+              , uappMaxCollateralInputs = maxCollateralInputs_
+              }
+          )
+          extraConfig_
 
 {-# COMPLETE AlonzoGenesis #-}
 
@@ -144,6 +177,7 @@ instance FromCBOR AlonzoGenesis where
           <! From
           <! From
           <! From
+          <! From
 
 instance ToCBOR AlonzoGenesis where
   toCBOR
@@ -172,13 +206,14 @@ instance ToCBOR AlonzoGenesis where
 instance FromJSON AlonzoGenesis where
   parseJSON = Aeson.withObject "Alonzo Genesis" $ \o -> do
     agCoinsPerUTxOWord <- o .: "lovelacePerUTxOWord"
-    agCostModels <- parseCostModels False =<< o .: "costModels"
+    agCostModels <- parseCostModels False [PlutusV1] =<< o .: "costModels"
     agPrices <- o .: "executionPrices"
     agMaxTxExUnits <- o .: "maxTxExUnits"
     agMaxBlockExUnits <- o .: "maxBlockExUnits"
     agMaxValSize <- o .: "maxValueSize"
     agCollateralPercentage <- o .: "collateralPercentage"
     agMaxCollateralInputs <- o .: "maxCollateralInputs"
+    agExtraConfig <- o .: "extraConfig"
     return AlonzoGenesis {..}
 
 instance ToKeyValuePairs AlonzoGenesis where

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

@@ -8,6 +8,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -106,10 +107,7 @@ import Cardano.Ledger.Plutus.Language (Language (..))
 import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
 import Cardano.Ledger.Shelley.PParams
 import Control.DeepSeq (NFData)
-import Data.Aeson as Aeson (
-  FromJSON,
-  ToJSON (..),
- )
+import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Coerce (coerce)
@@ -422,7 +420,15 @@ data UpgradeAlonzoPParams f = UpgradeAlonzoPParams
 
 emptyAlonzoUpgradePParamsUpdate :: UpgradeAlonzoPParams StrictMaybe
 emptyAlonzoUpgradePParamsUpdate =
-  UpgradeAlonzoPParams SNothing SNothing SNothing SNothing SNothing SNothing SNothing SNothing
+  UpgradeAlonzoPParams
+    SNothing
+    SNothing
+    SNothing
+    SNothing
+    SNothing
+    SNothing
+    SNothing
+    SNothing
 
 deriving instance Eq (UpgradeAlonzoPParams Identity)
 

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

@@ -61,7 +61,7 @@ instance TranslateEra AlonzoEra NewEpochState where
         }
 
 instance TranslateEra AlonzoEra PParams where
-  translateEra (AlonzoGenesisWrapper upgradeArgs) = pure . upgradePParams upgradeArgs
+  translateEra (AlonzoGenesisWrapper upgradeArgs _) = pure . upgradePParams upgradeArgs
 
 instance TranslateEra AlonzoEra FuturePParams where
   translateEra ctxt = \case

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

@@ -36,7 +36,7 @@ module Test.Cardano.Ledger.Alonzo.Arbitrary (
 import Cardano.Ledger.Alonzo (AlonzoEra, Tx (..))
 import Cardano.Ledger.Alonzo.BlockBody (AlonzoBlockBody (AlonzoBlockBody))
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.PParams (
   AlonzoPParams (AlonzoPParams),
   LangDepView (..),
@@ -436,6 +436,7 @@ instance Arbitrary AlonzoGenesis where
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
+      <*> arbitrary
 
 alwaysSucceeds ::
   forall l era.
@@ -493,3 +494,5 @@ instance
 
 instance Arbitrary LangDepView where
   arbitrary = LangDepView <$> arbitrary <*> arbitrary
+
+deriving instance Arbitrary AlonzoExtraConfig

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

@@ -15,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Examples (
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
 import Cardano.Ledger.Alonzo.Scripts (
   AlonzoPlutusPurpose (..),
@@ -218,4 +218,5 @@ exampleAlonzoGenesis =
     , agMaxValSize = 1234
     , agCollateralPercentage = 20
     , agMaxCollateralInputs = 30
+    , agExtraConfig = AlonzoExtraConfig Nothing
     }

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

@@ -47,7 +47,7 @@ module Test.Cardano.Ledger.Alonzo.ImpTest (
 import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (
   collectPlutusScriptsWithContext,
@@ -431,6 +431,7 @@ instance ShelleyEraImp AlonzoEra where
         , agMaxValSize = 5000
         , agCollateralPercentage = 150
         , agMaxCollateralInputs = 3
+        , agExtraConfig = AlonzoExtraConfig Nothing
         }
 
   impSatisfyNativeScript = impAllegraSatisfyNativeScript

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Golden.hs

@@ -9,7 +9,7 @@ module Test.Cardano.Ledger.Alonzo.Golden (
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
-import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
+import Cardano.Ledger.Alonzo.Genesis (AlonzoExtraConfig (..), AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.PParams (
   LangDepView (..),
   getLanguageView,
@@ -388,6 +388,7 @@ expectedGenesis =
     , agMaxValSize = 5000
     , agCollateralPercentage = 150
     , agMaxCollateralInputs = 3
+    , agExtraConfig = AlonzoExtraConfig Nothing
     }
 
 expectedCostModels :: CostModels

libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/CostModels.hs

@@ -135,17 +135,21 @@ instance NFData CostModel where
   rnf (CostModel lang cm ectx) = lang `deepseq` cm `deepseq` rnf ectx
 
 instance FromJSON CostModels where
-  parseJSON = parseCostModels True
+  parseJSON = parseCostModels True []
 
 parseCostModels ::
   -- | Do not restrict number of parameters to the initial count and allow parsing of cost models
   -- for unknown plutus versions.
   Bool ->
+  [Language] ->
   Value ->
   Parser CostModels
-parseCostModels isLenient =
+parseCostModels isLenient languages =
   withObject "CostModels" $ \o -> do
-    cms <- mapM (parseCostModel isLenient o) nonNativeLanguages
+    cms <-
+      if null languages
+        then mapM (parseCostModel isLenient o) nonNativeLanguages
+        else mapM (parseCostModel isLenient o) languages
     let cmsMap = Map.fromList [(cmLanguage cm, cm) | Just cm <- cms]
     unknownCostModels <-
       if isLenient