{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- This module provides the main 'UTxO' data type used by the wallet.
--
module Cardano.Wallet.Primitive.Types.UTxO
    (
    -- * UTxO
      UTxO (..)

    , dom
    , null
    , size
    , balance
    , isSubsetOf
    , empty
    , disjoint
    , excluding
    , restrictedBy
    , restrictedTo
    , difference
    , partition
    , lookup
    , filter
    , filterByAddressM
    , filterByAddress
    , toList

    -- * UTxO delta encoding
    , DeltaUTxO
    , excluded
    , received
    , excludingD
    , receiveD

    -- * Queries
    , assetIds
    , txIds

    -- * Transformations
    , mapAssetIds
    , mapTxIds
    , removeAssetId

    -- * UTxO Statistics
    , UTxOStatistics (..)
    , BoundType
    , HistogramBar (..)

    , computeStatistics
    , computeUtxoStatistics
    , log10
    ) where

import Prelude hiding
    ( filter, lookup, null )

import Cardano.Wallet.Primitive.Types.Address
    ( Address )
import Cardano.Wallet.Primitive.Types.Hash
    ( Hash )
import Cardano.Wallet.Primitive.Types.TokenBundle
    ( TokenBundle )
import Cardano.Wallet.Primitive.Types.TokenMap
    ( AssetId )
import Cardano.Wallet.Primitive.Types.Tx
    ( TxIn
    , TxOut (..)
    , txOutAssetIds
    , txOutCoin
    , txOutMapAssetIds
    , txOutRemoveAssetId
    )
import Control.DeepSeq
    ( NFData (..) )
import Data.Bifunctor
    ( bimap, first )
import Data.Delta
    ( Delta (..) )
import Data.Functor.Identity
    ( runIdentity )
import Data.Generics.Internal.VL.Lens
    ( over, view )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map.Strict
    ( Map )
import Data.Set
    ( Set )
import Data.Word
    ( Word64 )
import Fmt
    ( Buildable (..), blockListF', blockMapF, padRightF, tupleF )
import GHC.Generics
    ( Generic )

import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TB
import qualified Control.Foldl 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

--------------------------------------------------------------------------------
-- UTxO
--------------------------------------------------------------------------------

newtype UTxO = UTxO { UTxO -> Map TxIn TxOut
unUTxO :: Map TxIn TxOut }
    deriving stock (Int -> UTxO -> ShowS
[UTxO] -> ShowS
UTxO -> String
(Int -> UTxO -> ShowS)
-> (UTxO -> String) -> ([UTxO] -> ShowS) -> Show UTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxO] -> ShowS
$cshowList :: [UTxO] -> ShowS
show :: UTxO -> String
$cshow :: UTxO -> String
showsPrec :: Int -> UTxO -> ShowS
$cshowsPrec :: Int -> UTxO -> ShowS
Show, (forall x. UTxO -> Rep UTxO x)
-> (forall x. Rep UTxO x -> UTxO) -> Generic UTxO
forall x. Rep UTxO x -> UTxO
forall x. UTxO -> Rep UTxO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UTxO x -> UTxO
$cfrom :: forall x. UTxO -> Rep UTxO x
Generic, UTxO -> UTxO -> Bool
(UTxO -> UTxO -> Bool) -> (UTxO -> UTxO -> Bool) -> Eq UTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UTxO -> UTxO -> Bool
$c/= :: UTxO -> UTxO -> Bool
== :: UTxO -> UTxO -> Bool
$c== :: UTxO -> UTxO -> Bool
Eq, Eq UTxO
Eq UTxO
-> (UTxO -> UTxO -> Ordering)
-> (UTxO -> UTxO -> Bool)
-> (UTxO -> UTxO -> Bool)
-> (UTxO -> UTxO -> Bool)
-> (UTxO -> UTxO -> Bool)
-> (UTxO -> UTxO -> UTxO)
-> (UTxO -> UTxO -> UTxO)
-> Ord UTxO
UTxO -> UTxO -> Bool
UTxO -> UTxO -> Ordering
UTxO -> UTxO -> UTxO
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 :: UTxO -> UTxO -> UTxO
$cmin :: UTxO -> UTxO -> UTxO
max :: UTxO -> UTxO -> UTxO
$cmax :: UTxO -> UTxO -> UTxO
>= :: UTxO -> UTxO -> Bool
$c>= :: UTxO -> UTxO -> Bool
> :: UTxO -> UTxO -> Bool
$c> :: UTxO -> UTxO -> Bool
<= :: UTxO -> UTxO -> Bool
$c<= :: UTxO -> UTxO -> Bool
< :: UTxO -> UTxO -> Bool
$c< :: UTxO -> UTxO -> Bool
compare :: UTxO -> UTxO -> Ordering
$ccompare :: UTxO -> UTxO -> Ordering
$cp1Ord :: Eq UTxO
Ord)
    deriving newtype (b -> UTxO -> UTxO
NonEmpty UTxO -> UTxO
UTxO -> UTxO -> UTxO
(UTxO -> UTxO -> UTxO)
-> (NonEmpty UTxO -> UTxO)
-> (forall b. Integral b => b -> UTxO -> UTxO)
-> Semigroup UTxO
forall b. Integral b => b -> UTxO -> UTxO
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> UTxO -> UTxO
$cstimes :: forall b. Integral b => b -> UTxO -> UTxO
sconcat :: NonEmpty UTxO -> UTxO
$csconcat :: NonEmpty UTxO -> UTxO
<> :: UTxO -> UTxO -> UTxO
$c<> :: UTxO -> UTxO -> UTxO
Semigroup, Semigroup UTxO
UTxO
Semigroup UTxO
-> UTxO
-> (UTxO -> UTxO -> UTxO)
-> ([UTxO] -> UTxO)
-> Monoid UTxO
[UTxO] -> UTxO
UTxO -> UTxO -> UTxO
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [UTxO] -> UTxO
$cmconcat :: [UTxO] -> UTxO
mappend :: UTxO -> UTxO -> UTxO
$cmappend :: UTxO -> UTxO -> UTxO
mempty :: UTxO
$cmempty :: UTxO
$cp1Monoid :: Semigroup UTxO
Monoid)

instance NFData UTxO

instance Buildable UTxO where
    build :: UTxO -> Builder
build (UTxO Map TxIn TxOut
utxo) =
        Text -> ((TxIn, TxOut) -> Builder) -> [(TxIn, TxOut)] -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"-" (TxIn, TxOut) -> Builder
utxoF (Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList Map TxIn TxOut
utxo)
      where
        utxoF :: (TxIn, TxOut) -> Builder
utxoF (TxIn
inp, TxOut
out) = [(String, Builder)] -> Builder
buildMap
            [ (String
"input"
              , TxIn -> Builder
forall p. Buildable p => p -> Builder
build TxIn
inp)
            , (String
"output"
              , TxOut -> Builder
forall p. Buildable p => p -> Builder
build TxOut
out)
            ]
        buildMap :: [(String, Builder)] -> Builder
buildMap = [(String, Builder)] -> Builder
forall t k v.
(IsList t, Item t ~ (k, v), Buildable k, Buildable v) =>
t -> Builder
blockMapF ([(String, Builder)] -> Builder)
-> ([(String, Builder)] -> [(String, Builder)])
-> [(String, Builder)]
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Builder) -> (String, Builder))
-> [(String, Builder)] -> [(String, Builder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowS -> (String, Builder) -> (String, Builder)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ShowS -> (String, Builder) -> (String, Builder))
-> ShowS -> (String, Builder) -> (String, Builder)
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. a -> a
id @String)

-- | Domain of a 'UTxO' = the set of /inputs/ of the /utxo/.
dom :: UTxO -> Set TxIn
dom :: UTxO -> Set TxIn
dom (UTxO Map TxIn TxOut
utxo) = Map TxIn TxOut -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet Map TxIn TxOut
utxo

-- | Compute the balance of a UTxO
balance :: UTxO -> TokenBundle
balance :: UTxO -> TokenBundle
balance =
    (TokenBundle -> TxOut -> TokenBundle)
-> TokenBundle -> Map TxIn TxOut -> TokenBundle
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' TokenBundle -> TxOut -> TokenBundle
fn TokenBundle
forall a. Monoid a => a
mempty (Map TxIn TxOut -> TokenBundle)
-> (UTxO -> Map TxIn TxOut) -> UTxO -> TokenBundle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map TxIn TxOut
unUTxO
  where
    fn :: TokenBundle -> TxOut -> TokenBundle
    fn :: TokenBundle -> TxOut -> TokenBundle
fn TokenBundle
tot TxOut
out = TokenBundle
tot TokenBundle -> TokenBundle -> TokenBundle
`TB.add` ((TokenBundle -> Const TokenBundle TokenBundle)
 -> TxOut -> Const TokenBundle TxOut)
-> TxOut -> TokenBundle
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "tokens"
  ((TokenBundle -> Const TokenBundle TokenBundle)
   -> TxOut -> Const TokenBundle TxOut)
(TokenBundle -> Const TokenBundle TokenBundle)
-> TxOut -> Const TokenBundle TxOut
#tokens TxOut
out

difference :: UTxO -> UTxO -> UTxO
difference :: UTxO -> UTxO -> UTxO
difference UTxO
a UTxO
b = UTxO
a UTxO -> Set TxIn -> UTxO
`excluding` Map TxIn TxOut -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet (UTxO -> Map TxIn TxOut
unUTxO UTxO
b)

-- | Indicates whether a pair of UTxO sets are disjoint.
--
disjoint :: UTxO -> UTxO -> Bool
disjoint :: UTxO -> UTxO -> Bool
disjoint UTxO
u1 UTxO
u2 = UTxO -> Map TxIn TxOut
unUTxO UTxO
u1 Map TxIn TxOut -> Map TxIn TxOut -> Bool
forall k a b. Ord k => Map k a -> Map k b -> Bool
`Map.disjoint` UTxO -> Map TxIn TxOut
unUTxO UTxO
u2

-- | ins⋪ u
excluding :: UTxO -> Set TxIn ->  UTxO
excluding :: UTxO -> Set TxIn -> UTxO
excluding (UTxO Map TxIn TxOut
utxo) =
    Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO)
-> (Set TxIn -> Map TxIn TxOut) -> Set TxIn -> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> Set TxIn -> Map TxIn TxOut
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.withoutKeys Map TxIn TxOut
utxo

-- | a ⊆ b
isSubsetOf :: UTxO -> UTxO -> Bool
isSubsetOf :: UTxO -> UTxO -> Bool
isSubsetOf (UTxO Map TxIn TxOut
a) (UTxO Map TxIn TxOut
b) =
    Map TxIn TxOut
a Map TxIn TxOut -> Map TxIn TxOut -> Bool
forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
`Map.isSubmapOf` Map TxIn TxOut
b

-- | ins⊲ u
restrictedBy :: UTxO -> Set TxIn -> UTxO
restrictedBy :: UTxO -> Set TxIn -> UTxO
restrictedBy (UTxO Map TxIn TxOut
utxo) =
    Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO)
-> (Set TxIn -> Map TxIn TxOut) -> Set TxIn -> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> Set TxIn -> Map TxIn TxOut
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map TxIn TxOut
utxo

-- | u ⊳ outs
restrictedTo :: UTxO -> Set TxOut -> UTxO
restrictedTo :: UTxO -> Set TxOut -> UTxO
restrictedTo (UTxO Map TxIn TxOut
utxo) Set TxOut
outs =
    Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxOut -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (TxOut -> Set TxOut -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set TxOut
outs) Map TxIn TxOut
utxo

empty :: UTxO
empty :: UTxO
empty = Map TxIn TxOut -> UTxO
UTxO Map TxIn TxOut
forall k a. Map k a
Map.empty

null :: UTxO -> Bool
null :: UTxO -> Bool
null (UTxO Map TxIn TxOut
u) = Map TxIn TxOut -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn TxOut
u

size :: UTxO -> Int
size :: UTxO -> Int
size (UTxO Map TxIn TxOut
u) = Map TxIn TxOut -> Int
forall k a. Map k a -> Int
Map.size Map TxIn TxOut
u

-- | Filters a UTxO set according to a condition.
filter :: (TxIn -> Bool) -> UTxO -> UTxO
filter :: (TxIn -> Bool) -> UTxO -> UTxO
filter TxIn -> Bool
f (UTxO Map TxIn TxOut
u) = Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxOut -> Bool) -> Map TxIn TxOut -> Map TxIn TxOut
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> TxOut -> Bool
forall a b. a -> b -> a
const (Bool -> TxOut -> Bool) -> (TxIn -> Bool) -> TxIn -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Bool
f) Map TxIn TxOut
u

-- | Lookup an input in the UTXO
lookup :: TxIn -> UTxO -> Maybe TxOut
lookup :: TxIn -> UTxO -> Maybe TxOut
lookup TxIn
i (UTxO Map TxIn TxOut
u) = TxIn -> Map TxIn TxOut -> Maybe TxOut
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
i Map TxIn TxOut
u

-- | Filters a 'UTxO' set with an indicator function on 'Address' values.
--
-- Returns the subset of UTxO entries that have addresses for which the given
-- indicator function returns 'True'.
filterByAddressM :: forall f. Monad f => (Address -> f Bool) -> UTxO -> f UTxO
filterByAddressM :: (Address -> f Bool) -> UTxO -> f UTxO
filterByAddressM Address -> f Bool
isOursF (UTxO Map TxIn TxOut
m) =
    Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> f (Map TxIn TxOut) -> f UTxO
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TxIn -> TxOut -> f (Maybe TxOut))
-> Map TxIn TxOut -> f (Map TxIn TxOut)
forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
Map.traverseMaybeWithKey TxIn -> TxOut -> f (Maybe TxOut)
filterFunc Map TxIn TxOut
m
  where
    filterFunc :: TxIn -> TxOut -> f (Maybe TxOut)
    filterFunc :: TxIn -> TxOut -> f (Maybe TxOut)
filterFunc TxIn
_txin TxOut
txout = do
        Bool
ours <- Address -> f Bool
isOursF (Address -> f Bool) -> Address -> f Bool
forall a b. (a -> b) -> a -> b
$ ((Address -> Const Address Address)
 -> TxOut -> Const Address TxOut)
-> TxOut -> Address
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "address"
  ((Address -> Const Address Address)
   -> TxOut -> Const Address TxOut)
(Address -> Const Address Address) -> TxOut -> Const Address TxOut
#address TxOut
txout
        Maybe TxOut -> f (Maybe TxOut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TxOut -> f (Maybe TxOut)) -> Maybe TxOut -> f (Maybe TxOut)
forall a b. (a -> b) -> a -> b
$ if Bool
ours then TxOut -> Maybe TxOut
forall a. a -> Maybe a
Just TxOut
txout else Maybe TxOut
forall a. Maybe a
Nothing

-- | Filters a 'UTxO' set with an indicator function on 'Address' values.
--
-- Returns the subset of UTxO entries that have addresses for which the given
-- indicator function returns 'True'.
--
-- filterByAddress f u = runIdentity $ filterByAddressM (pure . f) u
-- filterByAddress (const True) u = u
-- filterByAddress (const False) u = mempty
-- filterByAddress f mempty = mempty
-- filterByAddress f u `isSubsetOf` u
filterByAddress :: (Address -> Bool) -> UTxO -> UTxO
filterByAddress :: (Address -> Bool) -> UTxO -> UTxO
filterByAddress Address -> Bool
f = Identity UTxO -> UTxO
forall a. Identity a -> a
runIdentity (Identity UTxO -> UTxO) -> (UTxO -> Identity UTxO) -> UTxO -> UTxO
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Address -> Identity Bool) -> UTxO -> Identity UTxO
forall (f :: * -> *).
Monad f =>
(Address -> f Bool) -> UTxO -> f UTxO
filterByAddressM (Bool -> Identity Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Identity Bool)
-> (Address -> Bool) -> Address -> Identity Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Bool
f)

-- | Partitions a UTxO set according to a condition.
--
-- > filter p a == a && filter (not . p) b == b
-- >   where (a,b) = partition p utxo
partition :: (TxIn -> Bool) -> UTxO -> (UTxO, UTxO)
partition :: (TxIn -> Bool) -> UTxO -> (UTxO, UTxO)
partition TxIn -> Bool
f (UTxO Map TxIn TxOut
u) = (Map TxIn TxOut -> UTxO)
-> (Map TxIn TxOut -> UTxO)
-> (Map TxIn TxOut, Map TxIn TxOut)
-> (UTxO, UTxO)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Map TxIn TxOut -> UTxO
UTxO Map TxIn TxOut -> UTxO
UTxO ((Map TxIn TxOut, Map TxIn TxOut) -> (UTxO, UTxO))
-> (Map TxIn TxOut, Map TxIn TxOut) -> (UTxO, UTxO)
forall a b. (a -> b) -> a -> b
$ (TxIn -> TxOut -> Bool)
-> Map TxIn TxOut -> (Map TxIn TxOut, Map TxIn TxOut)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (Bool -> TxOut -> Bool
forall a b. a -> b -> a
const (Bool -> TxOut -> Bool) -> (TxIn -> Bool) -> TxIn -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> Bool
f) Map TxIn TxOut
u

-- | Converts a UTxO set into a list of UTxO elements.
--
toList :: UTxO -> [(TxIn, TxOut)]
toList :: UTxO -> [(TxIn, TxOut)]
toList = Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn TxOut -> [(TxIn, TxOut)])
-> (UTxO -> Map TxIn TxOut) -> UTxO -> [(TxIn, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map TxIn TxOut
unUTxO

{-------------------------------------------------------------------------------
    Delta encodings of UTxO
-------------------------------------------------------------------------------}
-- | Efficient delta encoding for 'UTxO'.
data DeltaUTxO = DeltaUTxO
    { DeltaUTxO -> Set TxIn
excluded :: !(Set TxIn) -- ^ First exclude these inputs
    , DeltaUTxO -> UTxO
received :: !UTxO       -- ^ Then receive these additional outputs.
    } deriving ((forall x. DeltaUTxO -> Rep DeltaUTxO x)
-> (forall x. Rep DeltaUTxO x -> DeltaUTxO) -> Generic DeltaUTxO
forall x. Rep DeltaUTxO x -> DeltaUTxO
forall x. DeltaUTxO -> Rep DeltaUTxO x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeltaUTxO x -> DeltaUTxO
$cfrom :: forall x. DeltaUTxO -> Rep DeltaUTxO x
Generic, DeltaUTxO -> DeltaUTxO -> Bool
(DeltaUTxO -> DeltaUTxO -> Bool)
-> (DeltaUTxO -> DeltaUTxO -> Bool) -> Eq DeltaUTxO
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaUTxO -> DeltaUTxO -> Bool
$c/= :: DeltaUTxO -> DeltaUTxO -> Bool
== :: DeltaUTxO -> DeltaUTxO -> Bool
$c== :: DeltaUTxO -> DeltaUTxO -> Bool
Eq, Int -> DeltaUTxO -> ShowS
[DeltaUTxO] -> ShowS
DeltaUTxO -> String
(Int -> DeltaUTxO -> ShowS)
-> (DeltaUTxO -> String)
-> ([DeltaUTxO] -> ShowS)
-> Show DeltaUTxO
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaUTxO] -> ShowS
$cshowList :: [DeltaUTxO] -> ShowS
show :: DeltaUTxO -> String
$cshow :: DeltaUTxO -> String
showsPrec :: Int -> DeltaUTxO -> ShowS
$cshowsPrec :: Int -> DeltaUTxO -> ShowS
Show)

instance Delta DeltaUTxO where
    type Base DeltaUTxO = UTxO
    DeltaUTxO
du apply :: DeltaUTxO -> Base DeltaUTxO -> Base DeltaUTxO
`apply` Base DeltaUTxO
u = (Base DeltaUTxO
UTxO
u UTxO -> Set TxIn -> UTxO
`excluding` DeltaUTxO -> Set TxIn
excluded DeltaUTxO
du) UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> DeltaUTxO -> UTxO
received DeltaUTxO
du

-- | Left argument is applied /after/ right argument.
instance Semigroup DeltaUTxO where
    DeltaUTxO
db <> :: DeltaUTxO -> DeltaUTxO -> DeltaUTxO
<> DeltaUTxO
da = DeltaUTxO :: Set TxIn -> UTxO -> DeltaUTxO
DeltaUTxO
        { excluded :: Set TxIn
excluded = DeltaUTxO -> Set TxIn
excluded DeltaUTxO
da Set TxIn -> Set TxIn -> Set TxIn
forall a. Semigroup a => a -> a -> a
<> Set TxIn
excluded'db
        , received :: UTxO
received = UTxO
received'da UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> DeltaUTxO -> UTxO
received DeltaUTxO
db
        }
      where
        received'da :: UTxO
received'da = DeltaUTxO -> UTxO
received DeltaUTxO
da UTxO -> Set TxIn -> UTxO
`excluding` DeltaUTxO -> Set TxIn
excluded DeltaUTxO
db
        excluded'db :: Set TxIn
excluded'db = DeltaUTxO -> Set TxIn
excluded DeltaUTxO
db Set TxIn -> UTxO -> Set TxIn
`excludingS` DeltaUTxO -> UTxO
received DeltaUTxO
da

-- | Exclude the inputs of a 'UTxO' from a 'Set' of inputs.
excludingS :: Set TxIn -> UTxO -> Set TxIn
excludingS :: Set TxIn -> UTxO -> Set TxIn
excludingS Set TxIn
a (UTxO Map TxIn TxOut
b) = (TxIn -> Bool) -> Set TxIn -> Set TxIn
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (TxIn -> Bool) -> TxIn -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> Map TxIn TxOut -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map TxIn TxOut
b)) Set TxIn
a

-- | Restrict a 'Set' of inputs by the inputs of a 'UTxO'.
restrictedByS :: Set TxIn -> UTxO -> Set TxIn
restrictedByS :: Set TxIn -> UTxO -> Set TxIn
restrictedByS Set TxIn
a (UTxO Map TxIn TxOut
b) = (TxIn -> Bool) -> Set TxIn -> Set TxIn
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (TxIn -> Map TxIn TxOut -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map TxIn TxOut
b) Set TxIn
a

instance Monoid DeltaUTxO where
    mempty :: DeltaUTxO
mempty = DeltaUTxO :: Set TxIn -> UTxO -> DeltaUTxO
DeltaUTxO { excluded :: Set TxIn
excluded = Set TxIn
forall a. Monoid a => a
mempty, received :: UTxO
received = UTxO
forall a. Monoid a => a
mempty }

-- | Exclude a set of transaction inputs, typically because we spend them.
excludingD :: UTxO -> Set TxIn -> (DeltaUTxO, UTxO)
excludingD :: UTxO -> Set TxIn -> (DeltaUTxO, UTxO)
excludingD UTxO
u Set TxIn
ins = (DeltaUTxO
du, UTxO
u UTxO -> Set TxIn -> UTxO
`excluding` Set TxIn
spent)
  where
    spent :: Set TxIn
spent = Set TxIn
ins Set TxIn -> UTxO -> Set TxIn
`restrictedByS` UTxO
u
    du :: DeltaUTxO
du = DeltaUTxO :: Set TxIn -> UTxO -> DeltaUTxO
DeltaUTxO { excluded :: Set TxIn
excluded = Set TxIn
spent, received :: UTxO
received = UTxO
forall a. Monoid a => a
mempty }

-- | Receive additional 'UTxO' / union.
receiveD :: UTxO -> UTxO -> (DeltaUTxO, UTxO)
receiveD :: UTxO -> UTxO -> (DeltaUTxO, UTxO)
receiveD UTxO
a UTxO
b = (DeltaUTxO
da, UTxO
a UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
b)
  where da :: DeltaUTxO
da = DeltaUTxO :: Set TxIn -> UTxO -> DeltaUTxO
DeltaUTxO { excluded :: Set TxIn
excluded = Set TxIn
forall a. Monoid a => a
mempty, received :: UTxO
received = UTxO
b }

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

assetIds :: UTxO -> Set AssetId
assetIds :: UTxO -> Set AssetId
assetIds (UTxO Map TxIn TxOut
u) = (TxOut -> Set AssetId) -> Map TxIn TxOut -> Set AssetId
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut -> Set AssetId
txOutAssetIds Map TxIn TxOut
u

txIds :: UTxO -> Set (Hash "Tx")
txIds :: UTxO -> Set (Hash "Tx")
txIds (UTxO Map TxIn TxOut
u) = (TxIn -> Hash "Tx") -> Set TxIn -> Set (Hash "Tx")
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
 -> TxIn -> Const (Hash "Tx") TxIn)
-> TxIn -> Hash "Tx"
forall a s. ((a -> Const a a) -> s -> Const a s) -> s -> a
view IsLabel
  "inputId"
  ((Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
   -> TxIn -> Const (Hash "Tx") TxIn)
(Hash "Tx" -> Const (Hash "Tx") (Hash "Tx"))
-> TxIn -> Const (Hash "Tx") TxIn
#inputId) (Map TxIn TxOut -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet Map TxIn TxOut
u)

--------------------------------------------------------------------------------
-- Transformations
--------------------------------------------------------------------------------

mapAssetIds :: (AssetId -> AssetId) -> UTxO -> UTxO
mapAssetIds :: (AssetId -> AssetId) -> UTxO -> UTxO
mapAssetIds AssetId -> AssetId
f (UTxO Map TxIn TxOut
u) = Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxOut -> TxOut) -> Map TxIn TxOut -> Map TxIn TxOut
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((AssetId -> AssetId) -> TxOut -> TxOut
txOutMapAssetIds AssetId -> AssetId
f) Map TxIn TxOut
u

-- | Applies a mapping on transaction identifiers to a 'UTxO' set.
--
-- If the provided mapping gives rise to a collision within the 'TxIn' key set,
-- then only the smallest 'TxOut' is retained, according to the 'Ord' instance
-- for 'TxOut'.
--
mapTxIds :: (Hash "Tx" -> Hash "Tx") -> UTxO -> UTxO
mapTxIds :: (Hash "Tx" -> Hash "Tx") -> UTxO -> UTxO
mapTxIds Hash "Tx" -> Hash "Tx"
f (UTxO Map TxIn TxOut
u) = Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxOut -> TxOut -> TxOut)
-> (TxIn -> TxIn) -> Map TxIn TxOut -> Map TxIn TxOut
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith TxOut -> TxOut -> TxOut
forall a. Ord a => a -> a -> a
min (((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
-> (Hash "Tx" -> Hash "Tx") -> TxIn -> TxIn
forall a b s t.
((a -> Identity b) -> s -> Identity t) -> (a -> b) -> s -> t
over IsLabel
  "inputId"
  ((Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn)
(Hash "Tx" -> Identity (Hash "Tx")) -> TxIn -> Identity TxIn
#inputId Hash "Tx" -> Hash "Tx"
f) Map TxIn TxOut
u

removeAssetId :: UTxO -> AssetId -> UTxO
removeAssetId :: UTxO -> AssetId -> UTxO
removeAssetId (UTxO Map TxIn TxOut
u) AssetId
a = Map TxIn TxOut -> UTxO
UTxO (Map TxIn TxOut -> UTxO) -> Map TxIn TxOut -> UTxO
forall a b. (a -> b) -> a -> b
$ (TxOut -> TxOut) -> Map TxIn TxOut -> Map TxIn TxOut
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TxOut -> AssetId -> TxOut
`txOutRemoveAssetId` AssetId
a) Map TxIn TxOut
u

--------------------------------------------------------------------------------
-- UTxO Statistics
--------------------------------------------------------------------------------

data UTxOStatistics = UTxOStatistics
    { UTxOStatistics -> [HistogramBar]
histogram :: ![HistogramBar]
    , UTxOStatistics -> Word64
allStakes :: !Word64
    , UTxOStatistics -> BoundType
boundType :: BoundType
    } deriving (Int -> UTxOStatistics -> ShowS
[UTxOStatistics] -> ShowS
UTxOStatistics -> String
(Int -> UTxOStatistics -> ShowS)
-> (UTxOStatistics -> String)
-> ([UTxOStatistics] -> ShowS)
-> Show UTxOStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOStatistics] -> ShowS
$cshowList :: [UTxOStatistics] -> ShowS
show :: UTxOStatistics -> String
$cshow :: UTxOStatistics -> String
showsPrec :: Int -> UTxOStatistics -> ShowS
$cshowsPrec :: Int -> UTxOStatistics -> ShowS
Show, (forall x. UTxOStatistics -> Rep UTxOStatistics x)
-> (forall x. Rep UTxOStatistics x -> UTxOStatistics)
-> Generic UTxOStatistics
forall x. Rep UTxOStatistics x -> UTxOStatistics
forall x. UTxOStatistics -> Rep UTxOStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UTxOStatistics x -> UTxOStatistics
$cfrom :: forall x. UTxOStatistics -> Rep UTxOStatistics x
Generic, Eq UTxOStatistics
Eq UTxOStatistics
-> (UTxOStatistics -> UTxOStatistics -> Ordering)
-> (UTxOStatistics -> UTxOStatistics -> Bool)
-> (UTxOStatistics -> UTxOStatistics -> Bool)
-> (UTxOStatistics -> UTxOStatistics -> Bool)
-> (UTxOStatistics -> UTxOStatistics -> Bool)
-> (UTxOStatistics -> UTxOStatistics -> UTxOStatistics)
-> (UTxOStatistics -> UTxOStatistics -> UTxOStatistics)
-> Ord UTxOStatistics
UTxOStatistics -> UTxOStatistics -> Bool
UTxOStatistics -> UTxOStatistics -> Ordering
UTxOStatistics -> UTxOStatistics -> UTxOStatistics
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 :: UTxOStatistics -> UTxOStatistics -> UTxOStatistics
$cmin :: UTxOStatistics -> UTxOStatistics -> UTxOStatistics
max :: UTxOStatistics -> UTxOStatistics -> UTxOStatistics
$cmax :: UTxOStatistics -> UTxOStatistics -> UTxOStatistics
>= :: UTxOStatistics -> UTxOStatistics -> Bool
$c>= :: UTxOStatistics -> UTxOStatistics -> Bool
> :: UTxOStatistics -> UTxOStatistics -> Bool
$c> :: UTxOStatistics -> UTxOStatistics -> Bool
<= :: UTxOStatistics -> UTxOStatistics -> Bool
$c<= :: UTxOStatistics -> UTxOStatistics -> Bool
< :: UTxOStatistics -> UTxOStatistics -> Bool
$c< :: UTxOStatistics -> UTxOStatistics -> Bool
compare :: UTxOStatistics -> UTxOStatistics -> Ordering
$ccompare :: UTxOStatistics -> UTxOStatistics -> Ordering
$cp1Ord :: Eq UTxOStatistics
Ord)

instance NFData UTxOStatistics

-- Example output:
--
-- @
--    = Total value of 14061000005 lovelace across 7 UTxOs
--     ... 10                2
--     ... 100               0
--     ... 1000              0
--     ... 10000             0
--     ... 100000            0
--     ... 1000000           0
--     ... 10000000          0
--     ... 100000000         2
--     ... 1000000000        0
--     ... 10000000000       3
--     ... 100000000000      0
--     ... 1000000000000     0
--     ... 10000000000000    0
--     ... 100000000000000   0
--     ... 1000000000000000  0
--     ... 10000000000000000 0
--     ... 45000000000000000 0
--  @
instance Buildable UTxOStatistics where
    build :: UTxOStatistics -> Builder
build (UTxOStatistics [HistogramBar]
hist Word64
val BoundType
_) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Builder
"= Total value of "
        , Word64 -> Builder
forall p. Buildable p => p -> Builder
build Word64
val
        , Builder
" lovelace across "
        , Word64 -> Builder
wordF (Word64 -> Builder) -> Word64 -> Builder
forall a b. (a -> b) -> a -> b
$ [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (HistogramBar -> Word64) -> [HistogramBar] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map HistogramBar -> Word64
bucketCount [HistogramBar]
hist
        , Builder
" UTxOs"
        , Builder
"\n"
        , Text -> (HistogramBar -> Builder) -> [HistogramBar] -> Builder
forall (f :: * -> *) a.
Foldable f =>
Text -> (a -> Builder) -> f a -> Builder
blockListF' Text
"" HistogramBar -> Builder
buildBar [HistogramBar]
hist
        ]
      where
        buildBar :: HistogramBar -> Builder
buildBar (HistogramBar Word64
b Word64
c) =
            -- NOTE: Picked to fit well with the max value of Lovelace.
            Builder
"... " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> Char -> Word64 -> Builder
forall a. Buildable a => Int -> Char -> a -> Builder
padRightF Int
17 Char
' ' Word64
b) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
wordF Word64
c

        -- This is a workaround for the fact that:
        -- > fmt (build (0::Word)) == "-0"
        wordF :: Word64 -> Builder
wordF = Integer -> Builder
forall p. Buildable p => p -> Builder
build (Integer -> Builder) -> (Word64 -> Integer) -> Word64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger

instance Eq UTxOStatistics where
    (UTxOStatistics [HistogramBar]
h Word64
s BoundType
_) == :: UTxOStatistics -> UTxOStatistics -> Bool
== (UTxOStatistics [HistogramBar]
h' Word64
s' BoundType
_) =
        Word64
s Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
s' Bool -> Bool -> Bool
&& [HistogramBar] -> [HistogramBar]
sorted [HistogramBar]
h [HistogramBar] -> [HistogramBar] -> Bool
forall a. Eq a => a -> a -> Bool
== [HistogramBar] -> [HistogramBar]
sorted [HistogramBar]
h'
      where
        sorted :: [HistogramBar] -> [HistogramBar]
        sorted :: [HistogramBar] -> [HistogramBar]
sorted = (HistogramBar -> Word64) -> [HistogramBar] -> [HistogramBar]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (\(HistogramBar Word64
key Word64
_) -> Word64
key)

-- An 'HistogramBar' captures the value of a particular bucket. It specifies
-- the bucket upper bound, and its corresponding distribution (on the y-axis).
data HistogramBar = HistogramBar
    { HistogramBar -> Word64
bucketUpperBound :: !Word64
    , HistogramBar -> Word64
bucketCount      :: !Word64
    } deriving (Int -> HistogramBar -> ShowS
[HistogramBar] -> ShowS
HistogramBar -> String
(Int -> HistogramBar -> ShowS)
-> (HistogramBar -> String)
-> ([HistogramBar] -> ShowS)
-> Show HistogramBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistogramBar] -> ShowS
$cshowList :: [HistogramBar] -> ShowS
show :: HistogramBar -> String
$cshow :: HistogramBar -> String
showsPrec :: Int -> HistogramBar -> ShowS
$cshowsPrec :: Int -> HistogramBar -> ShowS
Show, HistogramBar -> HistogramBar -> Bool
(HistogramBar -> HistogramBar -> Bool)
-> (HistogramBar -> HistogramBar -> Bool) -> Eq HistogramBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistogramBar -> HistogramBar -> Bool
$c/= :: HistogramBar -> HistogramBar -> Bool
== :: HistogramBar -> HistogramBar -> Bool
$c== :: HistogramBar -> HistogramBar -> Bool
Eq, Eq HistogramBar
Eq HistogramBar
-> (HistogramBar -> HistogramBar -> Ordering)
-> (HistogramBar -> HistogramBar -> Bool)
-> (HistogramBar -> HistogramBar -> Bool)
-> (HistogramBar -> HistogramBar -> Bool)
-> (HistogramBar -> HistogramBar -> Bool)
-> (HistogramBar -> HistogramBar -> HistogramBar)
-> (HistogramBar -> HistogramBar -> HistogramBar)
-> Ord HistogramBar
HistogramBar -> HistogramBar -> Bool
HistogramBar -> HistogramBar -> Ordering
HistogramBar -> HistogramBar -> HistogramBar
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 :: HistogramBar -> HistogramBar -> HistogramBar
$cmin :: HistogramBar -> HistogramBar -> HistogramBar
max :: HistogramBar -> HistogramBar -> HistogramBar
$cmax :: HistogramBar -> HistogramBar -> HistogramBar
>= :: HistogramBar -> HistogramBar -> Bool
$c>= :: HistogramBar -> HistogramBar -> Bool
> :: HistogramBar -> HistogramBar -> Bool
$c> :: HistogramBar -> HistogramBar -> Bool
<= :: HistogramBar -> HistogramBar -> Bool
$c<= :: HistogramBar -> HistogramBar -> Bool
< :: HistogramBar -> HistogramBar -> Bool
$c< :: HistogramBar -> HistogramBar -> Bool
compare :: HistogramBar -> HistogramBar -> Ordering
$ccompare :: HistogramBar -> HistogramBar -> Ordering
$cp1Ord :: Eq HistogramBar
Ord, (forall x. HistogramBar -> Rep HistogramBar x)
-> (forall x. Rep HistogramBar x -> HistogramBar)
-> Generic HistogramBar
forall x. Rep HistogramBar x -> HistogramBar
forall x. HistogramBar -> Rep HistogramBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistogramBar x -> HistogramBar
$cfrom :: forall x. HistogramBar -> Rep HistogramBar x
Generic)

instance NFData HistogramBar

instance Buildable HistogramBar where
    build :: HistogramBar -> Builder
build (HistogramBar Word64
k Word64
v) = (Word64, Word64) -> Builder
forall a. TupleF a => a -> Builder
tupleF (Word64
k, Word64
v)

--  Buckets boundaries can be constructed in different ways
data BoundType = Log10 deriving (BoundType -> BoundType -> Bool
(BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool) -> Eq BoundType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoundType -> BoundType -> Bool
$c/= :: BoundType -> BoundType -> Bool
== :: BoundType -> BoundType -> Bool
$c== :: BoundType -> BoundType -> Bool
Eq, Int -> BoundType -> ShowS
[BoundType] -> ShowS
BoundType -> String
(Int -> BoundType -> ShowS)
-> (BoundType -> String)
-> ([BoundType] -> ShowS)
-> Show BoundType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BoundType] -> ShowS
$cshowList :: [BoundType] -> ShowS
show :: BoundType -> String
$cshow :: BoundType -> String
showsPrec :: Int -> BoundType -> ShowS
$cshowsPrec :: Int -> BoundType -> ShowS
Show, Eq BoundType
Eq BoundType
-> (BoundType -> BoundType -> Ordering)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> Bool)
-> (BoundType -> BoundType -> BoundType)
-> (BoundType -> BoundType -> BoundType)
-> Ord BoundType
BoundType -> BoundType -> Bool
BoundType -> BoundType -> Ordering
BoundType -> BoundType -> BoundType
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 :: BoundType -> BoundType -> BoundType
$cmin :: BoundType -> BoundType -> BoundType
max :: BoundType -> BoundType -> BoundType
$cmax :: BoundType -> BoundType -> BoundType
>= :: BoundType -> BoundType -> Bool
$c>= :: BoundType -> BoundType -> Bool
> :: BoundType -> BoundType -> Bool
$c> :: BoundType -> BoundType -> Bool
<= :: BoundType -> BoundType -> Bool
$c<= :: BoundType -> BoundType -> Bool
< :: BoundType -> BoundType -> Bool
$c< :: BoundType -> BoundType -> Bool
compare :: BoundType -> BoundType -> Ordering
$ccompare :: BoundType -> BoundType -> Ordering
$cp1Ord :: Eq BoundType
Ord, (forall x. BoundType -> Rep BoundType x)
-> (forall x. Rep BoundType x -> BoundType) -> Generic BoundType
forall x. Rep BoundType x -> BoundType
forall x. BoundType -> Rep BoundType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BoundType x -> BoundType
$cfrom :: forall x. BoundType -> Rep BoundType x
Generic)

instance NFData BoundType

-- | Smart-constructor to create bounds using a log-10 scale
log10 :: BoundType
log10 :: BoundType
log10 = BoundType
Log10
{-# INLINE log10 #-}

-- | Compute UtxoStatistics from UTxOs
computeUtxoStatistics :: BoundType -> UTxO -> UTxOStatistics
computeUtxoStatistics :: BoundType -> UTxO -> UTxOStatistics
computeUtxoStatistics BoundType
btype
    = (TxOut -> [Word64]) -> BoundType -> [TxOut] -> UTxOStatistics
forall a. (a -> [Word64]) -> BoundType -> [a] -> UTxOStatistics
computeStatistics (Word64 -> [Word64]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> [Word64]) -> (TxOut -> Word64) -> TxOut -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Coin -> Word64
Coin -> Word64
Coin.unsafeToWord64 (Coin -> Word64) -> (TxOut -> Coin) -> TxOut -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Coin
txOutCoin) BoundType
btype
    ([TxOut] -> UTxOStatistics)
-> (UTxO -> [TxOut]) -> UTxO -> UTxOStatistics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> [TxOut]
forall k a. Map k a -> [a]
Map.elems
    (Map TxIn TxOut -> [TxOut])
-> (UTxO -> Map TxIn TxOut) -> UTxO -> [TxOut]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO -> Map TxIn TxOut
unUTxO

-- | A more generic function for computing UTxO statistics on some other type of
-- data that maps to UTxO's values.
computeStatistics :: (a -> [Word64]) -> BoundType -> [a] -> UTxOStatistics
computeStatistics :: (a -> [Word64]) -> BoundType -> [a] -> UTxOStatistics
computeStatistics a -> [Word64]
getCoins BoundType
btype [a]
utxos =
    (Fold Word64 (BoundType -> UTxOStatistics)
-> [Word64] -> BoundType -> UTxOStatistics
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
F.fold Fold Word64 (BoundType -> UTxOStatistics)
foldStatistics ([[Word64]] -> [Word64]
forall a. Monoid a => [a] -> a
mconcat ([[Word64]] -> [Word64]) -> [[Word64]] -> [Word64]
forall a b. (a -> b) -> a -> b
$ a -> [Word64]
getCoins (a -> [Word64]) -> [a] -> [[Word64]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
utxos)) BoundType
btype
  where
    foldStatistics :: F.Fold Word64 (BoundType -> UTxOStatistics)
    foldStatistics :: Fold Word64 (BoundType -> UTxOStatistics)
foldStatistics = [HistogramBar] -> Word64 -> BoundType -> UTxOStatistics
UTxOStatistics
        ([HistogramBar] -> Word64 -> BoundType -> UTxOStatistics)
-> Fold Word64 [HistogramBar]
-> Fold Word64 (Word64 -> BoundType -> UTxOStatistics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Word64 -> Fold Word64 [HistogramBar]
foldBuckets (BoundType -> NonEmpty Word64
generateBounds BoundType
btype)
        Fold Word64 (Word64 -> BoundType -> UTxOStatistics)
-> Fold Word64 Word64 -> Fold Word64 (BoundType -> UTxOStatistics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold Word64 Word64
forall a. Num a => Fold a a
F.sum

    foldBuckets :: NonEmpty Word64 -> F.Fold Word64 [HistogramBar]
    foldBuckets :: NonEmpty Word64 -> Fold Word64 [HistogramBar]
foldBuckets NonEmpty Word64
bounds =
        let
            step :: Map Word64 Word64 -> Word64 -> Map Word64 Word64
            step :: Map Word64 Word64 -> Word64 -> Map Word64 Word64
step Map Word64 Word64
x Word64
a = case Word64 -> Map Word64 Word64 -> Maybe (Word64, Word64)
forall k v. Ord k => k -> Map k v -> Maybe (k, v)
Map.lookupGE Word64
a Map Word64 Word64
x of
                Just (Word64
k, Word64
v) -> Word64 -> Word64 -> Map Word64 Word64 -> Map Word64 Word64
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Word64
k (Word64
vWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) Map Word64 Word64
x
                Maybe (Word64, Word64)
Nothing -> (Word64 -> Word64)
-> Word64 -> Map Word64 Word64 -> Map Word64 Word64
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) (NonEmpty Word64 -> Word64
forall a. NonEmpty a -> a
NE.head NonEmpty Word64
bounds) Map Word64 Word64
x
            initial :: Map Word64 Word64
            initial :: Map Word64 Word64
initial =
                [(Word64, Word64)] -> Map Word64 Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Word64, Word64)] -> Map Word64 Word64)
-> [(Word64, Word64)] -> Map Word64 Word64
forall a b. (a -> b) -> a -> b
$ [Word64] -> [Word64] -> [(Word64, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip (NonEmpty Word64 -> [Word64]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Word64
bounds) (Word64 -> [Word64]
forall a. a -> [a]
repeat Word64
0)
            extract :: Map Word64 Word64 -> [HistogramBar]
            extract :: Map Word64 Word64 -> [HistogramBar]
extract =
                ((Word64, Word64) -> HistogramBar)
-> [(Word64, Word64)] -> [HistogramBar]
forall a b. (a -> b) -> [a] -> [b]
map ((Word64 -> Word64 -> HistogramBar)
-> (Word64, Word64) -> HistogramBar
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word64 -> Word64 -> HistogramBar
HistogramBar) ([(Word64, Word64)] -> [HistogramBar])
-> (Map Word64 Word64 -> [(Word64, Word64)])
-> Map Word64 Word64
-> [HistogramBar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word64 Word64 -> [(Word64, Word64)]
forall k a. Map k a -> [(k, a)]
Map.toList
        in
            (Map Word64 Word64 -> Word64 -> Map Word64 Word64)
-> Map Word64 Word64
-> (Map Word64 Word64 -> [HistogramBar])
-> Fold Word64 [HistogramBar]
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
F.Fold Map Word64 Word64 -> Word64 -> Map Word64 Word64
step Map Word64 Word64
initial Map Word64 Word64 -> [HistogramBar]
extract

    generateBounds :: BoundType -> NonEmpty Word64
    generateBounds :: BoundType -> NonEmpty Word64
generateBounds = \case
        BoundType
Log10 -> [Word64] -> NonEmpty Word64
forall a. [a] -> NonEmpty a
NE.fromList ([Word64] -> NonEmpty Word64) -> [Word64] -> NonEmpty Word64
forall a b. (a -> b) -> a -> b
$ (Word64 -> Word64) -> [Word64] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Word64
10 Word64 -> Word64 -> Word64
^!) [Word64
1..Word64
16] [Word64] -> [Word64] -> [Word64]
forall a. [a] -> [a] -> [a]
++ [Word64
45 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* (Word64
10 Word64 -> Word64 -> Word64
^! Word64
15)]

    (^!) :: Word64 -> Word64 -> Word64
    ^! :: Word64 -> Word64 -> Word64
(^!) = Word64 -> Word64 -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
(^)