Re-organize CostModel serialization

CHANGELOG.md

@@ -257,7 +257,8 @@ in the naming of release branches.
 - The `Cardano.Ledger.Alonzo.Scripts` module no longer re-exports the
   `plutus-ledger-api`'s `assertWellFormedCostModelParams`. #3065
 - Removed unused `Data.BiMap` module from `cardano-data` #3089
-- Removed `getMultiSigBytes` as unused #?
+- Removed `getMultiSigBytes` as unused #3138
+- Removed `hashCostModel` as unused and invalid #3138
 
 ### Fixed
 

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

@@ -318,55 +318,30 @@ instance FromJSON (AlonzoPParams era) where
   parseJSON =
     Aeson.withObject "PParams" $ \obj ->
       AlonzoPParams
-        <$> obj
-          .: "minFeeA"
-        <*> obj
-          .: "minFeeB"
-        <*> obj
-          .: "maxBlockBodySize"
-        <*> obj
-          .: "maxTxSize"
-        <*> obj
-          .: "maxBlockHeaderSize"
-        <*> obj
-          .: "keyDeposit"
-        <*> obj
-          .: "poolDeposit"
-        <*> obj
-          .: "eMax"
-        <*> obj
-          .: "nOpt"
-        <*> obj
-          .: "a0"
-        <*> obj
-          .: "rho"
-        <*> obj
-          .: "tau"
-        <*> obj
-          .: "decentralisationParam"
-        <*> obj
-          .: "extraEntropy"
-        <*> obj
-          .: "protocolVersion"
-        <*> obj
-          .: "minPoolCost"
-          .!= mempty
-        <*> obj
-          .: "lovelacePerUTxOWord"
-        <*> obj
-          .: "costmdls"
-        <*> obj
-          .: "prices"
-        <*> obj
-          .: "maxTxExUnits"
-        <*> obj
-          .: "maxBlockExUnits"
-        <*> obj
-          .: "maxValSize"
-        <*> obj
-          .: "collateralPercentage"
-        <*> obj
-          .: "maxCollateralInputs"
+        <$> obj .: "minFeeA"
+        <*> obj .: "minFeeB"
+        <*> obj .: "maxBlockBodySize"
+        <*> obj .: "maxTxSize"
+        <*> obj .: "maxBlockHeaderSize"
+        <*> obj .: "keyDeposit"
+        <*> obj .: "poolDeposit"
+        <*> obj .: "eMax"
+        <*> obj .: "nOpt"
+        <*> obj .: "a0"
+        <*> obj .: "rho"
+        <*> obj .: "tau"
+        <*> obj .: "decentralisationParam"
+        <*> obj .: "extraEntropy"
+        <*> obj .: "protocolVersion"
+        <*> obj .: "minPoolCost" .!= mempty
+        <*> obj .: "lovelacePerUTxOWord"
+        <*> obj .: "costmdls"
+        <*> obj .: "prices"
+        <*> obj .: "maxTxExUnits"
+        <*> obj .: "maxBlockExUnits"
+        <*> obj .: "maxValSize"
+        <*> obj .: "collateralPercentage"
+        <*> obj .: "maxCollateralInputs"
 
 deriving instance ToJSON (AlonzoPParamsUpdate era)
 

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

@@ -43,6 +43,7 @@ import Cardano.Ledger.Alonzo.Scripts
     CostModels (..),
     ExUnits (..),
     Prices (..),
+    getCostModelLanguage,
     getCostModelParams,
   )
 import Cardano.Ledger.BaseTypes
@@ -61,6 +62,7 @@ import Cardano.Ledger.Binary
     FromCBORGroup (..),
     ToCBOR (..),
     ToCBORGroup (..),
+    encodeFoldableAsDefLenList,
     encodeFoldableAsIndefLenList,
     encodeMapLen,
     encodeNull,
@@ -509,14 +511,19 @@ updatePParams pp ppup =
 data LangDepView = LangDepView {tag :: ByteString, params :: ByteString}
   deriving (Eq, Show, Ord, Generic, NoThunks)
 
--- In the Alonzo era, the map of languages to cost models was mistakenly encoded
--- using an indefinite CBOR map (contrary to canonical CBOR, as intended) when
--- computing the script integrity hash.
--- For this reason, PlutusV1 remains with this encoding.
--- Future versions of Plutus, starting with PlutusV2 in the Babbage era, will
--- use the intended definite length encoding.
-legacyNonCanonicalCostModelEncoder :: CostModel -> Encoding
-legacyNonCanonicalCostModelEncoder = encodeFoldableAsIndefLenList toCBOR . getCostModelParams
+encodeCostModel :: CostModel -> Encoding
+encodeCostModel cm =
+  case getCostModelLanguage cm of
+    -- In the Alonzo era, the map of languages to cost models was mistakenly encoded
+    -- using an indefinite CBOR map (contrary to canonical CBOR, as intended) when
+    -- computing the script integrity hash.
+    -- For this reason, PlutusV1 remains with this encoding.
+    -- Future versions of Plutus, starting with PlutusV2 in the Babbage era, will
+    -- use the intended definite length encoding.
+    PlutusV1 -> encodeFoldableAsIndefLenList toCBOR $ getCostModelParams cm
+    -- Since cost model serializations need to be independently reproduced,
+    -- we use the 'canonical' serialization with definite list length.
+    PlutusV2 -> encodeFoldableAsDefLenList toCBOR $ getCostModelParams cm
 
 getLanguageView ::
   forall era.
@@ -531,16 +538,14 @@ getLanguageView pp lang =
     PlutusV1 ->
       LangDepView -- The silly double bagging is to keep compatibility with a past bug
         (serialize' version (serialize' version lang))
-        ( serialize' version $
-            serializeEncoding' version $
-              maybe encodeNull legacyNonCanonicalCostModelEncoder costModel
-        )
+        (serialize' version costModelEncoding)
     PlutusV2 ->
       LangDepView
         (serialize' version lang)
-        (serializeEncoding' version $ maybe encodeNull toCBOR costModel)
+        costModelEncoding
   where
     costModel = Map.lookup lang (unCostModels $ getField @"_costmdls" pp)
+    costModelEncoding = serializeEncoding' version $ maybe encodeNull encodeCostModel costModel
     version = BT.pvMajor $ getField @"_protocolVersion" pp
 
 encodeLangViews :: Set LangDepView -> Encoding

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

@@ -30,13 +30,13 @@ module Cardano.Ledger.Alonzo.Scripts
     -- * Cost Model
     CostModel,
     mkCostModel,
+    encodeCostModel,
     getCostModelLanguage,
     getCostModelParams,
     getEvaluationContext,
     ExUnits (ExUnits, exUnitsMem, exUnitsSteps, ..),
     ExUnits',
     Prices (..),
-    hashCostModel,
     decodeCostModelMap,
     decodeCostModel,
     CostModels (..),
@@ -52,14 +52,14 @@ import Cardano.Ledger.Binary
   ( Annotator,
     Decoder,
     DecoderError (..),
+    Encoding,
     FromCBOR (fromCBOR),
     ToCBOR (toCBOR),
-    byronProtVer,
     cborError,
     decodeMapByKey,
     encodeFoldableAsDefLenList,
+    encodeMap,
     getVersion64,
-    serialize',
   )
 import Cardano.Ledger.Binary.Coders
   ( Decode (Ann, D, From, Invalid, RecD, SumD, Summands),
@@ -82,11 +82,7 @@ import Cardano.Ledger.Core
   )
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
-import Cardano.Ledger.SafeHash
-  ( HashWithCrypto (..),
-    SafeHash,
-    SafeToHash (..),
-  )
+import Cardano.Ledger.SafeHash (SafeToHash (..))
 import Cardano.Ledger.Shelley (nativeMultiSigTag)
 import Cardano.Ledger.ShelleyMA.Timelocks (Timelock)
 import qualified Cardano.Ledger.ShelleyMA.Timelocks as Timelocks
@@ -99,7 +95,7 @@ import Data.Either (isRight)
 import Data.Int (Int64)
 import Data.Map (Map)
 import Data.Measure (BoundedMeasure, Measure)
-import Data.Typeable (Proxy (..), Typeable)
+import Data.Typeable (Typeable)
 import Data.Word (Word64, Word8)
 import GHC.Generics (Generic)
 import NoThunks.Class (InspectHeapNamed (..), NoThunks)
@@ -267,20 +263,6 @@ instance Show CostModel where
 instance Ord CostModel where
   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 with definite list length.
-instance ToCBOR CostModel where
-  toCBOR (CostModel _ cm _) = encodeFoldableAsDefLenList toCBOR cm
-
--- See comment on the `ToCBOR` instance for the usage of byronProtVer
-instance SafeToHash CostModel where
-  originalBytes = serialize' byronProtVer
-
--- CostModel does not determine 'crypto' so make a HashWithCrypto
--- rather than a HashAnnotated instance.
-
-instance HashWithCrypto CostModel CostModel
-
 instance NoThunks CostModel
 
 instance NFData CostModel where
@@ -317,14 +299,6 @@ decodeCostModel lang = do
     Left e -> fail $ show e
     Right cm -> pure cm
 
-hashCostModel ::
-  forall e.
-  Era e =>
-  Proxy e ->
-  CostModel ->
-  SafeHash (EraCrypto e) CostModel
-hashCostModel _proxy = hashWithCrypto (Proxy @(EraCrypto e))
-
 getEvaluationContext :: CostModel -> PV1.EvaluationContext
 getEvaluationContext (CostModel _ _ ec) = ec
 
@@ -335,7 +309,12 @@ instance FromCBOR CostModels where
   fromCBOR = CostModels <$> decodeCostModelMap
 
 instance ToCBOR CostModels where
-  toCBOR = toCBOR . unCostModels
+  toCBOR = encodeMap toCBOR encodeCostModel . unCostModels
+
+-- | Encoding for the `CostModel`. Important to note that it differs from `Encoding` used
+-- by `Cardano.Ledger.Alonzo.PParams.getLanguageView`
+encodeCostModel :: CostModel -> Encoding
+encodeCostModel = encodeFoldableAsDefLenList toCBOR . getCostModelParams
 
 -- ==================================
 

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

@@ -71,6 +71,7 @@ import Cardano.Ledger.Alonzo.Scripts
   ( AlonzoScript (..),
     ExUnits (..),
     decodeCostModel,
+    encodeCostModel,
     getEvaluationContext,
     transProtocolVersion,
     validScript,
@@ -590,8 +591,10 @@ data PlutusDebugInfo
   | DebugBadHex String
 
 instance ToCBOR PlutusDebug where
-  toCBOR (PlutusDebugV1 a b c d e) = encode $ Sum PlutusDebugV1 0 !> To a !> To b !> To c !> To d !> To e
-  toCBOR (PlutusDebugV2 a b c d e) = encode $ Sum PlutusDebugV2 1 !> To a !> To b !> To c !> To d !> To e
+  toCBOR (PlutusDebugV1 a b c d e) =
+    encode $ Sum PlutusDebugV1 0 !> E encodeCostModel a !> To b !> To c !> To d !> To e
+  toCBOR (PlutusDebugV2 a b c d e) =
+    encode $ Sum PlutusDebugV2 1 !> E encodeCostModel a !> To b !> To c !> To d !> To e
 
 instance FromCBOR PlutusDebug where
   fromCBOR = decode (Summands "PlutusDebug" dec)