{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{- HLINT ignore "Use &&" -}

-- |
-- Copyright: © 2018-2021 IOHK
-- License: Apache-2.0
--
-- Provides internal functions for the 'UTxOIndex' type, which indexes a UTxO
-- set by asset identifier.
--
-- The index makes it possible to efficiently compute the subset of a UTxO set
-- containing a particular asset, or to select just a single UTxO containing a
-- particular asset, without having to search linearly through the entire UTxO
-- set.
--
-- See the documentation for 'UTxOIndex' for more details.
--
module Cardano.Wallet.Primitive.Types.UTxOIndex.Internal
    (
    ----------------------------------------------------------------------------
    -- Public Interface
    ----------------------------------------------------------------------------

    -- * Type

      -- Important:
      --
      -- The default data constructor for 'UTxOIndex' is not exported, by
      -- design, as the internal data structure has an invariant that must
      -- be preserved across all operations.
      --
      -- See the 'checkInvariant' function for more details.
      --
      UTxOIndex

    -- * Construction
    , empty
    , singleton
    , fromSequence
    , fromMap

    -- * Deconstruction
    , toList
    , toMap

    -- * Folding
    , fold

    -- * Modification
    , insert
    , insertMany
    , delete
    , deleteMany

    -- * Filtering and partitioning
    , filter
    , partition

    -- * Queries
    , assets
    , balance
    , lookup
    , member
    , null
    , size

    -- * Set operations
    , difference
    , disjoint

    -- * Selection
    , SelectionFilter (..)
    , selectRandom
    , selectRandomWithPriority

    ----------------------------------------------------------------------------
    -- Internal Interface
    ----------------------------------------------------------------------------

    -- * Assets
    , Asset (..)
    , tokenBundleAssets
    , tokenBundleAssetCount
    , tokenBundleHasAsset

    -- * Token bundle categorization
    , BundleCategory (..)
    , categorizeTokenBundle

    -- * Utilities
    , selectRandomSetMember

    -- * Invariant
    , InvariantStatus (..)
    , checkInvariant

    ) where

import Prelude hiding
    ( filter, lookup, null )

import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId )
import Control.DeepSeq
    ( NFData )
import Control.Monad.Extra
    ( firstJustM )
import Control.Monad.Random.Class
    ( MonadRandom (..) )
import Data.Bifunctor
    ( bimap )
import Data.Function
    ( (&) )
import Data.Generics.Internal.VL.Lens
    ( over )
import Data.Generics.Labels
    ()
import Data.List.NonEmpty
    ( NonEmpty )
import Data.Map.Strict
    ( Map )
import Data.Maybe
    ( isJust )
import Data.Set
    ( Set )
import Data.Set.Strict.NonEmptySet
    ( NonEmptySet )
import GHC.Generics
    ( Generic )

import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
import qualified Cardano.Wallet.Primitive.Types.TokenMap as TokenMap
import qualified Data.Foldable as F
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Set.Strict.NonEmptySet as NonEmptySet

--------------------------------------------------------------------------------
-- Public Interface
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Type
--------------------------------------------------------------------------------

-- | A UTxO set that is indexed by asset identifier.
--
-- The index provides a mapping from assets to subsets of the UTxO set.
--
-- A UTxO appears in the set for a particular asset if and only if its
-- associated value has a non-zero quantity of that asset.
--
-- The index makes it possible to efficiently compute the subset of a UTxO set
-- containing a particular asset, or to select just a single UTxO containing a
-- particular asset, without having to search linearly through the entire UTxO
-- set.
--
-- The index also keeps track of the current UTxO balance of all assets, making
-- it possible to efficiently look up the total quantity of a particular asset
-- without having to sum across the entire UTxO set.
--
-- The UTxO index data structure has an invariant that can be checked with
-- the 'checkInvariant' function.
--
data UTxOIndex u = UTxOIndex
    { UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll
        :: !(Map Asset (NonEmptySet u))
        -- An index of all entries that contain the given asset.
    , UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons
        :: !(Map Asset (NonEmptySet u))
        -- An index of all entries that contain the given asset and no other
        -- assets.
    , UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs
        :: !(Map Asset (NonEmptySet u))
        -- An index of all entries that contain the given asset and exactly
        -- one other asset.
    , UTxOIndex u -> TokenBundle
balance
        :: !TokenBundle
        -- The total balance of all entries.
    , UTxOIndex u -> Map u TokenBundle
universe
        :: !(Map u TokenBundle)
        -- The complete set of all entries.
    }
    deriving (UTxOIndex u -> UTxOIndex u -> Bool
(UTxOIndex u -> UTxOIndex u -> Bool)
-> (UTxOIndex u -> UTxOIndex u -> Bool) -> Eq (UTxOIndex u)
forall u. Eq u => UTxOIndex u -> UTxOIndex u -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxOIndex u -> UTxOIndex u -> Bool
$c/= :: forall u. Eq u => UTxOIndex u -> UTxOIndex u -> Bool
== :: UTxOIndex u -> UTxOIndex u -> Bool
$c== :: forall u. Eq u => UTxOIndex u -> UTxOIndex u -> Bool
Eq, (forall x. UTxOIndex u -> Rep (UTxOIndex u) x)
-> (forall x. Rep (UTxOIndex u) x -> UTxOIndex u)
-> Generic (UTxOIndex u)
forall x. Rep (UTxOIndex u) x -> UTxOIndex u
forall x. UTxOIndex u -> Rep (UTxOIndex u) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall u x. Rep (UTxOIndex u) x -> UTxOIndex u
forall u x. UTxOIndex u -> Rep (UTxOIndex u) x
$cto :: forall u x. Rep (UTxOIndex u) x -> UTxOIndex u
$cfrom :: forall u x. UTxOIndex u -> Rep (UTxOIndex u) x
Generic, ReadPrec [UTxOIndex u]
ReadPrec (UTxOIndex u)
Int -> ReadS (UTxOIndex u)
ReadS [UTxOIndex u]
(Int -> ReadS (UTxOIndex u))
-> ReadS [UTxOIndex u]
-> ReadPrec (UTxOIndex u)
-> ReadPrec [UTxOIndex u]
-> Read (UTxOIndex u)
forall u. (Read u, Ord u) => ReadPrec [UTxOIndex u]
forall u. (Read u, Ord u) => ReadPrec (UTxOIndex u)
forall u. (Read u, Ord u) => Int -> ReadS (UTxOIndex u)
forall u. (Read u, Ord u) => ReadS [UTxOIndex u]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UTxOIndex u]
$creadListPrec :: forall u. (Read u, Ord u) => ReadPrec [UTxOIndex u]
readPrec :: ReadPrec (UTxOIndex u)
$creadPrec :: forall u. (Read u, Ord u) => ReadPrec (UTxOIndex u)
readList :: ReadS [UTxOIndex u]
$creadList :: forall u. (Read u, Ord u) => ReadS [UTxOIndex u]
readsPrec :: Int -> ReadS (UTxOIndex u)
$creadsPrec :: forall u. (Read u, Ord u) => Int -> ReadS (UTxOIndex u)
Read, Int -> UTxOIndex u -> ShowS
[UTxOIndex u] -> ShowS
UTxOIndex u -> String
(Int -> UTxOIndex u -> ShowS)
-> (UTxOIndex u -> String)
-> ([UTxOIndex u] -> ShowS)
-> Show (UTxOIndex u)
forall u. Show u => Int -> UTxOIndex u -> ShowS
forall u. Show u => [UTxOIndex u] -> ShowS
forall u. Show u => UTxOIndex u -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOIndex u] -> ShowS
$cshowList :: forall u. Show u => [UTxOIndex u] -> ShowS
show :: UTxOIndex u -> String
$cshow :: forall u. Show u => UTxOIndex u -> String
showsPrec :: Int -> UTxOIndex u -> ShowS
$cshowsPrec :: forall u. Show u => Int -> UTxOIndex u -> ShowS
Show)

instance NFData u => NFData (UTxOIndex u)

--------------------------------------------------------------------------------
-- Construction
--------------------------------------------------------------------------------

-- | An index with no entries.
--
empty :: UTxOIndex u
empty :: UTxOIndex u
empty = UTxOIndex :: forall u.
Map Asset (NonEmptySet u)
-> Map Asset (NonEmptySet u)
-> Map Asset (NonEmptySet u)
-> TokenBundle
-> Map u TokenBundle
-> UTxOIndex u
UTxOIndex
    { indexAll :: Map Asset (NonEmptySet u)
indexAll = Map Asset (NonEmptySet u)
forall k a. Map k a
Map.empty
    , indexSingletons :: Map Asset (NonEmptySet u)
indexSingletons = Map Asset (NonEmptySet u)
forall k a. Map k a
Map.empty
    , indexPairs :: Map Asset (NonEmptySet u)
indexPairs = Map Asset (NonEmptySet u)
forall k a. Map k a
Map.empty
    , balance :: TokenBundle
balance = TokenBundle
TokenBundle.empty
    , universe :: Map u TokenBundle
universe = Map u TokenBundle
forall k a. Map k a
Map.empty
    }

-- | Creates a singleton index from the specified UTxO identifier and value.
--
singleton :: Ord u => u -> TokenBundle -> UTxOIndex u
singleton :: u -> TokenBundle -> UTxOIndex u
singleton u
u TokenBundle
b = u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insertUnsafe u
u TokenBundle
b UTxOIndex u
forall u. UTxOIndex u
empty

-- | Constructs an index from a sequence of entries.
--
-- Note that this operation is potentially expensive as it must construct an
-- index from scratch, and therefore should only be used sparingly.
--
-- If the given sequence contains more than one mapping for the same UTxO
-- identifier, the mapping that appears latest in the sequence will take
-- precedence, and all others will be ignored.
--
fromSequence :: (Foldable f, Ord u) => f (u, TokenBundle) -> UTxOIndex u
fromSequence :: f (u, TokenBundle) -> UTxOIndex u
fromSequence = (f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u)
-> UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u
forall a b c. (a -> b -> c) -> b -> a -> c
flip f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u
insertMany UTxOIndex u
forall u. UTxOIndex u
empty

-- | Constructs an index from a map.
--
-- Note that this operation is potentially expensive as it must construct an
-- index from scratch, and therefore should only be used sparingly.
--
fromMap :: Ord u => Map u TokenBundle -> UTxOIndex u
fromMap :: Map u TokenBundle -> UTxOIndex u
fromMap = [(u, TokenBundle)] -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u
fromSequence ([(u, TokenBundle)] -> UTxOIndex u)
-> (Map u TokenBundle -> [(u, TokenBundle)])
-> Map u TokenBundle
-> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map u TokenBundle -> [(u, TokenBundle)]
forall k a. Map k a -> [(k, a)]
Map.toList

--------------------------------------------------------------------------------
-- Deconstruction
--------------------------------------------------------------------------------

-- | Converts an index to a list of its constituent entries.
--
-- Consider using 'fold' if your goal is to consume all entries in the output.
--
toList :: UTxOIndex u -> [(u, TokenBundle)]
toList :: UTxOIndex u -> [(u, TokenBundle)]
toList = ([(u, TokenBundle)] -> u -> TokenBundle -> [(u, TokenBundle)])
-> [(u, TokenBundle)] -> UTxOIndex u -> [(u, TokenBundle)]
forall a u. (a -> u -> TokenBundle -> a) -> a -> UTxOIndex u -> a
fold (\[(u, TokenBundle)]
ubs u
u TokenBundle
b -> (u
u, TokenBundle
b) (u, TokenBundle) -> [(u, TokenBundle)] -> [(u, TokenBundle)]
forall a. a -> [a] -> [a]
: [(u, TokenBundle)]
ubs) []

-- | Converts an index into a map.
--
-- Consider using 'fold' if your goal is to consume all entries in the output.
--
toMap :: UTxOIndex u -> Map u TokenBundle
toMap :: UTxOIndex u -> Map u TokenBundle
toMap = UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe

--------------------------------------------------------------------------------
-- Folding
--------------------------------------------------------------------------------

-- | Folds strictly over the constituent entries of an index.
--
fold :: (a -> u -> TokenBundle -> a) -> a -> UTxOIndex u -> a
fold :: (a -> u -> TokenBundle -> a) -> a -> UTxOIndex u -> a
fold a -> u -> TokenBundle -> a
f a
a = (a -> u -> TokenBundle -> a) -> a -> Map u TokenBundle -> a
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' a -> u -> TokenBundle -> a
f a
a (Map u TokenBundle -> a)
-> (UTxOIndex u -> Map u TokenBundle) -> UTxOIndex u -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe

--------------------------------------------------------------------------------
-- Modification
--------------------------------------------------------------------------------

-- | Inserts an entry that maps the given UTxO identifier to the given value.
--
-- If the index has an existing value for the specified UTxO identifier, the
-- value referred to by that identifier will be replaced with the specified
-- value.
--
insert :: Ord u => u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insert :: u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insert u
u TokenBundle
b = u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insertUnsafe u
u TokenBundle
b (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> UTxOIndex u -> UTxOIndex u
delete u
u

-- | Inserts multiple entries into an index.
--
-- See 'insert'.
--
insertMany
    :: (Foldable f, Ord u)
    => f (u, TokenBundle)
    -> UTxOIndex u
    -> UTxOIndex u
insertMany :: f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u
insertMany = (UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u)
-> f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u)
 -> f (u, TokenBundle) -> UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u)
-> f (u, TokenBundle)
-> UTxOIndex u
-> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ (UTxOIndex u -> (u, TokenBundle) -> UTxOIndex u)
-> UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((UTxOIndex u -> (u, TokenBundle) -> UTxOIndex u)
 -> UTxOIndex u -> f (u, TokenBundle) -> UTxOIndex u)
-> (UTxOIndex u -> (u, TokenBundle) -> UTxOIndex u)
-> UTxOIndex u
-> f (u, TokenBundle)
-> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ \UTxOIndex u
i (u
u, TokenBundle
b) -> u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insert u
u TokenBundle
b UTxOIndex u
i

-- | Deletes the entry corresponding to the given UTxO identifier.
--
-- If the index has no existing entry for the specified identifier, the result
-- of applying this function will be equivalent to the identity function.
--
delete :: forall u. Ord u => u -> UTxOIndex u -> UTxOIndex u
delete :: u -> UTxOIndex u -> UTxOIndex u
delete u
u UTxOIndex u
i =
    UTxOIndex u
-> (TokenBundle -> UTxOIndex u) -> Maybe TokenBundle -> UTxOIndex u
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UTxOIndex u
i TokenBundle -> UTxOIndex u
updateIndex (Maybe TokenBundle -> UTxOIndex u)
-> Maybe TokenBundle -> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ u -> Map u TokenBundle -> Maybe TokenBundle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup u
u (Map u TokenBundle -> Maybe TokenBundle)
-> Map u TokenBundle -> Maybe TokenBundle
forall a b. (a -> b) -> a -> b
$ UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i
  where
    updateIndex :: TokenBundle -> UTxOIndex u
    updateIndex :: TokenBundle -> UTxOIndex u
updateIndex TokenBundle
b = UTxOIndex u
i
        -- This operation is safe, since we have already determined that the
        -- entry is a member of the index, and therefore the balance must be
        -- greater than or equal to the value of this output:
        UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& ((TokenBundle -> Identity TokenBundle)
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (TokenBundle -> TokenBundle) -> UTxOIndex u -> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "balance"
  ((TokenBundle -> Identity TokenBundle)
   -> UTxOIndex u -> Identity (UTxOIndex u))
(TokenBundle -> Identity TokenBundle)
-> UTxOIndex u -> Identity (UTxOIndex u)
#balance (TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.unsafeSubtract` TokenBundle
b)
        UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& ((Map u TokenBundle -> Identity (Map u TokenBundle))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map u TokenBundle -> Map u TokenBundle)
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "universe"
  ((Map u TokenBundle -> Identity (Map u TokenBundle))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map u TokenBundle -> Identity (Map u TokenBundle))
-> UTxOIndex u -> Identity (UTxOIndex u)
#universe (u -> Map u TokenBundle -> Map u TokenBundle
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete u
u)
        UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& case TokenBundle -> BundleCategory Asset
categorizeTokenBundle TokenBundle
b of
            BundleCategory Asset
BundleWithNoAssets -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
            BundleWithOneAsset Asset
a -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a)
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexSingletons"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexSingletons (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a)
            BundleWithTwoAssets (Asset
a1, Asset
a2) -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a1)
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a2)
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexPairs"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexPairs (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a1)
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexPairs"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexPairs (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`deleteEntry` Asset
a2)
            BundleWithMultipleAssets Set Asset
as -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
                (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll ((Map Asset (NonEmptySet u)
 -> Set Asset -> Map Asset (NonEmptySet u))
-> Set Asset
-> Map Asset (NonEmptySet u)
-> Map Asset (NonEmptySet u)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u))
-> Map Asset (NonEmptySet u)
-> Set Asset
-> Map Asset (NonEmptySet u)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
deleteEntry) Set Asset
as)

    deleteEntry
        :: Ord asset
        => Map asset (NonEmptySet u)
        -> asset
        -> Map asset (NonEmptySet u)
    deleteEntry :: Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
deleteEntry Map asset (NonEmptySet u)
m asset
a = (NonEmptySet u -> Maybe (NonEmptySet u))
-> asset -> Map asset (NonEmptySet u) -> Map asset (NonEmptySet u)
forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update (u -> NonEmptySet u -> Maybe (NonEmptySet u)
forall a. Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
NonEmptySet.delete u
u) asset
a Map asset (NonEmptySet u)
m

-- | Deletes multiple entries from an index.
--
-- See 'delete'.
--
deleteMany :: (Foldable f, Ord u) => f u -> UTxOIndex u -> UTxOIndex u
deleteMany :: f u -> UTxOIndex u -> UTxOIndex u
deleteMany = (UTxOIndex u -> f u -> UTxOIndex u)
-> f u -> UTxOIndex u -> UTxOIndex u
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((UTxOIndex u -> f u -> UTxOIndex u)
 -> f u -> UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> f u -> UTxOIndex u)
-> f u
-> UTxOIndex u
-> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ (UTxOIndex u -> u -> UTxOIndex u)
-> UTxOIndex u -> f u -> UTxOIndex u
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((UTxOIndex u -> u -> UTxOIndex u)
 -> UTxOIndex u -> f u -> UTxOIndex u)
-> (UTxOIndex u -> u -> UTxOIndex u)
-> UTxOIndex u
-> f u
-> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ \UTxOIndex u
i u
u -> u -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> UTxOIndex u -> UTxOIndex u
delete u
u UTxOIndex u
i

--------------------------------------------------------------------------------
-- Filtering and partitioning
--------------------------------------------------------------------------------

-- | Filters an index.
--
filter :: Ord u => (u -> Bool) -> UTxOIndex u -> UTxOIndex u
filter :: (u -> Bool) -> UTxOIndex u -> UTxOIndex u
filter u -> Bool
f = [(u, TokenBundle)] -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u
fromSequence ([(u, TokenBundle)] -> UTxOIndex u)
-> (UTxOIndex u -> [(u, TokenBundle)])
-> UTxOIndex u
-> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((u, TokenBundle) -> Bool)
-> [(u, TokenBundle)] -> [(u, TokenBundle)]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (u -> Bool
f (u -> Bool) -> ((u, TokenBundle) -> u) -> (u, TokenBundle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, TokenBundle) -> u
forall a b. (a, b) -> a
fst) ([(u, TokenBundle)] -> [(u, TokenBundle)])
-> (UTxOIndex u -> [(u, TokenBundle)])
-> UTxOIndex u
-> [(u, TokenBundle)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> [(u, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
toList

-- | Partitions an index.
--
partition :: Ord u => (u -> Bool) -> UTxOIndex u -> (UTxOIndex u, UTxOIndex u)
partition :: (u -> Bool) -> UTxOIndex u -> (UTxOIndex u, UTxOIndex u)
partition u -> Bool
f = ([(u, TokenBundle)] -> UTxOIndex u)
-> ([(u, TokenBundle)] -> UTxOIndex u)
-> ([(u, TokenBundle)], [(u, TokenBundle)])
-> (UTxOIndex u, UTxOIndex u)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [(u, TokenBundle)] -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u
fromSequence [(u, TokenBundle)] -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u
fromSequence (([(u, TokenBundle)], [(u, TokenBundle)])
 -> (UTxOIndex u, UTxOIndex u))
-> (UTxOIndex u -> ([(u, TokenBundle)], [(u, TokenBundle)]))
-> UTxOIndex u
-> (UTxOIndex u, UTxOIndex u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((u, TokenBundle) -> Bool)
-> [(u, TokenBundle)] -> ([(u, TokenBundle)], [(u, TokenBundle)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (u -> Bool
f (u -> Bool) -> ((u, TokenBundle) -> u) -> (u, TokenBundle) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u, TokenBundle) -> u
forall a b. (a, b) -> a
fst) ([(u, TokenBundle)] -> ([(u, TokenBundle)], [(u, TokenBundle)]))
-> (UTxOIndex u -> [(u, TokenBundle)])
-> UTxOIndex u
-> ([(u, TokenBundle)], [(u, TokenBundle)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> [(u, TokenBundle)]
forall u. UTxOIndex u -> [(u, TokenBundle)]
toList

--------------------------------------------------------------------------------
-- Queries
--------------------------------------------------------------------------------

-- | Returns the complete set of all assets contained in an index.
--
assets :: UTxOIndex u -> Set Asset
assets :: UTxOIndex u -> Set Asset
assets = Map Asset (NonEmptySet u) -> Set Asset
forall k a. Map k a -> Set k
Map.keysSet (Map Asset (NonEmptySet u) -> Set Asset)
-> (UTxOIndex u -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> Set Asset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll

-- | Returns the value corresponding to the given UTxO identifier.
--
-- If the index has no such identifier, this function returns 'Nothing'.
--
lookup :: Ord u => u -> UTxOIndex u -> Maybe TokenBundle
lookup :: u -> UTxOIndex u -> Maybe TokenBundle
lookup u
u = u -> Map u TokenBundle -> Maybe TokenBundle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup u
u (Map u TokenBundle -> Maybe TokenBundle)
-> (UTxOIndex u -> Map u TokenBundle)
-> UTxOIndex u
-> Maybe TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe

-- | Returns 'True' if (and only if) the index has an entry for the given UTxO
--   identifier.
--
member :: Ord u => u -> UTxOIndex u -> Bool
member :: u -> UTxOIndex u -> Bool
member u
u = Maybe TokenBundle -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TokenBundle -> Bool)
-> (UTxOIndex u -> Maybe TokenBundle) -> UTxOIndex u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> UTxOIndex u -> Maybe TokenBundle
forall u. Ord u => u -> UTxOIndex u -> Maybe TokenBundle
lookup u
u

-- | Returns 'True' if (and only if) the index is empty.
--
null :: UTxOIndex u -> Bool
null :: UTxOIndex u -> Bool
null = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (UTxOIndex u -> Int) -> UTxOIndex u -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> Int
forall u. UTxOIndex u -> Int
size

-- | Returns the total number of UTxO entries held within the index.
--
size :: UTxOIndex u -> Int
size :: UTxOIndex u -> Int
size = Map u TokenBundle -> Int
forall k a. Map k a -> Int
Map.size (Map u TokenBundle -> Int)
-> (UTxOIndex u -> Map u TokenBundle) -> UTxOIndex u -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe

--------------------------------------------------------------------------------
-- Set operations
--------------------------------------------------------------------------------

difference :: Ord u => UTxOIndex u -> UTxOIndex u -> UTxOIndex u
difference :: UTxOIndex u -> UTxOIndex u -> UTxOIndex u
difference UTxOIndex u
a UTxOIndex u
b = [(u, TokenBundle)] -> UTxOIndex u
forall (f :: * -> *) u.
(Foldable f, Ord u) =>
f (u, TokenBundle) -> UTxOIndex u
fromSequence
    ([(u, TokenBundle)] -> UTxOIndex u)
-> [(u, TokenBundle)] -> UTxOIndex u
forall a b. (a -> b) -> a -> b
$ Map u TokenBundle -> [(u, TokenBundle)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map u TokenBundle -> [(u, TokenBundle)])
-> Map u TokenBundle -> [(u, TokenBundle)]
forall a b. (a -> b) -> a -> b
$ Map u TokenBundle -> Map u TokenBundle -> Map u TokenBundle
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference (UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
a) (UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
b)

-- | Indicates whether a pair of UTxO indices are disjoint.
--
disjoint :: Ord u => UTxOIndex u -> UTxOIndex u -> Bool
disjoint :: UTxOIndex u -> UTxOIndex u -> Bool
disjoint UTxOIndex u
i1 UTxOIndex u
i2 = UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i1 Map u TokenBundle -> Map u TokenBundle -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
`Map.disjoint` UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i2

--------------------------------------------------------------------------------
-- Selection
--------------------------------------------------------------------------------

-- | Specifies a filter for selecting UTxO entries.
--
data SelectionFilter asset
    = SelectSingleton asset
      -- ^ Matches UTxOs that contain only the given asset and no other assets.
    | SelectPairWith asset
      -- ^ Matches UTxOs that contain the given asset and exactly one other
      -- asset.
    | SelectAnyWith asset
      -- ^ Matches UTxOs that contain the given asset and any number of other
      -- assets.
    | SelectAny
      -- ^ Matches all UTxOs regardless of what assets they contain.
    deriving (SelectionFilter asset -> SelectionFilter asset -> Bool
(SelectionFilter asset -> SelectionFilter asset -> Bool)
-> (SelectionFilter asset -> SelectionFilter asset -> Bool)
-> Eq (SelectionFilter asset)
forall asset.
Eq asset =>
SelectionFilter asset -> SelectionFilter asset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectionFilter asset -> SelectionFilter asset -> Bool
$c/= :: forall asset.
Eq asset =>
SelectionFilter asset -> SelectionFilter asset -> Bool
== :: SelectionFilter asset -> SelectionFilter asset -> Bool
$c== :: forall asset.
Eq asset =>
SelectionFilter asset -> SelectionFilter asset -> Bool
Eq, SelectionFilter a -> Bool
(a -> m) -> SelectionFilter a -> m
(a -> b -> b) -> b -> SelectionFilter a -> b
(forall m. Monoid m => SelectionFilter m -> m)
-> (forall m a. Monoid m => (a -> m) -> SelectionFilter a -> m)
-> (forall m a. Monoid m => (a -> m) -> SelectionFilter a -> m)
-> (forall a b. (a -> b -> b) -> b -> SelectionFilter a -> b)
-> (forall a b. (a -> b -> b) -> b -> SelectionFilter a -> b)
-> (forall b a. (b -> a -> b) -> b -> SelectionFilter a -> b)
-> (forall b a. (b -> a -> b) -> b -> SelectionFilter a -> b)
-> (forall a. (a -> a -> a) -> SelectionFilter a -> a)
-> (forall a. (a -> a -> a) -> SelectionFilter a -> a)
-> (forall a. SelectionFilter a -> [a])
-> (forall a. SelectionFilter a -> Bool)
-> (forall a. SelectionFilter a -> Int)
-> (forall a. Eq a => a -> SelectionFilter a -> Bool)
-> (forall a. Ord a => SelectionFilter a -> a)
-> (forall a. Ord a => SelectionFilter a -> a)
-> (forall a. Num a => SelectionFilter a -> a)
-> (forall a. Num a => SelectionFilter a -> a)
-> Foldable SelectionFilter
forall a. Eq a => a -> SelectionFilter a -> Bool
forall a. Num a => SelectionFilter a -> a
forall a. Ord a => SelectionFilter a -> a
forall m. Monoid m => SelectionFilter m -> m
forall a. SelectionFilter a -> Bool
forall a. SelectionFilter a -> Int
forall a. SelectionFilter a -> [a]
forall a. (a -> a -> a) -> SelectionFilter a -> a
forall m a. Monoid m => (a -> m) -> SelectionFilter a -> m
forall b a. (b -> a -> b) -> b -> SelectionFilter a -> b
forall a b. (a -> b -> b) -> b -> SelectionFilter a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: SelectionFilter a -> a
$cproduct :: forall a. Num a => SelectionFilter a -> a
sum :: SelectionFilter a -> a
$csum :: forall a. Num a => SelectionFilter a -> a
minimum :: SelectionFilter a -> a
$cminimum :: forall a. Ord a => SelectionFilter a -> a
maximum :: SelectionFilter a -> a
$cmaximum :: forall a. Ord a => SelectionFilter a -> a
elem :: a -> SelectionFilter a -> Bool
$celem :: forall a. Eq a => a -> SelectionFilter a -> Bool
length :: SelectionFilter a -> Int
$clength :: forall a. SelectionFilter a -> Int
null :: SelectionFilter a -> Bool
$cnull :: forall a. SelectionFilter a -> Bool
toList :: SelectionFilter a -> [a]
$ctoList :: forall a. SelectionFilter a -> [a]
foldl1 :: (a -> a -> a) -> SelectionFilter a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> SelectionFilter a -> a
foldr1 :: (a -> a -> a) -> SelectionFilter a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> SelectionFilter a -> a
foldl' :: (b -> a -> b) -> b -> SelectionFilter a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> SelectionFilter a -> b
foldl :: (b -> a -> b) -> b -> SelectionFilter a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> SelectionFilter a -> b
foldr' :: (a -> b -> b) -> b -> SelectionFilter a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> SelectionFilter a -> b
foldr :: (a -> b -> b) -> b -> SelectionFilter a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> SelectionFilter a -> b
foldMap' :: (a -> m) -> SelectionFilter a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> SelectionFilter a -> m
foldMap :: (a -> m) -> SelectionFilter a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> SelectionFilter a -> m
fold :: SelectionFilter m -> m
$cfold :: forall m. Monoid m => SelectionFilter m -> m
Foldable, a -> SelectionFilter b -> SelectionFilter a
(a -> b) -> SelectionFilter a -> SelectionFilter b
(forall a b. (a -> b) -> SelectionFilter a -> SelectionFilter b)
-> (forall a b. a -> SelectionFilter b -> SelectionFilter a)
-> Functor SelectionFilter
forall a b. a -> SelectionFilter b -> SelectionFilter a
forall a b. (a -> b) -> SelectionFilter a -> SelectionFilter b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SelectionFilter b -> SelectionFilter a
$c<$ :: forall a b. a -> SelectionFilter b -> SelectionFilter a
fmap :: (a -> b) -> SelectionFilter a -> SelectionFilter b
$cfmap :: forall a b. (a -> b) -> SelectionFilter a -> SelectionFilter b
Functor, Int -> SelectionFilter asset -> ShowS
[SelectionFilter asset] -> ShowS
SelectionFilter asset -> String
(Int -> SelectionFilter asset -> ShowS)
-> (SelectionFilter asset -> String)
-> ([SelectionFilter asset] -> ShowS)
-> Show (SelectionFilter asset)
forall asset. Show asset => Int -> SelectionFilter asset -> ShowS
forall asset. Show asset => [SelectionFilter asset] -> ShowS
forall asset. Show asset => SelectionFilter asset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectionFilter asset] -> ShowS
$cshowList :: forall asset. Show asset => [SelectionFilter asset] -> ShowS
show :: SelectionFilter asset -> String
$cshow :: forall asset. Show asset => SelectionFilter asset -> String
showsPrec :: Int -> SelectionFilter asset -> ShowS
$cshowsPrec :: forall asset. Show asset => Int -> SelectionFilter asset -> ShowS
Show, Functor SelectionFilter
Foldable SelectionFilter
Functor SelectionFilter
-> Foldable SelectionFilter
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> SelectionFilter a -> f (SelectionFilter b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    SelectionFilter (f a) -> f (SelectionFilter a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> SelectionFilter a -> m (SelectionFilter b))
-> (forall (m :: * -> *) a.
    Monad m =>
    SelectionFilter (m a) -> m (SelectionFilter a))
-> Traversable SelectionFilter
(a -> f b) -> SelectionFilter a -> f (SelectionFilter b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
SelectionFilter (m a) -> m (SelectionFilter a)
forall (f :: * -> *) a.
Applicative f =>
SelectionFilter (f a) -> f (SelectionFilter a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SelectionFilter a -> m (SelectionFilter b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SelectionFilter a -> f (SelectionFilter b)
sequence :: SelectionFilter (m a) -> m (SelectionFilter a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
SelectionFilter (m a) -> m (SelectionFilter a)
mapM :: (a -> m b) -> SelectionFilter a -> m (SelectionFilter b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> SelectionFilter a -> m (SelectionFilter b)
sequenceA :: SelectionFilter (f a) -> f (SelectionFilter a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
SelectionFilter (f a) -> f (SelectionFilter a)
traverse :: (a -> f b) -> SelectionFilter a -> f (SelectionFilter b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> SelectionFilter a -> f (SelectionFilter b)
$cp2Traversable :: Foldable SelectionFilter
$cp1Traversable :: Functor SelectionFilter
Traversable)

-- | Selects an entry at random from the index according to the given filter.
--
-- Returns the selected entry and an updated index with the entry removed.
--
-- Returns 'Nothing' if there were no matching entries.
--
selectRandom
    :: forall m u. (MonadRandom m, Ord u)
    => UTxOIndex u
    -> SelectionFilter Asset
    -> m (Maybe ((u, TokenBundle), UTxOIndex u))
selectRandom :: UTxOIndex u
-> SelectionFilter Asset
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
selectRandom UTxOIndex u
i SelectionFilter Asset
selectionFilter =
    (u -> Maybe ((u, TokenBundle), UTxOIndex u)
lookupAndRemoveEntry (u -> Maybe ((u, TokenBundle), UTxOIndex u))
-> Maybe u -> Maybe ((u, TokenBundle), UTxOIndex u)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe u -> Maybe ((u, TokenBundle), UTxOIndex u))
-> m (Maybe u) -> m (Maybe ((u, TokenBundle), UTxOIndex u))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set u -> m (Maybe u)
forall (m :: * -> *) a. MonadRandom m => Set a -> m (Maybe a)
selectRandomSetMember Set u
selectionSet
  where
    lookupAndRemoveEntry :: u -> Maybe ((u, TokenBundle), UTxOIndex u)
    lookupAndRemoveEntry :: u -> Maybe ((u, TokenBundle), UTxOIndex u)
lookupAndRemoveEntry u
u =
        (\TokenBundle
b -> ((u
u, TokenBundle
b), u -> UTxOIndex u -> UTxOIndex u
forall u. Ord u => u -> UTxOIndex u -> UTxOIndex u
delete u
u UTxOIndex u
i)) (TokenBundle -> ((u, TokenBundle), UTxOIndex u))
-> Maybe TokenBundle -> Maybe ((u, TokenBundle), UTxOIndex u)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> Map u TokenBundle -> Maybe TokenBundle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup u
u (UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i)

    selectionSet :: Set u
    selectionSet :: Set u
selectionSet = case SelectionFilter Asset
selectionFilter of
        SelectSingleton Asset
a ->
            Asset
a Asset -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Set u
forall a k.
(Ord a, Ord k) =>
k -> (UTxOIndex u -> Map k (NonEmptySet a)) -> Set a
`lookupWith` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons
        SelectPairWith Asset
a ->
            Asset
a Asset -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Set u
forall a k.
(Ord a, Ord k) =>
k -> (UTxOIndex u -> Map k (NonEmptySet a)) -> Set a
`lookupWith` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs
        SelectAnyWith Asset
a ->
            Asset
a Asset -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Set u
forall a k.
(Ord a, Ord k) =>
k -> (UTxOIndex u -> Map k (NonEmptySet a)) -> Set a
`lookupWith` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll
        SelectionFilter Asset
SelectAny ->
            Map u TokenBundle -> Set u
forall k a. Map k a -> Set k
Map.keysSet (UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i)
      where
        k
a lookupWith :: k -> (UTxOIndex u -> Map k (NonEmptySet a)) -> Set a
`lookupWith` UTxOIndex u -> Map k (NonEmptySet a)
index =
            Set a -> (NonEmptySet a -> Set a) -> Maybe (NonEmptySet a) -> Set a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set a
forall a. Monoid a => a
mempty NonEmptySet a -> Set a
forall a. Ord a => NonEmptySet a -> Set a
NonEmptySet.toSet (Maybe (NonEmptySet a) -> Set a) -> Maybe (NonEmptySet a) -> Set a
forall a b. (a -> b) -> a -> b
$ k -> Map k (NonEmptySet a) -> Maybe (NonEmptySet a)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
a (Map k (NonEmptySet a) -> Maybe (NonEmptySet a))
-> Map k (NonEmptySet a) -> Maybe (NonEmptySet a)
forall a b. (a -> b) -> a -> b
$ UTxOIndex u -> Map k (NonEmptySet a)
index UTxOIndex u
i

-- | Selects an entry at random from the index according to the given filters.
--
-- This function traverses the specified list of filters in descending order of
-- priority, from left to right.
--
-- When considering a particular filter:
--
--    - if the function is able to select a UTxO entry that matches, it
--      terminates with that entry and an updated index with the entry removed.
--
--    - if the function is not able to select a UTxO entry that matches, it
--      traverses to the next filter available.
--
-- This function returns 'Nothing' if (and only if) it traverses the entire
-- list of filters without successfully selecting a UTxO entry.
--
selectRandomWithPriority
    :: (MonadRandom m, Ord u)
    => UTxOIndex u
    -> NonEmpty (SelectionFilter Asset)
    -- ^ A list of selection filters to be traversed in descending order of
    -- priority, from left to right.
    -> m (Maybe ((u, TokenBundle), UTxOIndex u))
selectRandomWithPriority :: UTxOIndex u
-> NonEmpty (SelectionFilter Asset)
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
selectRandomWithPriority UTxOIndex u
i =
    (SelectionFilter Asset
 -> m (Maybe ((u, TokenBundle), UTxOIndex u)))
-> [SelectionFilter Asset]
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM (UTxOIndex u
-> SelectionFilter Asset
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
forall (m :: * -> *) u.
(MonadRandom m, Ord u) =>
UTxOIndex u
-> SelectionFilter Asset
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
selectRandom UTxOIndex u
i) ([SelectionFilter Asset]
 -> m (Maybe ((u, TokenBundle), UTxOIndex u)))
-> (NonEmpty (SelectionFilter Asset) -> [SelectionFilter Asset])
-> NonEmpty (SelectionFilter Asset)
-> m (Maybe ((u, TokenBundle), UTxOIndex u))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (SelectionFilter Asset) -> [SelectionFilter Asset]
forall a. NonEmpty a -> [a]
NE.toList

--------------------------------------------------------------------------------
-- Internal Interface
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Assets
--------------------------------------------------------------------------------

-- | A type capable of representing any asset, including both ada and non-ada
--   assets.
--
-- TODO: ADP-1449
-- Move this type away from the 'UTxOIndex' module and replace all usages of it
-- with a type parameter.
--
data Asset
    = AssetLovelace
    | Asset AssetId
    deriving (Asset -> Asset -> Bool
(Asset -> Asset -> Bool) -> (Asset -> Asset -> Bool) -> Eq Asset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Asset -> Asset -> Bool
$c/= :: Asset -> Asset -> Bool
== :: Asset -> Asset -> Bool
$c== :: Asset -> Asset -> Bool
Eq, (forall x. Asset -> Rep Asset x)
-> (forall x. Rep Asset x -> Asset) -> Generic Asset
forall x. Rep Asset x -> Asset
forall x. Asset -> Rep Asset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Asset x -> Asset
$cfrom :: forall x. Asset -> Rep Asset x
Generic, Eq Asset
Eq Asset
-> (Asset -> Asset -> Ordering)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Bool)
-> (Asset -> Asset -> Asset)
-> (Asset -> Asset -> Asset)
-> Ord Asset
Asset -> Asset -> Bool
Asset -> Asset -> Ordering
Asset -> Asset -> Asset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Asset -> Asset -> Asset
$cmin :: Asset -> Asset -> Asset
max :: Asset -> Asset -> Asset
$cmax :: Asset -> Asset -> Asset
>= :: Asset -> Asset -> Bool
$c>= :: Asset -> Asset -> Bool
> :: Asset -> Asset -> Bool
$c> :: Asset -> Asset -> Bool
<= :: Asset -> Asset -> Bool
$c<= :: Asset -> Asset -> Bool
< :: Asset -> Asset -> Bool
$c< :: Asset -> Asset -> Bool
compare :: Asset -> Asset -> Ordering
$ccompare :: Asset -> Asset -> Ordering
$cp1Ord :: Eq Asset
Ord, ReadPrec [Asset]
ReadPrec Asset
Int -> ReadS Asset
ReadS [Asset]
(Int -> ReadS Asset)
-> ReadS [Asset]
-> ReadPrec Asset
-> ReadPrec [Asset]
-> Read Asset
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Asset]
$creadListPrec :: ReadPrec [Asset]
readPrec :: ReadPrec Asset
$creadPrec :: ReadPrec Asset
readList :: ReadS [Asset]
$creadList :: ReadS [Asset]
readsPrec :: Int -> ReadS Asset
$creadsPrec :: Int -> ReadS Asset
Read, Int -> Asset -> ShowS
[Asset] -> ShowS
Asset -> String
(Int -> Asset -> ShowS)
-> (Asset -> String) -> ([Asset] -> ShowS) -> Show Asset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Asset] -> ShowS
$cshowList :: [Asset] -> ShowS
show :: Asset -> String
$cshow :: Asset -> String
showsPrec :: Int -> Asset -> ShowS
$cshowsPrec :: Int -> Asset -> ShowS
Show)

deriving instance NFData Asset

-- | Returns the set of assets associated with a given 'TokenBundle'.
--
-- Both ada and non-ada assets are included in the set returned.
--
-- TODO: ADP-1449
-- Move this function away from the 'UTxOIndex' module once the type of assets
-- has been generalized.
--
tokenBundleAssets :: TokenBundle -> Set Asset
tokenBundleAssets :: TokenBundle -> Set Asset
tokenBundleAssets TokenBundle
b = Set Asset -> Set Asset -> Set Asset
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    ([Asset] -> Set Asset
forall a. Ord a => [a] -> Set a
Set.fromList [Asset
AssetLovelace | TokenBundle -> Coin
TokenBundle.coin TokenBundle
b Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
forall a. Monoid a => a
mempty])
    ((AssetId -> Asset) -> Set AssetId -> Set Asset
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map AssetId -> Asset
Asset (TokenBundle -> Set AssetId
TokenBundle.getAssets TokenBundle
b))

-- | Returns the number of assets associated with a given 'TokenBundle'.
--
-- Both ada and non-ada assets are included in the total count returned.
--
-- TODO: ADP-1449
-- Move this function away from the 'UTxOIndex' module once the type of assets
-- has been generalized.
--
tokenBundleAssetCount :: TokenBundle -> Int
tokenBundleAssetCount :: TokenBundle -> Int
tokenBundleAssetCount TokenBundle
b = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
    (if TokenBundle -> Coin
TokenBundle.coin TokenBundle
b Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
forall a. Monoid a => a
mempty then Int
1 else Int
0)
    (TokenMap -> Int
TokenMap.size (TokenBundle -> TokenMap
TokenBundle.tokens TokenBundle
b))

-- | Indicates whether or not a given bundle includes a given asset.
--
-- Both ada and non-ada assets can be queried.
--
-- TODO: ADP-1449
-- Move this function away from the 'UTxOIndex' module once the type of assets
-- has been generalized.
--
tokenBundleHasAsset :: TokenBundle -> Asset -> Bool
tokenBundleHasAsset :: TokenBundle -> Asset -> Bool
tokenBundleHasAsset TokenBundle
b = \case
    Asset
AssetLovelace -> TokenBundle -> Coin
TokenBundle.coin TokenBundle
b Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
/= Coin
forall a. Monoid a => a
mempty
    Asset AssetId
assetId -> TokenBundle -> AssetId -> Bool
TokenBundle.hasQuantity TokenBundle
b AssetId
assetId

--------------------------------------------------------------------------------
-- Utilities
--------------------------------------------------------------------------------

-- | Represents different categories of token bundles.
--
data BundleCategory asset
    = BundleWithNoAssets
    | BundleWithOneAsset asset
    | BundleWithTwoAssets (asset, asset)
    | BundleWithMultipleAssets (Set asset)
    deriving (BundleCategory asset -> BundleCategory asset -> Bool
(BundleCategory asset -> BundleCategory asset -> Bool)
-> (BundleCategory asset -> BundleCategory asset -> Bool)
-> Eq (BundleCategory asset)
forall asset.
Eq asset =>
BundleCategory asset -> BundleCategory asset -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BundleCategory asset -> BundleCategory asset -> Bool
$c/= :: forall asset.
Eq asset =>
BundleCategory asset -> BundleCategory asset -> Bool
== :: BundleCategory asset -> BundleCategory asset -> Bool
$c== :: forall asset.
Eq asset =>
BundleCategory asset -> BundleCategory asset -> Bool
Eq, Int -> BundleCategory asset -> ShowS
[BundleCategory asset] -> ShowS
BundleCategory asset -> String
(Int -> BundleCategory asset -> ShowS)
-> (BundleCategory asset -> String)
-> ([BundleCategory asset] -> ShowS)
-> Show (BundleCategory asset)
forall asset. Show asset => Int -> BundleCategory asset -> ShowS
forall asset. Show asset => [BundleCategory asset] -> ShowS
forall asset. Show asset => BundleCategory asset -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BundleCategory asset] -> ShowS
$cshowList :: forall asset. Show asset => [BundleCategory asset] -> ShowS
show :: BundleCategory asset -> String
$cshow :: forall asset. Show asset => BundleCategory asset -> String
showsPrec :: Int -> BundleCategory asset -> ShowS
$cshowsPrec :: forall asset. Show asset => Int -> BundleCategory asset -> ShowS
Show)

-- | Categorizes a token bundle by how many assets it contains.
--
categorizeTokenBundle :: TokenBundle -> BundleCategory Asset
categorizeTokenBundle :: TokenBundle -> BundleCategory Asset
categorizeTokenBundle TokenBundle
b = case Set Asset -> [Asset]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Set Asset
bundleAssets of
    [      ] -> BundleCategory Asset
forall asset. BundleCategory asset
BundleWithNoAssets
    [Asset
a     ] -> Asset -> BundleCategory Asset
forall asset. asset -> BundleCategory asset
BundleWithOneAsset Asset
a
    [Asset
a1, Asset
a2] -> (Asset, Asset) -> BundleCategory Asset
forall asset. (asset, asset) -> BundleCategory asset
BundleWithTwoAssets (Asset
a1, Asset
a2)
    [Asset]
_        -> Set Asset -> BundleCategory Asset
forall asset. Set asset -> BundleCategory asset
BundleWithMultipleAssets Set Asset
bundleAssets
  where
    bundleAssets :: Set Asset
bundleAssets = TokenBundle -> Set Asset
tokenBundleAssets TokenBundle
b

-- Inserts an entry, but without checking the following pre-condition:
--
-- Pre-condition: there is no existing entry for the specified UTxO identifier.
--
-- See 'insert' for a safe version of this function.
--
insertUnsafe
    :: forall u. Ord u
    => u
    -> TokenBundle
    -> UTxOIndex u
    -> UTxOIndex u
insertUnsafe :: u -> TokenBundle -> UTxOIndex u -> UTxOIndex u
insertUnsafe u
u TokenBundle
b UTxOIndex u
i = UTxOIndex u
i
    UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& ((TokenBundle -> Identity TokenBundle)
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (TokenBundle -> TokenBundle) -> UTxOIndex u -> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "balance"
  ((TokenBundle -> Identity TokenBundle)
   -> UTxOIndex u -> Identity (UTxOIndex u))
(TokenBundle -> Identity TokenBundle)
-> UTxOIndex u -> Identity (UTxOIndex u)
#balance (TokenBundle -> TokenBundle -> TokenBundle
`TokenBundle.add` TokenBundle
b)
    UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& ((Map u TokenBundle -> Identity (Map u TokenBundle))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map u TokenBundle -> Map u TokenBundle)
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "universe"
  ((Map u TokenBundle -> Identity (Map u TokenBundle))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map u TokenBundle -> Identity (Map u TokenBundle))
-> UTxOIndex u -> Identity (UTxOIndex u)
#universe (u -> TokenBundle -> Map u TokenBundle -> Map u TokenBundle
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert u
u TokenBundle
b)
    UTxOIndex u -> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u
forall a b. a -> (a -> b) -> b
& case TokenBundle -> BundleCategory Asset
categorizeTokenBundle TokenBundle
b of
        BundleCategory Asset
BundleWithNoAssets -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
        BundleWithOneAsset Asset
a -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a)
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexSingletons"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexSingletons (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a)
        BundleWithTwoAssets (Asset
a1, Asset
a2) -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a1)
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a2)
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexPairs"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexPairs (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a1)
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexPairs"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexPairs (Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
`insertEntry` Asset
a2)
        BundleWithMultipleAssets Set Asset
as -> UTxOIndex u -> UTxOIndex u
forall a. a -> a
id
            (UTxOIndex u -> UTxOIndex u)
-> (UTxOIndex u -> UTxOIndex u) -> UTxOIndex u -> UTxOIndex u
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Map Asset (NonEmptySet u)
  -> Identity (Map Asset (NonEmptySet u)))
 -> UTxOIndex u -> Identity (UTxOIndex u))
-> (Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u))
-> UTxOIndex u
-> UTxOIndex u
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "indexAll"
  ((Map Asset (NonEmptySet u)
    -> Identity (Map Asset (NonEmptySet u)))
   -> UTxOIndex u -> Identity (UTxOIndex u))
(Map Asset (NonEmptySet u) -> Identity (Map Asset (NonEmptySet u)))
-> UTxOIndex u -> Identity (UTxOIndex u)
#indexAll ((Map Asset (NonEmptySet u)
 -> Set Asset -> Map Asset (NonEmptySet u))
-> Set Asset
-> Map Asset (NonEmptySet u)
-> Map Asset (NonEmptySet u)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u))
-> Map Asset (NonEmptySet u)
-> Set Asset
-> Map Asset (NonEmptySet u)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Map Asset (NonEmptySet u) -> Asset -> Map Asset (NonEmptySet u)
forall asset.
Ord asset =>
Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
insertEntry) Set Asset
as)
  where
    insertEntry
        :: Ord asset
        => Map asset (NonEmptySet u)
        -> asset
        -> Map asset (NonEmptySet u)
    insertEntry :: Map asset (NonEmptySet u) -> asset -> Map asset (NonEmptySet u)
insertEntry Map asset (NonEmptySet u)
m asset
a =
        (Maybe (NonEmptySet u) -> Maybe (NonEmptySet u))
-> asset -> Map asset (NonEmptySet u) -> Map asset (NonEmptySet u)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Maybe (NonEmptySet u)
-> (NonEmptySet u -> Maybe (NonEmptySet u))
-> Maybe (NonEmptySet u)
-> Maybe (NonEmptySet u)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NonEmptySet u -> Maybe (NonEmptySet u)
forall a. a -> Maybe a
Just NonEmptySet u
createNew) (NonEmptySet u -> Maybe (NonEmptySet u)
forall a. a -> Maybe a
Just (NonEmptySet u -> Maybe (NonEmptySet u))
-> (NonEmptySet u -> NonEmptySet u)
-> NonEmptySet u
-> Maybe (NonEmptySet u)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptySet u -> NonEmptySet u
updateOld)) asset
a Map asset (NonEmptySet u)
m
      where
        createNew :: NonEmptySet u
createNew = u -> NonEmptySet u
forall a. Ord a => a -> NonEmptySet a
NonEmptySet.singleton u
u
        updateOld :: NonEmptySet u -> NonEmptySet u
updateOld = u -> NonEmptySet u -> NonEmptySet u
forall a. Ord a => a -> NonEmptySet a -> NonEmptySet a
NonEmptySet.insert u
u

-- | Selects an element at random from the given set.
--
-- Returns 'Nothing' if (and only if) the given set is empty.
--
selectRandomSetMember
    :: MonadRandom m
    => Set a
    -> m (Maybe a)
selectRandomSetMember :: Set a -> m (Maybe a)
selectRandomSetMember Set a
s
    | Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s =
        Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise =
        a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Int -> a) -> Int -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Set a -> a) -> Set a -> Int -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Set a -> a
forall a. Int -> Set a -> a
Set.elemAt Set a
s (Int -> Maybe a) -> m Int -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> m Int
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, Set a -> Int
forall a. Set a -> Int
Set.size Set a
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

--------------------------------------------------------------------------------
-- Invariant
--------------------------------------------------------------------------------

-- | The result of checking the invariant with the 'checkInvariant' function.
--
data InvariantStatus
    = InvariantHolds
      -- ^ Indicates a successful check of the invariant.
    | InvariantBalanceError BalanceError
      -- ^ Indicates that the cached 'balance' value is incorrect.
    | InvariantIndexIncomplete
      -- ^ Indicates that the 'index' is missing one or more entries.
    | InvariantIndexNonMinimal
      -- ^ Indicates that the 'index' has one or more unnecessary entries.
    | InvariantIndexInconsistent
      -- ^ Indicates that the index sets are not consistent.
    | InvariantAssetsInconsistent
      -- ^ Indicates that the 'index' and the cached 'balance' value disagree
      --   about which assets are included.
    deriving (InvariantStatus -> InvariantStatus -> Bool
(InvariantStatus -> InvariantStatus -> Bool)
-> (InvariantStatus -> InvariantStatus -> Bool)
-> Eq InvariantStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvariantStatus -> InvariantStatus -> Bool
$c/= :: InvariantStatus -> InvariantStatus -> Bool
== :: InvariantStatus -> InvariantStatus -> Bool
$c== :: InvariantStatus -> InvariantStatus -> Bool
Eq, Int -> InvariantStatus -> ShowS
[InvariantStatus] -> ShowS
InvariantStatus -> String
(Int -> InvariantStatus -> ShowS)
-> (InvariantStatus -> String)
-> ([InvariantStatus] -> ShowS)
-> Show InvariantStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvariantStatus] -> ShowS
$cshowList :: [InvariantStatus] -> ShowS
show :: InvariantStatus -> String
$cshow :: InvariantStatus -> String
showsPrec :: Int -> InvariantStatus -> ShowS
$cshowsPrec :: Int -> InvariantStatus -> ShowS
Show)

-- | Checks whether or not the invariant holds.
--
checkInvariant :: Ord u => UTxOIndex u -> InvariantStatus
checkInvariant :: UTxOIndex u -> InvariantStatus
checkInvariant UTxOIndex u
i
    | BalanceStatus
balanceStatus BalanceStatus -> BalanceStatus -> Bool
forall a. Eq a => a -> a -> Bool
/= BalanceStatus
BalanceCorrect =
        BalanceError -> InvariantStatus
InvariantBalanceError BalanceError
balanceError
    | Bool -> Bool
not (UTxOIndex u -> Bool
forall u. Ord u => UTxOIndex u -> Bool
indexIsComplete UTxOIndex u
i) =
        InvariantStatus
InvariantIndexIncomplete
    | Bool -> Bool
not (UTxOIndex u -> Bool
forall u. Ord u => UTxOIndex u -> Bool
indexIsMinimal UTxOIndex u
i) =
        InvariantStatus
InvariantIndexNonMinimal
    | Bool -> Bool
not (UTxOIndex u -> Bool
forall u. Ord u => UTxOIndex u -> Bool
indexIsConsistent UTxOIndex u
i) =
        InvariantStatus
InvariantIndexInconsistent
    | Bool -> Bool
not (UTxOIndex u -> Bool
forall u. UTxOIndex u -> Bool
assetsConsistent UTxOIndex u
i) =
        InvariantStatus
InvariantAssetsInconsistent
    | Bool
otherwise =
        InvariantStatus
InvariantHolds
  where
    balanceStatus :: BalanceStatus
balanceStatus = UTxOIndex u -> BalanceStatus
forall u. UTxOIndex u -> BalanceStatus
checkBalance UTxOIndex u
i
    BalanceIncorrect BalanceError
balanceError = BalanceStatus
balanceStatus

-- | Indicates whether on not the stored 'balance' value is correct.
--
data BalanceStatus
    = BalanceCorrect
    | BalanceIncorrect BalanceError
    deriving (BalanceStatus -> BalanceStatus -> Bool
(BalanceStatus -> BalanceStatus -> Bool)
-> (BalanceStatus -> BalanceStatus -> Bool) -> Eq BalanceStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalanceStatus -> BalanceStatus -> Bool
$c/= :: BalanceStatus -> BalanceStatus -> Bool
== :: BalanceStatus -> BalanceStatus -> Bool
$c== :: BalanceStatus -> BalanceStatus -> Bool
Eq, Int -> BalanceStatus -> ShowS
[BalanceStatus] -> ShowS
BalanceStatus -> String
(Int -> BalanceStatus -> ShowS)
-> (BalanceStatus -> String)
-> ([BalanceStatus] -> ShowS)
-> Show BalanceStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceStatus] -> ShowS
$cshowList :: [BalanceStatus] -> ShowS
show :: BalanceStatus -> String
$cshow :: BalanceStatus -> String
showsPrec :: Int -> BalanceStatus -> ShowS
$cshowsPrec :: Int -> BalanceStatus -> ShowS
Show)

-- | Indicates that the stored 'balance' value is not correct.
--
data BalanceError = BalanceError
    { BalanceError -> TokenBundle
balanceComputed
        :: TokenBundle
    , BalanceError -> TokenBundle
balanceStored
        :: TokenBundle
    }
    deriving (BalanceError -> BalanceError -> Bool
(BalanceError -> BalanceError -> Bool)
-> (BalanceError -> BalanceError -> Bool) -> Eq BalanceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalanceError -> BalanceError -> Bool
$c/= :: BalanceError -> BalanceError -> Bool
== :: BalanceError -> BalanceError -> Bool
$c== :: BalanceError -> BalanceError -> Bool
Eq, Int -> BalanceError -> ShowS
[BalanceError] -> ShowS
BalanceError -> String
(Int -> BalanceError -> ShowS)
-> (BalanceError -> String)
-> ([BalanceError] -> ShowS)
-> Show BalanceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceError] -> ShowS
$cshowList :: [BalanceError] -> ShowS
show :: BalanceError -> String
$cshow :: BalanceError -> String
showsPrec :: Int -> BalanceError -> ShowS
$cshowsPrec :: Int -> BalanceError -> ShowS
Show)

-- | Checks that calculating the balance from scratch gives a result that
--   is equal to the stored 'balance' value.
--
checkBalance :: UTxOIndex u -> BalanceStatus
checkBalance :: UTxOIndex u -> BalanceStatus
checkBalance UTxOIndex u
i
    | TokenBundle
balanceComputed TokenBundle -> TokenBundle -> Bool
forall a. Eq a => a -> a -> Bool
== TokenBundle
balanceStored =
        BalanceStatus
BalanceCorrect
    | Bool
otherwise =
        BalanceError -> BalanceStatus
BalanceIncorrect (BalanceError -> BalanceStatus) -> BalanceError -> BalanceStatus
forall a b. (a -> b) -> a -> b
$ BalanceError :: TokenBundle -> TokenBundle -> BalanceError
BalanceError {TokenBundle
balanceComputed :: TokenBundle
balanceComputed :: TokenBundle
balanceComputed, TokenBundle
balanceStored :: TokenBundle
balanceStored :: TokenBundle
balanceStored}
  where
    balanceComputed :: TokenBundle
balanceComputed = Map u TokenBundle -> TokenBundle
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i)
    balanceStored :: TokenBundle
balanceStored = UTxOIndex u -> TokenBundle
forall u. UTxOIndex u -> TokenBundle
balance UTxOIndex u
i

-- | Checks that every entry in the 'universe' map is properly indexed.
--
indexIsComplete :: forall u. Ord u => UTxOIndex u -> Bool
indexIsComplete :: UTxOIndex u -> Bool
indexIsComplete UTxOIndex u
i =
    ((u, TokenBundle) -> Bool) -> [(u, TokenBundle)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (u, TokenBundle) -> Bool
hasEntry ([(u, TokenBundle)] -> Bool) -> [(u, TokenBundle)] -> Bool
forall a b. (a -> b) -> a -> b
$ Map u TokenBundle -> [(u, TokenBundle)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map u TokenBundle -> [(u, TokenBundle)])
-> Map u TokenBundle -> [(u, TokenBundle)]
forall a b. (a -> b) -> a -> b
$ UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i
  where
    hasEntry :: (u, TokenBundle) -> Bool
    hasEntry :: (u, TokenBundle) -> Bool
hasEntry (u
u, TokenBundle
b) = case TokenBundle -> BundleCategory Asset
categorizeTokenBundle TokenBundle
b of
        BundleCategory Asset
BundleWithNoAssets ->
            Bool
True
        BundleWithOneAsset Asset
a -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll
            , Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons
            ]
        BundleWithTwoAssets (Asset
a1, Asset
a2) -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
            [ Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a1 u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll
            , Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a2 u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll
            , Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a1 u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs
            , Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a2 u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs
            ]
        BundleWithMultipleAssets Set Asset
as ->
            (Asset -> Bool) -> Set Asset -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\Asset
a -> Asset -> u -> (UTxOIndex u -> Map Asset (NonEmptySet u)) -> Bool
forall asset.
Ord asset =>
asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset Asset
a u
u UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll) Set Asset
as

    hasEntryForAsset
        :: Ord asset
        => asset
        -> u
        -> (UTxOIndex u -> Map asset (NonEmptySet u))
        -> Bool
    hasEntryForAsset :: asset -> u -> (UTxOIndex u -> Map asset (NonEmptySet u)) -> Bool
hasEntryForAsset asset
asset u
u UTxOIndex u -> Map asset (NonEmptySet u)
assetsMap =
        Bool -> (NonEmptySet u -> Bool) -> Maybe (NonEmptySet u) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (u -> NonEmptySet u -> Bool
forall a. Ord a => a -> NonEmptySet a -> Bool
NonEmptySet.member u
u) (Maybe (NonEmptySet u) -> Bool) -> Maybe (NonEmptySet u) -> Bool
forall a b. (a -> b) -> a -> b
$ asset -> Map asset (NonEmptySet u) -> Maybe (NonEmptySet u)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup asset
asset (Map asset (NonEmptySet u) -> Maybe (NonEmptySet u))
-> Map asset (NonEmptySet u) -> Maybe (NonEmptySet u)
forall a b. (a -> b) -> a -> b
$ UTxOIndex u -> Map asset (NonEmptySet u)
assetsMap UTxOIndex u
i

-- | Checks that every indexed entry is required by some entry in the 'universe'
--   map.
--
indexIsMinimal :: forall u. Ord u => UTxOIndex u -> Bool
indexIsMinimal :: UTxOIndex u -> Bool
indexIsMinimal UTxOIndex u
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and
    [ UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll UTxOIndex u
i
        Map Asset (NonEmptySet u)
-> (Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)])
-> [(Asset, NonEmptySet u)]
forall a b. a -> (a -> b) -> b
& Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Asset, NonEmptySet u)]
-> ([(Asset, NonEmptySet u)] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& ((Asset, NonEmptySet u) -> Bool)
-> [(Asset, NonEmptySet u)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\(Asset
a, NonEmptySet u
u) -> (u -> Bool) -> NonEmptySet u -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (Asset -> u -> Bool
entryHasAsset Asset
a) NonEmptySet u
u)
    , UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons UTxOIndex u
i
        Map Asset (NonEmptySet u)
-> (Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)])
-> [(Asset, NonEmptySet u)]
forall a b. a -> (a -> b) -> b
& Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Asset, NonEmptySet u)]
-> ([(Asset, NonEmptySet u)] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& ((Asset, NonEmptySet u) -> Bool)
-> [(Asset, NonEmptySet u)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\(Asset
a, NonEmptySet u
u) -> (u -> Bool) -> NonEmptySet u -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (Asset -> u -> Bool
entryHasOneAsset Asset
a) NonEmptySet u
u)
    , UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs UTxOIndex u
i
        Map Asset (NonEmptySet u)
-> (Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)])
-> [(Asset, NonEmptySet u)]
forall a b. a -> (a -> b) -> b
& Map Asset (NonEmptySet u) -> [(Asset, NonEmptySet u)]
forall k a. Map k a -> [(k, a)]
Map.toList
        [(Asset, NonEmptySet u)]
-> ([(Asset, NonEmptySet u)] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& ((Asset, NonEmptySet u) -> Bool)
-> [(Asset, NonEmptySet u)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (\(Asset
a, NonEmptySet u
u) -> (u -> Bool) -> NonEmptySet u -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all (Asset -> u -> Bool
entryHasTwoAssetsWith Asset
a) NonEmptySet u
u)
    ]
  where
    entryHasAsset :: Asset -> u -> Bool
    entryHasAsset :: Asset -> u -> Bool
entryHasAsset Asset
a = (TokenBundle -> Bool) -> u -> Bool
entryMatches (TokenBundle -> Asset -> Bool
`tokenBundleHasAsset` Asset
a)

    entryHasOneAsset :: Asset -> u -> Bool
    entryHasOneAsset :: Asset -> u -> Bool
entryHasOneAsset Asset
a = (TokenBundle -> Bool) -> u -> Bool
entryMatches ((TokenBundle -> Bool) -> u -> Bool)
-> (TokenBundle -> Bool) -> u -> Bool
forall a b. (a -> b) -> a -> b
$ \TokenBundle
b -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ TokenBundle
b TokenBundle -> Asset -> Bool
`tokenBundleHasAsset` Asset
a
        , TokenBundle -> Int
tokenBundleAssetCount TokenBundle
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        ]

    entryHasTwoAssetsWith :: Asset -> u -> Bool
    entryHasTwoAssetsWith :: Asset -> u -> Bool
entryHasTwoAssetsWith Asset
a = (TokenBundle -> Bool) -> u -> Bool
entryMatches ((TokenBundle -> Bool) -> u -> Bool)
-> (TokenBundle -> Bool) -> u -> Bool
forall a b. (a -> b) -> a -> b
$ \TokenBundle
b -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
        [ TokenBundle
b TokenBundle -> Asset -> Bool
`tokenBundleHasAsset` Asset
a
        , TokenBundle -> Int
tokenBundleAssetCount TokenBundle
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
        ]

    entryMatches :: (TokenBundle -> Bool) -> u -> Bool
    entryMatches :: (TokenBundle -> Bool) -> u -> Bool
entryMatches TokenBundle -> Bool
test u
u = Bool -> (TokenBundle -> Bool) -> Maybe TokenBundle -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TokenBundle -> Bool
test (Maybe TokenBundle -> Bool) -> Maybe TokenBundle -> Bool
forall a b. (a -> b) -> a -> b
$ u -> Map u TokenBundle -> Maybe TokenBundle
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup u
u (Map u TokenBundle -> Maybe TokenBundle)
-> Map u TokenBundle -> Maybe TokenBundle
forall a b. (a -> b) -> a -> b
$ UTxOIndex u -> Map u TokenBundle
forall u. UTxOIndex u -> Map u TokenBundle
universe UTxOIndex u
i

-- | Checks that index set relationships are correct.
--
indexIsConsistent :: Ord u => UTxOIndex u -> Bool
indexIsConsistent :: UTxOIndex u -> Bool
indexIsConsistent UTxOIndex u
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and
    [ UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons UTxOIndex u
i
        Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u) -> Bool
forall u a.
Ord u =>
Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
`isDisjointTo` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs UTxOIndex u
i
    , UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons UTxOIndex u
i
        Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u) -> Bool
forall a u.
(Ord a, Ord u) =>
Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
`isSubmapOf` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll UTxOIndex u
i
    , UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs UTxOIndex u
i
        Map Asset (NonEmptySet u) -> Map Asset (NonEmptySet u) -> Bool
forall a u.
(Ord a, Ord u) =>
Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
`isSubmapOf` UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll UTxOIndex u
i
    ]
  where
    isDisjointTo
        :: Ord u
        => Map a (NonEmptySet u)
        -> Map a (NonEmptySet u)
        -> Bool
    isDisjointTo :: Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
isDisjointTo Map a (NonEmptySet u)
m1 Map a (NonEmptySet u)
m2 = Set u
s1 Set u -> Set u -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.disjoint` Set u
s2
      where
        s1 :: Set u
s1 = (NonEmptySet u -> Set u) -> Map a (NonEmptySet u) -> Set u
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap NonEmptySet u -> Set u
forall a. Ord a => NonEmptySet a -> Set a
NonEmptySet.toSet Map a (NonEmptySet u)
m1
        s2 :: Set u
s2 = (NonEmptySet u -> Set u) -> Map a (NonEmptySet u) -> Set u
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap NonEmptySet u -> Set u
forall a. Ord a => NonEmptySet a -> Set a
NonEmptySet.toSet Map a (NonEmptySet u)
m2

    isSubmapOf
        :: (Ord a, Ord u)
        => Map a (NonEmptySet u)
        -> Map a (NonEmptySet u)
        -> Bool
    isSubmapOf :: Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
isSubmapOf Map a (NonEmptySet u)
m1 Map a (NonEmptySet u)
m2 = (NonEmptySet u -> NonEmptySet u -> Bool)
-> Map a (NonEmptySet u) -> Map a (NonEmptySet u) -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy NonEmptySet u -> NonEmptySet u -> Bool
forall a. Ord a => NonEmptySet a -> NonEmptySet a -> Bool
isNonEmptySubsetOf Map a (NonEmptySet u)
m1 Map a (NonEmptySet u)
m2
      where
        isNonEmptySubsetOf :: NonEmptySet a -> NonEmptySet a -> Bool
isNonEmptySubsetOf NonEmptySet a
s1 NonEmptySet a
s2 =
            NonEmptySet a -> Set a
forall a. Ord a => NonEmptySet a -> Set a
NonEmptySet.toSet NonEmptySet a
s1 Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` NonEmptySet a -> Set a
forall a. Ord a => NonEmptySet a -> Set a
NonEmptySet.toSet NonEmptySet a
s2

-- | Checks that the asset sets are consistent.
--
-- In particular, the set of assets in the cached 'balance' must be:
--
--    - equal to the set of assets in 'indexAll'
--    - a superset of the set of assets in 'indexSingletons'.
--    - a superset of the set of assets in 'indexPairs'.
--
assetsConsistent :: UTxOIndex u -> Bool
assetsConsistent :: UTxOIndex u -> Bool
assetsConsistent UTxOIndex u
i = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    [ Map Asset (NonEmptySet u) -> Set Asset
forall k a. Map k a -> Set k
Map.keysSet (UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexAll UTxOIndex u
i)
        Set Asset -> Set Asset -> Bool
forall a. Eq a => a -> a -> Bool
== Set Asset
balanceAssets
    , Map Asset (NonEmptySet u) -> Set Asset
forall k a. Map k a -> Set k
Map.keysSet (UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexSingletons UTxOIndex u
i)
        Set Asset -> Set Asset -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Asset
balanceAssets
    , Map Asset (NonEmptySet u) -> Set Asset
forall k a. Map k a -> Set k
Map.keysSet (UTxOIndex u -> Map Asset (NonEmptySet u)
forall u. UTxOIndex u -> Map Asset (NonEmptySet u)
indexPairs UTxOIndex u
i)
        Set Asset -> Set Asset -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set Asset
balanceAssets
    ]
  where
    balanceAssets :: Set Asset
balanceAssets = TokenBundle -> Set Asset
tokenBundleAssets (UTxOIndex u -> TokenBundle
forall u. UTxOIndex u -> TokenBundle
balance UTxOIndex u
i)