diff --git a/cabal.project b/cabal.project index 27223f02bfb..6962696eacc 100644 --- a/cabal.project +++ b/cabal.project @@ -118,8 +118,8 @@ source-repository-package source-repository-package type: git location: https://github.com/input-output-hk/cardano-node - tag: 84a871ed86fc1b86018231b9cb24ba7b83493c0d - --sha256: 0qnr847z4fvxvbjsa0x0vfhmdwwmr99d6m3j4sh6jxdyph099b2n + tag: c02b0ab3786dce24bcd9899509be767057286f53 + --sha256: 1igxway613vzgkjypk4vbn9dkws7faygbdd72x90h0n14p47i2js subdir: cardano-api cardano-git-rev @@ -161,8 +161,8 @@ constraints: , Cabal >= 3.4.0.0 , async-timer >= 0.2.0.0 , unliftio-core >= 0.2.0.1 - , cardano-api >= 1.35.4 - , cardano-node >= 1.35.4 + , cardano-api >= 1.35.6 + , cardano-node >= 1.35.6 , generic-arbitrary >= 0.2.2 , iohk-monitoring >= 0.1.11 diff --git a/flake.lock b/flake.lock index 1060653edac..2758faebf74 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1678700984, - "narHash": "sha256-HzXVzCPJSnJGxatqOmbcLc23qDHvF4itTkqk4oxi3dk=", + "lastModified": 1679576818, + "narHash": "sha256-bsmI+91hGtJaxBa9V6QRA6wnh4cRhLo5m7HnVn428KU=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "81f266cd592aa855cc07b410cc1c16f7ae031da7", + "rev": "4a15403f6adbac6f47bcedbabac946f9c2636e59", "type": "github" }, "original": { diff --git a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs index 2bd190c777b..2187004cc52 100644 --- a/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs +++ b/lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs @@ -3071,12 +3071,14 @@ balanceTransaction (getState wallet) partialTx where - nodePParams = fromMaybe + nodePParams = maybe (error $ unwords [ "balanceTransaction: no nodePParams." , "Should only be possible in Byron, where" , "withRecentEra should prevent this being reached." ]) + (Cardano.bundleProtocolParams + (WriteTx.fromRecentEra (WriteTx.recentEra @era))) $ W.currentNodeProtocolParameters pp anyRecentTx <- maybeToHandler (Write.ErrOldEraNotSupported era) diff --git a/lib/wallet/src/Cardano/Api/Extra.hs b/lib/wallet/src/Cardano/Api/Extra.hs index 48311339bde..53534fdb200 100644 --- a/lib/wallet/src/Cardano/Api/Extra.hs +++ b/lib/wallet/src/Cardano/Api/Extra.hs @@ -12,12 +12,14 @@ module Cardano.Api.Extra , inAnyCardanoEra , asAnyShelleyBasedEra , fromShelleyBasedScript + , unbundleLedgerShelleyBasedProtocolParams ) where import Prelude import Cardano.Api - ( CardanoEra (..) + ( BundledProtocolParameters (..) + , CardanoEra (..) , InAnyCardanoEra (..) , InAnyShelleyBasedEra (..) , IsCardanoEra (cardanoEra) @@ -135,3 +137,16 @@ fromShelleyBasedScript era script = case era of ScriptInEra PlutusScriptV2InConway $ PlutusScript PlutusScriptV2 $ PlutusScriptSerialised s + +-- Not exposed by cardano-api +unbundleLedgerShelleyBasedProtocolParams + :: ShelleyBasedEra era + -> BundledProtocolParameters era + -> Ledger.PParams (ShelleyLedgerEra era) +unbundleLedgerShelleyBasedProtocolParams = \case + ShelleyBasedEraShelley -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp + ShelleyBasedEraAllegra -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp + ShelleyBasedEraMary -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp + ShelleyBasedEraAlonzo -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp + ShelleyBasedEraBabbage -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp + ShelleyBasedEraConway -> \(BundleAsShelleyBasedProtocolParameters _ _ lpp) -> lpp diff --git a/lib/wallet/src/Cardano/Wallet.hs b/lib/wallet/src/Cardano/Wallet.hs index fc705aefbd3..eb8d73e858a 100644 --- a/lib/wallet/src/Cardano/Wallet.hs +++ b/lib/wallet/src/Cardano/Wallet.hs @@ -2253,12 +2253,14 @@ buildTransactionPure where nodeProtocolParameters = ( protocolParams - , fromMaybe + , maybe (error $ unwords [ "buildAndSignTransactionPure: no nodePParams." , "should only be possible in Byron, where" , "withRecentEra should prevent this to be reached." ]) + (Cardano.bundleProtocolParams + (WriteTx.fromRecentEra (WriteTx.recentEra @era))) $ currentNodeProtocolParameters protocolParams ) diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/MinimumUTxO/Internal.hs b/lib/wallet/src/Cardano/Wallet/Shelley/MinimumUTxO/Internal.hs index 960fec6a1dd..713068db2c5 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/MinimumUTxO/Internal.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/MinimumUTxO/Internal.hs @@ -58,7 +58,9 @@ computeMinimumCoinForUTxO_CardanoApi unsafeCoinFromResult $ Cardano.calculateMinimumUTxO era (toCardanoTxOut era txOut) - (Cardano.fromLedgerPParams era pp) + (Cardano.bundleProtocolParams + (Cardano.shelleyBasedToCardanoEra era) + (Cardano.fromLedgerPParams era pp)) where unsafeCoinFromResult :: Either Cardano.MinimumUTxOError Cardano.Lovelace diff --git a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs index 90156cb1d6d..462d04bac4f 100644 --- a/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs +++ b/lib/wallet/src/Cardano/Wallet/Shelley/Transaction.hs @@ -276,6 +276,7 @@ import Ouroboros.Network.Block import qualified Cardano.Api as Cardano import qualified Cardano.Api.Byron as Byron +import qualified Cardano.Api.Extra as Cardano import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Chain.Common as Byron import qualified Cardano.Crypto as CC @@ -1010,7 +1011,7 @@ dummySkeleton inputCount outputs = SelectionSkeleton -- using ledger's functionality. evaluateMinimumFee :: Cardano.IsShelleyBasedEra era - => Cardano.ProtocolParameters + => Cardano.BundledProtocolParameters era -> KeyWitnessCount -> Cardano.TxBody era -> Coin @@ -1021,7 +1022,8 @@ evaluateMinimumFee pp (KeyWitnessCount nWits nBootWits) body = -- nBootWits, so we need to account for it separately. where bootWitFees = Coin.fromNatural $ - Cardano.protocolParamTxFeePerByte pp * bytes + Cardano.protocolParamTxFeePerByte + (Cardano.unbundleProtocolParams pp) * bytes where bytes :: Natural bytes = fromIntegral $ sizeOf_BootstrapWitnesses $ intCast nBootWits @@ -1029,7 +1031,7 @@ evaluateMinimumFee pp (KeyWitnessCount nWits nBootWits) body = -- | Estimate the size of the transaction (body) when fully signed. estimateSignedTxSize :: Cardano.IsShelleyBasedEra era - => Cardano.ProtocolParameters + => Cardano.BundledProtocolParameters era -> KeyWitnessCount -> Cardano.TxBody era -> TxSize @@ -1072,7 +1074,7 @@ estimateSignedTxSize pparams nWits body = feePerByte :: Coin feePerByte = Coin.fromNatural $ - view #protocolParamTxFeePerByte pparams + view #protocolParamTxFeePerByte (Cardano.unbundleProtocolParams pparams) numberOfShelleyWitnesses :: Word -> KeyWitnessCount numberOfShelleyWitnesses n = KeyWitnessCount n 0 @@ -1216,7 +1218,7 @@ type ConwayTx = assignScriptRedeemers :: forall era. Cardano.IsShelleyBasedEra era - => Cardano.ProtocolParameters + => Cardano.BundledProtocolParameters era -> TimeInterpreter (Either PastHorizonException) -> Cardano.UTxO era -> [Redeemer] @@ -1272,6 +1274,10 @@ assignScriptRedeemers pparams ti utxo redeemers tx = systemStart = getSystemStart ti + pparams' = Cardano.unbundleLedgerShelleyBasedProtocolParams + (shelleyBasedEra @era) + pparams + -- | Assign redeemers with null execution units to the input transaction. -- -- Redeemers are determined from the context given to the caller via the @@ -1352,8 +1358,6 @@ assignScriptRedeemers pparams ti utxo redeemers tx = -> Either ErrAssignRedeemers (Map Alonzo.RdmrPtr (Either ErrAssignRedeemers Alonzo.ExUnits)) evaluateExecutionUnitsAlonzo indexedRedeemers alonzoTx = do - let pparams' = Cardano.toLedgerPParams - Cardano.ShelleyBasedEraAlonzo pparams let costs = toCostModelsAsArray (Alonzo.unCostModels $ Alonzo._costmdls pparams') let res = evaluateTransactionExecutionUnits @@ -1376,8 +1380,6 @@ assignScriptRedeemers pparams ti utxo redeemers tx = -> Either ErrAssignRedeemers (Map Alonzo.RdmrPtr (Either ErrAssignRedeemers Alonzo.ExUnits)) evaluateExecutionUnitsBabbage indexedRedeemers babbageTx = do - let pparams' = Cardano.toLedgerPParams - Cardano.ShelleyBasedEraBabbage pparams let costs = toCostModelsAsArray (Alonzo.unCostModels $ Babbage._costmdls pparams') @@ -1401,8 +1403,6 @@ assignScriptRedeemers pparams ti utxo redeemers tx = -> Either ErrAssignRedeemers (Map Alonzo.RdmrPtr (Either ErrAssignRedeemers Alonzo.ExUnits)) evaluateExecutionUnitsConway indexedRedeemers conwayTx = do - let pparams' = Cardano.toLedgerPParams - Cardano.ShelleyBasedEraConway pparams let costs = toCostModelsAsArray (Alonzo.unCostModels $ Conway._costmdls pparams') @@ -1485,7 +1485,9 @@ assignScriptRedeemers pparams ti utxo redeemers tx = -- | Finally, calculate and add the script integrity hash with the new -- final redeemers, if any. - addScriptIntegrityHashAlonzo :: AlonzoTx -> AlonzoTx + addScriptIntegrityHashAlonzo + :: era ~ Cardano.AlonzoEra + => AlonzoTx -> AlonzoTx addScriptIntegrityHashAlonzo alonzoTx = let wits = Alonzo.wits alonzoTx langs = @@ -1497,16 +1499,15 @@ assignScriptRedeemers pparams ti utxo redeemers tx = in alonzoTx { Alonzo.body = (Alonzo.body alonzoTx) { Alonzo.scriptIntegrityHash = Alonzo.hashScriptIntegrity - (Set.fromList $ Alonzo.getLanguageView - (Cardano.toLedgerPParams - Cardano.ShelleyBasedEraAlonzo pparams) - <$> langs) + (Set.fromList $ Alonzo.getLanguageView pparams' <$> langs) (Alonzo.txrdmrs wits) (Alonzo.txdats wits) } } - addScriptIntegrityHashBabbage :: BabbageTx -> BabbageTx + addScriptIntegrityHashBabbage + :: era ~ Cardano.BabbageEra + => BabbageTx -> BabbageTx addScriptIntegrityHashBabbage babbageTx = let wits = Alonzo.wits babbageTx langs = @@ -1518,16 +1519,16 @@ assignScriptRedeemers pparams ti utxo redeemers tx = in babbageTx { Babbage.body = (Babbage.body babbageTx) { Babbage.scriptIntegrityHash = Alonzo.hashScriptIntegrity - (Set.fromList $ Alonzo.getLanguageView - (Cardano.toLedgerPParams - Cardano.ShelleyBasedEraBabbage pparams) + (Set.fromList $ Alonzo.getLanguageView pparams' <$> langs) (Alonzo.txrdmrs wits) (Alonzo.txdats wits) } } - addScriptIntegrityHashConway :: ConwayTx -> ConwayTx + addScriptIntegrityHashConway + :: era ~ Cardano.ConwayEra + => ConwayTx -> ConwayTx addScriptIntegrityHashConway conwayTx = let wits = Alonzo.wits conwayTx langs = @@ -1539,9 +1540,7 @@ assignScriptRedeemers pparams ti utxo redeemers tx = in conwayTx { Conway.body = (Conway.body conwayTx) { Conway.scriptIntegrityHash = Alonzo.hashScriptIntegrity - (Set.fromList $ Alonzo.getLanguageView - (Cardano.toLedgerPParams - Cardano.ShelleyBasedEraConway pparams) + (Set.fromList $ Alonzo.getLanguageView pparams' <$> langs) (Alonzo.txrdmrs wits) (Alonzo.txdats wits) diff --git a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs index 8ec8fd076bb..be86adb6445 100644 --- a/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs +++ b/lib/wallet/src/Cardano/Wallet/Write/Tx/Balance.hs @@ -164,6 +164,7 @@ import Text.Pretty.Simple import qualified Cardano.Address.Script as CA import qualified Cardano.Api as Cardano +import qualified Cardano.Api.Extra as Cardano import qualified Cardano.Api.Shelley as Cardano import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Primitive.Types.Address as W @@ -351,7 +352,7 @@ balanceTransaction ) => Tracer m BalanceTxLog -> UTxOAssumptions - -> (W.ProtocolParameters, Cardano.ProtocolParameters) + -> (W.ProtocolParameters, Cardano.BundledProtocolParameters era) -- ^ 'Cardano.ProtocolParameters' can be retrieved via a Local State Query -- to a local node. -- @@ -377,11 +378,9 @@ balanceTransaction -> PartialTx era -> ExceptT ErrBalanceTx m (Cardano.Tx era, changeState) balanceTransaction tr utxoAssumptions pp ti utxo genChange s unadjustedPtx = do - -- TODO [ADP-1490] Take 'Ledger.PParams era' directly as argument, and avoid - -- converting to/from Cardano.ProtocolParameters. This may affect - -- performance. The addition of this one specific conversion seems to have - -- made the --match "balanceTransaction" unit tests 11% slower in CPU time. - let ledgerPP = Cardano.toLedgerPParams shelleyEra $ snd pp + let ledgerPP = Cardano.unbundleLedgerShelleyBasedProtocolParams + shelleyEra + (snd pp) let adjustedPtx = over (#tx) (increaseZeroAdaOutputs (recentEra @era) ledgerPP) unadjustedPtx @@ -470,7 +469,7 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment ) => Tracer m BalanceTxLog -> UTxOAssumptions - -> (W.ProtocolParameters, Cardano.ProtocolParameters) + -> (W.ProtocolParameters, Cardano.BundledProtocolParameters era) -> TimeInterpreter (Either PastHorizonException) -> UTxOIndex WalletUTxO -> ChangeAddressGen changeState @@ -704,7 +703,9 @@ balanceTransactionWithSelectionStrategyAndNoZeroAdaAdjustment . Write.Tx.fromCardanoTx ledgerPP = - Cardano.toLedgerPParams (Cardano.shelleyBasedEra @era) nodePParams + Cardano.unbundleLedgerShelleyBasedProtocolParams + (Cardano.shelleyBasedEra @era) + nodePParams balanceAfterSettingMinFee :: Cardano.Tx era diff --git a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 9a0b3129b30..645b0ee0fe6 100644 --- a/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/wallet/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -476,6 +476,7 @@ import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo +import qualified Cardano.Ledger.Babbage as Babbage import qualified Cardano.Ledger.Babbage.PParams as Babbage import qualified Cardano.Ledger.Babbage.Tx as Babbage import qualified Cardano.Ledger.Babbage.TxBody as Babbage @@ -2750,7 +2751,7 @@ balanceTransactionSpec = describe "balanceTransaction" $ do fst <$> balanceTransaction nullTracer (allKeyPaymentCredentials testTxLayer) - mockProtocolParametersForBalancing + (mockBundledProtocolParametersForBalancing cardanoEra) (dummyTimeInterpreterWithHorizon horizon) utxoIndex (defaultChangeAddressGen @@ -3641,7 +3642,7 @@ balanceTransaction' (Wallet' utxoIndex wallet _pending) seed tx = fst <$> balanceTransaction nullTracer (allKeyPaymentCredentials testTxLayer) - mockProtocolParametersForBalancing + (mockBundledProtocolParametersForBalancing cardanoEra) dummyTimeInterpreter utxoIndex (defaultChangeAddressGen @@ -3696,7 +3697,7 @@ balanceTransactionWithDummyChangeState cs utxo seed ptx = balanceTransaction @_ @(Rand StdGen) (nullTracer @(Rand StdGen)) cs - mockProtocolParametersForBalancing + (mockBundledProtocolParametersForBalancing cardanoEra) dummyTimeInterpreter utxoIndex dummyChangeAddrGen @@ -3745,17 +3746,16 @@ instance Buildable BalanceTxGolden where testStdGenSeed :: StdGenSeed testStdGenSeed = StdGenSeed 0 -balanceTransactionGoldenSpec - :: Spec +balanceTransactionGoldenSpec :: Spec balanceTransactionGoldenSpec = describe "balance goldens" $ do it "testPParams" $ do let name = "testPParams" let dir = $(getTestData) "balanceTx" "binary" - - let pp = Cardano.toLedgerPParams Cardano.ShelleyBasedEraBabbage - $ snd mockProtocolParametersForBalancing + let ledgerPParams = + Cardano.toLedgerPParams Cardano.ShelleyBasedEraBabbage + $ snd mockProtocolParametersForBalancing Golden - { output = pp + { output = ledgerPParams , encodePretty = show , writeToFile = \fp x -> T.writeFile fp $ T.pack . toCBORHex $ x @@ -3912,7 +3912,7 @@ balanceTransactionGoldenSpec = describe "balance goldens" $ do -> Cardano.UTxO Cardano.BabbageEra -> Cardano.Lovelace txMinFee (Cardano.Tx body _) u = toCardanoLovelace $ evaluateMinimumFee - (snd mockProtocolParametersForBalancing) + (snd (mockBundledProtocolParametersForBalancing cardanoEra)) (estimateKeyWitnessCount u body) body @@ -4090,7 +4090,7 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed prop_validSize tx@(Cardano.Tx body _) utxo = do let (TxSize size) = estimateSignedTxSize - (snd mockProtocolParametersForBalancing) + (snd (mockBundledProtocolParametersForBalancing cardanoEra)) (estimateKeyWitnessCount utxo body) body let limit = fromIntegral $ getQuantity $ @@ -4116,9 +4116,9 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed valid :: WriteTx.TxOut WriteTx.StandardAlonzo -> Property valid out = counterexample msg $ property $ - not $ WriteTx.isBelowMinimumCoinForTxOut era pp out + not $ WriteTx.isBelowMinimumCoinForTxOut era ledgerPParams out where - pp = ledgerPParams + msg = unwords [ "ada quantity is" , "below minimum requirement" @@ -4180,9 +4180,11 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx) seed TxOutAdaOnly _ coin -> Cardano.lovelaceToValue coin TxOutValue _ val -> val - (_, nodePParams) = mockProtocolParametersForBalancing - ledgerPParams = Cardano.toLedgerPParams - Cardano.ShelleyBasedEraAlonzo nodePParams + (_, nodePParams) = mockBundledProtocolParametersForBalancing cardanoEra + + ledgerPParams = + Cardano.toLedgerPParams Cardano.ShelleyBasedEraAlonzo + $ snd mockProtocolParametersForBalancing prop_balanceTransactionExistingTotalCollateral :: Wallet' @@ -4308,9 +4310,9 @@ hasReturnCollateral (Cardano.Tx (Cardano.TxBody content) _) = -- function, so we need to manually ensure the hard-coded values are consistent. mockProtocolParametersForBalancing :: (ProtocolParameters, Cardano.ProtocolParameters) -mockProtocolParametersForBalancing = (mockProtocolParameters, nodePParams) - where - nodePParams = Cardano.ProtocolParameters +mockProtocolParametersForBalancing = + ( mockProtocolParameters + , Cardano.ProtocolParameters { Cardano.protocolParamTxFeeFixed = 155_381 , Cardano.protocolParamTxFeePerByte = 44 , Cardano.protocolParamMaxTxSize = 16_384 @@ -4332,9 +4334,11 @@ mockProtocolParametersForBalancing = (mockProtocolParameters, nodePParams) , Cardano.protocolParamMonetaryExpansion = 0 , Cardano.protocolParamTreasuryCut = 0 , Cardano.protocolParamUTxOCostPerWord = - Just $ fromIntegral $ SL.unCoin testParameter_coinsPerUTxOWord_Alonzo + Just $ fromIntegral $ + SL.unCoin testParameter_coinsPerUTxOWord_Alonzo , Cardano.protocolParamUTxOCostPerByte = - Just $ fromIntegral $ SL.unCoin testParameter_coinsPerUTxOByte_Babbage + Just $ fromIntegral $ + SL.unCoin testParameter_coinsPerUTxOByte_Babbage , Cardano.protocolParamCostModels = Cardano.fromAlonzoCostModels costModelsForTesting , Cardano.protocolParamPrices = @@ -4346,6 +4350,13 @@ mockProtocolParametersForBalancing = (mockProtocolParameters, nodePParams) , Cardano.protocolParamCollateralPercent = Just 1 , Cardano.protocolParamMaxCollateralInputs = Just 3 } + ) + +mockBundledProtocolParametersForBalancing + :: CardanoEra era + -> (ProtocolParameters, Cardano.BundledProtocolParameters era) +mockBundledProtocolParametersForBalancing era = + Cardano.bundleProtocolParams era <$> mockProtocolParametersForBalancing {-# NOINLINE costModelsForTesting #-} costModelsForTesting :: Alonzo.CostModels @@ -4463,25 +4474,22 @@ prop_updateTx collateralIns = sealedCollateralInputs . sealedTxFromCardano' estimateSignedTxSizeSpec :: Spec -estimateSignedTxSizeSpec = - describe "estimateSignedTxSize" $ do - it "equals the binary size of signed txs" $ property $ do - forAllGoldens signedTxGoldens $ \hexTx -> do - let bs = unsafeFromHex hexTx - let anyShelleyEraTx = shelleyBasedTxFromBytes bs +estimateSignedTxSizeSpec = describe "estimateSignedTxSize" $ + it "equals the binary size of signed txs" $ property $ + forAllGoldens signedTxGoldens $ \hexTx -> do + let bs = unsafeFromHex hexTx + withShelleyBasedTx (shelleyBasedTxFromBytes bs) $ + \(Cardano.Tx (body :: Cardano.TxBody era) _) -> do -- 'mockProtocolParametersForBalancing' is not valid for -- 'ShelleyEra'. - let pparams = (snd mockProtocolParametersForBalancing) - { Cardano.protocolParamMinUTxOValue = Just 1_000_000 - } - withShelleyBasedTx anyShelleyEraTx $ \(Cardano.Tx body _) -> - (estimateSignedTxSize - pparams - (estimateKeyWitnessCount - (utxoPromisingInputsHaveVkPaymentCreds body) body) - body) - `shouldBe` - TxSize (fromIntegral $ BS.length bs) + let pparams = Cardano.bundleProtocolParams cardanoEra $ + (snd mockProtocolParametersForBalancing) + { Cardano.protocolParamMinUTxOValue = Just 1_000_000 + } + utxo = utxoPromisingInputsHaveVkPaymentCreds body + witCount = estimateKeyWitnessCount utxo body + estimateSignedTxSize pparams witCount body + `shouldBe` TxSize (fromIntegral (BS.length bs)) where forAllGoldens goldens f = forM_ goldens $ \x -> Hspec.counterexample (show x) $ f x