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

Add constraints field to TransactionLayer #2620

Merged
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
6 changes: 4 additions & 2 deletions lib/core/src/Cardano/Wallet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1378,7 +1378,9 @@ calcMinimumCoinValues
-> IO (f Coin)
calcMinimumCoinValues ctx outs = do
pp <- currentProtocolParameters nl
pure $ calcMinimumCoinValue tl pp . view (#tokens . #tokens) <$> outs
pure
$ view #txOutputMinimumAdaQuantity (constraints tl pp)
. view (#tokens . #tokens) <$> outs
where
nl = ctx ^. networkLayer
tl = ctx ^. transactionLayer @k
Expand Down Expand Up @@ -1407,7 +1409,7 @@ selectAssets ctx (utxo, cp, pending) tx outs transform = do
selectionCriteria <- withExceptT ErrSelectAssetsCriteriaError $ except $
initSelectionCriteria tl pp tx utxo outs
sel <- performSelection
(calcMinimumCoinValue tl pp)
(view #txOutputMinimumAdaQuantity $ constraints tl pp)
(calcMinimumCost tl pp tx)
(tokenBundleSizeAssessor tl)
(selectionCriteria)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -185,22 +185,22 @@ data SelectionCriteria = SelectionCriteria
-- output must not change the estimated cost of a selection.
--
data SelectionSkeleton = SelectionSkeleton
{ inputsSkeleton
:: !UTxOIndex
, outputsSkeleton
{ skeletonInputCount
:: !Int
, skeletonOutputs
:: ![TxOut]
, changeSkeleton
, skeletonChange
:: ![Set AssetId]
}
deriving (Eq, Show)
deriving (Eq, Generic, Show)

-- | Creates an empty 'SelectionSkeleton' with no inputs, no outputs and no
-- change.
emptySkeleton :: SelectionSkeleton
emptySkeleton = SelectionSkeleton
{ inputsSkeleton = UTxOIndex.empty
, outputsSkeleton = mempty
, changeSkeleton = mempty
{ skeletonInputCount = 0
, skeletonOutputs = mempty
, skeletonChange = mempty
}

-- | Specifies a limit to adhere to when performing a selection.
Expand Down Expand Up @@ -594,12 +594,12 @@ performSelection minCoinFor costFor bundleSizeAssessor criteria
SelectionState {selected, leftover} = s

requiredCost = costFor SelectionSkeleton
{ inputsSkeleton = selected
, outputsSkeleton = NE.toList outputsToCover
, changeSkeleton
{ skeletonInputCount = UTxOIndex.size selected
, skeletonOutputs = NE.toList outputsToCover
, skeletonChange
}

changeSkeleton = predictChange selected
skeletonChange = predictChange selected
inputsSelected = mkInputsSelected selected

invariantSelectAnyInputs =
Expand Down
12 changes: 5 additions & 7 deletions lib/core/src/Cardano/Wallet/Primitive/Migration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,14 +17,13 @@ module Cardano.Wallet.Primitive.Migration
, MigrationPlan (..)
, RewardWithdrawal (..)
, Selection (..)
, TxSize (..)

) where

import Prelude

import Cardano.Wallet.Primitive.Migration.Selection
( RewardWithdrawal (..), Selection (..), TxSize (..) )
( RewardWithdrawal (..), Selection (..) )
import Cardano.Wallet.Primitive.Types.Coin
( Coin )
import Cardano.Wallet.Primitive.Types.Tx
Expand All @@ -44,8 +43,8 @@ import qualified Cardano.Wallet.Primitive.Migration.Planning as Planning
--
-- See 'createPlan' to create a migration plan.
--
data MigrationPlan size = MigrationPlan
{ selections :: ![Selection (TxIn, TxOut) size]
data MigrationPlan = MigrationPlan
{ selections :: ![Selection (TxIn, TxOut)]
-- ^ A list of generated selections: each selection is the basis for a
-- single transaction.
, unselected :: !UTxO
Expand All @@ -62,11 +61,10 @@ data MigrationPlan size = MigrationPlan
-- See 'MigrationPlan'.
--
createPlan
:: TxSize size
=> TxConstraints size
:: TxConstraints
-> UTxO
-> RewardWithdrawal
-> MigrationPlan size
-> MigrationPlan
createPlan constraints utxo reward = MigrationPlan
{ selections = view #selections plan
, unselected = Planning.uncategorizeUTxO (view #unselected plan)
Expand Down
46 changes: 19 additions & 27 deletions lib/core/src/Cardano/Wallet/Primitive/Migration/Planning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ module Cardano.Wallet.Primitive.Migration.Planning
import Prelude

import Cardano.Wallet.Primitive.Migration.Selection
( RewardWithdrawal (..), Selection (..), SelectionError (..), TxSize (..) )
( RewardWithdrawal (..), Selection (..), SelectionError (..) )
import Cardano.Wallet.Primitive.Types.Coin
( Coin (..) )
import Cardano.Wallet.Primitive.Types.TokenBundle
Expand Down Expand Up @@ -73,8 +73,8 @@ import qualified Data.Map.Strict as Map
--
-- Use 'createPlan' to create a migration plan.
--
data MigrationPlan input size = MigrationPlan
{ selections :: ![Selection input size]
data MigrationPlan input = MigrationPlan
{ selections :: ![Selection input]
-- ^ A list of generated selections: each selection is the basis for a
-- single transaction.
, unselected :: !(CategorizedUTxO input)
Expand All @@ -91,11 +91,10 @@ data MigrationPlan input size = MigrationPlan
-- See 'MigrationPlan'.
--
createPlan
:: TxSize size
=> TxConstraints size
:: TxConstraints
-> CategorizedUTxO input
-> RewardWithdrawal
-> MigrationPlan input size
-> MigrationPlan input
createPlan constraints =
run []
where
Expand All @@ -117,11 +116,10 @@ createPlan constraints =
-- entries that remain.
--
createSelection
:: TxSize size
=> TxConstraints size
:: TxConstraints
-> CategorizedUTxO input
-> RewardWithdrawal
-> Maybe (CategorizedUTxO input, Selection input size)
-> Maybe (CategorizedUTxO input, Selection input)
createSelection constraints utxo rewardWithdrawal =
initializeSelection constraints utxo rewardWithdrawal
<&> extendSelectionUntilFull constraints
Expand All @@ -132,11 +130,10 @@ createSelection constraints utxo rewardWithdrawal =
-- UTxO entries that remain.
--
initializeSelection
:: forall input size. TxSize size
=> TxConstraints size
:: TxConstraints
-> CategorizedUTxO input
-> RewardWithdrawal
-> Maybe (CategorizedUTxO input, Selection input size)
-> Maybe (CategorizedUTxO input, Selection input)
initializeSelection constraints utxoAtStart reward =
initializeWith =<< utxoAtStart `select` Supporter
where
Expand All @@ -156,10 +153,9 @@ initializeSelection constraints utxoAtStart reward =
-- is not enough ada to pay for a "freerider" entry.
--
extendSelectionUntilFull
:: TxSize size
=> TxConstraints size
-> (CategorizedUTxO input, Selection input size)
-> (CategorizedUTxO input, Selection input size)
:: TxConstraints
-> (CategorizedUTxO input, Selection input)
-> (CategorizedUTxO input, Selection input)
extendSelectionUntilFull constraints = extendWithFreerider
where
extendWithFreerider (!utxo, !selection) =
Expand Down Expand Up @@ -190,11 +186,10 @@ data ExtendSelectionError
| ExtendSelectionFull

extendWith
:: TxSize size
=> UTxOEntryCategory
-> TxConstraints size
-> (CategorizedUTxO input, Selection input size)
-> Either ExtendSelectionError (CategorizedUTxO input, Selection input size)
:: UTxOEntryCategory
-> TxConstraints
-> (CategorizedUTxO input, Selection input)
-> Either ExtendSelectionError (CategorizedUTxO input, Selection input)
extendWith category constraints (utxo, selection) =
case utxo `select` category of
Just (entry, utxo') ->
Expand Down Expand Up @@ -250,16 +245,14 @@ data CategorizedUTxO input = CategorizedUTxO
deriving (Eq, Show)

categorizeUTxO
:: TxSize size
=> TxConstraints size
:: TxConstraints
-> UTxO
-> CategorizedUTxO (TxIn, TxOut)
categorizeUTxO constraints (UTxO u) = categorizeUTxOEntries constraints $
(\(i, o) -> ((i, o), view #tokens o)) <$> Map.toList u

categorizeUTxOEntries
:: forall input size. TxSize size
=> TxConstraints size
:: forall input. TxConstraints
-> [(input, TokenBundle)]
-> CategorizedUTxO input
categorizeUTxOEntries constraints uncategorizedEntries = CategorizedUTxO
Expand All @@ -277,8 +270,7 @@ categorizeUTxOEntries constraints uncategorizedEntries = CategorizedUTxO
fmap fst <$> L.filter ((== category) . snd . snd) categorizedEntries

categorizeUTxOEntry
:: TxSize size
=> TxConstraints size
:: TxConstraints
-> TokenBundle
-> UTxOEntryCategory
categorizeUTxOEntry constraints b
Expand Down
Loading