WIP

cardano-foundation · Jul 29, 2021 · 6eaf2b6 · 6eaf2b6
1 parent cf16185
commit 6eaf2b6
Show file tree

Hide file tree

Showing 2 changed files with 67 additions and 72 deletions.
diff --git a/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Collateral.hs b/lib/core/src/Cardano/Wallet/Primitive/CoinSelection/Collateral.hs
@@ -1,10 +1,30 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Cardano.Wallet.Primitive.CoinSelection.Collateral where
+module Cardano.Wallet.Primitive.CoinSelection.Collateral
+    (
+    -- * Public API
+
+      selectCollateral
+    , SelectCollateralParams (..)
+    , SelectCollateralResult (..)
+    , SelectCollateralError (..)
+
+    -- * Internal API
+
+    -- ** Selecting collateral by giving priority to smallest values first
+    , selectCollateralSmallest
+
+    -- ** Selecting collateral by giving priority to largest values first
+    , selectCollateralLargest
+
+    -- ** Submaps and subsequences
+    , submaps
+    , subsequencesOfSize
+    , numberOfSubsequencesOfSize
+    )
+    where
 
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin )
@@ -29,7 +49,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 
 --------------------------------------------------------------------------------
--- Types
+-- Public API
 --------------------------------------------------------------------------------
 
 data SelectCollateralParams inputId = SelectCollateralParams
@@ -44,42 +64,42 @@ data SelectCollateralParams inputId = SelectCollateralParams
     }
     deriving (Eq, Generic, Show)
 
-data SelectCollateralResult inputId = SelectCollateralResult
+newtype SelectCollateralResult inputId = SelectCollateralResult
     { coinsSelected :: Map inputId Coin
-    , coinsLeftover :: Map inputId Coin
     }
     deriving (Eq, Generic, Show)
 
-data SelectCollateralError inputId = SelectCollateralError
-    { minimumCollateralAmount
-        :: Coin
-    , largestCombinationAvailable
-        :: Map inputId Coin
+newtype SelectCollateralError inputId = SelectCollateralError
+    { largestCombinationAvailable :: Map inputId Coin
     }
     deriving (Eq, Generic, Show)
 
---------------------------------------------------------------------------------
--- Selecting collateral
---------------------------------------------------------------------------------
-
 selectCollateral
     :: forall inputId. Ord inputId
     => SelectCollateralParams inputId
-    -> Either
-        (SelectCollateralError inputId)
-        (SelectCollateralResult inputId)
-selectCollateral params
-    | Just result <- selectCollateralSmallest params =
-        Right result
-    | otherwise =
-        selectCollateralLargest params
+    -> Either (SelectCollateralError inputId) (SelectCollateralResult inputId)
+selectCollateral params =
+    -- Give priority to the strategy of selecting the smallest values possible,
+    -- but fall back to the strategy of selecting larger values if necessary:
+    case (selectCollateralSmallest params, selectCollateralLargest params) of
+        (Just r, _      ) -> Right r
+        (_     , Right r) -> Right r
+        (_     , Left  e) -> Left  e
+
+--------------------------------------------------------------------------------
+-- Internal API
+--------------------------------------------------------------------------------
+
+--------------------------------------------------------------------------------
+-- Selecting collateral by giving priority to smallest values first
+--------------------------------------------------------------------------------
 
 selectCollateralSmallest
     :: forall inputId. Ord inputId
     => SelectCollateralParams inputId
     -> Maybe (SelectCollateralResult inputId)
 selectCollateralSmallest params =
-    makeResult coinsAvailable <$> smallestValidCombination
+    SelectCollateralResult <$> smallestValidCombination
   where
     smallestValidCombination :: Maybe (Map inputId Coin)
     smallestValidCombination
@@ -121,23 +141,24 @@ selectCollateralSmallest params =
         , maximumSearchSpaceSize
         } = params
 
+--------------------------------------------------------------------------------
+-- Selecting collateral by giving priority to largest values first
+--------------------------------------------------------------------------------
+
 selectCollateralLargest
     :: forall inputId. Ord inputId
     => SelectCollateralParams inputId
-    -> Either
-        (SelectCollateralError inputId)
-        (SelectCollateralResult inputId)
-selectCollateralLargest params
-    | Just coinsSelected <- smallestValidSubmapOfLargestCombinationAvailable =
-        Right (makeResult coinsAvailable coinsSelected)
-    | otherwise =
-        Left SelectCollateralError
-            { minimumCollateralAmount
-            , largestCombinationAvailable
-            }
+    -> Either (SelectCollateralError inputId) (SelectCollateralResult inputId)
+selectCollateralLargest params =
+    case smallestValidSubmapOfLargestCombinationAvailable of
+        Just coinsSelected ->
+            Right SelectCollateralResult {coinsSelected}
+        Nothing ->
+            Left SelectCollateralError {largestCombinationAvailable}
   where
     largestCombinationAvailable :: Map inputId Coin
-    largestCombinationAvailable = coinsAvailable
+    largestCombinationAvailable =
+        coinsAvailable
         & Map.toList
         & L.sortOn (Down . snd)
         & L.take maximumCollateralEntryCount
@@ -146,41 +167,27 @@ selectCollateralLargest params
     smallestValidSubmapOfLargestCombinationAvailable :: Maybe (Map inputId Coin)
     smallestValidSubmapOfLargestCombinationAvailable =
         largestCombinationAvailable
-            & submaps
-            & Set.toList
-            & fmap (\ics -> (ics, F.fold ics))
-            & L.sortOn snd
-            & L.dropWhile ((< minimumCollateralAmount) . snd)
-            & fmap fst
-            & listToMaybe
+        & submaps
+        & Set.toList
+        & fmap (\ics -> (ics, F.fold ics))
+        & L.sortOn snd
+        & L.dropWhile ((< minimumCollateralAmount) . snd)
+        & fmap fst
+        & listToMaybe
 
     SelectCollateralParams
         { coinsAvailable
         , minimumCollateralAmount
         , maximumCollateralEntryCount
         } = params
 
-makeResult
-    :: Ord inputId
-    => Map inputId Coin
-    -> Map inputId Coin
-    -> SelectCollateralResult inputId
-makeResult coinsAvailable coinsSelected = SelectCollateralResult
-    { coinsSelected
-    , coinsLeftover = coinsAvailable `Map.withoutKeys` Map.keysSet coinsSelected
-    }
-
 --------------------------------------------------------------------------------
--- Submaps
+-- Submaps and subsequences
 --------------------------------------------------------------------------------
 
 submaps :: forall a b. (Ord a, Ord b) => Map a b -> Set (Map a b)
 submaps m = Set.map (Map.restrictKeys m) (Set.powerSet (Map.keysSet m))
 
---------------------------------------------------------------------------------
--- Subsequences
---------------------------------------------------------------------------------
-
 numberOfSubsequencesOfSize :: Int -> Int -> Int
 numberOfSubsequencesOfSize = choose
   where

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/CollateralSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/CollateralSpec.hs
@@ -1,12 +1,8 @@
 {-# OPTIONS -fplugin=Overloaded -fplugin-opt=Overloaded:Numerals #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -27,10 +23,6 @@ import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Data.Either
     ( isLeft, isRight )
-import Data.Generics.Internal.VL.Lens
-    ( view )
-import Data.Generics.Labels
-    ()
 import Data.Map.Strict
     ( Map )
 import Data.Set
@@ -94,9 +86,7 @@ prop_selectCollateral_singleBitCoins_optimal
 
     case result of
         Left e -> conjoin
-            [ view #minimumCollateralAmount e
-                == minimumCollateralAmount
-            , F.fold (largestCombinationAvailable e)
+            [ F.fold (largestCombinationAvailable e)
                 < minimumCollateralAmount
             , F.length (largestCombinationAvailable e)
                 <= maximumCollateralEntryCount
@@ -151,9 +141,7 @@ prop_selectCollateral_singleBitCoins_constrained
 
     case result of
         Left e -> conjoin
-            [ view #minimumCollateralAmount e
-                == minimumCollateralAmount
-            , F.fold (largestCombinationAvailable e)
+            [ F.fold (largestCombinationAvailable e)
                 < minimumCollateralAmount
             , F.length (largestCombinationAvailable e)
                 <= maximumCollateralEntryCount