{-# 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.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Crypto
import Cardano.Ledger.Mary.Value
import Cardano.Ledger.PoolDistr (individualPoolStakeVrf)
import Cardano.Ledger.Shelley.API
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.UMap (rewardMap, sPoolMap)
import qualified Cardano.Ledger.UMap as UM (ptrMap)
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 C = StandardCrypto

type CurrentEra = Babbage

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

readEpochState ::
  FilePath ->
  IO (EpochState CurrentEra)
readEpochState :: String -> IO (EpochState (BabbageEra C))
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 C) -> 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 C))
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 C))
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 C, TxOut CurrentEra) b

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

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

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

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

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

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

txIdNestedInsert ::
  Map.Map (TxId C) (IntMap.IntMap a) ->
  (TxIn C, a) ->
  Map.Map (TxId C) (IntMap.IntMap a)
txIdNestedInsert :: forall a.
Map (TxId C) (IntMap a) -> (TxIn C, a) -> Map (TxId C) (IntMap a)
txIdNestedInsert !Map (TxId C) (IntMap a)
m (TxIn !TxId C
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 C
txId IntMap a
e Map (TxId C) (IntMap a)
m

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

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

txIxNestedInsert ::
  IntMap.IntMap (Map.Map (TxId C) a) ->
  (TxIn C, a) ->
  IntMap.IntMap (Map.Map (TxId C) a)
txIxNestedInsert :: forall a.
IntMap (Map (TxId C) a) -> (TxIn C, a) -> IntMap (Map (TxId C) a)
txIxNestedInsert !IntMap (Map (TxId C) a)
im (TxIn !TxId C
txId !TxIx
txIx, !a
v) =
  let f :: Maybe (Map (TxId C) a) -> Maybe (Map (TxId C) a)
f =
        \case
          Maybe (Map (TxId C) 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 C
txId a
v
          Just !Map (TxId C) 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 C
txId a
v Map (TxId C) a
m
   in forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IntMap.alter Maybe (Map (TxId C) a) -> Maybe (Map (TxId C) a)
f (TxIx -> Int
txIxToInt TxIx
txIx) IntMap (Map (TxId C) a)
im

totalADA :: Map.Map (TxIn C) (TxOut CurrentEra) -> MaryValue C
totalADA :: Map (TxIn C) (TxOut (BabbageEra C)) -> MaryValue C
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 C))
readBinUTxO String
fp = do
  NewEpochState (BabbageEra C)
ls <- String -> IO (NewEpochState (BabbageEra C))
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 C)
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))

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 C)
sssStake :: !(Stat (Credential 'Staking C))
  , SnapShotStats -> Stat (Credential 'Staking C)
sssDelegationCredential :: !(Stat (Credential 'Staking C))
  , SnapShotStats -> Stat (KeyHash 'StakePool C)
sssDelegationStakePool :: !(Stat (KeyHash 'StakePool C))
  , SnapShotStats -> Stat (KeyHash 'StakePool C)
sssPoolParams :: !(Stat (KeyHash 'StakePool C))
  , SnapShotStats -> PoolParamsStats
sssPoolParamsStats :: !PoolParamsStats
  }

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

instance Monoid SnapShotStats where
  mempty :: SnapShotStats
mempty = Stat (Credential 'Staking C)
-> Stat (Credential 'Staking C)
-> Stat (KeyHash 'StakePool C)
-> Stat (KeyHash 'StakePool C)
-> 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 (Credential 'Staking C)
Stat (KeyHash 'StakePool C)
sssPoolParamsStats :: PoolParamsStats
sssPoolParams :: Stat (KeyHash 'StakePool C)
sssDelegationStakePool :: Stat (KeyHash 'StakePool C)
sssDelegationCredential :: Stat (Credential 'Staking C)
sssStake :: Stat (Credential 'Staking C)
sssPoolParamsStats :: SnapShotStats -> PoolParamsStats
sssPoolParams :: SnapShotStats -> Stat (KeyHash 'StakePool C)
sssDelegationStakePool :: SnapShotStats -> Stat (KeyHash 'StakePool C)
sssDelegationCredential :: SnapShotStats -> Stat (Credential 'Staking C)
sssStake :: SnapShotStats -> Stat (Credential 'Staking C)
..} =
    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 C)
sssStake
      , Doc ann
"DelegationCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking C)
sssDelegationCredential
      , Doc ann
"DelegationStakePool" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool C)
sssDelegationStakePool
      , Doc ann
"PoolParams" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool C)
sssPoolParams
      , forall a ann. Pretty a => a -> Doc ann
pretty PoolParamsStats
sssPoolParamsStats
      ]

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

countSnapShotStat :: SnapShot C -> SnapShotStats
countSnapShotStat :: SnapShot C -> SnapShotStats
countSnapShotStat SnapShot {Stake C
VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
$sel:ssStake:SnapShot :: forall c. SnapShot c -> Stake c
$sel:ssDelegations:SnapShot :: forall c.
SnapShot c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
$sel:ssPoolParams:SnapShot :: forall c.
SnapShot c -> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams :: VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
ssDelegations :: VMap VB VB (Credential 'Staking C) (KeyHash 'StakePool C)
ssStake :: Stake C
..} =
  SnapShotStats
    { sssStake :: Stat (Credential 'Staking C)
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 (forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
unStake Stake C
ssStake))
    , sssDelegationCredential :: Stat (Credential 'Staking C)
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 C) (KeyHash 'StakePool C)
ssDelegations)
    , sssDelegationStakePool :: Stat (KeyHash 'StakePool C)
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 C) (KeyHash 'StakePool C)
ssDelegations)
    , sssPoolParams :: Stat (KeyHash 'StakePool C)
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 C) (PoolParams C)
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 C -> PoolParamsStats
countPoolParamsStats VMap VB VB (KeyHash 'StakePool C) (PoolParams C)
ssPoolParams
    }

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

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

instance Monoid PoolParamsStats where
  mempty :: PoolParamsStats
mempty = Stat (KeyHash 'StakePool C)
-> Stat (Credential 'Staking C)
-> Stat (KeyHash 'Staking C)
-> 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 (Credential 'Staking C)
Stat (KeyHash 'StakePool C)
Stat (KeyHash 'Staking C)
ppsOwners :: Stat (KeyHash 'Staking C)
ppsRewardAccount :: Stat (Credential 'Staking C)
ppsPoolId :: Stat (KeyHash 'StakePool C)
ppsOwners :: PoolParamsStats -> Stat (KeyHash 'Staking C)
ppsRewardAccount :: PoolParamsStats -> Stat (Credential 'Staking C)
ppsPoolId :: PoolParamsStats -> Stat (KeyHash 'StakePool C)
..} =
    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 C)
ppsPoolId
      , Doc ann
"RewardAccount" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking C)
ppsRewardAccount
      , Doc ann
"Owners" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'Staking C)
ppsOwners
      ]

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

countPoolParamsStats :: PoolParams C -> PoolParamsStats
countPoolParamsStats :: PoolParams C -> PoolParamsStats
countPoolParamsStats PoolParams {Set (KeyHash 'Staking C)
Hash C (VerKeyVRF C)
StrictMaybe PoolMetadata
StrictSeq StakePoolRelay
RewardAccount C
Coin
UnitInterval
KeyHash 'StakePool C
ppId :: forall c. PoolParams c -> KeyHash 'StakePool c
ppVrf :: forall c. PoolParams c -> Hash c (VerKeyVRF c)
ppPledge :: forall c. PoolParams c -> Coin
ppCost :: forall c. PoolParams c -> Coin
ppMargin :: forall c. PoolParams c -> UnitInterval
ppRewardAccount :: forall c. PoolParams c -> RewardAccount c
ppOwners :: forall c. PoolParams c -> Set (KeyHash 'Staking c)
ppRelays :: forall c. PoolParams c -> StrictSeq StakePoolRelay
ppMetadata :: forall c. PoolParams c -> StrictMaybe PoolMetadata
ppMetadata :: StrictMaybe PoolMetadata
ppRelays :: StrictSeq StakePoolRelay
ppOwners :: Set (KeyHash 'Staking C)
ppRewardAccount :: RewardAccount C
ppMargin :: UnitInterval
ppCost :: Coin
ppPledge :: Coin
ppVrf :: Hash C (VerKeyVRF C)
ppId :: KeyHash 'StakePool C
..} =
  PoolParamsStats
    { ppsPoolId :: Stat (KeyHash 'StakePool C)
ppsPoolId = forall a. a -> Stat a
statSingleton KeyHash 'StakePool C
ppId
    , ppsRewardAccount :: Stat (Credential 'Staking C)
ppsRewardAccount = forall a. a -> Stat a
statSingleton (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount C
ppRewardAccount)
    , ppsOwners :: Stat (KeyHash 'Staking C)
ppsOwners = forall a. Set a -> Stat a
statSet Set (KeyHash 'Staking C)
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 C)
pdsStakePoolKeyHash :: !(Stat (KeyHash 'StakePool C))
  , PoolDistrStats -> Stat (Hash C (VerKeyVRF C))
pdsStakePoolStakeVrf :: !(Stat (Hash C (VerKeyVRF C)))
  }

instance Pretty PoolDistrStats where
  pretty :: forall ann. PoolDistrStats -> Doc ann
pretty PoolDistrStats {Stat (Hash C (VerKeyVRF C))
Stat (KeyHash 'StakePool C)
pdsStakePoolStakeVrf :: Stat (Hash C (VerKeyVRF C))
pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool C)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (Hash C (VerKeyVRF C))
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash 'StakePool C)
..} =
    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 C)
pdsStakePoolKeyHash
      , Doc ann
"StakePoolStakeVrf" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Hash C (VerKeyVRF C))
pdsStakePoolStakeVrf
      ]

instance AggregateStat PoolDistrStats where
  aggregateStat :: PoolDistrStats -> AggregateStats
aggregateStat PoolDistrStats {Stat (Hash C (VerKeyVRF C))
Stat (KeyHash 'StakePool C)
pdsStakePoolStakeVrf :: Stat (Hash C (VerKeyVRF C))
pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool C)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (Hash C (VerKeyVRF C))
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash 'StakePool C)
..} =
    forall a. Monoid a => a
mempty
      { gsKeyHashStakePool :: Stat (KeyHash 'StakePool C)
gsKeyHashStakePool = Stat (KeyHash 'StakePool C)
pdsStakePoolKeyHash
      , gsVerKeyVRF :: Stat (Hash C (VerKeyVRF C))
gsVerKeyVRF = Stat (Hash C (VerKeyVRF C))
pdsStakePoolStakeVrf
      }

calcPoolDistrStats :: PoolDistr C -> PoolDistrStats
calcPoolDistrStats :: PoolDistr C -> PoolDistrStats
calcPoolDistrStats (PoolDistr Map (KeyHash 'StakePool C) (IndividualPoolStake C)
pd CompactForm Coin
_tot) =
  PoolDistrStats
    { pdsStakePoolKeyHash :: Stat (KeyHash 'StakePool C)
pdsStakePoolKeyHash = forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool C) (IndividualPoolStake C)
pd
    , pdsStakePoolStakeVrf :: Stat (Hash C (VerKeyVRF C))
pdsStakePoolStakeVrf = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (forall c. IndividualPoolStake c -> Hash c (VerKeyVRF c)
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 C) (IndividualPoolStake C)
pd)
    }

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

instance Pretty EpochStateStats where
  pretty :: forall ann. EpochStateStats -> Doc ann
pretty EpochStateStats {AggregateStats
LedgerStateStats
SnapShotStats
Stat (KeyHash 'StakePool C)
essAggregateStats :: AggregateStats
essNonMyopic :: Stat (KeyHash 'StakePool C)
essLedgerStateStats :: LedgerStateStats
essSnapShotsStats :: SnapShotStats
essGoSnapShotStats :: SnapShotStats
essSetSnapShotStats :: SnapShotStats
essMarkSnapShotStats :: SnapShotStats
essNonMyopic :: EpochStateStats -> Stat (KeyHash 'StakePool C)
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 C)
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 C)
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 C)
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 C)
essNonMyopic
      , forall a ann. Pretty a => a -> Doc ann
pretty AggregateStats
essAggregateStats
      ]

countEpochStateStats :: EpochState CurrentEra -> EpochStateStats
countEpochStateStats :: EpochState (BabbageEra C) -> EpochStateStats
countEpochStateStats EpochState {SnapShots (EraCrypto (BabbageEra C))
AccountState
LedgerState (BabbageEra C)
NonMyopic (EraCrypto (BabbageEra C))
esAccountState :: forall era. EpochState era -> AccountState
esSnapshots :: forall era. EpochState era -> SnapShots (EraCrypto era)
esNonMyopic :: forall era. EpochState era -> NonMyopic (EraCrypto era)
esNonMyopic :: NonMyopic (EraCrypto (BabbageEra C))
esSnapshots :: SnapShots (EraCrypto (BabbageEra C))
esLState :: LedgerState (BabbageEra C)
esAccountState :: AccountState
esLState :: forall era. EpochState era -> LedgerState era
..} =
  let markSnap :: SnapShotStats
markSnap = SnapShot C -> SnapShotStats
countSnapShotStat (forall c. SnapShots c -> SnapShot c
ssStakeMark SnapShots (EraCrypto (BabbageEra C))
esSnapshots)
      setSnap :: SnapShotStats
setSnap = SnapShot C -> SnapShotStats
countSnapShotStat (forall c. SnapShots c -> SnapShot c
ssStakeSet SnapShots (EraCrypto (BabbageEra C))
esSnapshots)
      goSnap :: SnapShotStats
goSnap = SnapShot C -> SnapShotStats
countSnapShotStat (forall c. SnapShots c -> SnapShot c
ssStakeGo SnapShots (EraCrypto (BabbageEra C))
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 C) -> LedgerStateStats
countLedgerStateStats LedgerState (BabbageEra C)
esLState
          , essNonMyopic :: Stat (KeyHash 'StakePool C)
essNonMyopic = forall k v. Map k v -> Stat k
statMapKeys (forall c. NonMyopic c -> Map (KeyHash 'StakePool c) Likelihood
likelihoodsNM NonMyopic (EraCrypto (BabbageEra C))
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 C)
essNonMyopic EpochStateStats
stats)
              ]
        }

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

instance Pretty DStateStats where
  pretty :: forall ann. DStateStats -> Doc ann
pretty DStateStats {Stat (Hash C (VerKeyVRF C))
Stat (Credential 'Staking C)
Stat (KeyHash 'StakePool C)
Stat (KeyHash 'GenesisDelegate C)
Stat (KeyHash 'Genesis C)
dssHashVerKeyVRF :: Stat (Hash C (VerKeyVRF C))
dssKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis C)
dssDelegations :: Stat (KeyHash 'StakePool C)
dssCredentialStaking :: Stat (Credential 'Staking C)
dssHashVerKeyVRF :: DStateStats -> Stat (Hash C (VerKeyVRF C))
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis C)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool C)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking C)
..} =
    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 C)
dssCredentialStaking
      , Doc ann
"SPoolUView" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool C)
dssDelegations
      , Doc ann
"KeyHashGenesis" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'Genesis C)
dssKeyHashGenesis
      , Doc ann
"KeyHashGenesisDelegate" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesisDelegate
      , Doc ann
"HashVerKeyVRF" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Hash C (VerKeyVRF C))
dssHashVerKeyVRF
      ]

instance AggregateStat DStateStats where
  aggregateStat :: DStateStats -> AggregateStats
aggregateStat DStateStats {Stat (Hash C (VerKeyVRF C))
Stat (Credential 'Staking C)
Stat (KeyHash 'StakePool C)
Stat (KeyHash 'GenesisDelegate C)
Stat (KeyHash 'Genesis C)
dssHashVerKeyVRF :: Stat (Hash C (VerKeyVRF C))
dssKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis C)
dssDelegations :: Stat (KeyHash 'StakePool C)
dssCredentialStaking :: Stat (Credential 'Staking C)
dssHashVerKeyVRF :: DStateStats -> Stat (Hash C (VerKeyVRF C))
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis C)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool C)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking C)
..} =
    forall a. Monoid a => a
mempty
      { gsCredentialStaking :: Stat (Credential 'Staking C)
gsCredentialStaking = Stat (Credential 'Staking C)
dssCredentialStaking
      , gsKeyHashStakePool :: Stat (KeyHash 'StakePool C)
gsKeyHashStakePool = Stat (KeyHash 'StakePool C)
dssDelegations
      , gsKeyHashGenesis :: Stat (KeyHash 'Genesis C)
gsKeyHashGenesis = Stat (KeyHash 'Genesis C)
dssKeyHashGenesis
      , gsKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate C)
gsKeyHashGenesisDelegate = Stat (KeyHash 'GenesisDelegate C)
dssKeyHashGenesisDelegate
      , gsVerKeyVRF :: Stat (Hash C (VerKeyVRF C))
gsVerKeyVRF = Stat (Hash C (VerKeyVRF C))
dssHashVerKeyVRF
      }

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

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

instance Pretty PStateStats where
  pretty :: forall ann. PStateStats -> Doc ann
pretty PStateStats {PoolParamsStats
Stat (KeyHash 'StakePool C)
pssPoolParamsStats :: PoolParamsStats
pssKeyHashStakePool :: Stat (KeyHash 'StakePool C)
pssPoolParamsStats :: PStateStats -> PoolParamsStats
pssKeyHashStakePool :: PStateStats -> Stat (KeyHash 'StakePool C)
..} =
    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 C)
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 C)
pssPoolParamsStats :: PoolParamsStats
pssKeyHashStakePool :: Stat (KeyHash 'StakePool C)
pssPoolParamsStats :: PStateStats -> PoolParamsStats
pssKeyHashStakePool :: PStateStats -> Stat (KeyHash 'StakePool C)
..} =
    (forall s. AggregateStat s => s -> AggregateStats
aggregateStat PoolParamsStats
pssPoolParamsStats) {gsKeyHashStakePool :: Stat (KeyHash 'StakePool C)
gsKeyHashStakePool = Stat (KeyHash 'StakePool C)
pssKeyHashStakePool}

countPStateStats :: PState CurrentEra -> PStateStats
countPStateStats :: PState (BabbageEra C) -> PStateStats
countPStateStats PState {Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
Map (KeyHash 'StakePool (EraCrypto (BabbageEra C))) Coin
Map (KeyHash 'StakePool (EraCrypto (BabbageEra C))) EpochNo
psStakePoolParams :: forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams :: forall era.
PState era
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psRetiring :: forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psDeposits :: forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits :: Map (KeyHash 'StakePool (EraCrypto (BabbageEra C))) Coin
psRetiring :: Map (KeyHash 'StakePool (EraCrypto (BabbageEra C))) EpochNo
psFutureStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
psStakePoolParams :: Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
..} =
  PStateStats
    { pssKeyHashStakePool :: Stat (KeyHash 'StakePool C)
pssKeyHashStakePool =
        forall k v. Map k v -> Stat k
statMapKeys Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
psStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
psFutureStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool (EraCrypto (BabbageEra C))) EpochNo
psRetiring
    , pssPoolParamsStats :: PoolParamsStats
pssPoolParamsStats =
        forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PoolParams C -> PoolParamsStats
countPoolParamsStats Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
psStakePoolParams
          forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PoolParams C -> PoolParamsStats
countPoolParamsStats Map
  (KeyHash 'StakePool (EraCrypto (BabbageEra C)))
  (PoolParams (EraCrypto (BabbageEra C)))
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 C) -> LedgerStateStats
countLedgerStateStats LedgerState {CertState (BabbageEra C)
UTxOState (BabbageEra C)
lsCertState :: forall era. LedgerState era -> CertState era
lsCertState :: CertState (BabbageEra C)
lsUTxOState :: UTxOState (BabbageEra C)
lsUTxOState :: forall era. LedgerState era -> UTxOState era
..} =
  LedgerStateStats
    { lssUTxOStats :: UTxOStats
lssUTxOStats = UTxO (BabbageEra C) -> UTxOStats
countUTxOStats (forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState (BabbageEra C)
lsUTxOState)
    , lssDStateStats :: DStateStats
lssDStateStats = DState (BabbageEra C) -> DStateStats
countDStateStats (forall era. CertState era -> DState era
certDState CertState (BabbageEra C)
lsCertState)
    , lssPStateStats :: PStateStats
lssPStateStats = PState (BabbageEra C) -> PStateStats
countPStateStats (forall era. CertState era -> PState era
certPState CertState (BabbageEra C)
lsCertState)
    }

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

instance Pretty TxInStats where
  pretty :: forall ann. TxInStats -> Doc ann
pretty TxInStats {Stat (TxId C)
Stat TxIx
tisTxIx :: Stat TxIx
tisTxId :: Stat (TxId C)
tisTxIx :: TxInStats -> Stat TxIx
tisTxId :: TxInStats -> Stat (TxId C)
..} =
    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 C)
tisTxId, Doc ann
"TxIx" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat TxIx
tisTxIx]

countTxInStats :: [TxIn C] -> TxInStats
countTxInStats :: [TxIn C] -> TxInStats
countTxInStats [TxIn C]
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 C
txId TxIx
txIx) -> (TxId C
txId, TxIx
txIx)) [TxIn C]
txIns) of
    ([TxId C]
txIds, [TxIx]
txIxs) ->
      TxInStats
        { tisTxId :: Stat (TxId C)
tisTxId = forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable [TxId C]
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 C)
tosBootstrap :: !(Stat (BootstrapAddress C))
  , TxOutStats -> Stat (Credential 'Payment C)
tosPaymentCredential :: !(Stat (Credential 'Payment C))
  , TxOutStats -> Stat (Credential 'Staking C)
tosStakingCredential :: !(Stat (Credential 'Staking C))
  , TxOutStats -> Stat Ptr
tosStakingPtr :: !(Stat Ptr)
  , TxOutStats -> Stat Network
tosNetwork :: !(Stat Network)
  , TxOutStats -> Stat Integer
tosValue :: !(Stat Integer)
  , TxOutStats -> Stat (PolicyID C)
tosPolicyId :: !(Stat (PolicyID C))
  , TxOutStats -> Stat AssetName
tosAssetName :: !(Stat AssetName)
  , TxOutStats -> Stat Integer
tosAssetValue :: !(Stat Integer)
  , TxOutStats -> Stat (DataHash C)
tosDataHash :: !(Stat (DataHash C))
  }

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

instance Monoid TxOutStats where
  mempty :: TxOutStats
mempty = Stat (BootstrapAddress C)
-> Stat (Credential 'Payment C)
-> Stat (Credential 'Staking C)
-> Stat Ptr
-> Stat Network
-> Stat Integer
-> Stat (PolicyID C)
-> Stat AssetName
-> Stat Integer
-> Stat (DataHash C)
-> 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 (BootstrapAddress C)
Stat (Credential 'Staking C)
Stat (Credential 'Payment C)
Stat Ptr
Stat Network
Stat (DataHash C)
Stat AssetName
Stat (PolicyID C)
tosDataHash :: Stat (DataHash C)
tosAssetValue :: Stat Integer
tosAssetName :: Stat AssetName
tosPolicyId :: Stat (PolicyID C)
tosValue :: Stat Integer
tosNetwork :: Stat Network
tosStakingPtr :: Stat Ptr
tosStakingCredential :: Stat (Credential 'Staking C)
tosPaymentCredential :: Stat (Credential 'Payment C)
tosBootstrap :: Stat (BootstrapAddress C)
tosDataHash :: TxOutStats -> Stat (DataHash C)
tosAssetValue :: TxOutStats -> Stat Integer
tosAssetName :: TxOutStats -> Stat AssetName
tosPolicyId :: TxOutStats -> Stat (PolicyID C)
tosValue :: TxOutStats -> Stat Integer
tosNetwork :: TxOutStats -> Stat Network
tosStakingPtr :: TxOutStats -> Stat Ptr
tosStakingCredential :: TxOutStats -> Stat (Credential 'Staking C)
tosPaymentCredential :: TxOutStats -> Stat (Credential 'Payment C)
tosBootstrap :: TxOutStats -> Stat (BootstrapAddress C)
..} =
    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 C)
tosBootstrap
      , Doc ann
"PaymentCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Payment C)
tosPaymentCredential
      , Doc ann
"StakingCredential" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential 'Staking C)
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 C)
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 C)
tosDataHash
      ]

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

countTxOutStats :: [TxOut CurrentEra] -> TxOutStats
countTxOutStats :: [TxOut (BabbageEra C)] -> TxOutStats
countTxOutStats = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut (BabbageEra C) -> TxOutStats
countTxOutStat
  where
    countTxOutStat :: TxOut CurrentEra -> TxOutStats
    countTxOutStat :: TxOut (BabbageEra C) -> TxOutStats
countTxOutStat TxOut (BabbageEra C)
txOut =
      let addr :: Addr C
addr = TxOut (BabbageEra C)
txOut forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
addrTxOutL
          MaryValue (Coin Integer
v) (MultiAsset Map (PolicyID C) (Map AssetName Integer)
m) = TxOut (BabbageEra C)
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 C
d -> forall a. Monoid a => a
mempty {tosDataHash :: Stat (DataHash C)
tosDataHash = forall a. a -> Stat a
statSingleton DataHash C
d})
              (TxOut (BabbageEra C)
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (DataHash (EraCrypto era)))
dataHashTxOutL)
          !vmElems :: [Map AssetName Integer]
vmElems = forall k a. Map k a -> [a]
Map.elems Map (PolicyID C) (Map AssetName Integer)
m
          !valueStat :: TxOutStats
valueStat =
            TxOutStats
dataStat
              { tosValue :: Stat Integer
tosValue = forall a. a -> Stat a
statSingleton Integer
v
              , tosPolicyId :: Stat (PolicyID C)
tosPolicyId = forall k v. Map k v -> Stat k
statMapKeys Map (PolicyID C) (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 (forall c. Addr c -> Network
getNetwork Addr C
addr)}
       in case Addr C
addr of
            AddrBootstrap BootstrapAddress C
addrBootstrap ->
              TxOutStats
networkStat {tosBootstrap :: Stat (BootstrapAddress C)
tosBootstrap = forall a. a -> Stat a
statSingleton BootstrapAddress C
addrBootstrap}
            Addr Network
_ Credential 'Payment C
pc StakeReference C
sr ->
              let stakeStat :: TxOutStats
stakeStat =
                    case StakeReference C
sr of
                      StakeReference C
StakeRefNull -> TxOutStats
networkStat
                      StakeRefPtr Ptr
ptr ->
                        TxOutStats
networkStat {tosStakingPtr :: Stat Ptr
tosStakingPtr = forall a. a -> Stat a
statSingleton Ptr
ptr}
                      StakeRefBase Credential 'Staking C
cred ->
                        TxOutStats
networkStat {tosStakingCredential :: Stat (Credential 'Staking C)
tosStakingCredential = forall a. a -> Stat a
statSingleton Credential 'Staking C
cred}
               in TxOutStats
stakeStat {tosPaymentCredential :: Stat (Credential 'Payment C)
tosPaymentCredential = forall a. a -> Stat a
statSingleton Credential 'Payment C
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 C) -> UTxOStats
countUTxOStats (UTxO Map (TxIn (EraCrypto (BabbageEra C))) (TxOut (BabbageEra C))
m) =
  UTxOStats
    { usTxInStats :: TxInStats
usTxInStats = [TxIn C] -> TxInStats
countTxInStats (forall k a. Map k a -> [k]
Map.keys Map (TxIn (EraCrypto (BabbageEra C))) (TxOut (BabbageEra C))
m)
    , usTxOutStats :: TxOutStats
usTxOutStats = [TxOut (BabbageEra C)] -> TxOutStats
countTxOutStats (forall k a. Map k a -> [a]
Map.elems Map (TxIn (EraCrypto (BabbageEra C))) (TxOut (BabbageEra C))
m)
    }

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

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

instance Monoid AggregateStats where
  mempty :: AggregateStats
mempty = Stat (Credential 'Staking C)
-> Stat (KeyHash 'StakePool C)
-> Stat (KeyHash 'Genesis C)
-> Stat (KeyHash 'GenesisDelegate C)
-> Stat (Hash C (VerKeyVRF C))
-> Stat (ScriptHash C)
-> 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 C (VerKeyVRF C))
Stat (ScriptHash C)
Stat (Credential 'Staking C)
Stat (KeyHash 'StakePool C)
Stat (KeyHash 'GenesisDelegate C)
Stat (KeyHash 'Genesis C)
gsScriptHash :: Stat (ScriptHash C)
gsVerKeyVRF :: Stat (Hash C (VerKeyVRF C))
gsKeyHashGenesisDelegate :: Stat (KeyHash 'GenesisDelegate C)
gsKeyHashGenesis :: Stat (KeyHash 'Genesis C)
gsKeyHashStakePool :: Stat (KeyHash 'StakePool C)
gsCredentialStaking :: Stat (Credential 'Staking C)
gsScriptHash :: AggregateStats -> Stat (ScriptHash C)
gsKeyHashGenesisDelegate :: AggregateStats -> Stat (KeyHash 'GenesisDelegate C)
gsKeyHashGenesis :: AggregateStats -> Stat (KeyHash 'Genesis C)
gsVerKeyVRF :: AggregateStats -> Stat (Hash C (VerKeyVRF C))
gsKeyHashStakePool :: AggregateStats -> Stat (KeyHash 'StakePool C)
gsCredentialStaking :: AggregateStats -> Stat (Credential 'Staking C)
..} =
    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 C)
gsCredentialStaking
      , Doc ann
"KeyHashStakePool" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'StakePool C)
gsKeyHashStakePool
      , Doc ann
"ScriptHash" forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (ScriptHash C)
gsScriptHash
      ]

class AggregateStat s where
  aggregateStat :: s -> AggregateStats

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

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

instance AggregateStat (Stat (ScriptHash C)) where
  aggregateStat :: Stat (ScriptHash C) -> AggregateStats
aggregateStat Stat (ScriptHash C)
s = forall a. Monoid a => a
mempty {gsScriptHash :: Stat (ScriptHash C)
gsScriptHash = Stat (ScriptHash C)
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 C)
paymentKeys :: !(Set.Set (KeyHash 'Payment C))
  , UTxOUniques -> Set (ScriptHash C)
paymentScripts :: !(Set.Set (ScriptHash C))
  , UTxOUniques -> Set (KeyHash 'Staking C)
stakeKeys :: !(Set.Set (KeyHash 'Staking C))
  , UTxOUniques -> Set (ScriptHash C)
stakeScripts :: !(Set.Set (ScriptHash C))
  , UTxOUniques -> Set Ptr
stakePtrs :: !(Set.Set Ptr)
  , UTxOUniques -> Set (ScriptHash C)
scripts :: !(Set.Set (ScriptHash C))
  , UTxOUniques -> Set (TxId C)
txIds :: !(Set.Set (TxId C))
  , UTxOUniques -> Set TxIx
txIxs :: !(Set.Set TxIx)
  }

emptyUniques :: UTxOUniques
emptyUniques :: UTxOUniques
emptyUniques = Set (KeyHash 'Payment C)
-> Set (ScriptHash C)
-> Set (KeyHash 'Staking C)
-> Set (ScriptHash C)
-> Set Ptr
-> Set (ScriptHash C)
-> Set (TxId C)
-> 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 C, TxOut CurrentEra) Void IO ()
collectStats :: ConduitT (TxIn C, TxOut (BabbageEra C)) 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 C, TxOut (BabbageEra C)) -> (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 C, TxOut CurrentEra) ->
      (UTxOUniques, UTxOStats')
    collect :: (UTxOUniques, UTxOStats')
-> (TxIn C, TxOut (BabbageEra C)) -> (UTxOUniques, UTxOStats')
collect (u :: UTxOUniques
u@UTxOUniques {Set (ScriptHash C)
Set (TxId C)
Set Ptr
Set TxIx
Set (KeyHash 'Staking C)
Set (KeyHash 'Payment C)
txIxs :: Set TxIx
txIds :: Set (TxId C)
scripts :: Set (ScriptHash C)
stakePtrs :: Set Ptr
stakeScripts :: Set (ScriptHash C)
stakeKeys :: Set (KeyHash 'Staking C)
paymentScripts :: Set (ScriptHash C)
paymentKeys :: Set (KeyHash 'Payment C)
txIxs :: UTxOUniques -> Set TxIx
txIds :: UTxOUniques -> Set (TxId C)
scripts :: UTxOUniques -> Set (ScriptHash C)
stakePtrs :: UTxOUniques -> Set Ptr
stakeScripts :: UTxOUniques -> Set (ScriptHash C)
stakeKeys :: UTxOUniques -> Set (KeyHash 'Staking C)
paymentScripts :: UTxOUniques -> Set (ScriptHash C)
paymentKeys :: UTxOUniques -> Set (KeyHash 'Payment C)
..}, 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 C
txId TxIx
txIx, TxOut (BabbageEra C)
txOut) =
      let u' :: UTxOUniques
u' = UTxOUniques
u {txIds :: Set (TxId C)
txIds = forall a. Ord a => a -> Set a -> Set a
Set.insert TxId C
txId Set (TxId C)
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 C
addr = TxOut (BabbageEra C)
txOut forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
addrTxOutL
          updateStakingStats :: StakeReference C
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats StakeReference C
sr (UTxOUniques
su, UTxOStats'
ss) =
            case StakeReference C
sr of
              StakeReference C
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 C
a
                | KeyHashObj KeyHash 'Staking C
kh <- Credential 'Staking C
a ->
                    ( UTxOUniques
su {stakeKeys :: Set (KeyHash 'Staking C)
stakeKeys = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Staking C
kh Set (KeyHash 'Staking C)
stakeKeys}
                    , UTxOStats'
ss {statsTotalStakeKeys :: Int
statsTotalStakeKeys = Int
statsTotalStakeKeys forall a. Num a => a -> a -> a
+ Int
1}
                    )
                | ScriptHashObj ScriptHash C
sh <- Credential 'Staking C
a ->
                    ( UTxOUniques
su {stakeScripts :: Set (ScriptHash C)
stakeScripts = forall a. Ord a => a -> Set a -> Set a
Set.insert ScriptHash C
sh Set (ScriptHash C)
stakeScripts}
                    , UTxOStats'
ss {statsTotalStakeScripts :: Int
statsTotalStakeScripts = Int
statsTotalStakeScripts forall a. Num a => a -> a -> a
+ Int
1}
                    )
       in case Addr C
addr of
            AddrBootstrap BootstrapAddress C
_ ->
              (UTxOUniques
u', UTxOStats'
s' {statsByronTxOuts :: Int
statsByronTxOuts = Int
statsByronTxOuts forall a. Num a => a -> a -> a
+ Int
1})
            Addr Network
_ni Credential 'Payment C
pc StakeReference C
sr
              | KeyHashObj KeyHash 'Payment C
kh <- Credential 'Payment C
pc ->
                  StakeReference C
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats
                    StakeReference C
sr
                    ( UTxOUniques
u' {paymentKeys :: Set (KeyHash 'Payment C)
paymentKeys = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'Payment C
kh Set (KeyHash 'Payment C)
paymentKeys}
                    , UTxOStats'
s' {statsTotalPaymentKeys :: Int
statsTotalPaymentKeys = Int
statsTotalPaymentKeys forall a. Num a => a -> a -> a
+ Int
1}
                    )
              | ScriptHashObj ScriptHash C
kh <- Credential 'Payment C
pc ->
                  StakeReference C
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats
                    StakeReference C
sr
                    ( UTxOUniques
u' {paymentScripts :: Set (ScriptHash C)
paymentScripts = forall a. Ord a => a -> Set a -> Set a
Set.insert ScriptHash C
kh Set (ScriptHash C)
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 C)
Set (TxId C)
Set Ptr
Set TxIx
Set (KeyHash 'Staking C)
Set (KeyHash 'Payment C)
txIxs :: Set TxIx
txIds :: Set (TxId C)
scripts :: Set (ScriptHash C)
stakePtrs :: Set Ptr
stakeScripts :: Set (ScriptHash C)
stakeKeys :: Set (KeyHash 'Staking C)
paymentScripts :: Set (ScriptHash C)
paymentKeys :: Set (KeyHash 'Payment C)
txIxs :: UTxOUniques -> Set TxIx
txIds :: UTxOUniques -> Set (TxId C)
scripts :: UTxOUniques -> Set (ScriptHash C)
stakePtrs :: UTxOUniques -> Set Ptr
stakeScripts :: UTxOUniques -> Set (ScriptHash C)
stakeKeys :: UTxOUniques -> Set (KeyHash 'Staking C)
paymentScripts :: UTxOUniques -> Set (ScriptHash C)
paymentKeys :: UTxOUniques -> Set (KeyHash 'Payment C)
..} 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 C)
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 C)
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 C)
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 C)
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 C)
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
      ]