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)