From ef64b9863b97cda80a6e6a9e66dfcf005c820bc2 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 3 Feb 2021 11:49:51 +0000 Subject: [PATCH] Review fixes --- cardano-api/cardano-api.cabal | 2 + cardano-api/src/Cardano/Api/Block.hs | 8 +- cardano-api/src/Cardano/Api/Orphans.hs | 245 ++++++++++++++++++ cardano-api/src/Cardano/Api/Query.hs | 77 ++++-- cardano-api/src/Cardano/Api/TxBody.hs | 29 ++- .../src/Cardano/CLI/Shelley/Orphans.hs | 96 +------ .../src/Cardano/CLI/Shelley/Run/Query.hs | 30 +-- .../src/Cardano/Node/Protocol/Cardano.hs | 1 + .../src/Cardano/Node/Protocol/Shelley.hs | 1 + .../Tracing/OrphanInstances/Shelley.hs | 35 +-- 10 files changed, 350 insertions(+), 174 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/Orphans.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 6320dd73f4d..2ad5e114f5e 100644 --- a/cardano-api/cardano-api.cabal +++ b/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 diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index ada6632f685..40238a53180 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/cardano-api/src/Cardano/Api/Block.hs @@ -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 diff --git a/cardano-api/src/Cardano/Api/Orphans.hs b/cardano-api/src/Cardano/Api/Orphans.hs new file mode 100644 index 00000000000..df327777730 --- /dev/null +++ b/cardano-api/src/Cardano/Api/Orphans.hs @@ -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 + ] \ No newline at end of file diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index 165f34e3586..b0e5c32d48c 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -1,10 +1,13 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyCase #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} -- The Shelley ledger uses promoted data kinds which we have to use, but we do -- not export any from this API. We also use them unticked as nature intended. @@ -27,8 +30,10 @@ module Cardano.Api.Query ( fromConsensusQueryResult, -- * Wrapper types used in queries - LedgerState(..), + SerialisedLedgerState(..), ProtocolState(..), + + LedgerState(..), ) where import Data.Aeson (ToJSON(..), object, (.=)) @@ -38,9 +43,9 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (mapMaybe) import Data.Set (Set) -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text +import Data.Text (Text) import qualified Data.Set as Set +import Data.Typeable import Data.SOP.Strict (SListI) import Prelude import qualified Data.Vector as Vector @@ -59,8 +64,8 @@ import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus import Ouroboros.Network.Block (Serialised) import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update - import qualified Cardano.Ledger.Era as Ledger +import Cardano.Binary import qualified Shelley.Spec.Ledger.API as Shelley import qualified Shelley.Spec.Ledger.LedgerState as Shelley @@ -68,12 +73,18 @@ import qualified Shelley.Spec.Ledger.LedgerState as Shelley import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Certificate -import Cardano.Api.SerialiseRaw import Cardano.Api.Eras import Cardano.Api.KeysShelley import Cardano.Api.Modes import Cardano.Api.NetworkId -import Cardano.Api.ProtocolParameters +import Cardano.Api.Orphans () +import Cardano.Api.ProtocolParameters + ( GenesisParameters, + ProtocolParametersUpdate, + ProtocolParameters, + fromShelleyProposedPPUpdates, + fromShelleyPParams, + fromShelleyGenesis ) import Cardano.Api.TxBody import Cardano.Api.Value @@ -145,7 +156,7 @@ data QueryInShelleyBasedEra era result where -- :: QueryInShelleyBasedEra era RewardProvenance QueryLedgerState - :: QueryInShelleyBasedEra era (LedgerState era) + :: QueryInShelleyBasedEra era (SerialisedLedgerState era) QueryProtocolState :: QueryInShelleyBasedEra era (ProtocolState era) @@ -166,17 +177,51 @@ newtype UTxO era = UTxO (Map TxIn (TxOut era)) instance IsCardanoEra era => ToJSON (UTxO era) where toJSON (UTxO m) = Aeson.Array . Vector.fromList . map convert $ Map.toList m where + toText :: TxIn -> Text + toText txin = case toJSON txin of + Aeson.String txt -> txt + _ -> error "failure" convert :: (TxIn, TxOut era) -> Aeson.Value - convert ((TxIn txId (TxIx ix), txout)) = - let txin = ( Text.decodeUtf8 (serialiseToRawBytesHex txId) - <> "#" - <> Text.pack (show ix) - ) - in object [ txin .= toJSON txout] + convert (txin, txout) = object [ toText txin .= toJSON txout] + + +newtype SerialisedLedgerState era + = SerialisedLedgerState (Serialised (Shelley.NewEpochState (ShelleyLedgerEra era))) + +data LedgerState era where + LedgerState :: ShelleyLedgerEra era ~ ledgerera => Shelley.NewEpochState ledgerera -> LedgerState era + +instance (Typeable era, Shelley.TransLedgerState FromCBOR (ShelleyLedgerEra era)) => FromCBOR (LedgerState era) where + fromCBOR = LedgerState <$> (fromCBOR :: Decoder s (Shelley.NewEpochState (ShelleyLedgerEra era))) + +instance ToJSON (LedgerState ShelleyEra) where + toJSON (LedgerState newEpochS) = object [ "lastEpoch" .= Shelley.nesEL newEpochS + , "blocksBefore" .= Shelley.nesBprev newEpochS + , "blocksCurrent" .= Shelley.nesBcur newEpochS + , "stateBefore" .= Shelley.nesEs newEpochS + , "possibleRewardUpdate" .= Shelley.nesRu newEpochS + , "stakeDistrib" .= Shelley.nesPd newEpochS + ] + +instance ToJSON (LedgerState AllegraEra) where + toJSON (LedgerState newEpochS) = object [ "lastEpoch" .= Shelley.nesEL newEpochS + , "blocksBefore" .= Shelley.nesBprev newEpochS + , "blocksCurrent" .= Shelley.nesBcur newEpochS + , "stateBefore" .= Shelley.nesEs newEpochS + , "possibleRewardUpdate" .= Shelley.nesRu newEpochS + , "stakeDistrib" .= Shelley.nesPd newEpochS + ] + +instance ToJSON (LedgerState MaryEra) where + toJSON (LedgerState newEpochS) = object [ "lastEpoch" .= Shelley.nesEL newEpochS + , "blocksBefore" .= Shelley.nesBprev newEpochS + , "blocksCurrent" .= Shelley.nesBcur newEpochS + , "stateBefore" .= Shelley.nesEs newEpochS + , "possibleRewardUpdate" .= Shelley.nesRu newEpochS + , "stakeDistrib" .= Shelley.nesPd newEpochS + ] -newtype LedgerState era - = LedgerState (Serialised (Shelley.NewEpochState (ShelleyLedgerEra era))) newtype ProtocolState era = ProtocolState (Serialised (Shelley.ChainDepState (Ledger.Crypto (ShelleyLedgerEra era)))) @@ -470,7 +515,7 @@ fromConsensusQueryResultShelleyBased _ (QueryStakeAddresses _ nId) q' r' = fromConsensusQueryResultShelleyBased _ QueryLedgerState{} q' r' = case q' of - Consensus.GetCBOR Consensus.DebugNewEpochState -> LedgerState r' + Consensus.GetCBOR Consensus.DebugNewEpochState -> SerialisedLedgerState r' _ -> fromConsensusQueryResultMismatch fromConsensusQueryResultShelleyBased _ QueryProtocolState q' r' = diff --git a/cardano-api/src/Cardano/Api/TxBody.hs b/cardano-api/src/Cardano/Api/TxBody.hs index 4166ef5459c..ad3abdeb322 100644 --- a/cardano-api/src/Cardano/Api/TxBody.hs +++ b/cardano-api/src/Cardano/Api/TxBody.hs @@ -175,7 +175,8 @@ newtype TxId = TxId (Shelley.Hash StandardCrypto Shelley.EraIndependentTxBody) deriving newtype (IsString) -- We use the Shelley representation and convert the Byron one -deriving newtype instance ToJSON TxId +instance ToJSON TxId where + toJSON = Aeson.String . Text.decodeUtf8 . serialiseToRawBytesHex instance HasTypeProxy TxId where data AsType TxId = AsTxId @@ -232,7 +233,14 @@ getTxId (ShelleyTxBody era tx _) = -- data TxIn = TxIn TxId TxIx - deriving (Eq, Generic, Ord, Show) + deriving (Eq, Ord, Show) + +instance ToJSON TxIn where + toJSON (TxIn txId (TxIx ix)) = + Aeson.String ( Text.decodeUtf8 (serialiseToRawBytesHex txId) + <> "#" + <> Text.pack (show ix) + ) newtype TxIx = TxIx Word deriving stock (Eq, Ord, Show) @@ -278,13 +286,19 @@ instance IsCardanoEra era => ToJSON (TxOut era) where case sbe of ShelleyBasedEraShelley -> let hexAddr = Text.decodeUtf8 $ serialiseToRawBytesHex addr - in object [ hexAddr .= toJSON val ] + in object [ "address" .= hexAddr + , "value" .= toJSON val + ] ShelleyBasedEraAllegra -> let hexAddr = Text.decodeUtf8 $ serialiseToRawBytesHex addr - in object [ hexAddr .= toJSON val ] + in object [ "address" .= hexAddr + , "value" .= toJSON val + ] ShelleyBasedEraMary -> let hexAddr = Text.decodeUtf8 $ serialiseToRawBytesHex addr - in object [ hexAddr .= toJSON val ] + in object [ "address" .= hexAddr + , "value" .= toJSON val + ] @@ -381,9 +395,6 @@ data OnlyAdaSupportedInEra era where deriving instance Eq (OnlyAdaSupportedInEra era) deriving instance Show (OnlyAdaSupportedInEra era) -instance ToJSON (OnlyAdaSupportedInEra era) where - toJSON = Aeson.String . Text.pack . show - multiAssetSupportedInEra :: CardanoEra era -> Either (OnlyAdaSupportedInEra era) (MultiAssetSupportedInEra era) @@ -629,7 +640,7 @@ deriving instance Show (TxOutValue era) deriving instance Generic (TxOutValue era) instance ToJSON (TxOutValue era) where - toJSON (TxOutAdaOnly _ (Lovelace int)) = Aeson.Number $ fromInteger int + toJSON (TxOutAdaOnly _ ll) = toJSON ll toJSON (TxOutValue _ val) = toJSON val -- ---------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs index d9699a64f20..9652a5399a9 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs @@ -17,66 +17,34 @@ import Cardano.Prelude import Control.SetAlgebra as SetAlgebra import Data.Aeson -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Encoding as Aeson import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Short as SBS -import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import Cardano.Api.Orphans () + import Cardano.Crypto.Hash.Class as Crypto import Ouroboros.Consensus.Byron.Ledger.Block (ByronHash (..)) import Ouroboros.Consensus.HardFork.Combinator (OneEraHash (..)) import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyHash (..)) -import Ouroboros.Consensus.Shelley.Eras - (ShelleyBasedEra, StandardCrypto, - StandardShelley, StandardAllegra, StandardMary) +import Ouroboros.Consensus.Shelley.Eras (StandardCrypto) import Ouroboros.Network.Block (BlockNo (..), HeaderHash, Tip (..)) import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..)) -import qualified Cardano.Ledger.Era as Ledger -import qualified Cardano.Ledger.Core as Core import qualified Shelley.Spec.Ledger.API.Protocol as Ledger -import Shelley.Spec.Ledger.BaseTypes (StrictMaybe) import Shelley.Spec.Ledger.BlockChain (HashHeader (..)) -import Shelley.Spec.Ledger.Coin (DeltaCoin (..)) import qualified Shelley.Spec.Ledger.Credential as Ledger import qualified Shelley.Spec.Ledger.Delegation.Certificates as Ledger import qualified Shelley.Spec.Ledger.EpochBoundary as Ledger -import qualified Shelley.Spec.Ledger.Keys as Ledger -import qualified Shelley.Spec.Ledger.LedgerState as Ledger -import qualified Shelley.Spec.Ledger.PParams as Ledger import qualified Shelley.Spec.Ledger.Rewards as Ledger import qualified Shelley.Spec.Ledger.STS.Prtcl as Ledger import qualified Shelley.Spec.Ledger.STS.Tickn as Ledger -import Shelley.Spec.Ledger.TxBody (TxId (..), TxIn (..), TxOut (..)) -import Shelley.Spec.Ledger.UTxO (UTxO (..)) +import Shelley.Spec.Ledger.TxBody (TxId (..)) import qualified Cardano.Ledger.Mary.Value as Ledger.Mary -instance ToJSONKey (TxIn StandardCrypto) where - toJSONKey = ToJSONKeyText txInToText (Aeson.text . txInToText) - -txInToText :: TxIn StandardCrypto -> Text -txInToText (TxIn (TxId txidHash) ix) = - hashToText txidHash - <> Text.pack "#" - <> Text.pack (show ix) - -hashToText :: Hash crypto a -> Text -hashToText = Text.decodeLatin1 . Crypto.hashToBytesAsHex - -deriving instance ToJSON (TxIn StandardCrypto) - -instance (ShelleyBasedEra era, ToJSON (Core.Value era)) => ToJSON (TxOut era) where - toJSON (TxOut addr amount) = - Aeson.object - [ "address" .= addr - , "amount" .= amount - ] - instance ToJSON (OneEraHash xs) where toJSON = toJSON . Text.decodeLatin1 @@ -106,80 +74,24 @@ deriving newtype instance ToJSON BlockNo deriving newtype instance ToJSON (TxId era) -deriving newtype instance ( ShelleyBasedEra era - , ToJSON (Core.TxOut era) - , Ledger.Crypto era ~ StandardCrypto - ) => ToJSON (UTxO era) - deriving newtype instance ToJSON (ShelleyHash era) deriving newtype instance ToJSON (HashHeader era) deriving newtype instance ToJSON (AuxiliaryDataHash StandardCrypto) deriving newtype instance ToJSON Ledger.LogWeight -deriving newtype instance ToJSON Ledger.Likelihood deriving newtype instance ToJSON (Ledger.PoolDistr StandardCrypto) -deriving newtype instance ToJSON DeltaCoin deriving newtype instance ToJSON (Ledger.Stake StandardCrypto) -deriving anyclass instance ToJSON (Ledger.GenDelegs StandardCrypto) -deriving anyclass instance ToJSON (Ledger.IndividualPoolStake StandardCrypto) - -deriving anyclass instance ToJSON (Ledger.ProposedPPUpdates StandardShelley) -deriving anyclass instance ToJSON (Ledger.PPUPState StandardShelley) - -deriving anyclass instance ToJSON (Ledger.ProposedPPUpdates StandardAllegra) -deriving anyclass instance ToJSON (Ledger.PPUPState StandardAllegra) - -deriving anyclass instance ToJSON (Ledger.ProposedPPUpdates StandardMary) -deriving anyclass instance ToJSON (Ledger.PPUPState StandardMary) - -deriving instance ToJSON Ledger.Ptr -deriving instance ToJSON Ledger.AccountState - -deriving instance ToJSON (Ledger.DPState StandardCrypto) -deriving instance ToJSON (Ledger.DState StandardCrypto) -deriving instance ToJSON (Ledger.InstantaneousRewards StandardCrypto) -deriving instance ToJSON (Ledger.NonMyopic StandardCrypto) -deriving instance ToJSON (Ledger.PState StandardCrypto) -deriving instance ToJSON (Ledger.RewardUpdate StandardCrypto) -deriving instance ToJSON (Ledger.SnapShot StandardCrypto) -deriving instance ToJSON (Ledger.SnapShots StandardCrypto) deriving instance ToJSON (Ledger.StakeReference StandardCrypto) -deriving instance ToJSON (Ledger.LedgerState StandardShelley) -deriving instance ToJSON (Ledger.EpochState StandardShelley) -deriving instance ToJSON (Ledger.NewEpochState StandardShelley) -deriving instance ToJSON (Ledger.PParams' StrictMaybe StandardShelley) -deriving instance ToJSON (Ledger.UTxOState StandardShelley) - -deriving instance ToJSON (Ledger.LedgerState StandardAllegra) -deriving instance ToJSON (Ledger.EpochState StandardAllegra) -deriving instance ToJSON (Ledger.NewEpochState StandardAllegra) -deriving instance ToJSON (Ledger.PParams' StrictMaybe StandardAllegra) -deriving instance ToJSON (Ledger.UTxOState StandardAllegra) - -deriving instance ToJSON (Ledger.LedgerState StandardMary) -deriving instance ToJSON (Ledger.EpochState StandardMary) -deriving instance ToJSON (Ledger.NewEpochState StandardMary) -deriving instance ToJSON (Ledger.PParams' StrictMaybe StandardMary) -deriving instance ToJSON (Ledger.UTxOState StandardMary) - -deriving instance ToJSON (Ledger.FutureGenDeleg StandardCrypto) deriving instance ToJSON (Ledger.PrtclState StandardCrypto) deriving instance ToJSON Ledger.TicknState deriving instance ToJSON (Ledger.ChainDepState StandardCrypto) deriving instance ToJSONKey Ledger.Ptr -deriving instance ToJSONKey (Ledger.FutureGenDeleg StandardCrypto) -deriving anyclass instance ToJSON (Ledger.Mary.Value StandardCrypto) deriving newtype instance ToJSON (Ledger.Mary.PolicyID StandardCrypto) -deriving anyclass instance ToJSONKey (Ledger.Mary.PolicyID StandardCrypto) -deriving anyclass instance ToJSONKey Ledger.Mary.AssetName - -instance ToJSON Ledger.Mary.AssetName where - toJSON (Ledger.Mary.AssetName bs) = toJSON (Text.decodeLatin1 bs) instance (ToJSONKey k, ToJSON v) => ToJSON (SetAlgebra.BiMap v k v) where toJSON = toJSON . SetAlgebra.forwards -- to normal Map diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index ceb5a15712a..97e60767678 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -31,7 +31,6 @@ import qualified Data.Vector as Vector import Numeric (showEFloat) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistMaybe, left) -import qualified Control.State.Transition as STS import Cardano.Api import Cardano.Api.Block @@ -53,7 +52,6 @@ import Cardano.CLI.Types import Cardano.Binary (decodeFull) import Cardano.Crypto.Hash (hashToBytesAsHex) -import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Crypto as Crypto import qualified Cardano.Ledger.Shelley.Constraints as Ledger import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) @@ -62,7 +60,6 @@ import Ouroboros.Network.Block (Serialised (..)) import Ouroboros.Network.Protocol.LocalStateQuery.Type as LocalStateQuery (AcquireFailure (..)) import qualified Shelley.Spec.Ledger.API.Protocol as Ledger -import qualified Shelley.Spec.Ledger.LedgerState as Ledger import Shelley.Spec.Ledger.Scripts () {- HLINT ignore "Reduce duplication" -} @@ -166,10 +163,7 @@ runQueryTip (AnyConsensusModeParams cModeParams) network mOutFile = do tip <- liftIO $ NewIPC.getLocalChainTip localNodeConnInfo - let output = case NewIPC.localConsensusMode localNodeConnInfo of - Mode.ByronMode -> encodePretty tip - Mode.ShelleyMode -> encodePretty tip - Mode.CardanoMode -> encodePretty tip + let output = encodePretty tip case mOutFile of Just (OutputFile fpath) -> liftIO $ LBS.writeFile fpath output @@ -368,14 +362,12 @@ writeStakeAddressInfo mOutFile delegsAndRewards = writeLedgerState :: forall era ledgerera. ShelleyLedgerEra era ~ ledgerera - => Ledger.UsesTxOut ledgerera - => ToJSON (Ledger.NewEpochState ledgerera) - => FromCBOR (STS.State (Ledger.EraRule "PPUP" ledgerera)) - => Ledger.ShelleyBased ledgerera + => ToJSON (Query.LedgerState era) + => FromCBOR (Query.LedgerState era) => Maybe OutputFile - -> Query.LedgerState era + -> Query.SerialisedLedgerState era -> ExceptT ShelleyQueryCmdError IO () -writeLedgerState mOutFile qState@(Query.LedgerState serLedgerState) = +writeLedgerState mOutFile qState@(Query.SerialisedLedgerState serLedgerState) = case mOutFile of Nothing -> case decodeLedgerState qState of Left bs -> firstExceptT ShelleyQueryCmdHelpersError $ pPrintCBOR bs @@ -385,9 +377,10 @@ writeLedgerState mOutFile qState@(Query.LedgerState serLedgerState) = $ LBS.writeFile fpath $ unSerialised serLedgerState where decodeLedgerState - :: Query.LedgerState era - -> Either LBS.ByteString (Ledger.NewEpochState ledgerera) - decodeLedgerState (Query.LedgerState (Serialised ls)) = first (const ls) (decodeFull ls) + :: Query.SerialisedLedgerState era + -> Either LBS.ByteString (Query.LedgerState era) + decodeLedgerState (Query.SerialisedLedgerState (Serialised ls)) = + first (const ls) (decodeFull ls) writeProtocolState :: Crypto.Crypto StandardCrypto @@ -589,9 +582,8 @@ obtainLedgerEraClassConstraints :: ShelleyLedgerEra era ~ ledgerera => ShelleyBasedEra era -> ((Ledger.ShelleyBased ledgerera - , ToJSON (Ledger.NewEpochState ledgerera) - , Ledger.UsesTxOut ledgerera - , FromCBOR (STS.State (Ledger.EraRule "PPUP" ledgerera)) + , ToJSON (Query.LedgerState era) + , FromCBOR (Query.LedgerState era) ) => a) -> a obtainLedgerEraClassConstraints ShelleyBasedEraShelley f = f obtainLedgerEraClassConstraints ShelleyBasedEraAllegra f = f diff --git a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs index ea8bb566aeb..bf82cc12c01 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Cardano.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Cardano.hs @@ -37,6 +37,7 @@ import Ouroboros.Consensus.Cardano.Condense () import Ouroboros.Consensus.Shelley.Protocol (StandardCrypto) +import Cardano.Api.Orphans () import Cardano.Node.Types import Cardano.Tracing.OrphanInstances.Byron () diff --git a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs index f31e91db5f2..fc7f6e16db6 100644 --- a/cardano-node/src/Cardano/Node/Protocol/Shelley.hs +++ b/cardano-node/src/Cardano/Node/Protocol/Shelley.hs @@ -48,6 +48,7 @@ import Shelley.Spec.Ledger.Keys (coerceKeyRole) import Shelley.Spec.Ledger.PParams (ProtVer (..)) import qualified Cardano.Api as Api (FileError (..)) +import Cardano.Api.Orphans () import Cardano.Api.Shelley hiding (FileError) diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs index 38da7f897dc..21a56f0d5b6 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs +++ b/cardano-node/src/Cardano/Tracing/OrphanInstances/Shelley.hs @@ -23,7 +23,6 @@ import Cardano.Prelude import Data.Aeson (ToJSONKey (..), ToJSONKeyFunction (..)) import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encoding as Aeson -import qualified Data.ByteString.Base16 as B16 import qualified Data.HashMap.Strict as HMS import Data.Scientific (Scientific) import qualified Data.Set as Set @@ -51,7 +50,6 @@ import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey import qualified Cardano.Ledger.AuxiliaryData as Core import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as Core -import qualified Cardano.Ledger.Mary.Value as MA import qualified Cardano.Ledger.ShelleyMA.Rules.Utxo as MA import qualified Cardano.Ledger.ShelleyMA.Timelocks as MA import qualified Cardano.Ledger.Torsor as Core @@ -59,7 +57,6 @@ import qualified Cardano.Ledger.Torsor as Core -- TODO: this should be exposed via Cardano.Api import Shelley.Spec.Ledger.API hiding (ShelleyBasedEra) import Shelley.Spec.Ledger.BlockChain (LastAppliedBlock (..)) -import Shelley.Spec.Ledger.Coin (DeltaCoin (..)) import Shelley.Spec.Ledger.PParams (PParamsUpdate) import Shelley.Spec.Ledger.STS.Bbody @@ -409,29 +406,6 @@ instance ( ShelleyBasedEra era , "addrs" .= addrs ] -instance ToJSON (MA.Value era) where - toJSON (MA.Value l ps) = - Aeson.object - [ "lovelace" .= toJSON l - , "policies" .= toJSON ps - ] - -instance ToJSON (MA.PolicyID era) where - toJSON (MA.PolicyID (ScriptHash h)) = Aeson.String (hashToTextAsHex h) - -instance ToJSONKey (MA.PolicyID era) where - toJSONKey = ToJSONKeyText render (Aeson.text . render) - where - render (MA.PolicyID (ScriptHash h)) = hashToTextAsHex h - -instance ToJSON MA.AssetName where - toJSON = Aeson.String . Text.decodeLatin1 . B16.encode . MA.assetName - -instance ToJSONKey MA.AssetName where - toJSONKey = ToJSONKeyText render (Aeson.text . render) - where - render = Text.decodeLatin1 . B16.encode . MA.assetName - instance ToJSON MA.ValidityInterval where toJSON vi = Aeson.object $ @@ -821,7 +795,7 @@ deriving newtype instance Core.Crypto crypto => ToJSON (Core.AuxiliaryDataHash c deriving instance Core.Crypto crypto => ToJSON (TxIn crypto) deriving newtype instance ToJSON (TxId crypto) -deriving newtype instance ToJSON DeltaCoin + instance Core.Crypto crypto => ToJSONKey (TxIn crypto) where toJSONKey = ToJSONKeyText txInToText (Aeson.text . txInToText) @@ -831,12 +805,5 @@ txInToText (TxIn (TxId txidHash) ix) = <> Text.pack "#" <> Text.pack (show ix) -instance (ShelleyBasedEra era, ToJSON (Core.Value era)) => ToJSON (TxOut era) where - toJSON (TxOut addr amount) = - Aeson.object - [ "address" .= addr - , "amount" .= amount - ] - hashToText :: Crypto.Hash crypto a -> Text hashToText = Text.decodeLatin1 . Crypto.hashToBytesAsHex