Define ToPlutusData instance in ConwayEraPParams based on pparams

and substitute it for the existing one

Author: teodanciu

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

@@ -8,6 +8,7 @@
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -99,6 +100,7 @@ import Cardano.Ledger.BaseTypes (
   ProtVer (ProtVer),
   UnitInterval,
   integralToBounded,
+  strictMaybeToMaybe,
  )
 import Cardano.Ledger.Binary (
   DecCBOR (..),
@@ -131,8 +133,11 @@ import Control.DeepSeq (NFData (..), rwhnf)
 import Data.Aeson hiding (Encoding, Value, decode, encode)
 import qualified Data.Aeson as Aeson
 import Data.Default (Default (def))
+import Data.Foldable (foldlM)
 import Data.Functor.Identity (Identity)
+import qualified Data.IntMap as IntMap
 import qualified Data.Map.Strict as Map
+import Data.Maybe (mapMaybe)
 import Data.Maybe.Strict (StrictMaybe (..))
 import Data.Proxy
 import Data.Set (Set)
@@ -161,6 +166,30 @@ class BabbageEraPParams era => ConwayEraPParams era where
   hkdMinFeeRefScriptCostPerByteL ::
     HKDFunctor f => Lens' (PParamsHKD f era) (HKD f NonNegativeInterval)
 
+instance ConwayEraPParams era => ToPlutusData (PParamsUpdate era) where
+  toPlutusData ppu = P.Map $ mapMaybe ppToData (eraPParams @era)
+    where
+      ppToData PParam' {ppUpdate} = do
+        PParamUpdate {ppuTag, ppuLens} <- ppUpdate
+        t <- strictMaybeToMaybe $ ppu ^. ppuLens
+        pure (P.I (toInteger @Word ppuTag), toPlutusData t)
+
+  fromPlutusData (P.Map dataPairs) = foldlM accum emptyPParamsUpdate dataPairs
+    where
+      accum acc (dataKey, dataVal) = do
+        tag <- fromPlutusData @Word dataKey
+        PParam' {ppUpdate} <-
+          IntMap.lookup (fromIntegral tag) ppMap
+        PParamUpdate {ppuLens} <- ppUpdate
+        plutusData <- fromPlutusData dataVal
+        pure $ set ppuLens (SJust plutusData) acc
+      ppMap =
+        IntMap.fromList
+          [ (fromIntegral ppuTag, pp)
+          | pp@PParam' {ppUpdate = Just PParamUpdate {ppuTag}} <- eraPParams @era
+          ]
+  fromPlutusData _ = Nothing
+
 ppPoolVotingThresholdsL ::
   forall era. ConwayEraPParams era => Lens' (PParams era) PoolVotingThresholds
 ppPoolVotingThresholdsL = ppLensHKD . hkdPoolVotingThresholdsL @era @Identity

eras/conway/impl/src/Cardano/Ledger/Conway/Plutus/Context.hs

@@ -145,9 +145,7 @@ conwayPParam =
 -- given a ToPlutusData instance for PParamsUpdate
 
 class
-  ( ToPlutusData (PParamsUpdate era)
-  , EraPlutusTxInfo l era
-  ) =>
+  EraPlutusTxInfo l era =>
   ConwayEraPlutusTxInfo (l :: Language) era
   where
   toPlutusChangedParameters :: proxy l -> PParamsUpdate era -> PV3.ChangedParameters

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

@@ -81,9 +81,6 @@ import Cardano.Ledger.Conway.Governance (
  )
 import Cardano.Ledger.Conway.Plutus.Context (
   ConwayEraPlutusTxInfo (toPlutusChangedParameters),
-  conwayPParamMap,
-  pparamUpdateFromData,
-  pparamUpdateToData,
  )
 import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..), PlutusScript (..))
 import Cardano.Ledger.Conway.Tx ()
@@ -730,12 +727,5 @@ scriptPurposeToScriptInfo sp maybeSpendingData =
     PV3.Voting voter -> PV3.VotingScript voter
     PV3.Proposing ix proposal -> PV3.ProposingScript ix proposal
 
--- ==========================
--- Instances
-
-instance ToPlutusData (PParamsUpdate ConwayEra) where
-  toPlutusData = pparamUpdateToData conwayPParamMap
-  fromPlutusData = pparamUpdateFromData conwayPParamMap
-
 instance ConwayEraPlutusTxInfo 'PlutusV3 ConwayEra where
   toPlutusChangedParameters _ x = PV3.ChangedParameters (PV3.dataToBuiltinData (toPlutusData x))

libs/cardano-ledger-core/src/Cardano/Ledger/Core/PParams.hs

@@ -630,7 +630,7 @@ makePParamMap xs = Map.fromList [(n, p) | p@(PParam n _) <- xs]
 -- | Represents a single protocol parameter and the data required to serialize it.
 data PParam' era where
   PParam' ::
-    (DecCBOR t, EncCBOR t, FromJSON t, ToJSON t) =>
+    (DecCBOR t, EncCBOR t, FromJSON t, ToJSON t, ToPlutusData t) =>
     { ppName :: Text
     -- ^ Used as JSON key
     , ppLens :: Lens' (PParams era) t