From 4a7ee97367e0adb625f6ac61b7ccae51280cdb77 Mon Sep 17 00:00:00 2001 From: teodanciu Date: Tue, 17 Oct 2023 14:48:56 +0100 Subject: [PATCH] Adapt `toLedgerPParamsUpdate` to >=8 constraint in `ppuProtocolVersionL` --- .../Cardano/Api/ProtocolParameters.hs | 49 +++++++++++++------ 1 file changed, 33 insertions(+), 16 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index 9a27df20d9..94516964f9 100644 --- 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,10 +1280,9 @@ toLedgerPParamsUpdate ShelleyBasedEraConway = toConwayPParamsUpdate toShelleyCommonPParamsUpdate :: EraPParams ledgerera => ProtocolParametersUpdate - -> Either ProtocolParametersConversionError (PParamsUpdate ledgerera) + -> Either ProtocolParametersConversionError (Ledger.PParamsUpdate ledgerera) toShelleyCommonPParamsUpdate ProtocolParametersUpdate { - protocolUpdateProtocolVersion , protocolUpdateMaxBlockHeaderSize , protocolUpdateMaxBlockBodySize , protocolUpdateMaxTxSize @@ -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,7 +1319,6 @@ toShelleyCommonPParamsUpdate & ppuRhoL .~ noInlineMaybeToStrictMaybe rho & ppuTauL .~ noInlineMaybeToStrictMaybe tau - & ppuProtocolVersionL .~ noInlineMaybeToStrictMaybe protVer & ppuMinPoolCostL .~ (toShelleyLovelace <$> noInlineMaybeToStrictMaybe protocolUpdateMinPoolCost) pure ppuCommon @@ -1329,17 +1326,20 @@ toShelleyCommonPParamsUpdate 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 @@ -1347,12 +1347,13 @@ toShelleyPParamsUpdate (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