Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Generalize UTxO identifier type within UTxOSelection. #3155

Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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