{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia   #-}
{-# LANGUAGE Rank2Types    #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies  #-}
-- | 'AddressMap's and functions for working on them.
--
-- 'AddressMap's are used to represent the limited knowledge about the state of the ledger that
-- the wallet retains. Rather than keeping the entire ledger (which can be very large) the wallet
-- only tracks the UTxOs at particular addresses.
module Ledger.AddressMap(
    AddressMap(..),
    UtxoMap,
    addAddress,
    addAddresses,
    filterRefs,
    fundsAt,
    values,
    traverseWithKey,
    singleton,
    fromTxOutputs,
    knownAddresses,
    updateAddresses,
    updateAllAddresses,
    restrict,
    addressesTouched,
    outRefMap,
    outputsMapFromTxForAddress,
    fromChain
    ) where

import Codec.Serialise.Class (Serialise)
import Control.Lens (At (..), Index, IxValue, Ixed (..), Lens', at, lens, non, (&), (.~), (^.))
import Control.Monad (join)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Aeson.Extras qualified as JSON
import Data.Foldable (fold)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
import GHC.Generics (Generic)

import Ledger.Address (CardanoAddress)
import Ledger.Blockchain (Blockchain, OnChainTx, consumableInputs, outputsProduced, unOnChain)
import Ledger.Tx (CardanoTx, TxIn (..), TxOut (..), TxOutRef (..), txOutAddress, txOutValue)
import Plutus.V1.Ledger.Value (Value)

type UtxoMap = Map TxOutRef (CardanoTx, TxOut)

-- | A map of 'Address'es and their unspent outputs.
newtype AddressMap = AddressMap { AddressMap -> Map CardanoAddress UtxoMap
getAddressMap :: Map CardanoAddress UtxoMap }
    deriving stock (Int -> AddressMap -> ShowS
[AddressMap] -> ShowS
AddressMap -> String
(Int -> AddressMap -> ShowS)
-> (AddressMap -> String)
-> ([AddressMap] -> ShowS)
-> Show AddressMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressMap] -> ShowS
$cshowList :: [AddressMap] -> ShowS
show :: AddressMap -> String
$cshow :: AddressMap -> String
showsPrec :: Int -> AddressMap -> ShowS
$cshowsPrec :: Int -> AddressMap -> ShowS
Show, AddressMap -> AddressMap -> Bool
(AddressMap -> AddressMap -> Bool)
-> (AddressMap -> AddressMap -> Bool) -> Eq AddressMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressMap -> AddressMap -> Bool
$c/= :: AddressMap -> AddressMap -> Bool
== :: AddressMap -> AddressMap -> Bool
$c== :: AddressMap -> AddressMap -> Bool
Eq, (forall x. AddressMap -> Rep AddressMap x)
-> (forall x. Rep AddressMap x -> AddressMap) -> Generic AddressMap
forall x. Rep AddressMap x -> AddressMap
forall x. AddressMap -> Rep AddressMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressMap x -> AddressMap
$cfrom :: forall x. AddressMap -> Rep AddressMap x
Generic)
    deriving newtype (Decoder s AddressMap
Decoder s [AddressMap]
[AddressMap] -> Encoding
AddressMap -> Encoding
(AddressMap -> Encoding)
-> (forall s. Decoder s AddressMap)
-> ([AddressMap] -> Encoding)
-> (forall s. Decoder s [AddressMap])
-> Serialise AddressMap
forall s. Decoder s [AddressMap]
forall s. Decoder s AddressMap
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [AddressMap]
$cdecodeList :: forall s. Decoder s [AddressMap]
encodeList :: [AddressMap] -> Encoding
$cencodeList :: [AddressMap] -> Encoding
decode :: Decoder s AddressMap
$cdecode :: forall s. Decoder s AddressMap
encode :: AddressMap -> Encoding
$cencode :: AddressMap -> Encoding
Serialise)
    deriving ([AddressMap] -> Encoding
[AddressMap] -> Value
AddressMap -> Encoding
AddressMap -> Value
(AddressMap -> Value)
-> (AddressMap -> Encoding)
-> ([AddressMap] -> Value)
-> ([AddressMap] -> Encoding)
-> ToJSON AddressMap
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AddressMap] -> Encoding
$ctoEncodingList :: [AddressMap] -> Encoding
toJSONList :: [AddressMap] -> Value
$ctoJSONList :: [AddressMap] -> Value
toEncoding :: AddressMap -> Encoding
$ctoEncoding :: AddressMap -> Encoding
toJSON :: AddressMap -> Value
$ctoJSON :: AddressMap -> Value
ToJSON, Value -> Parser [AddressMap]
Value -> Parser AddressMap
(Value -> Parser AddressMap)
-> (Value -> Parser [AddressMap]) -> FromJSON AddressMap
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [AddressMap]
$cparseJSONList :: Value -> Parser [AddressMap]
parseJSON :: Value -> Parser AddressMap
$cparseJSON :: Value -> Parser AddressMap
FromJSON) via (JSON.JSONViaSerialise AddressMap)

-- | An address map with a single unspent transaction output.
singleton :: (CardanoAddress, TxOutRef, CardanoTx, TxOut) -> AddressMap
singleton :: (CardanoAddress, TxOutRef, CardanoTx, TxOut) -> AddressMap
singleton (CardanoAddress
addr, TxOutRef
ref, CardanoTx
tx, TxOut
ot) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> Map CardanoAddress UtxoMap -> AddressMap
forall a b. (a -> b) -> a -> b
$ CardanoAddress -> UtxoMap -> Map CardanoAddress UtxoMap
forall k a. k -> a -> Map k a
Map.singleton CardanoAddress
addr (TxOutRef -> (CardanoTx, TxOut) -> UtxoMap
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
ref (CardanoTx
tx, TxOut
ot))

outRefMap :: AddressMap -> Map TxOutRef (CardanoTx, TxOut)
outRefMap :: AddressMap -> UtxoMap
outRefMap (AddressMap Map CardanoAddress UtxoMap
am) = [UtxoMap] -> UtxoMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ((CardanoAddress, UtxoMap) -> UtxoMap
forall a b. (a, b) -> b
snd ((CardanoAddress, UtxoMap) -> UtxoMap)
-> [(CardanoAddress, UtxoMap)] -> [UtxoMap]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map CardanoAddress UtxoMap -> [(CardanoAddress, UtxoMap)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CardanoAddress UtxoMap
am)

-- | Filter the transaction output references in the map
filterRefs :: (TxOutRef -> (CardanoTx, TxOut) -> Bool) -> AddressMap -> AddressMap
filterRefs :: (TxOutRef -> (CardanoTx, TxOut) -> Bool)
-> AddressMap -> AddressMap
filterRefs TxOutRef -> (CardanoTx, TxOut) -> Bool
flt =
    Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> (AddressMap -> Map CardanoAddress UtxoMap)
-> AddressMap
-> AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoMap -> UtxoMap)
-> Map CardanoAddress UtxoMap -> Map CardanoAddress UtxoMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((TxOutRef -> (CardanoTx, TxOut) -> Bool) -> UtxoMap -> UtxoMap
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey TxOutRef -> (CardanoTx, TxOut) -> Bool
flt) (Map CardanoAddress UtxoMap -> Map CardanoAddress UtxoMap)
-> (AddressMap -> Map CardanoAddress UtxoMap)
-> AddressMap
-> Map CardanoAddress UtxoMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressMap -> Map CardanoAddress UtxoMap
getAddressMap

-- NB: The ToJSON and FromJSON instance for AddressMap use the `Serialise`
-- instance with a base16 encoding, similar to the instances in Types.hs.
-- I chose this approach over the generic deriving mechanism because that would
-- have required `ToJSONKey` and `FromJSONKey` instances for `Address` and
-- `TxOutRef` which ultimately would have introduced more boilerplate code
-- than what we have here.

instance Semigroup AddressMap where
    (AddressMap Map CardanoAddress UtxoMap
l) <> :: AddressMap -> AddressMap -> AddressMap
<> (AddressMap Map CardanoAddress UtxoMap
r) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap ((UtxoMap -> UtxoMap -> UtxoMap)
-> Map CardanoAddress UtxoMap
-> Map CardanoAddress UtxoMap
-> Map CardanoAddress UtxoMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith UtxoMap -> UtxoMap -> UtxoMap
forall a. Map TxOutRef a -> Map TxOutRef a -> Map TxOutRef a
add Map CardanoAddress UtxoMap
l Map CardanoAddress UtxoMap
r) where
        add :: Map TxOutRef a -> Map TxOutRef a -> Map TxOutRef a
add = Map TxOutRef a -> Map TxOutRef a -> Map TxOutRef a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

instance Monoid AddressMap where
    mappend :: AddressMap -> AddressMap -> AddressMap
mappend = AddressMap -> AddressMap -> AddressMap
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: AddressMap
mempty = Map CardanoAddress UtxoMap -> AddressMap
AddressMap Map CardanoAddress UtxoMap
forall k a. Map k a
Map.empty

type instance Index AddressMap = CardanoAddress
type instance IxValue AddressMap = Map TxOutRef (CardanoTx, TxOut)

instance Ixed AddressMap where
    ix :: Index AddressMap -> Traversal' AddressMap (IxValue AddressMap)
ix Index AddressMap
adr IxValue AddressMap -> f (IxValue AddressMap)
f (AddressMap Map CardanoAddress UtxoMap
mp) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> f (Map CardanoAddress UtxoMap) -> f AddressMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Map CardanoAddress UtxoMap)
-> (IxValue (Map CardanoAddress UtxoMap)
    -> f (IxValue (Map CardanoAddress UtxoMap)))
-> Map CardanoAddress UtxoMap
-> f (Map CardanoAddress UtxoMap)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map CardanoAddress UtxoMap)
Index AddressMap
adr IxValue (Map CardanoAddress UtxoMap)
-> f (IxValue (Map CardanoAddress UtxoMap))
IxValue AddressMap -> f (IxValue AddressMap)
f Map CardanoAddress UtxoMap
mp

instance At AddressMap where
    at :: Index AddressMap -> Lens' AddressMap (Maybe (IxValue AddressMap))
at Index AddressMap
idx = (AddressMap -> Maybe UtxoMap)
-> (AddressMap -> Maybe UtxoMap -> AddressMap)
-> Lens AddressMap AddressMap (Maybe UtxoMap) (Maybe UtxoMap)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AddressMap -> Maybe UtxoMap
g AddressMap -> Maybe UtxoMap -> AddressMap
s where
        g :: AddressMap -> Maybe UtxoMap
g (AddressMap Map CardanoAddress UtxoMap
mp) = Map CardanoAddress UtxoMap
mp Map CardanoAddress UtxoMap
-> Getting
     (Maybe UtxoMap) (Map CardanoAddress UtxoMap) (Maybe UtxoMap)
-> Maybe UtxoMap
forall s a. s -> Getting a s a -> a
^. Index (Map CardanoAddress UtxoMap)
-> Lens'
     (Map CardanoAddress UtxoMap)
     (Maybe (IxValue (Map CardanoAddress UtxoMap)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map CardanoAddress UtxoMap)
Index AddressMap
idx
        s :: AddressMap -> Maybe UtxoMap -> AddressMap
s (AddressMap Map CardanoAddress UtxoMap
mp) Maybe UtxoMap
utxo = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> Map CardanoAddress UtxoMap -> AddressMap
forall a b. (a -> b) -> a -> b
$ Map CardanoAddress UtxoMap
mp Map CardanoAddress UtxoMap
-> (Map CardanoAddress UtxoMap -> Map CardanoAddress UtxoMap)
-> Map CardanoAddress UtxoMap
forall a b. a -> (a -> b) -> b
& Index (Map CardanoAddress UtxoMap)
-> Lens'
     (Map CardanoAddress UtxoMap)
     (Maybe (IxValue (Map CardanoAddress UtxoMap)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map CardanoAddress UtxoMap)
Index AddressMap
idx ((Maybe UtxoMap -> Identity (Maybe UtxoMap))
 -> Map CardanoAddress UtxoMap
 -> Identity (Map CardanoAddress UtxoMap))
-> Maybe UtxoMap
-> Map CardanoAddress UtxoMap
-> Map CardanoAddress UtxoMap
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe UtxoMap
utxo

-- | Get the funds available at a particular address.
fundsAt :: CardanoAddress -> Lens' AddressMap UtxoMap
fundsAt :: CardanoAddress -> Lens' AddressMap UtxoMap
fundsAt CardanoAddress
addr = Index AddressMap -> Lens' AddressMap (Maybe (IxValue AddressMap))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at CardanoAddress
Index AddressMap
addr ((Maybe UtxoMap -> f (Maybe UtxoMap))
 -> AddressMap -> f AddressMap)
-> ((UtxoMap -> f UtxoMap) -> Maybe UtxoMap -> f (Maybe UtxoMap))
-> (UtxoMap -> f UtxoMap)
-> AddressMap
-> f AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UtxoMap -> Iso' (Maybe UtxoMap) UtxoMap
forall a. Eq a => a -> Iso' (Maybe a) a
non UtxoMap
forall a. Monoid a => a
mempty

-- | Add an address with no unspent outputs to a map. If the address already
--   exists, do nothing.
addAddress :: CardanoAddress -> AddressMap -> AddressMap
addAddress :: CardanoAddress -> AddressMap -> AddressMap
addAddress CardanoAddress
adr (AddressMap Map CardanoAddress UtxoMap
mp) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> Map CardanoAddress UtxoMap -> AddressMap
forall a b. (a -> b) -> a -> b
$ (Maybe UtxoMap -> Maybe UtxoMap)
-> CardanoAddress
-> Map CardanoAddress UtxoMap
-> Map CardanoAddress UtxoMap
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe UtxoMap -> Maybe UtxoMap
upd CardanoAddress
adr Map CardanoAddress UtxoMap
mp where
    upd :: Maybe UtxoMap -> Maybe UtxoMap
    upd :: Maybe UtxoMap -> Maybe UtxoMap
upd = Maybe UtxoMap
-> (UtxoMap -> Maybe UtxoMap) -> Maybe UtxoMap -> Maybe UtxoMap
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UtxoMap -> Maybe UtxoMap
forall a. a -> Maybe a
Just UtxoMap
forall k a. Map k a
Map.empty) UtxoMap -> Maybe UtxoMap
forall a. a -> Maybe a
Just

-- | Add a list of 'Address'es with no unspent outputs to the map.
addAddresses :: [CardanoAddress] -> AddressMap -> AddressMap
addAddresses :: [CardanoAddress] -> AddressMap -> AddressMap
addAddresses = (AddressMap -> [CardanoAddress] -> AddressMap)
-> [CardanoAddress] -> AddressMap -> AddressMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((CardanoAddress -> AddressMap -> AddressMap)
-> AddressMap -> [CardanoAddress] -> AddressMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CardanoAddress -> AddressMap -> AddressMap
addAddress)

-- | The total value of unspent outputs (which the map knows about) at an address.
values :: AddressMap -> Map CardanoAddress Value
values :: AddressMap -> Map CardanoAddress Value
values = (UtxoMap -> Value)
-> Map CardanoAddress UtxoMap -> Map CardanoAddress Value
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Map TxOutRef Value -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map TxOutRef Value -> Value)
-> (UtxoMap -> Map TxOutRef Value) -> UtxoMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CardanoTx, TxOut) -> Value) -> UtxoMap -> Map TxOutRef Value
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TxOut -> Value
txOutValue (TxOut -> Value)
-> ((CardanoTx, TxOut) -> TxOut) -> (CardanoTx, TxOut) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CardanoTx, TxOut) -> TxOut
forall a b. (a, b) -> b
snd)) (Map CardanoAddress UtxoMap -> Map CardanoAddress Value)
-> (AddressMap -> Map CardanoAddress UtxoMap)
-> AddressMap
-> Map CardanoAddress Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressMap -> Map CardanoAddress UtxoMap
getAddressMap

-- | Walk through the address map, applying an effectful function to each entry.
traverseWithKey ::
     Applicative f
  => (CardanoAddress -> Map TxOutRef (CardanoTx, TxOut) -> f (Map TxOutRef (CardanoTx, TxOut)))
  -> AddressMap
  -> f AddressMap
traverseWithKey :: (CardanoAddress -> UtxoMap -> f UtxoMap)
-> AddressMap -> f AddressMap
traverseWithKey CardanoAddress -> UtxoMap -> f UtxoMap
f (AddressMap Map CardanoAddress UtxoMap
m) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> f (Map CardanoAddress UtxoMap) -> f AddressMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CardanoAddress -> UtxoMap -> f UtxoMap)
-> Map CardanoAddress UtxoMap -> f (Map CardanoAddress UtxoMap)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey CardanoAddress -> UtxoMap -> f UtxoMap
f Map CardanoAddress UtxoMap
m

outputsMapFromTxForAddress :: CardanoAddress -> OnChainTx -> Map TxOutRef (CardanoTx, TxOut)
outputsMapFromTxForAddress :: CardanoAddress -> OnChainTx -> UtxoMap
outputsMapFromTxForAddress CardanoAddress
addr OnChainTx
tx =
    (TxOut -> (CardanoTx, TxOut)) -> Map TxOutRef TxOut -> UtxoMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OnChainTx -> CardanoTx
unOnChain OnChainTx
tx ,)
    (Map TxOutRef TxOut -> UtxoMap) -> Map TxOutRef TxOut -> UtxoMap
forall a b. (a -> b) -> a -> b
$ (TxOut -> Bool) -> Map TxOutRef TxOut -> Map TxOutRef TxOut
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (CardanoAddress -> CardanoAddress -> Bool
forall a. Eq a => a -> a -> Bool
(==) CardanoAddress
addr (CardanoAddress -> Bool)
-> (TxOut -> CardanoAddress) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> CardanoAddress
txOutAddress)
    (Map TxOutRef TxOut -> Map TxOutRef TxOut)
-> Map TxOutRef TxOut -> Map TxOutRef TxOut
forall a b. (a -> b) -> a -> b
$ OnChainTx -> Map TxOutRef TxOut
outputsProduced OnChainTx
tx

-- | Create an 'AddressMap' with the unspent outputs of a single transaction.
fromTxOutputs :: OnChainTx -> AddressMap
fromTxOutputs :: OnChainTx -> AddressMap
fromTxOutputs OnChainTx
tx =
    Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> (OnChainTx -> Map CardanoAddress UtxoMap)
-> OnChainTx
-> AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UtxoMap -> UtxoMap -> UtxoMap)
-> [(CardanoAddress, UtxoMap)] -> Map CardanoAddress UtxoMap
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith UtxoMap -> UtxoMap -> UtxoMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(CardanoAddress, UtxoMap)] -> Map CardanoAddress UtxoMap)
-> (OnChainTx -> [(CardanoAddress, UtxoMap)])
-> OnChainTx
-> Map CardanoAddress UtxoMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxOutRef, TxOut) -> (CardanoAddress, UtxoMap))
-> [(TxOutRef, TxOut)] -> [(CardanoAddress, UtxoMap)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutRef, TxOut) -> (CardanoAddress, UtxoMap)
mkUtxo ([(TxOutRef, TxOut)] -> [(CardanoAddress, UtxoMap)])
-> (OnChainTx -> [(TxOutRef, TxOut)])
-> OnChainTx
-> [(CardanoAddress, UtxoMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> (OnChainTx -> Map TxOutRef TxOut)
-> OnChainTx
-> [(TxOutRef, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainTx -> Map TxOutRef TxOut
outputsProduced (OnChainTx -> AddressMap) -> OnChainTx -> AddressMap
forall a b. (a -> b) -> a -> b
$ OnChainTx
tx where
    mkUtxo :: (TxOutRef, TxOut) -> (CardanoAddress, UtxoMap)
mkUtxo (TxOutRef
ref, TxOut
txo) = (TxOut -> CardanoAddress
txOutAddress TxOut
txo, TxOutRef -> (CardanoTx, TxOut) -> UtxoMap
forall k a. k -> a -> Map k a
Map.singleton TxOutRef
ref (OnChainTx -> CardanoTx
unOnChain OnChainTx
tx, TxOut
txo))

-- | Create a map of unspent transaction outputs to their addresses (the
-- "inverse" of an 'AddressMap', without the values)
knownAddresses :: AddressMap -> Map TxOutRef CardanoAddress
knownAddresses :: AddressMap -> Map TxOutRef CardanoAddress
knownAddresses = [(TxOutRef, CardanoAddress)] -> Map TxOutRef CardanoAddress
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, CardanoAddress)] -> Map TxOutRef CardanoAddress)
-> (AddressMap -> [(TxOutRef, CardanoAddress)])
-> AddressMap
-> Map TxOutRef CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CardanoAddress, UtxoMap)] -> [(TxOutRef, CardanoAddress)]
unRef ([(CardanoAddress, UtxoMap)] -> [(TxOutRef, CardanoAddress)])
-> (AddressMap -> [(CardanoAddress, UtxoMap)])
-> AddressMap
-> [(TxOutRef, CardanoAddress)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CardanoAddress UtxoMap -> [(CardanoAddress, UtxoMap)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map CardanoAddress UtxoMap -> [(CardanoAddress, UtxoMap)])
-> (AddressMap -> Map CardanoAddress UtxoMap)
-> AddressMap
-> [(CardanoAddress, UtxoMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressMap -> Map CardanoAddress UtxoMap
getAddressMap where
    unRef :: [(CardanoAddress, Map TxOutRef (CardanoTx, TxOut))] -> [(TxOutRef, CardanoAddress)]
    unRef :: [(CardanoAddress, UtxoMap)] -> [(TxOutRef, CardanoAddress)]
unRef [(CardanoAddress, UtxoMap)]
lst = do
        (CardanoAddress
a, UtxoMap
outRefs) <- [(CardanoAddress, UtxoMap)]
lst
        (TxOutRef
rf, (CardanoTx, TxOut)
_) <- UtxoMap -> [(TxOutRef, (CardanoTx, TxOut))]
forall k a. Map k a -> [(k, a)]
Map.toList UtxoMap
outRefs
        (TxOutRef, CardanoAddress) -> [(TxOutRef, CardanoAddress)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOutRef
rf, CardanoAddress
a)

-- | Update an 'AddressMap' with the inputs and outputs of a new
-- transaction. @updateAddresses@ does /not/ add or remove any keys from the map.
updateAddresses :: OnChainTx -> AddressMap -> AddressMap
updateAddresses :: OnChainTx -> AddressMap -> AddressMap
updateAddresses OnChainTx
tx AddressMap
utxo = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> Map CardanoAddress UtxoMap -> AddressMap
forall a b. (a -> b) -> a -> b
$ (CardanoAddress -> UtxoMap -> UtxoMap)
-> Map CardanoAddress UtxoMap -> Map CardanoAddress UtxoMap
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey CardanoAddress -> UtxoMap -> UtxoMap
upd (AddressMap -> Map CardanoAddress UtxoMap
getAddressMap AddressMap
utxo) where
    -- adds the newly produced outputs, and removes the consumed outputs, for
    -- an address `adr`
    upd :: CardanoAddress -> Map TxOutRef (CardanoTx, TxOut) -> Map TxOutRef (CardanoTx, TxOut)
    upd :: CardanoAddress -> UtxoMap -> UtxoMap
upd CardanoAddress
adr UtxoMap
mp = UtxoMap -> UtxoMap -> UtxoMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (CardanoAddress -> UtxoMap
producedAt CardanoAddress
adr) UtxoMap
mp UtxoMap -> Map TxOutRef () -> UtxoMap
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`Map.difference` CardanoAddress -> Map TxOutRef ()
consumedFrom CardanoAddress
adr

    -- The TxOutRefs produced by the transaction, for a given address
    producedAt :: CardanoAddress -> Map TxOutRef (CardanoTx, TxOut)
    producedAt :: CardanoAddress -> UtxoMap
producedAt CardanoAddress
adr = UtxoMap -> CardanoAddress -> Map CardanoAddress UtxoMap -> UtxoMap
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault UtxoMap
forall k a. Map k a
Map.empty CardanoAddress
adr Map CardanoAddress UtxoMap
outputs

    -- The TxOutRefs consumed by the transaction, for a given address
    consumedFrom :: CardanoAddress -> Map TxOutRef ()
    consumedFrom :: CardanoAddress -> Map TxOutRef ()
consumedFrom CardanoAddress
adr = Map TxOutRef ()
-> (Set TxOutRef -> Map TxOutRef ())
-> Maybe (Set TxOutRef)
-> Map TxOutRef ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map TxOutRef ()
forall k a. Map k a
Map.empty ((TxOutRef -> ()) -> Set TxOutRef -> Map TxOutRef ()
forall k a. (k -> a) -> Set k -> Map k a
Map.fromSet (() -> TxOutRef -> ()
forall a b. a -> b -> a
const ())) (Maybe (Set TxOutRef) -> Map TxOutRef ())
-> Maybe (Set TxOutRef) -> Map TxOutRef ()
forall a b. (a -> b) -> a -> b
$ CardanoAddress
-> Map CardanoAddress (Set TxOutRef) -> Maybe (Set TxOutRef)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CardanoAddress
adr Map CardanoAddress (Set TxOutRef)
consumedInputs

    AddressMap Map CardanoAddress UtxoMap
outputs = OnChainTx -> AddressMap
fromTxOutputs OnChainTx
tx

    consumedInputs :: Map CardanoAddress (Set TxOutRef)
consumedInputs = Map TxOutRef CardanoAddress
-> OnChainTx -> Map CardanoAddress (Set TxOutRef)
inputs (AddressMap -> Map TxOutRef CardanoAddress
knownAddresses AddressMap
utxo) OnChainTx
tx

-- | Update an 'AddressMap' with the inputs and outputs of a new
-- transaction, including all addresses in the transaction.
updateAllAddresses :: OnChainTx -> AddressMap -> AddressMap
-- updateAddresses handles getting rid of spent outputs, so all we have to do is add in the
-- new things. We can do this by just merging in `fromTxOutputs`, which will have many of the
-- things that are already there, but also the new things.
updateAllAddresses :: OnChainTx -> AddressMap -> AddressMap
updateAllAddresses OnChainTx
tx AddressMap
utxo = OnChainTx -> AddressMap -> AddressMap
updateAddresses OnChainTx
tx AddressMap
utxo AddressMap -> AddressMap -> AddressMap
forall a. Semigroup a => a -> a -> a
<> OnChainTx -> AddressMap
fromTxOutputs OnChainTx
tx

-- | The inputs consumed by a transaction, indexed by address.
inputs ::
    Map TxOutRef CardanoAddress
    -- ^ A map of 'TxOutRef's to their 'Address'es
    -> OnChainTx
    -> Map CardanoAddress (Set.Set TxOutRef)
inputs :: Map TxOutRef CardanoAddress
-> OnChainTx -> Map CardanoAddress (Set TxOutRef)
inputs Map TxOutRef CardanoAddress
addrs = (Set TxOutRef -> Set TxOutRef -> Set TxOutRef)
-> [(CardanoAddress, Set TxOutRef)]
-> Map CardanoAddress (Set TxOutRef)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    ([(CardanoAddress, Set TxOutRef)]
 -> Map CardanoAddress (Set TxOutRef))
-> (OnChainTx -> [(CardanoAddress, Set TxOutRef)])
-> OnChainTx
-> Map CardanoAddress (Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxOutRef, CardanoAddress) -> (CardanoAddress, Set TxOutRef))
-> [(TxOutRef, CardanoAddress)] -> [(CardanoAddress, Set TxOutRef)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxOutRef -> Set TxOutRef)
-> (CardanoAddress, TxOutRef) -> (CardanoAddress, Set TxOutRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxOutRef -> Set TxOutRef
forall a. a -> Set a
Set.singleton ((CardanoAddress, TxOutRef) -> (CardanoAddress, Set TxOutRef))
-> ((TxOutRef, CardanoAddress) -> (CardanoAddress, TxOutRef))
-> (TxOutRef, CardanoAddress)
-> (CardanoAddress, Set TxOutRef)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxOutRef, CardanoAddress) -> (CardanoAddress, TxOutRef)
forall a b. (a, b) -> (b, a)
swap)
    ([(TxOutRef, CardanoAddress)] -> [(CardanoAddress, Set TxOutRef)])
-> (OnChainTx -> [(TxOutRef, CardanoAddress)])
-> OnChainTx
-> [(CardanoAddress, Set TxOutRef)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> Maybe (TxOutRef, CardanoAddress))
-> [TxIn] -> [(TxOutRef, CardanoAddress)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((\TxOutRef
a -> (TxOutRef, Maybe CardanoAddress)
-> Maybe (TxOutRef, CardanoAddress)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (TxOutRef
a, TxOutRef -> Map TxOutRef CardanoAddress -> Maybe CardanoAddress
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
a Map TxOutRef CardanoAddress
addrs)) (TxOutRef -> Maybe (TxOutRef, CardanoAddress))
-> (TxIn -> TxOutRef) -> TxIn -> Maybe (TxOutRef, CardanoAddress)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> TxOutRef
txInRef)
    ([TxIn] -> [(TxOutRef, CardanoAddress)])
-> (OnChainTx -> [TxIn])
-> OnChainTx
-> [(TxOutRef, CardanoAddress)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainTx -> [TxIn]
consumableInputs

-- | Restrict an 'AddressMap' to a set of addresses.
restrict :: AddressMap -> Set.Set CardanoAddress -> AddressMap
restrict :: AddressMap -> Set CardanoAddress -> AddressMap
restrict (AddressMap Map CardanoAddress UtxoMap
mp) = Map CardanoAddress UtxoMap -> AddressMap
AddressMap (Map CardanoAddress UtxoMap -> AddressMap)
-> (Set CardanoAddress -> Map CardanoAddress UtxoMap)
-> Set CardanoAddress
-> AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map CardanoAddress UtxoMap
-> Set CardanoAddress -> Map CardanoAddress UtxoMap
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map CardanoAddress UtxoMap
mp

swap :: (a, b) -> (b, a)
swap :: (a, b) -> (b, a)
swap (a
x, b
y) = (b
y, a
x)

-- | Get the set of all addresses that the transaction spends outputs from
--   or produces outputs to
addressesTouched :: AddressMap -> OnChainTx -> Set.Set CardanoAddress
addressesTouched :: AddressMap -> OnChainTx -> Set CardanoAddress
addressesTouched AddressMap
utxo OnChainTx
t = Set CardanoAddress
ins Set CardanoAddress -> Set CardanoAddress -> Set CardanoAddress
forall a. Semigroup a => a -> a -> a
<> Set CardanoAddress
outs where
    ins :: Set CardanoAddress
ins = Map CardanoAddress (Set TxOutRef) -> Set CardanoAddress
forall k a. Map k a -> Set k
Map.keysSet (Map TxOutRef CardanoAddress
-> OnChainTx -> Map CardanoAddress (Set TxOutRef)
inputs (AddressMap -> Map TxOutRef CardanoAddress
knownAddresses AddressMap
utxo) OnChainTx
t)
    outs :: Set CardanoAddress
outs = Map CardanoAddress UtxoMap -> Set CardanoAddress
forall k a. Map k a -> Set k
Map.keysSet (AddressMap -> Map CardanoAddress UtxoMap
getAddressMap (OnChainTx -> AddressMap
fromTxOutputs OnChainTx
t))

-- | The unspent transaction outputs of the ledger as a whole.
fromChain :: Blockchain -> AddressMap
fromChain :: Blockchain -> AddressMap
fromChain = (OnChainTx -> AddressMap -> AddressMap)
-> AddressMap -> [OnChainTx] -> AddressMap
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr OnChainTx -> AddressMap -> AddressMap
updateAllAddresses AddressMap
forall a. Monoid a => a
mempty ([OnChainTx] -> AddressMap)
-> (Blockchain -> [OnChainTx]) -> Blockchain -> AddressMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Blockchain -> [OnChainTx]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join