Genesis rational simplification

IntersectMBO · Jul 30, 2021 · 56485ff · 56485ff
1 parent 144a8d6
commit 56485ff
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 17 deletions.
diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs
@@ -24,6 +24,7 @@ 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 qualified Data.Scientific as Scientific
 
 import           Control.Applicative
 import           Control.Iterate.SetAlgebra (BiMap (..), Bimap)
@@ -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
@@ -470,3 +471,15 @@ instance (Ledger.Era era, Show (Ledger.Value era), ToJSON (Ledger.Value era))
            ]
 
 deriving instance Show Alonzo.AlonzoGenesis
+
+-- 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
diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs
@@ -58,25 +58,21 @@ module Cardano.Api.ProtocolParameters (
 
 import           Prelude
 
-import           Control.Applicative
+import           Control.Monad
+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 qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash.Class as Crypto
@@ -285,16 +281,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 +300,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"
@@ -730,8 +723,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