{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

-- | Support for visualisation of a blockchain as a graph.
module Wallet.Graph
  ( txnFlows
  , graph
  , FlowGraph
  , FlowLink
  , TxRef
  , UtxOwner
  , UtxoLocation
  ) where

import Data.Aeson.Types (ToJSON, toJSON)
import Data.List (nub)
import Data.Map qualified as Map
import Data.Maybe (catMaybes)
import Data.Set qualified as Set
import Data.Text qualified as Text
import GHC.Generics (Generic)

import Ledger.Ada qualified as Ada
import Ledger.Address
import Ledger.Blockchain
import Ledger.Credential (Credential (..))
import Ledger.Crypto
import Ledger.Tx

-- | The owner of an unspent transaction output.
data UtxOwner
  = PubKeyOwner PubKey
    -- ^ Funds owned by a known public key.
  | ScriptOwner
    -- ^ Funds locked by script.
  | OtherOwner
    -- ^ All other funds (that is, funds owned by a public key we are not interested in).
  deriving (UtxOwner -> UtxOwner -> Bool
(UtxOwner -> UtxOwner -> Bool)
-> (UtxOwner -> UtxOwner -> Bool) -> Eq UtxOwner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxOwner -> UtxOwner -> Bool
$c/= :: UtxOwner -> UtxOwner -> Bool
== :: UtxOwner -> UtxOwner -> Bool
$c== :: UtxOwner -> UtxOwner -> Bool
Eq, Eq UtxOwner
Eq UtxOwner
-> (UtxOwner -> UtxOwner -> Ordering)
-> (UtxOwner -> UtxOwner -> Bool)
-> (UtxOwner -> UtxOwner -> Bool)
-> (UtxOwner -> UtxOwner -> Bool)
-> (UtxOwner -> UtxOwner -> Bool)
-> (UtxOwner -> UtxOwner -> UtxOwner)
-> (UtxOwner -> UtxOwner -> UtxOwner)
-> Ord UtxOwner
UtxOwner -> UtxOwner -> Bool
UtxOwner -> UtxOwner -> Ordering
UtxOwner -> UtxOwner -> UtxOwner
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 :: UtxOwner -> UtxOwner -> UtxOwner
$cmin :: UtxOwner -> UtxOwner -> UtxOwner
max :: UtxOwner -> UtxOwner -> UtxOwner
$cmax :: UtxOwner -> UtxOwner -> UtxOwner
>= :: UtxOwner -> UtxOwner -> Bool
$c>= :: UtxOwner -> UtxOwner -> Bool
> :: UtxOwner -> UtxOwner -> Bool
$c> :: UtxOwner -> UtxOwner -> Bool
<= :: UtxOwner -> UtxOwner -> Bool
$c<= :: UtxOwner -> UtxOwner -> Bool
< :: UtxOwner -> UtxOwner -> Bool
$c< :: UtxOwner -> UtxOwner -> Bool
compare :: UtxOwner -> UtxOwner -> Ordering
$ccompare :: UtxOwner -> UtxOwner -> Ordering
$cp1Ord :: Eq UtxOwner
Ord, Int -> UtxOwner -> ShowS
[UtxOwner] -> ShowS
UtxOwner -> String
(Int -> UtxOwner -> ShowS)
-> (UtxOwner -> String) -> ([UtxOwner] -> ShowS) -> Show UtxOwner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxOwner] -> ShowS
$cshowList :: [UtxOwner] -> ShowS
show :: UtxOwner -> String
$cshow :: UtxOwner -> String
showsPrec :: Int -> UtxOwner -> ShowS
$cshowsPrec :: Int -> UtxOwner -> ShowS
Show, (forall x. UtxOwner -> Rep UtxOwner x)
-> (forall x. Rep UtxOwner x -> UtxOwner) -> Generic UtxOwner
forall x. Rep UtxOwner x -> UtxOwner
forall x. UtxOwner -> Rep UtxOwner x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxOwner x -> UtxOwner
$cfrom :: forall x. UtxOwner -> Rep UtxOwner x
Generic, [UtxOwner] -> Encoding
[UtxOwner] -> Value
UtxOwner -> Encoding
UtxOwner -> Value
(UtxOwner -> Value)
-> (UtxOwner -> Encoding)
-> ([UtxOwner] -> Value)
-> ([UtxOwner] -> Encoding)
-> ToJSON UtxOwner
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxOwner] -> Encoding
$ctoEncodingList :: [UtxOwner] -> Encoding
toJSONList :: [UtxOwner] -> Value
$ctoJSONList :: [UtxOwner] -> Value
toEncoding :: UtxOwner -> Encoding
$ctoEncoding :: UtxOwner -> Encoding
toJSON :: UtxOwner -> Value
$ctoJSON :: UtxOwner -> Value
ToJSON)

-- | Given a set of known public keys, compute the owner of a given transaction output.
owner :: Set.Set PubKey -> TxOut -> UtxOwner
owner :: Set PubKey -> TxOut -> UtxOwner
owner Set PubKey
keys TxOut
tx =
  let hashMap :: Map PubKeyHash PubKey
hashMap = (PubKey -> Map PubKeyHash PubKey)
-> Set PubKey -> Map PubKeyHash PubKey
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\PubKey
pk -> PubKeyHash -> PubKey -> Map PubKeyHash PubKey
forall k a. k -> a -> Map k a
Map.singleton (PubKey -> PubKeyHash
pubKeyHash PubKey
pk) PubKey
pk) Set PubKey
keys
  in case AddressInEra BabbageEra -> Credential
forall era. AddressInEra era -> Credential
cardanoAddressCredential (TxOut -> AddressInEra BabbageEra
txOutAddress TxOut
tx) of
    ScriptCredential{}                                       -> UtxOwner
ScriptOwner
    PubKeyCredential PubKeyHash
pkh | Just PubKey
pk <- PubKeyHash -> Map PubKeyHash PubKey -> Maybe PubKey
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PubKeyHash
pkh Map PubKeyHash PubKey
hashMap -> PubKey -> UtxOwner
PubKeyOwner PubKey
pk
    Credential
_                                                        -> UtxOwner
OtherOwner

-- | A wrapper around the first 8 digits of a 'TxId'.
newtype TxRef =
  TxRef Text.Text
  deriving (TxRef -> TxRef -> Bool
(TxRef -> TxRef -> Bool) -> (TxRef -> TxRef -> Bool) -> Eq TxRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxRef -> TxRef -> Bool
$c/= :: TxRef -> TxRef -> Bool
== :: TxRef -> TxRef -> Bool
$c== :: TxRef -> TxRef -> Bool
Eq, Eq TxRef
Eq TxRef
-> (TxRef -> TxRef -> Ordering)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> Bool)
-> (TxRef -> TxRef -> TxRef)
-> (TxRef -> TxRef -> TxRef)
-> Ord TxRef
TxRef -> TxRef -> Bool
TxRef -> TxRef -> Ordering
TxRef -> TxRef -> TxRef
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 :: TxRef -> TxRef -> TxRef
$cmin :: TxRef -> TxRef -> TxRef
max :: TxRef -> TxRef -> TxRef
$cmax :: TxRef -> TxRef -> TxRef
>= :: TxRef -> TxRef -> Bool
$c>= :: TxRef -> TxRef -> Bool
> :: TxRef -> TxRef -> Bool
$c> :: TxRef -> TxRef -> Bool
<= :: TxRef -> TxRef -> Bool
$c<= :: TxRef -> TxRef -> Bool
< :: TxRef -> TxRef -> Bool
$c< :: TxRef -> TxRef -> Bool
compare :: TxRef -> TxRef -> Ordering
$ccompare :: TxRef -> TxRef -> Ordering
$cp1Ord :: Eq TxRef
Ord, Int -> TxRef -> ShowS
[TxRef] -> ShowS
TxRef -> String
(Int -> TxRef -> ShowS)
-> (TxRef -> String) -> ([TxRef] -> ShowS) -> Show TxRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxRef] -> ShowS
$cshowList :: [TxRef] -> ShowS
show :: TxRef -> String
$cshow :: TxRef -> String
showsPrec :: Int -> TxRef -> ShowS
$cshowsPrec :: Int -> TxRef -> ShowS
Show, (forall x. TxRef -> Rep TxRef x)
-> (forall x. Rep TxRef x -> TxRef) -> Generic TxRef
forall x. Rep TxRef x -> TxRef
forall x. TxRef -> Rep TxRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxRef x -> TxRef
$cfrom :: forall x. TxRef -> Rep TxRef x
Generic)

instance ToJSON TxRef where
  toJSON :: TxRef -> Value
toJSON (TxRef Text
t) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
t

mkRef :: TxId -> TxRef
mkRef :: TxId -> TxRef
mkRef = Text -> TxRef
TxRef (Text -> TxRef) -> (TxId -> Text) -> TxId -> TxRef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (TxId -> String) -> TxId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 ShowS -> (TxId -> String) -> TxId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> String
forall a. Show a => a -> String
show (BuiltinByteString -> String)
-> (TxId -> BuiltinByteString) -> TxId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> BuiltinByteString
getTxId

-- | The location of a transaction in a blockchain specified by two indices: the index of the containing
-- block in the chain, and the index of the transaction within the block.
data UtxoLocation = UtxoLocation
  { UtxoLocation -> Integer
utxoLocBlock    :: Integer
  , UtxoLocation -> Integer
utxoLocBlockIdx :: Integer
  } deriving (UtxoLocation -> UtxoLocation -> Bool
(UtxoLocation -> UtxoLocation -> Bool)
-> (UtxoLocation -> UtxoLocation -> Bool) -> Eq UtxoLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UtxoLocation -> UtxoLocation -> Bool
$c/= :: UtxoLocation -> UtxoLocation -> Bool
== :: UtxoLocation -> UtxoLocation -> Bool
$c== :: UtxoLocation -> UtxoLocation -> Bool
Eq, Eq UtxoLocation
Eq UtxoLocation
-> (UtxoLocation -> UtxoLocation -> Ordering)
-> (UtxoLocation -> UtxoLocation -> Bool)
-> (UtxoLocation -> UtxoLocation -> Bool)
-> (UtxoLocation -> UtxoLocation -> Bool)
-> (UtxoLocation -> UtxoLocation -> Bool)
-> (UtxoLocation -> UtxoLocation -> UtxoLocation)
-> (UtxoLocation -> UtxoLocation -> UtxoLocation)
-> Ord UtxoLocation
UtxoLocation -> UtxoLocation -> Bool
UtxoLocation -> UtxoLocation -> Ordering
UtxoLocation -> UtxoLocation -> UtxoLocation
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 :: UtxoLocation -> UtxoLocation -> UtxoLocation
$cmin :: UtxoLocation -> UtxoLocation -> UtxoLocation
max :: UtxoLocation -> UtxoLocation -> UtxoLocation
$cmax :: UtxoLocation -> UtxoLocation -> UtxoLocation
>= :: UtxoLocation -> UtxoLocation -> Bool
$c>= :: UtxoLocation -> UtxoLocation -> Bool
> :: UtxoLocation -> UtxoLocation -> Bool
$c> :: UtxoLocation -> UtxoLocation -> Bool
<= :: UtxoLocation -> UtxoLocation -> Bool
$c<= :: UtxoLocation -> UtxoLocation -> Bool
< :: UtxoLocation -> UtxoLocation -> Bool
$c< :: UtxoLocation -> UtxoLocation -> Bool
compare :: UtxoLocation -> UtxoLocation -> Ordering
$ccompare :: UtxoLocation -> UtxoLocation -> Ordering
$cp1Ord :: Eq UtxoLocation
Ord, Int -> UtxoLocation -> ShowS
[UtxoLocation] -> ShowS
UtxoLocation -> String
(Int -> UtxoLocation -> ShowS)
-> (UtxoLocation -> String)
-> ([UtxoLocation] -> ShowS)
-> Show UtxoLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UtxoLocation] -> ShowS
$cshowList :: [UtxoLocation] -> ShowS
show :: UtxoLocation -> String
$cshow :: UtxoLocation -> String
showsPrec :: Int -> UtxoLocation -> ShowS
$cshowsPrec :: Int -> UtxoLocation -> ShowS
Show, (forall x. UtxoLocation -> Rep UtxoLocation x)
-> (forall x. Rep UtxoLocation x -> UtxoLocation)
-> Generic UtxoLocation
forall x. Rep UtxoLocation x -> UtxoLocation
forall x. UtxoLocation -> Rep UtxoLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UtxoLocation x -> UtxoLocation
$cfrom :: forall x. UtxoLocation -> Rep UtxoLocation x
Generic, [UtxoLocation] -> Encoding
[UtxoLocation] -> Value
UtxoLocation -> Encoding
UtxoLocation -> Value
(UtxoLocation -> Value)
-> (UtxoLocation -> Encoding)
-> ([UtxoLocation] -> Value)
-> ([UtxoLocation] -> Encoding)
-> ToJSON UtxoLocation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UtxoLocation] -> Encoding
$ctoEncodingList :: [UtxoLocation] -> Encoding
toJSONList :: [UtxoLocation] -> Value
$ctoJSONList :: [UtxoLocation] -> Value
toEncoding :: UtxoLocation -> Encoding
$ctoEncoding :: UtxoLocation -> Encoding
toJSON :: UtxoLocation -> Value
$ctoJSON :: UtxoLocation -> Value
ToJSON)

-- | A link in the flow graph.
data FlowLink = FlowLink
  { FlowLink -> TxRef
flowLinkSource    :: TxRef -- ^ The source transaction.
  , FlowLink -> TxRef
flowLinkTarget    :: TxRef -- ^ The target transaction.
  , FlowLink -> Integer
flowLinkValue     :: Integer -- ^ The value of Ada along this edge.
  , FlowLink -> UtxOwner
flowLinkOwner     :: UtxOwner -- ^ The owner of this edge.
  , FlowLink -> UtxoLocation
flowLinkSourceLoc :: UtxoLocation -- ^ The location of the source transaction.
  , FlowLink -> Maybe UtxoLocation
flowLinkTargetLoc :: Maybe UtxoLocation -- ^ The location of the target transaction, if 'Nothing' then it is unspent.
  } deriving (Int -> FlowLink -> ShowS
[FlowLink] -> ShowS
FlowLink -> String
(Int -> FlowLink -> ShowS)
-> (FlowLink -> String) -> ([FlowLink] -> ShowS) -> Show FlowLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowLink] -> ShowS
$cshowList :: [FlowLink] -> ShowS
show :: FlowLink -> String
$cshow :: FlowLink -> String
showsPrec :: Int -> FlowLink -> ShowS
$cshowsPrec :: Int -> FlowLink -> ShowS
Show, (forall x. FlowLink -> Rep FlowLink x)
-> (forall x. Rep FlowLink x -> FlowLink) -> Generic FlowLink
forall x. Rep FlowLink x -> FlowLink
forall x. FlowLink -> Rep FlowLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlowLink x -> FlowLink
$cfrom :: forall x. FlowLink -> Rep FlowLink x
Generic, [FlowLink] -> Encoding
[FlowLink] -> Value
FlowLink -> Encoding
FlowLink -> Value
(FlowLink -> Value)
-> (FlowLink -> Encoding)
-> ([FlowLink] -> Value)
-> ([FlowLink] -> Encoding)
-> ToJSON FlowLink
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FlowLink] -> Encoding
$ctoEncodingList :: [FlowLink] -> Encoding
toJSONList :: [FlowLink] -> Value
$ctoJSONList :: [FlowLink] -> Value
toEncoding :: FlowLink -> Encoding
$ctoEncoding :: FlowLink -> Encoding
toJSON :: FlowLink -> Value
$ctoJSON :: FlowLink -> Value
ToJSON)

-- | The flow graph, consisting of a set of nodes ('TxRef's) and edges ('FlowLink's).
data FlowGraph = FlowGraph
  { FlowGraph -> [FlowLink]
flowGraphLinks :: [FlowLink]
  , FlowGraph -> [TxRef]
flowGraphNodes :: [TxRef]
  } deriving (Int -> FlowGraph -> ShowS
[FlowGraph] -> ShowS
FlowGraph -> String
(Int -> FlowGraph -> ShowS)
-> (FlowGraph -> String)
-> ([FlowGraph] -> ShowS)
-> Show FlowGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlowGraph] -> ShowS
$cshowList :: [FlowGraph] -> ShowS
show :: FlowGraph -> String
$cshow :: FlowGraph -> String
showsPrec :: Int -> FlowGraph -> ShowS
$cshowsPrec :: Int -> FlowGraph -> ShowS
Show, (forall x. FlowGraph -> Rep FlowGraph x)
-> (forall x. Rep FlowGraph x -> FlowGraph) -> Generic FlowGraph
forall x. Rep FlowGraph x -> FlowGraph
forall x. FlowGraph -> Rep FlowGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FlowGraph x -> FlowGraph
$cfrom :: forall x. FlowGraph -> Rep FlowGraph x
Generic, [FlowGraph] -> Encoding
[FlowGraph] -> Value
FlowGraph -> Encoding
FlowGraph -> Value
(FlowGraph -> Value)
-> (FlowGraph -> Encoding)
-> ([FlowGraph] -> Value)
-> ([FlowGraph] -> Encoding)
-> ToJSON FlowGraph
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FlowGraph] -> Encoding
$ctoEncodingList :: [FlowGraph] -> Encoding
toJSONList :: [FlowGraph] -> Value
$ctoJSONList :: [FlowGraph] -> Value
toEncoding :: FlowGraph -> Encoding
$ctoEncoding :: FlowGraph -> Encoding
toJSON :: FlowGraph -> Value
$ctoJSON :: FlowGraph -> Value
ToJSON)

-- | Construct a graph from a list of 'FlowLink's.
graph :: [FlowLink] -> FlowGraph
graph :: [FlowLink] -> FlowGraph
graph [FlowLink]
lnks = FlowGraph :: [FlowLink] -> [TxRef] -> FlowGraph
FlowGraph {[FlowLink]
[TxRef]
flowGraphNodes :: [TxRef]
flowGraphLinks :: [FlowLink]
flowGraphNodes :: [TxRef]
flowGraphLinks :: [FlowLink]
..}
  where
    flowGraphLinks :: [FlowLink]
flowGraphLinks = [FlowLink]
lnks
    flowGraphNodes :: [TxRef]
flowGraphNodes = [TxRef] -> [TxRef]
forall a. Eq a => [a] -> [a]
nub ([TxRef] -> [TxRef]) -> [TxRef] -> [TxRef]
forall a b. (a -> b) -> a -> b
$ (FlowLink -> TxRef) -> [FlowLink] -> [TxRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlowLink -> TxRef
flowLinkSource [FlowLink]
lnks [TxRef] -> [TxRef] -> [TxRef]
forall a. [a] -> [a] -> [a]
++ (FlowLink -> TxRef) -> [FlowLink] -> [TxRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlowLink -> TxRef
flowLinkTarget [FlowLink]
lnks

-- | Compute the 'FlowLink's for a 'Blockchain' given a set of known 'PubKey's.
txnFlows :: [PubKey] -> Blockchain -> [FlowLink]
txnFlows :: [PubKey] -> Blockchain -> [FlowLink]
txnFlows [PubKey]
keys Blockchain
bc = [Maybe FlowLink] -> [FlowLink]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FlowLink]
utxoLinks [Maybe FlowLink] -> [Maybe FlowLink] -> [Maybe FlowLink]
forall a. [a] -> [a] -> [a]
++ ((UtxoLocation, OnChainTx) -> [Maybe FlowLink])
-> [(UtxoLocation, OnChainTx)] -> [Maybe FlowLink]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (UtxoLocation, OnChainTx) -> [Maybe FlowLink]
extract [(UtxoLocation, OnChainTx)]
bc')
  where
    bc' :: [(UtxoLocation, OnChainTx)]
bc' = ((Integer, [(Integer, OnChainTx)]) -> [(UtxoLocation, OnChainTx)])
-> [(Integer, [(Integer, OnChainTx)])]
-> [(UtxoLocation, OnChainTx)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Integer
blockNum, [(Integer, OnChainTx)]
txns) -> ((Integer, OnChainTx) -> (UtxoLocation, OnChainTx))
-> [(Integer, OnChainTx)] -> [(UtxoLocation, OnChainTx)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
blockIdx, OnChainTx
txn) -> (Integer -> Integer -> UtxoLocation
UtxoLocation Integer
blockNum Integer
blockIdx, OnChainTx
txn)) [(Integer, OnChainTx)]
txns) ([(Integer, [(Integer, OnChainTx)])]
 -> [(UtxoLocation, OnChainTx)])
-> [(Integer, [(Integer, OnChainTx)])]
-> [(UtxoLocation, OnChainTx)]
forall a b. (a -> b) -> a -> b
$ [[(Integer, OnChainTx)]] -> [(Integer, [(Integer, OnChainTx)])]
forall b. [b] -> [(Integer, b)]
zipWithIndex ([[(Integer, OnChainTx)]] -> [(Integer, [(Integer, OnChainTx)])])
-> [[(Integer, OnChainTx)]] -> [(Integer, [(Integer, OnChainTx)])]
forall a b. (a -> b) -> a -> b
$ [OnChainTx] -> [(Integer, OnChainTx)]
forall b. [b] -> [(Integer, b)]
zipWithIndex ([OnChainTx] -> [(Integer, OnChainTx)])
-> Blockchain -> [[(Integer, OnChainTx)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blockchain -> Blockchain
forall a. [a] -> [a]
reverse Blockchain
bc

    sourceLocations :: Map.Map TxOutRef UtxoLocation
    sourceLocations :: Map TxOutRef UtxoLocation
sourceLocations = [(TxOutRef, UtxoLocation)] -> Map TxOutRef UtxoLocation
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(TxOutRef, UtxoLocation)] -> Map TxOutRef UtxoLocation)
-> [(TxOutRef, UtxoLocation)] -> Map TxOutRef UtxoLocation
forall a b. (a -> b) -> a -> b
$ ((UtxoLocation, OnChainTx) -> [(TxOutRef, UtxoLocation)])
-> [(UtxoLocation, OnChainTx)] -> [(TxOutRef, UtxoLocation)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((UtxoLocation -> OnChainTx -> [(TxOutRef, UtxoLocation)])
-> (UtxoLocation, OnChainTx) -> [(TxOutRef, UtxoLocation)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry UtxoLocation -> OnChainTx -> [(TxOutRef, UtxoLocation)]
outRefsWithLoc) [(UtxoLocation, OnChainTx)]
bc'

    knownKeys :: Set.Set PubKey
    knownKeys :: Set PubKey
knownKeys = [PubKey] -> Set PubKey
forall a. Ord a => [a] -> Set a
Set.fromList [PubKey]
keys

    utxos :: [TxOutRef]
utxos = ((TxOutRef, TxOut) -> TxOutRef)
-> [(TxOutRef, TxOut)] -> [TxOutRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TxOutRef, TxOut) -> TxOutRef
forall a b. (a, b) -> a
fst ([(TxOutRef, TxOut)] -> [TxOutRef])
-> [(TxOutRef, TxOut)] -> [TxOutRef]
forall a b. (a -> b) -> a -> b
$ Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map TxOutRef TxOut -> [(TxOutRef, TxOut)])
-> Map TxOutRef TxOut -> [(TxOutRef, TxOut)]
forall a b. (a -> b) -> a -> b
$ Blockchain -> Map TxOutRef TxOut
unspentOutputs Blockchain
bc
    utxoLinks :: [Maybe FlowLink]
utxoLinks = (TxRef -> TxOutRef -> Maybe FlowLink)
-> (TxRef, TxOutRef) -> Maybe FlowLink
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Maybe UtxoLocation -> TxRef -> TxOutRef -> Maybe FlowLink
flow Maybe UtxoLocation
forall a. Maybe a
Nothing) ((TxRef, TxOutRef) -> Maybe FlowLink)
-> [(TxRef, TxOutRef)] -> [Maybe FlowLink]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxRef] -> [TxOutRef] -> [(TxRef, TxOutRef)]
forall a b. [a] -> [b] -> [(a, b)]
zip (TxOutRef -> TxRef
utxoTargets (TxOutRef -> TxRef) -> [TxOutRef] -> [TxRef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxOutRef]
utxos) [TxOutRef]
utxos

    extract :: (UtxoLocation, OnChainTx) -> [Maybe FlowLink]
    extract :: (UtxoLocation, OnChainTx) -> [Maybe FlowLink]
extract (UtxoLocation
loc, OnChainTx
tx) =
      let targetRef :: TxRef
targetRef = TxId -> TxRef
mkRef (TxId -> TxRef) -> TxId -> TxRef
forall a b. (a -> b) -> a -> b
$ CardanoTx -> TxId
getCardanoTxId (CardanoTx -> TxId) -> CardanoTx -> TxId
forall a b. (a -> b) -> a -> b
$ OnChainTx -> CardanoTx
unOnChain OnChainTx
tx in
      (TxIn -> Maybe FlowLink) -> [TxIn] -> [Maybe FlowLink]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe UtxoLocation -> TxRef -> TxOutRef -> Maybe FlowLink
flow (UtxoLocation -> Maybe UtxoLocation
forall a. a -> Maybe a
Just UtxoLocation
loc) TxRef
targetRef (TxOutRef -> Maybe FlowLink)
-> (TxIn -> TxOutRef) -> TxIn -> Maybe FlowLink
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> TxOutRef
txInRef) (OnChainTx -> [TxIn]
consumableInputs OnChainTx
tx)
    -- make a flow for a TxOutRef

    flow :: Maybe UtxoLocation -> TxRef -> TxOutRef -> Maybe FlowLink
    flow :: Maybe UtxoLocation -> TxRef -> TxOutRef -> Maybe FlowLink
flow Maybe UtxoLocation
tgtLoc TxRef
tgtRef TxOutRef
rf = do
      TxOut
src <- Blockchain -> TxOutRef -> Maybe TxOut
out Blockchain
bc TxOutRef
rf
      UtxoLocation
sourceLoc <- TxOutRef -> Map TxOutRef UtxoLocation -> Maybe UtxoLocation
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxOutRef
rf Map TxOutRef UtxoLocation
sourceLocations
      let sourceRef :: TxRef
sourceRef = TxId -> TxRef
mkRef (TxId -> TxRef) -> TxId -> TxRef
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TxId
txOutRefId TxOutRef
rf
      FlowLink -> Maybe FlowLink
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlowLink :: TxRef
-> TxRef
-> Integer
-> UtxOwner
-> UtxoLocation
-> Maybe UtxoLocation
-> FlowLink
FlowLink
            { flowLinkSource :: TxRef
flowLinkSource = TxRef
sourceRef
            , flowLinkTarget :: TxRef
flowLinkTarget = TxRef
tgtRef
            , flowLinkValue :: Integer
flowLinkValue = Ada -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ada -> Integer) -> Ada -> Integer
forall a b. (a -> b) -> a -> b
$ Value -> Ada
Ada.fromValue (Value -> Ada) -> Value -> Ada
forall a b. (a -> b) -> a -> b
$ TxOut -> Value
txOutValue TxOut
src
            , flowLinkOwner :: UtxOwner
flowLinkOwner = Set PubKey -> TxOut -> UtxOwner
owner Set PubKey
knownKeys TxOut
src
            , flowLinkSourceLoc :: UtxoLocation
flowLinkSourceLoc = UtxoLocation
sourceLoc
            , flowLinkTargetLoc :: Maybe UtxoLocation
flowLinkTargetLoc = Maybe UtxoLocation
tgtLoc
            }

    zipWithIndex :: [b] -> [(Integer, b)]
zipWithIndex = [Integer] -> [b] -> [(Integer, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..]

-- | Annotate the 'TxOutRef's produced by a transaction with the location of the transaction.
outRefsWithLoc :: UtxoLocation -> OnChainTx -> [(TxOutRef, UtxoLocation)]
outRefsWithLoc :: UtxoLocation -> OnChainTx -> [(TxOutRef, UtxoLocation)]
outRefsWithLoc UtxoLocation
loc (Valid CardanoTx
tx) = (\(TxOut, TxOutRef)
txo -> ((TxOut, TxOutRef) -> TxOutRef
forall a b. (a, b) -> b
snd (TxOut, TxOutRef)
txo, UtxoLocation
loc)) ((TxOut, TxOutRef) -> (TxOutRef, UtxoLocation))
-> [(TxOut, TxOutRef)] -> [(TxOutRef, UtxoLocation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CardanoTx -> [(TxOut, TxOutRef)]
getCardanoTxOutRefs CardanoTx
tx
outRefsWithLoc UtxoLocation
_ (Invalid CardanoTx
_)  = []

-- | Create a 'TxRef' from a 'TxOutRef'.
utxoTargets :: TxOutRef -> TxRef
utxoTargets :: TxOutRef -> TxRef
utxoTargets (TxOutRef TxId
rf Integer
idx) = Text -> TxRef
TxRef (Text -> TxRef) -> Text -> TxRef
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unwords [Text
"utxo", String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
8 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> String
forall a. Show a => a -> String
show (BuiltinByteString -> String) -> BuiltinByteString -> String
forall a b. (a -> b) -> a -> b
$ TxId -> BuiltinByteString
getTxId TxId
rf, String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
idx]