From cc6bc3c0894e31e2c06530b501af6c46d27951e7 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 25 May 2026 18:13:53 +0300 Subject: [PATCH] Integration for Node release 11.1 --- ..._fabrizio.ferrai_node_11_1_integration.yml | 32 +++ ...c_fabrizio.ferrai_era_aware_txout_cbor.yml | 10 + cabal.project | 59 +++++- cardano-api/cardano-api.cabal | 15 +- cardano-api/gen/Test/Gen/Cardano/Api.hs | 7 +- .../src/Cardano/Api/Certificate/Internal.hs | 9 +- .../Api/Consensus/Internal/Protocol.hs | 43 ++-- .../src/Cardano/Api/Genesis/Internal.hs | 2 + .../Api/Internal/Orphans/Serialisation.hs | 52 ----- .../src/Cardano/Api/Key/Internal/Leios.hs | 19 +- cardano-api/src/Cardano/Api/LedgerState.hs | 192 +++++++++--------- .../Serialise/TextEnvelope/Internal/Cddl.hs | 4 +- .../src/Cardano/Api/Tx/Internal/Serialise.hs | 4 +- .../src/Cardano/Api/Tx/Internal/Sign.hs | 20 +- .../src/Cardano/Api/Tx/Internal/TxMetadata.hs | 6 +- .../Test/Golden/Cardano/Api/Genesis.hs | 17 +- .../files/ShelleyGenesis.json | 9 +- cardano-rpc/cardano-rpc.cabal | 1 - .../Rpc/Server/Internal/UtxoRpc/Type.hs | 4 +- 19 files changed, 288 insertions(+), 217 deletions(-) create mode 100644 .changes/20260602_142317_cardano-api_fabrizio.ferrai_node_11_1_integration.yml create mode 100644 .changes/20260602_142317_cardano-rpc_fabrizio.ferrai_era_aware_txout_cbor.yml diff --git a/.changes/20260602_142317_cardano-api_fabrizio.ferrai_node_11_1_integration.yml b/.changes/20260602_142317_cardano-api_fabrizio.ferrai_node_11_1_integration.yml new file mode 100644 index 0000000000..8279d7d59f --- /dev/null +++ b/.changes/20260602_142317_cardano-api_fabrizio.ferrai_node_11_1_integration.yml @@ -0,0 +1,32 @@ +description: | + Integration for cardano-node 11.1. Highlights: + + Breaking: + - `initialLedgerState`, `foldBlocks`, `foldEpochState`, `mkProtocolInfoCardano` + and `genesisConfigToEnv` (all in `Cardano.Api.LedgerState`) take a new + `SomeHasFS IO` argument, used by consensus to stream genesis data from disk. + - In `Cardano.Api.Consensus`, the `ProtocolInfoArgs` data family is now + parameterised by the monad (`ProtocolInfoArgs m blk`) and `protocolInfo` + returns its result monadically. The `ProtocolInfoArgsCardano` and + `ProtocolInfoArgsShelley` constructors gain a `SomeHasFS m` field. + - The first type parameter of `Ledger.LedgerTables` is now the block + (e.g. `HardForkBlock (CardanoEras StandardCrypto)`) rather than + `LedgerState` of the block. This propagates through exported + `Cardano.Api.LedgerState` items including `AnyNewEpochState`, + `getLedgerTablesUTxOValues`, `toLedgerStateEvents`, + `tickThenReapplyCheckHash` and `tickThenApply`. + - Removed orphan `ToJSON` instances (previously made visible by + `import Cardano.Api`) for `NonEmptyMap`, `NonEmptySet`, + `Ledger.StakeSnapshots` and `Ledger.StakeSnapshot`. These instances are + now provided upstream. + - Dependency bound bumps: + `cardano-crypto-class ^>=2.5`, `small-steps ^>=1.2`, `fs-api ^>=0.4`. + + Compatible: + - `shelleyGenesisDefaults` and `conwayGenesisDefaults` populate the new + `sgExtraConfig` / `cgExtraConfig` ledger fields with their default values. +kind: + - breaking + - compatible +pr: 1221 +project: cardano-api diff --git a/.changes/20260602_142317_cardano-rpc_fabrizio.ferrai_era_aware_txout_cbor.yml b/.changes/20260602_142317_cardano-rpc_fabrizio.ferrai_era_aware_txout_cbor.yml new file mode 100644 index 0000000000..ce374fcf36 --- /dev/null +++ b/.changes/20260602_142317_cardano-rpc_fabrizio.ferrai_era_aware_txout_cbor.yml @@ -0,0 +1,10 @@ +description: | + `Cardano.Rpc.Server.Internal.UtxoRpc.Type.txInTxOutToAnyUtxoData` now + serialises the UTxO RPC `nativeBytes` for tx outputs using the era's ledger + CBOR (`L.serialize' (eraProtVerHigh era)`) instead of the unversioned + `Cardano.Binary.serialize'`. Downstream gRPC consumers will see the era's + canonical encoding rather than the previous era-agnostic bytes. +kind: + - bugfix +pr: 1221 +project: cardano-rpc diff --git a/cabal.project b/cabal.project index b173ba2df4..ad3c07bbc5 100644 --- a/cabal.project +++ b/cabal.project @@ -16,10 +16,6 @@ index-state: , hackage.haskell.org 2026-05-28T20:13:41Z , cardano-haskell-packages 2026-05-28T08:12:31Z -active-repositories: - , :rest - , cardano-haskell-packages:override - packages: cardano-api cardano-api-gen @@ -160,3 +156,58 @@ if impl(ghc >=9.14) , with-utf8:base -- cabal-allow-newer end +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger.git + tag: 3f879bb37df4738ed8211e500c7d180443cfcbe4 + --sha256: sha256-uLjiIHiU1SzAmoKs+rynQphc3FUYXKeJLlOnp87uNdg= + subdir: + eras/allegra/impl + eras/alonzo/impl + eras/babbage/impl + eras/byron/chain/executable-spec + eras/byron/crypto + eras/byron/ledger/executable-spec + eras/byron/ledger/impl + eras/conway/impl + eras/dijkstra/impl + eras/mary/impl + eras/shelley-ma/test-suite + eras/shelley/impl + eras/shelley/test-suite + libs/cardano-data + libs/cardano-ledger-api + libs/cardano-ledger-binary + libs/cardano-ledger-core + libs/cardano-protocol-tpraos + libs/non-integral + libs/small-steps + libs/vector-map + +source-repository-package + type: git + location: https://github.com/f-f/kes-agent.git + tag: 0b362519f6915841c92869ed288ce83f89b17b73 + --sha256: sha256-8pZYF7MJZZ1tM19wIUhbLKORDL+OP2ckhueWJM4aG/c= + subdir: + kes-agent + kes-agent-crypto + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus.git + tag: fc7665d0cb041565f1cce8819fefea51b395baf1 + --sha256: sha256-uPn1cRPyfvlNkQqysjUfzmNJihdFauMdDztal1ZSbQg= + subdir: + . + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network.git + tag: cb58582d5d55b3bce2b4c4ca8322ece46827e74e + --sha256: sha256-0aUzLQriB6Syq/+3sOw8EG8UMTZx5tN/o7IZV2c2WRo= + subdir: + ./cardano-diffusion + ./monoidal-synchronisation + ./network-mux + ./ouroboros-network diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 9da11d9a89..3cb3863989 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -132,9 +132,10 @@ library bytestring, bytestring-trie, cardano-addresses ^>=4.0.0, + cardano-base ^>=0.1, cardano-binary, cardano-crypto, - cardano-crypto-class ^>=2.3, + cardano-crypto-class ^>=2.5, cardano-crypto-wrapper ^>=1.7, cardano-data >=1.0, cardano-diffusion:{api, cardano-diffusion} ^>=1.0, @@ -164,11 +165,12 @@ library extra, filepath, formatting, + fs-api ^>=0.4, groups, iproute, memory, mempack, - microlens <0.5, + microlens <0.6, mono-traversable, mtl, network, @@ -189,7 +191,7 @@ library scientific, serialise, singletons, - small-steps ^>=1.1, + small-steps ^>=1.2, sop-core, sop-extras, stm, @@ -329,8 +331,8 @@ library gen base16-bytestring, bytestring, cardano-api, - cardano-binary >=1.6 && <1.9, - cardano-crypto-class ^>=2.3, + cardano-binary >=1.6 && <1.10, + cardano-crypto-class ^>=2.5, cardano-crypto-wrapper:testlib ^>=1.7, cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib}, cardano-ledger-byron:testlib, @@ -344,6 +346,7 @@ library gen hedgehog >=1.1, hedgehog-extras, hedgehog-quickcheck, + mempack, ordered-containers, tasty, tasty-hedgehog, @@ -367,7 +370,7 @@ test-suite cardano-api-test cardano-api:gen, cardano-binary, cardano-crypto, - cardano-crypto-class:{cardano-crypto-class, testlib} ^>=2.3, + cardano-crypto-class:{cardano-crypto-class, testlib} ^>=2.5, cardano-crypto-wrapper:testlib, cardano-ledger-alonzo, cardano-ledger-api ^>=1.13, diff --git a/cardano-api/gen/Test/Gen/Cardano/Api.hs b/cardano-api/gen/Test/Gen/Cardano/Api.hs index 4841e4c1ee..29ab5de0ad 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api.hs @@ -21,7 +21,9 @@ import Cardano.Ledger.Plutus.CostModels qualified as Plutus import Cardano.Ledger.Plutus.Language qualified as Alonzo import Cardano.Ledger.Shelley.TxAuxData (Metadatum (..), ShelleyTxAuxData (..)) +import Data.ByteString.Short qualified as SBS import Data.Map.Strict qualified as Map +import Data.MemPack.Buffer (byteArrayFromShortByteString) import Data.Word (Word64) import GHC.Exts (IsList (..)) @@ -41,7 +43,10 @@ genMetadata = do genMetadatum :: Gen Metadatum genMetadatum = do int <- Gen.list (Range.linear 1 5) (I <$> Gen.integral (Range.linear 1 100)) - bytes <- Gen.list (Range.linear 1 5) (B <$> Gen.bytes (Range.linear 1 20)) + bytes <- + Gen.list + (Range.linear 1 5) + (B . byteArrayFromShortByteString . SBS.toShort <$> Gen.bytes (Range.linear 1 20)) str <- Gen.list (Range.linear 1 5) (S <$> Gen.text (Range.linear 1 20) Gen.alphaNum) let mDatumList = int ++ bytes ++ str diff --git a/cardano-api/src/Cardano/Api/Certificate/Internal.hs b/cardano-api/src/Cardano/Api/Certificate/Internal.hs index 96012d9a86..54530aed14 100644 --- a/cardano-api/src/Cardano/Api/Certificate/Internal.hs +++ b/cardano-api/src/Cardano/Api/Certificate/Internal.hs @@ -24,6 +24,7 @@ import Cardano.Api.Key.Internal import Cardano.Api.Key.Internal.Praos import Cardano.Api.Ledger.Internal.Reexport qualified as Ledger +import Cardano.Base.IP (mkIPv4, mkIPv6, unIPv4, unIPv6) import Cardano.Ledger.Coin qualified as L import Cardano.Ledger.State qualified as Ledger @@ -125,8 +126,8 @@ toShelleyPoolParams toShelleyStakePoolRelay (StakePoolRelayIp mipv4 mipv6 mport) = Ledger.SingleHostAddr (fromIntegral <$> Ledger.maybeToStrictMaybe mport) - (Ledger.maybeToStrictMaybe mipv4) - (Ledger.maybeToStrictMaybe mipv6) + (Ledger.maybeToStrictMaybe (mkIPv4 <$> mipv4)) + (Ledger.maybeToStrictMaybe (mkIPv6 <$> mipv6)) toShelleyStakePoolRelay (StakePoolRelayDnsARecord dnsname mport) = Ledger.SingleHostName (fromIntegral <$> Ledger.maybeToStrictMaybe mport) @@ -192,8 +193,8 @@ fromShelleyPoolParams fromShelleyStakePoolRelay :: Ledger.StakePoolRelay -> StakePoolRelay fromShelleyStakePoolRelay (Ledger.SingleHostAddr mport mipv4 mipv6) = StakePoolRelayIp - (Ledger.strictMaybeToMaybe mipv4) - (Ledger.strictMaybeToMaybe mipv6) + (fmap unIPv4 (Ledger.strictMaybeToMaybe mipv4)) + (fmap unIPv6 (Ledger.strictMaybeToMaybe mipv6)) (fromIntegral . Ledger.portToWord16 <$> Ledger.strictMaybeToMaybe mport) fromShelleyStakePoolRelay (Ledger.SingleHostName mport dnsname) = StakePoolRelayDnsARecord diff --git a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs index 0caeed268e..c3c6c8930e 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs @@ -40,17 +40,18 @@ import Ouroboros.Consensus.Shelley.ShelleyHFC (ShelleyBlockHFC) import Ouroboros.Consensus.Util.IOLike (IOLike) import Control.Tracer qualified as Tracer -import Data.Bifunctor (bimap) +import System.FS.API (SomeHasFS) import Type.Reflection ((:~:) (..)) class (RunNode blk, IOLike m) => Protocol m blk where - data ProtocolInfoArgs blk + data ProtocolInfoArgs m blk protocolInfo - :: ProtocolInfoArgs blk - -> ( ProtocolInfo blk - , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m blk] - ) + :: ProtocolInfoArgs m blk + -> m + ( ProtocolInfo blk + , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m blk] + ) -- | Node client support for each consensus protocol. -- @@ -62,22 +63,27 @@ class RunNode blk => ProtocolClient blk where -- | Run PBFT against the Byron ledger instance IOLike m => Protocol m ByronBlockHFC where - data ProtocolInfoArgs ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron + data ProtocolInfoArgs m ByronBlockHFC = ProtocolInfoArgsByron ProtocolParamsByron protocolInfo (ProtocolInfoArgsByron params) = - ( inject $ protocolInfoByron params - , \_ -> pure . map (MkBlockForging . pure . inject) $ blockForgingByron params - ) + pure + ( inject $ protocolInfoByron params + , \_ -> pure . map (MkBlockForging . pure . inject) $ blockForgingByron params + ) instance - (CardanoHardForkConstraints StandardCrypto, IOLike m, MonadKESAgent m) + ( CardanoHardForkConstraints StandardCrypto + , IOLike m + , MonadKESAgent m + ) => Protocol m (CardanoBlock StandardCrypto) where - data ProtocolInfoArgs (CardanoBlock StandardCrypto) + data ProtocolInfoArgs m (CardanoBlock StandardCrypto) = ProtocolInfoArgsCardano + (SomeHasFS m) (CardanoProtocolParams StandardCrypto) - protocolInfo (ProtocolInfoArgsCardano paramsCardano) = - protocolInfoCardano paramsCardano + protocolInfo (ProtocolInfoArgsCardano fs paramsCardano) = + protocolInfoCardano fs paramsCardano instance ProtocolClient ByronBlockHFC where data ProtocolClientInfoArgs ByronBlockHFC @@ -102,14 +108,15 @@ instance ) => Protocol m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) where - data ProtocolInfoArgs (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) + data ProtocolInfoArgs m (ShelleyBlockHFC (Consensus.TPraos StandardCrypto) ShelleyEra) = ProtocolInfoArgsShelley + (SomeHasFS m) ShelleyGenesis (ProtocolParamsShelleyBased StandardCrypto) ProtVer - protocolInfo (ProtocolInfoArgsShelley genesis paramsShelleyBased_ paramsShelley_) = - bimap inject (fmap $ fmap $ map inject) $ - protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_ + protocolInfo (ProtocolInfoArgsShelley fs genesis paramsShelleyBased_ paramsShelley_) = do + (pinfo, bf) <- protocolInfoShelley fs genesis paramsShelleyBased_ paramsShelley_ + pure (inject pinfo, \tr -> map inject <$> bf tr) instance Consensus.LedgerSupportsProtocol diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal.hs b/cardano-api/src/Cardano/Api/Genesis/Internal.hs index d70751c0b0..fafb558738 100644 --- a/cardano-api/src/Cardano/Api/Genesis/Internal.hs +++ b/cardano-api/src/Cardano/Api/Genesis/Internal.hs @@ -185,6 +185,7 @@ shelleyGenesisDefaults = , sgStaking = emptyGenesisStaking , sgInitialFunds = ListMap.empty , sgMaxLovelaceSupply = 0 + , sgExtraConfig = SJust DefaultClass.def } where k = knownNonZeroBounded @2160 @@ -215,6 +216,7 @@ conwayGenesisDefaults = , cgCommittee = DefaultClass.def , cgDelegs = mempty , cgInitialDReps = mempty + , cgExtraConfig = SJust DefaultClass.def } where defaultUpgradeConwayParams :: UpgradeConwayPParams Identity diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index aad6036ba9..2cf8b98733 100644 --- a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs +++ b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs @@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeFamilies #-} @@ -52,7 +51,6 @@ import Cardano.Ledger.Alonzo.Rules qualified as Alonzo import Cardano.Ledger.Alonzo.Rules qualified as L import Cardano.Ledger.Alonzo.Tx qualified as L import Cardano.Ledger.Api qualified as L -import Cardano.Ledger.Api.State.Query qualified as Ledger import Cardano.Ledger.Babbage qualified as Babbage (ApplyTxError (..)) import Cardano.Ledger.Babbage.PParams qualified as Ledger import Cardano.Ledger.Babbage.Rules qualified as Babbage @@ -129,11 +127,8 @@ import Data.Kind (Constraint, Type) import Data.ListMap (ListMap) import Data.ListMap qualified as ListMap import Data.Map.NonEmpty (NonEmptyMap) -import Data.Map.NonEmpty qualified as NonEmptyMap import Data.Maybe.Strict (StrictMaybe (..)) import Data.Monoid -import Data.Set.NonEmpty (NonEmptySet) -import Data.Set.NonEmpty qualified as NonEmptySet import Data.Text qualified as T import Data.Text qualified as Text import Data.Text.Encoding qualified as Text @@ -213,12 +208,6 @@ deriving anyclass instance ToJSON L.VotingPeriod deriving anyclass instance ToJSON L.Withdrawals -instance (ToJSONKey k, ToJSON v) => ToJSON (NonEmptyMap k v) where - toJSON = toJSON . NonEmptyMap.toMap - -instance ToJSON v => ToJSON (NonEmptySet v) where - toJSON = toJSON . NonEmptySet.toSet - deriving anyclass instance ( ToJSON (L.PredicateFailure (L.EraRule "UTXOW" ledgerera)) , ToJSON (L.PredicateFailure (L.EraRule "DELEGS" ledgerera)) @@ -332,47 +321,6 @@ instance Pretty L.PolicyID where instance Pretty L.AssetName where pretty = pretty . L.assetNameToTextAsHex --- 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 Ledger.StakeSnapshots where - toJSON = object . stakeSnapshotsToPair - toEncoding = pairs . mconcat . stakeSnapshotsToPair - -stakeSnapshotsToPair - :: Aeson.KeyValue e a => Ledger.StakeSnapshots -> [a] -stakeSnapshotsToPair - Ledger.StakeSnapshots - { Ledger.ssStakeSnapshots - , Ledger.ssMarkTotal - , Ledger.ssSetTotal - , Ledger.ssGoTotal - } = - [ "pools" .= ssStakeSnapshots - , "total" - .= object - [ "stakeMark" .= ssMarkTotal - , "stakeSet" .= ssSetTotal - , "stakeGo" .= ssGoTotal - ] - ] - -instance ToJSON Ledger.StakeSnapshot where - toJSON = object . stakeSnapshotToPair - toEncoding = pairs . mconcat . stakeSnapshotToPair - -stakeSnapshotToPair :: Aeson.KeyValue e a => Ledger.StakeSnapshot -> [a] -stakeSnapshotToPair - Ledger.StakeSnapshot - { Ledger.ssMarkPool - , Ledger.ssSetPool - , Ledger.ssGoPool - } = - [ "stakeMark" .= ssMarkPool - , "stakeSet" .= ssSetPool - , "stakeGo" .= ssGoPool - ] - instance ToJSON (OneEraHash xs) where toJSON = toJSON diff --git a/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs b/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs index 9837447038..20a0b2ed46 100644 --- a/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs +++ b/cardano-api/src/Cardano/Api/Key/Internal/Leios.hs @@ -190,23 +190,6 @@ blsPossessionProof hexBs = Left e -> error $ "blsPossessionProof: " ++ show e Right p -> p --- | Signing context including the Domain Separation Tag (DST) for the proofs-of-possession of --- BLS keys using the minimal-signature-size BLS12-381 variant. --- --- A Domain Separation Tag is a unique tag (like a magic number) that we add to ensure that --- the signature is used only in the context that it was intended for. --- This is because BLS keys and signatures can be used for multiple purposes, and --- we don't want a proof of possession for one purpose to be interpreted as something different --- in a different context. -minSigPoPContext :: Crypto.BLS12381SignContext -minSigPoPContext = Crypto.BLS12381SignContext (Just minSigPoPDST) Nothing - --- TODO: This is a provisional definition. Import @minSigPoPDST@ from --- @Cardano.Crypto.DSIGN.BLS12381@ (cardano-crypto-class) when --- IntersectMBO/cardano-base#635 is merged and the dependency is bumped. -minSigPoPDST :: ByteString -minSigPoPDST = "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_" - -- | Create a proof of possession for a BLS signing key. -- -- This proof demonstrates that the holder of a BLS verification key knows the corresponding @@ -215,7 +198,7 @@ minSigPoPDST = "BLS_SIG_BLS12381G1_XMD:SHA-256_SSWU_RO_POP_" -- honest participants' keys during aggregation (a rogue key attack). createBlsPossessionProof :: SigningKey BlsKey -> BlsPossessionProof createBlsPossessionProof (BlsSigningKey sk) = - BlsPossessionProof (Crypto.createPossessionProofDSIGN minSigPoPContext sk) + BlsPossessionProof (Crypto.createPossessionProofDSIGN Crypto.minSigPoPDST sk) instance HasTypeProxy BlsPossessionProof where data AsType BlsPossessionProof = AsBlsPossessionProof diff --git a/cardano-api/src/Cardano/Api/LedgerState.hs b/cardano-api/src/Cardano/Api/LedgerState.hs index 19f0d437d9..933ec3e356 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -156,7 +156,6 @@ import Cardano.Crypto.VRF.Class qualified as VRF import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) import Cardano.Ledger.Api.Era qualified as Ledger import Cardano.Ledger.Api.Transition qualified as Ledger -import Cardano.Ledger.BHeaderView qualified as Ledger import Cardano.Ledger.BaseTypes ( Globals (..) , Nonce @@ -170,11 +169,13 @@ import Cardano.Ledger.BaseTypes qualified as Ledger import Cardano.Ledger.Binary (DecoderError) import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Dijkstra.PParams qualified as Ledger +import Cardano.Ledger.Dijkstra.Tx qualified as Ledger import Cardano.Ledger.Keys qualified as L import Cardano.Ledger.Keys qualified as SL import Cardano.Ledger.Shelley.API qualified as ShelleyAPI import Cardano.Ledger.Shelley.Core qualified as Core import Cardano.Ledger.Shelley.Genesis qualified as Ledger +import Cardano.Ledger.Slot qualified as Ledger import Cardano.Ledger.State qualified as SL import Cardano.Protocol.Crypto qualified as Crypto import Cardano.Protocol.TPraos.API qualified as TPraos @@ -199,7 +200,6 @@ import Ouroboros.Consensus.HardFork.Combinator.Ledger qualified as HFC import Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common qualified as HFC import Ouroboros.Consensus.HardFork.Combinator.State.Types import Ouroboros.Consensus.Ledger.Abstract qualified as Ledger -import Ouroboros.Consensus.Ledger.Basics qualified as Consensus import Ouroboros.Consensus.Ledger.Extended qualified as Ledger import Ouroboros.Consensus.Ledger.Tables.Utils qualified as Ledger import Ouroboros.Consensus.Node.ProtocolInfo qualified as Consensus @@ -274,6 +274,7 @@ import GHC.Stack (HasCallStack) import Lens.Micro import Network.Mux qualified as Mux import Network.TypedProtocol.Core (Nat (..)) +import System.FS.API (SomeHasFS) import System.FilePath data InitialLedgerStateError @@ -353,18 +354,21 @@ instance Error LedgerStateError where -- | Get the environment and initial ledger state. initialLedgerState :: MonadIOTransError InitialLedgerStateError t m - => NodeConfigFile 'In + => SomeHasFS IO + -- ^ Filesystem capability used by consensus for testing/benchmarking, + -- to stream Shelley/Conway genesis data from the extraConfig. + -> NodeConfigFile 'In -- ^ Path to the cardano-node config file (e.g. /configuration/cardano/mainnet-config.json) -> t m (Env, LedgerState) -- ^ The environment and initial ledger state -initialLedgerState nodeConfigFile = do +initialLedgerState fs nodeConfigFile = do -- TODO Once support for querying the ledger config is added to the node, we -- can remove the nodeConfigFile argument and much of the code in this -- module. config <- modifyError ILSEConfigFile (readNodeConfig nodeConfigFile) genesisConfig <- modifyError ILSEGenesisFile (readCardanoGenesisConfig config) - env <- modifyError ILSELedgerConsensusConfig (except (genesisConfigToEnv genesisConfig)) - let ledgerState = initLedgerStateVar genesisConfig + env <- hoistIOEither (first ILSELedgerConsensusConfig <$> genesisConfigToEnv fs genesisConfig) + ledgerState <- liftIO (initLedgerStateVar fs genesisConfig) return (env, ledgerState) -- | Apply a single block to the current ledger state. @@ -462,7 +466,10 @@ foldBlocks . HasCallStack => Show a => MonadIOTransError FoldBlocksError t m - => NodeConfigFile 'In + => SomeHasFS IO + -- ^ Filesystem capability used by consensus for testing/benchmarking, + -- to stream Shelley/Conway genesis data from the extraConfig. + -> NodeConfigFile 'In -- ^ Path to the cardano-node config file (e.g. /configuration/cardano/mainnet-config.json) -> SocketPath -- ^ Path to local cardano-node socket. This is the path specified by the @--socket-path@ command line option when running the node. @@ -490,14 +497,14 @@ foldBlocks -- truncating the last k blocks before the node's tip. -> t m a -- ^ The final state -foldBlocks nodeConfigFilePath socketPath validationMode state0 accumulate = handleExceptions $ do +foldBlocks fs nodeConfigFilePath socketPath validationMode state0 accumulate = handleExceptions $ do -- NOTE this was originally implemented with a non-pipelined client then -- changed to a pipelined client for a modest speedup: -- * Non-pipelined: 1h 0m 19s -- * Pipelined: 46m 23s (env, ledgerState) <- - modifyError FoldBlocksInitialLedgerStateError $ initialLedgerState nodeConfigFilePath + modifyError FoldBlocksInitialLedgerStateError $ initialLedgerState fs nodeConfigFilePath -- Place to store the accumulated state -- This is a bit ugly, but easy. @@ -1050,50 +1057,49 @@ rollBackLedgerStateHist :: History a -> SlotNo -> History a rollBackLedgerStateHist hist maxInc = Seq.dropWhileL ((> maxInc) . (\(x, _, _) -> x)) hist genesisConfigToEnv - :: GenesisConfig - -> Either GenesisConfigError Env -genesisConfigToEnv - -- enp - genCfg = - case genCfg of - GenesisCardano _ bCfg _ transCfg - | Cardano.Crypto.ProtocolMagic.unProtocolMagicId (Cardano.Chain.Genesis.configProtocolMagicId bCfg) - /= Ledger.sgNetworkMagic shelleyGenesis -> - Left . NECardanoConfig $ - mconcat - [ "ProtocolMagicId " - , textShow - (Cardano.Crypto.ProtocolMagic.unProtocolMagicId $ Cardano.Chain.Genesis.configProtocolMagicId bCfg) - , " /= " - , textShow (Ledger.sgNetworkMagic shelleyGenesis) - ] - -- byron start time is stored in seconds precision (using `canonical-json` library) - -- shelley start time is stored in fracions of a seconds precision (using `aeson` library) - -- Because of the representation precision difference, we need to round the values to the number of seconds before comparison. - | let byronSystemStart = - round . utcTimeToPOSIXSeconds . Cardano.Chain.Genesis.gdStartTime $ - Cardano.Chain.Genesis.configGenesisData bCfg - :: Int - , let shelleySystemStart = round . utcTimeToPOSIXSeconds $ Ledger.sgSystemStart shelleyGenesis :: Int - , byronSystemStart /= shelleySystemStart -> - Left . NECardanoConfig $ - mconcat - [ "SystemStart " - , textShow (Cardano.Chain.Genesis.gdStartTime $ Cardano.Chain.Genesis.configGenesisData bCfg) - , " /= " - , textShow (Ledger.sgSystemStart shelleyGenesis) - ] - | otherwise -> - let - topLevelConfig = Consensus.pInfoConfig $ fst $ mkProtocolInfoCardano genCfg - in - Right $ - Env - { envLedgerConfig = Consensus.topLevelConfigLedger topLevelConfig - , envConsensusConfig = Consensus.topLevelConfigProtocol topLevelConfig - } - where - shelleyGenesis = transCfg ^. Ledger.tcShelleyGenesisL + :: SomeHasFS IO + -> GenesisConfig + -> IO (Either GenesisConfigError Env) +genesisConfigToEnv fs genCfg = + case genCfg of + GenesisCardano _ bCfg _ transCfg + | Cardano.Crypto.ProtocolMagic.unProtocolMagicId (Cardano.Chain.Genesis.configProtocolMagicId bCfg) + /= Ledger.sgNetworkMagic shelleyGenesis -> + pure . Left . NECardanoConfig $ + mconcat + [ "ProtocolMagicId " + , textShow + (Cardano.Crypto.ProtocolMagic.unProtocolMagicId $ Cardano.Chain.Genesis.configProtocolMagicId bCfg) + , " /= " + , textShow (Ledger.sgNetworkMagic shelleyGenesis) + ] + -- byron start time is stored in seconds precision (using `canonical-json` library) + -- shelley start time is stored in fracions of a seconds precision (using `aeson` library) + -- Because of the representation precision difference, we need to round the values to the number of seconds before comparison. + | let byronSystemStart = + round . utcTimeToPOSIXSeconds . Cardano.Chain.Genesis.gdStartTime $ + Cardano.Chain.Genesis.configGenesisData bCfg + :: Int + , let shelleySystemStart = round . utcTimeToPOSIXSeconds $ Ledger.sgSystemStart shelleyGenesis :: Int + , byronSystemStart /= shelleySystemStart -> + pure . Left . NECardanoConfig $ + mconcat + [ "SystemStart " + , textShow (Cardano.Chain.Genesis.gdStartTime $ Cardano.Chain.Genesis.configGenesisData bCfg) + , " /= " + , textShow (Ledger.sgSystemStart shelleyGenesis) + ] + | otherwise -> do + (pinfo, _) <- mkProtocolInfoCardano fs genCfg + let topLevelConfig = Consensus.pInfoConfig pinfo + pure $ + Right $ + Env + { envLedgerConfig = Consensus.topLevelConfigLedger topLevelConfig + , envConsensusConfig = Consensus.topLevelConfigProtocol topLevelConfig + } + where + shelleyGenesis = transCfg ^. Ledger.tcShelleyGenesisL readNodeConfig :: MonadError Text m @@ -1234,28 +1240,26 @@ readByteString fp cfgType = (liftEither <=< liftIO) $ mconcat ["Cannot read the ", cfgType, " configuration file at : ", Text.pack fp] -initLedgerStateVar :: GenesisConfig -> LedgerState -initLedgerStateVar genesisConfig = - LedgerState - { clsState = - Ledger.ledgerState $ - Ledger.forgetLedgerTables $ - Consensus.pInfoInitLedger $ - fst protocolInfo - , clsTables = - Ledger.projectLedgerTables $ +initLedgerStateVar :: SomeHasFS IO -> GenesisConfig -> IO LedgerState +initLedgerStateVar fs genesisConfig = do + (pinfo, _) <- mkProtocolInfoCardano fs genesisConfig + pure + LedgerState + { clsState = Ledger.ledgerState $ - Consensus.pInfoInitLedger $ - fst protocolInfo - } - where - protocolInfo = mkProtocolInfoCardano genesisConfig + Ledger.forgetLedgerTables $ + Consensus.pInfoInitLedger pinfo + , clsTables = + Ledger.projectLedgerTables $ + Ledger.ledgerState $ + Consensus.pInfoInitLedger pinfo + } data LedgerState = LedgerState { clsState :: Consensus.CardanoLedgerState Consensus.StandardCrypto Ledger.EmptyMK , clsTables :: Ledger.LedgerTables - (Ledger.LedgerState (Consensus.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto))) + (Consensus.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) Ledger.ValuesMK } deriving Show @@ -1433,7 +1437,7 @@ type LedgerStateEvents = (LedgerState, [LedgerEvent]) toLedgerStateEvents :: Ledger.LedgerResult - (Ledger.LedgerState (Consensus.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto))) + (Consensus.HardForkBlock (Consensus.CardanoEras Consensus.StandardCrypto)) LedgerState -> LedgerStateEvents toLedgerStateEvents lr = (ledgerState, ledgerEvents) @@ -1467,14 +1471,17 @@ newtype NetworkName = NetworkName type NodeConfigFile = File NodeConfig mkProtocolInfoCardano - :: GenesisConfig - -> ( Consensus.ProtocolInfo - (Consensus.CardanoBlock Consensus.StandardCrypto) - , Tracer.Tracer IO KESAgentClientTrace - -> IO [MkBlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] - ) -mkProtocolInfoCardano (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg) = + :: SomeHasFS IO + -> GenesisConfig + -> IO + ( Consensus.ProtocolInfo + (Consensus.CardanoBlock Consensus.StandardCrypto) + , Tracer.Tracer IO KESAgentClientTrace + -> IO [MkBlockForging IO (Consensus.CardanoBlock Consensus.StandardCrypto)] + ) +mkProtocolInfoCardano fs (GenesisCardano dnc byronGenesis shelleyGenesisHash transCfg) = Consensus.protocolInfoCardano + fs Consensus.CardanoProtocolParams { Consensus.byronProtocolParams = Consensus.ProtocolParamsByron @@ -1863,13 +1870,13 @@ tickThenReapplyCheckHash cfg block (LedgerState st tbs) = then let keys - :: Consensus.LedgerTables - (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) + :: Ledger.LedgerTables + (Consensus.CardanoBlock Consensus.StandardCrypto) Ledger.KeysMK keys = Ledger.getBlockKeySets block restrictedTables = - Consensus.LedgerTables + Ledger.LedgerTables (Ledger.restrictValuesMK (Ledger.getLedgerTables tbs) (Ledger.getLedgerTables keys)) ledgerResult = @@ -1882,7 +1889,7 @@ tickThenReapplyCheckHash cfg block (LedgerState st tbs) = ( \stt -> LedgerState (Ledger.forgetLedgerTables stt) - ( Consensus.LedgerTables + ( Ledger.LedgerTables . Ledger.applyDiffsMK (Ledger.getLedgerTables tbs) . Ledger.getLedgerTables . Ledger.projectLedgerTables @@ -1924,13 +1931,13 @@ tickThenApply tickThenApply cfg block (LedgerState st tbs) = let keys - :: Consensus.LedgerTables - (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) + :: Ledger.LedgerTables + (Consensus.CardanoBlock Consensus.StandardCrypto) Ledger.KeysMK keys = Ledger.getBlockKeySets block restrictedTables = - Consensus.LedgerTables + Ledger.LedgerTables (Ledger.restrictValuesMK (Ledger.getLedgerTables tbs) (Ledger.getLedgerTables keys)) eLedgerResult = @@ -1946,7 +1953,7 @@ tickThenApply cfg block (LedgerState st tbs) = ( \stt -> LedgerState (Ledger.forgetLedgerTables stt) - ( Consensus.LedgerTables + ( Ledger.LedgerTables . Ledger.applyDiffsMK (Ledger.getLedgerTables tbs) . Ledger.getLedgerTables . Ledger.projectLedgerTables @@ -2271,7 +2278,7 @@ data AnyNewEpochState where :: ShelleyBasedEra era -> ShelleyAPI.NewEpochState (ShelleyLedgerEra era) -> Ledger.LedgerTables - (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) + (Consensus.CardanoBlock Consensus.StandardCrypto) Ledger.ValuesMK -> AnyNewEpochState @@ -2283,7 +2290,7 @@ getLedgerTablesUTxOValues :: forall era . ShelleyBasedEra era -> Ledger.LedgerTables - (Ledger.LedgerState (Consensus.CardanoBlock Consensus.StandardCrypto)) + (Consensus.CardanoBlock Consensus.StandardCrypto) Ledger.ValuesMK -> Map TxIn (TxOut CtxUTxO era) getLedgerTablesUTxOValues sbe tbs = @@ -2294,7 +2301,7 @@ getLedgerTablesUTxOValues sbe tbs = (Shelley.ShelleyBlock proto (ShelleyLedgerEra era)) -> Map TxIn (TxOut CtxUTxO era) ejectTables idx = - let Consensus.LedgerTables (Ledger.ValuesMK values) = HFC.ejectLedgerTables idx tbs + let Ledger.LedgerTables (Ledger.ValuesMK values) = HFC.ejectLedgerTables idx tbs in Map.mapKeys fromShelleyTxIn $ coerceMapKeys $ Map.map (fromShelleyTxOut sbe) values in case sbe of @@ -2313,7 +2320,10 @@ foldEpochState :: forall t m s . HasCallStack => MonadIOTransError FoldBlocksError t m - => NodeConfigFile 'In + => SomeHasFS IO + -- ^ Filesystem capability used by consensus for testing/benchmarking, + -- to stream Shelley/Conway genesis data from the extraConfig. + -> NodeConfigFile 'In -- ^ Path to the cardano-node config file (e.g. /configuration/cardano/mainnet-config.json) -> SocketPath -- ^ Path to local cardano-node socket. This is the path specified by the @--socket-path@ command line option when running the node. @@ -2340,7 +2350,7 @@ foldEpochState -- truncating the last k blocks before the node's tip. -> t m (ConditionResult, s) -- ^ The final state -foldEpochState nodeConfigFilePath socketPath validationMode terminationEpoch initialResult checkCondition = handleExceptions $ do +foldEpochState fs nodeConfigFilePath socketPath validationMode terminationEpoch initialResult checkCondition = handleExceptions $ do -- NOTE this was originally implemented with a non-pipelined client then -- changed to a pipelined client for a modest speedup: -- * Non-pipelined: 1h 0m 19s @@ -2348,7 +2358,7 @@ foldEpochState nodeConfigFilePath socketPath validationMode terminationEpoch ini (env, ledgerState) <- modifyError FoldBlocksInitialLedgerStateError $ - initialLedgerState nodeConfigFilePath + initialLedgerState fs nodeConfigFilePath -- Place to store the accumulated state -- This is a bit ugly, but easy. diff --git a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal/Cddl.hs b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal/Cddl.hs index 3d7596346d..412cb082ad 100644 --- a/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal/Cddl.hs +++ b/cardano-api/src/Cardano/Api/Serialise/TextEnvelope/Internal/Cddl.hs @@ -185,7 +185,7 @@ deserialiseWitnessLedgerCddl sbe te = "Key BootstrapWitness ShelleyEra" -> do w <- first TextEnvelopeCddlErrCBORDecodingError $ - CBOR.decodeFullAnnotator + CBOR.decodeFullDecoder (eraProtVerHigh sbe) "Shelley Witness" CBOR.decCBOR @@ -194,7 +194,7 @@ deserialiseWitnessLedgerCddl sbe te = "Key Witness ShelleyEra" -> do w <- first TextEnvelopeCddlErrCBORDecodingError $ - CBOR.decodeFullAnnotator + CBOR.decodeFullDecoder (eraProtVerHigh sbe) "Shelley Witness" CBOR.decCBOR diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Serialise.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Serialise.hs index bc0e2e0f5a..ec14c2357c 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Serialise.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Serialise.hs @@ -87,7 +87,7 @@ deserialiseWitnessLedger sbe te = "Key BootstrapWitness ShelleyEra" -> do w <- first TextEnvelopeDecodeError $ - CBOR.decodeFullAnnotator + CBOR.decodeFullDecoder (eraProtVerHigh sbe) "Shelley Witness" CBOR.decCBOR @@ -96,7 +96,7 @@ deserialiseWitnessLedger sbe te = "Key Witness ShelleyEra" -> do w <- first TextEnvelopeDecodeError $ - CBOR.decodeFullAnnotator + CBOR.decodeFullDecoder (eraProtVerHigh sbe) "Shelley Witness" CBOR.decCBOR diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs index 331bdc822d..631a7815d5 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Sign.hs @@ -107,9 +107,11 @@ import Cardano.Ledger.Keys qualified as Shelley import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Short qualified as SBS import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe +import Data.MemPack.Buffer (byteArrayFromShortByteString) import Data.Set qualified as Set import Data.Text qualified as Text import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) @@ -778,10 +780,10 @@ decodeShelleyBasedWitness -> Either CBOR.DecoderError (KeyWitness era) decodeShelleyBasedWitness sbe bs = let e = - Valid.toEither $ + Valid.foldValidation Left Right $ mconcat $ map - (Valid.liftError return) + (either (Valid.Failure . (: [])) Valid.Success) [ bootstrapWitnessDecoder bs , shelleyKeyWitnessDecoder bs , legacyKeyWitnessDecoder bs @@ -794,7 +796,7 @@ decodeShelleyBasedWitness sbe bs = where shelleyKeyWitnessDecoder b = ShelleyKeyWitness sbe - <$> CBOR.decodeFullAnnotator + <$> CBOR.decodeFullDecoder (L.eraProtVerHigh @(ShelleyLedgerEra era)) "Shelley Witness" CBOR.decCBOR @@ -802,27 +804,27 @@ decodeShelleyBasedWitness sbe bs = bootstrapWitnessDecoder b = ShelleyBootstrapWitness sbe - <$> CBOR.decodeFullAnnotator + <$> CBOR.decodeFullDecoder (L.eraProtVerHigh @(ShelleyLedgerEra era)) "Shelley Witness" CBOR.decCBOR (LBS.fromStrict b) legacyKeyWitnessDecoder b = - CBOR.decodeFullAnnotator + CBOR.decodeFullDecoder (L.eraProtVerHigh @(ShelleyLedgerEra era)) "Shelley Witness" decodeLegacy (LBS.fromStrict b) -- Non-CDDL compliant legacy decoder. - decodeLegacy :: CBOR.Decoder s (CBOR.Annotator (KeyWitness era)) + decodeLegacy :: CBOR.Decoder s (KeyWitness era) decodeLegacy = do CBOR.decodeListLenOf 2 t <- CBOR.decodeWord case t of - 0 -> fmap (fmap (ShelleyKeyWitness sbe)) CBOR.decCBOR - 1 -> fmap (fmap (ShelleyBootstrapWitness sbe)) CBOR.decCBOR + 0 -> ShelleyKeyWitness sbe <$> CBOR.decCBOR + 1 -> ShelleyBootstrapWitness sbe <$> CBOR.decCBOR _ -> CBOR.cborError $ CBOR.DecoderErrorUnknownTag @@ -1119,7 +1121,7 @@ makeShelleyBasedBootstrapWitness sbe nwOrAddr txbody (ByronSigningKey sk) = { Shelley.bwKey = vk , Shelley.bwSignature = signature , Shelley.bwChainCode = chainCode - , Shelley.bwAttributes = attributes + , Shelley.bwAttributes = byteArrayFromShortByteString (SBS.toShort attributes) } where -- Starting with the easy bits: we /can/ convert the Byron verification key diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs b/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs index 37036f58ca..f70795925c 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs @@ -70,12 +70,14 @@ import Data.ByteString qualified as BS import Data.ByteString.Base16 qualified as Base16 import Data.ByteString.Char8 qualified as BSC import Data.ByteString.Lazy.Char8 qualified as LBS +import Data.ByteString.Short qualified as SBS import Data.Data (Data) import Data.List qualified as List import Data.Map.Lazy qualified as Map.Lazy import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe) +import Data.MemPack.Buffer (byteArrayFromShortByteString, byteArrayToShortByteString) import Data.Scientific qualified as Scientific import Data.Text qualified as Text import Data.Text.Encoding qualified as Text @@ -227,7 +229,7 @@ toShelleyMetadata = Map.map toShelleyMetadatum toShelleyMetadatum :: TxMetadataValue -> Shelley.Metadatum toShelleyMetadatum (TxMetaNumber x) = Shelley.I x -toShelleyMetadatum (TxMetaBytes x) = Shelley.B x +toShelleyMetadatum (TxMetaBytes x) = Shelley.B (byteArrayFromShortByteString (SBS.toShort x)) toShelleyMetadatum (TxMetaText x) = Shelley.S x toShelleyMetadatum (TxMetaList xs) = Shelley.List @@ -245,7 +247,7 @@ fromShelleyMetadata = Map.Lazy.map fromShelleyMetadatum fromShelleyMetadatum :: Shelley.Metadatum -> TxMetadataValue fromShelleyMetadatum (Shelley.I x) = TxMetaNumber x -fromShelleyMetadatum (Shelley.B x) = TxMetaBytes x +fromShelleyMetadatum (Shelley.B x) = TxMetaBytes (SBS.fromShort (byteArrayToShortByteString x)) fromShelleyMetadatum (Shelley.S x) = TxMetaText x fromShelleyMetadatum (Shelley.List xs) = TxMetaList diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs index 586d595b20..d6173b889f 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/Cardano/Api/Genesis.hs @@ -11,7 +11,7 @@ where import Cardano.Api.Genesis import Cardano.Crypto.VRF (VerKeyVRF) -import Cardano.Ledger.BaseTypes (Network (..), knownNonZeroBounded) +import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (SJust), knownNonZeroBounded) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Core import Cardano.Ledger.Credential @@ -19,7 +19,11 @@ import Cardano.Ledger.Credential , StakeReference (..) ) import Cardano.Ledger.Keys (GenDelegPair (..)) -import Cardano.Ledger.Shelley.Genesis (emptyGenesisStaking) +import Cardano.Ledger.Shelley.Genesis + ( InjectionData (EmbeddedInjection, NoInjection) + , ShelleyExtraConfig (ShelleyExtraConfig) + , emptyGenesisStaking + ) import Cardano.Protocol.Crypto (StandardCrypto) import Data.ListMap (ListMap (ListMap)) @@ -53,8 +57,15 @@ exampleShelleyGenesis = , GenDelegPair delegVerKeyHash (toVRFVerKeyHash delegVrfKeyHash) ) ] - , sgInitialFunds = ListMap [(initialFundedAddress, initialFunds)] + , sgInitialFunds = ListMap [] , sgStaking = emptyGenesisStaking + , sgExtraConfig = + SJust + ( ShelleyExtraConfig + (EmbeddedInjection (ListMap [(initialFundedAddress, initialFunds)])) + NoInjection + NoInjection + ) } where -- hash of the genesis verification key diff --git a/cardano-api/test/cardano-api-golden/files/ShelleyGenesis.json b/cardano-api/test/cardano-api-golden/files/ShelleyGenesis.json index 9a04213816..48257d7647 100644 --- a/cardano-api/test/cardano-api-golden/files/ShelleyGenesis.json +++ b/cardano-api/test/cardano-api-golden/files/ShelleyGenesis.json @@ -32,8 +32,13 @@ }, "updateQuorum": 16991, "networkId": "Testnet", - "initialFunds": { - "001c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5e37a65ea2f9bcefb645de4312cf13d8ac12ae61cf242a9aa2973c9ee": 12157196 + "initialFunds": {}, + "extraConfig": { + "initialFunds": { + "data": { + "001c14ee8e58fbcbd48dc7367c95a63fd1d937ba989820015db16ac7e5e37a65ea2f9bcefb645de4312cf13d8ac12ae61cf242a9aa2973c9ee": 12157196 + } + } }, "maxLovelaceSupply": 71, "networkMagic": 4036000900, diff --git a/cardano-rpc/cardano-rpc.cabal b/cardano-rpc/cardano-rpc.cabal index a9e53ce75f..a4411e0f0a 100644 --- a/cardano-rpc/cardano-rpc.cabal +++ b/cardano-rpc/cardano-rpc.cabal @@ -76,7 +76,6 @@ library base, bytestring, cardano-api >=11.2, - cardano-binary, cardano-ledger-api, cardano-ledger-conway, cardano-ledger-core >=1.19, diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs index 17c0669a02..af81a6facf 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type.hs @@ -34,6 +34,7 @@ import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Era import Cardano.Api.Error +import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Experimental.Era import Cardano.Api.HasTypeProxy import Cardano.Api.Ledger qualified as L @@ -47,7 +48,6 @@ import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as U5c import Cardano.Rpc.Proto.Api.UtxoRpc.Query qualified as UtxoRpc import Cardano.Rpc.Server.Internal.Orphans () -import Cardano.Binary qualified as CBOR import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes (WithOrigin (..)) import Cardano.Ledger.BaseTypes qualified as L @@ -533,7 +533,7 @@ txInTxOutToAnyUtxoData txIn txOut = do let era = useEra @era txOutCbor = obtainCommonConstraints era $ - CBOR.serialize' $ + L.serialize' (Exp.eraProtVerHigh era) $ toShelleyTxOut (convert era) txOut defMessage & U5c.nativeBytes .~ txOutCbor