From e6414578b1ecab1cba46f47abd5f5070c4a78490 Mon Sep 17 00:00:00 2001
From: John Ky <john.ky@iohk.io>
Date: Fri, 30 Jul 2021 15:40:41 +1000
Subject: [PATCH] Genesis rational simplification

---
 cardano-api/src/Cardano/Api/Orphans.hs | 28 +++++++++++++++++++++-----
 1 file changed, 23 insertions(+), 5 deletions(-)

diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs
index fcecc2e0c96..0bbd573fad1 100644
--- a/cardano-api/src/Cardano/Api/Orphans.hs
+++ b/cardano-api/src/Cardano/Api/Orphans.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
@@ -23,7 +24,9 @@ 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           Data.Aeson.Types (Parser, FromJSONKey (..), ToJSONKey (..), toJSONKeyText)
+import           Data.Scientific (Scientific)
+import qualified Data.Scientific as Scientific
 
 import           Control.Applicative
 import           Control.Iterate.SetAlgebra (BiMap (..), Bimap)
@@ -302,15 +305,15 @@ 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
   parseJSON =
     Aeson.withObject "prices" $ \o -> do
-      steps <- o .: "prSteps"
-      mem   <- o .: "prMem"
+      steps <- o .: "prSteps" >>= parseRationalJSON
+      mem   <- o .: "prMem" >>= parseRationalJSON
       prSteps <- checkBoundedRational steps
       prMem   <- checkBoundedRational mem
       return Alonzo.Prices { Alonzo.prSteps, Alonzo.prMem }
@@ -470,3 +473,18 @@ 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
+
+parseRationalJSON :: Aeson.Value -> Parser Rational
+parseRationalJSON v = parseJSON v <|> (toRational @Scientific <$> parseJSON v)