{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Copyright: © 2022 IOHK
-- License: Apache-2.0
--
-- This module provides the 'BlockSummary' type
-- which summarizes a contiguous sequence of blocks.
--
module Cardano.Wallet.Primitive.BlockSummary
    ( BlockSummary (..)
    , LightSummary

    -- * Chain Events
    , ChainEvents
    , fromBlockEvents
    , toAscBlockEvents

    -- * Block Events
    , BlockEvents (..)
    , fromEntireBlock

    -- * Sublist
    , Sublist
    , filterSublist
    , wholeList

    -- * Internal & Testing
    , summarizeOnTxOut
    , mkChainEvents
    , mergeSublist
    , unsafeMkSublist
    ) where

import Prelude

import Cardano.Wallet.Primitive.Types
    ( Block (..)
    , BlockHeader (..)
    , DelegationCertificate
    , Slot
    , chainPointFromBlockHeader
    , dlgCertAccount
    , toSlot
    )
import Cardano.Wallet.Primitive.Types.Address
    ( Address )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount )
import Cardano.Wallet.Primitive.Types.Tx
    ( Tx (..), TxOut (..) )
import Data.Foldable
    ( Foldable (toList) )
import Data.Functor.Identity
    ( Identity (..) )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Map
    ( Map )
import Data.Quantity
    ( Quantity )
import Data.Word
    ( Word32 )
import GHC.Generics
    ( Generic )
import Numeric.Natural
    ( Natural )

import qualified Cardano.Wallet.Primitive.Types as Block
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map

{-------------------------------------------------------------------------------
    BlockSummary
-------------------------------------------------------------------------------}
-- | A 'BlockSummary' summarizes the data contained in a contiguous sequence
-- of blocks.
--
-- However, instead of storing the sequence of blocks of directly as a Haskell
-- list, the 'BlockSummary' only provides a 'query' function
-- which looks up all transactions associated to a given addresses.
-- In addition, this query function is monadic, which means that it
-- can call out to an external data source.
--
data BlockSummary m addr txs = BlockSummary
    { BlockSummary m addr txs -> BlockHeader
from  :: !BlockHeader
    , BlockSummary m addr txs -> BlockHeader
to    :: !BlockHeader
    , BlockSummary m addr txs -> addr -> m txs
query :: addr -> m txs
    } deriving ((forall x.
 BlockSummary m addr txs -> Rep (BlockSummary m addr txs) x)
-> (forall x.
    Rep (BlockSummary m addr txs) x -> BlockSummary m addr txs)
-> Generic (BlockSummary m addr txs)
forall x.
Rep (BlockSummary m addr txs) x -> BlockSummary m addr txs
forall x.
BlockSummary m addr txs -> Rep (BlockSummary m addr txs) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) addr txs x.
Rep (BlockSummary m addr txs) x -> BlockSummary m addr txs
forall (m :: * -> *) addr txs x.
BlockSummary m addr txs -> Rep (BlockSummary m addr txs) x
$cto :: forall (m :: * -> *) addr txs x.
Rep (BlockSummary m addr txs) x -> BlockSummary m addr txs
$cfrom :: forall (m :: * -> *) addr txs x.
BlockSummary m addr txs -> Rep (BlockSummary m addr txs) x
Generic)

-- | 'BlockSummary' used for light-mode.
type LightSummary m =
    BlockSummary m (Either Address RewardAccount) ChainEvents

{-------------------------------------------------------------------------------
    ChainEvents
-------------------------------------------------------------------------------}
-- | 'BlockEvents', always ordered by slot.
newtype ChainEvents = ChainEvents (Map Slot BlockEvents)
    deriving (ChainEvents -> ChainEvents -> Bool
(ChainEvents -> ChainEvents -> Bool)
-> (ChainEvents -> ChainEvents -> Bool) -> Eq ChainEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainEvents -> ChainEvents -> Bool
$c/= :: ChainEvents -> ChainEvents -> Bool
== :: ChainEvents -> ChainEvents -> Bool
$c== :: ChainEvents -> ChainEvents -> Bool
Eq, Eq ChainEvents
Eq ChainEvents
-> (ChainEvents -> ChainEvents -> Ordering)
-> (ChainEvents -> ChainEvents -> Bool)
-> (ChainEvents -> ChainEvents -> Bool)
-> (ChainEvents -> ChainEvents -> Bool)
-> (ChainEvents -> ChainEvents -> Bool)
-> (ChainEvents -> ChainEvents -> ChainEvents)
-> (ChainEvents -> ChainEvents -> ChainEvents)
-> Ord ChainEvents
ChainEvents -> ChainEvents -> Bool
ChainEvents -> ChainEvents -> Ordering
ChainEvents -> ChainEvents -> ChainEvents
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 :: ChainEvents -> ChainEvents -> ChainEvents
$cmin :: ChainEvents -> ChainEvents -> ChainEvents
max :: ChainEvents -> ChainEvents -> ChainEvents
$cmax :: ChainEvents -> ChainEvents -> ChainEvents
>= :: ChainEvents -> ChainEvents -> Bool
$c>= :: ChainEvents -> ChainEvents -> Bool
> :: ChainEvents -> ChainEvents -> Bool
$c> :: ChainEvents -> ChainEvents -> Bool
<= :: ChainEvents -> ChainEvents -> Bool
$c<= :: ChainEvents -> ChainEvents -> Bool
< :: ChainEvents -> ChainEvents -> Bool
$c< :: ChainEvents -> ChainEvents -> Bool
compare :: ChainEvents -> ChainEvents -> Ordering
$ccompare :: ChainEvents -> ChainEvents -> Ordering
$cp1Ord :: Eq ChainEvents
Ord, Int -> ChainEvents -> ShowS
[ChainEvents] -> ShowS
ChainEvents -> String
(Int -> ChainEvents -> ShowS)
-> (ChainEvents -> String)
-> ([ChainEvents] -> ShowS)
-> Show ChainEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainEvents] -> ShowS
$cshowList :: [ChainEvents] -> ShowS
show :: ChainEvents -> String
$cshow :: ChainEvents -> String
showsPrec :: Int -> ChainEvents -> ShowS
$cshowsPrec :: Int -> ChainEvents -> ShowS
Show)

mkChainEvents :: Map Slot BlockEvents -> ChainEvents
mkChainEvents :: Map Slot BlockEvents -> ChainEvents
mkChainEvents = Map Slot BlockEvents -> ChainEvents
ChainEvents

instance Semigroup ChainEvents where
    (ChainEvents Map Slot BlockEvents
bs1) <> :: ChainEvents -> ChainEvents -> ChainEvents
<> (ChainEvents Map Slot BlockEvents
bs2) =
        Map Slot BlockEvents -> ChainEvents
ChainEvents (Map Slot BlockEvents -> ChainEvents)
-> Map Slot BlockEvents -> ChainEvents
forall a b. (a -> b) -> a -> b
$ (BlockEvents -> BlockEvents -> BlockEvents)
-> Map Slot BlockEvents
-> Map Slot BlockEvents
-> Map Slot BlockEvents
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith BlockEvents -> BlockEvents -> BlockEvents
mergeSameBlock Map Slot BlockEvents
bs1 Map Slot BlockEvents
bs2

instance Monoid ChainEvents where
    mempty :: ChainEvents
mempty = Map Slot BlockEvents -> ChainEvents
ChainEvents Map Slot BlockEvents
forall a. Monoid a => a
mempty

-- | Create 'ChainEvents' from a list of block events
-- (which do not need to be in order.)
fromBlockEvents :: [BlockEvents] -> ChainEvents
fromBlockEvents :: [BlockEvents] -> ChainEvents
fromBlockEvents = Map Slot BlockEvents -> ChainEvents
ChainEvents
    (Map Slot BlockEvents -> ChainEvents)
-> ([BlockEvents] -> Map Slot BlockEvents)
-> [BlockEvents]
-> ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockEvents -> BlockEvents -> BlockEvents)
-> [(Slot, BlockEvents)] -> Map Slot BlockEvents
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith BlockEvents -> BlockEvents -> BlockEvents
mergeSameBlock
    ([(Slot, BlockEvents)] -> Map Slot BlockEvents)
-> ([BlockEvents] -> [(Slot, BlockEvents)])
-> [BlockEvents]
-> Map Slot BlockEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockEvents -> (Slot, BlockEvents))
-> [BlockEvents] -> [(Slot, BlockEvents)]
forall a b. (a -> b) -> [a] -> [b]
map (\BlockEvents
bl -> (BlockEvents -> Slot
slot BlockEvents
bl, BlockEvents
bl))
    ([BlockEvents] -> [(Slot, BlockEvents)])
-> ([BlockEvents] -> [BlockEvents])
-> [BlockEvents]
-> [(Slot, BlockEvents)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BlockEvents -> Bool) -> [BlockEvents] -> [BlockEvents]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (BlockEvents -> Bool) -> BlockEvents -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockEvents -> Bool
nullBlockEvents)

-- | List of 'BlockEvents', in ascending order.
-- (No duplicate blocks, all transactions within block in order).
toAscBlockEvents :: ChainEvents -> [BlockEvents]
toAscBlockEvents :: ChainEvents -> [BlockEvents]
toAscBlockEvents (ChainEvents Map Slot BlockEvents
bs) = Map Slot BlockEvents -> [BlockEvents]
forall k a. Map k a -> [a]
Map.elems Map Slot BlockEvents
bs

{-------------------------------------------------------------------------------
    BlockEvents
-------------------------------------------------------------------------------}
-- | Events (such as txs, delegations) within a single block
-- that are potentially relevant to the wallet.
-- This can be the entire block, or a pre-filtered version of it.
data BlockEvents = BlockEvents
    { BlockEvents -> Slot
slot :: !Slot
    , BlockEvents -> Quantity "block" Word32
blockHeight :: !(Quantity "block" Word32)
    , BlockEvents -> Sublist Tx
transactions :: Sublist Tx
        -- ^ (Index of the transaction within the block, transaction data)
        -- INVARIANT: The list is ordered by ascending index.
    , BlockEvents -> Sublist DelegationCertificate
delegations :: Sublist DelegationCertificate
        -- ^ (Index of the delegation within the block, delegation data)
        -- INVARIANT: The list is ordered by ascending index.
    } deriving (BlockEvents -> BlockEvents -> Bool
(BlockEvents -> BlockEvents -> Bool)
-> (BlockEvents -> BlockEvents -> Bool) -> Eq BlockEvents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockEvents -> BlockEvents -> Bool
$c/= :: BlockEvents -> BlockEvents -> Bool
== :: BlockEvents -> BlockEvents -> Bool
$c== :: BlockEvents -> BlockEvents -> Bool
Eq, Eq BlockEvents
Eq BlockEvents
-> (BlockEvents -> BlockEvents -> Ordering)
-> (BlockEvents -> BlockEvents -> Bool)
-> (BlockEvents -> BlockEvents -> Bool)
-> (BlockEvents -> BlockEvents -> Bool)
-> (BlockEvents -> BlockEvents -> Bool)
-> (BlockEvents -> BlockEvents -> BlockEvents)
-> (BlockEvents -> BlockEvents -> BlockEvents)
-> Ord BlockEvents
BlockEvents -> BlockEvents -> Bool
BlockEvents -> BlockEvents -> Ordering
BlockEvents -> BlockEvents -> BlockEvents
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 :: BlockEvents -> BlockEvents -> BlockEvents
$cmin :: BlockEvents -> BlockEvents -> BlockEvents
max :: BlockEvents -> BlockEvents -> BlockEvents
$cmax :: BlockEvents -> BlockEvents -> BlockEvents
>= :: BlockEvents -> BlockEvents -> Bool
$c>= :: BlockEvents -> BlockEvents -> Bool
> :: BlockEvents -> BlockEvents -> Bool
$c> :: BlockEvents -> BlockEvents -> Bool
<= :: BlockEvents -> BlockEvents -> Bool
$c<= :: BlockEvents -> BlockEvents -> Bool
< :: BlockEvents -> BlockEvents -> Bool
$c< :: BlockEvents -> BlockEvents -> Bool
compare :: BlockEvents -> BlockEvents -> Ordering
$ccompare :: BlockEvents -> BlockEvents -> Ordering
$cp1Ord :: Eq BlockEvents
Ord, (forall x. BlockEvents -> Rep BlockEvents x)
-> (forall x. Rep BlockEvents x -> BlockEvents)
-> Generic BlockEvents
forall x. Rep BlockEvents x -> BlockEvents
forall x. BlockEvents -> Rep BlockEvents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockEvents x -> BlockEvents
$cfrom :: forall x. BlockEvents -> Rep BlockEvents x
Generic, Int -> BlockEvents -> ShowS
[BlockEvents] -> ShowS
BlockEvents -> String
(Int -> BlockEvents -> ShowS)
-> (BlockEvents -> String)
-> ([BlockEvents] -> ShowS)
-> Show BlockEvents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockEvents] -> ShowS
$cshowList :: [BlockEvents] -> ShowS
show :: BlockEvents -> String
$cshow :: BlockEvents -> String
showsPrec :: Int -> BlockEvents -> ShowS
$cshowsPrec :: Int -> BlockEvents -> ShowS
Show)

type Index1 = Natural
type Index2 = Natural

-- | A data type representing a sublist of a total list.
-- Such a sublist typically arises by filtering and keeps
-- track of the indices of the filtered list elements.
--
-- In order to represent sublists of 'DelegationCertificate',
-- we do not use a single 'Int', but a pair @(Index1,Index2)@
-- as index internally.
-- This internal index is not part of the (safe) API of 'Sublist'.
--
-- The main purpose of this data type is optimization:
-- When processing whole 'Block', we want to avoid copying
-- and redecorating the entire list of transactions in that 'Block';
-- instead, we want to copy a pointer to this list.
data Sublist a = All [a] | Some (Map (Index1, Index2) a)
    deriving (Sublist a -> Sublist a -> Bool
(Sublist a -> Sublist a -> Bool)
-> (Sublist a -> Sublist a -> Bool) -> Eq (Sublist a)
forall a. Eq a => Sublist a -> Sublist a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sublist a -> Sublist a -> Bool
$c/= :: forall a. Eq a => Sublist a -> Sublist a -> Bool
== :: Sublist a -> Sublist a -> Bool
$c== :: forall a. Eq a => Sublist a -> Sublist a -> Bool
Eq, Eq (Sublist a)
Eq (Sublist a)
-> (Sublist a -> Sublist a -> Ordering)
-> (Sublist a -> Sublist a -> Bool)
-> (Sublist a -> Sublist a -> Bool)
-> (Sublist a -> Sublist a -> Bool)
-> (Sublist a -> Sublist a -> Bool)
-> (Sublist a -> Sublist a -> Sublist a)
-> (Sublist a -> Sublist a -> Sublist a)
-> Ord (Sublist a)
Sublist a -> Sublist a -> Bool
Sublist a -> Sublist a -> Ordering
Sublist a -> Sublist a -> Sublist a
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
forall a. Ord a => Eq (Sublist a)
forall a. Ord a => Sublist a -> Sublist a -> Bool
forall a. Ord a => Sublist a -> Sublist a -> Ordering
forall a. Ord a => Sublist a -> Sublist a -> Sublist a
min :: Sublist a -> Sublist a -> Sublist a
$cmin :: forall a. Ord a => Sublist a -> Sublist a -> Sublist a
max :: Sublist a -> Sublist a -> Sublist a
$cmax :: forall a. Ord a => Sublist a -> Sublist a -> Sublist a
>= :: Sublist a -> Sublist a -> Bool
$c>= :: forall a. Ord a => Sublist a -> Sublist a -> Bool
> :: Sublist a -> Sublist a -> Bool
$c> :: forall a. Ord a => Sublist a -> Sublist a -> Bool
<= :: Sublist a -> Sublist a -> Bool
$c<= :: forall a. Ord a => Sublist a -> Sublist a -> Bool
< :: Sublist a -> Sublist a -> Bool
$c< :: forall a. Ord a => Sublist a -> Sublist a -> Bool
compare :: Sublist a -> Sublist a -> Ordering
$ccompare :: forall a. Ord a => Sublist a -> Sublist a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Sublist a)
Ord, Int -> Sublist a -> ShowS
[Sublist a] -> ShowS
Sublist a -> String
(Int -> Sublist a -> ShowS)
-> (Sublist a -> String)
-> ([Sublist a] -> ShowS)
-> Show (Sublist a)
forall a. Show a => Int -> Sublist a -> ShowS
forall a. Show a => [Sublist a] -> ShowS
forall a. Show a => Sublist a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sublist a] -> ShowS
$cshowList :: forall a. Show a => [Sublist a] -> ShowS
show :: Sublist a -> String
$cshow :: forall a. Show a => Sublist a -> String
showsPrec :: Int -> Sublist a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Sublist a -> ShowS
Show)

-- | Construct a 'Sublist' representing the whole list.
wholeList :: [a] -> Sublist a
wholeList :: [a] -> Sublist a
wholeList = [a] -> Sublist a
forall a. [a] -> Sublist a
All

-- | Construct a 'Sublist' from a list of indexed items.
unsafeMkSublist :: [((Index1, Index2), a)] -> Sublist a
unsafeMkSublist :: [((Index1, Index1), a)] -> Sublist a
unsafeMkSublist = Map (Index1, Index1) a -> Sublist a
forall a. Map (Index1, Index1) a -> Sublist a
Some (Map (Index1, Index1) a -> Sublist a)
-> ([((Index1, Index1), a)] -> Map (Index1, Index1) a)
-> [((Index1, Index1), a)]
-> Sublist a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((Index1, Index1), a)] -> Map (Index1, Index1) a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

-- | Filter a 'Sublist' by a predicate.
filterSublist :: (a -> Bool) -> Sublist a -> Sublist a
filterSublist :: (a -> Bool) -> Sublist a -> Sublist a
filterSublist a -> Bool
p (All [a]
xs) =
    (a -> Bool) -> Sublist a -> Sublist a
forall a. (a -> Bool) -> Sublist a -> Sublist a
filterSublist a -> Bool
p (Sublist a -> Sublist a) -> Sublist a -> Sublist a
forall a b. (a -> b) -> a -> b
$ [((Index1, Index1), a)] -> Sublist a
forall a. [((Index1, Index1), a)] -> Sublist a
unsafeMkSublist ([((Index1, Index1), a)] -> Sublist a)
-> [((Index1, Index1), a)] -> Sublist a
forall a b. (a -> b) -> a -> b
$ [(Index1, Index1)] -> [a] -> [((Index1, Index1), a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Index1 -> (Index1, Index1)) -> [Index1] -> [(Index1, Index1)]
forall a b. (a -> b) -> [a] -> [b]
map (,Index1
0) [Index1
0..]) [a]
xs
filterSublist a -> Bool
p (Some Map (Index1, Index1) a
ixs) = Map (Index1, Index1) a -> Sublist a
forall a. Map (Index1, Index1) a -> Sublist a
Some (Map (Index1, Index1) a -> Sublist a)
-> Map (Index1, Index1) a -> Sublist a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Map (Index1, Index1) a -> Map (Index1, Index1) a
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter a -> Bool
p Map (Index1, Index1) a
ixs

instance Functor Sublist where
    fmap :: (a -> b) -> Sublist a -> Sublist b
fmap a -> b
f (All [a]
xs) = [b] -> Sublist b
forall a. [a] -> Sublist a
All ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
xs)
    fmap a -> b
f (Some Map (Index1, Index1) a
ixs) = Map (Index1, Index1) b -> Sublist b
forall a. Map (Index1, Index1) a -> Sublist a
Some (Map (Index1, Index1) b -> Sublist b)
-> Map (Index1, Index1) b -> Sublist b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> Map (Index1, Index1) a -> Map (Index1, Index1) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (Index1, Index1) a
ixs

instance Foldable Sublist where
    foldr :: (a -> b -> b) -> b -> Sublist a -> b
foldr a -> b -> b
f b
b = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
b ([a] -> b) -> (Sublist a -> [a]) -> Sublist a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sublist a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    null :: Sublist a -> Bool
null = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> (Sublist a -> [a]) -> Sublist a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sublist a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    toList :: Sublist a -> [a]
toList (All [a]
as) = [a]
as
    toList (Some Map (Index1, Index1) a
ixs) = Map (Index1, Index1) a -> [a]
forall k a. Map k a -> [a]
Map.elems Map (Index1, Index1) a
ixs

-- | Returns 'True' if the 'BlockEvents' contains empty
-- 'transactions' and 'delegations'.
nullBlockEvents :: BlockEvents -> Bool
nullBlockEvents :: BlockEvents -> Bool
nullBlockEvents BlockEvents{Sublist Tx
transactions :: Sublist Tx
$sel:transactions:BlockEvents :: BlockEvents -> Sublist Tx
transactions,Sublist DelegationCertificate
delegations :: Sublist DelegationCertificate
$sel:delegations:BlockEvents :: BlockEvents -> Sublist DelegationCertificate
delegations}
    = Sublist Tx -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Sublist Tx
transactions Bool -> Bool -> Bool
&& Sublist DelegationCertificate -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Sublist DelegationCertificate
delegations

-- | Merge two 'Sublist' assuming that they are sublists of the /same/ list.
mergeSublist :: Sublist a -> Sublist a -> Sublist a
mergeSublist :: Sublist a -> Sublist a -> Sublist a
mergeSublist (All [a]
xs) Sublist a
_ = [a] -> Sublist a
forall a. [a] -> Sublist a
All [a]
xs -- result cannot be larger
mergeSublist Sublist a
_ (All [a]
ys) = [a] -> Sublist a
forall a. [a] -> Sublist a
All [a]
ys
mergeSublist (Some Map (Index1, Index1) a
xs) (Some Map (Index1, Index1) a
ys) = Map (Index1, Index1) a -> Sublist a
forall a. Map (Index1, Index1) a -> Sublist a
Some (Map (Index1, Index1) a -> Sublist a)
-> Map (Index1, Index1) a -> Sublist a
forall a b. (a -> b) -> a -> b
$ Map (Index1, Index1) a
-> Map (Index1, Index1) a -> Map (Index1, Index1) a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map (Index1, Index1) a
xs Map (Index1, Index1) a
ys

-- | Merge block events that belong to the same block.
mergeSameBlock :: BlockEvents -> BlockEvents -> BlockEvents
mergeSameBlock :: BlockEvents -> BlockEvents -> BlockEvents
mergeSameBlock
    BlockEvents{Slot
slot :: Slot
$sel:slot:BlockEvents :: BlockEvents -> Slot
slot,Quantity "block" Word32
blockHeight :: Quantity "block" Word32
$sel:blockHeight:BlockEvents :: BlockEvents -> Quantity "block" Word32
blockHeight,$sel:transactions:BlockEvents :: BlockEvents -> Sublist Tx
transactions=Sublist Tx
txs1,$sel:delegations:BlockEvents :: BlockEvents -> Sublist DelegationCertificate
delegations=Sublist DelegationCertificate
dlg1}
    BlockEvents{$sel:transactions:BlockEvents :: BlockEvents -> Sublist Tx
transactions=Sublist Tx
txs2,$sel:delegations:BlockEvents :: BlockEvents -> Sublist DelegationCertificate
delegations=Sublist DelegationCertificate
dlg2}
  = BlockEvents :: Slot
-> Quantity "block" Word32
-> Sublist Tx
-> Sublist DelegationCertificate
-> BlockEvents
BlockEvents
    { Slot
slot :: Slot
$sel:slot:BlockEvents :: Slot
slot
    , Quantity "block" Word32
blockHeight :: Quantity "block" Word32
$sel:blockHeight:BlockEvents :: Quantity "block" Word32
blockHeight
    , $sel:transactions:BlockEvents :: Sublist Tx
transactions = Sublist Tx -> Sublist Tx -> Sublist Tx
forall a. Sublist a -> Sublist a -> Sublist a
mergeSublist Sublist Tx
txs1 Sublist Tx
txs2
    , $sel:delegations:BlockEvents :: Sublist DelegationCertificate
delegations = Sublist DelegationCertificate
-> Sublist DelegationCertificate -> Sublist DelegationCertificate
forall a. Sublist a -> Sublist a -> Sublist a
mergeSublist Sublist DelegationCertificate
dlg1 Sublist DelegationCertificate
dlg2
    }

-- | Get the 'BlockEvents' corresponding to an entire 'Block'.
fromEntireBlock :: Block -> BlockEvents
fromEntireBlock :: Block -> BlockEvents
fromEntireBlock Block{BlockHeader
$sel:header:Block :: Block -> BlockHeader
header :: BlockHeader
header,[Tx]
$sel:transactions:Block :: Block -> [Tx]
transactions :: [Tx]
transactions,[DelegationCertificate]
$sel:delegations:Block :: Block -> [DelegationCertificate]
delegations :: [DelegationCertificate]
delegations} = BlockEvents :: Slot
-> Quantity "block" Word32
-> Sublist Tx
-> Sublist DelegationCertificate
-> BlockEvents
BlockEvents
    { $sel:slot:BlockEvents :: Slot
slot = ChainPoint -> Slot
toSlot (ChainPoint -> Slot) -> ChainPoint -> Slot
forall a b. (a -> b) -> a -> b
$ BlockHeader -> ChainPoint
chainPointFromBlockHeader BlockHeader
header
    , $sel:blockHeight:BlockEvents :: Quantity "block" Word32
blockHeight = BlockHeader -> Quantity "block" Word32
Block.blockHeight BlockHeader
header
    , $sel:transactions:BlockEvents :: Sublist Tx
transactions = [Tx] -> Sublist Tx
forall a. [a] -> Sublist a
All [Tx]
transactions
    , $sel:delegations:BlockEvents :: Sublist DelegationCertificate
delegations = [DelegationCertificate] -> Sublist DelegationCertificate
forall a. [a] -> Sublist a
All [DelegationCertificate]
delegations
    }

{-------------------------------------------------------------------------------
    Testing
-------------------------------------------------------------------------------}
-- | For testing:
-- Convert a list of blocks into a 'BlockSummary'.
-- Unfortunately, as 'TxIn' references are not resolved,
-- we can only find transactions with relevant 'TxOut'.
summarizeOnTxOut :: NonEmpty Block -> LightSummary Identity
summarizeOnTxOut :: NonEmpty Block -> LightSummary Identity
summarizeOnTxOut NonEmpty Block
bs = BlockSummary :: forall (m :: * -> *) addr txs.
BlockHeader
-> BlockHeader -> (addr -> m txs) -> BlockSummary m addr txs
BlockSummary
    { $sel:from:BlockSummary :: BlockHeader
from = Block -> BlockHeader
header (Block -> BlockHeader)
-> (NonEmpty Block -> Block) -> NonEmpty Block -> BlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Block -> Block
forall a. NonEmpty a -> a
NE.head (NonEmpty Block -> BlockHeader) -> NonEmpty Block -> BlockHeader
forall a b. (a -> b) -> a -> b
$ NonEmpty Block
bs
    , $sel:to:BlockSummary :: BlockHeader
to = Block -> BlockHeader
header (Block -> BlockHeader)
-> (NonEmpty Block -> Block) -> NonEmpty Block -> BlockHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Block -> Block
forall a. NonEmpty a -> a
NE.last (NonEmpty Block -> BlockHeader) -> NonEmpty Block -> BlockHeader
forall a b. (a -> b) -> a -> b
$ NonEmpty Block
bs
    , $sel:query:BlockSummary :: Either Address RewardAccount -> Identity ChainEvents
query = \Either Address RewardAccount
q -> ChainEvents -> Identity ChainEvents
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (ChainEvents -> Identity ChainEvents)
-> ([Block] -> ChainEvents) -> [Block] -> Identity ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BlockEvents] -> ChainEvents
fromBlockEvents ([BlockEvents] -> ChainEvents)
-> ([Block] -> [BlockEvents]) -> [Block] -> ChainEvents
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> BlockEvents) -> [Block] -> [BlockEvents]
forall a b. (a -> b) -> [a] -> [b]
map (Either Address RewardAccount -> Block -> BlockEvents
filterBlock Either Address RewardAccount
q) ([Block] -> Identity ChainEvents)
-> [Block] -> Identity ChainEvents
forall a b. (a -> b) -> a -> b
$ NonEmpty Block -> [Block]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Block
bs
    }

filterBlock :: Either Address RewardAccount -> Block -> BlockEvents
filterBlock :: Either Address RewardAccount -> Block -> BlockEvents
filterBlock Either Address RewardAccount
question Block
block = case Block -> BlockEvents
fromEntireBlock Block
block of
    BlockEvents{Slot
slot :: Slot
$sel:slot:BlockEvents :: BlockEvents -> Slot
slot,Quantity "block" Word32
blockHeight :: Quantity "block" Word32
$sel:blockHeight:BlockEvents :: BlockEvents -> Quantity "block" Word32
blockHeight,Sublist Tx
transactions :: Sublist Tx
$sel:transactions:BlockEvents :: BlockEvents -> Sublist Tx
transactions,Sublist DelegationCertificate
delegations :: Sublist DelegationCertificate
$sel:delegations:BlockEvents :: BlockEvents -> Sublist DelegationCertificate
delegations} -> BlockEvents :: Slot
-> Quantity "block" Word32
-> Sublist Tx
-> Sublist DelegationCertificate
-> BlockEvents
BlockEvents
        { Slot
slot :: Slot
$sel:slot:BlockEvents :: Slot
slot
        , Quantity "block" Word32
blockHeight :: Quantity "block" Word32
$sel:blockHeight:BlockEvents :: Quantity "block" Word32
blockHeight
        , $sel:transactions:BlockEvents :: Sublist Tx
transactions = case Either Address RewardAccount
question of
            Left Address
addr -> (Tx -> Bool) -> Sublist Tx -> Sublist Tx
forall a. (a -> Bool) -> Sublist a -> Sublist a
filterSublist (Address -> Tx -> Bool
isRelevantTx Address
addr) Sublist Tx
transactions
            Right RewardAccount
_   -> Map (Index1, Index1) Tx -> Sublist Tx
forall a. Map (Index1, Index1) a -> Sublist a
Some Map (Index1, Index1) Tx
forall a. Monoid a => a
mempty
        , $sel:delegations:BlockEvents :: Sublist DelegationCertificate
delegations = case Either Address RewardAccount
question of
            Left Address
_     -> Map (Index1, Index1) DelegationCertificate
-> Sublist DelegationCertificate
forall a. Map (Index1, Index1) a -> Sublist a
Some Map (Index1, Index1) DelegationCertificate
forall a. Monoid a => a
mempty
            Right RewardAccount
racc -> (DelegationCertificate -> Bool)
-> Sublist DelegationCertificate -> Sublist DelegationCertificate
forall a. (a -> Bool) -> Sublist a -> Sublist a
filterSublist (RewardAccount -> DelegationCertificate -> Bool
isRelevantDelegation RewardAccount
racc) Sublist DelegationCertificate
delegations
        }
  where
    -- NOTE: Currently used the full address,
    -- containing both payment and staking parts.
    -- We may want to query only for the payment part at some point.
    isRelevantTx :: Address -> Tx -> Bool
isRelevantTx Address
addr = (TxOut -> Bool) -> [TxOut] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Address
addr Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
==) (Address -> Bool) -> (TxOut -> Address) -> TxOut -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut -> Address
address) ([TxOut] -> Bool) -> (Tx -> [TxOut]) -> Tx -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxOut]
outputs
    isRelevantDelegation :: RewardAccount -> DelegationCertificate -> Bool
isRelevantDelegation RewardAccount
racc = (RewardAccount
racc RewardAccount -> RewardAccount -> Bool
forall a. Eq a => a -> a -> Bool
== ) (RewardAccount -> Bool)
-> (DelegationCertificate -> RewardAccount)
-> DelegationCertificate
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DelegationCertificate -> RewardAccount
dlgCertAccount