-
Notifications
You must be signed in to change notification settings - Fork 211
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add type
UTxOSelection
to represent an in-progress UTxO selection.
- Loading branch information
1 parent
0450d3c
commit c826d36
Showing
2 changed files
with
306 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
305 changes: 305 additions & 0 deletions
305
lib/core/src/Cardano/Wallet/Primitive/Types/UTxOSelection.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,305 @@ | ||
{-# LANGUAGE DeriveGeneric #-} | ||
{-# LANGUAGE DuplicateRecordFields #-} | ||
{-# LANGUAGE NamedFieldPuns #-} | ||
{-# LANGUAGE OverloadedLabels #-} | ||
{-# LANGUAGE TypeFamilies #-} | ||
|
||
module Cardano.Wallet.Primitive.Types.UTxOSelection | ||
( | ||
-- * Classes | ||
IsUTxOSelection | ||
|
||
-- * Types | ||
, UTxOSelection | ||
, UTxOSelectionNonEmpty | ||
|
||
-- * Construction and deconstruction | ||
, empty | ||
, fromIndex | ||
, fromIndexFiltered | ||
, fromIndexPair | ||
, toIndexPair | ||
|
||
-- * Promotion and demotion | ||
, fromNonEmpty | ||
, toNonEmpty | ||
|
||
-- * Queries | ||
, isEmpty | ||
, isNonEmpty | ||
, isMember | ||
, isLeftover | ||
, isSelected | ||
, leftoverBalance | ||
, leftoverCount | ||
, leftoverIndex | ||
, leftoverList | ||
, selectedBalance | ||
, selectedCount | ||
, selectedIndex | ||
, selectedList | ||
|
||
-- * Modification | ||
, select | ||
, selectMany | ||
|
||
) where | ||
|
||
import Prelude | ||
|
||
import Cardano.Wallet.Primitive.Types.TokenBundle | ||
( TokenBundle ) | ||
import Cardano.Wallet.Primitive.Types.Tx | ||
( TxIn, TxOut ) | ||
import Cardano.Wallet.Primitive.Types.UTxOIndex | ||
( UTxOIndex ) | ||
import Control.Monad | ||
( ap, (<=<) ) | ||
import Data.Function | ||
( (&) ) | ||
import Data.Generics.Internal.VL.Lens | ||
( over ) | ||
import Data.Generics.Labels | ||
() | ||
import Data.List.NonEmpty | ||
( NonEmpty ) | ||
import Data.Maybe | ||
( fromMaybe ) | ||
import GHC.Generics | ||
( Generic ) | ||
|
||
import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex | ||
import qualified Data.Foldable as F | ||
import qualified Data.List.NonEmpty as NonEmpty | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Classes | ||
-------------------------------------------------------------------------------- | ||
|
||
class HasUTxOSelectionState s where | ||
|
||
-- | Retrieves the internal state from a selection. | ||
state :: s -> State | ||
|
||
-- | Reconstructs a selection from an internal state. | ||
fromState :: State -> s | ||
|
||
class HasUTxOSelectionState s => IsUTxOSelection s where | ||
|
||
-- | The type of the list of selected UTxOs. | ||
type SelectedList s | ||
|
||
-- | Retrieves a list of the selected UTxOs. | ||
selectedList :: s -> SelectedList s | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Types | ||
-------------------------------------------------------------------------------- | ||
|
||
data State = State | ||
{ leftover :: !UTxOIndex | ||
, selected :: !UTxOIndex | ||
} | ||
deriving (Eq, Generic, Show) | ||
|
||
-- | A selection for which 'selectionCount' may be zero. | ||
-- | ||
newtype UTxOSelection = UTxOSelection State | ||
deriving (Eq, Generic, Show) | ||
|
||
-- | A selection for which 'selectionCount' cannot be zero. | ||
-- | ||
newtype UTxOSelectionNonEmpty = UTxOSelectionNonEmpty State | ||
deriving (Eq, Generic, Show) | ||
|
||
instance HasUTxOSelectionState UTxOSelection where | ||
state (UTxOSelection s) = s | ||
fromState s = UTxOSelection s | ||
|
||
instance HasUTxOSelectionState UTxOSelectionNonEmpty where | ||
state (UTxOSelectionNonEmpty s) = s | ||
fromState s = UTxOSelectionNonEmpty s | ||
|
||
instance IsUTxOSelection UTxOSelection where | ||
type SelectedList UTxOSelection = [(TxIn, TxOut)] | ||
selectedList | ||
= UTxOIndex.toList | ||
. selectedIndex | ||
|
||
instance IsUTxOSelection UTxOSelectionNonEmpty where | ||
type SelectedList UTxOSelectionNonEmpty = NonEmpty (TxIn, TxOut) | ||
selectedList | ||
= NonEmpty.fromList | ||
. UTxOIndex.toList | ||
. selectedIndex | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Construction and deconstruction | ||
-------------------------------------------------------------------------------- | ||
|
||
-- | A completely empty selection with nothing in either set. | ||
-- | ||
empty :: UTxOSelection | ||
empty = fromIndex UTxOIndex.empty | ||
|
||
-- | Creates a selection from an index. | ||
-- | ||
-- All UTxOs in the index will be added to the leftover set. | ||
-- | ||
fromIndex :: UTxOIndex -> UTxOSelection | ||
fromIndex i = UTxOSelection State | ||
{ leftover = i | ||
, selected = UTxOIndex.empty | ||
} | ||
|
||
-- | Creates a selection from an index and a filter. | ||
-- | ||
-- All UTxOs that match the given filter will be added to the selected set, | ||
-- whereas all UTxOs that do not match will be added to the leftover set. | ||
-- | ||
fromIndexFiltered :: UTxOIndex -> (TxIn -> Bool) -> UTxOSelection | ||
fromIndexFiltered index f = | ||
UTxOSelection State {leftover, selected} | ||
where | ||
(selected, leftover) = UTxOIndex.partition f index | ||
|
||
-- | Creates a selection from a pair of indices. | ||
-- | ||
-- The 1st index in the pair represents the leftover set. | ||
-- The 2nd index in the pair represents the selected set. | ||
-- | ||
-- Any items that are in both sets are removed from the leftover set. | ||
-- | ||
fromIndexPair :: (UTxOIndex, UTxOIndex) -> UTxOSelection | ||
fromIndexPair (leftover, selected) = | ||
UTxOSelection State | ||
{ leftover = leftover `UTxOIndex.difference` selected | ||
, selected | ||
} | ||
|
||
-- | Converts a selection to a pair of indices. | ||
-- | ||
-- The 1st index in the pair represents the leftover set. | ||
-- The 2nd index in the pair represents the selected set. | ||
-- | ||
toIndexPair :: IsUTxOSelection s => s -> (UTxOIndex, UTxOIndex) | ||
toIndexPair s = (leftoverIndex s, selectedIndex s) | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Promotion and demotion | ||
-------------------------------------------------------------------------------- | ||
|
||
-- | Demotes a non-empty selection to an ordinary selection. | ||
-- | ||
fromNonEmpty :: UTxOSelectionNonEmpty -> UTxOSelection | ||
fromNonEmpty = UTxOSelection . state | ||
|
||
-- | Promotes an ordinary selection to a non-empty selection. | ||
-- | ||
-- Returns 'Nothing' if the the selected set is empty. | ||
-- | ||
toNonEmpty :: IsUTxOSelection s => s -> Maybe UTxOSelectionNonEmpty | ||
toNonEmpty s | ||
| isNonEmpty s = | ||
Just $ UTxOSelectionNonEmpty $ state s | ||
| otherwise = | ||
Nothing | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Querying | ||
-------------------------------------------------------------------------------- | ||
|
||
-- | Returns 'True' if and only if the selected set is empty. | ||
-- | ||
isEmpty :: IsUTxOSelection s => s -> Bool | ||
isEmpty = (== 0) . selectedCount | ||
|
||
-- | Returns 'True' if and only if the selected set is non-empty. | ||
-- | ||
isNonEmpty :: IsUTxOSelection s => s -> Bool | ||
isNonEmpty = (> 0) . selectedCount | ||
|
||
-- | Returns 'True' if the given 'TxIn' is a member of either set. | ||
-- | ||
-- Otherwise, returns 'False'. | ||
-- | ||
isMember :: IsUTxOSelection s => TxIn -> s -> Bool | ||
isMember i s = isLeftover i s || isSelected i s | ||
|
||
-- | Returns 'True' iff. the given 'TxIn' is a member of the leftover set. | ||
-- | ||
isLeftover :: IsUTxOSelection s => TxIn -> s -> Bool | ||
isLeftover i = UTxOIndex.member i . leftoverIndex | ||
|
||
-- | Returns 'True' iff. the given 'TxIn' is a member of the selected set. | ||
-- | ||
isSelected :: IsUTxOSelection s => TxIn -> s -> Bool | ||
isSelected i = UTxOIndex.member i . selectedIndex | ||
|
||
-- | Retrieves the balance of leftover UTxOs. | ||
-- | ||
leftoverBalance :: IsUTxOSelection s => s -> TokenBundle | ||
leftoverBalance = UTxOIndex.balance . leftoverIndex | ||
|
||
-- | Retrieves a count of the leftover UTxOs. | ||
-- | ||
leftoverCount :: IsUTxOSelection s => s -> Int | ||
leftoverCount = UTxOIndex.size . leftoverIndex | ||
|
||
-- | Retrieves an index of the leftover UTxOs. | ||
-- | ||
leftoverIndex :: IsUTxOSelection s => s -> UTxOIndex | ||
leftoverIndex = leftover . state | ||
|
||
-- | Retrieves a list of the leftover UTxOs. | ||
-- | ||
leftoverList :: IsUTxOSelection s => s -> [(TxIn, TxOut)] | ||
leftoverList = UTxOIndex.toList . leftoverIndex | ||
|
||
-- | Retrieves the balance of selected UTxOs. | ||
-- | ||
selectedBalance :: IsUTxOSelection s => s -> TokenBundle | ||
selectedBalance = UTxOIndex.balance . selectedIndex | ||
|
||
-- | Retrieves a count of the selected UTxOs. | ||
-- | ||
selectedCount :: IsUTxOSelection s => s -> Int | ||
selectedCount = UTxOIndex.size . selectedIndex | ||
|
||
-- | Retrieves an index of the selected UTxOs. | ||
-- | ||
selectedIndex :: IsUTxOSelection s => s -> UTxOIndex | ||
selectedIndex = selected . state | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Modification | ||
-------------------------------------------------------------------------------- | ||
|
||
-- | Moves a single entry from the leftover set to the selected set. | ||
-- | ||
select :: IsUTxOSelection s => TxIn -> s -> Maybe UTxOSelectionNonEmpty | ||
select = (toNonEmpty <=<) . withState . selectState | ||
|
||
-- | Moves multiple entries from the leftover set to the selected set. | ||
-- | ||
selectMany :: IsUTxOSelection s => Foldable f => f TxIn -> s -> s | ||
selectMany = ap fromMaybe . withState . flip (F.foldrM selectState) | ||
|
||
-------------------------------------------------------------------------------- | ||
-- Modification (Internal) | ||
-------------------------------------------------------------------------------- | ||
|
||
-- | Moves a single entry from the leftover set to the selected set. | ||
-- | ||
selectState :: TxIn -> State -> Maybe State | ||
selectState i s = | ||
updateFields <$> UTxOIndex.lookup i (leftover s) | ||
where | ||
updateFields o = s | ||
& over #leftover (UTxOIndex.delete i) | ||
& over #selected (UTxOIndex.insert i o) | ||
|
||
-- | Applies the given function to the internal state. | ||
-- | ||
withState :: Functor f => IsUTxOSelection s => (State -> f State) -> s -> f s | ||
withState f = fmap fromState . f . state |