Re-write balanceTransaction

Misc balanceTx testing improvements for re-write Try to catch more problems in prop_balanceTransactionBalanced Factor out change addr assignment from selectAssets' Remove unused selectionDelta Tweak some comments
cardano-foundation · Mar 1, 2022 · ae8a220 · ae8a220
1 parent dd95203
commit ae8a220
Show file tree

Hide file tree

Showing 10 changed files with 493 additions and 336 deletions.
diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs
@@ -45,6 +45,7 @@ module Test.Integration.Framework.TestData
     , errMsg400WalletIdEncoding
     , errMsg400StartTimeLaterThanEndTime
     , errMsg403Fee
+    , errMsg403MinimizeFee
     , errMsg403Collateral
     , errMsg403NotAByronWallet
     , errMsg403NotAnIcarusWallet
@@ -322,6 +323,11 @@ errMsg403Fee =
     \available to pay for the fee and also pay for the minimum ada quantities \
     \of all change outputs."
 
+errMsg403MinimizeFee :: String
+errMsg403MinimizeFee =
+    "I cannot minimize fees because I cannot construct a change \
+    \output. Try ensuring the wallet has at least a couple of ada."
+
 errMsg403Collateral :: String
 errMsg403Collateral =
     "I'm unable to create this transaction because the balance of pure ada \

diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/TransactionsNew.hs
@@ -186,6 +186,7 @@ import Test.Integration.Framework.TestData
     , errMsg403ForeignTransaction
     , errMsg403InvalidConstructTx
     , errMsg403MinUTxOValue
+    , errMsg403MinimizeFee
     , errMsg403MissingWitsInTransaction
     , errMsg403MultiaccountTransaction
     , errMsg403MultidelegationTransaction
@@ -1645,21 +1646,21 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
 
     it "TRANS_NEW_BALANCE_02b - Cannot balance when I cannot afford fee" $
         \ctx -> runResourceT $ do
-        wa <- fixtureWalletWith @n ctx [2 * 1_000_000]
+        wa <- fixtureWalletWith @n ctx [2_500_000]
         let balancePayload = Json PlutusScenario.pingPong_1
         rTx <- request @ApiSerialisedTransaction ctx
             (Link.balanceTransaction @'Shelley wa) Default balancePayload
         verify rTx
             [ expectResponseCode HTTP.status403
-            , expectErrorMessage errMsg403Fee
+            , expectErrorMessage errMsg403MinimizeFee
             ]
 
     it "TRANS_NEW_BALANCE_02c - \
         \Cannot balance when I cannot afford collateral" $
         \ctx -> runResourceT $ do
+        liftIO $ pendingWith "unreachable with current params (need ≈2.2 ada for collateral, need ≈3.4 ada for balancing)"
         wa <- fixtureWalletWith @n ctx
-            [ 2_000_000
-            , 2_000_000
+            [ 3_300_000
             ]
         let toBalance = Json PlutusScenario.pingPong_1
         rTx <- request @ApiSerialisedTransaction ctx
@@ -1689,11 +1690,11 @@ spec = describe "NEW_SHELLEY_TRANSACTIONS" $ do
             , expectErrorMessage errMsg403Collateral
             , expectErrorMessage $ unwords
                 [ "I need an ada amount of at least:"
-                , "2.779500"
+                , "2.627700"
                 ]
             , expectErrorMessage $ unwords
                 [ "The largest combination of pure ada UTxOs I could find is:"
-                , "[1.853000]"
+                , "[1.873000]"
                 ]
             ]
 

diff --git a/lib/core/src/Cardano/Api/Gen.hs b/lib/core/src/Cardano/Api/Gen.hs
@@ -256,8 +256,14 @@ genLovelace = Lovelace <$> frequency
             , (8, pure 65536)
             , (90, pure 4294967296)
             ]
-        x <- choose (-1_000_000, 1_000_000)
-        pure $ max 0 $ boundary + x
+
+        offset <- frequency
+            [ (1, choose (-10, 10))
+            , (1, choose (-220_000, -150_000))
+            , (1, choose (150_000, 220_000))
+            , (1, choose (-1_000_000, 1_000_000))
+            ]
+        pure $ max 0 $ boundary + offset
 
 
 genTxFee :: CardanoEra era -> Gen (TxFee era)