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..80e7e66172 --- /dev/null +++ b/.changes/20260602_142317_cardano-api_fabrizio.ferrai_node_11_1_integration.yml @@ -0,0 +1,18 @@ +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. + - The transaction-balancing API drops its `drepDelegDeposits` (`Map (Credential DRepRole) Coin`) parameter, following cardano-ledger 1.14 removing the DRep-deposit lookup from `evalBalanceTxBody` (ledger PR 5919). Affected exported functions: `evaluateTransactionBalance`, `estimateBalancedTxBody`, `estimateOrCalculateBalancedTxBody`, `makeTransactionBodyAutoBalance`, `constructBalancedTx` and their `Cardano.Api.Experimental.Tx` counterparts plus `evaluateTransaction`, `evaluateSignedTx`, `calcMinFeeRecursive`. + - Dependency bound bumps: `cardano-crypto-class ^>=2.5`, `fs-api ^>=0.4`, `cardano-ledger-api ^>=1.14`. + + 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..04511df2fd --- /dev/null +++ b/.changes/20260602_142317_cardano-rpc_fabrizio.ferrai_era_aware_txout_cbor.yml @@ -0,0 +1,6 @@ +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/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 926a51be76..c99b4ed6e5 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -47,7 +47,7 @@ jobs: env: # Modify this value to "invalidate" the cabal cache. - CABAL_CACHE_VERSION: "2024-07-26" + CABAL_CACHE_VERSION: "2026-06-26" # these two are msys2 env vars, they have no effect on non-msys2 installs. MSYS2_PATH_TYPE: inherit MSYSTEM: MINGW64 diff --git a/cabal.project b/cabal.project index b173ba2df4..53cfe637c1 100644 --- a/cabal.project +++ b/cabal.project @@ -13,12 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them 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 + , hackage.haskell.org 2026-06-29T22:49:53Z + , cardano-haskell-packages 2026-07-02T10:10:00Z packages: cardano-api @@ -156,7 +152,74 @@ if impl(ghc >=9.14) , serialise:base , serialise:containers , serialise:time + , tdigest:base , time-locale-compat:time , with-utf8:base -- cabal-allow-newer end +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-ledger.git + tag: e9827fdc3def69c02fe826fdf46e2a412620ef98 + --sha256: sha256-bVR1ZFs1VDc7ag2QEpSf5rVj1mdBCB/Ag7nhj00UXQE= + 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 + 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: 32c1ed675d22a30735d9f22f7afa436a3ef3e64a + --sha256: sha256-o7hFX1JnraS6Xq0WoXQwd9Z8GsPPv0Ls2DWvZ08o0ZU= + subdir: + kes-agent + kes-agent-crypto + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-consensus.git + tag: e468a936006a890d4469d1cbfaa3cfbe6867e29c + --sha256: sha256-X1Yd6TMYhhxbm8qiD3y8Ad3nY2D5wieGWf9kwoRCWxc= + subdir: + . + +source-repository-package + type: git + location: https://github.com/IntersectMBO/ouroboros-network.git + tag: 94daae78d79a9589a99a4b591b1848d0d7476a00 + --sha256: sha256-4iCw6hKO0udTOmm8ivEflOhp0rm/1iVmHSJhptnlPJ8= + subdir: + ./cardano-diffusion + ./monoidal-synchronisation + ./network-mux + ./ouroboros-network + +source-repository-package + type: git + location: https://github.com/IntersectMBO/plutus.git + tag: b1db04cc425fab303ac3b79d7140dc2a17f29e6d + --sha256: sha256-XtYzjNVx4+IGWpgm+p/YTf56DrJtK0I98umZCTE3U80= + subdir: + plutus-core + plutus-ledger-api + plutus-tx diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index d8e4f3bc59..d122b94667 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -132,15 +132,16 @@ 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, cardano-ledger-allegra >=1.7, cardano-ledger-alonzo >=1.15, - cardano-ledger-api ^>=1.13, + cardano-ledger-api ^>=1.14, cardano-ledger-babbage >=1.11, cardano-ledger-binary >=1.6, cardano-ledger-byron >=1.2, @@ -149,6 +150,7 @@ library cardano-ledger-dijkstra >=0.1, cardano-ledger-mary >=1.8, cardano-ledger-shelley >=1.16, + cardano-protocol ^>=0.1, cardano-protocol-tpraos >=1.4, cardano-slotting >=0.2.0.0, cardano-strict-containers >=0.1, @@ -164,10 +166,11 @@ library extra, filepath, formatting, + fs-api ^>=0.4, iproute, memory, mempack, - microlens <0.5, + microlens <0.6, mono-traversable, mtl, network, @@ -328,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, @@ -343,6 +346,7 @@ library gen hedgehog >=1.1, hedgehog-extras, hedgehog-quickcheck, + mempack, ordered-containers, tasty, tasty-hedgehog, @@ -366,10 +370,10 @@ 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, + cardano-ledger-api ^>=1.14, cardano-ledger-babbage, cardano-ledger-binary, cardano-ledger-conway, @@ -448,7 +452,7 @@ test-suite cardano-api-golden cardano-crypto-class, cardano-data >=1.0, cardano-ledger-alonzo, - cardano-ledger-api ^>=1.13, + cardano-ledger-api ^>=1.14, cardano-ledger-binary, cardano-ledger-core, cardano-ledger-shelley, diff --git a/cardano-api/gen/Test/Gen/Cardano/Api.hs b/cardano-api/gen/Test/Gen/Cardano/Api.hs index 4841e4c1ee..5fe753ab2a 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 @@ -113,7 +118,7 @@ genAlonzoGenesis = do Nothing -> Map.empty ) [Alonzo.PlutusV2 .. maxBound] - extraConfig = Just $ Alonzo.AlonzoExtraConfig $ Just $ L.mkCostModels v2OnwardsCostModels + extraConfig = Ledger.SJust $ Alonzo.AlonzoExtraConfig $ Just $ L.mkCostModels v2OnwardsCostModels prices' <- genPrices maxTxExUnits' <- genExUnits maxBlockExUnits' <- genExUnits diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs b/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs index ec4ee32f57..5985a353c8 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/ProtocolParameters.hs @@ -1,4 +1,6 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Test.Gen.Cardano.Api.ProtocolParameters where @@ -7,6 +9,7 @@ import Cardano.Api.Ledger import Test.Cardano.Ledger.Alonzo.Arbitrary () import Test.Cardano.Ledger.Conway.Arbitrary () +import Test.Cardano.Ledger.Core.Arbitrary (genEraProtVer) import Hedgehog (MonadGen) import Hedgehog.Gen qualified as Gen @@ -40,8 +43,15 @@ genCommonProtocolParametersUpdate = genDeprecatedAfterMaryPParams :: MonadGen m => m (DeprecatedAfterMaryPParams era) genDeprecatedAfterMaryPParams = DeprecatedAfterMaryPParams <$> genStrictMaybe Q.arbitrary -genDeprecatedAfterBabbagePParams :: MonadGen m => m (DeprecatedAfterBabbagePParams era) -genDeprecatedAfterBabbagePParams = DeprecatedAfterBabbagePParams <$> genStrictMaybe Q.arbitrary +genDeprecatedAfterBabbagePParams + :: forall era ledgerera m + . MonadGen m + => ShelleyBasedEra era + -> m (DeprecatedAfterBabbagePParams ledgerera) +genDeprecatedAfterBabbagePParams sbe = + shelleyBasedEraConstraints sbe $ + DeprecatedAfterBabbagePParams + <$> genStrictMaybe (Q.quickcheck (genEraProtVer @(ShelleyLedgerEra era))) genShelleyToAlonzoPParams :: MonadGen m => m (ShelleyToAlonzoPParams era) genShelleyToAlonzoPParams = @@ -100,7 +110,7 @@ genShelleyEraBasedProtocolParametersUpdate = ShelleyEraBasedProtocolParametersUpdate <$> genCommonProtocolParametersUpdate <*> genDeprecatedAfterMaryPParams - <*> genDeprecatedAfterBabbagePParams + <*> genDeprecatedAfterBabbagePParams ShelleyBasedEraShelley <*> genShelleyToAlonzoPParams genAllegraEraBasedProtocolParametersUpdate @@ -110,7 +120,7 @@ genAllegraEraBasedProtocolParametersUpdate = <$> genCommonProtocolParametersUpdate <*> genDeprecatedAfterMaryPParams <*> genShelleyToAlonzoPParams - <*> genDeprecatedAfterBabbagePParams + <*> genDeprecatedAfterBabbagePParams ShelleyBasedEraAllegra genMaryEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate MaryEra) @@ -119,7 +129,7 @@ genMaryEraBasedProtocolParametersUpdate = <$> genCommonProtocolParametersUpdate <*> genDeprecatedAfterMaryPParams <*> genShelleyToAlonzoPParams - <*> genDeprecatedAfterBabbagePParams + <*> genDeprecatedAfterBabbagePParams ShelleyBasedEraMary genAlonzoEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate AlonzoEra) @@ -128,7 +138,7 @@ genAlonzoEraBasedProtocolParametersUpdate = <$> genCommonProtocolParametersUpdate <*> genShelleyToAlonzoPParams <*> genAlonzoOnwardsPParams - <*> genDeprecatedAfterBabbagePParams + <*> genDeprecatedAfterBabbagePParams ShelleyBasedEraAlonzo genBabbageEraBasedProtocolParametersUpdate :: MonadGen m => m (EraBasedProtocolParametersUpdate BabbageEra) @@ -136,7 +146,7 @@ genBabbageEraBasedProtocolParametersUpdate = BabbageEraBasedProtocolParametersUpdate <$> genCommonProtocolParametersUpdate <*> genAlonzoOnwardsPParams - <*> genDeprecatedAfterBabbagePParams + <*> genDeprecatedAfterBabbagePParams ShelleyBasedEraBabbage <*> genIntroducedInBabbagePParams genConwayEraBasedProtocolParametersUpdate diff --git a/cardano-api/src/Cardano/Api/Block.hs b/cardano-api/src/Cardano/Api/Block.hs index e0994a56d0..4f9f1eaf66 100644 --- a/cardano-api/src/Cardano/Api/Block.hs +++ b/cardano-api/src/Cardano/Api/Block.hs @@ -74,6 +74,7 @@ import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS import Data.ByteString.Short qualified as SBS import Data.Foldable (Foldable (toList)) +import Data.Maybe (fromMaybe) import Data.Text (Text) import Lens.Micro @@ -316,7 +317,9 @@ toConsensusPoint -> Consensus.Point (Consensus.ShelleyBlock protocol ledgerera) toConsensusPoint ChainPointAtGenesis = Consensus.GenesisPoint toConsensusPoint (ChainPoint slot (HeaderHash h)) = - Consensus.BlockPoint slot (Consensus.fromShortRawHash proxy h) + Consensus.BlockPoint + slot + (fromMaybe (error "toConsensusPoint: hash size mismatch") (Consensus.fromShortRawHash proxy h)) where proxy :: Proxy (Consensus.ShelleyBlock protocol ledgerera) proxy = Proxy 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 7c22f91c0b..eb27fa8463 100644 --- a/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs +++ b/cardano-api/src/Cardano/Api/Consensus/Internal/Protocol.hs @@ -44,17 +44,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. -- @@ -66,22 +67,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 @@ -106,14 +112,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/Era/Internal/Eon/ShelleyBasedEra.hs b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs index c2050f9342..ff09062dce 100644 --- a/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs +++ b/cardano-api/src/Cardano/Api/Era/Internal/Eon/ShelleyBasedEra.hs @@ -50,7 +50,6 @@ import Cardano.Ledger.Api qualified as L import Cardano.Ledger.BaseTypes qualified as L import Cardano.Ledger.Binary (FromCBOR) import Cardano.Ledger.Core qualified as L -import Cardano.Ledger.Shelley.Rules qualified as L import Cardano.Ledger.State qualified as L import Cardano.Protocol.Crypto qualified as L import Ouroboros.Consensus.Protocol.Abstract qualified as Consensus @@ -58,6 +57,7 @@ import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus import Ouroboros.Consensus.Shelley.Ledger qualified as Consensus import Control.DeepSeq +import Control.State.Transition.Extended qualified as L (PredicateFailure) import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText) import Data.Text qualified as Text import Data.Type.Equality (TestEquality (..), (:~:) (Refl), type (==)) diff --git a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs index 30eb8a97d2..e8ea3acf9c 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs @@ -137,7 +137,7 @@ toPlutusScriptPurpose -> Witnessable thing era -> L.PlutusPurpose L.AsIx era toPlutusScriptPurpose index WitTxIn{} = L.mkSpendingPurpose (L.AsIx index) -toPlutusScriptPurpose index WitWithdrawal{} = L.mkRewardingPurpose (L.AsIx index) +toPlutusScriptPurpose index WitWithdrawal{} = L.mkWithdrawingPurpose (L.AsIx index) toPlutusScriptPurpose index WitMint{} = L.mkMintingPurpose (L.AsIx index) toPlutusScriptPurpose index WitTxCert{} = L.mkCertifyingPurpose (L.AsIx index) toPlutusScriptPurpose index WitVote{} = L.mkVotingPurpose (L.AsIx index) diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx.hs b/cardano-api/src/Cardano/Api/Experimental/Tx.hs index 2620d4cac5..c3104f3b90 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx.hs @@ -244,7 +244,6 @@ import Cardano.Crypto.Hash qualified as Hash import Cardano.Ledger.Alonzo.Core qualified as Ledger import Cardano.Ledger.Api qualified as L import Cardano.Ledger.Binary qualified as Ledger -import Cardano.Ledger.Credential qualified as Ledger (Credential) import Cardano.Ledger.Hashes qualified as L hiding (Hash) import Control.Exception (displayException) @@ -349,14 +348,12 @@ evaluateSignedTx -- ^ Registered stake pools -> Map StakeCredential L.Coin -- ^ Stake delegation deposits - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ DRep delegation deposits -> L.UTxO (LedgerEra era) -- ^ UTxO set for the transaction inputs -> SignedTx era -- ^ Signed transaction to evaluate -> TxEvaluationResult (LedgerEra era) -evaluateSignedTx systemStart epochInfo protocolParams poolIds stakeDelegDeposits drepDelegDeposits utxo (SignedTx tx) = +evaluateSignedTx systemStart epochInfo protocolParams poolIds stakeDelegDeposits utxo (SignedTx tx) = -- obtainCommonConstraints is needed here to bring ShelleyLedgerEra era ~ LedgerEra era -- into scope, unifying SignedTx's ShelleyLedgerEra with evaluateTransaction's LedgerEra. obtainCommonConstraints (useEra @era) $ @@ -366,7 +363,6 @@ evaluateSignedTx systemStart epochInfo protocolParams poolIds stakeDelegDeposits protocolParams poolIds stakeDelegDeposits - drepDelegDeposits utxo tx diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs index 90f0a56420..6752aa1b84 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs @@ -615,7 +615,7 @@ babbageOnwardsTxOutParseJson baseTxOut o = do fail "babbageOnwardsTxOutParseJson: inlineDatumhash present without inlineDatumRaw" pure $ maybe L.NoDatum L.DatumHash mDatumHash -- Determine reference script - refScript <- fmap L.maybeToStrictMaybe $ forM mRefScript scriptInAnyLangToLedgerScript + refScript <- L.maybeToStrictMaybe <$> forM mRefScript scriptInAnyLangToLedgerScript -- Construct TxOut pure . TxOut $ baseTxOut diff --git a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs index 56e9ace2d9..34e6ace5ab 100644 --- a/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs +++ b/cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Fee.hs @@ -219,9 +219,6 @@ estimateBalancedTxBody -> Map StakeCredential L.Coin -- ^ A map of all deposits for stake credentials that are being -- unregistered in this transaction. - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ A map of all deposits for DRep credentials that are being - -- unregistered in this transaction. -> Map (Ledger.PlutusPurpose Ledger.AsIx (LedgerEra era)) ExecutionUnits -- ^ Plutus script execution units. -> Coin @@ -243,7 +240,6 @@ estimateBalancedTxBody pparams poolids stakeDelegDeposits - drepDelegDeposits exUnitsMap = obtainCommonConstraints w $ estimateBalancedTxBody' @@ -251,7 +247,6 @@ estimateBalancedTxBody pparams poolids stakeDelegDeposits - drepDelegDeposits (Map.mapKeys (toScriptIndex (convert w)) exUnitsMap) data TxFeeEstimationError era @@ -279,9 +274,6 @@ estimateBalancedTxBody' -> Map StakeCredential L.Coin -- ^ A map of all deposits for stake credentials that are being -- unregistered in this transaction. - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ A map of all deposits for DRep credentials that are being - -- unregistered in this transaction. -> Map ScriptWitnessIndex ExecutionUnits -- ^ Plutus script execution units. -> Coin @@ -302,7 +294,6 @@ estimateBalancedTxBody' pparams poolids stakeDelegDeposits - drepDelegDeposits exUnitsMap totalPotentialCollateral intendedKeyWits @@ -418,7 +409,7 @@ estimateBalancedTxBody' let fakeUTxO = createFakeUTxO txbodycontent1 $ L.coin availableUTxOValue balance :: Ledger.Value (LedgerEra era) = - evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits fakeUTxO txbody2 + evaluateTransactionBalance pparams poolids stakeDelegDeposits fakeUTxO txbody2 coinBalance :: L.Coin coinBalance = obtainCommonConstraints (useEra @era) $ L.coin balance @@ -559,14 +550,12 @@ evaluateTransaction -- ^ Registered stake pools -> Map StakeCredential L.Coin -- ^ Stake delegation deposits - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ DRep delegation deposits -> L.UTxO (LedgerEra era) -- ^ UTxO set for the transaction inputs -> L.Tx L.TopTx (LedgerEra era) -- ^ Signed transaction to evaluate -> TxEvaluationResult (LedgerEra era) -evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDeposits drepDelegDeposits utxo tx = +evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDeposits utxo tx = obtainCommonConstraints (useEra @era) $ do let txEvalExecutionUnits = evaluateTransactionExecutionUnits systemStart epochInfo protocolParams utxo tx @@ -593,7 +582,6 @@ evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDepos L.evalBalanceTxBody protocolParams lookupDelegDeposit - lookupDRepDeposit isRegPool utxo $ txWithEvaluatedExUnits ^. L.bodyTxL @@ -607,11 +595,6 @@ evaluateTransaction systemStart epochInfo protocolParams poolIds stakeDelegDepos lookupDelegDeposit stakeCred = Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits - lookupDRepDeposit - :: Ledger.Credential Ledger.DRepRole -> Maybe L.Coin - lookupDRepDeposit drepCred = - Map.lookup drepCred drepDelegDeposits - -- | Compute the total balance of the proposed transaction. Ultimately, a valid -- transaction must be fully balanced, which means that it has a total value -- of zero. @@ -624,17 +607,15 @@ evaluateTransactionBalance => Ledger.PParams (LedgerEra era) -> Set PoolId -> Map StakeCredential L.Coin - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin -> L.UTxO (LedgerEra era) -> UnsignedTx (LedgerEra era) -> L.Value (LedgerEra era) -evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo (UnsignedTx unsignedTx) = +evaluateTransactionBalance pp poolids stakeDelegDeposits utxo (UnsignedTx unsignedTx) = let txbody = unsignedTx ^. L.bodyTxL in obtainCommonConstraints (useEra @era) $ L.evalBalanceTxBody pp lookupDelegDeposit - lookupDRepDeposit isRegPool utxo txbody @@ -647,11 +628,6 @@ evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo lookupDelegDeposit stakeCred = Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits - lookupDRepDeposit - :: Ledger.Credential Ledger.DRepRole -> Maybe L.Coin - lookupDRepDeposit drepCred = - Map.lookup drepCred drepDelegDeposits - -- | This is used in the balance calculation in the event where -- the user does not supply the UTxO(s) they intend to spend -- but they must supply their total balance of ADA. @@ -847,13 +823,10 @@ calcMinFeeRecursive -> Map StakeCredential L.Coin -- ^ Deposits for stake credentials being deregistered in this -- transaction. These are counted as refunds on the consumed side. - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ Deposits for DRep credentials being deregistered in this - -- transaction. These are counted as refunds on the consumed side. -> Int -- ^ Number of extra key hashes for native scripts -> Either FeeCalculationError (UnsignedTx (LedgerEra era)) -calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposits drepDelegDeposits nExtraWitnesses +calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposits nExtraWitnesses -- If multi-assets are non-negative initially, they stay non-negative across -- iterations (only ADA and fee change), so check once upfront. | multiAssetIsNegative = @@ -861,7 +834,7 @@ calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposit | otherwise = go maxIterations unsignedTx where - initialBalance = evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits utxo unsignedTx + initialBalance = evaluateTransactionBalance pparams poolids stakeDelegDeposits utxo unsignedTx multiAssets = obtainCommonConstraints (useEra @era) $ let L.MaryValue _ ma = initialBalance @@ -898,7 +871,7 @@ calcMinFeeRecursive changeAddr unsignedTx utxo pparams poolids stakeDelegDeposit minFee = obtainCommonConstraints (useEra @era) $ L.calcMinFeeTx utxo pparams ledgerTx nExtraWitnesses txBodyFee = ledgerTx ^. L.bodyTxL . L.feeTxBodyL txBalanceValue = - evaluateTransactionBalance pparams poolids stakeDelegDeposits drepDelegDeposits utxo unSignTx + evaluateTransactionBalance pparams poolids stakeDelegDeposits utxo unSignTx checkOutputMinUTxO :: forall era @@ -1477,9 +1450,6 @@ makeTransactionBodyAutoBalance -> Map StakeCredential L.Coin -- ^ The map of all deposits for stake credentials that are being -- unregistered in this transaction - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ The map of all deposits for DRep credentials that are being - -- unregistered in this transaction -> L.UTxO (LedgerEra era) -- ^ The transaction inputs (including reference and collateral ones), not the entire 'UTxO'. -> TxBodyContent (LedgerEra era) @@ -1496,7 +1466,6 @@ makeTransactionBodyAutoBalance pp poolids stakeDelegDeposits - drepDelegDeposits utxo txbodycontent changeaddr @@ -1516,7 +1485,7 @@ makeTransactionBodyAutoBalance -- Check the balance before constructing the TxOut. L.mkBasicTxOut calls toCompact, which throws an irrecoverable -- error on negative Coin values, so checkNonNegative would never get to return Left for the negative case. initialChangeTxOutValue :: Ledger.Value (LedgerEra era) <- do - let val = evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange + let val = evaluateTransactionBalance pp poolids stakeDelegDeposits utxo txbodyForChange L.MaryValue initialCoin initialMultiAsset = obtainCommonConstraints (useEra @era) val val <$ unless @@ -1632,7 +1601,7 @@ makeTransactionBodyAutoBalance case useEra @era of DijkstraEra -> error "TODO Dijkstra: makeTransactionBodyAutoBalance: era not supported" ConwayEra -> do - let balance :: L.MaryValue = evaluateTransactionBalance pp poolids stakeDelegDeposits drepDelegDeposits utxo txbody2 + let balance :: L.MaryValue = evaluateTransactionBalance pp poolids stakeDelegDeposits utxo txbody2 adaBalance = getAda (useEra @era) balance when (adaBalance < 0) $ Left $ diff --git a/cardano-api/src/Cardano/Api/Genesis/Internal.hs b/cardano-api/src/Cardano/Api/Genesis/Internal.hs index d70751c0b0..bfd8b4c5a1 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 @@ -364,7 +366,7 @@ alonzoGenesisDefaults = , agPlutusV1CostModel = either (error . show) id (L.mkCostModel PlutusV1 defaultV1CostModelValues) , agCollateralPercentage = 150 , agCoinsPerUTxOWord = CoinPerWord $ Coin 34482 - , agExtraConfig = Just . AlonzoExtraConfig . Just $ errorFail apiCostModels + , agExtraConfig = SJust . AlonzoExtraConfig . Just $ errorFail apiCostModels } where apiCostModels = diff --git a/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs b/cardano-api/src/Cardano/Api/Internal/Orphans/Serialisation.hs index aad6036ba9..3045fe1d28 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 @@ -84,7 +82,7 @@ import Cardano.Ledger.Shelley.TxBody qualified as L import Cardano.Ledger.Shelley.TxCert qualified as L import Cardano.Protocol.Crypto qualified as P import Cardano.Protocol.TPraos.API qualified as Ledger -import Cardano.Protocol.TPraos.BHeader (HashHeader (..)) +import Cardano.Protocol.TPraos.BlockHeader (HashHeader (..)) import Cardano.Protocol.TPraos.Rules.Prtcl qualified as L import Cardano.Protocol.TPraos.Rules.Prtcl qualified as Ledger import Cardano.Protocol.TPraos.Rules.Tickn qualified as Ledger @@ -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 5aa05eaefe..b2f0406449 100644 --- a/cardano-api/src/Cardano/Api/LedgerState.hs +++ b/cardano-api/src/Cardano/Api/LedgerState.hs @@ -151,7 +151,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 @@ -165,16 +164,19 @@ 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.Praos.VRF (mkInputVRF, vrfLeaderValue) import Cardano.Protocol.TPraos.API qualified as TPraos -import Cardano.Protocol.TPraos.BHeader (checkLeaderNatValue) -import Cardano.Protocol.TPraos.BHeader qualified as TPraos +import Cardano.Protocol.TPraos.BlockHeader (checkLeaderNatValue) +import Cardano.Protocol.TPraos.BlockHeader qualified as TPraos import Cardano.Slotting.EpochInfo (EpochInfo) import Cardano.Slotting.EpochInfo.API qualified as Slot import Cardano.Slotting.Slot (WithOrigin (At, Origin)) @@ -194,7 +196,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 @@ -202,7 +203,6 @@ import Ouroboros.Consensus.Protocol.Abstract (ChainDepState, ConsensusProtocol ( import Ouroboros.Consensus.Protocol.Praos qualified as Praos import Ouroboros.Consensus.Protocol.Praos.AgentClient import Ouroboros.Consensus.Protocol.Praos.Common qualified as Consensus -import Ouroboros.Consensus.Protocol.Praos.VRF (mkInputVRF, vrfLeaderValue) import Ouroboros.Consensus.Protocol.TPraos qualified as TPraos import Ouroboros.Consensus.Shelley.HFEras qualified as Shelley import Ouroboros.Consensus.Shelley.Ledger.Block qualified as Shelley @@ -268,6 +268,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 @@ -347,18 +348,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 Ledger 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. @@ -456,7 +460,10 @@ foldBlocks . HasCallStack => Show a => MonadIOTransError FoldBlocksError t m - => NodeConfigFile 'In + => SomeHasFS IO + -- ^ Filesystem capability used by Ledger 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. @@ -484,14 +491,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. @@ -1044,50 +1051,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 @@ -1228,28 +1234,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 @@ -1427,7 +1431,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) @@ -1461,14 +1465,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 @@ -1857,13 +1864,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 = @@ -1876,7 +1883,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 @@ -1918,13 +1925,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 = @@ -1940,7 +1947,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 @@ -2265,7 +2272,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 @@ -2277,7 +2284,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 = @@ -2288,7 +2295,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 . Shelley.getOriginalTxIn) $ Map.map (fromShelleyTxOut sbe) values in case sbe of @@ -2307,7 +2314,10 @@ foldEpochState :: forall t m s . HasCallStack => MonadIOTransError FoldBlocksError t m - => NodeConfigFile 'In + => SomeHasFS IO + -- ^ Filesystem capability used by Ledger 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. @@ -2334,7 +2344,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 @@ -2342,7 +2352,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/LedgerState/Internal/Rule/TICK/NEWEPOCH.hs b/cardano-api/src/Cardano/Api/LedgerState/Internal/Rule/TICK/NEWEPOCH.hs index 7c825b6037..a8d37860e9 100644 --- a/cardano-api/src/Cardano/Api/LedgerState/Internal/Rule/TICK/NEWEPOCH.hs +++ b/cardano-api/src/Cardano/Api/LedgerState/Internal/Rule/TICK/NEWEPOCH.hs @@ -22,6 +22,7 @@ import Cardano.Ledger.Core qualified as Core import Cardano.Ledger.Shelley.Rules import Cardano.Ledger.Shelley.Rules qualified as Shelley +import Control.State.Transition (Event) import Data.Map.Strict qualified as Map type LatestTickEventConstraints ledgerera = diff --git a/cardano-api/src/Cardano/Api/ProtocolParameters.hs b/cardano-api/src/Cardano/Api/ProtocolParameters.hs index c85d19b761..a69c6ae95f 100644 --- a/cardano-api/src/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/src/Cardano/Api/ProtocolParameters.hs @@ -544,7 +544,7 @@ pparamsUpdateToIntroducedInBabbagePParams w ppupdate = data ProtocolParameters = ProtocolParameters - { protocolParamProtocolVersion :: (Natural, Natural) + { protocolParamProtocolVersion :: (Natural, Word32) -- ^ Protocol version, major and minor. Updating the major version is -- used to trigger hard forks. -- (Major , Minor ) 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/Body.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs index f70fdd302e..1e22452d80 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Body.hs @@ -2179,7 +2179,7 @@ toScriptIndexAlonzo scriptPurposeIndex = L.AlonzoSpending (L.AsIx i) -> ScriptWitnessIndexTxIn i L.AlonzoMinting (L.AsIx i) -> ScriptWitnessIndexMint i L.AlonzoCertifying (L.AsIx i) -> ScriptWitnessIndexCertificate i - L.AlonzoRewarding (L.AsIx i) -> ScriptWitnessIndexWithdrawal i + L.AlonzoWithdrawing (L.AsIx i) -> ScriptWitnessIndexWithdrawal i toScriptIndexConway :: L.ConwayPlutusPurpose L.AsIx (ShelleyLedgerEra era) @@ -2189,7 +2189,7 @@ toScriptIndexConway scriptPurposeIndex = L.ConwaySpending (L.AsIx i) -> ScriptWitnessIndexTxIn i L.ConwayMinting (L.AsIx i) -> ScriptWitnessIndexMint i L.ConwayCertifying (L.AsIx i) -> ScriptWitnessIndexCertificate i - L.ConwayRewarding (L.AsIx i) -> ScriptWitnessIndexWithdrawal i + L.ConwayWithdrawing (L.AsIx i) -> ScriptWitnessIndexWithdrawal i L.ConwayVoting (L.AsIx i) -> ScriptWitnessIndexVoting i L.ConwayProposing (L.AsIx i) -> ScriptWitnessIndexProposing i @@ -2201,7 +2201,7 @@ toScriptIndexDijkstra scriptPurposeIndex = L.DijkstraSpending (L.AsIx i) -> ScriptWitnessIndexTxIn i L.DijkstraMinting (L.AsIx i) -> ScriptWitnessIndexMint i L.DijkstraCertifying (L.AsIx i) -> ScriptWitnessIndexCertificate i - L.DijkstraRewarding (L.AsIx i) -> ScriptWitnessIndexWithdrawal i + L.DijkstraWithdrawing (L.AsIx i) -> ScriptWitnessIndexWithdrawal i L.DijkstraVoting (L.AsIx i) -> ScriptWitnessIndexVoting i L.DijkstraProposing (L.AsIx i) -> ScriptWitnessIndexProposing i L.DijkstraGuarding (L.AsIx i) -> error $ "toScriptIndexDijkstra: unexpected DijkstraGuarding at index " <> show i diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs index 5bd710c69f..ff28291b6e 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Convenience.hs @@ -27,8 +27,6 @@ import Cardano.Api.Tx.Internal.Sign import Cardano.Api.UTxO (UTxO (..)) import Cardano.Ledger.Coin qualified as L -import Cardano.Ledger.Credential qualified as L -import Cardano.Ledger.Keys qualified as L import Data.List qualified as List import Data.Map.Strict qualified as Map @@ -58,7 +56,6 @@ constructBalancedTx -> Set PoolId -- ^ The set of registered stake pools -> Map.Map StakeCredential L.Coin - -> Map.Map (L.Credential L.DRepRole) L.Coin -> [ShelleyWitnessSigningKey] -> Either (TxBodyErrorAutoBalance era) (Tx era) constructBalancedTx @@ -72,7 +69,6 @@ constructBalancedTx systemStart stakePools stakeDelegDeposits - drepDelegDeposits shelleyWitSigningKeys = do BalancedTxBody _ txbody _txBalanceOutput _fee <- makeTransactionBodyAutoBalance @@ -82,7 +78,6 @@ constructBalancedTx lpp stakePools stakeDelegDeposits - drepDelegDeposits utxo txbodcontent changeAddr diff --git a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs index 0978eb5d17..ce1543eee3 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs @@ -129,10 +129,9 @@ estimateOrCalculateBalancedTxBody -> TxBodyContent BuildTx era -> Set PoolId -> Map StakeCredential L.Coin - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin -> AddressInEra era -> Either (AutoBalanceError era) (BalancedTxBody era) -estimateOrCalculateBalancedTxBody era feeEstMode pparams txBodyContent poolids stakeDelegDeposits drepDelegDeposits changeAddr = +estimateOrCalculateBalancedTxBody era feeEstMode pparams txBodyContent poolids stakeDelegDeposits changeAddr = case feeEstMode of CalculateWithSpendableUTxO utxo systemstart ledgerEpochInfo mOverride -> first AutoBalanceCalculationError $ @@ -143,7 +142,6 @@ estimateOrCalculateBalancedTxBody era feeEstMode pparams txBodyContent poolids s (LedgerProtocolParameters pparams) poolids stakeDelegDeposits - drepDelegDeposits utxo txBodyContent changeAddr @@ -166,7 +164,6 @@ estimateOrCalculateBalancedTxBody era feeEstMode pparams txBodyContent poolids s pparams poolids stakeDelegDeposits - drepDelegDeposits exUnitsMap totalPotentialCollateral numKeyWits @@ -206,9 +203,6 @@ estimateBalancedTxBody -> Map StakeCredential L.Coin -- ^ A map of all deposits for stake credentials that are being -- unregistered in this transaction. - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ A map of all deposits for DRep credentials that are being - -- unregistered in this transaction. -> Map ScriptWitnessIndex ExecutionUnits -- ^ Plutus script execution units. -> Coin @@ -230,7 +224,6 @@ estimateBalancedTxBody pparams poolids stakeDelegDeposits - drepDelegDeposits exUnitsMap totalPotentialCollateral intendedKeyWits @@ -348,7 +341,7 @@ estimateBalancedTxBody let fakeUTxO = createFakeUTxO sbe txbodycontent1 $ selectLovelace availableUTxOValue balance = - evaluateTransactionBalance sbe pparams poolids stakeDelegDeposits drepDelegDeposits fakeUTxO txbody2 + evaluateTransactionBalance sbe pparams poolids stakeDelegDeposits fakeUTxO txbody2 balanceTxOut = TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone -- Step 6. Check all txouts have the min required UTxO value @@ -760,17 +753,15 @@ evaluateTransactionBalance -> Ledger.PParams (ShelleyLedgerEra era) -> Set PoolId -> Map StakeCredential L.Coin - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin -> UTxO era -> TxBody era -> TxOutValue era -evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo (ShelleyTxBody _ txbody _ _ _ _) = +evaluateTransactionBalance sbe pp poolids stakeDelegDeposits utxo (ShelleyTxBody _ txbody _ _ _ _) = shelleyBasedEraConstraints sbe $ TxOutValueShelleyBased sbe $ L.evalBalanceTxBody pp lookupDelegDeposit - lookupDRepDeposit isRegPool (toLedgerUTxO sbe utxo) txbody @@ -783,11 +774,6 @@ evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits u lookupDelegDeposit stakeCred = Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits - lookupDRepDeposit - :: Ledger.Credential Ledger.DRepRole -> Maybe L.Coin - lookupDRepDeposit drepCred = - Map.lookup drepCred drepDelegDeposits - -- ---------------------------------------------------------------------------- -- Automated transaction building -- @@ -972,9 +958,6 @@ makeTransactionBodyAutoBalance -> Map StakeCredential L.Coin -- ^ The map of all deposits for stake credentials that are being -- unregistered in this transaction - -> Map (Ledger.Credential Ledger.DRepRole) L.Coin - -- ^ The map of all deposits for DRep credentials that are being - -- unregistered in this transaction -> UTxO era -- ^ The transaction inputs (including reference and collateral ones), not the entire 'UTxO'. -> TxBodyContent BuildTx era @@ -990,7 +973,6 @@ makeTransactionBodyAutoBalance lpp@(LedgerProtocolParameters pp) poolids stakeDelegDeposits - drepDelegDeposits utxo txbodycontent changeaddr @@ -1004,7 +986,7 @@ makeTransactionBodyAutoBalance txbodyForChange <- first TxBodyError $ createTransactionBody sbe txbodycontent let initialChangeTxOutValue = - evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange + evaluateTransactionBalance sbe pp poolids stakeDelegDeposits utxo txbodyForChange initialChangeTxOut = TxOut changeaddr @@ -1114,7 +1096,7 @@ makeTransactionBodyAutoBalance , txReturnCollateral = retColl , txTotalCollateral = reqCol } - let balance = evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbody2 + let balance = evaluateTransactionBalance sbe pp poolids stakeDelegDeposits utxo txbody2 balanceTxOut = TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone first (uncurry TxBodyErrorMinUTxONotMet) . mapM_ (checkMinUTxOValue sbe pp) 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..fe467028b9 100644 --- a/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs +++ b/cardano-api/src/Cardano/Api/Tx/Internal/TxMetadata.hs @@ -70,12 +70,15 @@ 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.Data (Data) +import Data.ByteString.Short qualified as SBS +import Data.Data (Data, constrIndex, toConstr) 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.Ord (comparing) import Data.Scientific qualified as Scientific import Data.Text qualified as Text import Data.Text.Encoding qualified as Text @@ -97,11 +100,20 @@ data TxMetadataValue | TxMetaNumber Integer -- -2^64 .. 2^64-1 | TxMetaBytes ByteString | TxMetaText Text - deriving (Eq, Ord, Show) + deriving (Eq, Show, Data) -- Note the order of constructors is the same as the ledger definitions -- so that the Ord instance is consistent with the ledger one. -- This is checked by prop_ord_distributive_TxMetadata +-- We can't derive this instance because Ledger uses ByteArray but here we +-- have ByteString for TxMetaBytes. +instance Ord TxMetadataValue where + compare (TxMetaMap a) (TxMetaMap b) = compare a b + compare (TxMetaList a) (TxMetaList b) = compare a b + compare (TxMetaNumber a) (TxMetaNumber b) = compare a b + compare (TxMetaBytes a) (TxMetaBytes b) = comparing BS.length a b <> compare a b + compare (TxMetaText a) (TxMetaText b) = compare a b + compare a b = comparing (constrIndex . toConstr) a b -- | Merge metadata maps. When there are clashing entries the left hand side -- takes precedence. @@ -227,7 +239,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 +257,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-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs index 8f828c355a..c8af85d935 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental.hs @@ -257,7 +257,6 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do exampleProtocolParams mempty mempty - mempty 0 let recFee = recFeeTx ^. (L.bodyTxL . L.feeTxBodyL) @@ -288,7 +287,6 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do mempty mempty mempty - mempty 0 1 0 @@ -305,7 +303,6 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do mempty mempty mempty - mempty 0 1 0 @@ -351,7 +348,6 @@ prop_balance_transaction_two_ways = H.propertyOnce $ do (Api.LedgerProtocolParameters exampleProtocolParams) mempty mempty - mempty utxoToUse txBodyContent changeAddress @@ -755,7 +751,7 @@ genUnderfundedTx era = do prop_calcMinFeeRecursive_well_funded_succeeds :: Property prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left err -> H.annotateShow err >> H.failure Right (Exp.UnsignedTx resultLedgerTx) -> do let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL @@ -765,7 +761,6 @@ prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do UnexportedLedger.evalBalanceTxBody exampleProtocolParams (const Nothing) - (const Nothing) (const False) utxo (resultLedgerTx ^. L.bodyTxL) @@ -777,7 +772,7 @@ prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do prop_calcMinFeeRecursive_well_funded_multi_asset :: Property prop_calcMinFeeRecursive_well_funded_multi_asset = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedMultiAssetTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left err -> H.annotateShow err >> H.failure Right (Exp.UnsignedTx resultLedgerTx) -> do let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL @@ -786,7 +781,6 @@ prop_calcMinFeeRecursive_well_funded_multi_asset = H.property $ do UnexportedLedger.evalBalanceTxBody exampleProtocolParams (const Nothing) - (const Nothing) (const False) utxo (resultLedgerTx ^. L.bodyTxL) @@ -798,12 +792,12 @@ prop_calcMinFeeRecursive_well_funded_multi_asset = H.property $ do prop_calcMinFeeRecursive_fee_fixpoint :: Property prop_calcMinFeeRecursive_fee_fixpoint = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left err -> H.annotateShow err >> H.failure Right resultTx -> do secondResult <- H.evalEither $ - Exp.calcMinFeeRecursive changeAddr resultTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr resultTx utxo exampleProtocolParams mempty mempty 0 resultTx H.=== secondResult -- | When the outputs exceed the UTxO value the function returns @@ -811,7 +805,7 @@ prop_calcMinFeeRecursive_fee_fixpoint = H.property $ do prop_calcMinFeeRecursive_insufficient_funds :: Property prop_calcMinFeeRecursive_insufficient_funds = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genUnderfundedTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NotEnoughAdaForNewOutput deficit) -> H.assert $ deficit < L.Coin 0 Left Exp.NonAdaAssetsUnbalanced{} -> H.annotate "Unexpected NonAdaAssetsUnbalanced error" >> H.failure Left Exp.MinUTxONotMet{} -> H.annotate "Unexpected MinUTxONotMet error" >> H.failure @@ -942,7 +936,7 @@ genNoOutputsTx era = do prop_calcMinFeeRecursive_non_ada_unbalanced :: Property prop_calcMinFeeRecursive_non_ada_unbalanced = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genNonAdaUnbalancedTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NonAdaAssetsUnbalanced _) -> H.success Left Exp.NotEnoughAdaForChangeOutput{} -> H.annotate "Unexpected NotEnoughAdaForChangeOutput" >> H.failure Left Exp.NotEnoughAdaForNewOutput{} -> H.annotate "Unexpected NotEnoughAdaForNewOutput" >> H.failure @@ -956,7 +950,7 @@ prop_calcMinFeeRecursive_non_ada_unbalanced = H.property $ do prop_calcMinFeeRecursive_min_utxo_not_met :: Property prop_calcMinFeeRecursive_min_utxo_not_met = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genMinUTxOViolatingTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.MinUTxONotMet actual required) -> do H.annotate $ "Actual: " <> show actual <> ", Required: " <> show required H.assert $ actual < required @@ -971,7 +965,7 @@ prop_calcMinFeeRecursive_min_utxo_not_met = H.property $ do prop_calcMinFeeRecursive_no_tx_outs :: Property prop_calcMinFeeRecursive_no_tx_outs = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genNoOutputsTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left err -> H.annotateShow err >> H.failure Right (Exp.UnsignedTx resultLedgerTx) -> do let outs = toList $ resultLedgerTx ^. L.bodyTxL . L.outputsTxBodyL diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental/Fee.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental/Fee.hs index 483a2bd05f..18f36fbe35 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental/Fee.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Experimental/Fee.hs @@ -555,7 +555,7 @@ prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra Exp.UnsignedTx resultLedgerTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL H.assertWith resultFee (> L.Coin 0) -- The resulting transaction must be fully balanced (zero balance). @@ -563,7 +563,6 @@ prop_calcMinFeeRecursive_well_funded_succeeds = H.property $ do UnexportedLedger.evalBalanceTxBody exampleProtocolParams (const Nothing) - (const Nothing) (const False) utxo (resultLedgerTx ^. L.bodyTxL) @@ -577,14 +576,13 @@ prop_calcMinFeeRecursive_well_funded_multi_asset = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedMultiAssetTx Exp.ConwayEra Exp.UnsignedTx resultLedgerTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL H.assertWith resultFee (> L.Coin 0) let balance = UnexportedLedger.evalBalanceTxBody exampleProtocolParams (const Nothing) - (const Nothing) (const False) utxo (resultLedgerTx ^. L.bodyTxL) @@ -598,10 +596,10 @@ prop_calcMinFeeRecursive_fee_fixpoint = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra resultTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 secondResult <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr resultTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr resultTx utxo exampleProtocolParams mempty mempty 0 resultTx H.=== secondResult -- | When the outputs exceed the UTxO value the function returns @@ -609,7 +607,7 @@ prop_calcMinFeeRecursive_fee_fixpoint = H.property $ do prop_calcMinFeeRecursive_insufficient_funds :: Property prop_calcMinFeeRecursive_insufficient_funds = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genUnderfundedTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NotEnoughAdaForNewOutput deficit) -> H.assertWith deficit (< L.Coin 0) Left Exp.NonAdaAssetsUnbalanced{} -> H.annotate "Unexpected NonAdaAssetsUnbalanced error" >> H.failure Left Exp.MinUTxONotMet{} -> H.annotate "Unexpected MinUTxONotMet error" >> H.failure @@ -622,7 +620,7 @@ prop_calcMinFeeRecursive_insufficient_funds = H.property $ do prop_calcMinFeeRecursive_non_ada_unbalanced :: Property prop_calcMinFeeRecursive_non_ada_unbalanced = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genNonAdaUnbalancedTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NonAdaAssetsUnbalanced _) -> H.success Left Exp.NotEnoughAdaForChangeOutput{} -> H.annotate "Unexpected NotEnoughAdaForChangeOutput" >> H.failure Left Exp.NotEnoughAdaForNewOutput{} -> H.annotate "Unexpected NotEnoughAdaForNewOutput" >> H.failure @@ -636,7 +634,7 @@ prop_calcMinFeeRecursive_non_ada_unbalanced = H.property $ do prop_calcMinFeeRecursive_min_utxo_not_met :: Property prop_calcMinFeeRecursive_min_utxo_not_met = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genMinUTxOViolatingTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.MinUTxONotMet actual required) -> H.assertWith (actual, required) (uncurry (<)) Left Exp.NotEnoughAdaForChangeOutput{} -> H.annotate "Unexpected NotEnoughAdaForChangeOutput" >> H.failure @@ -652,7 +650,7 @@ prop_calcMinFeeRecursive_no_tx_outs = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genNoOutputsTx Exp.ConwayEra Exp.UnsignedTx resultLedgerTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 let outs = toList $ resultLedgerTx ^. L.bodyTxL . L.outputsTxBodyL -- The result should have exactly one output (the change output) length outs H.=== 1 @@ -663,7 +661,7 @@ prop_calcMinFeeRecursive_no_tx_outs = H.property $ do prop_calcMinFeeRecursive_tiny_surplus_not_enough_ada :: Property prop_calcMinFeeRecursive_tiny_surplus_not_enough_ada = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genTinySurplusTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NotEnoughAdaForChangeOutput deficit) -> H.assertWith deficit (< L.Coin 0) Left (Exp.MinUTxONotMet actual required) -> @@ -684,14 +682,13 @@ prop_calcMinFeeRecursive_withdrawal_funded_succeeds = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genWithdrawalFundedTx Exp.ConwayEra Exp.UnsignedTx resultLedgerTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 let resultFee = resultLedgerTx ^. L.bodyTxL . L.feeTxBodyL H.assertWith resultFee (> L.Coin 0) let balance = UnexportedLedger.evalBalanceTxBody exampleProtocolParams (const Nothing) - (const Nothing) (const False) utxo (resultLedgerTx ^. L.bodyTxL) @@ -704,7 +701,7 @@ prop_calcMinFeeRecursive_withdrawal_funded_succeeds = H.property $ do prop_calcMinFeeRecursive_withdrawal_tiny_input_fails :: Property prop_calcMinFeeRecursive_withdrawal_tiny_input_fails = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genWithdrawalTinyInputTx Exp.ConwayEra - case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 of + case Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 of Left (Exp.NotEnoughAdaForChangeOutput deficit) -> H.assertWith deficit (< L.Coin 0) Left (Exp.NotEnoughAdaForNewOutput deficit) -> @@ -736,7 +733,6 @@ prop_makeTransactionBodyAutoBalance_balance_negative = H.property $ do exampleProtocolParams mempty mempty - mempty utxo txBodyContent changeAddr @@ -770,7 +766,7 @@ prop_evaluateSignedTx_balanced_mempty = H.property $ do (unsignedTx, utxo, changeAddr) <- H.forAll $ genFundedSimpleTx Exp.ConwayEra Exp.UnsignedTx balancedLedgerTx <- H.leftFail $ - Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty mempty 0 + Exp.calcMinFeeRecursive changeAddr unsignedTx utxo exampleProtocolParams mempty mempty 0 let signedTx = Exp.SignedTx balancedLedgerTx systemStart = Api.SystemStart $ Time.posixSecondsToUTCTime 0 epochInfo = @@ -783,7 +779,6 @@ prop_evaluateSignedTx_balanced_mempty = H.property $ do exampleProtocolParams mempty mempty - mempty utxo signedTx Exp.txEvalBalance result H.=== mempty @@ -810,7 +805,6 @@ evalSimpleTx = do exampleProtocolParams mempty mempty - mempty utxo signedTx pure (result, utxo, unsignedTx, changeAddr) diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs index edb1c2ec46..b0ba793caf 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Genesis.hs @@ -83,7 +83,8 @@ prop_check_default_alonzo_genesis_roundtrips = H.propertyOnce $ do ] forM_ eras $ \(Some aeo) -> do - let defaultCostModels = fromJust . L.aecCostModels $ fromJust $ L.agExtraConfig alonzoGenesisDefaults + let defaultCostModels = + fromJust . L.aecCostModels $ fromJust $ L.strictMaybeToMaybe $ L.agExtraConfig alonzoGenesisDefaults defaultCostModelsBs = encodeCborInEraCostModels aeo defaultCostModels H.note_ $ "Decode alonzo genesis for era " <> show aeo defaultCostModels' <- H.leftFail $ decodeCborInEraCostModels aeo defaultCostModelsBs @@ -126,6 +127,7 @@ loadPlutusV2CostModelFromGenesis filePath = withFrozenCallStack . runExceptT $ d ] ) Right + $ L.strictMaybeToMaybe $ L.agExtraConfig aGen costModels <- diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 69b17cbb8f..692d7bbb7d 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -126,7 +126,6 @@ prop_make_transaction_body_autobalance_invariants = H.property $ do pparams mempty mempty - mempty utxos content changeAddress @@ -215,7 +214,6 @@ prop_make_transaction_body_autobalance_no_change = H.propertyOnce $ do pparams mempty mempty - mempty utxos content address @@ -280,7 +278,6 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr pparams mempty mempty - mempty utxos contentWithTxoutAsset address @@ -310,7 +307,6 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr pparams mempty mempty - mempty utxos content address @@ -391,7 +387,6 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.property $ d pparams mempty [(stakeCred, deregDeposit)] - mempty utxos content address @@ -449,7 +444,6 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ pparams mempty mempty - mempty utxos content address @@ -607,7 +601,6 @@ prop_ensure_gov_actions_are_preserved_by_autobalance = H.propertyOnce $ do pparams mempty mempty - mempty utxos content address diff --git a/cardano-rpc/cardano-rpc.cabal b/cardano-rpc/cardano-rpc.cabal index e44e186113..d9350c8a36 100644 --- a/cardano-rpc/cardano-rpc.cabal +++ b/cardano-rpc/cardano-rpc.cabal @@ -88,7 +88,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/Eval.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Eval.hs index 84e8bcb03e..667bd64dd9 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Eval.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Eval.hs @@ -59,13 +59,13 @@ evalTxMethod request = do Set.map fromShelleyTxIn $ ledgerTx ^. L.bodyTxL . L.allInputsTxBodyF - let (unregStakeCreds, unregDRepCreds, regPoolIds) = + let (unregStakeCreds, _unregDRepCreds, regPoolIds) = extractBalanceCheckCreds eon $ ledgerTx ^. L.bodyTxL apiStakeCreds = Set.map fromShelleyStakeCredential unregStakeCreds apiPoolIds = Set.map StakePoolKeyHash regPoolIds let target = VolatileTip - (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, drepStates, registeredPools) <- + (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, registeredPools) <- liftIO . (throwEither =<<) $ executeLocalStateQueryExpr nodeConnInfo target $ do protocolParams <- throwEither =<< throwEither =<< queryProtocolParameters (convert eon) @@ -74,15 +74,13 @@ evalTxMethod request = do eraHistory <- throwEither =<< queryEraHistory stakeDelegDeposits <- throwEither =<< throwEither =<< queryStakeDelegDeposits (convert eon) apiStakeCreds - drepStates <- throwEither =<< throwEither =<< queryDRepState (convert eon) unregDRepCreds registeredPools <- throwEither =<< throwEither =<< queryStakePoolParameters (convert eon) apiPoolIds pure - (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, drepStates, registeredPools) + (protocolParams, utxo, systemStart, eraHistory, stakeDelegDeposits, registeredPools) obtainCommonConstraints eon $ do let ledgerUtxo = toLedgerUTxO (convert eon) utxo epochInfo = toLedgerEpochInfo eraHistory - drepDeposits = Map.map (L.fromCompact . L.drepDeposit) drepStates poolIdSet = Map.keysSet registeredPools Exp.TxEvaluationResult fee evalUnits balance = Exp.evaluateTransaction @@ -91,7 +89,6 @@ evalTxMethod request = do protocolParams poolIdSet stakeDelegDeposits - drepDeposits ledgerUtxo ledgerTx redeemerData = diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/ProtocolParameters.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/ProtocolParameters.hs index 1ee46e2f04..fd56c987db 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/ProtocolParameters.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/ProtocolParameters.hs @@ -312,7 +312,7 @@ utxoRpcPParamsToProtocolParams era pp = conwayEraOnwardsConstraints (convert era pvMajorL :: Lens' L.ProtVer L.Version pvMajorL = lens L.pvMajor $ \p v -> p{L.pvMajor = v} - pvMinorL :: Lens' L.ProtVer Natural + pvMinorL :: Lens' L.ProtVer Word32 pvMinorL = lens L.pvMinor $ \p v -> p{L.pvMinor = v} prStepsL :: Lens' L.Prices L.NonNegativeInterval diff --git a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/TxOutput.hs b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/TxOutput.hs index cda51d27da..7d084d9962 100644 --- a/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/TxOutput.hs +++ b/cardano-rpc/src/Cardano/Rpc/Server/Internal/UtxoRpc/Type/TxOutput.hs @@ -16,6 +16,7 @@ where import Cardano.Api.Address 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 @@ -31,8 +32,6 @@ import Cardano.Rpc.Server.Internal.UtxoRpc.Type.BigInt import Cardano.Rpc.Server.Internal.UtxoRpc.Type.PlutusData import Cardano.Rpc.Server.Internal.UtxoRpc.Type.Script -import Cardano.Binary qualified as CBOR - import RIO hiding (toList) import Data.ProtoLens (defMessage) @@ -50,7 +49,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 diff --git a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs index 283d470447..6c30138a3d 100644 --- a/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs +++ b/cardano-rpc/test/cardano-rpc-test/Test/Cardano/Rpc/ProtocolParameters.hs @@ -105,7 +105,7 @@ clipI n v pvMajorL :: Lens' L.ProtVer L.Version pvMajorL = lens L.pvMajor $ \p v -> p{L.pvMajor = v} -pvMinorL :: Lens' L.ProtVer Natural +pvMinorL :: Lens' L.ProtVer Word32 pvMinorL = lens L.pvMinor $ \p v -> p{L.pvMinor = v} prStepsL :: Lens' L.Prices L.NonNegativeInterval diff --git a/flake.lock b/flake.lock index cd0f4fb884..a85327e4cc 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1779957774, - "narHash": "sha256-VUzCpkEokaKNnvFEMM386ijgzKgP6pRIo2odQj9XBb0=", + "lastModified": 1782990451, + "narHash": "sha256-U0o77JuGp6ADqym7TtGV3AwzRn5SFuiTRyCOR6qfxGA=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "9a187ad488ecf19944d6d119c41eff683a1ff54f", + "rev": "def6ba6e0324e451802f5a17b12a00bd64639e14", "type": "github" }, "original": { @@ -439,11 +439,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1780017704, - "narHash": "sha256-wW8jzU8UMWmF8LkM5ZXJXxV9cSg5JKKeP4jmuw/ki+Q=", + "lastModified": 1782826502, + "narHash": "sha256-G6bt7DeWkDXJWI/fHME467V/SOaUdfG6hk7bTRuWyKg=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "06ae6246e0f2d65fbb869c9e4947898f2d363613", + "rev": "6a87e2657c145eb81d5f0f53702d4f26c08f9cbf", "type": "github" }, "original": {