@@ -769,11 +769,6 @@ data TxBodyErrorAutoBalance =
769
769
-- | One or more of the scripts were expected to fail validation, but none did.
770
770
| TxBodyScriptBadScriptValidity
771
771
772
- -- | The balance of the non-ada assets is not zero. The 'Value' here is
773
- -- that residual non-zero balance. The 'makeTransactionBodyAutoBalance'
774
- -- function only automatically balances ada, not other assets.
775
- | TxBodyErrorAssetBalanceWrong Value
776
-
777
772
-- | There is not enough ada to cover both the outputs and the fees.
778
773
-- The transaction should be changed to provide more input ada, or
779
774
-- otherwise adjusted to need less (e.g. outputs, script etc).
@@ -832,13 +827,6 @@ instance Error TxBodyErrorAutoBalance where
832
827
displayError TxBodyScriptBadScriptValidity =
833
828
" One or more of the scripts were expected to fail validation, but none did."
834
829
835
- displayError (TxBodyErrorAssetBalanceWrong _value) =
836
- " The transaction does not correctly balance in its non-ada assets. "
837
- ++ " The balance between inputs and outputs should sum to zero. "
838
- ++ " The actual balance is: "
839
- ++ " TODO: move the Value renderer and parser from the CLI into the API and use them here"
840
- -- TODO: do this ^^
841
-
842
830
displayError (TxBodyErrorAdaBalanceNegative lovelace) =
843
831
" The transaction does not balance in its use of ada. The net balance "
844
832
++ " of the transaction is negative: " ++ show lovelace ++ " lovelace. "
@@ -977,13 +965,30 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
977
965
-- output and fee. Yes this means this current code will only work for
978
966
-- final fee of less than around 4000 ada (2^32-1 lovelace) and change output
979
967
-- of less than around 18 trillion ada (2^64-1 lovelace).
968
+ -- However, since at this point we know how much non-Ada change to give
969
+ -- we can use the true values for that.
970
+
971
+ let outgoingNonAda = mconcat [filterValue isNotAda v | (TxOut _ (TxOutValue _ v) _ _) <- txOuts txbodycontent]
972
+ let incomingNonAda = mconcat [filterValue isNotAda v | (TxOut _ (TxOutValue _ v) _ _) <- Map. elems $ unUTxO utxo]
973
+ let mintedNonAda = case txMintValue txbodycontent1 of
974
+ TxMintNone -> mempty
975
+ TxMintValue _ v _ -> v
976
+ let nonAdaChange = mconcat
977
+ [ incomingNonAda
978
+ , mintedNonAda
979
+ , negateValue outgoingNonAda
980
+ ]
981
+
982
+ let changeTxOut = case multiAssetSupportedInEra cardanoEra of
983
+ Left _ -> lovelaceToTxOutValue $ Lovelace (2 ^ (64 :: Integer )) - 1
984
+ Right multiAsset -> TxOutValue multiAsset (lovelaceToValue (Lovelace (2 ^ (64 :: Integer )) - 1 ) <> nonAdaChange)
980
985
981
986
let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput txbodycontent changeaddr
982
987
txbody1 <- first TxBodyError $ -- TODO: impossible to fail now
983
988
createAndValidateTransactionBody txbodycontent1 {
984
989
txFee = TxFeeExplicit explicitTxFees $ Lovelace (2 ^ (32 :: Integer ) - 1 ),
985
990
txOuts = TxOut changeaddr
986
- (lovelaceToTxOutValue $ Lovelace ( 2 ^ ( 64 :: Integer )) - 1 )
991
+ changeTxOut
987
992
TxOutDatumNone ReferenceScriptNone
988
993
: txOuts txbodycontent,
989
994
txReturnCollateral = dummyCollRet,
@@ -1015,13 +1020,7 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
1015
1020
1016
1021
-- check if the balance is positive or negative
1017
1022
-- in one case we can produce change, in the other the inputs are insufficient
1018
- case balance of
1019
- TxOutAdaOnly _ _ -> balanceCheck balance
1020
- TxOutValue _ v ->
1021
- case valueToLovelace v of
1022
- Nothing -> Left $ TxBodyErrorNonAdaAssetsUnbalanced v
1023
- Just _ -> balanceCheck balance
1024
-
1023
+ balanceCheck balance
1025
1024
1026
1025
-- TODO: we could add the extra fee for the CBOR encoding of the change,
1027
1026
-- now that we know the magnitude of the change: i.e. 1-8 bytes extra.
@@ -1147,7 +1146,7 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
1147
1146
1148
1147
balanceCheck :: TxOutValue era -> Either TxBodyErrorAutoBalance ()
1149
1148
balanceCheck balance
1150
- | txOutValueToLovelace balance == 0 = return ()
1149
+ | txOutValueToLovelace balance == 0 && onlyAda (txOutValueToValue balance) = return ()
1151
1150
| txOutValueToLovelace balance < 0 =
1152
1151
Left . TxBodyErrorAdaBalanceNegative $ txOutValueToLovelace balance
1153
1152
| otherwise =
@@ -1157,6 +1156,13 @@ makeTransactionBodyAutoBalance eraInMode systemstart history pparams
1157
1156
Left err -> Left err
1158
1157
Right _ -> Right ()
1159
1158
1159
+ isNotAda :: AssetId -> Bool
1160
+ isNotAda AdaAssetId = False
1161
+ isNotAda _ = True
1162
+
1163
+ onlyAda :: Value -> Bool
1164
+ onlyAda = null . valueToList . filterValue isNotAda
1165
+
1160
1166
checkMinUTxOValue
1161
1167
:: TxOut CtxTx era
1162
1168
-> ProtocolParameters
0 commit comments