From 6bca834d561258ee9fa0ae055617368c0e26838e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 02:08:25 +0000 Subject: [PATCH 1/9] Add property `prop_performSelection_onSuccess_selectionLimitRespected`. This tests that the selection limit is respected for successful selections. --- .../Wallet/Primitive/CoinSelectionSpec.hs | 21 ++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 74b91c79b6f..557d1f15358 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -32,7 +32,7 @@ import Cardano.Wallet.Primitive.CoinSelection , toBalanceConstraintsParams ) import Cardano.Wallet.Primitive.CoinSelection.Balance - ( SelectionLimit, SelectionSkeleton ) + ( SelectionLimit, SelectionLimitOf (..), SelectionSkeleton ) import Cardano.Wallet.Primitive.CoinSelection.Balance.Gen ( genSelectionSkeleton, shrinkSelectionSkeleton ) import Cardano.Wallet.Primitive.CoinSelection.BalanceSpec @@ -141,6 +141,9 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do it "prop_performSelection_onSuccess_hasSuitableCollateral" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_hasSuitableCollateral + it "prop_performSelection_onSuccess_selectionLimitRespected" $ + prop_performSelection_onSuccess + prop_performSelection_onSuccess_selectionLimitRespected parallel $ describe "Constructing balance constraints and parameters" $ do @@ -270,6 +273,22 @@ prop_performSelection_onSuccess_hasSuitableCollateral cs _ps selection = suitableForCollateral :: (TxIn, TxOut) -> Bool suitableForCollateral = isJust . view #utxoSuitableForCollateral cs +prop_performSelection_onSuccess_selectionLimitRespected + :: PerformSelectionPropertyOnSuccess +prop_performSelection_onSuccess_selectionLimitRespected cs _ps selection = + report (selection ^. #collateral) + "collateral" $ + report (selection ^. #inputs) + "inputs" $ + property $ MaximumInputLimit totalInputCount <= selectionLimit + where + totalInputCount = (+) + (F.length $ selection ^. #collateral) + (F.length $ selection ^. #inputs) + selectionLimit = + (cs ^. #computeSelectionLimit) + (selection ^. #outputs) + -------------------------------------------------------------------------------- -- Construction of balance constraints and parameters -------------------------------------------------------------------------------- From 9e755912e1e0433f72cc82ba51b458cfb583badb Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 02:31:44 +0000 Subject: [PATCH 2/9] 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. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 41 +++++++++++++++++++ .../Wallet/Primitive/CoinSelectionSpec.hs | 10 +++++ 2 files changed, 51 insertions(+) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index ed77b2e0a7b..1c4e30e53e3 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/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 -------------------------------------------------------------------------------- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 557d1f15358..2f112627ff8 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/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 = From 98d44d0af3abdd66f4b1e9ad7e59f8ed65648c1c Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 02:39:24 +0000 Subject: [PATCH 3/9] Add verification failure case `SelectionCollateralInsufficient`. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 32 +++++++++++++++++-- .../Wallet/Primitive/CoinSelectionSpec.hs | 17 ---------- 2 files changed, 30 insertions(+), 19 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index 1c4e30e53e3..7ff4a89e14d 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE EmptyDataDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE NamedFieldPuns #-} @@ -357,6 +356,8 @@ data SelectionCorrectness -- | Indicates that a selection is incorrect. -- data SelectionCorrectnessError + = SelectionCollateralInsufficient + SelectionCollateralInsufficientError deriving (Eq, Show) -- | Verifies a selection for correctness. @@ -374,11 +375,38 @@ verifySelection cs ps selection = either SelectionIncorrect (const SelectionCorrect) verifyAll where verifyAll :: Either SelectionCorrectnessError () - verifyAll = Right () + verifyAll = do + verifySelectionCollateralSufficiency cs ps selection + `failWith` SelectionCollateralInsufficient failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 () onError `failWith` thisError = maybe (Right ()) (Left . thisError) onError +-------------------------------------------------------------------------------- +-- Selection correctness: collateral sufficiency +-------------------------------------------------------------------------------- + +data SelectionCollateralInsufficientError = SelectionCollateralInsufficientError + { collateralSelected :: Coin + , collateralRequired :: Coin + } + deriving (Eq, Show) + +verifySelectionCollateralSufficiency + :: SelectionConstraints + -> SelectionParams + -> Selection + -> Maybe SelectionCollateralInsufficientError +verifySelectionCollateralSufficiency cs ps selection + | collateralSelected >= collateralRequired = + Nothing + | otherwise = + Just SelectionCollateralInsufficientError + {collateralSelected, collateralRequired} + where + collateralSelected = selectionCollateral selection + collateralRequired = selectionMinimumCollateral cs ps selection + -------------------------------------------------------------------------------- -- Selection deltas -------------------------------------------------------------------------------- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 2f112627ff8..213473abdfb 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -23,12 +23,9 @@ import Cardano.Wallet.Primitive.CoinSelection , computeMinimumCollateral , performSelection , prepareOutputsWith - , selectionCollateral , selectionCollateralRequired , selectionDeltaAllAssets - , selectionHasSufficientCollateral , selectionHasValidSurplus - , selectionMinimumCollateral , selectionMinimumCost , toBalanceConstraintsParams , verifySelection @@ -140,9 +137,6 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do it "prop_performSelection_onSuccess_hasValidSurplus" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_hasValidSurplus - it "prop_performSelection_onSuccess_hasSufficientCollateral" $ - prop_performSelection_onSuccess - prop_performSelection_onSuccess_hasSufficientCollateral it "prop_performSelection_onSuccess_hasSuitableCollateral" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_hasSuitableCollateral @@ -262,17 +256,6 @@ prop_performSelection_onSuccess_hasValidSurplus cs ps selection = "selectionMinimumCost" $ selectionHasValidSurplus cs ps selection -prop_performSelection_onSuccess_hasSufficientCollateral - :: PerformSelectionPropertyOnSuccess -prop_performSelection_onSuccess_hasSufficientCollateral cs ps selection = - report (selectionCollateral selection) - "selection collateral" $ - report (selectionMinimumCollateral cs ps selection) - "selection collateral minimum" $ - report (selectionCollateralRequired ps) - "selection collateral required" $ - selectionHasSufficientCollateral cs ps selection - prop_performSelection_onSuccess_hasSuitableCollateral :: PerformSelectionPropertyOnSuccess prop_performSelection_onSuccess_hasSuitableCollateral cs _ps selection = From ffdd565e879e544d3ff3c2d4e5724ba2d686cb07 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 02:49:59 +0000 Subject: [PATCH 4/9] Add verification failure case `SelectionCollateralUnsuitable`. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 40 ++++++++++++++++++- .../Wallet/Primitive/CoinSelectionSpec.hs | 15 ------- 2 files changed, 39 insertions(+), 16 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index 7ff4a89e14d..454c9a39656 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -101,11 +101,13 @@ import Control.Monad.Trans.Except import Data.Function ( (&) ) import Data.Generics.Internal.VL.Lens - ( over, set, view ) + ( over, set, view, (^.) ) import Data.Generics.Labels () import Data.List.NonEmpty ( NonEmpty (..) ) +import Data.Maybe + ( isNothing ) import Data.Ratio ( (%) ) import Data.Semigroup @@ -358,6 +360,8 @@ data SelectionCorrectness data SelectionCorrectnessError = SelectionCollateralInsufficient SelectionCollateralInsufficientError + | SelectionCollateralUnsuitable + SelectionCollateralUnsuitableError deriving (Eq, Show) -- | Verifies a selection for correctness. @@ -378,6 +382,8 @@ verifySelection cs ps selection = verifyAll = do verifySelectionCollateralSufficiency cs ps selection `failWith` SelectionCollateralInsufficient + verifySelectionCollateralSuitability cs ps selection + `failWith` SelectionCollateralUnsuitable failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 () onError `failWith` thisError = maybe (Right ()) (Left . thisError) onError @@ -407,6 +413,38 @@ verifySelectionCollateralSufficiency cs ps selection collateralSelected = selectionCollateral selection collateralRequired = selectionMinimumCollateral cs ps selection +-------------------------------------------------------------------------------- +-- Selection correctness: collateral suitability +-------------------------------------------------------------------------------- + +data SelectionCollateralUnsuitableError = SelectionCollateralUnsuitableError + { collateralSelected + :: [(TxIn, TxOut)] + , collateralSelectedButUnsuitable + :: [(TxIn, TxOut)] + } + deriving (Eq, Show) + +verifySelectionCollateralSuitability + :: SelectionConstraints + -> SelectionParams + -> Selection + -> Maybe SelectionCollateralUnsuitableError +verifySelectionCollateralSuitability cs _ps selection + | null collateralSelectedButUnsuitable = + Nothing + | otherwise = + Just SelectionCollateralUnsuitableError + {collateralSelected, collateralSelectedButUnsuitable} + where + collateralSelected = + selection ^. #collateral + collateralSelectedButUnsuitable = + filter utxoUnsuitableForCollateral collateralSelected + + utxoUnsuitableForCollateral :: (TxIn, TxOut) -> Bool + utxoUnsuitableForCollateral = isNothing . (cs ^. #utxoSuitableForCollateral) + -------------------------------------------------------------------------------- -- Selection deltas -------------------------------------------------------------------------------- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 213473abdfb..3812a661ef3 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -84,8 +84,6 @@ import Data.Functor ( (<&>) ) import Data.Generics.Internal.VL.Lens ( over, view, (^.) ) -import Data.Maybe - ( isJust ) import GHC.Generics ( Generic ) import Numeric.Natural @@ -137,9 +135,6 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do it "prop_performSelection_onSuccess_hasValidSurplus" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_hasValidSurplus - it "prop_performSelection_onSuccess_hasSuitableCollateral" $ - prop_performSelection_onSuccess - prop_performSelection_onSuccess_hasSuitableCollateral it "prop_performSelection_onSuccess_selectionLimitRespected" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_selectionLimitRespected @@ -256,16 +251,6 @@ prop_performSelection_onSuccess_hasValidSurplus cs ps selection = "selectionMinimumCost" $ selectionHasValidSurplus cs ps selection -prop_performSelection_onSuccess_hasSuitableCollateral - :: PerformSelectionPropertyOnSuccess -prop_performSelection_onSuccess_hasSuitableCollateral cs _ps selection = - report (view #collateral selection) - "selection collateral" $ - property $ all suitableForCollateral (view #collateral selection) - where - suitableForCollateral :: (TxIn, TxOut) -> Bool - suitableForCollateral = isJust . view #utxoSuitableForCollateral cs - prop_performSelection_onSuccess_selectionLimitRespected :: PerformSelectionPropertyOnSuccess prop_performSelection_onSuccess_selectionLimitRespected cs _ps selection = From 4f91ebd7a09392dda07be9124b5dd4d2a2e3295e Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 03:03:33 +0000 Subject: [PATCH 5/9] Add verification failure case `SelectionLimitExceeded`. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 36 +++++++++++++++++++ .../Wallet/Primitive/CoinSelectionSpec.hs | 21 +---------- 2 files changed, 37 insertions(+), 20 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index 454c9a39656..382a7b7dba3 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -362,6 +362,8 @@ data SelectionCorrectnessError SelectionCollateralInsufficientError | SelectionCollateralUnsuitable SelectionCollateralUnsuitableError + | SelectionLimitExceeded + SelectionLimitExceededError deriving (Eq, Show) -- | Verifies a selection for correctness. @@ -384,6 +386,8 @@ verifySelection cs ps selection = `failWith` SelectionCollateralInsufficient verifySelectionCollateralSuitability cs ps selection `failWith` SelectionCollateralUnsuitable + verifySelectionLimit cs ps selection + `failWith` SelectionLimitExceeded failWith :: Maybe e1 -> (e1 -> e2) -> Either e2 () onError `failWith` thisError = maybe (Right ()) (Left . thisError) onError @@ -445,6 +449,38 @@ verifySelectionCollateralSuitability cs _ps selection utxoUnsuitableForCollateral :: (TxIn, TxOut) -> Bool utxoUnsuitableForCollateral = isNothing . (cs ^. #utxoSuitableForCollateral) +-------------------------------------------------------------------------------- +-- Selection correctness: selection limit +-------------------------------------------------------------------------------- + +data SelectionLimitExceededError = SelectionLimitExceededError + { collateralInputCount + :: Int + , ordinaryInputCount + :: Int + , totalInputCount + :: Int + , selectionLimit + :: SelectionLimit + } + deriving (Eq, Show) + +verifySelectionLimit + :: SelectionConstraints + -> SelectionParams + -> Selection + -> Maybe SelectionLimitExceededError +verifySelectionLimit cs _ps selection + | Balance.MaximumInputLimit totalInputCount <= selectionLimit = + Nothing + | otherwise = + Just SelectionLimitExceededError {..} + where + collateralInputCount = length (selection ^. #collateral) + ordinaryInputCount = length (selection ^. #inputs) + totalInputCount = collateralInputCount + ordinaryInputCount + selectionLimit = (cs ^. #computeSelectionLimit) (selection ^. #outputs) + -------------------------------------------------------------------------------- -- Selection deltas -------------------------------------------------------------------------------- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 3812a661ef3..9a00f08e5e4 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -31,7 +31,7 @@ import Cardano.Wallet.Primitive.CoinSelection , verifySelection ) import Cardano.Wallet.Primitive.CoinSelection.Balance - ( SelectionLimit, SelectionLimitOf (..), SelectionSkeleton ) + ( SelectionLimit, SelectionSkeleton ) import Cardano.Wallet.Primitive.CoinSelection.Balance.Gen ( genSelectionSkeleton, shrinkSelectionSkeleton ) import Cardano.Wallet.Primitive.CoinSelection.BalanceSpec @@ -135,9 +135,6 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do it "prop_performSelection_onSuccess_hasValidSurplus" $ prop_performSelection_onSuccess prop_performSelection_onSuccess_hasValidSurplus - it "prop_performSelection_onSuccess_selectionLimitRespected" $ - prop_performSelection_onSuccess - prop_performSelection_onSuccess_selectionLimitRespected parallel $ describe "Constructing balance constraints and parameters" $ do @@ -251,22 +248,6 @@ prop_performSelection_onSuccess_hasValidSurplus cs ps selection = "selectionMinimumCost" $ selectionHasValidSurplus cs ps selection -prop_performSelection_onSuccess_selectionLimitRespected - :: PerformSelectionPropertyOnSuccess -prop_performSelection_onSuccess_selectionLimitRespected cs _ps selection = - report (selection ^. #collateral) - "collateral" $ - report (selection ^. #inputs) - "inputs" $ - property $ MaximumInputLimit totalInputCount <= selectionLimit - where - totalInputCount = (+) - (F.length $ selection ^. #collateral) - (F.length $ selection ^. #inputs) - selectionLimit = - (cs ^. #computeSelectionLimit) - (selection ^. #outputs) - -------------------------------------------------------------------------------- -- Construction of balance constraints and parameters -------------------------------------------------------------------------------- From e353d573577ad121f410c5b97fc7529c3befe6b9 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 03:20:24 +0000 Subject: [PATCH 6/9] Add verification failure case `SelectionDeltaInvalid`. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 30 +++++++++++++++++++ .../Wallet/Primitive/CoinSelectionSpec.hs | 15 ---------- 2 files changed, 30 insertions(+), 15 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index 382a7b7dba3..cfe3eb79209 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -362,6 +362,8 @@ data SelectionCorrectnessError SelectionCollateralInsufficientError | SelectionCollateralUnsuitable SelectionCollateralUnsuitableError + | SelectionDeltaInvalid + SelectionDeltaInvalidError | SelectionLimitExceeded SelectionLimitExceededError deriving (Eq, Show) @@ -386,6 +388,8 @@ verifySelection cs ps selection = `failWith` SelectionCollateralInsufficient verifySelectionCollateralSuitability cs ps selection `failWith` SelectionCollateralUnsuitable + verifySelectionDelta cs ps selection + `failWith` SelectionDeltaInvalid verifySelectionLimit cs ps selection `failWith` SelectionLimitExceeded @@ -449,6 +453,32 @@ verifySelectionCollateralSuitability cs _ps selection utxoUnsuitableForCollateral :: (TxIn, TxOut) -> Bool utxoUnsuitableForCollateral = isNothing . (cs ^. #utxoSuitableForCollateral) +-------------------------------------------------------------------------------- +-- Selection correctness: delta validity +-------------------------------------------------------------------------------- + +data SelectionDeltaInvalidError = SelectionDeltaInvalidError + { delta + :: SelectionDelta TokenBundle + , minimumCost + :: Coin + } + deriving (Eq, Show) + +verifySelectionDelta + :: SelectionConstraints + -> SelectionParams + -> Selection + -> Maybe SelectionDeltaInvalidError +verifySelectionDelta cs ps selection + | selectionHasValidSurplus cs ps selection = + Nothing + | otherwise = + Just SelectionDeltaInvalidError {..} + where + delta = selectionDeltaAllAssets selection + minimumCost = selectionMinimumCost cs ps selection + -------------------------------------------------------------------------------- -- Selection correctness: selection limit -------------------------------------------------------------------------------- diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 9a00f08e5e4..073943ebfe1 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -24,9 +24,6 @@ import Cardano.Wallet.Primitive.CoinSelection , performSelection , prepareOutputsWith , selectionCollateralRequired - , selectionDeltaAllAssets - , selectionHasValidSurplus - , selectionMinimumCost , toBalanceConstraintsParams , verifySelection ) @@ -132,9 +129,6 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ 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 parallel $ describe "Constructing balance constraints and parameters" $ do @@ -239,15 +233,6 @@ prop_performSelection_onSuccess_isCorrect 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 = - report (selectionDeltaAllAssets selection) - "selectionDelta" $ - report (selectionMinimumCost cs ps selection) - "selectionMinimumCost" $ - selectionHasValidSurplus cs ps selection - -------------------------------------------------------------------------------- -- Construction of balance constraints and parameters -------------------------------------------------------------------------------- From 090589044692f4f37ed6144e404424878b557138 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 03:26:13 +0000 Subject: [PATCH 7/9] Add type `VerifySelectionProperty`. --- .../Cardano/Wallet/Primitive/CoinSelection.hs | 28 ++++++++----------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index cfe3eb79209..567da7eda40 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -368,6 +368,14 @@ data SelectionCorrectnessError SelectionLimitExceededError deriving (Eq, Show) +-- | The type of all selection property verification functions. +-- +type VerifySelectionProperty error = + SelectionConstraints -> + SelectionParams -> + Selection -> + Maybe error + -- | Verifies a selection for correctness. -- -- This function is provided primarily as a convenience for testing. As such, @@ -407,10 +415,7 @@ data SelectionCollateralInsufficientError = SelectionCollateralInsufficientError deriving (Eq, Show) verifySelectionCollateralSufficiency - :: SelectionConstraints - -> SelectionParams - -> Selection - -> Maybe SelectionCollateralInsufficientError + :: VerifySelectionProperty SelectionCollateralInsufficientError verifySelectionCollateralSufficiency cs ps selection | collateralSelected >= collateralRequired = Nothing @@ -434,10 +439,7 @@ data SelectionCollateralUnsuitableError = SelectionCollateralUnsuitableError deriving (Eq, Show) verifySelectionCollateralSuitability - :: SelectionConstraints - -> SelectionParams - -> Selection - -> Maybe SelectionCollateralUnsuitableError + :: VerifySelectionProperty SelectionCollateralUnsuitableError verifySelectionCollateralSuitability cs _ps selection | null collateralSelectedButUnsuitable = Nothing @@ -466,10 +468,7 @@ data SelectionDeltaInvalidError = SelectionDeltaInvalidError deriving (Eq, Show) verifySelectionDelta - :: SelectionConstraints - -> SelectionParams - -> Selection - -> Maybe SelectionDeltaInvalidError + :: VerifySelectionProperty SelectionDeltaInvalidError verifySelectionDelta cs ps selection | selectionHasValidSurplus cs ps selection = Nothing @@ -496,10 +495,7 @@ data SelectionLimitExceededError = SelectionLimitExceededError deriving (Eq, Show) verifySelectionLimit - :: SelectionConstraints - -> SelectionParams - -> Selection - -> Maybe SelectionLimitExceededError + :: VerifySelectionProperty SelectionLimitExceededError verifySelectionLimit cs _ps selection | Balance.MaximumInputLimit totalInputCount <= selectionLimit = Nothing From 0353a0b596c0b7ac6e809cdaf2604f232dec2bd8 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 03:27:20 +0000 Subject: [PATCH 8/9] Simplify description of post-condition for `performSelection` --- lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index 567da7eda40..9d697bf0217 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -148,10 +148,9 @@ type PerformSelection m a = -- -- This function guarantees that if it successfully creates a 'Selection' @s@, -- given a set of 'SelectionConstraints' @cs@ and 'SelectionParameters' @ps@, --- then the following properties will hold: +-- then the following property will hold: -- --- >>> selectionHasValidSurplus cs ps s --- >>> selectionHasSufficientCollateral cs ps s +-- >>> verifySelection cs ps s == SelectionCorrect -- performSelection :: (HasCallStack, MonadRandom m) => PerformSelection m Selection From fdf820932384aa9e2c7db633272d2bfb86893425 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Tue, 12 Oct 2021 03:36:51 +0000 Subject: [PATCH 9/9] Simplify `prop_performSelection_onSuccess`. Since there is now only one property to check on success, we can simplify the infrastructure around testing successful selections. --- .../Wallet/Primitive/CoinSelectionSpec.hs | 25 ++++++------------- 1 file changed, 8 insertions(+), 17 deletions(-) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 073943ebfe1..5aa1e566ba8 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -126,9 +126,8 @@ 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" $ + property prop_performSelection_onSuccess parallel $ describe "Constructing balance constraints and parameters" $ do @@ -167,12 +166,6 @@ type PerformSelectionPropertyInner = Either SelectionError Selection -> Property -type PerformSelectionPropertyOnSuccess = - SelectionConstraints -> - SelectionParams -> - Selection -> - Property - prop_performSelection_with :: PerformSelectionPropertyInner -> PerformSelectionProperty @@ -222,16 +215,14 @@ prop_performSelection_coverage _constraints params result = SelectionOutputError _ -> True _ -> False -prop_performSelection_onSuccess - :: PerformSelectionPropertyOnSuccess -> Property -prop_performSelection_onSuccess onSuccess = property $ +prop_performSelection_onSuccess :: PerformSelectionProperty +prop_performSelection_onSuccess = 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 + where + onSuccess constraints params selection = + Pretty (verifySelection constraints params selection) === + Pretty SelectionCorrect -------------------------------------------------------------------------------- -- Construction of balance constraints and parameters