diff --git a/eras/alonzo/impl/CHANGELOG.md b/eras/alonzo/impl/CHANGELOG.md index 73181c70d3f..3971c28e592 100644 --- a/eras/alonzo/impl/CHANGELOG.md +++ b/eras/alonzo/impl/CHANGELOG.md @@ -25,6 +25,7 @@ * Add `SpendingPurpose`, `MintingPurpose`, `CertifyingPurpose`, `RewardingPurpose` pattern synonyms. * Add `getSpendingScriptsNeeded`, `getRewardingScriptsNeeded`, `getMintingScriptsNeeded` * Add `zipAsIxItem` +* Modify `PParams` JSON instances to match `cardano-api` ### `testlib` diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index e8bc9021fb4..85591dbb214 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -137,7 +137,7 @@ import Data.Aeson as Aeson ( (.!=), (.:), ) -import qualified Data.Aeson as Aeson (Value) +import qualified Data.Aeson.Types as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Coerce (coerce) @@ -474,28 +474,28 @@ instance FromJSON (AlonzoPParams Identity era) where parseJSON = Aeson.withObject "PParams" $ \obj -> AlonzoPParams - <$> obj .: "minFeeA" - <*> obj .: "minFeeB" + <$> obj .: "txFeePerByte" + <*> obj .: "txFeeFixed" <*> 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 .: "stakeAddressDeposit" + <*> obj .: "stakePoolDeposit" + <*> obj .: "poolRetireMaxEpoch" + <*> obj .: "stakePoolTargetNum" + <*> obj .: "poolPledgeInfluence" + <*> obj .: "monetaryExpansion" + <*> obj .: "treasuryCut" + <*> obj .: "decentralization" + <*> obj .: "extraPraosEntropy" <*> obj .: "protocolVersion" <*> obj .: "minPoolCost" .!= mempty - <*> obj .: "lovelacePerUTxOWord" - <*> obj .: "costmdls" - <*> obj .: "prices" - <*> obj .: "maxTxExUnits" - <*> obj .: "maxBlockExUnits" - <*> obj .: "maxValSize" + <*> obj .: "utxoCostPerByte" + <*> obj .: "costModels" + <*> obj .: "executionUnitPrices" + <*> obj .: "maxTxExecutionUnits" + <*> obj .: "maxBlockExecutionUnits" + <*> obj .: "maxValueSize" <*> obj .: "collateralPercentage" <*> obj .: "maxCollateralInputs" @@ -730,7 +730,7 @@ alonzoPParamsHKDPairs px pp = alonzoCommonPParamsHKDPairs px pp ++ shelleyCommonPParamsHKDPairsV8 px pp ++ shelleyCommonPParamsHKDPairsV6 px pp - ++ [("lovelacePerUTxOWord", hkdMap px (toJSON @CoinPerWord) (pp ^. hkdCoinsPerUTxOWordL @_ @f))] + ++ [("utxoCostPerByte", hkdMap px (toJSON @CoinPerWord) (pp ^. hkdCoinsPerUTxOWordL @_ @f))] -- | These are the fields that are common across all eras starting with Alonzo. alonzoCommonPParamsHKDPairs :: @@ -741,11 +741,11 @@ alonzoCommonPParamsHKDPairs :: [(Key, HKD f Aeson.Value)] alonzoCommonPParamsHKDPairs px pp = shelleyCommonPParamsHKDPairs px pp - ++ [ ("costmdls", hkdMap px (toJSON @CostModels) (pp ^. hkdCostModelsL @era @f)) - , ("prices", hkdMap px (toJSON @Prices) (pp ^. hkdPricesL @era @f)) - , ("maxTxExUnits", hkdMap px (toJSON @ExUnits) (pp ^. hkdMaxTxExUnitsL @era @f)) - , ("maxBlockExUnits", hkdMap px (toJSON @ExUnits) (pp ^. hkdMaxBlockExUnitsL @era @f)) - , ("maxValSize", hkdMap px (toJSON @Natural) (pp ^. hkdMaxValSizeL @era @f)) + ++ [ ("costModels", hkdMap px (toJSON @CostModels) (pp ^. hkdCostModelsL @era @f)) + , ("executionUnitPrices", hkdMap px (toJSON @Prices) (pp ^. hkdPricesL @era @f)) + , ("maxTxExecutionUnits", hkdMap px (toJSON @ExUnits) (pp ^. hkdMaxTxExUnitsL @era @f)) + , ("maxBlockExecutionUnits", hkdMap px (toJSON @ExUnits) (pp ^. hkdMaxBlockExUnitsL @era @f)) + , ("maxValueSize", hkdMap px (toJSON @Natural) (pp ^. hkdMaxValSizeL @era @f)) , ("collateralPercentage", hkdMap px (toJSON @Natural) (pp ^. hkdCollateralPercentageL @era @f)) , ("maxCollateralInputs", hkdMap px (toJSON @Natural) (pp ^. hkdMaxCollateralInputsL @era @f)) ] diff --git a/eras/babbage/impl/CHANGELOG.md b/eras/babbage/impl/CHANGELOG.md index f58578b2481..d1394fb95d7 100644 --- a/eras/babbage/impl/CHANGELOG.md +++ b/eras/babbage/impl/CHANGELOG.md @@ -8,6 +8,7 @@ * Add `getReferenceScriptsNonDistinct` * Add the constructor `BabbageNonDisjointRefInputs` to `BabbageUtxoPredFailure` * Utxo rule raises that `PredicateFailure` in Conway and future Eras when they are not disjoint. +* Modify `PParams` JSON instances to match `cardano-api` ## 1.6.0.0 diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs index f1cfbddfc7f..45e7c3a2262 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs @@ -102,13 +102,13 @@ import Data.Aeson as Aeson ( Key, KeyValue ((.=)), ToJSON (..), + Value, object, pairs, withObject, (.!=), (.:), ) -import qualified Data.Aeson as Aeson (Value) import Data.Functor.Identity (Identity (..)) import Data.Proxy (Proxy (Proxy)) import Data.Word (Word16, Word32) @@ -356,26 +356,26 @@ instance FromJSON (BabbagePParams Identity era) where parseJSON = withObject "PParams" $ \obj -> BabbagePParams - <$> obj .: "minFeeA" - <*> obj .: "minFeeB" + <$> obj .: "txFeePerByte" + <*> obj .: "txFeeFixed" <*> obj .: "maxBlockBodySize" <*> obj .: "maxTxSize" <*> obj .: "maxBlockHeaderSize" - <*> obj .: "keyDeposit" - <*> obj .: "poolDeposit" - <*> obj .: "eMax" - <*> obj .: "nOpt" - <*> obj .: "a0" - <*> obj .: "rho" - <*> obj .: "tau" + <*> obj .: "stakeAddressDeposit" + <*> obj .: "stakePoolDeposit" + <*> obj .: "poolRetireMaxEpoch" + <*> obj .: "stakePoolTargetNum" + <*> obj .: "poolPledgeInfluence" + <*> obj .: "monetaryExpansion" + <*> obj .: "treasuryCut" <*> obj .: "protocolVersion" <*> obj .: "minPoolCost" .!= mempty - <*> obj .: "coinsPerUTxOByte" - <*> obj .: "costmdls" - <*> obj .: "prices" - <*> obj .: "maxTxExUnits" - <*> obj .: "maxBlockExUnits" - <*> obj .: "maxValSize" + <*> obj .: "utxoCostPerByte" + <*> obj .: "costModels" + <*> obj .: "executionUnitPrices" + <*> obj .: "maxTxExecutionUnits" + <*> obj .: "maxBlockExecutionUnits" + <*> obj .: "maxValueSize" <*> obj .: "collateralPercentage" <*> obj .: "maxCollateralInputs" @@ -550,7 +550,7 @@ babbageCommonPParamsHKDPairs :: [(Key, HKD f Aeson.Value)] babbageCommonPParamsHKDPairs px pp = alonzoCommonPParamsHKDPairs px pp - <> [("coinsPerUTxOByte", hkdMap px (toJSON @CoinPerByte) (pp ^. hkdCoinsPerUTxOByteL @_ @f))] + <> [("utxoCostPerByte", hkdMap px (toJSON @CoinPerByte) (pp ^. hkdCoinsPerUTxOByteL @_ @f))] upgradeBabbagePParams :: forall f c. diff --git a/eras/conway/impl/CHANGELOG.md b/eras/conway/impl/CHANGELOG.md index e488dd086b3..cc4f6a9fb21 100644 --- a/eras/conway/impl/CHANGELOG.md +++ b/eras/conway/impl/CHANGELOG.md @@ -60,6 +60,7 @@ * Add `TreeMaybe`, `toGovRelationTree` and `toGovRelationTreeEither` * Remove `proposalsAreConsistent` * Remove `registerDelegs` and `registerInitialDReps` +* Modify `PParams` JSON instances to match `cardano-api` ### `testlib` diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs index 0794455138e..4bc0c8439f1 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs @@ -840,28 +840,28 @@ conwayPParamsPairs pp = instance Era era => FromJSON (ConwayPParams Identity era) where parseJSON = - withObject "PParams" $ \obj -> + withObject "ProtocolParameters" $ \obj -> ConwayPParams - <$> obj .: "minFeeA" - <*> obj .: "minFeeB" + <$> obj .: "txFeePerByte" + <*> obj .: "txFeeFixed" <*> obj .: "maxBlockBodySize" <*> obj .: "maxTxSize" <*> obj .: "maxBlockHeaderSize" - <*> obj .: "keyDeposit" - <*> obj .: "poolDeposit" - <*> obj .: "eMax" - <*> obj .: "nOpt" - <*> obj .: "a0" - <*> obj .: "rho" - <*> obj .: "tau" + <*> obj .: "stakeAddressDeposit" + <*> obj .: "stakePoolDeposit" + <*> obj .: "poolRetireMaxEpoch" + <*> obj .: "stakePoolTargetNum" + <*> obj .: "poolPledgeInfluence" + <*> obj .: "monetaryExpansion" + <*> obj .: "treasuryCut" <*> obj .: "protocolVersion" <*> obj .: "minPoolCost" .!= mempty - <*> obj .: "coinsPerUTxOByte" - <*> obj .: "costmdls" - <*> obj .: "prices" - <*> obj .: "maxTxExUnits" - <*> obj .: "maxBlockExUnits" - <*> obj .: "maxValSize" + <*> obj .: "utxoCostPerByte" + <*> obj .: "costModels" + <*> obj .: "executionUnitPrices" + <*> obj .: "maxTxExecutionUnits" + <*> obj .: "maxBlockExecutionUnits" + <*> obj .: "maxValueSize" <*> obj .: "collateralPercentage" <*> obj .: "maxCollateralInputs" <*> obj .: "poolVotingThresholds" diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 5a4390d9c7f..93b0f3421ce 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -21,6 +21,8 @@ * Deprecate `RewardAcnt` in favor of `RewardAccount` * Remove `registerInitialFunds` and `registerInitialStaking` * Add `registerInitialFundsThenStaking` +* Modify `PParams` JSON instances to match `cardano-api` +* Add wrapper to `PParams` in `ShelleyGenesis` to preserve the legacy behaviour of JSON instances ### `testlib` diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs index ba015408db5..a55bc4fc9eb 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs @@ -50,6 +50,7 @@ import Cardano.Ledger.BaseTypes ( EpochSize (..), Globals (..), Network, + Nonce (..), PositiveUnitInterval, Version, mkActiveSlotCoeff, @@ -79,15 +80,17 @@ import Cardano.Ledger.Keys import Cardano.Ledger.PoolParams (PoolParams (..)) import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) import Cardano.Ledger.Shelley.Era (ShelleyEra) -import Cardano.Ledger.Shelley.PParams () +import Cardano.Ledger.Shelley.PParams (ShelleyPParams (..)) import Cardano.Ledger.Shelley.StabilityWindow import Cardano.Ledger.TxIn (TxId (..), TxIn (..)) import Cardano.Ledger.UTxO (UTxO (UTxO)) import qualified Cardano.Ledger.Val as Val import Cardano.Slotting.EpochInfo (EpochInfo) import Cardano.Slotting.Time (SystemStart (SystemStart)) -import Data.Aeson (FromJSON (..), ToJSON (..), (.!=), (.:), (.:?), (.=)) +import Control.Monad.Identity (Identity) +import Data.Aeson (FromJSON (..), ToJSON (..), object, (.!=), (.:), (.:?), (.=)) import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Parser, Value (..), typeMismatch) import Data.Fixed (Fixed (..), Micro, Pico) import qualified Data.ListMap as LM import Data.Map.Strict (Map) @@ -247,6 +250,105 @@ instance Crypto c => ToJSON (ShelleyGenesis c) where toJSON = Aeson.object . toShelleyGenesisPairs toEncoding = Aeson.pairs . mconcat . toShelleyGenesisPairs +-------------------------------------------------- +-- Legacy JSON representation of ShelleyGenesis -- +-------------------------------------------------- +newtype LegacyJSONPParams c = LegacyJSONPParams (PParamsHKD Identity (ShelleyEra c)) + +legacyFromJSONPParams :: LegacyJSONPParams c -> PParams (ShelleyEra c) +legacyFromJSONPParams (LegacyJSONPParams x) = PParams x + +instance FromJSON (LegacyJSONPParams c) where + parseJSON = + Aeson.withObject "ShelleyPParams" $ \obj -> do + LegacyJSONPParams + <$> ( ShelleyPParams + <$> 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" + <*> (parseNonce =<< (obj .: "extraEntropy")) + <*> obj .: "protocolVersion" + <*> obj .:? "minUTxOValue" .!= mempty + <*> obj .:? "minPoolCost" .!= mempty + ) + where + parseNonce :: Aeson.Value -> Parser Nonce + parseNonce = + Aeson.withObject + "Nonce" + ( \obj -> do + tag <- (obj .: "tag" :: Parser Text) + case tag of + "Nonce" -> Nonce <$> obj .: "contents" + "NeutralNonce" -> return NeutralNonce + _ -> typeMismatch "Nonce" (Object obj) + ) + +legacyToJSONPParams :: PParams (ShelleyEra c) -> LegacyJSONPParams c +legacyToJSONPParams (PParams x) = LegacyJSONPParams x + +instance ToJSON (LegacyJSONPParams c) where + toJSON + ( LegacyJSONPParams + ( ShelleyPParams + { sppMinFeeA + , sppMinFeeB + , sppMaxBBSize + , sppMaxTxSize + , sppMaxBHSize + , sppKeyDeposit + , sppPoolDeposit + , sppEMax + , sppNOpt + , sppA0 + , sppRho + , sppTau + , sppD + , sppExtraEntropy + , sppProtocolVersion + , sppMinUTxOValue + , sppMinPoolCost + } + ) + ) = + Aeson.object + [ "minFeeA" .= sppMinFeeA + , "minFeeB" .= sppMinFeeB + , "maxBlockBodySize" .= sppMaxBBSize + , "maxTxSize" .= sppMaxTxSize + , "maxBlockHeaderSize" .= sppMaxBHSize + , "keyDeposit" .= sppKeyDeposit + , "poolDeposit" .= sppPoolDeposit + , "eMax" .= sppEMax + , "nOpt" .= sppNOpt + , "a0" .= sppA0 + , "rho" .= sppRho + , "tau" .= sppTau + , "decentralisationParam" .= sppD + , "extraEntropy" + .= object + ( case sppExtraEntropy of + Nonce hash -> + [ "tag" .= ("Nonce" :: Text) + , "contents" .= hash + ] + NeutralNonce -> ["tag" .= ("NeutralNonce" :: Text)] + ) + , "protocolVersion" .= sppProtocolVersion + , "minUTxOValue" .= sppMinUTxOValue + , "minPoolCost" .= sppMinPoolCost + ] + toShelleyGenesisPairs :: (Aeson.KeyValue e a, Crypto c) => ShelleyGenesis c -> [a] toShelleyGenesisPairs ShelleyGenesis @@ -279,7 +381,7 @@ toShelleyGenesisPairs , "slotLength" .= sgSlotLength , "updateQuorum" .= sgUpdateQuorum , "maxLovelaceSupply" .= sgMaxLovelaceSupply - , "protocolParams" .= sgProtocolParams + , "protocolParams" .= legacyToJSONPParams sgProtocolParams , "genDelegs" .= sgGenDelegs , "initialFunds" .= strictSgInitialFunds , "staking" .= strictSgStaking @@ -300,7 +402,7 @@ instance Crypto c => FromJSON (ShelleyGenesis c) where <*> obj .: "slotLength" <*> obj .: "updateQuorum" <*> obj .: "maxLovelaceSupply" - <*> obj .: "protocolParams" + <*> (legacyFromJSONPParams <$> obj .: "protocolParams") <*> (forceElemsToWHNF <$> obj .: "genDelegs") <*> (forceElemsToWHNF <$> obj .: "initialFunds") -- TODO: disable. Move to EraTransition <*> obj .:? "staking" .!= emptyGenesisStaking -- TODO: remove. Move to EraTransition diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs index 6864660c6b9..1d37d30e0ea 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/PParams.hs @@ -256,26 +256,27 @@ shelleyPParamsPairs :: PParamsHKD Identity era -> [a] shelleyPParamsPairs pp = - uncurry (.=) <$> shelleyPParamsHKDPairs (Proxy @Identity) pp + uncurry (.=) + <$> shelleyPParamsHKDPairs (Proxy @Identity) pp instance FromJSON (ShelleyPParams Identity era) where parseJSON = - Aeson.withObject "ShelleyPParams" $ \obj -> + Aeson.withObject "ShelleyPParams" $ \obj -> do ShelleyPParams - <$> obj .: "minFeeA" - <*> obj .: "minFeeB" + <$> obj .: "txFeePerByte" + <*> obj .: "txFeeFixed" <*> 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 .: "stakeAddressDeposit" + <*> obj .: "stakePoolDeposit" + <*> obj .: "poolRetireMaxEpoch" + <*> obj .: "stakePoolTargetNum" + <*> obj .: "poolPledgeInfluence" + <*> obj .: "monetaryExpansion" + <*> obj .: "treasuryCut" + <*> obj .: "decentralization" + <*> obj .: "extraPraosEntropy" <*> obj .: "protocolVersion" <*> obj .:? "minUTxOValue" .!= mempty <*> obj .:? "minPoolCost" .!= mempty @@ -457,8 +458,8 @@ shelleyCommonPParamsHKDPairsV6 :: PParamsHKD f era -> [(Key, HKD f Aeson.Value)] shelleyCommonPParamsHKDPairsV6 px pp = - [ ("decentralisationParam", hkdMap px (toJSON @UnitInterval) (pp ^. hkdDL @era @f)) - , ("extraEntropy", hkdMap px (toJSON @Nonce) (pp ^. hkdExtraEntropyL @era @f)) + [ ("decentralization", hkdMap px (toJSON @UnitInterval) (pp ^. hkdDL @era @f)) + , ("extraPraosEntropy", hkdMap px (toJSON @Nonce) (pp ^. hkdExtraEntropyL @era @f)) ] shelleyCommonPParamsHKDPairsV8 :: @@ -479,18 +480,18 @@ shelleyCommonPParamsHKDPairs :: PParamsHKD f era -> [(Key, HKD f Aeson.Value)] shelleyCommonPParamsHKDPairs px pp = - [ ("minFeeA", hkdMap px (toJSON @Coin) (pp ^. hkdMinFeeAL @_ @f :: HKD f Coin)) - , ("minFeeB", hkdMap px (toJSON @Coin) (pp ^. hkdMinFeeBL @era @f)) + [ ("txFeePerByte", hkdMap px (toJSON @Coin) (pp ^. hkdMinFeeAL @_ @f :: HKD f Coin)) + , ("txFeeFixed", hkdMap px (toJSON @Coin) (pp ^. hkdMinFeeBL @era @f)) , ("maxBlockBodySize", hkdMap px (toJSON @Word32) (pp ^. hkdMaxBBSizeL @era @f)) , ("maxTxSize", hkdMap px (toJSON @Word32) (pp ^. hkdMaxTxSizeL @era @f)) , ("maxBlockHeaderSize", hkdMap px (toJSON @Word16) (pp ^. hkdMaxBHSizeL @era @f)) - , ("keyDeposit", hkdMap px (toJSON @Coin) (pp ^. hkdKeyDepositL @era @f)) - , ("poolDeposit", hkdMap px (toJSON @Coin) (pp ^. hkdPoolDepositL @era @f)) - , ("eMax", hkdMap px (toJSON @EpochInterval) (pp ^. hkdEMaxL @era @f)) - , ("nOpt", hkdMap px (toJSON @Natural) (pp ^. hkdNOptL @era @f)) - , ("a0", hkdMap px (toJSON @NonNegativeInterval) (pp ^. hkdA0L @era @f)) - , ("rho", hkdMap px (toJSON @UnitInterval) (pp ^. hkdRhoL @era @f)) - , ("tau", hkdMap px (toJSON @UnitInterval) (pp ^. hkdTauL @era @f)) + , ("stakeAddressDeposit", hkdMap px (toJSON @Coin) (pp ^. hkdKeyDepositL @era @f)) + , ("stakePoolDeposit", hkdMap px (toJSON @Coin) (pp ^. hkdPoolDepositL @era @f)) + , ("poolRetireMaxEpoch", hkdMap px (toJSON @EpochInterval) (pp ^. hkdEMaxL @era @f)) + , ("stakePoolTargetNum", hkdMap px (toJSON @Natural) (pp ^. hkdNOptL @era @f)) + , ("poolPledgeInfluence", hkdMap px (toJSON @NonNegativeInterval) (pp ^. hkdA0L @era @f)) + , ("monetaryExpansion", hkdMap px (toJSON @UnitInterval) (pp ^. hkdRhoL @era @f)) + , ("treasuryCut", hkdMap px (toJSON @UnitInterval) (pp ^. hkdTauL @era @f)) , ("minPoolCost", hkdMap px (toJSON @Coin) (pp ^. hkdMinPoolCostL @era @f)) ] diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 719d4508798..3e6b80a0595 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -27,6 +27,7 @@ * Deprecate `deserialiseRewardAcnt` in favor of `deserialiseRewardAccount` * Deprecate `serialiseRewardAcnt` in favor of `serialiseRewardAccount` * Deprecate `RewardAcnt` in favor of `RewardAccount` +* Modify `Prices` and `Nonce` JSON instances to match `cardano-api` ### `testlib` diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs index 0896c90ee80..8e6ba296e46 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs @@ -6,6 +6,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} @@ -338,11 +339,12 @@ instance Just u -> pure u instance Bounded (BoundedRatio b Word64) => ToJSON (BoundedRatio b Word64) where - toJSON = toRationalJSON . unboundRational + toJSON :: BoundedRatio b Word64 -> Value + toJSON br = case fromRationalRepetendLimited maxDecimalsWord64 r of + Right (s, Nothing) -> toJSON s + _ -> toJSON r where - toRationalJSON r = case fromRationalRepetendLimited maxDecimalsWord64 r of - Right (s, Nothing) -> toJSON s - _ -> toJSON r + r = unboundRational br instance Bounded (BoundedRatio b Word64) => FromJSON (BoundedRatio b Word64) where parseJSON = \case @@ -486,9 +488,13 @@ instance FromCBOR Nonce where pure (2, Nonce x) k -> invalidKey k -deriving anyclass instance ToJSON Nonce +instance ToJSON Nonce where + toJSON NeutralNonce = Null + toJSON (Nonce n) = toJSON n -deriving anyclass instance FromJSON Nonce +instance FromJSON Nonce where + parseJSON Null = return NeutralNonce + parseJSON x = Nonce <$> parseJSON x -- | Evolve the nonce (⭒) :: Nonce -> Nonce -> Nonce diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs index 06adbf64aed..0a507ef37ed 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/ExUnits.hs @@ -46,6 +46,7 @@ import Cardano.Ledger.Binary.Coders ( ()) import Control.DeepSeq (NFData (..)) import Control.Monad (when) import Data.Aeson ( @@ -108,14 +109,14 @@ instance ToJSON ExUnits where toJSON exUnits@(ExUnits _ _) = let ExUnits {exUnitsMem, exUnitsSteps} = exUnits in object - [ "exUnitsMem" .= toJSON exUnitsMem - , "exUnitsSteps" .= toJSON exUnitsSteps + [ "memory" .= toJSON exUnitsMem + , "steps" .= toJSON exUnitsSteps ] instance FromJSON ExUnits where parseJSON = withObject "exUnits" $ \o -> do - exUnitsMem <- checkWord64Bounds =<< o .: "exUnitsMem" - exUnitsSteps <- checkWord64Bounds =<< o .: "exUnitsSteps" + exUnitsMem <- checkWord64Bounds =<< (o .: "memory" <|> o .: "exUnitsMem") + exUnitsSteps <- checkWord64Bounds =<< (o .: "steps" <|> o .: "exUnitsSteps") pure $ ExUnits {exUnitsMem, exUnitsSteps} where checkWord64Bounds n = @@ -163,9 +164,19 @@ instance NoThunks Prices instance NFData Prices -instance ToJSON Prices - -instance FromJSON Prices +instance ToJSON Prices where + toJSON Prices {prSteps, prMem} = + object + [ "priceSteps" .= prSteps + , "priceMemory" .= prMem + ] + +instance FromJSON Prices where + parseJSON = + withObject "prices" $ \o -> do + prSteps <- o .: "priceSteps" <|> o .: "prSteps" + prMem <- o .: "priceMemory" <|> o .: "prMem" + return Prices {prSteps, prMem} -- | Compute the cost of a script based upon prices and the number of execution -- units.