hide CostModel constructor

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

@@ -21,7 +21,15 @@ import Cardano.Binary
 import Cardano.Crypto.Hash.Class (hashToTextAsHex)
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.PParams
-import Cardano.Ledger.Alonzo.Scripts (CostModel (..), CostModels (..), ExUnits (..), ExUnits', Prices (..))
+import Cardano.Ledger.Alonzo.Scripts
+  ( CostModel,
+    CostModels (..),
+    ExUnits (..),
+    ExUnits',
+    Prices (..),
+    getCostModelParams,
+    mkCostModel,
+  )
 import Cardano.Ledger.Alonzo.TxBody
 import qualified Cardano.Ledger.BaseTypes as BT
 import Cardano.Ledger.Coin (Coin)
@@ -43,8 +51,6 @@ import Data.Word (Word64)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks)
 import Numeric.Natural (Natural)
-import Plutus.V1.Ledger.Api as PV1 hiding (Map, Script, TxOut, Value)
-import Plutus.V2.Ledger.Api as PV2 hiding (Map, Script, TxOut, Value)
 import Prelude
 
 data AlonzoGenesis = AlonzoGenesis
@@ -182,8 +188,7 @@ instance FromJSON Prices where
           Just s -> return s
 
 instance ToJSON CostModel where
-  toJSON (CostModelV1 cm _) = toJSON cm
-  toJSON (CostModelV2 cm _) = toJSON cm
+  toJSON = toJSON . getCostModelParams
 
 instance ToJSON CostModels where
   toJSON = toJSON . unCostModels
@@ -210,12 +215,9 @@ instance FromJSONKey Language where
   fromJSONKey = Aeson.FromJSONKeyTextParser languageFromText
 
 validateCostModel :: MonadFail m => (Language, (Map Text Integer)) -> m (Language, CostModel)
-validateCostModel (PlutusV1, cmps) = case PV1.mkEvaluationContext cmps of
-  Nothing -> fail "corrupt Plutus V1 cost model"
-  Just ec -> pure (PlutusV1, CostModelV1 cmps ec)
-validateCostModel (PlutusV2, cmps) = case PV2.mkEvaluationContext cmps of
-  Nothing -> fail "corrupt Plutus V2 cost model"
-  Just ec -> pure (PlutusV2, CostModelV2 cmps ec)
+validateCostModel (lang, cmps) = case mkCostModel lang cmps of
+  Left err -> fail err
+  Right cm -> pure (lang, cm)
 
 instance FromJSON CostModels where
   parseJSON = Aeson.withObject "CostModels" $ \o -> do

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

@@ -42,8 +42,7 @@ import Cardano.Binary
   )
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts
-  ( CostModel (..),
-    CostModels (..),
+  ( CostModels (..),
     ExUnits (..),
     Prices (..),
   )
@@ -75,7 +74,6 @@ import Data.Coders
     Wrapped (..),
     decode,
     encode,
-    encodeFoldableAsIndefinite,
     field,
     (!>),
     (<!),
@@ -491,13 +489,10 @@ getLanguageView pp lang@PlutusV1 =
     (serialize' (serialize' lang))
     ( serialize'
         ( serializeEncoding' $
-            maybe encodeNull enc $
+            maybe encodeNull toCBOR $
               Map.lookup lang (unCostModels $ getField @"_costmdls" pp)
         )
     )
-  where
-    enc (CostModelV1 cm _) = encodeFoldableAsIndefinite $ Map.elems cm
-    enc (CostModelV2 cm _) = encodeFoldableAsIndefinite $ Map.elems cm
 getLanguageView pp lang@PlutusV2 =
   LangDepView
     (serialize' lang)

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

@@ -24,7 +24,7 @@ where
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Alonzo.Data (getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
-import Cardano.Ledger.Alonzo.Scripts (CostModel (..), CostModels (..), ExUnits (..))
+import Cardano.Ledger.Alonzo.Scripts (CostModel, CostModels (..), ExUnits (..))
 import qualified Cardano.Ledger.Alonzo.Scripts as AlonzoScript (Script (..))
 import Cardano.Ledger.Alonzo.Tx
   ( Data,

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

@@ -26,7 +26,10 @@ module Cardano.Ledger.Alonzo.Scripts
     pointWiseExUnits,
 
     -- * Cost Model
-    CostModel (..),
+    CostModel,
+    mkCostModel,
+    getCostModelLanguage,
+    getCostModelParams,
     getEvaluationContext,
     ExUnits (ExUnits, exUnitsMem, exUnitsSteps, ..),
     ExUnits',
@@ -56,7 +59,7 @@ import Cardano.Ledger.SafeHash
   )
 import Cardano.Ledger.Serialization (mapToCBOR)
 import Cardano.Ledger.ShelleyMA.Timelocks
-import Control.DeepSeq (NFData (..), rwhnf)
+import Control.DeepSeq (NFData (..), deepseq, rwhnf)
 import Control.Monad (when)
 import Data.ByteString.Short (ShortByteString, fromShort)
 import Data.Coders
@@ -182,30 +185,32 @@ pointWiseExUnits oper (ExUnits m1 s1) (ExUnits m2 s2) = (m1 `oper` m2) && (s1 `o
 
 -- =====================================
 
-data CostModel
-  = CostModelV1 (Map Text Integer) PV1.EvaluationContext
-  | CostModelV2 (Map Text Integer) PV2.EvaluationContext
+-- | A language dependent cost model for the Plutus evaluator.
+-- Note that the `EvaluationContext` is entirely dependent on the
+-- cost model parameters (ie the `Map` `Text` `Integer`) and that
+-- this type uses the smart constructor `mkCostModel`
+-- to hide the evaluation context.
+data CostModel = CostModel !Language (Map Text Integer) PV1.EvaluationContext
 
+-- | Note that this Eq instance ignores the evaluation context, which is
+-- entirely dependent on the cost model parameters and is guarded by the
+-- smart constructor `mkCostModel`.
 instance Eq CostModel where
-  (CostModelV1 x _) == (CostModelV1 y _) = x == y
-  (CostModelV2 x _) == (CostModelV2 y _) = x == y
-  _ == _ = False
+  CostModel l1 x _ == CostModel l2 y _ = l1 == l2 && x == y
 
 instance Show CostModel where
-  show (CostModelV1 cm _) = "CostModelV1 " <> show cm
-  show (CostModelV2 cm _) = "CostModelV2 " <> show cm
+  show (CostModel lang cm _) = "CostModel " <> show lang <> " " <> show cm
 
+-- | Note that this Ord instance ignores the evaluation context, which is
+-- entirely dependent on the cost model parameters and is guarded by the
+-- smart constructor `mkCostModel`.
 instance Ord CostModel where
-  compare (CostModelV1 x _) (CostModelV1 y _) = compare x y
-  compare (CostModelV2 x _) (CostModelV2 y _) = compare x y
-  compare (CostModelV1 _ _) (CostModelV2 _ _) = LT
-  compare (CostModelV2 _ _) (CostModelV1 _ _) = GT
+  compare (CostModel l1 x _) (CostModel l2 y _) = compare l1 l2 <> compare x y
 
 -- NOTE: Since cost model serializations need to be independently reproduced,
 -- we use the 'canonical' serialization approach used in Byron.
 instance ToCBOR CostModel where
-  toCBOR (CostModelV1 cm _) = encodeFoldableAsDefinite $ Map.elems cm
-  toCBOR (CostModelV2 cm _) = encodeFoldableAsDefinite $ Map.elems cm
+  toCBOR (CostModel _ cm _) = encodeFoldableAsDefinite $ Map.elems cm
 
 instance SafeToHash CostModel where
   originalBytes = serialize'
@@ -220,27 +225,32 @@ deriving via InspectHeapNamed "PV1.EvaluationContext" PV1.EvaluationContext inst
 deriving via InspectHeapNamed "CostModel" CostModel instance NoThunks CostModel
 
 instance NFData CostModel where
-  rnf (CostModelV1 cm ectx) = seq (rnf cm) (rnf ectx)
-  rnf (CostModelV2 cm ectx) = seq (rnf cm) (rnf ectx)
+  rnf (CostModel lang cm ectx) = lang `deepseq` cm `deepseq` rnf ectx
 
 -- | Convert cost model parameters to a cost model, making use of the
 --  conversion function mkEvaluationContext from the Plutus API.
-costModelParamsToCostModel :: Language -> Map Text Integer -> Either String CostModel
-costModelParamsToCostModel PlutusV1 cm =
+mkCostModel :: Language -> Map Text Integer -> Either String CostModel
+mkCostModel PlutusV1 cm =
   case PV1.mkEvaluationContext cm of
-    Just evalCtx -> Right (CostModelV1 cm evalCtx)
+    Just evalCtx -> Right (CostModel PlutusV1 cm evalCtx)
     Nothing -> Left ("Invalid PlutusV1 cost model: " ++ show cm)
-costModelParamsToCostModel PlutusV2 cm =
+mkCostModel PlutusV2 cm =
   case PV2.mkEvaluationContext cm of
-    Just evalCtx -> Right (CostModelV2 cm evalCtx)
+    Just evalCtx -> Right (CostModel PlutusV2 cm evalCtx)
     Nothing -> Left ("Invalid PlutusV2 cost model: " ++ show cm)
 
+getCostModelLanguage :: CostModel -> Language
+getCostModelLanguage (CostModel lang _ _) = lang
+
+getCostModelParams :: CostModel -> Map Text Integer
+getCostModelParams (CostModel _ cm _) = cm
+
 decodeCostModelMap :: Decoder s (Map Language CostModel)
 decodeCostModelMap = decodeMapByKey fromCBOR decodeCostModel
 
 decodeCostModel :: Language -> Decoder s CostModel
 decodeCostModel lang = do
-  checked <- costModelParamsToCostModel lang <$> decodeArrayAsMap keys fromCBOR
+  checked <- mkCostModel lang <$> decodeArrayAsMap keys fromCBOR
   case checked of
     Left e -> fail e
     Right cm -> pure cm
@@ -274,8 +284,7 @@ hashCostModel ::
 hashCostModel _proxy = hashWithCrypto (Proxy @(Crypto e))
 
 getEvaluationContext :: CostModel -> PV1.EvaluationContext
-getEvaluationContext (CostModelV1 _ ec) = ec
-getEvaluationContext (CostModelV2 _ ec) = ec
+getEvaluationContext (CostModel _ _ ec) = ec
 
 newtype CostModels = CostModels {unCostModels :: Map Language CostModel}
   deriving (Eq, Show, Ord, Generic, NFData, NoThunks)

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

@@ -15,7 +15,7 @@ import Cardano.Ledger.Alonzo.Data (Data, getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.PlutusScriptApi (scriptsNeeded)
 import Cardano.Ledger.Alonzo.Scripts
-  ( CostModel (..),
+  ( CostModel,
     ExUnits (..),
     Script (..),
     getEvaluationContext,

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

@@ -24,11 +24,12 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (utxoEntrySize, vKeyLocked)
 import Cardano.Ledger.Alonzo.Rules.Utxow (langsUsed)
 import Cardano.Ledger.Alonzo.Scripts (isPlutusScript, pointWiseExUnits, txscriptfee)
 import Cardano.Ledger.Alonzo.Scripts as Alonzo
-  ( CostModel (..),
+  ( CostModel,
     CostModels (..),
     ExUnits (..),
     Prices (..),
     Script (..),
+    mkCostModel,
   )
 import Cardano.Ledger.Alonzo.Tx
   ( IsValid (..),
@@ -64,18 +65,18 @@ import Cardano.Slotting.Slot (SlotNo (..))
 import Control.Monad (replicateM)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Compact.SplitMap as SplitMap
+import Data.Either (fromRight)
 import Data.Hashable (Hashable (..))
 import qualified Data.List as List
 import Data.Map as Map
-import Data.Maybe (fromJust)
 import Data.Proxy (Proxy (..))
 import Data.Ratio ((%))
 import Data.Sequence.Strict (StrictSeq ((:|>)))
 import qualified Data.Sequence.Strict as Seq (fromList)
 import Data.Set as Set
 import GHC.Records (HasField (..))
 import Numeric.Natural (Natural)
-import Plutus.V1.Ledger.Api (costModelParamNames, mkEvaluationContext)
+import Plutus.V1.Ledger.Api (costModelParamNames)
 import qualified PlutusTx as P (Data (..))
 import qualified PlutusTx as Plutus
 import Test.Cardano.Ledger.AllegraEraGen (genValidityInterval)
@@ -178,10 +179,11 @@ genAlonzoMint startvalue = do
 
 -- | A cost model that sets everything as being free
 freeCostModel :: CostModel
-freeCostModel = CostModelV1 cmps ec
+freeCostModel =
+  fromRight (error "freeCostModel is not well-formed") $
+    Alonzo.mkCostModel PlutusV1 cmps
   where
     cmps = Map.fromList $ fmap (\k -> (k, 0)) (Set.toList costModelParamNames)
-    ec = fromJust $ mkEvaluationContext cmps
 
 -- ================================================================
 

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

@@ -2,22 +2,20 @@
 module Test.Cardano.Ledger.Alonzo.PlutusScripts where
 
 import Cardano.Ledger.Alonzo.Language (Language (..))
-import Cardano.Ledger.Alonzo.Scripts (CostModel (..), Script (..))
+import Cardano.Ledger.Alonzo.Scripts (CostModel, Script (..), mkCostModel)
 import Data.ByteString.Short (pack)
-import Data.Maybe (fromJust)
-import qualified Plutus.V1.Ledger.Api as PV1
+import Data.Either (fromRight)
 import qualified Plutus.V1.Ledger.EvaluationContext as PV1
-import qualified Plutus.V2.Ledger.Api as PV2
 
 testingCostModelV1 :: CostModel
 testingCostModelV1 =
-  CostModelV1 PV1.costModelParamsForTesting (fromJust $ PV1.mkEvaluationContext PV1.costModelParamsForTesting)
+  fromRight (error "testingCostModelV1 is not well-formed") $
+    mkCostModel PlutusV1 PV1.costModelParamsForTesting
 
 testingCostModelV2 :: CostModel
 testingCostModelV2 =
-  CostModelV2 costModelParamsForTestingPV2 (fromJust $ PV2.mkEvaluationContext costModelParamsForTestingPV2)
-  where
-    costModelParamsForTestingPV2 = PV1.costModelParamsForTesting -- TODO use PV2 when it exists
+  fromRight (error "testingCostModelV2 is not well-formed") $
+    mkCostModel PlutusV2 PV1.costModelParamsForTesting -- TODO use PV2 when it exists
 
 {-# DEPRECATED defaultCostModel "use testingCostModelV1 instead" #-}
 defaultCostModel :: Maybe CostModel

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs

@@ -22,12 +22,12 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure (..))
 import Cardano.Ledger.Alonzo.Rules.Utxos (TagMismatchDescription (..), UtxosPredicateFailure (..))
 import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail (..))
 import Cardano.Ledger.Alonzo.Scripts
-  ( CostModel (..),
-    CostModels (..),
+  ( CostModels (..),
     ExUnits (..),
     Prices (..),
     Script (..),
     Tag (..),
+    mkCostModel,
   )
 import Cardano.Ledger.Alonzo.Tx
 import Cardano.Ledger.Alonzo.TxBody
@@ -42,7 +42,6 @@ import Cardano.Ledger.Shelley.Constraints (UsesScript, UsesValue)
 import Data.Int (Int64)
 import Data.Map (Map)
 import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Text (Text, pack)
@@ -204,14 +203,14 @@ instance Arbitrary Prices where
 mkNullCostModel :: Set Text -> Map Text Integer
 mkNullCostModel = Map.fromList . fmap (\k -> (k, 0 :: Integer)) . Set.toList
 
-genCM :: Set Text -> Gen (Map Text Integer, PV1.EvaluationContext)
-genCM costModelParamNames = do
+genCM :: Language -> Set Text -> Gen CostModel
+genCM lang costModelParamNames = do
   newCMPs <- traverse (const arbitrary) (mkNullCostModel costModelParamNames)
-  pure $ (newCMPs, fromMaybe (error "Corrupt cost model") (PV1.mkEvaluationContext newCMPs))
+  either (error "Corrupt cost model") pure $ mkCostModel lang newCMPs
 
 genCostModel :: Language -> Gen (Language, CostModel)
-genCostModel PlutusV1 = (PlutusV1,) <$> uncurry CostModelV1 <$> genCM PV1.costModelParamNames
-genCostModel PlutusV2 = (PlutusV2,) <$> uncurry CostModelV2 <$> genCM PV2.costModelParamNames
+genCostModel PlutusV1 = (PlutusV1,) <$> genCM PlutusV1 PV1.costModelParamNames
+genCostModel PlutusV2 = (PlutusV2,) <$> genCM PlutusV2 PV2.costModelParamNames
 
 instance Arbitrary CostModel where
   arbitrary = snd <$> (elements nonNativeLanguages >>= genCostModel)

eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Serialisation/Generators.hs

@@ -20,7 +20,7 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (UtxoPredicateFailure (..))
 import Cardano.Ledger.Alonzo.Rules.Utxos (TagMismatchDescription (..), UtxosPredicateFailure (..))
 import Cardano.Ledger.Alonzo.Rules.Utxow (UtxowPredicateFail (..))
 import Cardano.Ledger.Alonzo.Scripts
-  ( CostModel (..),
+  ( CostModel,
     ExUnits (..),
     Prices (..),
     Script (..),

libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty/Alonzo.hs

@@ -72,10 +72,8 @@ ppExUnits (ExUnits mem step) =
 instance PrettyA ExUnits where prettyA = ppExUnits
 
 ppCostModel :: CostModel -> PDoc
-ppCostModel (CostModelV1 m _) =
-  ppSexp "CostModelV1" [ppMap text ppInteger m]
-ppCostModel (CostModelV2 m _) =
-  ppSexp "CostModelV2" [ppMap text ppInteger m]
+ppCostModel cm =
+  ppSexp "CostModel" [ppLanguage (getCostModelLanguage cm), ppMap text ppInteger (getCostModelParams cm)]
 
 instance PrettyA CostModel where prettyA = ppCostModel