From 06a7648c105e64fb0917d5824df9d4bd8de260a7 Mon Sep 17 00:00:00 2001 From: Yuriy Lazaryev Date: Thu, 23 Jun 2022 16:50:59 +0200 Subject: [PATCH] feat: balance tx fails fast on txcoll or collRet --- lib/core/src/Cardano/Api/Gen.hs | 38 ++- lib/core/src/Cardano/Wallet.hs | 16 ++ lib/core/src/Cardano/Wallet/Api/Server.hs | 45 +-- lib/core/src/Cardano/Wallet/Api/Types.hs | 10 + .../test/unit/Cardano/Wallet/Api/TypesSpec.hs | 12 +- lib/shelley/cardano-wallet.cabal | 1 + .../Cardano/Wallet/Shelley/TransactionSpec.hs | 258 ++++++++++++++---- specifications/api/swagger.yaml | 146 +++++++++- 8 files changed, 430 insertions(+), 96 deletions(-) diff --git a/lib/core/src/Cardano/Api/Gen.hs b/lib/core/src/Cardano/Api/Gen.hs index 7a132033eb1..41b8b90aa6b 100644 --- a/lib/core/src/Cardano/Api/Gen.hs +++ b/lib/core/src/Cardano/Api/Gen.hs @@ -16,6 +16,7 @@ module Cardano.Api.Gen , genAssetIdNoAda , genAssetName , genByronKeyWitness + , genCertIx , genCostModel , genCostModels , genEncodingBoundaryLovelace @@ -23,8 +24,6 @@ module Cardano.Api.Gen , genExecutionUnitPrices , genExecutionUnits , genExtraKeyWitnesses - , genTxIx - , genCertIx , genLovelace , genMIRPot , genMIRTarget @@ -75,9 +74,10 @@ module Cardano.Api.Gen , genTxForBalancing , genTxId , genTxIn - , genTxInEra , genTxIndex + , genTxInEra , genTxInsCollateral + , genTxIx , genTxMetadata , genTxMetadataInEra , genTxMetadataValue @@ -85,7 +85,9 @@ module Cardano.Api.Gen , genTxOut , genTxOutDatum , genTxOutValue + , genTxReturnCollateral , genTxScriptValidity + , genTxTotalCollateral , genTxValidityLowerBound , genTxValidityRange , genTxValidityUpperBound @@ -98,9 +100,9 @@ module Cardano.Api.Gen , genVerificationKeyHash , genWithdrawalInfo , genWitness + , genWitnesses , genWitnessNetworkIdOrByronAddress , genWitnessStake - , genWitnesses ) where import Prelude @@ -400,12 +402,30 @@ genExtraKeyWitnesses :: CardanoEra era -> Gen (TxExtraKeyWitnesses era) genExtraKeyWitnesses era = case extraKeyWitnessesSupportedInEra era of Nothing -> pure TxExtraKeyWitnessesNone - Just supported -> oneof + Just supported -> oneof [ pure TxExtraKeyWitnessesNone , TxExtraKeyWitnesses supported <$> scale (`div` 3) (listOf (genVerificationKeyHash AsPaymentKey)) ] +genTxTotalCollateral :: CardanoEra era -> Gen (TxTotalCollateral era) +genTxTotalCollateral era = + case totalAndReturnCollateralSupportedInEra era of + Nothing -> pure TxTotalCollateralNone + Just supported -> oneof + [ pure TxTotalCollateralNone + , TxTotalCollateral supported <$> genLovelace + ] + +genTxReturnCollateral :: CardanoEra era -> Gen (TxReturnCollateral ctx era) +genTxReturnCollateral era = + case totalAndReturnCollateralSupportedInEra era of + Nothing -> pure TxReturnCollateralNone + Just supported -> oneof + [ pure TxReturnCollateralNone + , TxReturnCollateral supported <$> genTxOut era + ] + genPlutusScript :: PlutusScriptVersion lang -> Gen (PlutusScript lang) genPlutusScript _ = -- We make no attempt to create a valid script @@ -1330,6 +1350,8 @@ genTxBodyContent era = do txMintValue <- genTxMintValue era txScriptValidity <- genTxScriptValidity era txExtraKeyWits <- genExtraKeyWitnesses era + txTotalCollateral <- genTxTotalCollateral era + txReturnCollateral <- genTxReturnCollateral era let txBody = TxBodyContent @@ -1344,10 +1366,8 @@ genTxBodyContent era = do -- TODO add proper generator, perhaps as part of ADP-1655 , Api.txInsReference = TxInsReferenceNone - -- TODO add proper generators, perhaps as part of ADP-1653 - , Api.txTotalCollateral = TxTotalCollateralNone - , Api.txReturnCollateral = TxReturnCollateralNone - + , Api.txTotalCollateral + , Api.txReturnCollateral , Api.txFee , Api.txValidityRange , Api.txMetadata diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index 2549cc84d20..2008fcda273 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -1593,6 +1593,8 @@ balanceTransactionWithSelectionStrategy ptx@(PartialTx partialTx externalInputs redeemers) = do guardExistingCollateral partialTx + guardExistingTotalCollateral partialTx + guardExistingReturnCollateral partialTx guardZeroAdaOutputs (extractOutputsFromTx $ toSealed partialTx) guardConflictingWithdrawalNetworks partialTx @@ -1851,6 +1853,18 @@ balanceTransactionWithSelectionStrategy Cardano.TxInsCollateral _ _ -> throwE ErrBalanceTxExistingCollateral + guardExistingTotalCollateral (Cardano.Tx (Cardano.TxBody body) _) = + case Cardano.txTotalCollateral body of + Cardano.TxTotalCollateralNone -> return () + Cardano.TxTotalCollateral _ _ -> + throwE ErrBalanceTxExistingTotalCollateral + + guardExistingReturnCollateral (Cardano.Tx (Cardano.TxBody body) _) = + case Cardano.txReturnCollateral body of + Cardano.TxReturnCollateralNone -> return () + Cardano.TxReturnCollateral _ _ -> + throwE ErrBalanceTxExistingReturnCollateral + -- | Select assets to cover the specified balance and fee. -- -- If the transaction contains redeemers, the function will also ensure the @@ -3436,6 +3450,8 @@ data ErrBalanceTx | ErrBalanceTxSelectAssets ErrSelectAssets | ErrBalanceTxMaxSizeLimitExceeded | ErrBalanceTxExistingCollateral + | ErrBalanceTxExistingTotalCollateral + | ErrBalanceTxExistingReturnCollateral | ErrBalanceTxConflictingNetworks | ErrBalanceTxAssignRedeemers ErrAssignRedeemers | ErrBalanceTxInternalError ErrBalanceTxInternalError diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index f3115b43139..87e15ef0789 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -4522,10 +4522,10 @@ instance IsServerError ErrDecodeTx where instance IsServerError ErrBalanceTx where toServerError = \case ErrByronTxNotSupported -> - apiError err403 CreatedInvalidTransaction + apiError err403 BalanceTxByronNotSupported "Balancing Byron transactions is not supported." ErrBalanceTxUpdateError (ErrExistingKeyWitnesses n) -> - apiError err403 CreatedInvalidTransaction $ mconcat + apiError err403 BalanceTxExistingKeyWitnesses $ mconcat [ "The transaction could not be balanced, because it contains " , T.pack (show n), " " , "existing key-witnesses which would be invalid after " @@ -4535,34 +4535,45 @@ instance IsServerError ErrBalanceTx where ErrBalanceTxSelectAssets err -> toServerError err ErrBalanceTxAssignRedeemers err -> toServerError err ErrBalanceTxConflictingNetworks -> - apiError err403 CreatedInvalidTransaction $ mconcat - [ "There are withdrawals for multiple networks (e.g. both " - , "mainnet and testnet) in the provided transaction. This " + apiError err403 BalanceTxConflictingNetworks $ T.unwords + [ "There are withdrawals for multiple networks (e.g. both" + , "mainnet and testnet) in the provided transaction. This" , "makes no sense, and I'm confused." ] ErrBalanceTxExistingCollateral -> - apiError err403 CreatedInvalidTransaction $ mconcat - [ "I cannot balance transactions with pre-defined collateral." + apiError err403 BalanceTxExistingCollateral + "I cannot balance transactions with pre-defined collateral." + + ErrBalanceTxExistingTotalCollateral -> + apiError err403 BalanceTxExistingTotalCollateral $ T.unwords + [ "I cannot balance transactions" + , "with pre-defined total collateral." + ] + ErrBalanceTxExistingReturnCollateral -> + apiError err403 BalanceTxExistingReturnCollateral $ T.unwords + [ "Balancing transactions with pre-defined" + , "collateral return outputs is not yet supported." ] ErrBalanceTxZeroAdaOutput -> - apiError err501 CreatedInvalidTransaction $ mconcat - [ "I don't currently support balancing transactions containing " - , "one or more zero ada outputs. In the future I might be able " + apiError err501 BalanceTxZeroAdaOutput $ T.unwords + [ "I don't currently support balancing transactions containing" + , "one or more zero-ada outputs. In the future I might be able" , "to increase the values to the minimum allowed ada value." ] ErrBalanceTxInternalError (ErrFailedBalancing v) -> - apiError err500 CreatedInvalidTransaction $ mconcat - [ "I have somehow failed to balance the transaction. The balance" - , " is " <> T.pack (show v) + apiError err500 BalanceTxInternalError $ T.unwords + [ "I have somehow failed to balance the transaction." + , "The balance is" + , T.pack (show v) ] ErrBalanceTxInternalError (ErrUnderestimatedFee c _) -> - apiError err500 CreatedInvalidTransaction $ mconcat - [ "I have somehow underestimated the fee of the transaction " - , " by " <> pretty c + apiError err500 BalanceTxUnderestimatedFee $ T.unwords + [ "I have somehow underestimated the fee of the transaction by" + , pretty c , "and cannot finish balancing." ] ErrBalanceTxMaxSizeLimitExceeded -> - apiError err403 CreatedInvalidTransaction $ mconcat + apiError err403 BalanceTxMaxSizeLimitExceeded $ T.unwords [ "I was not able to balance the transaction without exceeding" , "the maximum transaction size." ] diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs index a6251bc92a4..95518e4cf57 100644 --- a/lib/core/src/Cardano/Wallet/Api/Types.hs +++ b/lib/core/src/Cardano/Wallet/Api/Types.hs @@ -1669,6 +1669,16 @@ data ApiErrorCode | AssetNameTooLong | AssetNotPresent | BadRequest + | BalanceTxByronNotSupported + | BalanceTxConflictingNetworks + | BalanceTxExistingCollateral + | BalanceTxExistingKeyWitnesses + | BalanceTxExistingReturnCollateral + | BalanceTxExistingTotalCollateral + | BalanceTxInternalError + | BalanceTxMaxSizeLimitExceeded + | BalanceTxUnderestimatedFee + | BalanceTxZeroAdaOutput | CannotCoverFee | CreatedInvalidTransaction | CreatedMultiaccountTransaction diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 7f767d7d5ae..8dd9249b6e2 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs @@ -1099,25 +1099,25 @@ spec = parallel $ do } in x' === x .&&. show x' === show x - it "WalletPutPassphraseData" $ property $ \case - WalletPutPassphraseData (Left x) -> + it "WalletPutPassphraseData" $ property $ \case + WalletPutPassphraseData (Left x) -> let x' = WalletPutPassphraseOldPassphraseData - { oldPassphrase = oldPassphrase + { oldPassphrase = oldPassphrase (x :: WalletPutPassphraseOldPassphraseData) - , newPassphrase = newPassphrase + , newPassphrase = newPassphrase (x :: WalletPutPassphraseOldPassphraseData) } in x' === x .&&. show x' === show x - WalletPutPassphraseData (Right x) -> + WalletPutPassphraseData (Right x) -> let x' = Api.WalletPutPassphraseMnemonicData { mnemonicSentence = mnemonicSentence (x :: WalletPutPassphraseMnemonicData) , mnemonicSecondFactor = mnemonicSecondFactor (x :: WalletPutPassphraseMnemonicData) - , newPassphrase = newPassphrase + , newPassphrase = newPassphrase (x :: WalletPutPassphraseMnemonicData) } in diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index eaf7203a9b3..450c23d4de9 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -246,6 +246,7 @@ test-suite unit , cardano-crypto-class , cardano-crypto-wrapper , cardano-ledger-alonzo + , cardano-ledger-babbage , cardano-ledger-byron , cardano-ledger-core , cardano-numeric diff --git a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs index 31ebe3467b2..96bfae31583 100644 --- a/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs +++ b/lib/shelley/test/unit/Cardano/Wallet/Shelley/TransactionSpec.hs @@ -65,6 +65,8 @@ import Cardano.BM.Tracer ( Tracer ) import Cardano.Ledger.Alonzo.TxInfo ( TranslationError (TranslationLogicMissingInput) ) +import Cardano.Ledger.Era + ( Era ) import Cardano.Ledger.Shelley.API ( StrictMaybe (SJust, SNothing), Wdrl (..) ) import Cardano.Ledger.ShelleyMA.Timelocks @@ -397,6 +399,7 @@ import qualified Cardano.Crypto.Hash.Blake2b as Crypto import qualified Cardano.Crypto.Hash.Class as Crypto import qualified Cardano.Ledger.Alonzo.Tx as Alonzo import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo +import qualified Cardano.Ledger.Babbage.Tx as Babbage import qualified Cardano.Ledger.Coin as Ledger import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Crypto as Crypto @@ -2203,6 +2206,12 @@ balanceTransactionSpec = do describe "balanceTransaction" $ do -- TODO: Create a test to show that datums are passed through... + it "doesn't balance transactions with existing 'totalCollateral'" + $ property prop_balanceTransactionExistingTotalCollateral + + it "doesn't balance transactions with existing 'returnCollateral'" + $ property prop_balanceTransactionExistingReturnCollateral + it "produces valid transactions or fails" $ property prop_balanceTransactionValid @@ -2834,7 +2843,7 @@ instance Arbitrary (PartialTx Cardano.AlonzoEra) where tx' inputs redeemers - | tx' <- shrinkTx tx + | tx' <- shrinkTxAlonzo tx ] where shrinkInputs (i:ins) = @@ -2842,6 +2851,30 @@ instance Arbitrary (PartialTx Cardano.AlonzoEra) where shrinkInputs [] = [] +instance Arbitrary (PartialTx Cardano.BabbageEra) where + arbitrary = do + let era = BabbageEra + tx <- genTxForBalancing era + let (Cardano.Tx (Cardano.TxBody content) _) = tx + let inputs = Cardano.txIns content + resolvedInputs <- forM inputs $ \i -> do + -- NOTE: genTxOut does not generate quantities larger than + -- `maxBound :: Word64`, however users could supply these. + -- We should ideally test what happens, and make it clear what code, + -- if any, should validate. + o <- fromCardanoTxOut <$> genTxOut Cardano.BabbageEra + return (fromCardanoTxIn $ fst i, o, Nothing) + let redeemers = [] + return $ PartialTx tx resolvedInputs redeemers + shrink (PartialTx tx inputs redeemers) = + [ PartialTx tx inputs' redeemers | inputs' <- shrinkInputs inputs ] <> + [ restrictResolution $ PartialTx tx' inputs redeemers + | tx' <- shrinkTxBabbage tx ] + where + shrinkInputs (i:ins) = + map (:ins) (shrink i) ++ map (i:) (shrinkInputs ins) + shrinkInputs [] = [] + resolvedInputsUTxO :: ShelleyBasedEra era -> PartialTx era @@ -2860,12 +2893,15 @@ instance Semigroup (Cardano.UTxO era) where instance Monoid (Cardano.UTxO era) where mempty = Cardano.UTxO mempty -shrinkTx - :: Cardano.Tx Cardano.AlonzoEra -> [Cardano.Tx Cardano.AlonzoEra] -shrinkTx (Cardano.Tx bod wits) = - [ Cardano.Tx bod' wits - | bod' <- shrinkTxBody bod - ] +shrinkTxAlonzo :: + Cardano.Tx Cardano.AlonzoEra -> [Cardano.Tx Cardano.AlonzoEra] +shrinkTxAlonzo (Cardano.Tx bod wits) = + [ Cardano.Tx bod' wits | bod' <- shrinkTxBodyAlonzo bod ] + +shrinkTxBabbage :: + Cardano.Tx Cardano.BabbageEra -> [Cardano.Tx Cardano.BabbageEra] +shrinkTxBabbage (Cardano.Tx bod wits) = + [ Cardano.Tx bod' wits | bod' <- shrinkTxBodyBabbage bod ] -- | Restricts the inputs list of the 'PartialTx' to the inputs of the -- underlying CBOR transaction. This allows us to "fix" the 'PartialTx' after @@ -2883,41 +2919,22 @@ restrictResolution (PartialTx tx inputs redeemers) = inputsInTx (Cardano.Tx (Cardano.TxBody bod) _) = Set.fromList $ map (fromCardanoTxIn . fst) $ Cardano.txIns bod -shrinkTxBody +shrinkTxBodyAlonzo :: Cardano.TxBody Cardano.AlonzoEra -> [Cardano.TxBody Cardano.AlonzoEra] -shrinkTxBody (Cardano.ShelleyTxBody e bod scripts scriptData aux val) = tail - [ Cardano.ShelleyTxBody e bod' scripts' scriptData' aux' val' - | bod' <- prependOriginal shrinkLedgerTxBody bod - , aux' <- aux : filter (/= aux) [Nothing] - , scriptData' <- prependOriginal shrinkScriptData scriptData - , scripts' <- prependOriginal shrinkScripts scripts - , val' <- val : filter (/= val) - [ Cardano.TxScriptValidity Cardano.TxScriptValiditySupportedInAlonzoEra - Cardano.ScriptValid +shrinkTxBodyAlonzo (Cardano.ShelleyTxBody e bod scripts scriptData aux val) = + tail + [ Cardano.ShelleyTxBody e bod' scripts' scriptData' aux' val' + | bod' <- prependOriginal shrinkLedgerTxBody bod + , aux' <- aux : filter (/= aux) [Nothing] + , scriptData' <- prependOriginal shrinkScriptData scriptData + , scripts' <- prependOriginal (shrinkList (const [])) scripts + , val' <- case Cardano.txScriptValiditySupportedInShelleyBasedEra e of + Nothing -> [val] + Just txsvsie -> val : filter (/= val) + [ Cardano.TxScriptValidity txsvsie Cardano.ScriptValid ] ] - ] where - -- | For writing shrinkers in the style of https://stackoverflow.com/a/14006575 - prependOriginal shrinker = \x -> x : shrinker x - - shrinkScripts = shrinkList (const []) - - shrinkScriptData Cardano.TxBodyNoScriptData = [] - shrinkScriptData - (Cardano.TxBodyScriptData era - (Alonzo.TxDats dats) - (Alonzo.Redeemers redeemers) - ) = tail - [ Cardano.TxBodyScriptData era - (Alonzo.TxDats dats') - (Alonzo.Redeemers redeemers') - | dats' <- dats : - (Map.fromList <$> shrinkList (const []) (Map.toList dats)) - , redeemers' <- redeemers : - (Map.fromList <$> shrinkList (const []) (Map.toList redeemers)) - ] - shrinkLedgerTxBody :: Ledger.TxBody (Cardano.ShelleyLedgerEra Cardano.AlonzoEra) -> [Ledger.TxBody (Cardano.ShelleyLedgerEra Cardano.AlonzoEra)] @@ -2932,7 +2949,7 @@ shrinkTxBody (Cardano.ShelleyTxBody e bod scripts scriptData aux val) = tail { Alonzo.txUpdates = updates' } { Alonzo.txfee = txfee' } | updates' <- - prependOriginal shrinkUpdates (Alonzo.txUpdates body) + prependOriginal shrinkStrictMaybe (Alonzo.txUpdates body) , wdrls' <- prependOriginal shrinkWdrl (Alonzo.txwdrls body) , outs' <- @@ -2949,31 +2966,103 @@ shrinkTxBody (Cardano.ShelleyTxBody e bod scripts scriptData aux val) = tail prependOriginal shrinkFee (Alonzo.txfee body) ] - shrinkValue v = filter (/= v) [v0] - where - v0 = mempty +shrinkTxBodyBabbage + :: Cardano.TxBody Cardano.BabbageEra -> [Cardano.TxBody Cardano.BabbageEra] +shrinkTxBodyBabbage (Cardano.ShelleyTxBody e bod scripts scriptData aux val) = + tail + [ Cardano.ShelleyTxBody e bod' scripts' scriptData' aux' val' + | bod' <- prependOriginal shrinkLedgerTxBody bod + , aux' <- aux : filter (/= aux) [Nothing] + , scriptData' <- prependOriginal shrinkScriptData scriptData + , scripts' <- prependOriginal (shrinkList (const [])) scripts + , val' <- case Cardano.txScriptValiditySupportedInShelleyBasedEra e of + Nothing -> [val] + Just txsvsie -> val : filter (/= val) + [ Cardano.TxScriptValidity txsvsie Cardano.ScriptValid ] + ] + where + shrinkLedgerTxBody + :: Ledger.TxBody (Cardano.ShelleyLedgerEra Cardano.BabbageEra) + -> [Ledger.TxBody (Cardano.ShelleyLedgerEra Cardano.BabbageEra)] + shrinkLedgerTxBody body = tail + [ body + { Babbage.txwdrls = wdrls' + , Babbage.outputs = outs' + , Babbage.inputs = ins' + , Babbage.txcerts = certs' + , Babbage.mint = mint' + , Babbage.reqSignerHashes = rsh' + , Babbage.txUpdates = updates' + , Babbage.txfee = txfee' + } + | updates' <- + prependOriginal shrinkStrictMaybe (Babbage.txUpdates body) + , wdrls' <- + prependOriginal shrinkWdrl (Babbage.txwdrls body) + , outs' <- + prependOriginal (shrinkSeq (const [])) (Babbage.outputs body) + , ins' <- + prependOriginal (shrinkSet (const [])) (Babbage.inputs body) + , certs' <- + prependOriginal (shrinkSeq (const [])) (Babbage.txcerts body) + , mint' <- + prependOriginal shrinkValue (Babbage.mint body) + , rsh' <- + prependOriginal + (shrinkSet (const [])) (Babbage.reqSignerHashes body) + , txfee' <- + prependOriginal shrinkFee (Babbage.txfee body) + ] - shrinkSet :: Ord a => (a -> [a]) -> Set a -> [Set a] - shrinkSet shrinkElem = map Set.fromList . shrinkList shrinkElem . F.toList - shrinkSeq shrinkElem = - map StrictSeq.fromList . shrinkList shrinkElem . F.toList - shrinkFee :: Ledger.Coin -> [Ledger.Coin] - shrinkFee (Ledger.Coin 0) = [] - shrinkFee _ = [Ledger.Coin 0] +shrinkScriptData + :: Era (Cardano.ShelleyLedgerEra era) + => Cardano.TxBodyScriptData era + -> [Cardano.TxBodyScriptData era] +shrinkScriptData Cardano.TxBodyNoScriptData = [] +shrinkScriptData (Cardano.TxBodyScriptData era + (Alonzo.TxDats dats) (Alonzo.Redeemers redeemers)) = tail + [ Cardano.TxBodyScriptData era + (Alonzo.TxDats dats') + (Alonzo.Redeemers redeemers') + | dats' <- dats : + (Map.fromList <$> shrinkList (const []) (Map.toList dats)) + , redeemers' <- redeemers : + (Map.fromList <$> shrinkList (const []) (Map.toList redeemers)) + ] - shrinkWdrl :: Wdrl era -> [Wdrl era] - shrinkWdrl (Wdrl m) = map (Wdrl . Map.fromList) $ - shrinkList shrinkWdrl' (Map.toList m) - where - shrinkWdrl' (acc, Ledger.Coin c) = - [ (acc, Ledger.Coin c') - | c' <- filter (>= 1) $ shrink c - ] +-- | For writing shrinkers in the style of https://stackoverflow.com/a/14006575 +prependOriginal :: (t -> [t]) -> t -> [t] +prependOriginal shrinker x = x : shrinker x - shrinkUpdates SNothing = [] - shrinkUpdates (SJust _) = [SNothing] +shrinkValue :: (Eq a, Monoid a) => a -> [a] +shrinkValue v = filter (/= v) [mempty] + +shrinkSet :: Ord a => (a -> [a]) -> Set a -> [Set a] +shrinkSet shrinkElem = map Set.fromList . shrinkList shrinkElem . F.toList + +shrinkSeq :: Foldable t => (a -> [a]) -> t a -> [StrictSeq.StrictSeq a] +shrinkSeq shrinkElem = + map StrictSeq.fromList . shrinkList shrinkElem . F.toList + +shrinkFee :: Ledger.Coin -> [Ledger.Coin] +shrinkFee (Ledger.Coin 0) = [] +shrinkFee _ = [Ledger.Coin 0] + +shrinkWdrl :: Wdrl era -> [Wdrl era] +shrinkWdrl (Wdrl m) = map (Wdrl . Map.fromList) $ + shrinkList shrinkWdrl' (Map.toList m) + where + shrinkWdrl' (acc, Ledger.Coin c) = + [ (acc, Ledger.Coin c') + | c' <- filter (>= 1) $ shrink c + ] + +shrinkStrictMaybe :: StrictMaybe a -> [StrictMaybe a] +shrinkStrictMaybe = \case + SNothing -> [] + SJust _ -> [SNothing] balanceTransaction' :: IsShelleyBasedEra era @@ -3324,6 +3413,10 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx') seed label "outputs below minCoinValue" $ property True Left (ErrBalanceTxExistingCollateral) -> label "existing collateral" True + Left (ErrBalanceTxExistingTotalCollateral) -> + label "existing total collateral" True + Left (ErrBalanceTxExistingReturnCollateral) -> + label "existing collateral return outputs" True Left ErrBalanceTxZeroAdaOutput -> label "not yet supported: zero ada output" $ property True Left ErrBalanceTxMaxSizeLimitExceeded -> @@ -3465,6 +3558,53 @@ prop_balanceTransactionValid wallet (ShowBuildable partialTx') seed (_, nodePParams) = mockProtocolParametersForBalancing +prop_balanceTransactionExistingTotalCollateral + :: Wallet' + -> ShowBuildable (PartialTx Cardano.BabbageEra) + -> StdGenSeed + -> Property +prop_balanceTransactionExistingTotalCollateral + wallet (ShowBuildable partialTx@PartialTx{tx}) seed = withMaxSuccess 10 $ + hasTotalCollateral tx + && not (hasInsCollateral tx) + && not (hasReturnCollateral tx) ==> + case balanceTransaction' wallet seed partialTx of + Left err -> ErrBalanceTxExistingTotalCollateral === err + e -> counterexample (show e) False + +prop_balanceTransactionExistingReturnCollateral + :: Wallet' + -> ShowBuildable (PartialTx Cardano.BabbageEra) + -> StdGenSeed + -> Property +prop_balanceTransactionExistingReturnCollateral + wallet (ShowBuildable partialTx@PartialTx{tx}) seed = withMaxSuccess 10 $ + hasReturnCollateral tx + && not (hasInsCollateral tx) + && not (hasTotalCollateral tx) ==> + case balanceTransaction' wallet seed partialTx of + Left err -> ErrBalanceTxExistingReturnCollateral === err + e -> counterexample (show e) False + +hasInsCollateral :: Cardano.Tx era -> Bool +hasInsCollateral (Cardano.Tx (Cardano.TxBody content) _) = + case Cardano.txInsCollateral content of + Cardano.TxInsCollateralNone -> False + Cardano.TxInsCollateral _ [] -> False + Cardano.TxInsCollateral _ _ -> True + +hasTotalCollateral :: Cardano.Tx era -> Bool +hasTotalCollateral (Cardano.Tx (Cardano.TxBody content) _) = + case Cardano.txTotalCollateral content of + Cardano.TxTotalCollateralNone -> False + Cardano.TxTotalCollateral _ _ -> True + +hasReturnCollateral :: Cardano.Tx era -> Bool +hasReturnCollateral (Cardano.Tx (Cardano.TxBody content) _) = + case Cardano.txReturnCollateral content of + Cardano.TxReturnCollateralNone -> False + Cardano.TxReturnCollateral _ _ -> True + -- | Consistent pair of ProtocolParameters of both wallet and cardano-api types. -- -- We try to use similar parameters to mainnet where it matters (in particular diff --git a/specifications/api/swagger.yaml b/specifications/api/swagger.yaml index fe42add6e89..1cdf999dd3c 100644 --- a/specifications/api/swagger.yaml +++ b/specifications/api/swagger.yaml @@ -4444,6 +4444,134 @@ x-errBadRequest: &errBadRequest type: string enum: ['bad_request'] +x-errBalanceTxByronNotSupported: &errBalanceTxByronNotSupported + <<: *responsesErr + title: balance_tx_byron_not_supported + properties: + message: + type: string + description: Balancing Byron transactions is not supported. + code: + type: string + enum: ["balance_tx_byron_not_supported"] + +x-errBalanceTxConflictingNetworks: &errBalanceTxConflictingNetworks + <<: *responsesErr + title: balance_tx_conflicting_networks + properties: + message: + type: string + description: | + There are withdrawals for multiple networks + (e.g. both mainnet and testnet) in the provided transaction. + This makes no sense, and I'm confused. + code: + type: string + enum: ["balance_tx_conflicting_networks"] + +x-errBalanceTxExistingCollateral: &errBalanceTxExistingCollateral + <<: *responsesErr + title: balance_tx_existing_collateral + properties: + message: + type: string + description: I cannot balance transactions with pre-defined collateral. + code: + type: string + enum: ["balance_tx_existing_collateral"] + +x-errBalanceTxExistingKeyWitnesses: &errBalanceTxExistingKeyWitnesses + <<: *responsesErr + title: balance_tx_existing_key_witnesses + properties: + message: + type: string + description: | + The transaction could not be balanced, because it contains + existing key-witnesses which would be invalid after + the transaction body is modified. + Please sign the transaction after it is balanced instead. + code: + type: string + enum: ["balance_tx_existing_key_witnesses"] + +x-errBalanceTxExistingReturnCollateral: &errBalanceTxExistingReturnCollateral + <<: *responsesErr + title: balance_tx_existing_collateral_return_outputs + properties: + message: + type: string + description: | + Balancing transactions with pre-defined collateral return outputs + is not yet supported. + code: + type: string + enum: ["balance_tx_existing_collateral_return_outputs"] + +x-errBalanceTxExistingTotalCollateral: &errBalanceTxExistingTotalCollateral + <<: *responsesErr + title: balance_tx_existing_total_collateral + properties: + message: + type: string + description: | + I cannot balance transactions with pre-defined total collateral. + code: + type: string + enum: ["balance_tx_existing_total_collateral"] + +x-errBalanceTxInternalError: &errBalanceTxInternalError + <<: *responsesErr + title: balance_tx_internal_error + properties: + message: + type: string + description: | + Balancing transaction failed for an internal reason. + code: + type: string + enum: ["balance_tx_internal_error"] + +x-errBalanceTxMaxSizeLimitExceeded: &errBalanceTxMaxSizeLimitExceeded + <<: *responsesErr + title: balance_tx_max_size_limit_exceeded + properties: + message: + type: string + description: | + I was not able to balance the transaction without exceeding + the maximum transaction size. + code: + type: string + enum: ["balance_tx_max_size_limit_exceeded"] + +x-errBalanceTxUnderestimatedFee: &errBalanceTxUnderestimatedFee + <<: *responsesErr + title: balance_tx_underestimated_fee + properties: + message: + type: string + description: | + I have somehow underestimated the fee of the transaction + and cannot finish balancing. + code: + type: string + enum: ["balance_tx_underestimated_fee"] + +x-errBalanceTxZeroAdaOutput: &errBalanceTxZeroAdaOutput + <<: *responsesErr + title: balance_tx_zero_ada_output + properties: + message: + type: string + description: | + I don't currently support balancing transactions containing + one or more zero-ada outputs. In the future I might be able + to increase the values to the minimum allowed ada value. + code: + type: string + enum: ["balance_tx_zero_ada_output"] + x-errMethodNotAllowed: &errMethodNotAllowed <<: *responsesErr title: method_not_allowed @@ -5713,15 +5841,23 @@ x-responsesBalanceTransaction: &responsesBalanceTransaction application/json: schema: oneOf: - - <<: *errInvalidWalletType - <<: *errAlreadyWithdrawing - - <<: *errUtxoTooSmall + - <<: *errBalanceTxByronNotSupported + - <<: *errBalanceTxConflictingNetworks + - <<: *errBalanceTxExistingCollateral + - <<: *errBalanceTxExistingKeyWitnesses + - <<: *errBalanceTxExistingReturnCollateral + - <<: *errBalanceTxExistingTotalCollateral + - <<: *errBalanceTxInternalError + - <<: *errBalanceTxMaxSizeLimitExceeded - <<: *errCannotCoverFee - - <<: *errNotEnoughMoney - <<: *errInsufficientCollateral - - <<: *errTransactionIsTooBig + - <<: *errInvalidWalletType + - <<: *errNotEnoughMoney - <<: *errTransactionAlreadyBalanced - - <<: *errExistingKeyWitnesses + - <<: *errTransactionIsTooBig + - <<: *errUtxoTooSmall + <<: *responsesErr404WalletNotFound <<: *responsesErr406 <<: *responsesErr415UnsupportedMediaType