{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia   #-}
{-# LANGUAGE Rank2Types    #-}
{-# 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,
    fundsAt,
    values,
    traverseWithKey,
    singleton,
    updateAddresses,
    updateAllAddresses,
    lookupOutRef,
    fromChain
    ) where

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

import Cardano.Api qualified as C
import Ledger.Address (CardanoAddress)
import Ledger.Blockchain (Blockchain, OnChainTx, consumableInputs, outputsProduced, unOnChain)
import Ledger.Tx (CardanoTx, TxOut (..), txOutAddress, txOutValue)

type UtxoMap = Map C.TxIn (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)

-- | An address map with a single unspent transaction output.
singleton :: (CardanoAddress, C.TxIn, CardanoTx, TxOut) -> AddressMap
singleton :: (CardanoAddress, TxIn, CardanoTx, TxOut) -> AddressMap
singleton (CardanoAddress
addr, TxIn
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 (TxIn -> (CardanoTx, TxOut) -> UtxoMap
forall k a. k -> a -> Map k a
Map.singleton TxIn
ref (CardanoTx
tx, TxOut
ot))

-- | Determine the unspent output that an input refers to
lookupOutRef :: C.TxIn -> AddressMap -> Maybe TxOut
lookupOutRef :: TxIn -> AddressMap -> Maybe TxOut
lookupOutRef TxIn
outRef = ((CardanoTx, TxOut) -> TxOut)
-> Maybe (CardanoTx, TxOut) -> Maybe TxOut
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CardanoTx, TxOut) -> TxOut
forall a b. (a, b) -> b
snd (Maybe (CardanoTx, TxOut) -> Maybe TxOut)
-> (AddressMap -> Maybe (CardanoTx, TxOut))
-> AddressMap
-> Maybe TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped (First (CardanoTx, TxOut)) -> First (CardanoTx, TxOut))
-> ((UtxoMap -> First (CardanoTx, TxOut))
    -> Map CardanoAddress UtxoMap -> First (CardanoTx, TxOut))
-> (UtxoMap -> Unwrapped (First (CardanoTx, TxOut)))
-> Map CardanoAddress UtxoMap
-> Unwrapped (First (CardanoTx, TxOut))
forall (f :: * -> *) (g :: * -> *) s t.
(Functor f, Functor g, Rewrapping s t) =>
(Unwrapped s -> s)
-> (f t -> g s) -> f (Unwrapped t) -> g (Unwrapped s)
alaf Unwrapped (First (CardanoTx, TxOut)) -> First (CardanoTx, TxOut)
forall a. Maybe a -> First a
First (UtxoMap -> First (CardanoTx, TxOut))
-> Map CardanoAddress UtxoMap -> First (CardanoTx, TxOut)
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (TxIn -> UtxoMap -> Maybe (CardanoTx, TxOut)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
outRef) (Map CardanoAddress UtxoMap -> Maybe (CardanoTx, TxOut))
-> (AddressMap -> Map CardanoAddress UtxoMap)
-> AddressMap
-> Maybe (CardanoTx, TxOut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressMap -> Map CardanoAddress UtxoMap
getAddressMap

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 TxIn a -> Map TxIn a -> Map TxIn a
add Map CardanoAddress UtxoMap
l Map CardanoAddress UtxoMap
r) where
        add :: Map TxIn a -> Map TxIn a -> Map TxIn a
add = Map TxIn a -> Map TxIn a -> Map TxIn 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 C.TxIn (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 Index AddressMap
CardanoAddress
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 C.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 TxIn Value -> Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map TxIn Value -> Value)
-> (UtxoMap -> Map TxIn Value) -> UtxoMap -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CardanoTx, TxOut) -> Value) -> UtxoMap -> Map TxIn 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 C.TxIn (CardanoTx, TxOut) -> f (Map C.TxIn (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

-- | 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
. ((TxIn, TxOut) -> (CardanoAddress, UtxoMap))
-> [(TxIn, TxOut)] -> [(CardanoAddress, UtxoMap)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxIn, TxOut) -> (CardanoAddress, UtxoMap)
mkUtxo ([(TxIn, TxOut)] -> [(CardanoAddress, UtxoMap)])
-> (OnChainTx -> [(TxIn, TxOut)])
-> OnChainTx
-> [(CardanoAddress, UtxoMap)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> [(TxIn, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxIn TxOut -> [(TxIn, TxOut)])
-> (OnChainTx -> Map TxIn TxOut) -> OnChainTx -> [(TxIn, TxOut)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainTx -> Map TxIn TxOut
outputsProduced (OnChainTx -> AddressMap) -> OnChainTx -> AddressMap
forall a b. (a -> b) -> a -> b
$ OnChainTx
tx where
    mkUtxo :: (TxIn, TxOut) -> (CardanoAddress, UtxoMap)
mkUtxo (TxIn
ref, TxOut
txo) = (TxOut -> CardanoAddress
txOutAddress TxOut
txo, TxIn -> (CardanoTx, TxOut) -> UtxoMap
forall k a. k -> a -> Map k a
Map.singleton TxIn
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 C.TxIn CardanoAddress
knownAddresses :: AddressMap -> Map TxIn CardanoAddress
knownAddresses = [(TxIn, CardanoAddress)] -> Map TxIn CardanoAddress
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxIn, CardanoAddress)] -> Map TxIn CardanoAddress)
-> (AddressMap -> [(TxIn, CardanoAddress)])
-> AddressMap
-> Map TxIn CardanoAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(CardanoAddress, UtxoMap)] -> [(TxIn, CardanoAddress)]
unRef ([(CardanoAddress, UtxoMap)] -> [(TxIn, CardanoAddress)])
-> (AddressMap -> [(CardanoAddress, UtxoMap)])
-> AddressMap
-> [(TxIn, 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 C.TxIn (CardanoTx, TxOut))] -> [(C.TxIn, CardanoAddress)]
    unRef :: [(CardanoAddress, UtxoMap)] -> [(TxIn, CardanoAddress)]
unRef [(CardanoAddress, UtxoMap)]
lst = do
        (CardanoAddress
a, UtxoMap
outRefs) <- [(CardanoAddress, UtxoMap)]
lst
        (TxIn
rf, (CardanoTx, TxOut)
_) <- UtxoMap -> [(TxIn, (CardanoTx, TxOut))]
forall k a. Map k a -> [(k, a)]
Map.toList UtxoMap
outRefs
        (TxIn, CardanoAddress) -> [(TxIn, CardanoAddress)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxIn
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 C.TxIn (CardanoTx, TxOut) -> Map C.TxIn (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 -> Set TxIn -> UtxoMap
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` CardanoAddress -> Set TxIn
consumedFrom CardanoAddress
adr

    -- The TxOutRefs produced by the transaction, for a given address
    producedAt :: CardanoAddress -> Map C.TxIn (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 a. Monoid a => a
mempty CardanoAddress
adr Map CardanoAddress UtxoMap
outputs

    -- The TxOutRefs consumed by the transaction, for a given address
    consumedFrom :: CardanoAddress -> Set.Set C.TxIn
    consumedFrom :: CardanoAddress -> Set TxIn
consumedFrom CardanoAddress
adr = Set TxIn
-> CardanoAddress -> Map CardanoAddress (Set TxIn) -> Set TxIn
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set TxIn
forall a. Monoid a => a
mempty CardanoAddress
adr Map CardanoAddress (Set TxIn)
consumedInputs

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

    consumedInputs :: Map CardanoAddress (Set TxIn)
consumedInputs = Map TxIn CardanoAddress
-> OnChainTx -> Map CardanoAddress (Set TxIn)
inputs (AddressMap -> Map TxIn 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 C.TxIn CardanoAddress
    -- ^ A map of 'TxOutRef's to their 'Address'es
    -> OnChainTx
    -> Map CardanoAddress (Set.Set C.TxIn)
inputs :: Map TxIn CardanoAddress
-> OnChainTx -> Map CardanoAddress (Set TxIn)
inputs Map TxIn CardanoAddress
addrs = (Set TxIn -> Set TxIn -> Set TxIn)
-> [(CardanoAddress, Set TxIn)] -> Map CardanoAddress (Set TxIn)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
Set.union
    ([(CardanoAddress, Set TxIn)] -> Map CardanoAddress (Set TxIn))
-> (OnChainTx -> [(CardanoAddress, Set TxIn)])
-> OnChainTx
-> Map CardanoAddress (Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TxIn, CardanoAddress) -> (CardanoAddress, Set TxIn))
-> [(TxIn, CardanoAddress)] -> [(CardanoAddress, Set TxIn)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxIn -> Set TxIn)
-> (CardanoAddress, TxIn) -> (CardanoAddress, Set TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton ((CardanoAddress, TxIn) -> (CardanoAddress, Set TxIn))
-> ((TxIn, CardanoAddress) -> (CardanoAddress, TxIn))
-> (TxIn, CardanoAddress)
-> (CardanoAddress, Set TxIn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn, CardanoAddress) -> (CardanoAddress, TxIn)
forall a b. (a, b) -> (b, a)
swap)
    ([(TxIn, CardanoAddress)] -> [(CardanoAddress, Set TxIn)])
-> (OnChainTx -> [(TxIn, CardanoAddress)])
-> OnChainTx
-> [(CardanoAddress, Set TxIn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxIn -> Maybe (TxIn, CardanoAddress))
-> [TxIn] -> [(TxIn, CardanoAddress)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\TxIn
a -> (TxIn, Maybe CardanoAddress) -> Maybe (TxIn, CardanoAddress)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (TxIn
a, TxIn -> Map TxIn CardanoAddress -> Maybe CardanoAddress
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
a Map TxIn CardanoAddress
addrs))
    ([TxIn] -> [(TxIn, CardanoAddress)])
-> (OnChainTx -> [TxIn]) -> OnChainTx -> [(TxIn, CardanoAddress)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnChainTx -> [TxIn]
consumableInputs

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

-- | 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