Simplify Implementation of conwayApplyPPUpdates

Author: lehins

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

@@ -1120,64 +1120,58 @@ downgradeConwayPParams ConwayPParams {..} =
     , bppMaxCollateralInputs = asNaturalHKD @f @Word16 (unTHKD cppMaxCollateralInputs)
     }
 
+-- | Functionality for updating protocol parameters in Conway era. Worth noting that, unlike previous
+-- eras, `ProtocolVersion` can no longer be updated using this mechanism and `CostModels` update
+-- differs form other protocol parameters.
 conwayApplyPPUpdates ::
+  forall era.
   ConwayPParams Identity era ->
   ConwayPParams StrictMaybe era ->
   ConwayPParams Identity era
 conwayApplyPPUpdates pp ppu =
   ConwayPParams
-    { cppMinFeeA = ppUpdate (cppMinFeeA pp) (cppMinFeeA ppu)
-    , cppMinFeeB = ppUpdate (cppMinFeeB pp) (cppMinFeeB ppu)
-    , cppMaxBBSize = ppUpdate (cppMaxBBSize pp) (cppMaxBBSize ppu)
-    , cppMaxTxSize = ppUpdate (cppMaxTxSize pp) (cppMaxTxSize ppu)
-    , cppMaxBHSize = ppUpdate (cppMaxBHSize pp) (cppMaxBHSize ppu)
-    , cppKeyDeposit = ppUpdate (cppKeyDeposit pp) (cppKeyDeposit ppu)
-    , cppPoolDeposit = ppUpdate (cppPoolDeposit pp) (cppPoolDeposit ppu)
-    , cppEMax = ppUpdate (cppEMax pp) (cppEMax ppu)
-    , cppNOpt = ppUpdate (cppNOpt pp) (cppNOpt ppu)
-    , cppA0 = ppUpdate (cppA0 pp) (cppA0 ppu)
-    , cppRho = ppUpdate (cppRho pp) (cppRho ppu)
-    , cppTau = ppUpdate (cppTau pp) (cppTau ppu)
+    { cppMinFeeA = ppApplyUpdate cppMinFeeA
+    , cppMinFeeB = ppApplyUpdate cppMinFeeB
+    , cppMaxBBSize = ppApplyUpdate cppMaxBBSize
+    , cppMaxTxSize = ppApplyUpdate cppMaxTxSize
+    , cppMaxBHSize = ppApplyUpdate cppMaxBHSize
+    , cppKeyDeposit = ppApplyUpdate cppKeyDeposit
+    , cppPoolDeposit = ppApplyUpdate cppPoolDeposit
+    , cppEMax = ppApplyUpdate cppEMax
+    , cppNOpt = ppApplyUpdate cppNOpt
+    , cppA0 = ppApplyUpdate cppA0
+    , cppRho = ppApplyUpdate cppRho
+    , cppTau = ppApplyUpdate cppTau
     , cppProtocolVersion = cppProtocolVersion pp
-    , cppMinPoolCost = ppUpdate (cppMinPoolCost pp) (cppMinPoolCost ppu)
-    , cppCoinsPerUTxOByte = ppUpdate (cppCoinsPerUTxOByte pp) (cppCoinsPerUTxOByte ppu)
-    , cppCostModels = ppUpdateCostModels (cppCostModels pp) (cppCostModels ppu)
-    , cppPrices = ppUpdate (cppPrices pp) (cppPrices ppu)
-    , cppMaxTxExUnits = ppUpdate (cppMaxTxExUnits pp) (cppMaxTxExUnits ppu)
-    , cppMaxBlockExUnits = ppUpdate (cppMaxBlockExUnits pp) (cppMaxBlockExUnits ppu)
-    , cppMaxValSize = ppUpdate (cppMaxValSize pp) (cppMaxValSize ppu)
-    , cppCollateralPercentage = ppUpdate (cppCollateralPercentage pp) (cppCollateralPercentage ppu)
-    , cppMaxCollateralInputs = ppUpdate (cppMaxCollateralInputs pp) (cppMaxCollateralInputs ppu)
-    , cppPoolVotingThresholds = ppUpdate (cppPoolVotingThresholds pp) (cppPoolVotingThresholds ppu)
-    , cppDRepVotingThresholds = ppUpdate (cppDRepVotingThresholds pp) (cppDRepVotingThresholds ppu)
-    , cppCommitteeMinSize = ppUpdate (cppCommitteeMinSize pp) (cppCommitteeMinSize ppu)
-    , cppCommitteeMaxTermLength =
-        ppUpdate (cppCommitteeMaxTermLength pp) (cppCommitteeMaxTermLength ppu)
-    , cppGovActionLifetime = ppUpdate (cppGovActionLifetime pp) (cppGovActionLifetime ppu)
-    , cppGovActionDeposit = ppUpdate (cppGovActionDeposit pp) (cppGovActionDeposit ppu)
-    , cppDRepDeposit = ppUpdate (cppDRepDeposit pp) (cppDRepDeposit ppu)
-    , cppDRepActivity = ppUpdate (cppDRepActivity pp) (cppDRepActivity ppu)
-    , cppMinFeeRefScriptCostPerByte =
-        ppUpdate (cppMinFeeRefScriptCostPerByte pp) (cppMinFeeRefScriptCostPerByte ppu)
+    , cppMinPoolCost = ppApplyUpdate cppMinPoolCost
+    , cppCoinsPerUTxOByte = ppApplyUpdate cppCoinsPerUTxOByte
+    , cppCostModels =
+        case cppCostModels ppu of
+          THKD SNothing -> cppCostModels pp
+          THKD (SJust costModelUpdate) ->
+            THKD $ updateCostModels (unTHKD (cppCostModels pp)) costModelUpdate
+    , cppPrices = ppApplyUpdate cppPrices
+    , cppMaxTxExUnits = ppApplyUpdate cppMaxTxExUnits
+    , cppMaxBlockExUnits = ppApplyUpdate cppMaxBlockExUnits
+    , cppMaxValSize = ppApplyUpdate cppMaxValSize
+    , cppCollateralPercentage = ppApplyUpdate cppCollateralPercentage
+    , cppMaxCollateralInputs = ppApplyUpdate cppMaxCollateralInputs
+    , cppPoolVotingThresholds = ppApplyUpdate cppPoolVotingThresholds
+    , cppDRepVotingThresholds = ppApplyUpdate cppDRepVotingThresholds
+    , cppCommitteeMinSize = ppApplyUpdate cppCommitteeMinSize
+    , cppCommitteeMaxTermLength = ppApplyUpdate cppCommitteeMaxTermLength
+    , cppGovActionLifetime = ppApplyUpdate cppGovActionLifetime
+    , cppGovActionDeposit = ppApplyUpdate cppGovActionDeposit
+    , cppDRepDeposit = ppApplyUpdate cppDRepDeposit
+    , cppDRepActivity = ppApplyUpdate cppDRepActivity
+    , cppMinFeeRefScriptCostPerByte = ppApplyUpdate cppMinFeeRefScriptCostPerByte
     }
   where
-    ppUpdate ::
-      THKD f Identity a ->
-      THKD f StrictMaybe a ->
-      THKD f Identity a
-    ppUpdate (THKD ppCurValue) (THKD ppuValue) =
-      case ppuValue of
-        SNothing -> THKD ppCurValue
-        SJust ppNewValue -> THKD ppNewValue
-
-    ppUpdateCostModels ::
-      THKD f Identity CostModels ->
-      THKD f StrictMaybe CostModels ->
-      THKD f Identity CostModels
-    ppUpdateCostModels (THKD curCostModel) (THKD ppuCostModel) =
-      case ppuCostModel of
-        SNothing -> THKD curCostModel
-        SJust costModelUpdate -> THKD $ updateCostModels curCostModel costModelUpdate
+    ppApplyUpdate :: (forall f. ConwayPParams f era -> THKD g f a) -> THKD g Identity a
+    ppApplyUpdate cppGet =
+      case cppGet ppu of
+        THKD SNothing -> cppGet pp
+        THKD (SJust ppNewValue) -> THKD ppNewValue
 
 conwayModifiedPPGroups :: ConwayPParams StrictMaybe era -> Set PPGroups
 conwayModifiedPPGroups