Genesis rational simplification

IntersectMBO · Jul 30, 2021 · 6c978ec · 6c978ec
1 parent 144a8d6
commit 6c978ec
Show file tree

Hide file tree

Showing 4 changed files with 39 additions and 38 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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