From adf7dd0ad75b153f86c6e18b4e8340a302107221 Mon Sep 17 00:00:00 2001
From: Jonathan Knowles <jonathan.knowles@iohk.io>
Date: Thu, 22 Apr 2021 11:10:38 +0000
Subject: [PATCH] Check that `Selection.create` and `Selection.extend` minimize
 the fee.

It's really important that both of these functions minimize the fee.

So we check that:

1. Calling `balance` on a resultant selection leaves it unchanged.
2. Calling `minimizeFee` on a resultant fee excess leaves it unchanged.

In response to review feedback:

https://github.com/input-output-hk/cardano-wallet/pull/2618#issuecomment-822413404
---
 .../Wallet/Primitive/Migration/Selection.hs   |  3 ++
 .../Primitive/Migration/SelectionSpec.hs      | 53 +++++++++++++++----
 2 files changed, 47 insertions(+), 9 deletions(-)

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs b/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs
index 420d2fa9014..6cc8c59e444 100644
--- a/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs
+++ b/lib/core/src/Cardano/Wallet/Primitive/Migration/Selection.hs
@@ -34,6 +34,9 @@ module Cardano.Wallet.Primitive.Migration.Selection
     -- * Extending selections
     , extend
 
+    -- * Balancing selections
+    , balance
+
     -- * Adding value to outputs
     , addValueToOutputs
 
diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs
index e57fa00fb46..d4ae0a350c7 100644
--- a/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs
+++ b/lib/core/test/unit/Cardano/Wallet/Primitive/Migration/SelectionSpec.hs
@@ -102,7 +102,6 @@ import Test.QuickCheck
     , vectorOf
     , withMaxSuccess
     , (.&&.)
-    , (===)
     )
 import Text.Pretty.Simple
     ( pShow )
@@ -181,9 +180,9 @@ prop_create_inner
     -> Property
 prop_create_inner mockConstraints inputs reward =
     checkCoverage $
-    cover 40 (resultIsSelection result)
+    cover 50 (resultIsSelection result)
         "Success" $
-    cover 10 (resultHasZeroFeeExcess result)
+    cover 50 (resultHasZeroFeeExcess result)
         "Success with zero fee excess" $
     cover 1 (resultHasInsufficientAda result)
         "Failure due to insufficient ada" $
@@ -196,8 +195,26 @@ prop_create_inner mockConstraints inputs reward =
             property True
         Left (SelectionFull e) ->
             property (selectionSizeMaximum e < selectionSizeRequired e)
-        Right selection ->
-            Selection.verify constraints selection === SelectionCorrect
+        Right selection -> makeReports $ testAll
+            $ verify
+                (correctness == SelectionCorrect)
+                "correctness == SelectionCorrect"
+            . verify
+                (Selection.balance constraints selection == Right selection)
+                "Rebalancing the selection leaves it unchanged"
+            . verify
+                (feeExcess selection == feeExcessExpected)
+                "feeExcess selection == feeExcessExpected"
+          where
+            makeReports
+                = report correctness
+                    "correctness"
+                . report feeExcessExpected
+                    "feeExcessExpected"
+            correctness =
+                Selection.verify constraints selection
+            (feeExcessExpected, _) =
+                minimizeFee constraints (feeExcess selection, outputs selection)
   where
     constraints = unMockTxConstraints mockConstraints
     result = create constraints reward inputs
@@ -262,7 +279,7 @@ prop_extend_inner
     -> MockSelection
     -> (MockInputId, TokenBundle)
     -> Property
-prop_extend_inner mockConstraints selection input =
+prop_extend_inner mockConstraints selectionOriginal input =
     checkCoverage $
     cover 40 (resultIsSelection result)
         "Success" $
@@ -279,11 +296,29 @@ prop_extend_inner mockConstraints selection input =
             property True
         Left (SelectionFull e) ->
             property (selectionSizeMaximum e < selectionSizeRequired e)
-        Right selectionExtended ->
-            Selection.verify constraints selectionExtended === SelectionCorrect
+        Right selection -> makeReports $ testAll
+            $ verify
+                (correctness == SelectionCorrect)
+                "correctness == SelectionCorrect"
+            . verify
+                (Selection.balance constraints selection == Right selection)
+                "Rebalancing the selection leaves it unchanged"
+            . verify
+                (feeExcess selection == feeExcessExpected)
+                "feeExcess selection == feeExcessExpected"
+          where
+            makeReports
+                = report correctness
+                    "correctness"
+                . report feeExcessExpected
+                    "feeExcessExpected"
+            correctness =
+                Selection.verify constraints selection
+            (feeExcessExpected, _) =
+                minimizeFee constraints (feeExcess selection, outputs selection)
   where
     constraints = unMockTxConstraints mockConstraints
-    result = extend constraints selection input
+    result = extend constraints selectionOriginal input
 
 --------------------------------------------------------------------------------
 -- Adding value to outputs