Review fixes for JSON output

cardano-api/cardano-api.cabal

@@ -27,6 +27,7 @@ library
                         Cardano.Api.Eras
                         Cardano.Api.LocalChainSync
                         Cardano.Api.Modes
+                        Cardano.Api.Orphans
                         Cardano.Api.Protocol
                         Cardano.Api.ProtocolParameters
                         Cardano.Api.Protocol.Byron
@@ -123,6 +124,7 @@ library
                       , scientific
                       , serialise
                       , shelley-spec-ledger
+                      , small-steps
                       , stm
                       , text
                       , time

cardano-api/src/Cardano/Api.hs

@@ -347,6 +347,7 @@ module Cardano.Api (
     deserialiseFromRawBytes,
     serialiseToRawBytesHex,
     deserialiseFromRawBytesHex,
+    serialiseToRawBytesHexText,
 
     -- ** Text envelope
     -- | Support for a envelope file format with text headers and a hex-encoded

cardano-api/src/Cardano/Api/Address.hs

@@ -354,7 +354,7 @@ instance IsCardanoEra era => SerialiseAsRawBytes (AddressInEra era) where
     serialiseToRawBytes (AddressInEra ShelleyAddressInEra{} addr) =
       serialiseToRawBytes addr
 
-    deserialiseFromRawBytes _ bs = do
+    deserialiseFromRawBytes _ bs =
       anyAddressInEra cardanoEra =<< deserialiseFromRawBytes AsAddressAny bs
 
 instance IsCardanoEra era => SerialiseAddress (AddressInEra era) where

cardano-api/src/Cardano/Api/Block.hs

@@ -46,7 +46,6 @@ import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
 import           Data.Foldable (Foldable (toList))
-import qualified Data.Text.Encoding as Text
 
 import           Cardano.Slotting.Block (BlockNo)
 import           Cardano.Slotting.Slot (EpochNo, SlotNo)
@@ -70,8 +69,8 @@ import qualified Cardano.Chain.UTxO as Byron
 import qualified Shelley.Spec.Ledger.BlockChain as Shelley
 
 import           Cardano.Api.Eras
-import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Hash
 import           Cardano.Api.Modes
 import           Cardano.Api.SerialiseRaw
 import           Cardano.Api.Tx
@@ -330,11 +329,11 @@ data ChainTip = ChainTipAtGenesis
   deriving (Eq, Show)
 
 instance ToJSON ChainTip where
-  toJSON ChainTipAtGenesis = Aeson.String "Tip is currently at genesis block"
+  toJSON ChainTipAtGenesis = Aeson.Null
   toJSON (ChainTip slot headerHash (Consensus.BlockNo bNum)) =
-    object [ "slotNo" .= slot
-           , "headerHash" .= Text.decodeUtf8 (serialiseToRawBytesHex headerHash)
-           , "blockNo" .= bNum
+    object [ "slot" .= slot
+           , "hash" .= serialiseToRawBytesHexText headerHash
+           , "block" .= bNum
            ]
 
 chainTipToChainPoint :: ChainTip -> ChainPoint

cardano-api/src/Cardano/Api/KeysByron.hs

@@ -100,7 +100,7 @@ instance Key ByronKey where
 
     newtype VerificationKey ByronKey =
            ByronVerificationKey Byron.VerificationKey
-      deriving stock (Eq)
+      deriving stock Eq
       deriving (Show, IsString) via UsingRawBytesHex (VerificationKey ByronKey)
       deriving newtype (ToCBOR, FromCBOR)
       deriving anyclass SerialiseAsCBOR

cardano-api/src/Cardano/Api/Orphans.hs

@@ -0,0 +1,245 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-# OPTIONS_GHC -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
+
+module Cardano.Api.Orphans () where
+
+import           Prelude
+
+import           Control.Iterate.SetAlgebra (BiMap (..), Bimap)
+import           Data.Aeson (ToJSON (..), object, (.=))
+import qualified Data.Aeson as Aeson
+import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
+import qualified Data.ByteString.Base16 as B16
+import qualified Data.Map.Strict as Map
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+
+import qualified Cardano.Crypto.Hash.Class as Crypto
+import qualified Cardano.Ledger.Core as Core
+import qualified Cardano.Ledger.Crypto as Crypto
+import qualified Cardano.Ledger.Mary.Value as Mary
+import           Cardano.Slotting.Slot (SlotNo (..))
+import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
+import qualified Shelley.Spec.Ledger.API as Shelley
+import           Shelley.Spec.Ledger.BaseTypes (StrictMaybe)
+import qualified Shelley.Spec.Ledger.Coin as Shelley
+import qualified Shelley.Spec.Ledger.Delegation.Certificates as Shelley
+import qualified Shelley.Spec.Ledger.EpochBoundary as ShelleyEpoch
+import qualified Shelley.Spec.Ledger.LedgerState as ShelleyLedger
+import qualified Shelley.Spec.Ledger.Rewards as Shelley
+
+-- Orphan instances involved in the JSON output of the API queries.
+-- We will remove/replace these as we provide more API wrapper types
+
+instance ToJSON (Mary.Value era) where
+  toJSON (Mary.Value l ps) =
+    object
+      [ "lovelace" .= toJSON l
+      , "policies" .= toJSON ps
+      ]
+
+instance ToJSONKey Mary.AssetName where
+  toJSONKey = toJSONKeyText render
+    where
+      render = Text.decodeLatin1 . B16.encode . Mary.assetName
+
+instance ToJSON (Mary.PolicyID era) where
+  toJSON (Mary.PolicyID (Shelley.ScriptHash h)) = Aeson.String (hashToText h)
+
+instance ToJSONKey (Mary.PolicyID era) where
+  toJSONKey = toJSONKeyText render
+    where
+      render (Mary.PolicyID (Shelley.ScriptHash h)) = hashToText h
+
+instance ToJSON Mary.AssetName where
+  toJSON = Aeson.String . Text.decodeLatin1 . B16.encode . Mary.assetName
+
+instance ToJSON Shelley.AccountState where
+  toJSON (Shelley.AccountState tr rs) = object [ "treasury" .= tr
+                                               , "reserves" .= rs
+                                               ]
+
+instance ( Consensus.ShelleyBasedEra era
+         , ToJSON (Core.TxOut era)
+         ) => ToJSON (Shelley.EpochState era) where
+  toJSON eState = object [ "esAccountState" .= Shelley.esAccountState eState
+                         , "esSnapshots" .= Shelley.esSnapshots eState
+                         , "esLState" .= Shelley.esLState eState
+                         , "esPrevPp" .= Shelley.esPrevPp eState
+                         , "esPp" .= Shelley.esPp eState
+                         , "esNonMyopic" .= Shelley.esNonMyopic eState
+                         ]
+
+instance ( Consensus.ShelleyBasedEra era
+         , ToJSON (Core.TxOut era)
+         ) => ToJSON (Shelley.LedgerState era) where
+  toJSON lState = object [ "utxoState" .= Shelley._utxoState lState
+                         , "delegationState" .= Shelley._delegationState lState
+                         ]
+
+instance ( Consensus.ShelleyBasedEra era
+         , ToJSON (Core.TxOut era)
+         ) => ToJSON (Shelley.UTxOState era) where
+  toJSON utxoState = object [ "utxo" .= Shelley._utxo utxoState
+                            , "deposited" .= Shelley._deposited utxoState
+                            , "fees" .= Shelley._fees utxoState
+                            , "ppups" .= Shelley._ppups utxoState
+                            ]
+
+instance ToJSON (Shelley.PPUPState era) where
+  toJSON ppUpState = object [ "proposals" .= Shelley.proposals ppUpState
+                            , "futureProposals" .= Shelley.futureProposals ppUpState
+                            ]
+
+instance ToJSON (Shelley.ProposedPPUpdates era) where
+  toJSON (Shelley.ProposedPPUpdates ppUpdates) = toJSON $ Map.toList ppUpdates
+
+instance ToJSON (Shelley.PParams' StrictMaybe era) where
+  toJSON pparams =
+    object [ "minfeeA" .= Shelley._minfeeA pparams
+           , "minfeeB" .= Shelley._minfeeB pparams
+           , "maxBBSize" .= Shelley._maxBBSize pparams
+           , "maxTxSize" .= Shelley._maxTxSize pparams
+           , "maxBHSize" .= Shelley._maxBHSize pparams
+           , "keyDeposit" .= Shelley._keyDeposit pparams
+           , "poolDeposit" .= Shelley._poolDeposit pparams
+           , "eMax" .= Shelley._eMax pparams
+           , "nOpt" .= Shelley._nOpt pparams
+           , "a0" .= Shelley._a0 pparams
+           , "rho" .= Shelley._rho pparams
+           , "tau" .= Shelley._tau pparams
+           , "d" .= Shelley._d pparams
+           , "extraEntropy" .= Shelley._extraEntropy pparams
+           , "protocolVersion" .= Shelley._protocolVersion pparams
+           , "minUTxOValue" .= Shelley._minUTxOValue pparams
+           , "minPoolCost" .= Shelley._minPoolCost pparams
+           ]
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.DPState crypto) where
+  toJSON dpState = object [ "dstate" .= Shelley._dstate dpState
+                          , "pstate" .= Shelley._pstate dpState
+                          ]
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.DState crypto) where
+  toJSON dState = object [ "rewards" .= Shelley._rewards dState
+                         , "delegations" .= ShelleyLedger._delegations dState
+                         , "ptrs" .= Shelley._ptrs dState
+                         , "fGenDelegs" .= Map.toList (Shelley._fGenDelegs dState)
+                         , "genDelegs" .= Shelley._genDelegs dState
+                         , "irwd" .= Shelley._irwd dState
+                         ]
+
+instance ToJSON (ShelleyLedger.FutureGenDeleg crypto) where
+  toJSON fGenDeleg =
+    object [ "fGenDelegSlot" .= ShelleyLedger.fGenDelegSlot fGenDeleg
+           , "fGenDelegGenKeyHash" .= ShelleyLedger.fGenDelegGenKeyHash fGenDeleg
+           ]
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.GenDelegs crypto) where
+  toJSON (Shelley.GenDelegs delegs) = toJSON delegs
+
+instance ToJSON (Shelley.InstantaneousRewards crypto) where
+  toJSON iRwds = object [ "iRReserves" .= Shelley.iRReserves iRwds
+                        , "iRTreasury" .= Shelley.iRTreasury iRwds
+                        ]
+
+instance ToJSON (Bimap Shelley.Ptr (Shelley.Credential Shelley.Staking crypto)) where
+  toJSON (MkBiMap ptsStakeM stakePtrSetM) =
+    object [ "stakedCreds" .= Map.toList ptsStakeM
+           , "credPtrR" .= toJSON stakePtrSetM
+           ]
+instance ToJSON Shelley.Ptr where
+  toJSON (Shelley.Ptr slotNo txIndex certIndex) =
+    object [ "slot" .= unSlotNo slotNo
+           , "txIndex" .= txIndex
+           , "certIndex" .= certIndex
+           ]
+
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.PState crypto) where
+  toJSON pState = object [ "pParams pState" .= Shelley._pParams pState
+                         , "fPParams pState" .= Shelley._fPParams pState
+                         , "retiring pState" .= Shelley._retiring pState
+                         ]
+
+instance ( Consensus.ShelleyBasedEra era
+         , ToJSON (Core.TxOut era)
+         ) => ToJSON (Shelley.UTxO era) where
+  toJSON (Shelley.UTxO utxo) = toJSON utxo
+
+instance ( Consensus.ShelleyBasedEra era
+         , ToJSON (Core.Value era)
+         ) => ToJSON (Shelley.TxOut era) where
+  toJSON (Shelley.TxOut addr amount) =
+    object
+      [ "address" .= addr
+      , "amount" .= amount
+      ]
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.TxIn crypto) where
+  toJSON = toJSON . txInToText
+
+instance Crypto.Crypto crypto => ToJSONKey (Shelley.TxIn crypto) where
+  toJSONKey = toJSONKeyText txInToText
+
+txInToText :: Crypto.Crypto crypto => Shelley.TxIn crypto -> Text
+txInToText (Shelley.TxIn (Shelley.TxId txidHash) ix) =
+  hashToText txidHash
+    <> Text.pack "#"
+    <> Text.pack (show ix)
+
+hashToText :: Crypto.Hash crypto a -> Text
+hashToText = Text.decodeLatin1 . Crypto.hashToBytesAsHex
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.NonMyopic crypto) where
+  toJSON nonMy = object [ "likelihoodsNM" .= Shelley.likelihoodsNM nonMy
+                        , "rewardPotNM" .= Shelley.rewardPotNM nonMy
+                        ]
+
+instance ToJSON Shelley.Likelihood where
+  toJSON (Shelley.Likelihood llhd) =
+    toJSON $ fmap (\(Shelley.LogWeight f) -> exp $ realToFrac f :: Double) llhd
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShots crypto) where
+  toJSON ss = object [ "pstakeMark" .= Shelley._pstakeMark ss
+                     , "pstakeSet" .= Shelley._pstakeSet ss
+                     , "pstakeGo" .= Shelley._pstakeGo ss
+                     , "feeSS" .= Shelley._feeSS ss
+                     ]
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.SnapShot crypto) where
+  toJSON ss = object [ "stake" .= Shelley._stake ss
+                     , "delegations" .= ShelleyEpoch._delegations ss
+                     , "poolParams" .= Shelley._poolParams ss
+                     ]
+
+instance ToJSON (Shelley.Stake crypto) where
+  toJSON (Shelley.Stake s) = toJSON s
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.RewardUpdate crypto) where
+  toJSON rUpdate = object [ "deltaT" .= Shelley.deltaT rUpdate
+                          , "deltaR" .= Shelley.deltaR rUpdate
+                          , "rs" .= Shelley.rs rUpdate
+                          , "deltaF" .= Shelley.deltaF rUpdate
+                          , "nonMyopic" .= Shelley.nonMyopic rUpdate
+                          ]
+
+instance ToJSON Shelley.DeltaCoin where
+  toJSON (Shelley.DeltaCoin i) = toJSON i
+
+instance Crypto.Crypto crypto => ToJSON (Shelley.PoolDistr crypto) where
+  toJSON (Shelley.PoolDistr m) = toJSON m
+
+instance ToJSON (Shelley.IndividualPoolStake crypto) where
+  toJSON indivPoolStake =
+    object [ "individualPoolStake" .= Shelley.individualPoolStake indivPoolStake
+           , "individualPoolStakeVrf" .= Shelley.individualPoolStakeVrf indivPoolStake
+           ]
+