From 144a8d630c7fad27abc21a068c7f400859ae5e7d Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 30 Jul 2021 14:42:18 +1000 Subject: [PATCH 1/2] Parse decimals for rational fields in protocol parameters --- .../src/Cardano/Api/ProtocolParameters.hs | 49 +++++++++++-------- 1 file changed, 29 insertions(+), 20 deletions(-) diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index 77f9832d255..da544518746 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -5,6 +5,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | The various Cardano protocol parameters, including: @@ -57,11 +58,13 @@ module Cardano.Api.ProtocolParameters ( import Prelude +import Control.Applicative import Data.ByteString (ByteString) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.String (IsString) import qualified Data.Scientific as Scientific +import Data.Scientific (Scientific) import Data.Text (Text) import Data.Maybe (fromMaybe) import GHC.Generics @@ -71,6 +74,7 @@ import Control.Monad import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), (.=)) +import Data.Aeson.Types (Parser) import qualified Data.Aeson as Aeson import Data.Bifunctor (bimap) @@ -281,13 +285,16 @@ data ProtocolParameters = } deriving (Eq, Generic, Show) +parseRationalJSON :: Aeson.Value -> Parser Rational +parseRationalJSON v = parseJSON v <|> (toRational @Scientific <$> parseJSON v) + instance FromJSON ProtocolParameters where parseJSON = withObject "ProtocolParameters" $ \o -> do v <- o .: "protocolVersion" ProtocolParameters <$> ((,) <$> v .: "major" <*> v .: "minor") - <*> o .: "decentralization" + <*> (o .: "decentralization" >>= parseRationalJSON) <*> o .: "extraPraosEntropy" <*> o .: "maxBlockHeaderSize" <*> o .: "maxBlockBodySize" @@ -300,9 +307,9 @@ instance FromJSON ProtocolParameters where <*> o .: "minPoolCost" <*> o .: "poolRetireMaxEpoch" <*> o .: "stakePoolTargetNum" - <*> o .: "poolPledgeInfluence" - <*> o .: "monetaryExpansion" - <*> o .: "treasuryCut" + <*> (o .: "poolPledgeInfluence" >>= parseRationalJSON) + <*> (o .: "monetaryExpansion" >>= parseRationalJSON) + <*> (o .: "treasuryCut" >>= parseRationalJSON) <*> o .:? "utxoCostPerWord" <*> o .:? "costModels" .!= Map.empty <*> o .:? "executionUnitPrices" @@ -343,18 +350,18 @@ instance ToJSON ProtocolParameters where , "collateralPercentage" .= protocolParamCollateralPercent , "maxCollateralInputs" .= protocolParamMaxCollateralInputs ] - where - -- Rationals and JSON are an awkward mix. We cannot convert rationals - -- like @1/3@ to JSON numbers. But _most_ of the numbers we want to use - -- in practice have simple decimal representations. Our solution here is - -- to use simple decimal representations where we can and representation - -- in a @{"numerator": 1, "denominator": 3}@ style otherwise. - -- - toRationalJSON :: Rational -> Aeson.Value - toRationalJSON r = - case Scientific.fromRationalRepetend (Just 5) r of - Right (s, Nothing) -> toJSON s - _ -> toJSON r + +-- Rationals and JSON are an awkward mix. We cannot convert rationals +-- like @1/3@ to JSON numbers. But _most_ of the numbers we want to use +-- in practice have simple decimal representations. Our solution here is +-- to use simple decimal representations where we can and representation +-- in a @{"numerator": 1, "denominator": 3}@ style otherwise. +-- +toRationalJSON :: Rational -> Aeson.Value +toRationalJSON r = + case Scientific.fromRationalRepetend (Just 5) r of + Right (s, Nothing) -> toJSON s + _ -> toJSON r -- ---------------------------------------------------------------------------- @@ -475,6 +482,7 @@ data ProtocolParametersUpdate = -- This is the \"tau\" incentives parameter from the design document. -- protocolUpdateTreasuryCut :: Maybe Rational, + -- Introduced in Alonzo -- | Cost in ada per word of UTxO storage. @@ -714,15 +722,16 @@ instance FromCBOR ExecutionUnitPrices where instance ToJSON ExecutionUnitPrices where toJSON ExecutionUnitPrices{priceExecutionSteps, priceExecutionMemory} = - object [ "priceSteps" .= priceExecutionSteps - , "priceMemory" .= priceExecutionMemory ] + object [ "priceSteps" .= toRationalJSON priceExecutionSteps + , "priceMemory" .= toRationalJSON priceExecutionMemory + ] instance FromJSON ExecutionUnitPrices where parseJSON = withObject "ExecutionUnitPrices" $ \o -> ExecutionUnitPrices - <$> o .: "priceSteps" - <*> o .: "priceMemory" + <$> (o .: "priceSteps" >>= parseRationalJSON) + <*> (o .: "priceMemory" >>= parseRationalJSON) toAlonzoPrices :: ExecutionUnitPrices -> Maybe Alonzo.Prices From 6c978ec1d50dc8b19c696985d7d4903b4c111738 Mon Sep 17 00:00:00 2001 From: John Ky Date: Sat, 31 Jul 2021 01:11:02 +1000 Subject: [PATCH 2/2] Genesis rational simplification --- cardano-api/cardano-api.cabal | 1 + cardano-api/src/Cardano/Api/Json.hs | 21 +++++++++ cardano-api/src/Cardano/Api/Orphans.hs | 11 ++--- .../src/Cardano/Api/ProtocolParameters.hs | 44 +++++-------------- 4 files changed, 39 insertions(+), 38 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/Json.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 9a1ce6f9a15..4055010a1c9 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -62,6 +62,7 @@ library Cardano.Api.HasTypeProxy Cardano.Api.IPC Cardano.Api.IPC.Monad + Cardano.Api.Json Cardano.Api.Key Cardano.Api.KeysByron Cardano.Api.KeysPraos diff --git a/cardano-api/src/Cardano/Api/Json.hs b/cardano-api/src/Cardano/Api/Json.hs new file mode 100644 index 00000000000..4fdbf9d4de2 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Json.hs @@ -0,0 +1,21 @@ +module Cardano.Api.Json + ( toRationalJSON + ) where + +import Data.Aeson +import Data.Either +import Data.Maybe +import Data.Scientific +import GHC.Real + +-- Rationals and JSON are an awkward mix. We cannot convert rationals +-- like @1/3@ to JSON numbers. But _most_ of the numbers we want to use +-- in practice have simple decimal representations. Our solution here is +-- to use simple decimal representations where we can and representation +-- in a @{"numerator": 1, "denominator": 3}@ style otherwise. +-- +toRationalJSON :: Rational -> Value +toRationalJSON r = + case fromRationalRepetendLimited 20 r of + Right (s, Nothing) -> toJSON s + _ -> toJSON r diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs index fcecc2e0c96..3550879b73f 100644 --- a/cardano-api/src/Cardano/Api/Orphans.hs +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -16,18 +16,19 @@ module Cardano.Api.Orphans () where import Prelude +import Data.Aeson (FromJSON (..), ToJSON (..), object, (.=), (.!=), (.:), (.:?)) +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), toJSONKeyText) import qualified Data.ByteString.Base16 as B16 import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Map.Strict as Map -import Data.Aeson (FromJSON (..), ToJSON (..), object, (.=), (.!=), (.:), (.:?)) -import qualified Data.Aeson as Aeson -import Data.Aeson.Types (FromJSONKey (..), ToJSONKey (..), toJSONKeyText) import Control.Applicative import Control.Iterate.SetAlgebra (BiMap (..), Bimap) +import Cardano.Api.Json import qualified Cardano.Ledger.BaseTypes as Ledger import Cardano.Ledger.BaseTypes (StrictMaybe (..), strictMaybeToMaybe) import Cardano.Ledger.Crypto (StandardCrypto) @@ -302,8 +303,8 @@ deriving instance FromJSON Alonzo.ExUnits instance ToJSON Alonzo.Prices where toJSON Alonzo.Prices { Alonzo.prSteps, Alonzo.prMem } = -- We cannot round-trip via NonNegativeInterval, so we go via Rational - object [ "prSteps" .= Ledger.unboundRational prSteps - , "prMem" .= Ledger.unboundRational prMem + object [ "prSteps" .= toRationalJSON (Ledger.unboundRational prSteps) + , "prMem" .= toRationalJSON (Ledger.unboundRational prMem) ] instance FromJSON Alonzo.Prices where diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index da544518746..29af9224f21 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -5,7 +5,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | The various Cardano protocol parameters, including: @@ -58,26 +57,20 @@ module Cardano.Api.ProtocolParameters ( import Prelude -import Control.Applicative +import Control.Monad +import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, + (.!=), (.:), (.:?), (.=)) +import Data.Bifunctor (bimap) import Data.ByteString (ByteString) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.String (IsString) -import qualified Data.Scientific as Scientific -import Data.Scientific (Scientific) import Data.Text (Text) import Data.Maybe (fromMaybe) import GHC.Generics import Numeric.Natural -import Control.Monad - -import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, - (.!=), (.:), (.:?), (.=)) -import Data.Aeson.Types (Parser) -import qualified Data.Aeson as Aeson -import Data.Bifunctor (bimap) - +import Cardano.Api.Json import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Slotting.Slot (EpochNo) @@ -285,16 +278,13 @@ data ProtocolParameters = } deriving (Eq, Generic, Show) -parseRationalJSON :: Aeson.Value -> Parser Rational -parseRationalJSON v = parseJSON v <|> (toRational @Scientific <$> parseJSON v) - instance FromJSON ProtocolParameters where parseJSON = withObject "ProtocolParameters" $ \o -> do v <- o .: "protocolVersion" ProtocolParameters <$> ((,) <$> v .: "major" <*> v .: "minor") - <*> (o .: "decentralization" >>= parseRationalJSON) + <*> o .: "decentralization" <*> o .: "extraPraosEntropy" <*> o .: "maxBlockHeaderSize" <*> o .: "maxBlockBodySize" @@ -307,9 +297,9 @@ instance FromJSON ProtocolParameters where <*> o .: "minPoolCost" <*> o .: "poolRetireMaxEpoch" <*> o .: "stakePoolTargetNum" - <*> (o .: "poolPledgeInfluence" >>= parseRationalJSON) - <*> (o .: "monetaryExpansion" >>= parseRationalJSON) - <*> (o .: "treasuryCut" >>= parseRationalJSON) + <*> o .: "poolPledgeInfluence" + <*> o .: "monetaryExpansion" + <*> o .: "treasuryCut" <*> o .:? "utxoCostPerWord" <*> o .:? "costModels" .!= Map.empty <*> o .:? "executionUnitPrices" @@ -351,18 +341,6 @@ instance ToJSON ProtocolParameters where , "maxCollateralInputs" .= protocolParamMaxCollateralInputs ] --- Rationals and JSON are an awkward mix. We cannot convert rationals --- like @1/3@ to JSON numbers. But _most_ of the numbers we want to use --- in practice have simple decimal representations. Our solution here is --- to use simple decimal representations where we can and representation --- in a @{"numerator": 1, "denominator": 3}@ style otherwise. --- -toRationalJSON :: Rational -> Aeson.Value -toRationalJSON r = - case Scientific.fromRationalRepetend (Just 5) r of - Right (s, Nothing) -> toJSON s - _ -> toJSON r - -- ---------------------------------------------------------------------------- -- Updates to the protocol paramaters @@ -730,8 +708,8 @@ instance FromJSON ExecutionUnitPrices where parseJSON = withObject "ExecutionUnitPrices" $ \o -> ExecutionUnitPrices - <$> (o .: "priceSteps" >>= parseRationalJSON) - <*> (o .: "priceMemory" >>= parseRationalJSON) + <$> o .: "priceSteps" + <*> o .: "priceMemory" toAlonzoPrices :: ExecutionUnitPrices -> Maybe Alonzo.Prices