Adapt toLedgerPParamsUpdate to >=8 constraint in ppuProtocolVersionL

IntersectMBO · Oct 17, 2023 · 20bc444 · 20bc444
1 parent 951eeab
commit 20bc444
Showing 1 changed file with 34 additions and 17 deletions.
diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs
@@ -1269,7 +1269,7 @@ toLedgerProposedPPUpdates sbe m =
 
 toLedgerPParamsUpdate :: ShelleyBasedEra era
                       -> ProtocolParametersUpdate
-                      -> Either ProtocolParametersConversionError (PParamsUpdate (ShelleyLedgerEra era))
+                      -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate (ShelleyLedgerEra era))
 toLedgerPParamsUpdate ShelleyBasedEraShelley = toShelleyPParamsUpdate
 toLedgerPParamsUpdate ShelleyBasedEraAllegra = toShelleyPParamsUpdate
 toLedgerPParamsUpdate ShelleyBasedEraMary    = toShelleyPParamsUpdate
@@ -1280,11 +1280,10 @@ toLedgerPParamsUpdate ShelleyBasedEraConway  = toConwayPParamsUpdate
 
 toShelleyCommonPParamsUpdate :: EraPParams ledgerera
                              => ProtocolParametersUpdate
-                             -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
+                             -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera)
 toShelleyCommonPParamsUpdate
     ProtocolParametersUpdate {
-      protocolUpdateProtocolVersion
-    , protocolUpdateMaxBlockHeaderSize
+      protocolUpdateMaxBlockHeaderSize
     , protocolUpdateMaxBlockBodySize
     , protocolUpdateMaxTxSize
     , protocolUpdateTxFeeFixed
@@ -1301,7 +1300,6 @@ toShelleyCommonPParamsUpdate
   a0 <- mapM (boundRationalEither "A0") protocolUpdatePoolPledgeInfluence
   rho <- mapM (boundRationalEither "Rho") protocolUpdateMonetaryExpansion
   tau <- mapM (boundRationalEither "Tau") protocolUpdateTreasuryCut
-  protVer <- mapM mkProtVer protocolUpdateProtocolVersion
   let ppuCommon =
         emptyPParamsUpdate
         & ppuMinFeeAL     .~
@@ -1321,38 +1319,41 @@ toShelleyCommonPParamsUpdate
 
         & ppuRhoL         .~ noInlineMaybeToStrictMaybe rho
         & ppuTauL         .~ noInlineMaybeToStrictMaybe tau
-        & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer
         & ppuMinPoolCostL     .~
           (toShelleyLovelace <$> noInlineMaybeToStrictMaybe protocolUpdateMinPoolCost)
   pure ppuCommon
 
 toShelleyPParamsUpdate :: ( EraPParams ledgerera
                           , Ledger.AtMostEra Ledger.MaryEra ledgerera
                           , Ledger.AtMostEra Ledger.AlonzoEra ledgerera
+                          , Ledger.AtMostEra Ledger.BabbageEra ledgerera
                           )
                        => ProtocolParametersUpdate
-                       -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
+                       -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera)
 toShelleyPParamsUpdate
     protocolParametersUpdate@ProtocolParametersUpdate {
-      protocolUpdateDecentralization
+      protocolUpdateProtocolVersion
+    , protocolUpdateDecentralization
     , protocolUpdateExtraPraosEntropy
     , protocolUpdateMinUTxOValue
     } = do
   ppuCommon <- toShelleyCommonPParamsUpdate protocolParametersUpdate
   d <- mapM (boundRationalEither "D") protocolUpdateDecentralization
+  protVer <- mapM mkProtVer protocolUpdateProtocolVersion
   let ppuShelley =
         ppuCommon
         & ppuDL            .~ noInlineMaybeToStrictMaybe d
         & ppuExtraEntropyL .~
           (toLedgerNonce <$> noInlineMaybeToStrictMaybe protocolUpdateExtraPraosEntropy)
         & ppuMinUTxOValueL .~
           (toShelleyLovelace <$> noInlineMaybeToStrictMaybe protocolUpdateMinUTxOValue)
+        & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer
   pure ppuShelley
 
 
 toAlonzoCommonPParamsUpdate :: AlonzoEraPParams ledgerera
                             => ProtocolParametersUpdate
-                            -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
+                            -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera)
 toAlonzoCommonPParamsUpdate
     protocolParametersUpdate@ProtocolParametersUpdate {
       protocolUpdateCostModels
@@ -1385,27 +1386,29 @@ toAlonzoCommonPParamsUpdate
 
 toAlonzoPParamsUpdate :: Ledger.Crypto crypto
                       => ProtocolParametersUpdate
-                      -> Either ProtocolParametersConversionError (PParamsUpdate (Ledger.AlonzoEra crypto))
+                      -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate (Ledger.AlonzoEra crypto))
 toAlonzoPParamsUpdate
     protocolParametersUpdate@ProtocolParametersUpdate {
-      protocolUpdateDecentralization
+      protocolUpdateProtocolVersion
+    , protocolUpdateDecentralization
     , protocolUpdateUTxOCostPerWord
     } = do
   ppuAlonzoCommon <- toAlonzoCommonPParamsUpdate protocolParametersUpdate
   d <- mapM (boundRationalEither "D") protocolUpdateDecentralization
+  protVer <- mapM mkProtVer protocolUpdateProtocolVersion
   let ppuAlonzo =
         ppuAlonzoCommon
         & ppuDL .~ noInlineMaybeToStrictMaybe d
         & ppuCoinsPerUTxOWordL .~
           (CoinPerWord . toShelleyLovelace <$>
            noInlineMaybeToStrictMaybe protocolUpdateUTxOCostPerWord)
+        & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer
   pure ppuAlonzo
 
-
-toBabbagePParamsUpdate :: BabbageEraPParams ledgerera
-                       => ProtocolParametersUpdate
-                       -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
-toBabbagePParamsUpdate
+toBabbageCommonPParamsUpdate :: BabbageEraPParams ledgerera
+                            => ProtocolParametersUpdate
+                            -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera)
+toBabbageCommonPParamsUpdate
     protocolParametersUpdate@ProtocolParametersUpdate {
       protocolUpdateUTxOCostPerByte
     } = do
@@ -1417,6 +1420,20 @@ toBabbagePParamsUpdate
            noInlineMaybeToStrictMaybe protocolUpdateUTxOCostPerByte)
   pure ppuBabbage
 
+toBabbagePParamsUpdate :: Ledger.Crypto crypto
+                       => ProtocolParametersUpdate
+                       -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate (Ledger.BabbageEra crypto))
+toBabbagePParamsUpdate
+    protocolParametersUpdate@ProtocolParametersUpdate {
+      protocolUpdateProtocolVersion
+    } = do
+  ppuBabbageCommon <- toBabbageCommonPParamsUpdate protocolParametersUpdate
+  protVer <- mapM mkProtVer protocolUpdateProtocolVersion
+  let ppuBabbage =
+        ppuBabbageCommon
+        & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer
+  pure ppuBabbage
+
 requireParam :: String -> (a -> Either ProtocolParametersConversionError b) -> Maybe a -> Either ProtocolParametersConversionError b
 requireParam paramName = maybe (Left $ PpceMissingParameter paramName)
 
@@ -1434,7 +1451,7 @@ boundRationalEither name r = maybeToRight (PpceOutOfBounds name r) $ Ledger.boun
 toConwayPParamsUpdate :: BabbageEraPParams ledgerera
                       => ProtocolParametersUpdate
                       -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera)
-toConwayPParamsUpdate = toBabbagePParamsUpdate
+toConwayPParamsUpdate = toBabbageCommonPParamsUpdate
 
 -- ----------------------------------------------------------------------------
 -- Conversion functions: updates from ledger types