Merge #2974

2974: Support for verifying selection errors r=jonathanknowles a=jonathanknowles

## Issue Number

ADP-1037

## Summary

This PR:
- [x] adds basic support for verifying selection errors (values of type `SelectionError`).
- [x] makes some simplifications to `prop_performSelection`.

## Not included in this PR

For now, selection errors will always verify successfully with `VerifySelectionErrorSuccess`.
Future PRs will extend the definition of `verifySelectionError`.

Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>

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

@@ -42,6 +42,10 @@ module Cardano.Wallet.Primitive.CoinSelection
     , VerifySelectionResult (..)
     , verifySelection
 
+    -- * Selection error verification
+    , VerifySelectionErrorResult (..)
+    , verifySelectionError
+
     -- * Selection deltas
     , SelectionDelta (..)
     , selectionDelta
@@ -151,11 +155,18 @@ type PerformSelection m a =
 --  - producing change outputs to return excess value to the wallet;
 --  - balancing a selection to pay for the transaction fee.
 --
--- This function guarantees that if it successfully creates a 'Selection' @s@,
--- given a set of 'SelectionConstraints' @cs@ and 'SelectionParameters' @ps@,
--- then the following property will hold:
+-- This function guarantees that given a set of 'SelectionConstraints' @cs@
+-- and 'SelectionParams' @ps@:
+--
+--  - if creation of a selection succeeds, a value @s@ of type 'Selection'
+--    will be returned for which the following property holds:
+--
+--      >>> verifySelection cs ps s == VerifySelectionSuccess
 --
---    >>> verifySelection cs ps s == VerifySelectionSuccess
+--  - if creation of a selection fails, a value @e@ of type 'SelectionError'
+--    will be returned for which the following property holds:
+--
+--      >>> verifySelectionError cs ps e == VerifySelectionErrorSuccess
 --
 performSelection
     :: (HasCallStack, MonadRandom m) => PerformSelection m Selection
@@ -352,16 +363,16 @@ toBalanceResult selection = Balance.SelectionResult
 -- Selection verification
 --------------------------------------------------------------------------------
 
--- | The result of verifying a selection with 'verifySelection'.
+-- | The result of verifying a 'Selection' with 'verifySelection'.
 --
 data VerifySelectionResult
     = VerifySelectionSuccess
-    | VerifySelectionFailure (NonEmpty VerifySelectionError)
+    | VerifySelectionFailure (NonEmpty VerifySelectionFailureReason)
     deriving (Eq, Show)
 
--- | Indicates that verification of a selection has failed.
+-- | Indicates that verification of a 'Selection' has failed.
 --
-data VerifySelectionError
+data VerifySelectionFailureReason
     = VerifySelectionCollateralInsufficient
       VerifySelectionCollateralInsufficientError
     | VerifySelectionCollateralUnsuitable
@@ -378,19 +389,19 @@ data VerifySelectionError
       VerifySelectionOutputTokenQuantityExceedsLimitError
     deriving (Eq, Show)
 
--- | The type of all selection property verification functions.
+-- | The type of all 'Selection' verification functions.
 --
 type VerifySelectionProperty error =
     SelectionConstraints ->
     SelectionParams ->
     Selection ->
     Maybe error
 
--- | Verifies a selection for correctness.
+-- | Verifies a 'Selection' for correctness.
 --
 -- This function is provided primarily as a convenience for testing. As such,
 -- it's not usually necessary to call this function from ordinary application
--- code, unless you suspect that a selection is incorrect in some way.
+-- code, unless you suspect that a 'Selection' is incorrect in some way.
 --
 verifySelection
     :: SelectionConstraints
@@ -403,7 +414,7 @@ verifySelection cs ps selection
     | otherwise =
         VerifySelectionSuccess
   where
-    errors :: [VerifySelectionError]
+    errors :: [VerifySelectionFailureReason]
     errors = lefts
         [ verifySelectionCollateralSufficiency cs ps selection
             `failWith` VerifySelectionCollateralInsufficient
@@ -611,6 +622,33 @@ verifySelectionOutputTokenQuantities _cs _ps selection
     errors :: [SelectionOutputTokenQuantityExceedsLimitError]
     errors = verifyOutputTokenQuantities =<< selectionAllOutputs selection
 
+--------------------------------------------------------------------------------
+-- Selection error verification
+--------------------------------------------------------------------------------
+
+-- | The result of verifying a 'SelectionError' with 'verifySelectionError'.
+--
+data VerifySelectionErrorResult
+    = VerifySelectionErrorSuccess
+    | VerifySelectionErrorFailure
+    deriving (Eq, Show)
+
+-- | Verifies a 'SelectionError' for correctness.
+--
+-- This function is provided primarily as a convenience for testing. As such,
+-- it's not usually necessary to call this function from ordinary application
+-- code, unless you suspect that a 'SelectionError' is incorrect in some way.
+--
+verifySelectionError
+    :: SelectionConstraints
+    -> SelectionParams
+    -> SelectionError
+    -> VerifySelectionErrorResult
+verifySelectionError _cs _ps _e =
+    -- TODO: [ADP-1037]
+    -- For now, all errors will verify successfully.
+    VerifySelectionErrorSuccess
+
 --------------------------------------------------------------------------------
 -- Selection deltas
 --------------------------------------------------------------------------------

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

@@ -19,13 +19,15 @@ import Cardano.Wallet.Primitive.CoinSelection
     , SelectionConstraints (..)
     , SelectionError (..)
     , SelectionParams (..)
+    , VerifySelectionErrorResult (..)
     , VerifySelectionResult (..)
     , computeMinimumCollateral
     , performSelection
     , prepareOutputsWith
     , selectionCollateralRequired
     , toBalanceConstraintsParams
     , verifySelection
+    , verifySelectionError
     )
 import Cardano.Wallet.Primitive.CoinSelection.Balance
     ( SelectionLimit, SelectionSkeleton )
@@ -126,8 +128,8 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do
 
     parallel $ describe "Performing selections" $ do
 
-        it "prop_performSelection_onSuccess" $
-            property prop_performSelection_onSuccess
+        it "prop_performSelection" $
+            property prop_performSelection
 
     parallel $ describe "Constructing balance constraints and parameters" $ do
 
@@ -155,32 +157,23 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do
 -- Performing selections
 --------------------------------------------------------------------------------
 
-type PerformSelectionProperty =
-    Pretty MockSelectionConstraints ->
-    Pretty SelectionParams ->
-    Property
-
-type PerformSelectionPropertyInner =
-    SelectionConstraints ->
-    SelectionParams ->
-    Either SelectionError Selection ->
-    Property
-
-prop_performSelection_with
-    :: PerformSelectionPropertyInner
-    -> PerformSelectionProperty
-prop_performSelection_with mkProperty (Pretty mockConstraints) (Pretty params) =
-    monadicIO $ do
-        result <- run $ runExceptT $ performSelection constraints params
-        pure $ conjoin
-            [ prop_performSelection_coverage constraints params result
-            , mkProperty constraints params result
-            ]
+prop_performSelection
+    :: Pretty MockSelectionConstraints
+    -> Pretty SelectionParams
+    -> Property
+prop_performSelection (Pretty mockConstraints) (Pretty params) =
+    monadicIO $
+    prop_performSelection_inner constraints params <$>
+    run (runExceptT $ performSelection constraints params)
   where
     constraints = unMockSelectionConstraints mockConstraints
 
-prop_performSelection_coverage :: PerformSelectionPropertyInner
-prop_performSelection_coverage _constraints params result =
+prop_performSelection_inner
+    :: SelectionConstraints
+    -> SelectionParams
+    -> Either SelectionError Selection
+    -> Property
+prop_performSelection_inner constraints params result =
     checkCoverage $
     cover 10 (isLeft result)
         "failure" $
@@ -198,9 +191,13 @@ prop_performSelection_coverage _constraints params result =
                 "failure: collateral" $
             cover 0.5 (isOutputError e)
                 "failure: output" $
-            property True
-        Right _ ->
-            property True
+            report e "selection error" $
+            Pretty (verifySelectionError constraints params e) ===
+            Pretty VerifySelectionErrorSuccess
+        Right selection ->
+            report selection "selection" $
+            Pretty (verifySelection constraints params selection) ===
+            Pretty VerifySelectionSuccess
   where
     isBalanceError :: SelectionError -> Bool
     isBalanceError = \case
@@ -215,16 +212,6 @@ prop_performSelection_coverage _constraints params result =
         SelectionOutputError _ -> True
         _ -> False
 
-prop_performSelection_onSuccess :: PerformSelectionProperty
-prop_performSelection_onSuccess =
-    prop_performSelection_with $ \constraints params ->
-        either (const $ property True) (onSuccess constraints params)
-  where
-    onSuccess constraints params selection =
-        report selection "selection" $
-        Pretty (verifySelection constraints params selection) ===
-        Pretty VerifySelectionSuccess
-
 --------------------------------------------------------------------------------
 -- Construction of balance constraints and parameters
 --------------------------------------------------------------------------------