Add verifySelection function to verify the correctness of a selection.

We also add a property `prop_performSelection_onSuccess_isCorrect`.

We will use this property to replace the other correctness properties,
step by step, in later commits.

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE EmptyDataDeriving #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -38,6 +39,10 @@ module Cardano.Wallet.Primitive.CoinSelection
     , SelectionOutputSizeExceedsLimitError (..)
     , SelectionOutputTokenQuantityExceedsLimitError (..)
 
+    -- * Selection correctness
+    , SelectionCorrectness (..)
+    , verifySelection
+
     -- * Selection deltas
     , SelectionDelta (..)
     , selectionDelta
@@ -338,6 +343,42 @@ toBalanceResult selection = Balance.SelectionResult
     , extraCoinSink = view #extraCoinSink selection
     }
 
+--------------------------------------------------------------------------------
+-- Selection correctness
+--------------------------------------------------------------------------------
+
+-- | Indicates whether or not a selection is correct.
+--
+data SelectionCorrectness
+    = SelectionCorrect
+    | SelectionIncorrect SelectionCorrectnessError
+    deriving (Eq, Show)
+
+-- | Indicates that a selection is incorrect.
+--
+data SelectionCorrectnessError
+    deriving (Eq, Show)
+
+-- | 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.
+--
+verifySelection
+    :: SelectionConstraints
+    -> SelectionParams
+    -> Selection
+    -> SelectionCorrectness
+verifySelection cs ps selection =
+    either SelectionIncorrect (const SelectionCorrect) verifyAll
+  where
+    verifyAll :: Either SelectionCorrectnessError ()
+    verifyAll = Right ()
+
+    failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 ()
+    onError `failWith` thisError = maybe (Right ()) (Left . thisError) onError
+
 --------------------------------------------------------------------------------
 -- Selection deltas
 --------------------------------------------------------------------------------

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

@@ -17,6 +17,7 @@ import Cardano.Wallet.Primitive.CoinSelection
     , Selection
     , SelectionCollateralRequirement (..)
     , SelectionConstraints (..)
+    , SelectionCorrectness (..)
     , SelectionError (..)
     , SelectionParams (..)
     , computeMinimumCollateral
@@ -30,6 +31,7 @@ import Cardano.Wallet.Primitive.CoinSelection
     , selectionMinimumCollateral
     , selectionMinimumCost
     , toBalanceConstraintsParams
+    , verifySelection
     )
 import Cardano.Wallet.Primitive.CoinSelection.Balance
     ( SelectionLimit, SelectionLimitOf (..), SelectionSkeleton )
@@ -132,6 +134,9 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do
 
     parallel $ describe "Performing selections" $ do
 
+        it "prop_performSelection_onSuccess_isCorrect" $
+            prop_performSelection_onSuccess
+            prop_performSelection_onSuccess_isCorrect
         it "prop_performSelection_onSuccess_hasValidSurplus" $
             prop_performSelection_onSuccess
             prop_performSelection_onSuccess_hasValidSurplus
@@ -243,6 +248,11 @@ prop_performSelection_onSuccess onSuccess = property $
     prop_performSelection_with $ \constraints params ->
         either (const $ property True) (onSuccess constraints params)
 
+prop_performSelection_onSuccess_isCorrect
+    :: PerformSelectionPropertyOnSuccess
+prop_performSelection_onSuccess_isCorrect cs ps selection =
+    Pretty (verifySelection cs ps selection) === Pretty SelectionCorrect
+
 prop_performSelection_onSuccess_hasValidSurplus
     :: PerformSelectionPropertyOnSuccess
 prop_performSelection_onSuccess_hasValidSurplus cs ps selection =