diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs index ff5e2dafa95..ed77b2e0a7b 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection.hs @@ -64,6 +64,7 @@ module Cardano.Wallet.Primitive.CoinSelection -- * Internal types and functions , ComputeMinimumCollateralParams (..) , computeMinimumCollateral + , toBalanceConstraintsParams ) where diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs index 2011e345417..d6b302e438f 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelectionSpec.hs @@ -29,7 +29,10 @@ import Cardano.Wallet.Primitive.CoinSelection , selectionHasValidSurplus , selectionMinimumCollateral , selectionMinimumCost + , toBalanceConstraintsParams ) +import Cardano.Wallet.Primitive.CoinSelection.Balance + ( SelectionLimit ) import Cardano.Wallet.Primitive.CoinSelection.BalanceSpec ( MockAssessTokenBundleSize , MockComputeMinimumAdaQuantity @@ -74,8 +77,12 @@ import Control.Monad.Trans.Except ( runExceptT ) import Data.Either ( isLeft, isRight ) +import Data.Function + ( (&) ) +import Data.Functor + ( (<&>) ) import Data.Generics.Internal.VL.Lens - ( view ) + ( view, (^.) ) import Data.Maybe ( isJust ) import GHC.Generics @@ -133,6 +140,11 @@ spec = describe "Cardano.Wallet.Primitive.CoinSelectionSpec" $ do prop_performSelection_onSuccess prop_performSelection_onSuccess_hasSuitableCollateral + parallel $ describe "Constructing balance constraints and parameters" $ do + + it "prop_toBalanceConstraintsParams_computeSelectionLimit" $ + property prop_toBalanceConstraintsParams_computeSelectionLimit + parallel $ describe "Preparing outputs" $ do it "prop_prepareOutputsWith_twice" $ @@ -254,6 +266,63 @@ prop_performSelection_onSuccess_hasSuitableCollateral cs _ps selection = suitableForCollateral :: (TxIn, TxOut) -> Bool suitableForCollateral = isJust . view #utxoSuitableForCollateral cs +-------------------------------------------------------------------------------- +-- Construction of balance constraints and parameters +-------------------------------------------------------------------------------- + +-- Tests that function 'toBalanceConstraintsParams' applies the correct +-- transformation to the 'computeSelectionLimit' function. +-- +prop_toBalanceConstraintsParams_computeSelectionLimit + :: MockSelectionConstraints + -> SelectionParams + -> Property +prop_toBalanceConstraintsParams_computeSelectionLimit mockConstraints params = + checkCoverage $ + cover 10 (selectionCollateralRequired params) + "collateral required: yes" $ + cover 10 (not (selectionCollateralRequired params)) + "collateral required: no" $ + cover 10 (selectionLimitOriginal > selectionLimitAdjusted) + "selection limit (original) > selection limit (adjusted)" $ + report selectionLimitOriginal + "selection limit (original)" $ + report selectionLimitAdjusted + "selection limit (adjusted)" $ + if selectionCollateralRequired params + then + conjoin + [ selectionLimitOriginal >= selectionLimitAdjusted + -- Here we apply a transformation that is the *inverse* of + -- the transformation within 'toBalanceConstraintsParams': + , selectionLimitOriginal == + (selectionLimitAdjusted <&> (+ maximumCollateralInputCount)) + ] + else + selectionLimitOriginal === selectionLimitAdjusted + where + constraints :: SelectionConstraints + constraints = unMockSelectionConstraints mockConstraints + + maximumCollateralInputCount :: Int + maximumCollateralInputCount = constraints ^. #maximumCollateralInputCount + + computeSelectionLimitOriginal :: [TxOut] -> SelectionLimit + computeSelectionLimitOriginal = constraints ^. #computeSelectionLimit + + computeSelectionLimitAdjusted :: [TxOut] -> SelectionLimit + computeSelectionLimitAdjusted = + toBalanceConstraintsParams (constraints, params) + & fst & view #computeSelectionLimit + + selectionLimitOriginal :: SelectionLimit + selectionLimitOriginal = computeSelectionLimitOriginal + (params ^. #outputsToCover) + + selectionLimitAdjusted :: SelectionLimit + selectionLimitAdjusted = computeSelectionLimitAdjusted + (params ^. #outputsToCover) + -------------------------------------------------------------------------------- -- Preparing outputs --------------------------------------------------------------------------------