Skip to content

Commit

Permalink
Review fixes
Browse files Browse the repository at this point in the history
  • Loading branch information
@Jimbo4350
Jimbo4350 committed Feb 5, 2021
1 parent e3f8b18 commit ef64b98
Show file tree
Hide file tree
Showing 10 changed files with 350 additions and 174 deletions.
2 changes: 2 additions & 0 deletions cardano-api/cardano-api.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -123,6 +124,7 @@ library
, scientific
, serialise
, shelley-spec-ledger
, small-steps
, stm
, text
, time
Expand Down
8 changes: 4 additions & 4 deletions cardano-api/src/Cardano/Api/Block.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -330,11 +330,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" .= Text.decodeUtf8 (serialiseToRawBytesHex headerHash)
, "block" .= bNum
]

chainTipToChainPoint :: ChainTip -> ChainPoint
Expand Down
245 changes: 245 additions & 0 deletions cardano-api/src/Cardano/Api/Orphans.hs
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,245 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DataKinds #-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Cardano.Api.Orphans () where

import Prelude

import Data.Aeson.Types (toJSONKeyText)
import qualified Data.Aeson as Aeson
import Data.Aeson (ToJSON(..), (.=), object)
import Control.Iterate.SetAlgebra (Bimap, BiMap(..))
import Data.Aeson.Types (ToJSONKey (..))
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Text (Text)
import qualified Data.ByteString.Base16 as B16
import qualified Data.Map.Strict as Map

import qualified Shelley.Spec.Ledger.API as Shelley
import qualified Shelley.Spec.Ledger.Rewards as Shelley
import Cardano.Slotting.Slot (SlotNo(..))
import qualified Cardano.Ledger.Mary.Value as Mary
import qualified Shelley.Spec.Ledger.LedgerState as ShelleyLedger
import qualified Shelley.Spec.Ledger.EpochBoundary as ShelleyEpoch
import qualified Shelley.Spec.Ledger.Coin as Shelley
import Shelley.Spec.Ledger.BaseTypes (StrictMaybe)
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Ouroboros.Consensus.Shelley.Eras as Consensus
import qualified Shelley.Spec.Ledger.Delegation.Certificates as Shelley
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as Crypto

-- 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
]
Loading

0 comments on commit ef64b98

Please sign in to comment.