Skip to content

Commit

Permalink
Merge #3155
Browse files Browse the repository at this point in the history
3155: Generalize UTxO identifier type within `UTxOSelection`. r=Anviking a=jonathanknowles

## Issue Number

ADP-1450

## Background

Within coin selection modules, we are steadily replacing all uses of `TxIn`, `Address`, `TxOut` with type parameters, so that the coin selection library does not depend on these concrete wallet types.

## Summary

This PR replaces all uses of `InputId` (a temporary type synonym introduced in #3149) with a type parameter within module `UTxOSelection`.

We use the following convention for type parameters and identifier names:
- `u` represents a unique identifier for an individual UTxO (unspent transaction output).
- `s` represents a selection of type `UTxOSelection`.
- `b` represents a `TokenBundle` value.
- `i` represents an index of type `UTxOIndex`.


Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>
  • Loading branch information
iohk-bors[bot] and jonathanknowles authored Feb 24, 2022
2 parents 9bd6cfe + d75a860 commit 6391cfd
Show file tree
Hide file tree
Showing 9 changed files with 185 additions and 150 deletions.
2 changes: 1 addition & 1 deletion lib/core/src/Cardano/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1913,7 +1913,7 @@ data SelectAssetsParams s result = SelectAssetsParams
, randomSeed :: Maybe StdGenSeed
, txContext :: TransactionCtx
, utxoAvailableForCollateral :: Map InputId TokenBundle
, utxoAvailableForInputs :: UTxOSelection
, utxoAvailableForInputs :: UTxOSelection InputId
, wallet :: Wallet s
}
deriving Generic
Expand Down
2 changes: 1 addition & 1 deletion lib/core/src/Cardano/Wallet/CoinSelection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -225,7 +225,7 @@ data SelectionParams = SelectionParams
-- This set is allowed to intersect with 'utxoAvailableForInputs',
-- since the ledger does not require that these sets are disjoint.
, utxoAvailableForInputs
:: !UTxOSelection
:: !(UTxOSelection InputId)
-- ^ Specifies a set of UTxOs that are available for selection as
-- ordinary inputs and optionally, a subset that has already been
-- selected.
Expand Down
4 changes: 2 additions & 2 deletions lib/core/src/Cardano/Wallet/CoinSelection/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -215,7 +215,7 @@ data SelectionParams = SelectionParams
-- This set is allowed to intersect with 'utxoAvailableForInputs',
-- since the ledger does not require that these sets are disjoint.
, utxoAvailableForInputs
:: !UTxOSelection
:: !(UTxOSelection InputId)
-- ^ Specifies a set of UTxOs that are available for selection as
-- ordinary inputs and optionally, a subset that has already been
-- selected.
Expand Down Expand Up @@ -879,7 +879,7 @@ verifyBalanceInsufficientError cs ps e =
--------------------------------------------------------------------------------

newtype FailureToVerifyEmptyUTxOError = FailureToVerifyEmptyUTxOError
{ utxoAvailableForInputs :: UTxOSelection }
{ utxoAvailableForInputs :: UTxOSelection InputId }
deriving (Eq, Show)

verifyEmptyUTxOError :: VerifySelectionError ()
Expand Down
61 changes: 36 additions & 25 deletions lib/core/src/Cardano/Wallet/CoinSelection/Internal/Balance.hs
Original file line number Diff line number Diff line change
Expand Up @@ -247,7 +247,7 @@ data SelectionParamsOf outputs = SelectionParams
:: !outputs
-- ^ The complete set of outputs to be covered.
, utxoAvailable
:: !UTxOSelection
:: !(UTxOSelection InputId)
-- ^ Specifies a set of UTxOs that are available for selection as
-- inputs and optionally, a subset that has already been selected.
--
Expand Down Expand Up @@ -436,7 +436,11 @@ instance Ord a => Ord (SelectionLimitOf a) where

-- | Indicates whether or not the given selection limit has been exceeded.
--
selectionLimitExceeded :: IsUTxOSelection s => s -> SelectionLimit -> Bool
selectionLimitExceeded
:: IsUTxOSelection s InputId
=> s InputId
-> SelectionLimit
-> Bool
selectionLimitExceeded s = \case
NoLimit -> False
MaximumInputLimit n -> UTxOSelection.selectedSize s > n
Expand Down Expand Up @@ -946,7 +950,7 @@ performSelectionNonEmpty constraints params
-- assets of the final resulting selection).
--
predictChange
:: UTxOSelectionNonEmpty
:: UTxOSelectionNonEmpty InputId
-> [Set AssetId]
predictChange s = either
(const $ invariantResultWithNoCost $ UTxOSelection.selectedIndex s)
Expand Down Expand Up @@ -988,7 +992,7 @@ performSelectionNonEmpty constraints params
-- function won't make associated outputs for them.
--
makeChangeRepeatedly
:: UTxOSelectionNonEmpty
:: UTxOSelectionNonEmpty InputId
-> m
( Either
SelectionBalanceError
Expand Down Expand Up @@ -1092,31 +1096,35 @@ performSelectionNonEmpty constraints params
data RunSelectionParams = RunSelectionParams
{ selectionLimit :: SelectionLimit
-- ^ A limit to adhere to when performing a selection.
, utxoAvailable :: UTxOSelection
, utxoAvailable :: (UTxOSelection InputId)
-- ^ UTxO entries available for selection.
, minimumBalance :: TokenBundle
-- ^ Minimum balance to cover.
}
deriving (Eq, Generic, Show)

runSelectionNonEmpty
:: MonadRandom m => RunSelectionParams -> m (Maybe UTxOSelectionNonEmpty)
:: MonadRandom m
=> RunSelectionParams
-> m (Maybe (UTxOSelectionNonEmpty InputId))
runSelectionNonEmpty = (=<<)
<$> runSelectionNonEmptyWith . selectCoinQuantity . view #selectionLimit
<*> runSelection

runSelectionNonEmptyWith
:: Monad m
=> (UTxOSelection -> m (Maybe UTxOSelectionNonEmpty))
-> UTxOSelection
-> m (Maybe UTxOSelectionNonEmpty)
=> (UTxOSelection InputId -> m (Maybe (UTxOSelectionNonEmpty InputId)))
-> UTxOSelection InputId
-> m (Maybe (UTxOSelectionNonEmpty InputId))
runSelectionNonEmptyWith selectSingleEntry result =
UTxOSelection.toNonEmpty result & maybe
(result & selectSingleEntry)
(pure . Just)

runSelection
:: forall m. MonadRandom m => RunSelectionParams -> m UTxOSelection
:: forall m. MonadRandom m
=> RunSelectionParams
-> m (UTxOSelection InputId)
runSelection params =
runRoundRobinM utxoAvailable UTxOSelection.fromNonEmpty selectors
where
Expand All @@ -1130,7 +1138,8 @@ runSelection params =
-- necessarily has a non-zero ada amount. By running the other selectors
-- first, we increase the probability that the coin selector will be able
-- to terminate without needing to select an additional coin.
selectors :: [UTxOSelection -> m (Maybe UTxOSelectionNonEmpty)]
selectors
:: [UTxOSelection InputId -> m (Maybe (UTxOSelectionNonEmpty InputId))]
selectors =
reverse (coinSelector : fmap assetSelector minimumAssetQuantities)
where
Expand All @@ -1146,7 +1155,7 @@ assetSelectionLens
:: MonadRandom m
=> SelectionLimit
-> (AssetId, TokenQuantity)
-> SelectionLens m UTxOSelection UTxOSelectionNonEmpty
-> SelectionLens m (UTxOSelection InputId) (UTxOSelectionNonEmpty InputId)
assetSelectionLens limit (asset, minimumAssetQuantity) = SelectionLens
{ currentQuantity = selectedAssetQuantity asset
, updatedQuantity = selectedAssetQuantity asset
Expand All @@ -1159,7 +1168,7 @@ coinSelectionLens
=> SelectionLimit
-> Coin
-- ^ Minimum coin quantity.
-> SelectionLens m UTxOSelection UTxOSelectionNonEmpty
-> SelectionLens m (UTxOSelection InputId) (UTxOSelectionNonEmpty InputId)
coinSelectionLens limit minimumCoinQuantity = SelectionLens
{ currentQuantity = selectedCoinQuantity
, updatedQuantity = selectedCoinQuantity
Expand All @@ -1171,22 +1180,22 @@ coinSelectionLens limit minimumCoinQuantity = SelectionLens
--
selectAssetQuantity
:: MonadRandom m
=> IsUTxOSelection utxoSelection
=> IsUTxOSelection utxoSelection InputId
=> AssetId
-> SelectionLimit
-> utxoSelection
-> m (Maybe UTxOSelectionNonEmpty)
-> utxoSelection InputId
-> m (Maybe (UTxOSelectionNonEmpty InputId))
selectAssetQuantity asset =
selectMatchingQuantity (WithAssetOnly asset :| [WithAsset asset])

-- | Specializes 'selectMatchingQuantity' to ada.
--
selectCoinQuantity
:: MonadRandom m
=> IsUTxOSelection utxoSelection
=> IsUTxOSelection utxoSelection InputId
=> SelectionLimit
-> utxoSelection
-> m (Maybe UTxOSelectionNonEmpty)
-> utxoSelection InputId
-> m (Maybe (UTxOSelectionNonEmpty InputId))
selectCoinQuantity =
selectMatchingQuantity (WithAdaOnly :| [Any])

Expand All @@ -1208,15 +1217,15 @@ selectCoinQuantity =
--
selectMatchingQuantity
:: MonadRandom m
=> IsUTxOSelection utxoSelection
=> IsUTxOSelection utxoSelection InputId
=> NonEmpty SelectionFilter
-- ^ A list of selection filters to be traversed from left-to-right,
-- in descending order of priority.
-> SelectionLimit
-- ^ A limit to adhere to when selecting entries.
-> utxoSelection
-> utxoSelection InputId
-- ^ The current selection state.
-> m (Maybe UTxOSelectionNonEmpty)
-> m (Maybe (UTxOSelectionNonEmpty InputId))
-- ^ An updated selection state that includes a matching UTxO entry,
-- or 'Nothing' if no such entry could be found.
selectMatchingQuantity filters limit s
Expand All @@ -1232,7 +1241,7 @@ selectMatchingQuantity filters limit s

updateState
:: ((InputId, TokenBundle), UTxOIndex InputId)
-> Maybe UTxOSelectionNonEmpty
-> Maybe (UTxOSelectionNonEmpty InputId)
updateState ((i, _b), _remaining) = UTxOSelection.select i s

--------------------------------------------------------------------------------
Expand Down Expand Up @@ -2141,13 +2150,15 @@ runRoundRobinM state demote processors = go state processors []
-- Accessor functions
--------------------------------------------------------------------------------

selectedAssetQuantity :: IsUTxOSelection s => AssetId -> s -> Natural
selectedAssetQuantity
:: IsUTxOSelection s InputId => AssetId -> s InputId -> Natural
selectedAssetQuantity asset
= unTokenQuantity
. flip TokenBundle.getQuantity asset
. UTxOSelection.selectedBalance

selectedCoinQuantity :: IsUTxOSelection s => s -> Natural
selectedCoinQuantity
:: IsUTxOSelection s InputId => s InputId -> Natural
selectedCoinQuantity
= intCast
. unCoin
Expand Down
Loading

0 comments on commit 6391cfd

Please sign in to comment.