diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 81bab44aed..269997ed9e 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -1045,41 +1045,21 @@ makeTransactionBodyAutoBalance -- 3. update tx with fees -- 4. balance the transaction and update tx change output - -- UTXO inputs, which inclue also non-ada assets - let totalValueAtUTxO = - fromLedgerValue sbe . calculateIncomingUTxOValue . Map.elems $ unUTxO utxo - -- this is a partial change: it does not include deposits, but we need to have non-ada assets in it - -- from utxo and inputs - partialChange = - monoidForEraInEon (toCardanoEra sbe) $ \w -> - toLedgerValue w $ calculatePartialChangeValue sbe totalValueAtUTxO txbodycontent - - -- For the purpose of fees and execution units calculation we just need to make a txbody larger than - -- strictly necessary. We do not need the right values for the fee or change output. We use - -- "big enough" values for the change output and set so that the CBOR encoding size of the tx will - -- be big enough to cover the size of the final output and fee. Yes this means this current code will - -- only work for final fee of less than around 4000 ada (2^32-1 lovelace) and change output of less - -- than around 18 trillion ada (2^64-1 lovelace). However, since at this point we know how much - -- non-Ada change to give we can use the true values for that. - let maxLovelaceChange = L.Coin (2 ^ (64 :: Integer)) - 1 - let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1) - let changeWithMaxLovelace = partialChange & A.adaAssetL sbe .~ maxLovelaceChange - let changeTxOut = - forShelleyBasedEraInEon - sbe - (lovelaceToTxOutValue sbe maxLovelaceChange) - (\w -> maryEraOnwardsConstraints w $ TxOutValueShelleyBased sbe changeWithMaxLovelace) - - -- Tx body used only for evaluating execution units, txout exact values do not matter much here. We also - -- use 'maxLovelaceChange' in txout to avoid ending up with negative change accidentally (this could - -- happen if there's a big certificate deposit being returned for example). - txbody0 <- + txbodyForChange <- first TxBodyError $ createTransactionBody sbe txbodycontent + let initialChangeTxOut = + evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbodyForChange + + -- Tx body used only for evaluating execution units. Because txout exact + -- values do not matter much here, we are using an initial change value, + -- which is slightly overestimated, because it does not include fee or + -- scripts execution costs. + txbody <- first TxBodyError $ createTransactionBody sbe $ txbodycontent & modTxOuts - (<> [TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone]) + (<> [TxOut changeaddr initialChangeTxOut TxOutDatumNone ReferenceScriptNone]) exUnitsMapWithLogs <- first TxBodyErrorValidityInterval $ evaluateTransactionExecutionUnits @@ -1088,7 +1068,7 @@ makeTransactionBodyAutoBalance history lpp utxo - txbody0 + txbody let exUnitsMap = Map.map (fmap snd) exUnitsMapWithLogs @@ -1102,6 +1082,14 @@ makeTransactionBodyAutoBalance txbodycontent1 <- substituteExecutionUnits exUnitsMap' txbodycontent + -- Make a txbody that we will use for calculating the fees. For the purpose + -- of fees we just need to make a txbody of the right size in bytes. We do + -- not need the right values for the fee. We use "big enough" values for + -- the fee and set so that the CBOR encoding size of the tx will be big + -- enough to cover the size of the final output and fee. Yes this means + -- this current code will only work for final fee of less than around + -- 4000 ada (2^32-1 lovelace). + let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1) -- Make a txbody that we will use for calculating the fees. let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput sbe txbodycontent changeaddr txbody1 <- @@ -1112,7 +1100,7 @@ makeTransactionBodyAutoBalance { txFee = TxFeeExplicit sbe maxLovelaceFee , txOuts = txOuts txbodycontent - <> [TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone] + <> [TxOut changeaddr initialChangeTxOut TxOutDatumNone ReferenceScriptNone] , txReturnCollateral = dummyCollRet , txTotalCollateral = dummyTotColl } @@ -1248,12 +1236,12 @@ isNotAda _ = True onlyAda :: Value -> Bool onlyAda = null . toList . filterValue isNotAda -calculateIncomingUTxOValue - :: Monoid (Ledger.Value (ShelleyLedgerEra era)) - => [TxOut ctx era] - -> Ledger.Value (ShelleyLedgerEra era) -calculateIncomingUTxOValue providedUtxoOuts = - mconcat [v | (TxOut _ (TxOutValueShelleyBased _ v) _ _) <- providedUtxoOuts] +-- calculateIncomingUTxOValue +-- :: Monoid (Ledger.Value (ShelleyLedgerEra era)) +-- => [TxOut ctx era] +-- -> Ledger.Value (ShelleyLedgerEra era) +-- calculateIncomingUTxOValue providedUtxoOuts = +-- mconcat [v | (TxOut _ (TxOutValueShelleyBased _ v) _ _) <- providedUtxoOuts] -- Calculation taken from validateInsufficientCollateral: https://github.com/input-output-hk/cardano-ledger/blob/389b266d6226dedf3d2aec7af640b3ca4984c5ea/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs#L335 -- TODO: Bug Jared to expose a function from the ledger that returns total and return collateral. @@ -1325,10 +1313,10 @@ calculatePartialChangeValue -> Value -> TxBodyContent build era -> Value -calculatePartialChangeValue sbe incoming txbodycontent = +calculatePartialChangeValue sbe incoming txbodycontent = do let outgoing = newUtxoValue mintedValue = txMintValueToValue $ txMintValue txbodycontent - in mconcat [incoming, mintedValue, negateValue outgoing] + mconcat [incoming, mintedValue, negateValue outgoing] where newUtxoValue = mconcat [fromLedgerValue sbe v | (TxOut _ (TxOutValueShelleyBased _ v) _ _) <- txOuts txbodycontent] diff --git a/cardano-api/internal/Cardano/Api/IPC.hs b/cardano-api/internal/Cardano/Api/IPC.hs index bfba54487b..5903fa58f8 100644 --- a/cardano-api/internal/Cardano/Api/IPC.hs +++ b/cardano-api/internal/Cardano/Api/IPC.hs @@ -174,6 +174,7 @@ data LocalNodeConnectInfo , localNodeNetworkId :: NetworkId , localNodeSocketPath :: SocketPath } + deriving Show -- ---------------------------------------------------------------------------- -- Actually connect to the node 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 6b7584c6e2..abc22af71e 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 @@ -110,7 +110,7 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr address Nothing -- the correct amount with manual balancing of assets - 335_475 === feeWithTxoutAsset + 335_299 === feeWithTxoutAsset -- autobalanced body has assets and ADA in the change txout (BalancedTxBody balancedContent _ _ fee) <- @@ -158,8 +158,11 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce stakeCred <- forAll genStakeCredential let certs = - [ ConwayCertificate ceo $ - L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit)) + [ + ( ConwayCertificate ceo $ + L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit)) + , Nothing + ) ] content = @@ -167,7 +170,7 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce & setTxIns txInputs & setTxOuts (mkTxOutput beo address txOutCoin Nothing) & setTxProtocolParams (pure $ pure pparams) - & setTxCertificates (TxCertificates sbe certs (BuildTxWith [])) + & setTxCertificates (mkTxCertificates sbe certs) -- autobalanced body has assets and ADA in the change txout (BalancedTxBody _ _ changeOut fee) <- @@ -190,7 +193,7 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce H.note_ "Sanity check: inputs == outputs" mconcat [deregDeposit, txInputsTotalCoin] === mconcat [txOutCoin, fee, changeCoin] - 176_633 === fee + 180_901 === fee prop_make_transaction_body_autobalance_multi_asset_collateral :: Property prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ do @@ -243,7 +246,7 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ address Nothing - 335_475 === fee + 335_299 === fee TxReturnCollateral _ (TxOut _ txOutValue _ _) <- H.noteShow $ txReturnCollateral balancedContent let assets = [a | a@(AssetId _ _, _) <- toList $ txOutValueToValue txOutValue] H.note_ "Check that all assets from UTXO, from the collateral txin, are in the return collateral."