{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans -funbox-strict-fields #-}

module Cardano.Ledger.State.UTxO where

import Cardano.Ledger.Address
import Cardano.Ledger.Alonzo.TxBody
import Cardano.Ledger.Babbage
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.EpochBoundary
import Cardano.Ledger.Keys hiding (Hash)
import Cardano.Ledger.Mary.Value
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.PoolParams
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.TxIn
import Cardano.Ledger.UMap (rewardMap, sPoolMap)
import qualified Cardano.Ledger.UMap as UM (ptrMap)
import Cardano.Ledger.UTxO
import Conduit
import Control.Exception (throwIO)
import Control.Foldl (Fold (..))
import Control.SetAlgebra (range)
import qualified Data.ByteString.Lazy as LBS
import Data.Foldable as F
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Typeable
import qualified Data.VMap as VMap
import Lens.Micro
import Prettyprinter
import Text.Printf

type CurrentEra = BabbageEra

--- Loading
readNewEpochState ::
  FilePath ->
  IO (NewEpochState CurrentEra)
readNewEpochState :: String -> IO (NewEpochState BabbageEra)
readNewEpochState = forall a. FromCBOR a => String -> IO a
readDecCBOR

readEpochState ::
  FilePath ->
  IO (EpochState CurrentEra)
readEpochState :: String -> IO (EpochState BabbageEra)
readEpochState = forall a. FromCBOR a => String -> IO a
readDecCBOR

readDecCBOR :: FromCBOR a => FilePath -> IO a
readDecCBOR :: forall a. FromCBOR a => String -> IO a
readDecCBOR String
fp =
  String -> IO ByteString
LBS.readFile String
fp forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a. FromCBOR a => ByteString -> Either DecoderError a
Plain.decodeFull forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left DecoderError
exc -> forall e a. Exception e => e -> IO a
throwIO DecoderError
exc
    Right a
res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

writeEpochState :: FilePath -> EpochState CurrentEra -> IO ()
writeEpochState :: String -> EpochState BabbageEra -> IO ()
writeEpochState String
fp = String -> ByteString -> IO ()
LBS.writeFile String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToCBOR a => a -> ByteString
Plain.serialize

loadLedgerState ::
  FilePath ->
  IO (LedgerState CurrentEra)
loadLedgerState :: String -> IO (LedgerState BabbageEra)
loadLedgerState String
fp = forall era. EpochState era -> LedgerState era
esLState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. NewEpochState era -> EpochState era
nesEs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (NewEpochState BabbageEra)
readNewEpochState String
fp

runConduitFold :: Monad m => ConduitT () a m () -> Fold a b -> m b
runConduitFold :: forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m () -> Fold a b -> m b
runConduitFold ConduitT () a m ()
source (Fold x -> a -> x
f x
e x -> b
g) = (x -> b
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () a m ()
source forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC x -> a -> x
f x
e))

type UTxOFold b = Fold (TxIn, TxOut CurrentEra) b

noSharing :: Fold (TxIn, a) (Map.Map TxIn a)
noSharing :: forall a. Fold (TxIn, a) (Map TxIn a)
noSharing = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\ !Map TxIn a
m !(!TxIn
k, !a
v) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
k a
v Map TxIn a
m) forall a. Monoid a => a
mempty forall a. a -> a
id

noSharing_ :: UTxOFold (Map.Map TxIn ())
noSharing_ :: UTxOFold (Map TxIn ())
noSharing_ = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\ !Map TxIn ()
m !(!TxIn
k, BabbageTxOut BabbageEra
_) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
k () Map TxIn ()
m) forall a. Monoid a => a
mempty forall a. a -> a
id

noSharingMap :: Fold (TxIn, a) (Map.Map TxIn a)
noSharingMap :: forall a. Fold (TxIn, a) (Map TxIn a)
noSharingMap = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\ !Map TxIn a
m !(!TxIn
k, !a
v) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
k a
v Map TxIn a
m) forall a. Monoid a => a
mempty forall a. a -> a
id

noSharingMap_ :: UTxOFold (Map.Map TxIn ())
noSharingMap_ :: UTxOFold (Map TxIn ())
noSharingMap_ = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\ !Map TxIn ()
m !(!TxIn
k, BabbageTxOut BabbageEra
_) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
k () Map TxIn ()
m) forall a. Monoid a => a
mempty forall a. a -> a
id

txIdSharing ::
  UTxOFold (Map.Map TxId (IntMap.IntMap (TxOut CurrentEra)))
txIdSharing :: UTxOFold (Map TxId (IntMap (TxOut BabbageEra)))
txIdSharing = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. Map TxId (IntMap a) -> (TxIn, a) -> Map TxId (IntMap a)
txIdNestedInsert forall a. Monoid a => a
mempty forall a. a -> a
id

txIdSharing_ :: UTxOFold (Map.Map TxId (IntMap.IntMap ()))
txIdSharing_ :: UTxOFold (Map TxId (IntMap ()))
txIdSharing_ = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Map TxId (IntMap ())
a (TxIn, BabbageTxOut BabbageEra)
v -> forall a. Map TxId (IntMap a) -> (TxIn, a) -> Map TxId (IntMap a)
txIdNestedInsert Map TxId (IntMap ())
a (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TxIn, BabbageTxOut BabbageEra)
v)) forall a. Monoid a => a
mempty forall a. a -> a
id

txIdNestedInsert ::
  Map.Map TxId (IntMap.IntMap a) ->
  (TxIn, a) ->
  Map.Map TxId (IntMap.IntMap a)
txIdNestedInsert :: forall a. Map TxId (IntMap a) -> (TxIn, a) -> Map TxId (IntMap a)
txIdNestedInsert !Map TxId (IntMap a)
m (TxIn !TxId
txId !TxIx
txIx, !a
v) =
  let !e :: IntMap a
e = forall a. Int -> a -> IntMap a
IntMap.singleton (TxIx -> Int
txIxToInt TxIx
txIx) a
v
   in forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) TxId
txId IntMap a
e Map TxId (IntMap a)
m

txIxSharing :: Fold (TxIn, a) (IntMap.IntMap (Map.Map TxId a))
txIxSharing :: forall a. Fold (TxIn, a) (IntMap (Map TxId a))
txIxSharing = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold forall a. IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
txIxNestedInsert forall a. Monoid a => a
mempty forall a. a -> a
id

txIxSharing_ :: UTxOFold (IntMap.IntMap (Map.Map TxId ()))
txIxSharing_ :: UTxOFold (IntMap (Map TxId ()))
txIxSharing_ = forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\IntMap (Map TxId ())
a (TxIn, BabbageTxOut BabbageEra)
v -> forall a. IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
txIxNestedInsert IntMap (Map TxId ())
a (() forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TxIn, BabbageTxOut BabbageEra)
v)) forall a. Monoid a => a
mempty forall a. a -> a
id

txIxNestedInsert ::
  IntMap.IntMap (Map.Map TxId a) ->
  (TxIn, a) ->
  IntMap.IntMap (Map.Map TxId a)
txIxNestedInsert :: forall a. IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
txIxNestedInsert !IntMap (Map TxId a)
im (TxIn !TxId
txId !TxIx
txIx, !a
v) =
  let f :: Maybe (Map TxId a) -> Maybe (Map TxId a)
f =
        \case
          Maybe (Map TxId a)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall k a. k -> a -> Map k a
Map.singleton TxId
txId a
v
          Just !Map TxId a
m -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxId
txId a
v Map TxId a
m
   in forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter Maybe (Map TxId a) -> Maybe (Map TxId a)
f (TxIx -> Int
txIxToInt TxIx
txIx) IntMap (Map TxId a)
im

totalADA :: Map.Map TxIn (TxOut CurrentEra) -> MaryValue
totalADA :: Map TxIn (TxOut BabbageEra) -> MaryValue
totalADA = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL)

readBinUTxO ::
  FilePath ->
  IO (UTxO CurrentEra)
readBinUTxO :: String -> IO (UTxO BabbageEra)
readBinUTxO String
fp = do
  NewEpochState BabbageEra
ls <- String -> IO (NewEpochState BabbageEra)
readNewEpochState String
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall era. UTxOState era -> UTxO era
utxosUtxo forall a b. (a -> b) -> a -> b
$ forall era. LedgerState era -> UTxOState era
lsUTxOState forall a b. (a -> b) -> a -> b
$ forall era. EpochState era -> LedgerState era
esLState forall a b. (a -> b) -> a -> b
$ forall era. NewEpochState era -> EpochState era
nesEs NewEpochState BabbageEra
ls

newtype Count = Count Int
  deriving (Count -> Count -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Count -> Count -> Bool
$c/= :: Count -> Count -> Bool
== :: Count -> Count -> Bool
$c== :: Count -> Count -> Bool
Eq, Eq Count
Count -> Count -> Bool
Count -> Count -> Ordering
Count -> Count -> Count
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 :: Count -> Count -> Count
$cmin :: Count -> Count -> Count
max :: Count -> Count -> Count
$cmax :: Count -> Count -> Count
>= :: Count -> Count -> Bool
$c>= :: Count -> Count -> Bool
> :: Count -> Count -> Bool
$c> :: Count -> Count -> Bool
<= :: Count -> Count -> Bool
$c<= :: Count -> Count -> Bool
< :: Count -> Count -> Bool
$c< :: Count -> Count -> Bool
compare :: Count -> Count -> Ordering
$ccompare :: Count -> Count -> Ordering
Ord, Int -> Count
Count -> Int
Count -> [Count]
Count -> Count
Count -> Count -> [Count]
Count -> Count -> Count -> [Count]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Count -> Count -> Count -> [Count]
$cenumFromThenTo :: Count -> Count -> Count -> [Count]
enumFromTo :: Count -> Count -> [Count]
$cenumFromTo :: Count -> Count -> [Count]
enumFromThen :: Count -> Count -> [Count]
$cenumFromThen :: Count -> Count -> [Count]
enumFrom :: Count -> [Count]
$cenumFrom :: Count -> [Count]
fromEnum :: Count -> Int
$cfromEnum :: Count -> Int
toEnum :: Int -> Count
$ctoEnum :: Int -> Count
pred :: Count -> Count
$cpred :: Count -> Count
succ :: Count -> Count
$csucc :: Count -> Count
Enum, Num Count
Ord Count
Count -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Count -> Rational
$ctoRational :: Count -> Rational
Real, Enum Count
Real Count
Count -> Integer
Count -> Count -> (Count, Count)
Count -> Count -> Count
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Count -> Integer
$ctoInteger :: Count -> Integer
divMod :: Count -> Count -> (Count, Count)
$cdivMod :: Count -> Count -> (Count, Count)
quotRem :: Count -> Count -> (Count, Count)
$cquotRem :: Count -> Count -> (Count, Count)
mod :: Count -> Count -> Count
$cmod :: Count -> Count -> Count
div :: Count -> Count -> Count
$cdiv :: Count -> Count -> Count
rem :: Count -> Count -> Count
$crem :: Count -> Count -> Count
quot :: Count -> Count -> Count
$cquot :: Count -> Count -> Count
Integral, Integer -> Count
Count -> Count
Count -> Count -> Count
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Count
$cfromInteger :: Integer -> Count
signum :: Count -> Count
$csignum :: Count -> Count
abs :: Count -> Count
$cabs :: Count -> Count
negate :: Count -> Count
$cnegate :: Count -> Count
* :: Count -> Count -> Count
$c* :: Count -> Count -> Count
- :: Count -> Count -> Count
$c- :: Count -> Count -> Count
+ :: Count -> Count -> Count
$c+ :: Count -> Count -> Count
Num, forall ann. [Count] -> Doc ann
forall ann. Count -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [Count] -> Doc ann
$cprettyList :: forall ann. [Count] -> Doc ann
pretty :: forall ann. Count -> Doc ann
$cpretty :: forall ann. Count -> Doc ann
Pretty)

data Stat k = Stat
  { forall k. Stat k -> Set k
statUnique :: !(Set.Set k)
  , forall k. Stat k -> Count
statCount :: !Count
  }

instance Ord k => Semigroup (Stat k) where
  <> :: Stat k -> Stat k -> Stat k
(<>) Stat k
s1 Stat k
s2 = forall k. Set k -> Count -> Stat k
Stat (forall k. Stat k -> Set k
statUnique Stat k
s1 forall a. Semigroup a => a -> a -> a
<> forall k. Stat k -> Set k
statUnique Stat k
s2) (forall k. Stat k -> Count
statCount Stat k
s1 forall a. Num a => a -> a -> a
+ forall k. Stat k -> Count
statCount Stat k
s2)

instance Ord k => Monoid (Stat k) where
  mempty :: Stat k
mempty = forall k. Set k -> Count -> Stat k
Stat forall a. Monoid a => a
mempty Count
0

instance Pretty (Stat k) where
  pretty :: forall ann. Stat k -> Doc ann
pretty Stat {Set k
Count
statCount :: Count
statUnique :: Set k
statCount :: forall k. Stat k -> Count
statUnique :: forall k. Stat k -> Set k
..} =
    forall a ann. Pretty a => a -> Doc ann
pretty Int
n
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"/"
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Count
statCount
      forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"("
      forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall i. Integral i => Int -> i -> Percent
intPercent Int
n Count
statCount)
      forall a. Semigroup a => a -> a -> a
<> Doc ann
" unique)"
    where
      n :: Int
n = forall a. Set a -> Int
Set.size Set k
statUnique

data Percent = Percent Int Int

instance Pretty Percent where
  pretty :: forall ann. Percent -> Doc ann
pretty (Percent Int
x Int
y) = forall a ann. Pretty a => a -> Doc ann
pretty (forall r. PrintfType r => String -> r
printf String
"%d.%02d%%" Int
x Int
y :: String)

intPercent :: Integral i => Int -> i -> Percent
intPercent :: forall i. Integral i => Int -> i -> Percent
intPercent Int
x i
y
  | i
y forall a. Eq a => a -> a -> Bool
== i
0 = Int -> Int -> Percent
Percent Int
0 Int
0
  | Bool
otherwise = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Percent
Percent (((Int
10000 forall a. Num a => a -> a -> a
* Int
x) forall a. Integral a => a -> a -> a
`div` forall a b. (Integral a, Num b) => a -> b
fromIntegral i
y) forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100)

statSingleton :: a -> Stat a
statSingleton :: forall a. a -> Stat a
statSingleton a
a = forall k. Set k -> Count -> Stat k
Stat (forall a. a -> Set a
Set.singleton a
a) Count
1

statSet :: Set.Set a -> Stat a
statSet :: forall a. Set a -> Stat a
statSet Set a
s = forall k. Set k -> Count -> Stat k
Stat Set a
s (Int -> Count
Count (forall a. Set a -> Int
Set.size Set a
s))

mapStat :: Ord b => (a -> b) -> Stat a -> Stat b
mapStat :: forall b a. Ord b => (a -> b) -> Stat a -> Stat b
mapStat a -> b
f Stat a
s = forall k. Set k -> Count -> Stat k
Stat (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f (forall k. Stat k -> Set k
statUnique Stat a
s)) (forall k. Stat k -> Count
statCount Stat a
s)

statMapKeys :: Map.Map k v -> Stat k
statMapKeys :: forall k v. Map k v -> Stat k
statMapKeys = forall a. Set a -> Stat a
statSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> Set k
Map.keysSet

statFoldable :: (Ord a, Foldable t) => t a -> Stat a
statFoldable :: forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable t a
m = forall k. Set k -> Count -> Stat k
Stat (forall a. Ord a => [a] -> Set a
Set.fromList (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
m)) (Int -> Count
Count (forall (t :: * -> *) a. Foldable t => t a -> Int
F.length t a
m))

prettyRecord :: Doc ann -> [Doc ann] -> Doc ann
prettyRecord :: forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord Doc ann
h [Doc ann]
content = Doc ann
h forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
content)

(<:>) :: (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> :: forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
(<:>) Doc ann
x a
y =
  Doc ann
"[" forall a. Semigroup a => a -> a -> a
<> Doc ann
x forall a. Semigroup a => a -> a -> a
<> Doc ann
"]:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty a
y forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (TypeRep -> ShowS
showsTypeRep (forall a. Typeable a => a -> TypeRep
typeOf a
y) String
">")

infixr 6 <:>

data SnapShotStats = SnapShotStats
  { SnapShotStats -> Stat (Credential 'Staking)
sssStake :: !(Stat (Credential 'Staking))
  , SnapShotStats -> Stat (Credential 'Staking)
sssDelegationCredential :: !(Stat (Credential 'Staking))
  , SnapShotStats -> Stat (KeyHash 'StakePool)
sssDelegationStakePool :: !(Stat (KeyHash 'StakePool))
  , SnapShotStats -> Stat (KeyHash 'StakePool)
sssPoolParams :: !(Stat (KeyHash 'StakePool))
  , SnapShotStats -> PoolParamsStats
sssPoolParamsStats :: !PoolParamsStats
  }

instance Semigroup SnapShotStats where
  <> :: SnapShotStats -> SnapShotStats -> SnapShotStats
(<>) (SnapShotStats Stat (Credential 'Staking)
x1 Stat (Credential 'Staking)
x2 Stat (KeyHash 'StakePool)
x3 Stat (KeyHash 'StakePool)
x4 PoolParamsStats
x5) (SnapShotStats Stat (Credential 'Staking)
y1 Stat (Credential 'Staking)
y2 Stat (KeyHash 'StakePool)
y3 Stat (KeyHash 'StakePool)
y4 PoolParamsStats
y5) =
    Stat (Credential 'Staking)
-> Stat (Credential 'Staking)
-> Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'StakePool)
-> PoolParamsStats
-> SnapShotStats
SnapShotStats
      (Stat (Credential 'Staking)
x1 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
y1)
      (Stat (Credential 'Staking)
x2 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
y2)
      (Stat (KeyHash 'StakePool)
x3 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'StakePool)
y3)
      (Stat (KeyHash 'StakePool)
x4 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'StakePool)
y4)
      (PoolParamsStats
x5 forall a. Semigroup a => a -> a -> a
<> PoolParamsStats
y5)

instance Monoid SnapShotStats where
  mempty :: SnapShotStats
mempty = Stat (Credential 'Staking)
-> Stat (Credential 'Staking)
-> Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'StakePool)
-> PoolParamsStats
-> SnapShotStats
SnapShotStats forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Pretty SnapShotStats where
  pretty :: forall ann. SnapShotStats -> Doc ann
pretty SnapShotStats {PoolParamsStats
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
sssPoolParamsStats :: PoolParamsStats
sssPoolParams :: Stat (KeyHash 'StakePool)
sssDelegationStakePool :: Stat (KeyHash 'StakePool)
sssDelegationCredential :: Stat (Credential 'Staking)
sssStake :: Stat (Credential 'Staking)
sssPoolParamsStats :: SnapShotStats -> PoolParamsStats
sssPoolParams :: SnapShotStats -> Stat (KeyHash 'StakePool)
sssDelegationStakePool :: SnapShotStats -> Stat (KeyHash 'StakePool)
sssDelegationCredential :: SnapShotStats -> Stat (Credential 'Staking)
sssStake :: SnapShotStats -> Stat (Credential 'Staking)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"SnapShot"
      [ Doc ann
"Stake" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
sssStake
      , Doc ann
"DelegationCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
sssDelegationCredential
      , Doc ann
"DelegationStakePool" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
sssDelegationStakePool
      , Doc ann
"PoolParams" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
sssPoolParams
      , forall a ann. Pretty a => a -> Doc ann
pretty PoolParamsStats
sssPoolParamsStats
      ]

instance AggregateStat SnapShotStats where
  aggregateStat :: SnapShotStats -> AggregateStats
aggregateStat SnapShotStats {PoolParamsStats
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
sssPoolParamsStats :: PoolParamsStats
sssPoolParams :: Stat (KeyHash 'StakePool)
sssDelegationStakePool :: Stat (KeyHash 'StakePool)
sssDelegationCredential :: Stat (Credential 'Staking)
sssStake :: Stat (Credential 'Staking)
sssPoolParamsStats :: SnapShotStats -> PoolParamsStats
sssPoolParams :: SnapShotStats -> Stat (KeyHash 'StakePool)
sssDelegationStakePool :: SnapShotStats -> Stat (KeyHash 'StakePool)
sssDelegationCredential :: SnapShotStats -> Stat (Credential 'Staking)
sssStake :: SnapShotStats -> Stat (Credential 'Staking)
..} =
    (forall s. AggregateStat s => s -> AggregateStats
aggregateStat PoolParamsStats
sssPoolParamsStats)
      { gsCredentialStaking :: Stat (Credential 'Staking)
gsCredentialStaking = Stat (Credential 'Staking)
sssStake forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
sssDelegationCredential
      , gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
sssDelegationStakePool forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'StakePool)
sssPoolParams
      }

countSnapShotStat :: SnapShot -> SnapShotStats
countSnapShotStat :: SnapShot -> SnapShotStats
countSnapShotStat SnapShot {Stake
VMap VB VB (KeyHash 'StakePool) PoolParams
VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssStake:SnapShot :: SnapShot -> Stake
$sel:ssDelegations:SnapShot :: SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssPoolParams:SnapShot :: SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssDelegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssStake :: Stake
..} =
  SnapShotStats
    { sssStake :: Stat (Credential 'Staking)
sssStake = forall k v. Map k v -> Stat k
statMapKeys (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
unStake Stake
ssStake))
    , sssDelegationCredential :: Stat (Credential 'Staking)
sssDelegationCredential = forall k v. Map k v -> Stat k
statMapKeys (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations)
    , sssDelegationStakePool :: Stat (KeyHash 'StakePool)
sssDelegationStakePool = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations)
    , sssPoolParams :: Stat (KeyHash 'StakePool)
sssPoolParams = forall k v. Map k v -> Stat k
statMapKeys (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams)
    , sssPoolParamsStats :: PoolParamsStats
sssPoolParamsStats = forall (vv :: * -> *) v m (kv :: * -> *) k.
(Vector vv v, Monoid m) =>
(v -> m) -> VMap kv vv k v -> m
VMap.foldMap PoolParams -> PoolParamsStats
countPoolParamsStats VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams
    }

data PoolParamsStats = PoolParamsStats
  { PoolParamsStats -> Stat (KeyHash 'StakePool)
ppsPoolId :: !(Stat (KeyHash 'StakePool))
  , PoolParamsStats -> Stat (Credential 'Staking)
ppsRewardAccount :: !(Stat (Credential 'Staking))
  , PoolParamsStats -> Stat (KeyHash 'Staking)
ppsOwners :: !(Stat (KeyHash 'Staking))
  }

instance Semigroup PoolParamsStats where
  <> :: PoolParamsStats -> PoolParamsStats -> PoolParamsStats
(<>) (PoolParamsStats Stat (KeyHash 'StakePool)
x1 Stat (Credential 'Staking)
x2 Stat (KeyHash 'Staking)
x3) (PoolParamsStats Stat (KeyHash 'StakePool)
y1 Stat (Credential 'Staking)
y2 Stat (KeyHash 'Staking)
y3) =
    Stat (KeyHash 'StakePool)
-> Stat (Credential 'Staking)
-> Stat (KeyHash 'Staking)
-> PoolParamsStats
PoolParamsStats
      (Stat (KeyHash 'StakePool)
x1 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'StakePool)
y1)
      (Stat (Credential 'Staking)
x2 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
y2)
      (Stat (KeyHash 'Staking)
x3 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'Staking)
y3)

instance Monoid PoolParamsStats where
  mempty :: PoolParamsStats
mempty = Stat (KeyHash 'StakePool)
-> Stat (Credential 'Staking)
-> Stat (KeyHash 'Staking)
-> PoolParamsStats
PoolParamsStats forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Pretty PoolParamsStats where
  pretty :: forall ann. PoolParamsStats -> Doc ann
pretty PoolParamsStats {Stat (KeyHash 'Staking)
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
ppsOwners :: Stat (KeyHash 'Staking)
ppsRewardAccount :: Stat (Credential 'Staking)
ppsPoolId :: Stat (KeyHash 'StakePool)
ppsOwners :: PoolParamsStats -> Stat (KeyHash 'Staking)
ppsRewardAccount :: PoolParamsStats -> Stat (Credential 'Staking)
ppsPoolId :: PoolParamsStats -> Stat (KeyHash 'StakePool)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PoolParamsStats"
      [ Doc ann
"PoolId" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
ppsPoolId
      , Doc ann
"RewardAccount" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
ppsRewardAccount
      , Doc ann
"Owners" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'Staking)
ppsOwners
      ]

instance AggregateStat PoolParamsStats where
  aggregateStat :: PoolParamsStats -> AggregateStats
aggregateStat PoolParamsStats {Stat (KeyHash 'Staking)
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
ppsOwners :: Stat (KeyHash 'Staking)
ppsRewardAccount :: Stat (Credential 'Staking)
ppsPoolId :: Stat (KeyHash 'StakePool)
ppsOwners :: PoolParamsStats -> Stat (KeyHash 'Staking)
ppsRewardAccount :: PoolParamsStats -> Stat (Credential 'Staking)
ppsPoolId :: PoolParamsStats -> Stat (KeyHash 'StakePool)
..} =
    forall a. Monoid a => a
mempty {gsCredentialStaking :: Stat (Credential 'Staking)
gsCredentialStaking = Stat (Credential 'Staking)
ppsRewardAccount, gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
ppsPoolId}

countPoolParamsStats :: PoolParams -> PoolParamsStats
countPoolParamsStats :: PoolParams -> PoolParamsStats
countPoolParamsStats PoolParams {Set (KeyHash 'Staking)
VRFVerKeyHash 'StakePoolVRF
KeyHash 'StakePool
StrictMaybe PoolMetadata
StrictSeq StakePoolRelay
RewardAccount
Coin
UnitInterval
ppId :: PoolParams -> KeyHash 'StakePool
ppVrf :: PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppPledge :: PoolParams -> Coin
ppCost :: PoolParams -> Coin
ppMargin :: PoolParams -> UnitInterval
ppRewardAccount :: PoolParams -> RewardAccount
ppOwners :: PoolParams -> Set (KeyHash 'Staking)
ppRelays :: PoolParams -> StrictSeq StakePoolRelay
ppMetadata :: PoolParams -> StrictMaybe PoolMetadata
ppMetadata :: StrictMaybe PoolMetadata
ppRelays :: StrictSeq StakePoolRelay
ppOwners :: Set (KeyHash 'Staking)
ppRewardAccount :: RewardAccount
ppMargin :: UnitInterval
ppCost :: Coin
ppPledge :: Coin
ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppId :: KeyHash 'StakePool
..} =
  PoolParamsStats
    { ppsPoolId :: Stat (KeyHash 'StakePool)
ppsPoolId = forall a. a -> Stat a
statSingleton KeyHash 'StakePool
ppId
    , ppsRewardAccount :: Stat (Credential 'Staking)
ppsRewardAccount = forall a. a -> Stat a
statSingleton (RewardAccount -> Credential 'Staking
raCredential RewardAccount
ppRewardAccount)
    , ppsOwners :: Stat (KeyHash 'Staking)
ppsOwners = forall a. Set a -> Stat a
statSet Set (KeyHash 'Staking)
ppOwners
    }

data RewardUpdateStats = RewardUpdateStats

instance Pretty RewardUpdateStats where
  pretty :: forall ann. RewardUpdateStats -> Doc ann
pretty RewardUpdateStats {} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord Doc ann
"RewardUpdateStats" []

instance AggregateStat RewardUpdateStats where
  aggregateStat :: RewardUpdateStats -> AggregateStats
aggregateStat RewardUpdateStats
RewardUpdateStats = forall a. Monoid a => a
mempty

data PoolDistrStats = PoolDistrStats
  { PoolDistrStats -> Stat (KeyHash 'StakePool)
pdsStakePoolKeyHash :: !(Stat (KeyHash 'StakePool))
  , PoolDistrStats -> Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolStakeVrf :: !(Stat (VRFVerKeyHash 'StakePoolVRF))
  }

instance Pretty PoolDistrStats where
  pretty :: forall ann. PoolDistrStats -> Doc ann
pretty PoolDistrStats {Stat (VRFVerKeyHash 'StakePoolVRF)
Stat (KeyHash 'StakePool)
pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash 'StakePool)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PoolDistrStats"
      [ Doc ann
"StakePoolKeyHash" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
pdsStakePoolKeyHash
      , Doc ann
"StakePoolStakeVrf" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolStakeVrf
      ]

instance AggregateStat PoolDistrStats where
  aggregateStat :: PoolDistrStats -> AggregateStats
aggregateStat PoolDistrStats {Stat (VRFVerKeyHash 'StakePoolVRF)
Stat (KeyHash 'StakePool)
pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash 'StakePool)
..} =
    forall a. Monoid a => a
mempty
      { gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
pdsStakePoolKeyHash
      , gsVerKeyVRF :: Stat (Hash HASH KeyRoleVRF)
gsVerKeyVRF = forall b a. Ord b => (a -> b) -> Stat a -> Stat b
mapStat forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolStakeVrf
      }

calcPoolDistrStats :: PoolDistr -> PoolDistrStats
calcPoolDistrStats :: PoolDistr -> PoolDistrStats
calcPoolDistrStats (PoolDistr Map (KeyHash 'StakePool) IndividualPoolStake
pd CompactForm Coin
_tot) =
  PoolDistrStats
    { pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool)
pdsStakePoolKeyHash = forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) IndividualPoolStake
pd
    , pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash 'StakePoolVRF)
pdsStakePoolStakeVrf = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (IndividualPoolStake -> VRFVerKeyHash 'StakePoolVRF
individualPoolStakeVrf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'StakePool) IndividualPoolStake
pd)
    }

data NewEpochStateStats = NewEpochStateStats
  { NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessPrevBlocksMade :: !(Stat (KeyHash 'StakePool))
  , NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessCurBlocksMade :: !(Stat (KeyHash 'StakePool))
  , NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessBlocksMade :: !(Stat (KeyHash 'StakePool))
  , NewEpochStateStats -> EpochStateStats
nessEpochStateStats :: !EpochStateStats
  , NewEpochStateStats -> RewardUpdateStats
nessRewardUpdate :: !RewardUpdateStats
  , NewEpochStateStats -> PoolDistrStats
nessPoolDistrStats :: !PoolDistrStats
  , NewEpochStateStats -> AggregateStats
nessAggregateStats :: !AggregateStats
  }

instance Pretty NewEpochStateStats where
  pretty :: forall ann. NewEpochStateStats -> Doc ann
pretty NewEpochStateStats {AggregateStats
EpochStateStats
PoolDistrStats
RewardUpdateStats
Stat (KeyHash 'StakePool)
nessAggregateStats :: AggregateStats
nessPoolDistrStats :: PoolDistrStats
nessRewardUpdate :: RewardUpdateStats
nessEpochStateStats :: EpochStateStats
nessBlocksMade :: Stat (KeyHash 'StakePool)
nessCurBlocksMade :: Stat (KeyHash 'StakePool)
nessPrevBlocksMade :: Stat (KeyHash 'StakePool)
nessAggregateStats :: NewEpochStateStats -> AggregateStats
nessPoolDistrStats :: NewEpochStateStats -> PoolDistrStats
nessRewardUpdate :: NewEpochStateStats -> RewardUpdateStats
nessEpochStateStats :: NewEpochStateStats -> EpochStateStats
nessBlocksMade :: NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessCurBlocksMade :: NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessPrevBlocksMade :: NewEpochStateStats -> Stat (KeyHash 'StakePool)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"NewEpochStateStats"
      [ Doc ann
"PrevBlocksMade" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> forall k. Stat k -> Count
statCount Stat (KeyHash 'StakePool)
nessPrevBlocksMade
      , Doc ann
"CurBlocksMade" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> forall k. Stat k -> Count
statCount Stat (KeyHash 'StakePool)
nessCurBlocksMade
      , Doc ann
"BlocksMade" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
nessBlocksMade
      , forall a ann. Pretty a => a -> Doc ann
pretty EpochStateStats
nessEpochStateStats
      , forall a ann. Pretty a => a -> Doc ann
pretty RewardUpdateStats
nessRewardUpdate forall a. Semigroup a => a -> a -> a
<> Doc ann
"TODO"
      , forall a ann. Pretty a => a -> Doc ann
pretty PoolDistrStats
nessPoolDistrStats
      , forall a ann. Pretty a => a -> Doc ann
pretty AggregateStats
nessAggregateStats
      ]

countNewEpochStateStats :: NewEpochState CurrentEra -> NewEpochStateStats
countNewEpochStateStats :: NewEpochState BabbageEra -> NewEpochStateStats
countNewEpochStateStats NewEpochState {StrictMaybe PulsingRewUpdate
PoolDistr
BlocksMade
EpochNo
EpochState BabbageEra
StashedAVVMAddresses BabbageEra
nesEL :: forall era. NewEpochState era -> EpochNo
nesBprev :: forall era. NewEpochState era -> BlocksMade
nesBcur :: forall era. NewEpochState era -> BlocksMade
nesRu :: forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesPd :: forall era. NewEpochState era -> PoolDistr
stashedAVVMAddresses :: forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses :: StashedAVVMAddresses BabbageEra
nesPd :: PoolDistr
nesRu :: StrictMaybe PulsingRewUpdate
nesEs :: EpochState BabbageEra
nesBcur :: BlocksMade
nesBprev :: BlocksMade
nesEL :: EpochNo
nesEs :: forall era. NewEpochState era -> EpochState era
..} =
  let ness :: NewEpochStateStats
ness =
        NewEpochStateStats
          { nessPrevBlocksMade :: Stat (KeyHash 'StakePool)
nessPrevBlocksMade = forall k v. Map k v -> Stat k
statMapKeys (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBprev)
          , nessCurBlocksMade :: Stat (KeyHash 'StakePool)
nessCurBlocksMade = forall k v. Map k v -> Stat k
statMapKeys (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBcur)
          , nessBlocksMade :: Stat (KeyHash 'StakePool)
nessBlocksMade = forall a. Monoid a => a
mempty
          , nessEpochStateStats :: EpochStateStats
nessEpochStateStats = EpochState BabbageEra -> EpochStateStats
countEpochStateStats EpochState BabbageEra
nesEs
          , nessRewardUpdate :: RewardUpdateStats
nessRewardUpdate = RewardUpdateStats
RewardUpdateStats
          , nessPoolDistrStats :: PoolDistrStats
nessPoolDistrStats = PoolDistr -> PoolDistrStats
calcPoolDistrStats PoolDistr
nesPd
          , nessAggregateStats :: AggregateStats
nessAggregateStats = forall a. Monoid a => a
mempty
          }
   in NewEpochStateStats
ness
        { nessBlocksMade :: Stat (KeyHash 'StakePool)
nessBlocksMade = NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessPrevBlocksMade NewEpochStateStats
ness forall a. Semigroup a => a -> a -> a
<> NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessCurBlocksMade NewEpochStateStats
ness
        , nessAggregateStats :: AggregateStats
nessAggregateStats =
            forall a. Monoid a => [a] -> a
mconcat
              [ forall s. AggregateStat s => s -> AggregateStats
aggregateStat (NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessPrevBlocksMade NewEpochStateStats
ness)
              , forall s. AggregateStat s => s -> AggregateStats
aggregateStat (NewEpochStateStats -> Stat (KeyHash 'StakePool)
nessCurBlocksMade NewEpochStateStats
ness)
              , forall s. AggregateStat s => s -> AggregateStats
aggregateStat (NewEpochStateStats -> RewardUpdateStats
nessRewardUpdate NewEpochStateStats
ness)
              , EpochStateStats -> AggregateStats
essAggregateStats (NewEpochStateStats -> EpochStateStats
nessEpochStateStats NewEpochStateStats
ness)
              , forall s. AggregateStat s => s -> AggregateStats
aggregateStat (NewEpochStateStats -> PoolDistrStats
nessPoolDistrStats NewEpochStateStats
ness)
              ]
        }

printNewEpochStateStats :: NewEpochStateStats -> IO ()
printNewEpochStateStats :: NewEpochStateStats -> IO ()
printNewEpochStateStats = String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

data EpochStateStats = EpochStateStats
  { EpochStateStats -> SnapShotStats
essMarkSnapShotStats :: !SnapShotStats
  , EpochStateStats -> SnapShotStats
essSetSnapShotStats :: !SnapShotStats
  , EpochStateStats -> SnapShotStats
essGoSnapShotStats :: !SnapShotStats
  , EpochStateStats -> SnapShotStats
essSnapShotsStats :: !SnapShotStats
  , EpochStateStats -> LedgerStateStats
essLedgerStateStats :: !LedgerStateStats
  , EpochStateStats -> Stat (KeyHash 'StakePool)
essNonMyopic :: !(Stat (KeyHash 'StakePool))
  , EpochStateStats -> AggregateStats
essAggregateStats :: !AggregateStats
  }

instance Pretty EpochStateStats where
  pretty :: forall ann. EpochStateStats -> Doc ann
pretty EpochStateStats {AggregateStats
LedgerStateStats
SnapShotStats
Stat (KeyHash 'StakePool)
essAggregateStats :: AggregateStats
essNonMyopic :: Stat (KeyHash 'StakePool)
essLedgerStateStats :: LedgerStateStats
essSnapShotsStats :: SnapShotStats
essGoSnapShotStats :: SnapShotStats
essSetSnapShotStats :: SnapShotStats
essMarkSnapShotStats :: SnapShotStats
essNonMyopic :: EpochStateStats -> Stat (KeyHash 'StakePool)
essLedgerStateStats :: EpochStateStats -> LedgerStateStats
essSnapShotsStats :: EpochStateStats -> SnapShotStats
essGoSnapShotStats :: EpochStateStats -> SnapShotStats
essSetSnapShotStats :: EpochStateStats -> SnapShotStats
essMarkSnapShotStats :: EpochStateStats -> SnapShotStats
essAggregateStats :: EpochStateStats -> AggregateStats
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"EpochStateStats"
      [ Doc ann
"mark" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential 'Staking)
sssStake SnapShotStats
essMarkSnapShotStats)
      , Doc ann
"set" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential 'Staking)
sssStake SnapShotStats
essSetSnapShotStats)
      , Doc ann
"go" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential 'Staking)
sssStake SnapShotStats
essGoSnapShotStats)
      , Doc ann
"mark+set+go =" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty SnapShotStats
essSnapShotsStats
      , forall a ann. Pretty a => a -> Doc ann
pretty LedgerStateStats
essLedgerStateStats
      , Doc ann
"NonMyopic" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
essNonMyopic
      , forall a ann. Pretty a => a -> Doc ann
pretty AggregateStats
essAggregateStats
      ]

countEpochStateStats :: EpochState CurrentEra -> EpochStateStats
countEpochStateStats :: EpochState BabbageEra -> EpochStateStats
countEpochStateStats EpochState {SnapShots
AccountState
LedgerState BabbageEra
NonMyopic
esAccountState :: forall era. EpochState era -> AccountState
esSnapshots :: forall era. EpochState era -> SnapShots
esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic :: NonMyopic
esSnapshots :: SnapShots
esLState :: LedgerState BabbageEra
esAccountState :: AccountState
esLState :: forall era. EpochState era -> LedgerState era
..} =
  let markSnap :: SnapShotStats
markSnap = SnapShot -> SnapShotStats
countSnapShotStat (SnapShots -> SnapShot
ssStakeMark SnapShots
esSnapshots)
      setSnap :: SnapShotStats
setSnap = SnapShot -> SnapShotStats
countSnapShotStat (SnapShots -> SnapShot
ssStakeSet SnapShots
esSnapshots)
      goSnap :: SnapShotStats
goSnap = SnapShot -> SnapShotStats
countSnapShotStat (SnapShots -> SnapShot
ssStakeGo SnapShots
esSnapshots)
      stats :: EpochStateStats
stats =
        EpochStateStats
          { essMarkSnapShotStats :: SnapShotStats
essMarkSnapShotStats = SnapShotStats
markSnap
          , essSetSnapShotStats :: SnapShotStats
essSetSnapShotStats = SnapShotStats
setSnap
          , essGoSnapShotStats :: SnapShotStats
essGoSnapShotStats = SnapShotStats
goSnap
          , essSnapShotsStats :: SnapShotStats
essSnapShotsStats = SnapShotStats
markSnap forall a. Semigroup a => a -> a -> a
<> SnapShotStats
setSnap forall a. Semigroup a => a -> a -> a
<> SnapShotStats
goSnap
          , essLedgerStateStats :: LedgerStateStats
essLedgerStateStats = LedgerState BabbageEra -> LedgerStateStats
countLedgerStateStats LedgerState BabbageEra
esLState
          , essNonMyopic :: Stat (KeyHash 'StakePool)
essNonMyopic = forall k v. Map k v -> Stat k
statMapKeys (NonMyopic -> Map (KeyHash 'StakePool) Likelihood
likelihoodsNM NonMyopic
esNonMyopic)
          , essAggregateStats :: AggregateStats
essAggregateStats = forall a. Monoid a => a
mempty
          }
   in EpochStateStats
stats
        { essAggregateStats :: AggregateStats
essAggregateStats =
            forall a. Monoid a => [a] -> a
mconcat
              [ forall s. AggregateStat s => s -> AggregateStats
aggregateStat (EpochStateStats -> SnapShotStats
essSnapShotsStats EpochStateStats
stats)
              , forall s. AggregateStat s => s -> AggregateStats
aggregateStat (EpochStateStats -> LedgerStateStats
essLedgerStateStats EpochStateStats
stats)
              , forall s. AggregateStat s => s -> AggregateStats
aggregateStat (EpochStateStats -> Stat (KeyHash 'StakePool)
essNonMyopic EpochStateStats
stats)
              ]
        }

data DStateStats = DStateStats
  { DStateStats -> Stat (Credential 'Staking)
dssCredentialStaking :: !(Stat (Credential 'Staking))
  , DStateStats -> Stat (KeyHash 'StakePool)
dssDelegations :: !(Stat (KeyHash 'StakePool))
  , DStateStats -> Stat (KeyHash 'Genesis)
dssKeyHashGenesis :: !(Stat (KeyHash 'Genesis))
  , DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesisDelegate :: !(Stat (KeyHash 'GenesisDelegate))
  , DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssHashVerKeyVRF :: !(Stat (VRFVerKeyHash 'GenDelegVRF))
  }

instance Pretty DStateStats where
  pretty :: forall ann. DStateStats -> Doc ann
pretty DStateStats {Stat (VRFVerKeyHash 'GenDelegVRF)
Stat (KeyHash 'Genesis)
Stat (KeyHash 'GenesisDelegate)
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
dssHashVerKeyVRF :: Stat (VRFVerKeyHash 'GenDelegVRF)
dssKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
dssDelegations :: Stat (KeyHash 'StakePool)
dssCredentialStaking :: Stat (Credential 'Staking)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"DStateStats"
      [ Doc ann
"CredentialStaking" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
dssCredentialStaking
      , Doc ann
"SPoolUView" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
dssDelegations
      , Doc ann
"KeyHashGenesis" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'Genesis)
dssKeyHashGenesis
      , Doc ann
"KeyHashGenesisDelegate" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesisDelegate
      , Doc ann
"HashVerKeyVRF" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (VRFVerKeyHash 'GenDelegVRF)
dssHashVerKeyVRF
      ]

instance AggregateStat DStateStats where
  aggregateStat :: DStateStats -> AggregateStats
aggregateStat DStateStats {Stat (VRFVerKeyHash 'GenDelegVRF)
Stat (KeyHash 'Genesis)
Stat (KeyHash 'GenesisDelegate)
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
dssHashVerKeyVRF :: Stat (VRFVerKeyHash 'GenDelegVRF)
dssKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
dssDelegations :: Stat (KeyHash 'StakePool)
dssCredentialStaking :: Stat (Credential 'Staking)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking)
..} =
    forall a. Monoid a => a
mempty
      { gsCredentialStaking :: Stat (Credential 'Staking)
gsCredentialStaking = Stat (Credential 'Staking)
dssCredentialStaking
      , gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
dssDelegations
      , gsKeyHashGenesis :: Stat (KeyHash 'Genesis)
gsKeyHashGenesis = Stat (KeyHash 'Genesis)
dssKeyHashGenesis
      , gsKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate)
gsKeyHashGenesisDelegate = Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesisDelegate
      , gsVerKeyVRF :: Stat (Hash HASH KeyRoleVRF)
gsVerKeyVRF = forall b a. Ord b => (a -> b) -> Stat a -> Stat b
mapStat forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash Stat (VRFVerKeyHash 'GenDelegVRF)
dssHashVerKeyVRF
      }

countDStateStats :: DState CurrentEra -> DStateStats
countDStateStats :: DState BabbageEra -> DStateStats
countDStateStats DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
UMap
GenDelegs
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
dsIRewards :: InstantaneousRewards
dsGenDelegs :: GenDelegs
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsUnified :: UMap
..} =
  DStateStats
    { dssCredentialStaking :: Stat (Credential 'Staking)
dssCredentialStaking =
        forall k v. Map k v -> Stat k
statMapKeys (UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
dsUnified)
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)
          forall a. Semigroup a => a -> a -> a
<> forall a. Set a -> Stat a
statSet (forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range (UMap -> Map Ptr (Credential 'Staking)
UM.ptrMap UMap
dsUnified))
    , dssDelegations :: Stat (KeyHash 'StakePool)
dssDelegations = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)
    , dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
dssKeyHashGenesis =
        forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (FutureGenDeleg -> KeyHash 'Genesis
fGenDelegGenKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [k]
Map.keys Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs)
    , dssKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesisDelegate =
        forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
          forall a. Semigroup a => a -> a -> a
<> forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable
            (GenDelegPair -> KeyHash 'GenesisDelegate
genDelegKeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs))
    , dssHashVerKeyVRF :: Stat (VRFVerKeyHash 'GenDelegVRF)
dssHashVerKeyVRF =
        forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (GenDelegPair -> VRFVerKeyHash 'GenDelegVRF
genDelegVrfHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
          forall a. Semigroup a => a -> a -> a
<> forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable
            (GenDelegPair -> VRFVerKeyHash 'GenDelegVRF
genDelegVrfHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs))
    }

data PStateStats = PStateStats
  { PStateStats -> Stat (KeyHash 'StakePool)
pssKeyHashStakePool :: !(Stat (KeyHash 'StakePool))
  , PStateStats -> PoolParamsStats
pssPoolParamsStats :: !PoolParamsStats
  }

instance Pretty PStateStats where
  pretty :: forall ann. PStateStats -> Doc ann
pretty PStateStats {PoolParamsStats
Stat (KeyHash 'StakePool)
pssPoolParamsStats :: PoolParamsStats
pssKeyHashStakePool :: Stat (KeyHash 'StakePool)
pssPoolParamsStats :: PStateStats -> PoolParamsStats
pssKeyHashStakePool :: PStateStats -> Stat (KeyHash 'StakePool)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PStateStats"
      [ Doc ann
"KeyHashStakePool" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
pssKeyHashStakePool
      , forall a ann. Pretty a => a -> Doc ann
pretty PoolParamsStats
pssPoolParamsStats
      ]

instance AggregateStat PStateStats where
  aggregateStat :: PStateStats -> AggregateStats
aggregateStat PStateStats {PoolParamsStats
Stat (KeyHash 'StakePool)
pssPoolParamsStats :: PoolParamsStats
pssKeyHashStakePool :: Stat (KeyHash 'StakePool)
pssPoolParamsStats :: PStateStats -> PoolParamsStats
pssKeyHashStakePool :: PStateStats -> Stat (KeyHash 'StakePool)
..} =
    (forall s. AggregateStat s => s -> AggregateStats
aggregateStat PoolParamsStats
pssPoolParamsStats) {gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
pssKeyHashStakePool}

countPStateStats :: PState CurrentEra -> PStateStats
countPStateStats :: PState BabbageEra -> PStateStats
countPStateStats PState {Map (KeyHash 'StakePool) PoolParams
Map (KeyHash 'StakePool) Coin
Map (KeyHash 'StakePool) EpochNo
psStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psRetiring :: forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psDeposits :: forall era. PState era -> Map (KeyHash 'StakePool) Coin
psDeposits :: Map (KeyHash 'StakePool) Coin
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
..} =
  PStateStats
    { pssKeyHashStakePool :: Stat (KeyHash 'StakePool)
pssKeyHashStakePool =
        forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) PoolParams
psStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) EpochNo
psRetiring
    , pssPoolParamsStats :: PoolParamsStats
pssPoolParamsStats =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PoolParams -> PoolParamsStats
countPoolParamsStats Map (KeyHash 'StakePool) PoolParams
psStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PoolParams -> PoolParamsStats
countPoolParamsStats Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams
    }

data LedgerStateStats = LedgerStateStats
  { LedgerStateStats -> UTxOStats
lssUTxOStats :: !UTxOStats
  , LedgerStateStats -> DStateStats
lssDStateStats :: !DStateStats
  , LedgerStateStats -> PStateStats
lssPStateStats :: !PStateStats
  }

instance Pretty LedgerStateStats where
  pretty :: forall ann. LedgerStateStats -> Doc ann
pretty LedgerStateStats {UTxOStats
PStateStats
DStateStats
lssPStateStats :: PStateStats
lssDStateStats :: DStateStats
lssUTxOStats :: UTxOStats
lssPStateStats :: LedgerStateStats -> PStateStats
lssDStateStats :: LedgerStateStats -> DStateStats
lssUTxOStats :: LedgerStateStats -> UTxOStats
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"LedgerStateStats"
      [ forall a ann. Pretty a => a -> Doc ann
pretty UTxOStats
lssUTxOStats
      , forall a ann. Pretty a => a -> Doc ann
pretty DStateStats
lssDStateStats
      , forall a ann. Pretty a => a -> Doc ann
pretty PStateStats
lssPStateStats
      ]

instance AggregateStat LedgerStateStats where
  aggregateStat :: LedgerStateStats -> AggregateStats
aggregateStat LedgerStateStats {UTxOStats
PStateStats
DStateStats
lssPStateStats :: PStateStats
lssDStateStats :: DStateStats
lssUTxOStats :: UTxOStats
lssPStateStats :: LedgerStateStats -> PStateStats
lssDStateStats :: LedgerStateStats -> DStateStats
lssUTxOStats :: LedgerStateStats -> UTxOStats
..} =
    forall a. Monoid a => [a] -> a
mconcat
      [ forall s. AggregateStat s => s -> AggregateStats
aggregateStat UTxOStats
lssUTxOStats
      , forall s. AggregateStat s => s -> AggregateStats
aggregateStat DStateStats
lssDStateStats
      , forall s. AggregateStat s => s -> AggregateStats
aggregateStat PStateStats
lssPStateStats
      ]

countLedgerStateStats :: LedgerState CurrentEra -> LedgerStateStats
countLedgerStateStats :: LedgerState BabbageEra -> LedgerStateStats
countLedgerStateStats LedgerState {CertState BabbageEra
UTxOState BabbageEra
lsCertState :: forall era. LedgerState era -> CertState era
lsCertState :: CertState BabbageEra
lsUTxOState :: UTxOState BabbageEra
lsUTxOState :: forall era. LedgerState era -> UTxOState era
..} =
  LedgerStateStats
    { lssUTxOStats :: UTxOStats
lssUTxOStats = UTxO BabbageEra -> UTxOStats
countUTxOStats (forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState BabbageEra
lsUTxOState)
    , lssDStateStats :: DStateStats
lssDStateStats = DState BabbageEra -> DStateStats
countDStateStats (forall era. CertState era -> DState era
certDState CertState BabbageEra
lsCertState)
    , lssPStateStats :: PStateStats
lssPStateStats = PState BabbageEra -> PStateStats
countPStateStats (forall era. CertState era -> PState era
certPState CertState BabbageEra
lsCertState)
    }

data TxInStats = TxInStats
  { TxInStats -> Stat TxId
tisTxId :: !(Stat TxId)
  , TxInStats -> Stat TxIx
tisTxIx :: !(Stat TxIx)
  }

instance Pretty TxInStats where
  pretty :: forall ann. TxInStats -> Doc ann
pretty TxInStats {Stat TxId
Stat TxIx
tisTxIx :: Stat TxIx
tisTxId :: Stat TxId
tisTxIx :: TxInStats -> Stat TxIx
tisTxId :: TxInStats -> Stat TxId
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord Doc ann
"TxInStats" [Doc ann
"TxId" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat TxId
tisTxId, Doc ann
"TxIx" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat TxIx
tisTxIx]

countTxInStats :: [TxIn] -> TxInStats
countTxInStats :: [TxIn] -> TxInStats
countTxInStats [TxIn]
txIns =
  case forall a b. [(a, b)] -> ([a], [b])
unzip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TxIn TxId
txId TxIx
txIx) -> (TxId
txId, TxIx
txIx)) [TxIn]
txIns) of
    ([TxId]
txIds, [TxIx]
txIxs) ->
      TxInStats
        { tisTxId :: Stat TxId
tisTxId = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable [TxId]
txIds
        , tisTxIx :: Stat TxIx
tisTxIx = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable [TxIx]
txIxs
        }

data TxOutStats = TxOutStats
  { TxOutStats -> Stat BootstrapAddress
tosBootstrap :: !(Stat BootstrapAddress)
  , TxOutStats -> Stat (Credential 'Payment)
tosPaymentCredential :: !(Stat (Credential 'Payment))
  , TxOutStats -> Stat (Credential 'Staking)
tosStakingCredential :: !(Stat (Credential 'Staking))
  , TxOutStats -> Stat Ptr
tosStakingPtr :: !(Stat Ptr)
  , TxOutStats -> Stat Network
tosNetwork :: !(Stat Network)
  , TxOutStats -> Stat Integer
tosValue :: !(Stat Integer)
  , TxOutStats -> Stat PolicyID
tosPolicyId :: !(Stat PolicyID)
  , TxOutStats -> Stat AssetName
tosAssetName :: !(Stat AssetName)
  , TxOutStats -> Stat Integer
tosAssetValue :: !(Stat Integer)
  , TxOutStats -> Stat DataHash
tosDataHash :: !(Stat DataHash)
  }

instance Semigroup TxOutStats where
  <> :: TxOutStats -> TxOutStats -> TxOutStats
(<>) (TxOutStats Stat BootstrapAddress
x0 Stat (Credential 'Payment)
x1 Stat (Credential 'Staking)
x2 Stat Ptr
x3 Stat Network
x4 Stat Integer
x5 Stat PolicyID
x6 Stat AssetName
x7 Stat Integer
x8 Stat DataHash
x9) (TxOutStats Stat BootstrapAddress
y0 Stat (Credential 'Payment)
y1 Stat (Credential 'Staking)
y2 Stat Ptr
y3 Stat Network
y4 Stat Integer
y5 Stat PolicyID
y6 Stat AssetName
y7 Stat Integer
y8 Stat DataHash
y9) =
    Stat BootstrapAddress
-> Stat (Credential 'Payment)
-> Stat (Credential 'Staking)
-> Stat Ptr
-> Stat Network
-> Stat Integer
-> Stat PolicyID
-> Stat AssetName
-> Stat Integer
-> Stat DataHash
-> TxOutStats
TxOutStats
      (Stat BootstrapAddress
x0 forall a. Semigroup a => a -> a -> a
<> Stat BootstrapAddress
y0)
      (Stat (Credential 'Payment)
x1 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Payment)
y1)
      (Stat (Credential 'Staking)
x2 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
y2)
      (Stat Ptr
x3 forall a. Semigroup a => a -> a -> a
<> Stat Ptr
y3)
      (Stat Network
x4 forall a. Semigroup a => a -> a -> a
<> Stat Network
y4)
      (Stat Integer
x5 forall a. Semigroup a => a -> a -> a
<> Stat Integer
y5)
      (Stat PolicyID
x6 forall a. Semigroup a => a -> a -> a
<> Stat PolicyID
y6)
      (Stat AssetName
x7 forall a. Semigroup a => a -> a -> a
<> Stat AssetName
y7)
      (Stat Integer
x8 forall a. Semigroup a => a -> a -> a
<> Stat Integer
y8)
      (Stat DataHash
x9 forall a. Semigroup a => a -> a -> a
<> Stat DataHash
y9)

instance Monoid TxOutStats where
  mempty :: TxOutStats
mempty = Stat BootstrapAddress
-> Stat (Credential 'Payment)
-> Stat (Credential 'Staking)
-> Stat Ptr
-> Stat Network
-> Stat Integer
-> Stat PolicyID
-> Stat AssetName
-> Stat Integer
-> Stat DataHash
-> TxOutStats
TxOutStats forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Pretty TxOutStats where
  pretty :: forall ann. TxOutStats -> Doc ann
pretty TxOutStats {Stat Integer
Stat DataHash
Stat BootstrapAddress
Stat (Credential 'Payment)
Stat (Credential 'Staking)
Stat Ptr
Stat Network
Stat AssetName
Stat PolicyID
tosDataHash :: Stat DataHash
tosAssetValue :: Stat Integer
tosAssetName :: Stat AssetName
tosPolicyId :: Stat PolicyID
tosValue :: Stat Integer
tosNetwork :: Stat Network
tosStakingPtr :: Stat Ptr
tosStakingCredential :: Stat (Credential 'Staking)
tosPaymentCredential :: Stat (Credential 'Payment)
tosBootstrap :: Stat BootstrapAddress
tosDataHash :: TxOutStats -> Stat DataHash
tosAssetValue :: TxOutStats -> Stat Integer
tosAssetName :: TxOutStats -> Stat AssetName
tosPolicyId :: TxOutStats -> Stat PolicyID
tosValue :: TxOutStats -> Stat Integer
tosNetwork :: TxOutStats -> Stat Network
tosStakingPtr :: TxOutStats -> Stat Ptr
tosStakingCredential :: TxOutStats -> Stat (Credential 'Staking)
tosPaymentCredential :: TxOutStats -> Stat (Credential 'Payment)
tosBootstrap :: TxOutStats -> Stat BootstrapAddress
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"TxOutStats"
      [ Doc ann
"Bootstrap" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat BootstrapAddress
tosBootstrap
      , Doc ann
"PaymentCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Payment)
tosPaymentCredential
      , Doc ann
"StakingCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
tosStakingCredential
      , Doc ann
"StakingPtr" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat Ptr
tosStakingPtr
      , Doc ann
"Network" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat Network
tosNetwork
      , Doc ann
"Value" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat Integer
tosValue
      , Doc ann
"PolicyId" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat PolicyID
tosPolicyId
      , Doc ann
"AssetName" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat AssetName
tosAssetName
      , Doc ann
"AssetValue" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat Integer
tosAssetValue
      , Doc ann
"DataHash" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat DataHash
tosDataHash
      ]

instance AggregateStat TxOutStats where
  aggregateStat :: TxOutStats -> AggregateStats
aggregateStat TxOutStats {Stat Integer
Stat DataHash
Stat BootstrapAddress
Stat (Credential 'Payment)
Stat (Credential 'Staking)
Stat Ptr
Stat Network
Stat AssetName
Stat PolicyID
tosDataHash :: Stat DataHash
tosAssetValue :: Stat Integer
tosAssetName :: Stat AssetName
tosPolicyId :: Stat PolicyID
tosValue :: Stat Integer
tosNetwork :: Stat Network
tosStakingPtr :: Stat Ptr
tosStakingCredential :: Stat (Credential 'Staking)
tosPaymentCredential :: Stat (Credential 'Payment)
tosBootstrap :: Stat BootstrapAddress
tosDataHash :: TxOutStats -> Stat DataHash
tosAssetValue :: TxOutStats -> Stat Integer
tosAssetName :: TxOutStats -> Stat AssetName
tosPolicyId :: TxOutStats -> Stat PolicyID
tosValue :: TxOutStats -> Stat Integer
tosNetwork :: TxOutStats -> Stat Network
tosStakingPtr :: TxOutStats -> Stat Ptr
tosStakingCredential :: TxOutStats -> Stat (Credential 'Staking)
tosPaymentCredential :: TxOutStats -> Stat (Credential 'Payment)
tosBootstrap :: TxOutStats -> Stat BootstrapAddress
..} = forall s. AggregateStat s => s -> AggregateStats
aggregateStat Stat (Credential 'Staking)
tosStakingCredential

countTxOutStats :: [TxOut CurrentEra] -> TxOutStats
countTxOutStats :: [TxOut BabbageEra] -> TxOutStats
countTxOutStats = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut BabbageEra -> TxOutStats
countTxOutStat
  where
    countTxOutStat :: TxOut CurrentEra -> TxOutStats
    countTxOutStat :: TxOut BabbageEra -> TxOutStats
countTxOutStat TxOut BabbageEra
txOut =
      let addr :: Addr
addr = TxOut BabbageEra
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL
          MaryValue (Coin Integer
v) (MultiAsset Map PolicyID (Map AssetName Integer)
m) = TxOut BabbageEra
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL
          !dataStat :: TxOutStats
dataStat =
            forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe
              forall a. Monoid a => a
mempty
              (\DataHash
d -> forall a. Monoid a => a
mempty {tosDataHash :: Stat DataHash
tosDataHash = forall a. a -> Stat a
statSingleton DataHash
d})
              (TxOut BabbageEra
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL)
          !vmElems :: [Map AssetName Integer]
vmElems = forall k a. Map k a -> [a]
Map.elems Map PolicyID (Map AssetName Integer)
m
          !valueStat :: TxOutStats
valueStat =
            TxOutStats
dataStat
              { tosValue :: Stat Integer
tosValue = forall a. a -> Stat a
statSingleton Integer
v
              , tosPolicyId :: Stat PolicyID
tosPolicyId = forall k v. Map k v -> Stat k
statMapKeys Map PolicyID (Map AssetName Integer)
m
              , tosAssetName :: Stat AssetName
tosAssetName = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall k v. Map k v -> Stat k
statMapKeys [Map AssetName Integer]
vmElems
              , tosAssetValue :: Stat Integer
tosAssetValue = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable [Map AssetName Integer]
vmElems
              }
          !networkStat :: TxOutStats
networkStat = TxOutStats
valueStat {tosNetwork :: Stat Network
tosNetwork = forall a. a -> Stat a
statSingleton (Addr -> Network
getNetwork Addr
addr)}
       in case Addr
addr of
            AddrBootstrap BootstrapAddress
addrBootstrap ->
              TxOutStats
networkStat {tosBootstrap :: Stat BootstrapAddress
tosBootstrap = forall a. a -> Stat a
statSingleton BootstrapAddress
addrBootstrap}
            Addr Network
_ Credential 'Payment
pc StakeReference
sr ->
              let stakeStat :: TxOutStats
stakeStat =
                    case StakeReference
sr of
                      StakeReference
StakeRefNull -> TxOutStats
networkStat
                      StakeRefPtr Ptr
ptr ->
                        TxOutStats
networkStat {tosStakingPtr :: Stat Ptr
tosStakingPtr = forall a. a -> Stat a
statSingleton Ptr
ptr}
                      StakeRefBase Credential 'Staking
cred ->
                        TxOutStats
networkStat {tosStakingCredential :: Stat (Credential 'Staking)
tosStakingCredential = forall a. a -> Stat a
statSingleton Credential 'Staking
cred}
               in TxOutStats
stakeStat {tosPaymentCredential :: Stat (Credential 'Payment)
tosPaymentCredential = forall a. a -> Stat a
statSingleton Credential 'Payment
pc}

data UTxOStats = UTxOStats
  { UTxOStats -> TxInStats
usTxInStats :: !TxInStats
  , UTxOStats -> TxOutStats
usTxOutStats :: !TxOutStats
  }

instance Pretty UTxOStats where
  pretty :: forall ann. UTxOStats -> Doc ann
pretty UTxOStats {TxOutStats
TxInStats
usTxOutStats :: TxOutStats
usTxInStats :: TxInStats
usTxOutStats :: UTxOStats -> TxOutStats
usTxInStats :: UTxOStats -> TxInStats
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"UTxOStats"
      [forall a ann. Pretty a => a -> Doc ann
pretty TxInStats
usTxInStats, forall a ann. Pretty a => a -> Doc ann
pretty TxOutStats
usTxOutStats]

instance AggregateStat UTxOStats where
  aggregateStat :: UTxOStats -> AggregateStats
aggregateStat = forall s. AggregateStat s => s -> AggregateStats
aggregateStat forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxOStats -> TxOutStats
usTxOutStats

countUTxOStats :: UTxO CurrentEra -> UTxOStats
countUTxOStats :: UTxO BabbageEra -> UTxOStats
countUTxOStats (UTxO Map TxIn (TxOut BabbageEra)
m) =
  UTxOStats
    { usTxInStats :: TxInStats
usTxInStats = [TxIn] -> TxInStats
countTxInStats (forall k a. Map k a -> [k]
Map.keys Map TxIn (TxOut BabbageEra)
m)
    , usTxOutStats :: TxOutStats
usTxOutStats = [TxOut BabbageEra] -> TxOutStats
countTxOutStats (forall k a. Map k a -> [a]
Map.elems Map TxIn (TxOut BabbageEra)
m)
    }

data AggregateStats = AggregateStats
  { AggregateStats -> Stat (Credential 'Staking)
gsCredentialStaking :: !(Stat (Credential 'Staking))
  , AggregateStats -> Stat (KeyHash 'StakePool)
gsKeyHashStakePool :: !(Stat (KeyHash 'StakePool))
  , AggregateStats -> Stat (KeyHash 'Genesis)
gsKeyHashGenesis :: !(Stat (KeyHash 'Genesis))
  , AggregateStats -> Stat (KeyHash 'GenesisDelegate)
gsKeyHashGenesisDelegate :: !(Stat (KeyHash 'GenesisDelegate))
  , AggregateStats -> Stat (Hash HASH KeyRoleVRF)
gsVerKeyVRF :: !(Stat (Hash HASH KeyRoleVRF))
  , AggregateStats -> Stat ScriptHash
gsScriptHash :: !(Stat ScriptHash)
  }

instance Semigroup AggregateStats where
  <> :: AggregateStats -> AggregateStats -> AggregateStats
(<>) (AggregateStats Stat (Credential 'Staking)
x1 Stat (KeyHash 'StakePool)
x2 Stat (KeyHash 'Genesis)
x3 Stat (KeyHash 'GenesisDelegate)
x4 Stat (Hash HASH KeyRoleVRF)
x5 Stat ScriptHash
x6) (AggregateStats Stat (Credential 'Staking)
y1 Stat (KeyHash 'StakePool)
y2 Stat (KeyHash 'Genesis)
y3 Stat (KeyHash 'GenesisDelegate)
y4 Stat (Hash HASH KeyRoleVRF)
y5 Stat ScriptHash
y6) =
    Stat (Credential 'Staking)
-> Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'Genesis)
-> Stat (KeyHash 'GenesisDelegate)
-> Stat (Hash HASH KeyRoleVRF)
-> Stat ScriptHash
-> AggregateStats
AggregateStats
      (Stat (Credential 'Staking)
x1 forall a. Semigroup a => a -> a -> a
<> Stat (Credential 'Staking)
y1)
      (Stat (KeyHash 'StakePool)
x2 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'StakePool)
y2)
      (Stat (KeyHash 'Genesis)
x3 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'Genesis)
y3)
      (Stat (KeyHash 'GenesisDelegate)
x4 forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'GenesisDelegate)
y4)
      (Stat (Hash HASH KeyRoleVRF)
x5 forall a. Semigroup a => a -> a -> a
<> Stat (Hash HASH KeyRoleVRF)
y5)
      (Stat ScriptHash
x6 forall a. Semigroup a => a -> a -> a
<> Stat ScriptHash
y6)

instance Monoid AggregateStats where
  mempty :: AggregateStats
mempty = Stat (Credential 'Staking)
-> Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'Genesis)
-> Stat (KeyHash 'GenesisDelegate)
-> Stat (Hash HASH KeyRoleVRF)
-> Stat ScriptHash
-> AggregateStats
AggregateStats forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Pretty AggregateStats where
  pretty :: forall ann. AggregateStats -> Doc ann
pretty AggregateStats {Stat (Hash HASH KeyRoleVRF)
Stat ScriptHash
Stat (KeyHash 'Genesis)
Stat (KeyHash 'GenesisDelegate)
Stat (KeyHash 'StakePool)
Stat (Credential 'Staking)
gsScriptHash :: Stat ScriptHash
gsVerKeyVRF :: Stat (Hash HASH KeyRoleVRF)
gsKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate)
gsKeyHashGenesis :: Stat (KeyHash 'Genesis)
gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsCredentialStaking :: Stat (Credential 'Staking)
gsScriptHash :: AggregateStats -> Stat ScriptHash
gsKeyHashGenesisDelegate :: AggregateStats -> Stat (KeyHash 'GenesisDelegate)
gsKeyHashGenesis :: AggregateStats -> Stat (KeyHash 'Genesis)
gsVerKeyVRF :: AggregateStats -> Stat (Hash HASH KeyRoleVRF)
gsKeyHashStakePool :: AggregateStats -> Stat (KeyHash 'StakePool)
gsCredentialStaking :: AggregateStats -> Stat (Credential 'Staking)
..} =
    forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"AggregateStats"
      [ Doc ann
"StakingCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking)
gsCredentialStaking
      , Doc ann
"KeyHashStakePool" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool)
gsKeyHashStakePool
      , Doc ann
"ScriptHash" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat ScriptHash
gsScriptHash
      ]

class AggregateStat s where
  aggregateStat :: s -> AggregateStats

instance AggregateStat (Stat (Credential 'Staking)) where
  aggregateStat :: Stat (Credential 'Staking) -> AggregateStats
aggregateStat Stat (Credential 'Staking)
s = forall a. Monoid a => a
mempty {gsCredentialStaking :: Stat (Credential 'Staking)
gsCredentialStaking = Stat (Credential 'Staking)
s}

instance AggregateStat (Stat (KeyHash 'StakePool)) where
  aggregateStat :: Stat (KeyHash 'StakePool) -> AggregateStats
aggregateStat Stat (KeyHash 'StakePool)
s = forall a. Monoid a => a
mempty {gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashStakePool = Stat (KeyHash 'StakePool)
s}

instance AggregateStat (Stat ScriptHash) where
  aggregateStat :: Stat ScriptHash -> AggregateStats
aggregateStat Stat ScriptHash
s = forall a. Monoid a => a
mempty {gsScriptHash :: Stat ScriptHash
gsScriptHash = Stat ScriptHash
s}

-- Initial attempt at UTxO stats, which was mostly superseded by the above
-- approach that works for the whole state

data UTxOUniques = UTxOUniques
  { UTxOUniques -> Set (KeyHash 'Payment)
paymentKeys :: !(Set.Set (KeyHash 'Payment))
  , UTxOUniques -> Set ScriptHash
paymentScripts :: !(Set.Set ScriptHash)
  , UTxOUniques -> Set (KeyHash 'Staking)
stakeKeys :: !(Set.Set (KeyHash 'Staking))
  , UTxOUniques -> Set ScriptHash
stakeScripts :: !(Set.Set ScriptHash)
  , UTxOUniques -> Set Ptr
stakePtrs :: !(Set.Set Ptr)
  , UTxOUniques -> Set ScriptHash
scripts :: !(Set.Set ScriptHash)
  , UTxOUniques -> Set TxId
txIds :: !(Set.Set TxId)
  , UTxOUniques -> Set TxIx
txIxs :: !(Set.Set TxIx)
  }

emptyUniques :: UTxOUniques
emptyUniques :: UTxOUniques
emptyUniques = Set (KeyHash 'Payment)
-> Set ScriptHash
-> Set (KeyHash 'Staking)
-> Set ScriptHash
-> Set Ptr
-> Set ScriptHash
-> Set TxId
-> Set TxIx
-> UTxOUniques
UTxOUniques forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

data UTxOStats' = UTxOStats'
  { UTxOStats' -> Int
statsTotalTxOuts :: !Int
  , UTxOStats' -> Int
statsByronTxOuts :: !Int
  , UTxOStats' -> Int
statsTotalPaymentKeys :: !Int
  , UTxOStats' -> Int
statsTotalPaymentScripts :: !Int
  , UTxOStats' -> Int
statsTotalStakeKeys :: !Int
  , UTxOStats' -> Int
statsTotalStakeScripts :: !Int
  , UTxOStats' -> Int
statsTotalStakePtrs :: !Int
  , UTxOStats' -> Int
stateTotalStakeNulls :: !Int
  }
  deriving (Int -> UTxOStats' -> ShowS
[UTxOStats'] -> ShowS
UTxOStats' -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UTxOStats'] -> ShowS
$cshowList :: [UTxOStats'] -> ShowS
show :: UTxOStats' -> String
$cshow :: UTxOStats' -> String
showsPrec :: Int -> UTxOStats' -> ShowS
$cshowsPrec :: Int -> UTxOStats' -> ShowS
Show)

initStats :: UTxOStats'
initStats :: UTxOStats'
initStats = Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> UTxOStats'
UTxOStats' Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0

collectStats :: ConduitT (TxIn, TxOut CurrentEra) Void IO ()
collectStats :: ConduitT (TxIn, TxOut BabbageEra) Void IO ()
collectStats = do
  (UTxOUniques
uniques, UTxOStats'
stats) <- forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC (UTxOUniques, UTxOStats')
-> (TxIn, TxOut BabbageEra) -> (UTxOUniques, UTxOStats')
collect (UTxOUniques
emptyUniques, UTxOStats'
initStats)
  forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ UTxOUniques -> UTxOStats' -> IO ()
reportStats UTxOUniques
uniques UTxOStats'
stats
  where
    collect ::
      (UTxOUniques, UTxOStats') ->
      (TxIn, TxOut CurrentEra) ->
      (UTxOUniques, UTxOStats')
    collect :: (UTxOUniques, UTxOStats')
-> (TxIn, TxOut BabbageEra) -> (UTxOUniques, UTxOStats')
collect (u :: UTxOUniques
u@UTxOUniques {Set ScriptHash
Set (KeyHash 'Payment)
Set (KeyHash 'Staking)
Set TxId
Set Ptr
Set TxIx
txIxs :: Set TxIx
txIds :: Set TxId
scripts :: Set ScriptHash
stakePtrs :: Set Ptr
stakeScripts :: Set ScriptHash
stakeKeys :: Set (KeyHash 'Staking)
paymentScripts :: Set ScriptHash
paymentKeys :: Set (KeyHash 'Payment)
txIxs :: UTxOUniques -> Set TxIx
txIds :: UTxOUniques -> Set TxId
scripts :: UTxOUniques -> Set ScriptHash
stakePtrs :: UTxOUniques -> Set Ptr
stakeScripts :: UTxOUniques -> Set ScriptHash
stakeKeys :: UTxOUniques -> Set (KeyHash 'Staking)
paymentScripts :: UTxOUniques -> Set ScriptHash
paymentKeys :: UTxOUniques -> Set (KeyHash 'Payment)
..}, s :: UTxOStats'
s@UTxOStats' {Int
stateTotalStakeNulls :: Int
statsTotalStakePtrs :: Int
statsTotalStakeScripts :: Int
statsTotalStakeKeys :: Int
statsTotalPaymentScripts :: Int
statsTotalPaymentKeys :: Int
statsByronTxOuts :: Int
statsTotalTxOuts :: Int
stateTotalStakeNulls :: UTxOStats' -> Int
statsTotalStakePtrs :: UTxOStats' -> Int
statsTotalStakeScripts :: UTxOStats' -> Int
statsTotalStakeKeys :: UTxOStats' -> Int
statsTotalPaymentScripts :: UTxOStats' -> Int
statsTotalPaymentKeys :: UTxOStats' -> Int
statsByronTxOuts :: UTxOStats' -> Int
statsTotalTxOuts :: UTxOStats' -> Int
..}) (TxIn TxId
txId TxIx
txIx, TxOut BabbageEra
txOut) =
      let u' :: UTxOUniques
u' = UTxOUniques
u {txIds :: Set TxId
txIds = forall a. Ord a => a -> Set a -> Set a
Set.insert TxId
txId Set TxId
txIds, txIxs :: Set TxIx
txIxs = forall a. Ord a => a -> Set a -> Set a
Set.insert TxIx
txIx Set TxIx
txIxs}
          s' :: UTxOStats'
s' = UTxOStats'
s {statsTotalTxOuts :: Int
statsTotalTxOuts = Int
statsTotalTxOuts forall a. Num a => a -> a -> a
+ Int
1}
          addr :: Addr
addr = TxOut BabbageEra
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) Addr
addrTxOutL
          updateStakingStats :: StakeReference
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats StakeReference
sr (UTxOUniques
su, UTxOStats'
ss) =
            case StakeReference
sr of
              StakeReference
StakeRefNull ->
                (UTxOUniques
su, UTxOStats'
ss {stateTotalStakeNulls :: Int
stateTotalStakeNulls = Int
stateTotalStakeNulls forall a. Num a => a -> a -> a
+ Int
1})
              StakeRefPtr Ptr
ptr ->
                ( UTxOUniques
su {stakePtrs :: Set Ptr
stakePtrs = forall a. Ord a => a -> Set a -> Set a
Set.insert Ptr
ptr Set Ptr
stakePtrs}
                , UTxOStats'
ss {statsTotalStakePtrs :: Int
statsTotalStakePtrs = Int
statsTotalStakePtrs forall a. Num a => a -> a -> a
+ Int
1}
                )
              StakeRefBase Credential 'Staking
a
                | KeyHashObj KeyHash 'Staking
kh <- Credential 'Staking
a ->
                    ( UTxOUniques
su {stakeKeys :: Set (KeyHash 'Staking)
stakeKeys = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Staking
kh Set (KeyHash 'Staking)
stakeKeys}
                    , UTxOStats'
ss {statsTotalStakeKeys :: Int
statsTotalStakeKeys = Int
statsTotalStakeKeys forall a. Num a => a -> a -> a
+ Int
1}
                    )
                | ScriptHashObj ScriptHash
sh <- Credential 'Staking
a ->
                    ( UTxOUniques
su {stakeScripts :: Set ScriptHash
stakeScripts = forall a. Ord a => a -> Set a -> Set a
Set.insert ScriptHash
sh Set ScriptHash
stakeScripts}
                    , UTxOStats'
ss {statsTotalStakeScripts :: Int
statsTotalStakeScripts = Int
statsTotalStakeScripts forall a. Num a => a -> a -> a
+ Int
1}
                    )
       in case Addr
addr of
            AddrBootstrap BootstrapAddress
_ ->
              (UTxOUniques
u', UTxOStats'
s' {statsByronTxOuts :: Int
statsByronTxOuts = Int
statsByronTxOuts forall a. Num a => a -> a -> a
+ Int
1})
            Addr Network
_ni Credential 'Payment
pc StakeReference
sr
              | KeyHashObj KeyHash 'Payment
kh <- Credential 'Payment
pc ->
                  StakeReference
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats
                    StakeReference
sr
                    ( UTxOUniques
u' {paymentKeys :: Set (KeyHash 'Payment)
paymentKeys = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Payment
kh Set (KeyHash 'Payment)
paymentKeys}
                    , UTxOStats'
s' {statsTotalPaymentKeys :: Int
statsTotalPaymentKeys = Int
statsTotalPaymentKeys forall a. Num a => a -> a -> a
+ Int
1}
                    )
              | ScriptHashObj ScriptHash
kh <- Credential 'Payment
pc ->
                  StakeReference
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats
                    StakeReference
sr
                    ( UTxOUniques
u' {paymentScripts :: Set ScriptHash
paymentScripts = forall a. Ord a => a -> Set a -> Set a
Set.insert ScriptHash
kh Set ScriptHash
paymentScripts}
                    , UTxOStats'
s' {statsTotalPaymentScripts :: Int
statsTotalPaymentScripts = Int
statsTotalPaymentScripts forall a. Num a => a -> a -> a
+ Int
1}
                    )

reportStats :: UTxOUniques -> UTxOStats' -> IO ()
reportStats :: UTxOUniques -> UTxOStats' -> IO ()
reportStats UTxOUniques {Set ScriptHash
Set (KeyHash 'Payment)
Set (KeyHash 'Staking)
Set TxId
Set Ptr
Set TxIx
txIxs :: Set TxIx
txIds :: Set TxId
scripts :: Set ScriptHash
stakePtrs :: Set Ptr
stakeScripts :: Set ScriptHash
stakeKeys :: Set (KeyHash 'Staking)
paymentScripts :: Set ScriptHash
paymentKeys :: Set (KeyHash 'Payment)
txIxs :: UTxOUniques -> Set TxIx
txIds :: UTxOUniques -> Set TxId
scripts :: UTxOUniques -> Set ScriptHash
stakePtrs :: UTxOUniques -> Set Ptr
stakeScripts :: UTxOUniques -> Set ScriptHash
stakeKeys :: UTxOUniques -> Set (KeyHash 'Staking)
paymentScripts :: UTxOUniques -> Set ScriptHash
paymentKeys :: UTxOUniques -> Set (KeyHash 'Payment)
..} UTxOStats' {Int
stateTotalStakeNulls :: Int
statsTotalStakePtrs :: Int
statsTotalStakeScripts :: Int
statsTotalStakeKeys :: Int
statsTotalPaymentScripts :: Int
statsTotalPaymentKeys :: Int
statsByronTxOuts :: Int
statsTotalTxOuts :: Int
stateTotalStakeNulls :: UTxOStats' -> Int
statsTotalStakePtrs :: UTxOStats' -> Int
statsTotalStakeScripts :: UTxOStats' -> Int
statsTotalStakeKeys :: UTxOStats' -> Int
statsTotalPaymentScripts :: UTxOStats' -> Int
statsTotalPaymentKeys :: UTxOStats' -> Int
statsByronTxOuts :: UTxOStats' -> Int
statsTotalTxOuts :: UTxOStats' -> Int
..} = do
  let showPercent :: a -> a -> String
showPercent a
x a
y
        | a
y forall a. Eq a => a -> a -> Bool
== a
0 = String
"0"
        | Bool
otherwise =
            case ((a
1000 forall a. Num a => a -> a -> a
* a
x) forall a. Integral a => a -> a -> a
`div` a
y) forall a. Integral a => a -> a -> (a, a)
`quotRem` a
10 of
              (a
q, a
r) ->
                forall a. Show a => a -> String
show a
x forall a. Semigroup a => a -> a -> a
<> String
", " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
q forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
r forall a. Semigroup a => a -> a -> a
<> String
"% of total"
  String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
    [String] -> String
unlines
      [ String
"Total TxOuts = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalTxOuts
      , String
"Byron TxOuts = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent Int
statsByronTxOuts Int
statsTotalTxOuts
      , String
"Unique TxIds = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set TxId
txIds) Int
statsTotalTxOuts
      , String
"Unique TxIxs = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set TxIx
txIxs) Int
statsTotalTxOuts
      , String
"Shelley Total Payment Keys = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalPaymentKeys
      , String
"Shelley Unique Payment Keys = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set (KeyHash 'Payment)
paymentKeys) Int
statsTotalPaymentKeys
      , String
"Shelley Total Payment Scripts = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalPaymentScripts
      , String
"Shelley Unique Payment Scripts = "
          forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set ScriptHash
paymentScripts) Int
statsTotalPaymentScripts
      , String
"Shelley Total Stake Keys = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalStakeKeys
      , String
"Shelley Unique Stake Keys = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set (KeyHash 'Staking)
stakeKeys) Int
statsTotalStakeKeys
      , String
"Shelley Total Stake Scripts = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalStakeScripts
      , String
"Shelley Unique Stake Scripts = "
          forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set ScriptHash
stakeScripts) Int
statsTotalStakeScripts
      , String
"Shelley Total Stake Ptrs = " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
statsTotalStakePtrs
      , String
"Shelley Unique Stake Ptrs = " forall a. Semigroup a => a -> a -> a
<> forall {a}. (Integral a, Show a) => a -> a -> String
showPercent (forall a. Set a -> Int
Set.size Set Ptr
stakePtrs) Int
statsTotalStakePtrs
      ]