Merge #2338 #2346

2338: Mark TRANS_TTL_{01,02}, STAKE_POOLS_JOIN_05, and STAKE_POOLS_SMASH_01 pending r=Anviking a=Anviking

# Issue Number

None. Addressing CI failures.

# Overview


- [x] Add new `flakyBecauseOf ticketOrReason` helper that calls `pendingWith` unless `RUN_FLAKY_TESTS` is set.
- [x] Mark TRANS_TTL_{01,02} and STAKE_POOLS_JOIN_05 pending/flaky.
- [x] Also mark STAKE_POOLS_SMASH_01 pending
- [x] Add manual test calling for running flaky tests

# Comments

- Should lower the failure rate by 21% of runs, from 59% to 38%. 
- Next candidate for marking pending would be #2224, but with a relatively low failure rate of 3.6%, and being important, I think it would be a bad idea.
- Maybe we should have flaky tests run per default, unless setting `DONT_RUN_FLAKY_TESTS` in CI, to maximise the times we run them locally.

Recent bors failures:
```
succeded: 19, failed: 37 (66%), total: 56
excluding #expected failures

Broken down by tags/issues:
10 times #2292 Flaky test - various DB properties causing timeout | #2292
7 times #2295 Flaky TRANS_TTL_{01,02} - SlotNo 80 > SlotNo 50 | #2295
6 times
3 times #2311 Flaky test - integration test timeout after/related to STAKE_POOLS_LIST_01 | #2311
3 times #2230 Flaky  STAKE_POOLS_JOIN_05 - Can join when stake key already exists | #2230
2 times #2224 Flaky STAKE_POOLS_LIST_01 - List stake pools, has non-zero saturation & stake | #2224
1 times #another-integration-timeout  |
1 times #2337 STAKE_POOLS_GARBAGE_COLLECTION_01 timed out | #2337
1 times #2320 Flaky test - The node backend is unreachable at the moment. STAKE_POOLS_QUIT_02 | #2320
1 times #2295, #2331 Flaky TRANS_TTL_{01,02} - SlotNo 80 > SlotNo 50 | #2295
1 times #2207 Flaky SHELLEY_MIGRATE_01_big_wallet | #2207
1 times #2118 Property `prop_rebalanceSelection` occasionally fails. | #2118
```


<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


2346: get rid of 'OnDanglingChange' option for fee balancing r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

ADP-568

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- [ ] I have removed 'OnDanglingChange' option for fee balancing.

# Comments

<!-- Additional comments or screenshots to attach if any -->

  This option allowed choosing between two modes: SaveMoney and
  PayAndBalance. The former was used with cardano-node, and the latter
  used with jormungandr. The reason for having a difference is was
  because of discrepency in the minimum transaction expected by both
  ledger. On jormungandr, transactions have to be _exactly_ balanced and
  leave exactly the expected fees required by the network. On the
  counterpart, the fee calculation was only a function of the number of
  inputs and outputs... therefore much easier to satisfy than on
  cardano-node. Now that we've removed jormungandr, this extra
  indirection / complexity is just harmful. Since the 'PayAndBalance'
  mode is never used, I've removed the option entirely and made code
  assume 'SaveMoney' everywhere it used to choose between both
  alternatives.

  This also seemingly remove the 'allowUnbalancedTx' field from the
  transaction layer which was directly related to this option.

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: Johannes Lund <[email protected]>
Co-authored-by: KtorZ <[email protected]>

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs

@@ -85,7 +85,7 @@ import Test.Hspec
 import Test.Hspec.Expectations.Lifted
     ( shouldBe, shouldSatisfy )
 import Test.Hspec.Extra
-    ( it )
+    ( flakyBecauseOf, it )
 import Test.Integration.Framework.Context
     ( Context (..), PoolGarbageCollectionEvent (..) )
 import Test.Integration.Framework.DSL
@@ -581,6 +581,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
 
     it "STAKE_POOLS_JOIN_05 - \
         \Can join when stake key already exists" $ \ctx -> runResourceT $ do
+        liftIO $ flakyBecauseOf "#2230"
         let walletWithPreRegKey =
                 [ "over", "decorate", "flock", "badge", "beauty"
                 , "stamp" , "chest", "owner", "excess", "omit"
@@ -1101,6 +1102,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do
 
     it "STAKE_POOLS_SMASH_01 - fetching metadata from SMASH works with delisted pools" $
         \ctx -> runResourceT $ bracketSettings ctx $ do
+            liftIO $ flakyBecauseOf "#2337 (theorized)"
             smashUrl <- liftIO $ getEnv "CARDANO_WALLET_SMASH_URL"
             updateMetadataSource ctx (T.pack smashUrl)
             eventually "metadata is fetched" $ do

lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs

@@ -88,11 +88,11 @@ import Network.HTTP.Types.Method
 import Numeric.Natural
     ( Natural )
 import Test.Hspec
-    ( SpecWith, describe, pendingWith )
+    ( SpecWith, describe )
 import Test.Hspec.Expectations.Lifted
     ( expectationFailure, shouldBe, shouldNotBe, shouldSatisfy )
 import Test.Hspec.Extra
-    ( it )
+    ( flakyBecauseOf, it )
 import Test.Integration.Framework.DSL
     ( Context
     , Headers (..)
@@ -607,6 +607,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
     let slotDiff a b = if a > b then a - b else b - a
 
     it "TRANS_TTL_01 - Pending transaction expiry" $ \ctx -> runResourceT $ do
+        liftIO $ flakyBecauseOf "#2295"
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = minUTxOValue :: Natural
 
@@ -640,6 +641,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
             & counterexample ("actual expiry: " <> show txActualExp)
 
     it "TRANS_TTL_02 - Custom transaction expiry" $ \ctx -> runResourceT $ do
+        liftIO $ flakyBecauseOf "#2295"
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = minUTxOValue :: Natural
         let testTTL = 42 :: NominalDiffTime
@@ -674,7 +676,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
             & counterexample ("actual expiry: " <> show txActualExp)
 
     it "TRANS_TTL_03 - Expired transactions" $ \ctx -> runResourceT $ do
-        liftIO $ pendingWith "#1840 this is flaky -- need a better approach"
+        liftIO $ flakyBecauseOf "#1840 -- need a better approach"
 
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = minUTxOValue :: Natural
@@ -2219,7 +2221,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets"
 
     it "TRANS_TTL_DELETE_01 - Shelley: can remove expired tx" $ \ctx -> runResourceT $ do
-        liftIO $ pendingWith "#1840 this is flaky -- need a better approach"
+        liftIO $ flakyBecauseOf "#1840 -- need a better approach"
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx
         let amt = minUTxOValue :: Natural
 

lib/core/src/Cardano/Wallet.hs

@@ -273,12 +273,7 @@ import Cardano.Wallet.Primitive.CoinSelection
 import Cardano.Wallet.Primitive.CoinSelection.Migration
     ( depleteUTxO, idealBatchSize )
 import Cardano.Wallet.Primitive.Fee
-    ( ErrAdjustForFee (..)
-    , Fee (..)
-    , FeeOptions (..)
-    , OnDanglingChange (..)
-    , adjustForFee
-    )
+    ( ErrAdjustForFee (..), Fee (..), FeeOptions (..), adjustForFee )
 import Cardano.Wallet.Primitive.Model
     ( Wallet
     , applyBlocks
@@ -1260,7 +1255,6 @@ feeOpts
 feeOpts tl action md txp minUtxo cs = FeeOptions
     { estimateFee = minimumFee tl feePolicy action md
     , dustThreshold = minUtxo
-    , onDanglingChange = if allowUnbalancedTx tl then SaveMoney else PayAndBalance
     -- NOTE
     -- Our fee calculation is rather good, but not perfect. We make little
     -- approximation errors that may lead to us leaving slightly more fees than

lib/core/src/Cardano/Wallet/Primitive/Fee.hs

@@ -28,7 +28,6 @@ module Cardano.Wallet.Primitive.Fee
       -- * Fee Adjustment
     , FeeOptions (..)
     , ErrAdjustForFee(..)
-    , OnDanglingChange(..)
     , adjustForFee
     , rebalanceSelection
     , coalesceDust
@@ -106,11 +105,6 @@ data FeeOptions = FeeOptions
       -- from the created transaction. Setting 'dustThreshold' to 0
       -- removes output equal to 0
 
-    , onDanglingChange
-      :: OnDanglingChange
-      -- ^ What do to when we encouter a dangling change output.
-      -- See 'OnDanglingChange'
-
     , feeUpperBound
       :: Fee
       -- ^ An extra upper-bound computed from the transaction max size. This is
@@ -124,19 +118,6 @@ data FeeOptions = FeeOptions
       -- transaction size based on how many inputs it has.
     } deriving (Generic)
 
--- | We call 'dangling' a change output that would be too expensive to add. This
--- can happen when a change output is small, but adding it generate more fees
--- than not having it.
---
--- In case where nodes accept slightly unbalanced transactions, we may choose to
--- save money and keep the transaction slightly unbalanced. In case where node
--- demands exactly balanced transaction, we have no choice but to add the extra
--- dangling change output and pay for the extra cost induced.
-data OnDanglingChange
-    = PayAndBalance
-    | SaveMoney
-    deriving (Generic, Show, Eq)
-
 newtype ErrAdjustForFee
     = ErrCannotCoverFee Word64
     -- ^ UTxO exhausted during fee covering
@@ -300,21 +281,11 @@ rebalanceSelection opts s
         rebalanceSelection opts (s { change = chgs' })
 
     -- we've left too much, but adding a change output would be more
-    -- expensive than not having it. Here we have two choices:
-    --
-    -- a) If the node allows unbalanced transaction, we can stop here and do
-    -- nothing. We'll leave slightly more than what's needed for fees, but
-    -- having an extra change output isn't worth it anyway.
-    --
-    -- b) If we __must__ balance the transaction, then we can choose to pay
-    -- the extra cost by adding the change output and pick a new input to
-    -- pay for the fee.
+    -- expensive than not having it. Sicne the node allows unbalanced transaction,
+    -- we can stop here and do nothing. We'll leave slightly more than what's
+    -- needed for fees, but having an extra change output isn't worth it anyway.
     | φ_dangling >= δ_original && φ_dangling > δ_dangling =
-        case onDanglingChange opts of
-            SaveMoney ->
-                (s, Fee 0)
-            PayAndBalance ->
-                (sDangling, Fee (φ_dangling - δ_dangling))
+        (s, Fee 0)
 
     -- So, we can simply add the change output, and iterate.
     | otherwise =

lib/core/src/Cardano/Wallet/Transaction.hs

@@ -154,10 +154,6 @@ data TransactionLayer t k = TransactionLayer
       -- For example, Byron nodes do not allow null output amounts. Jörmungandr
       -- on its side doesn't support more than 255 inputs or outputs.
 
-    , allowUnbalancedTx
-      :: Bool
-      -- ^ Whether the transaction layer accepts unbalanced transactions.
-
     , decodeSignedTx
         :: ByteString -> Either ErrDecodeSignedTx (Tx, SealedTx)
         -- ^ Decode an externally-signed transaction to the chain producer

lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MigrationSpec.hs

@@ -15,7 +15,7 @@ import Cardano.Wallet.Primitive.CoinSelection.Migration
 import Cardano.Wallet.Primitive.CoinSelectionSpec
     ()
 import Cardano.Wallet.Primitive.Fee
-    ( Fee (..), FeeOptions (..), OnDanglingChange (..) )
+    ( Fee (..), FeeOptions (..) )
 import Cardano.Wallet.Primitive.FeeSpec
     ()
 import Cardano.Wallet.Primitive.Types.Address
@@ -122,7 +122,6 @@ spec = do
                     , estimateFee = \s -> Fee
                         $ fromIntegral
                         $ 5 * (length (inputs s) + length (outputs s))
-                    , onDanglingChange = PayAndBalance
                     , feeUpperBound = Fee maxBound
                     , maximumNumberOfInputs = maxBound
                     }
@@ -245,7 +244,6 @@ genFeeOptions (Coin dust) = do
             let x = fromIntegral (length (inputs s) + length (outputs s))
             in Fee $ (dust `div` 100) * x + dust
         , dustThreshold = Coin dust
-        , onDanglingChange = PayAndBalance
         , feeUpperBound = Fee maxBound
         , maximumNumberOfInputs = maxBound
         }

lib/core/test/unit/Cardano/Wallet/Primitive/FeeSpec.hs

@@ -25,7 +25,6 @@ import Cardano.Wallet.Primitive.Fee
     ( ErrAdjustForFee (..)
     , Fee (..)
     , FeeOptions (..)
-    , OnDanglingChange (..)
     , adjustForFee
     , coalesceDust
     , divvyFee
@@ -514,23 +513,19 @@ propDivvyFeeInvariantEmptyList (fee, outs) =
 
 prop_rebalanceSelection
     :: CoinSelection
-    -> OnDanglingChange
     -> Coin
     -> Property
-prop_rebalanceSelection sel onDangling threshold = do
+prop_rebalanceSelection sel threshold = do
     let (sel', fee') = first withCoalescedDust $ rebalanceSelection opts sel
 
-    let selectionIsBalanced = case onDangling of
-            PayAndBalance ->
-                delta sel' == fromIntegral (getFee $ estimateFee opts sel')
-            SaveMoney ->
-                delta sel' >= fromIntegral (getFee $ estimateFee opts sel')
+    let selectionIsBalanced =
+            delta sel' >= fromIntegral (getFee $ estimateFee opts sel')
 
     let equalityModuloChange =
             sel { change = [] } == sel' { change = [] }
 
     let noDust =
-            all (> threshold') (change sel')
+            all (> threshold) (change sel')
 
     conjoin
         [ fee' == Fee 0 ==> selectionIsBalanced
@@ -566,45 +561,20 @@ prop_rebalanceSelection sel onDangling threshold = do
 
     withCoalescedDust :: CoinSelection -> CoinSelection
     withCoalescedDust cs =
-        cs { change = coalesceDust threshold' (change cs) }
-
-    -- NOTE: We only allow non-null dust threshold if 'onDangling' is
-    -- set to 'SaveMoney'.
-    threshold' =
-        case onDangling of
-            SaveMoney ->
-                threshold
-
-            PayAndBalance ->
-                Coin 0
+        cs { change = coalesceDust threshold (change cs) }
 
     opts = FeeOptions
         { estimateFee = \cs ->
-            case onDangling of
-                -- NOTE
-                -- Dummy fee policy but, following a similar rule as the fee
-                -- policy on Byron / Shelley (bigger transaction cost more) with
-                -- sensible values.
-                SaveMoney ->
-                    let
-                        size = fromIntegral $ length $ show cs
-                    in
-                        Fee (100000 + 100 * size)
-
-                -- NOTE
-                -- Dummy fee policy but, following a similar rule as the fee
-                -- policy on Jormungandr. More inputs/outputs cost more.
-                PayAndBalance ->
-                    let
-                        ios = fromIntegral
-                            $ length (inputs cs)
-                            + length (outputs cs)
-                            + length (change cs)
-                    in
-                        Fee (100000 + 100 * ios)
-
-        , dustThreshold = threshold'
-        , onDanglingChange = onDangling
+            -- NOTE
+            -- Dummy fee policy but, following a similar rule as the fee
+            -- policy on Byron / Shelley (bigger transaction cost more) with
+            -- sensible values.
+            let
+                size = fromIntegral $ length $ show cs
+            in
+                Fee (100000 + 100 * size)
+
+        , dustThreshold = threshold
         , feeUpperBound = Fee maxBound
         , maximumNumberOfInputs = maxBound
         }
@@ -629,8 +599,6 @@ feeOptions fee dust = FeeOptions
         \_ -> Fee fee
     , dustThreshold =
         Coin dust
-    , onDanglingChange =
-        PayAndBalance
     , feeUpperBound =
         Fee maxBound
     , maximumNumberOfInputs =
@@ -846,10 +814,6 @@ instance Arbitrary CoinSelection where
             >>= genTxOut
         genSelectionFor (NE.fromList outs)
 
-instance Arbitrary OnDanglingChange
-  where
-    arbitrary = elements [ PayAndBalance, SaveMoney ]
-
 instance Arbitrary FeeOptions where
     arbitrary = do
         t <- choose (0, 10) -- dust threshold
@@ -861,11 +825,10 @@ instance Arbitrary FeeOptions where
                     $ fromIntegral
                     $ c + a * (length (inputs s) + length (outputs s))
             , dustThreshold = Coin t
-            , onDanglingChange = PayAndBalance
             , feeUpperBound = Fee maxBound
             , maximumNumberOfInputs = maxBound
             }
 
 instance Show FeeOptions where
-    show (FeeOptions _ dust onDangling maxFee maxN) =
-        show (dust, onDangling, maxFee, maxN)
+    show (FeeOptions _ dust maxFee maxN) =
+        show (dust, maxFee, maxN)

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -743,8 +743,6 @@ dummyTransactionLayer = TransactionLayer
         error "dummyTransactionLayer: validateSelection not implemented"
     , decodeSignedTx =
         error "dummyTransactionLayer: decodeSignedTx not implemented"
-    , allowUnbalancedTx =
-        False
     }
   where
     withEither :: e -> Maybe a -> Either e a

lib/shelley/src/Cardano/Wallet/Shelley/Transaction.hs

@@ -233,7 +233,6 @@ newTransactionLayer networkId = TransactionLayer
     , minimumFee = _minimumFee @k networkId
     , estimateMaxNumberOfInputs = _estimateMaxNumberOfInputs @k networkId
     , validateSelection = const $ return ()
-    , allowUnbalancedTx = True
     }
   where
     _initDelegationSelection

lib/test-utils/src/Test/Hspec/Extra.hs

@@ -14,6 +14,7 @@ module Test.Hspec.Extra
     ( aroundAll
     , it
     , itWithCustomTimeout
+    , flakyBecauseOf
     ) where
 
 import Prelude
@@ -26,15 +27,19 @@ import Control.Concurrent.MVar
     ( MVar, newEmptyMVar, putMVar, takeMVar )
 import Control.Exception
     ( SomeException, catch, throwIO )
+import System.Environment
+    ( lookupEnv )
 import Test.Hspec
     ( ActionWith
+    , Expectation
     , HasCallStack
     , Spec
     , SpecWith
     , afterAll
     , beforeAll
     , beforeWith
     , expectationFailure
+    , pendingWith
     , specify
     )
 
@@ -143,3 +148,11 @@ await = takeMVar
 -- | Some helper to help readability on the thread synchronization above.
 unlock  :: MVar () -> IO ()
 unlock = flip putMVar ()
+
+-- | Mark a test pending because of flakiness, with given reason. Unless the
+-- RUN_FLAKY_TESTS environment variable is set.
+flakyBecauseOf :: String -> Expectation
+flakyBecauseOf ticketOrReason =
+    lookupEnv "RUN_FLAKY_TESTS" >>= \case
+        Just _ -> return ()
+        Nothing -> pendingWith $ "Flaky: " <> ticketOrReason

test/manual/cardano-node/FlakyTests.md

@@ -0,0 +1,15 @@
+# Run Flaky Tests
+
+Some tests might have been disabled in CI with the `flakyBecauseOf` helper.
+
+Run them locally using 
+
+```bash
+RUN_FLAKY_TESTS=1 stack test cardano-wallet:integration
+```
+
+or on Windows:
+```bash
+set RUN_FLAKY_TESTS=1
+cardano-wallet-test-integration.exe
+```