{-# 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.BaseTypes
import Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Keys
import Cardano.Ledger.Mary.Value
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.State
import Cardano.Ledger.TxIn
import Conduit
import Control.Exception (throwIO)
import Control.Foldl (Fold (..))
import Control.Monad ((<=<))
import Data.Bifunctor (first)
import qualified Data.ByteString.Base16.Lazy as Base16
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 qualified Data.Text as T
import Data.Typeable
import qualified Data.VMap as VMap
import Lens.Micro
import Prettyprinter
import Text.Printf

type CurrentEra = ConwayEra

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

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

readHexUTxO ::
  FilePath ->
  IO (UTxO CurrentEra)
readHexUTxO :: String -> IO (UTxO ConwayEra)
readHexUTxO = String -> IO (UTxO ConwayEra)
forall a. FromCBOR a => String -> IO a
readDecCBORHex

readDecCBOR :: FromCBOR a => FilePath -> IO a
readDecCBOR :: forall a. FromCBOR a => String -> IO a
readDecCBOR = (DecoderError -> IO a)
-> (a -> IO a) -> Either DecoderError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either DecoderError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError a -> IO a)
-> (ByteString -> Either DecoderError a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError a
forall a. FromCBOR a => ByteString -> Either DecoderError a
Plain.decodeFull (ByteString -> IO a) -> (String -> IO ByteString) -> String -> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
LBS.readFile

readDecCBORHex :: FromCBOR a => FilePath -> IO a
readDecCBORHex :: forall a. FromCBOR a => String -> IO a
readDecCBORHex = (DecoderError -> IO a)
-> (a -> IO a) -> Either DecoderError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either DecoderError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError a -> IO a)
-> (ByteString -> Either DecoderError a) -> ByteString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either DecoderError a
decodeFullHex (ByteString -> IO a) -> (String -> IO ByteString) -> String -> IO a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO ByteString
LBS.readFile
  where
    decodeFullHex :: ByteString -> Either DecoderError a
decodeFullHex =
      ByteString -> Either DecoderError a
forall a. FromCBOR a => ByteString -> Either DecoderError a
Plain.decodeFull
        (ByteString -> Either DecoderError a)
-> (ByteString -> Either DecoderError ByteString)
-> ByteString
-> Either DecoderError a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (String -> DecoderError)
-> Either String ByteString -> Either DecoderError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> DecoderError
DecoderErrorCustom Text
"Invalid Hex encoding:" (Text -> DecoderError)
-> (String -> Text) -> String -> DecoderError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Either String ByteString -> Either DecoderError ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> Either DecoderError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
Base16.decode

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

loadLedgerState ::
  FilePath ->
  IO (LedgerState CurrentEra)
loadLedgerState :: String -> IO (LedgerState ConwayEra)
loadLedgerState String
fp = EpochState ConwayEra -> LedgerState ConwayEra
forall era. EpochState era -> LedgerState era
esLState (EpochState ConwayEra -> LedgerState ConwayEra)
-> (NewEpochState ConwayEra -> EpochState ConwayEra)
-> NewEpochState ConwayEra
-> LedgerState ConwayEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochState ConwayEra -> EpochState ConwayEra
forall era. NewEpochState era -> EpochState era
nesEs (NewEpochState ConwayEra -> LedgerState ConwayEra)
-> IO (NewEpochState ConwayEra) -> IO (LedgerState ConwayEra)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (NewEpochState ConwayEra)
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 (x -> b) -> m x -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void m x -> m x
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () a m ()
source ConduitT () a m () -> ConduitT a Void m x -> ConduitT () Void m x
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (x -> a -> x) -> x -> ConduitT a Void m x
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 = (Map TxIn a -> (TxIn, a) -> Map TxIn a)
-> Map TxIn a
-> (Map TxIn a -> Map TxIn a)
-> Fold (TxIn, a) (Map TxIn a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\ !Map TxIn a
m !(!TxIn
k, !a
v) -> TxIn -> a -> Map TxIn a -> Map TxIn a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
k a
v Map TxIn a
m) Map TxIn a
forall a. Monoid a => a
mempty Map TxIn a -> Map TxIn a
forall a. a -> a
id

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

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

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

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

txIdSharing_ :: UTxOFold (Map.Map TxId (IntMap.IntMap ()))
txIdSharing_ :: UTxOFold (Map TxId (IntMap ()))
txIdSharing_ = (Map TxId (IntMap ())
 -> (TxIn, BabbageTxOut ConwayEra) -> Map TxId (IntMap ()))
-> Map TxId (IntMap ())
-> (Map TxId (IntMap ()) -> Map TxId (IntMap ()))
-> Fold (TxIn, BabbageTxOut ConwayEra) (Map TxId (IntMap ()))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\Map TxId (IntMap ())
a (TxIn, BabbageTxOut ConwayEra)
v -> Map TxId (IntMap ()) -> (TxIn, ()) -> Map TxId (IntMap ())
forall a. Map TxId (IntMap a) -> (TxIn, a) -> Map TxId (IntMap a)
txIdNestedInsert Map TxId (IntMap ())
a (() () -> (TxIn, BabbageTxOut ConwayEra) -> (TxIn, ())
forall a b. a -> (TxIn, b) -> (TxIn, a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TxIn, BabbageTxOut ConwayEra)
v)) Map TxId (IntMap ())
forall a. Monoid a => a
mempty Map TxId (IntMap ()) -> Map TxId (IntMap ())
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 = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
IntMap.singleton (TxIx -> Int
txIxToInt TxIx
txIx) a
v
   in (IntMap a -> IntMap a -> IntMap a)
-> TxId -> IntMap a -> Map TxId (IntMap a) -> Map TxId (IntMap a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith IntMap a -> IntMap a -> IntMap a
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 = (IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a))
-> IntMap (Map TxId a)
-> (IntMap (Map TxId a) -> IntMap (Map TxId a))
-> Fold (TxIn, a) (IntMap (Map TxId a))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
forall a. IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
txIxNestedInsert IntMap (Map TxId a)
forall a. Monoid a => a
mempty IntMap (Map TxId a) -> IntMap (Map TxId a)
forall a. a -> a
id

txIxSharing_ :: UTxOFold (IntMap.IntMap (Map.Map TxId ()))
txIxSharing_ :: UTxOFold (IntMap (Map TxId ()))
txIxSharing_ = (IntMap (Map TxId ())
 -> (TxIn, BabbageTxOut ConwayEra) -> IntMap (Map TxId ()))
-> IntMap (Map TxId ())
-> (IntMap (Map TxId ()) -> IntMap (Map TxId ()))
-> Fold (TxIn, BabbageTxOut ConwayEra) (IntMap (Map TxId ()))
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
Fold (\IntMap (Map TxId ())
a (TxIn, BabbageTxOut ConwayEra)
v -> IntMap (Map TxId ()) -> (TxIn, ()) -> IntMap (Map TxId ())
forall a. IntMap (Map TxId a) -> (TxIn, a) -> IntMap (Map TxId a)
txIxNestedInsert IntMap (Map TxId ())
a (() () -> (TxIn, BabbageTxOut ConwayEra) -> (TxIn, ())
forall a b. a -> (TxIn, b) -> (TxIn, a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (TxIn, BabbageTxOut ConwayEra)
v)) IntMap (Map TxId ())
forall a. Monoid a => a
mempty IntMap (Map TxId ()) -> IntMap (Map TxId ())
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 -> Map TxId a -> Maybe (Map TxId a)
forall a. a -> Maybe a
Just (Map TxId a -> Maybe (Map TxId a))
-> Map TxId a -> Maybe (Map TxId a)
forall a b. (a -> b) -> a -> b
$! TxId -> a -> Map TxId a
forall k a. k -> a -> Map k a
Map.singleton TxId
txId a
v
          Just !Map TxId a
m -> Map TxId a -> Maybe (Map TxId a)
forall a. a -> Maybe a
Just (Map TxId a -> Maybe (Map TxId a))
-> Map TxId a -> Maybe (Map TxId a)
forall a b. (a -> b) -> a -> b
$! TxId -> a -> Map TxId a -> Map TxId a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxId
txId a
v Map TxId a
m
   in (Maybe (Map TxId a) -> Maybe (Map TxId a))
-> Int -> IntMap (Map TxId a) -> IntMap (Map TxId a)
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 ConwayEra) -> MaryValue
totalADA = (BabbageTxOut ConwayEra -> MaryValue)
-> Map TxIn (BabbageTxOut ConwayEra) -> MaryValue
forall m a. Monoid m => (a -> m) -> Map TxIn a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (BabbageTxOut ConwayEra
-> Getting MaryValue (BabbageTxOut ConwayEra) MaryValue
-> MaryValue
forall s a. s -> Getting a s a -> a
^. (Value ConwayEra -> Const MaryValue (Value ConwayEra))
-> TxOut ConwayEra -> Const MaryValue (TxOut ConwayEra)
Getting MaryValue (BabbageTxOut ConwayEra) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut ConwayEra) (Value ConwayEra)
valueTxOutL)

readBinUTxO ::
  FilePath ->
  IO (UTxO CurrentEra)
readBinUTxO :: String -> IO (UTxO ConwayEra)
readBinUTxO String
fp = do
  ls <- String -> IO (NewEpochState ConwayEra)
readNewEpochState String
fp
  pure $! utxosUtxo $ lsUTxOState $ esLState $ nesEs ls

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

instance Ord k => Monoid (Stat k) where
  mempty :: Stat k
mempty = Set k -> Count -> Stat k
forall k. Set k -> Count -> Stat k
Stat Set k
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
statUnique :: forall k. Stat k -> Set k
statCount :: forall k. Stat k -> Count
statUnique :: Set k
statCount :: Count
..} =
    Int -> Doc ann
forall ann. Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
n
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"/"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Count -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Count -> Doc ann
pretty Count
statCount
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"("
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Percent -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Percent -> Doc ann
pretty (Int -> Count -> Percent
forall i. Integral i => Int -> i -> Percent
intPercent Int
n Count
statCount)
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" unique)"
    where
      n :: Int
n = Set k -> Int
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) = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Int -> Int -> String
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 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
0 = Int -> Int -> Percent
Percent Int
0 Int
0
  | Bool
otherwise = (Int -> Int -> Percent) -> (Int, Int) -> Percent
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Percent
Percent (((Int
10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
x) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
y) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
100)

statSingleton :: a -> Stat a
statSingleton :: forall a. a -> Stat a
statSingleton a
a = Set a -> Count -> Stat a
forall k. Set k -> Count -> Stat k
Stat (a -> Set a
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 = Set a -> Count -> Stat a
forall k. Set k -> Count -> Stat k
Stat Set a
s (Int -> Count
Count (Set a -> Int
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 = Set b -> Count -> Stat b
forall k. Set k -> Count -> Stat k
Stat ((a -> b) -> Set a -> Set b
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f (Stat a -> Set a
forall k. Stat k -> Set k
statUnique Stat a
s)) (Stat a -> Count
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 = Set k -> Stat k
forall a. Set a -> Stat a
statSet (Set k -> Stat k) -> (Map k v -> Set k) -> Map k v -> Stat k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> Set k
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 = Set a -> Count -> Stat a
forall k. Set k -> Count -> Stat k
Stat ([a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList (t a -> [a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList t a
m)) (Int -> Count
Count (t a -> Int
forall a. t a -> Int
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 Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
line Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
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
"[" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"]:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
y Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"<" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TypeRep -> ShowS
showsTypeRep (a -> TypeRep
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 Stat (Credential Staking)
-> Stat (Credential Staking) -> Stat (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Staking)
y1)
      (Stat (Credential Staking)
x2 Stat (Credential Staking)
-> Stat (Credential Staking) -> Stat (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Staking)
y2)
      (Stat (KeyHash StakePool)
x3 Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash StakePool)
y3)
      (Stat (KeyHash StakePool)
x4 Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash StakePool)
y4)
      (PoolParamsStats
x5 PoolParamsStats -> PoolParamsStats -> PoolParamsStats
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 Stat (Credential Staking)
forall a. Monoid a => a
mempty Stat (Credential Staking)
forall a. Monoid a => a
mempty Stat (KeyHash StakePool)
forall a. Monoid a => a
mempty Stat (KeyHash StakePool)
forall a. Monoid a => a
mempty PoolParamsStats
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)
sssStake :: SnapShotStats -> Stat (Credential Staking)
sssDelegationCredential :: SnapShotStats -> Stat (Credential Staking)
sssDelegationStakePool :: SnapShotStats -> Stat (KeyHash StakePool)
sssPoolParams :: SnapShotStats -> Stat (KeyHash StakePool)
sssPoolParamsStats :: SnapShotStats -> PoolParamsStats
sssStake :: Stat (Credential Staking)
sssDelegationCredential :: Stat (Credential Staking)
sssDelegationStakePool :: Stat (KeyHash StakePool)
sssPoolParams :: Stat (KeyHash StakePool)
sssPoolParamsStats :: PoolParamsStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"SnapShot"
      [ Doc ann
"Stake" Doc ann -> Stat (Credential Staking) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking)
sssStake
      , Doc ann
"DelegationCredential" Doc ann -> Stat (Credential Staking) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking)
sssDelegationCredential
      , Doc ann
"DelegationStakePool" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
sssDelegationStakePool
      , Doc ann
"PoolParams" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
sssPoolParams
      , PoolParamsStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PoolParamsStats -> Doc ann
pretty PoolParamsStats
sssPoolParamsStats
      ]

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

countSnapShotStat :: SnapShot -> SnapShotStats
countSnapShotStat :: SnapShot -> SnapShotStats
countSnapShotStat SnapShot {Stake
VMap VB VB (KeyHash StakePool) StakePoolParams
VMap VB VB (Credential Staking) (KeyHash StakePool)
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: VMap VB VB (KeyHash StakePool) StakePoolParams
ssDelegations :: SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssStake :: SnapShot -> Stake
..} =
  SnapShotStats
    { sssStake :: Stat (Credential Staking)
sssStake = Map (Credential Staking) (CompactForm Coin)
-> Stat (Credential Staking)
forall k v. Map k v -> Stat k
statMapKeys (VMap VB VP (Credential Staking) (CompactForm Coin)
-> Map (Credential Staking) (CompactForm Coin)
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 = Map (Credential Staking) (KeyHash StakePool)
-> Stat (Credential Staking)
forall k v. Map k v -> Stat k
statMapKeys (VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Map (Credential Staking) (KeyHash StakePool)
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 = Map (Credential Staking) (KeyHash StakePool)
-> Stat (KeyHash StakePool)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (VMap VB VB (Credential Staking) (KeyHash StakePool)
-> Map (Credential Staking) (KeyHash StakePool)
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 = Map (KeyHash StakePool) StakePoolParams -> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys (VMap VB VB (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) StakePoolParams
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) StakePoolParams
ssPoolParams)
    , sssPoolParamsStats :: PoolParamsStats
sssPoolParamsStats = (StakePoolParams -> PoolParamsStats)
-> VMap VB VB (KeyHash StakePool) StakePoolParams
-> PoolParamsStats
forall (vv :: * -> *) v m (kv :: * -> *) k.
(Vector vv v, Monoid m) =>
(v -> m) -> VMap kv vv k v -> m
VMap.foldMap StakePoolParams -> PoolParamsStats
countPoolParamsStats VMap VB VB (KeyHash StakePool) StakePoolParams
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 Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash StakePool)
y1)
      (Stat (Credential Staking)
x2 Stat (Credential Staking)
-> Stat (Credential Staking) -> Stat (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Staking)
y2)
      (Stat (KeyHash Staking)
x3 Stat (KeyHash Staking)
-> Stat (KeyHash Staking) -> Stat (KeyHash Staking)
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 Stat (KeyHash StakePool)
forall a. Monoid a => a
mempty Stat (Credential Staking)
forall a. Monoid a => a
mempty Stat (KeyHash Staking)
forall a. Monoid a => a
mempty

instance Pretty PoolParamsStats where
  pretty :: forall ann. PoolParamsStats -> Doc ann
pretty PoolParamsStats {Stat (KeyHash StakePool)
Stat (KeyHash Staking)
Stat (Credential Staking)
ppsPoolId :: PoolParamsStats -> Stat (KeyHash StakePool)
ppsRewardAccount :: PoolParamsStats -> Stat (Credential Staking)
ppsOwners :: PoolParamsStats -> Stat (KeyHash Staking)
ppsPoolId :: Stat (KeyHash StakePool)
ppsRewardAccount :: Stat (Credential Staking)
ppsOwners :: Stat (KeyHash Staking)
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PoolParamsStats"
      [ Doc ann
"PoolId" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
ppsPoolId
      , Doc ann
"RewardAccount" Doc ann -> Stat (Credential Staking) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking)
ppsRewardAccount
      , Doc ann
"Owners" Doc ann -> Stat (KeyHash Staking) -> Doc ann
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 StakePool)
Stat (KeyHash Staking)
Stat (Credential Staking)
ppsPoolId :: PoolParamsStats -> Stat (KeyHash StakePool)
ppsRewardAccount :: PoolParamsStats -> Stat (Credential Staking)
ppsOwners :: PoolParamsStats -> Stat (KeyHash Staking)
ppsPoolId :: Stat (KeyHash StakePool)
ppsRewardAccount :: Stat (Credential Staking)
ppsOwners :: Stat (KeyHash Staking)
..} =
    AggregateStats
forall a. Monoid a => a
mempty {gsCredentialStaking = ppsRewardAccount, gsKeyHashStakePool = ppsPoolId}

countPoolParamsStats :: StakePoolParams -> PoolParamsStats
countPoolParamsStats :: StakePoolParams -> PoolParamsStats
countPoolParamsStats StakePoolParams {Set (KeyHash Staking)
StrictMaybe PoolMetadata
KeyHash StakePool
VRFVerKeyHash StakePoolVRF
Coin
UnitInterval
RewardAccount
StrictSeq StakePoolRelay
sppId :: KeyHash StakePool
sppVrf :: VRFVerKeyHash StakePoolVRF
sppPledge :: Coin
sppCost :: Coin
sppMargin :: UnitInterval
sppRewardAccount :: RewardAccount
sppOwners :: Set (KeyHash Staking)
sppRelays :: StrictSeq StakePoolRelay
sppMetadata :: StrictMaybe PoolMetadata
sppCost :: StakePoolParams -> Coin
sppId :: StakePoolParams -> KeyHash StakePool
sppMargin :: StakePoolParams -> UnitInterval
sppMetadata :: StakePoolParams -> StrictMaybe PoolMetadata
sppOwners :: StakePoolParams -> Set (KeyHash Staking)
sppPledge :: StakePoolParams -> Coin
sppRelays :: StakePoolParams -> StrictSeq StakePoolRelay
sppRewardAccount :: StakePoolParams -> RewardAccount
sppVrf :: StakePoolParams -> VRFVerKeyHash StakePoolVRF
..} =
  PoolParamsStats
    { ppsPoolId :: Stat (KeyHash StakePool)
ppsPoolId = KeyHash StakePool -> Stat (KeyHash StakePool)
forall a. a -> Stat a
statSingleton KeyHash StakePool
sppId
    , ppsRewardAccount :: Stat (Credential Staking)
ppsRewardAccount = Credential Staking -> Stat (Credential Staking)
forall a. a -> Stat a
statSingleton (RewardAccount -> Credential Staking
raCredential RewardAccount
sppRewardAccount)
    , ppsOwners :: Stat (KeyHash Staking)
ppsOwners = Set (KeyHash Staking) -> Stat (KeyHash Staking)
forall a. Set a -> Stat a
statSet Set (KeyHash Staking)
sppOwners
    }

data RewardUpdateStats = RewardUpdateStats

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

instance AggregateStat RewardUpdateStats where
  aggregateStat :: RewardUpdateStats -> AggregateStats
aggregateStat RewardUpdateStats
RewardUpdateStats = AggregateStats
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 (KeyHash StakePool)
Stat (VRFVerKeyHash StakePoolVRF)
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash StakePool)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (VRFVerKeyHash StakePoolVRF)
pdsStakePoolKeyHash :: Stat (KeyHash StakePool)
pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash StakePoolVRF)
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PoolDistrStats"
      [ Doc ann
"StakePoolKeyHash" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
pdsStakePoolKeyHash
      , Doc ann
"StakePoolStakeVrf" Doc ann -> Stat (VRFVerKeyHash StakePoolVRF) -> Doc ann
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 (KeyHash StakePool)
Stat (VRFVerKeyHash StakePoolVRF)
pdsStakePoolKeyHash :: PoolDistrStats -> Stat (KeyHash StakePool)
pdsStakePoolStakeVrf :: PoolDistrStats -> Stat (VRFVerKeyHash StakePoolVRF)
pdsStakePoolKeyHash :: Stat (KeyHash StakePool)
pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash StakePoolVRF)
..} =
    AggregateStats
forall a. Monoid a => a
mempty
      { gsKeyHashStakePool = pdsStakePoolKeyHash
      , gsVerKeyVRF = mapStat unVRFVerKeyHash pdsStakePoolStakeVrf
      }

calcPoolDistrStats :: PoolDistr -> PoolDistrStats
calcPoolDistrStats :: PoolDistr -> PoolDistrStats
calcPoolDistrStats (PoolDistr Map (KeyHash StakePool) IndividualPoolStake
pd CompactForm Coin
_tot) =
  PoolDistrStats
    { pdsStakePoolKeyHash :: Stat (KeyHash StakePool)
pdsStakePoolKeyHash = Map (KeyHash StakePool) IndividualPoolStake
-> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash StakePool) IndividualPoolStake
pd
    , pdsStakePoolStakeVrf :: Stat (VRFVerKeyHash StakePoolVRF)
pdsStakePoolStakeVrf = [VRFVerKeyHash StakePoolVRF] -> Stat (VRFVerKeyHash StakePoolVRF)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (IndividualPoolStake -> VRFVerKeyHash StakePoolVRF
individualPoolStakeVrf (IndividualPoolStake -> VRFVerKeyHash StakePoolVRF)
-> [IndividualPoolStake] -> [VRFVerKeyHash StakePoolVRF]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash StakePool) IndividualPoolStake
-> [IndividualPoolStake]
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)
nessPrevBlocksMade :: NewEpochStateStats -> Stat (KeyHash StakePool)
nessCurBlocksMade :: NewEpochStateStats -> Stat (KeyHash StakePool)
nessBlocksMade :: NewEpochStateStats -> Stat (KeyHash StakePool)
nessEpochStateStats :: NewEpochStateStats -> EpochStateStats
nessRewardUpdate :: NewEpochStateStats -> RewardUpdateStats
nessPoolDistrStats :: NewEpochStateStats -> PoolDistrStats
nessAggregateStats :: NewEpochStateStats -> AggregateStats
nessPrevBlocksMade :: Stat (KeyHash StakePool)
nessCurBlocksMade :: Stat (KeyHash StakePool)
nessBlocksMade :: Stat (KeyHash StakePool)
nessEpochStateStats :: EpochStateStats
nessRewardUpdate :: RewardUpdateStats
nessPoolDistrStats :: PoolDistrStats
nessAggregateStats :: AggregateStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"NewEpochStateStats"
      [ Doc ann
"PrevBlocksMade" Doc ann -> Count -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool) -> Count
forall k. Stat k -> Count
statCount Stat (KeyHash StakePool)
nessPrevBlocksMade
      , Doc ann
"CurBlocksMade" Doc ann -> Count -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool) -> Count
forall k. Stat k -> Count
statCount Stat (KeyHash StakePool)
nessCurBlocksMade
      , Doc ann
"BlocksMade" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
nessBlocksMade
      , EpochStateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. EpochStateStats -> Doc ann
pretty EpochStateStats
nessEpochStateStats
      , RewardUpdateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. RewardUpdateStats -> Doc ann
pretty RewardUpdateStats
nessRewardUpdate Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"TODO"
      , PoolDistrStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PoolDistrStats -> Doc ann
pretty PoolDistrStats
nessPoolDistrStats
      , AggregateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AggregateStats -> Doc ann
pretty AggregateStats
nessAggregateStats
      ]

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

printNewEpochStateStats :: NewEpochStateStats -> IO ()
printNewEpochStateStats :: NewEpochStateStats -> IO ()
printNewEpochStateStats = String -> IO ()
putStrLn (String -> IO ())
-> (NewEpochStateStats -> String) -> NewEpochStateStats -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc (ZonkAny 0) -> String
forall a. Show a => a -> String
show (Doc (ZonkAny 0) -> String)
-> (NewEpochStateStats -> Doc (ZonkAny 0))
-> NewEpochStateStats
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochStateStats -> Doc (ZonkAny 0)
forall a ann. Pretty a => a -> Doc ann
forall ann. NewEpochStateStats -> 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 :: EpochStateStats -> AggregateStats
essMarkSnapShotStats :: EpochStateStats -> SnapShotStats
essSetSnapShotStats :: EpochStateStats -> SnapShotStats
essGoSnapShotStats :: EpochStateStats -> SnapShotStats
essSnapShotsStats :: EpochStateStats -> SnapShotStats
essLedgerStateStats :: EpochStateStats -> LedgerStateStats
essNonMyopic :: EpochStateStats -> Stat (KeyHash StakePool)
essMarkSnapShotStats :: SnapShotStats
essSetSnapShotStats :: SnapShotStats
essGoSnapShotStats :: SnapShotStats
essSnapShotsStats :: SnapShotStats
essLedgerStateStats :: LedgerStateStats
essNonMyopic :: Stat (KeyHash StakePool)
essAggregateStats :: AggregateStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"EpochStateStats"
      [ Doc ann
"mark" Doc ann -> Count -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking) -> Count
forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential Staking)
sssStake SnapShotStats
essMarkSnapShotStats)
      , Doc ann
"set" Doc ann -> Count -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking) -> Count
forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential Staking)
sssStake SnapShotStats
essSetSnapShotStats)
      , Doc ann
"go" Doc ann -> Count -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking) -> Count
forall k. Stat k -> Count
statCount (SnapShotStats -> Stat (Credential Staking)
sssStake SnapShotStats
essGoSnapShotStats)
      , Doc ann
"mark+set+go =" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SnapShotStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SnapShotStats -> Doc ann
pretty SnapShotStats
essSnapShotsStats
      , LedgerStateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. LedgerStateStats -> Doc ann
pretty LedgerStateStats
essLedgerStateStats
      , Doc ann
"NonMyopic" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
essNonMyopic
      , AggregateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. AggregateStats -> Doc ann
pretty AggregateStats
essAggregateStats
      ]

countEpochStateStats :: EpochState CurrentEra -> EpochStateStats
countEpochStateStats :: EpochState ConwayEra -> EpochStateStats
countEpochStateStats EpochState {ChainAccountState
SnapShots
NonMyopic
LedgerState ConwayEra
esLState :: forall era. EpochState era -> LedgerState era
esChainAccountState :: ChainAccountState
esLState :: LedgerState ConwayEra
esSnapshots :: SnapShots
esNonMyopic :: NonMyopic
esNonMyopic :: forall era. EpochState era -> NonMyopic
esSnapshots :: forall era. EpochState era -> SnapShots
esChainAccountState :: forall era. EpochState era -> ChainAccountState
..} =
  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 SnapShotStats -> SnapShotStats -> SnapShotStats
forall a. Semigroup a => a -> a -> a
<> SnapShotStats
setSnap SnapShotStats -> SnapShotStats -> SnapShotStats
forall a. Semigroup a => a -> a -> a
<> SnapShotStats
goSnap
          , essLedgerStateStats :: LedgerStateStats
essLedgerStateStats = LedgerState ConwayEra -> LedgerStateStats
countLedgerStateStats LedgerState ConwayEra
esLState
          , essNonMyopic :: Stat (KeyHash StakePool)
essNonMyopic = Map (KeyHash StakePool) Likelihood -> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys (NonMyopic -> Map (KeyHash StakePool) Likelihood
likelihoodsNM NonMyopic
esNonMyopic)
          , essAggregateStats :: AggregateStats
essAggregateStats = AggregateStats
forall a. Monoid a => a
mempty
          }
   in EpochStateStats
stats
        { essAggregateStats =
            mconcat
              [ aggregateStat (essSnapShotsStats stats)
              , aggregateStat (essLedgerStateStats stats)
              , aggregateStat (essNonMyopic stats)
              ]
        }

data DStateStats = DStateStats
  { DStateStats -> Stat (Credential Staking)
dssCredentialStaking :: !(Stat (Credential Staking))
  , DStateStats -> Stat (KeyHash StakePool)
dssDelegations :: !(Stat (KeyHash StakePool))
  , DStateStats -> Stat (KeyHash GenesisRole)
dssKeyHashGenesis :: !(Stat (KeyHash GenesisRole))
  , 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 (KeyHash GenesisDelegate)
Stat (KeyHash GenesisRole)
Stat (KeyHash StakePool)
Stat (VRFVerKeyHash GenDelegVRF)
Stat (Credential Staking)
dssCredentialStaking :: DStateStats -> Stat (Credential Staking)
dssDelegations :: DStateStats -> Stat (KeyHash StakePool)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash GenesisRole)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash GenesisDelegate)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash GenDelegVRF)
dssCredentialStaking :: Stat (Credential Staking)
dssDelegations :: Stat (KeyHash StakePool)
dssKeyHashGenesis :: Stat (KeyHash GenesisRole)
dssKeyHashGenesisDelegate :: Stat (KeyHash GenesisDelegate)
dssHashVerKeyVRF :: Stat (VRFVerKeyHash GenDelegVRF)
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"DStateStats"
      [ Doc ann
"CredentialStaking" Doc ann -> Stat (Credential Staking) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking)
dssCredentialStaking
      , Doc ann
"SPoolUView" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
dssDelegations
      , Doc ann
"KeyHashGenesis" Doc ann -> Stat (KeyHash GenesisRole) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash GenesisRole)
dssKeyHashGenesis
      , Doc ann
"KeyHashGenesisDelegate" Doc ann -> Stat (KeyHash GenesisDelegate) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash GenesisDelegate)
dssKeyHashGenesisDelegate
      , Doc ann
"HashVerKeyVRF" Doc ann -> Stat (VRFVerKeyHash GenDelegVRF) -> Doc ann
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 (KeyHash GenesisDelegate)
Stat (KeyHash GenesisRole)
Stat (KeyHash StakePool)
Stat (VRFVerKeyHash GenDelegVRF)
Stat (Credential Staking)
dssCredentialStaking :: DStateStats -> Stat (Credential Staking)
dssDelegations :: DStateStats -> Stat (KeyHash StakePool)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash GenesisRole)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash GenesisDelegate)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash GenDelegVRF)
dssCredentialStaking :: Stat (Credential Staking)
dssDelegations :: Stat (KeyHash StakePool)
dssKeyHashGenesis :: Stat (KeyHash GenesisRole)
dssKeyHashGenesisDelegate :: Stat (KeyHash GenesisDelegate)
dssHashVerKeyVRF :: Stat (VRFVerKeyHash GenDelegVRF)
..} =
    AggregateStats
forall a. Monoid a => a
mempty
      { gsCredentialStaking = dssCredentialStaking
      , gsKeyHashStakePool = dssDelegations
      , gsKeyHashGenesis = dssKeyHashGenesis
      , gsKeyHashGenesisDelegate = dssKeyHashGenesisDelegate
      , gsVerKeyVRF = mapStat unVRFVerKeyHash dssHashVerKeyVRF
      }

countDStateStats :: DState CurrentEra -> DStateStats
countDStateStats :: DState ConwayEra -> DStateStats
countDStateStats ds :: DState ConwayEra
ds@DState {Map FutureGenDeleg GenDelegPair
Accounts ConwayEra
InstantaneousRewards
GenDelegs
dsAccounts :: Accounts ConwayEra
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsAccounts :: forall era. DState era -> Accounts era
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
..} =
  let accountsMap :: Map (Credential Staking) (AccountState ConwayEra)
accountsMap = DState ConwayEra
ds DState ConwayEra
-> Getting
     (Map (Credential Staking) (AccountState ConwayEra))
     (DState ConwayEra)
     (Map (Credential Staking) (AccountState ConwayEra))
-> Map (Credential Staking) (AccountState ConwayEra)
forall s a. s -> Getting a s a -> a
^. (Accounts ConwayEra
 -> Const
      (Map (Credential Staking) (AccountState ConwayEra))
      (Accounts ConwayEra))
-> DState ConwayEra
-> Const
     (Map (Credential Staking) (AccountState ConwayEra))
     (DState ConwayEra)
(ConwayAccounts ConwayEra
 -> Const
      (Map (Credential Staking) (AccountState ConwayEra))
      (ConwayAccounts ConwayEra))
-> DState ConwayEra
-> Const
     (Map (Credential Staking) (AccountState ConwayEra))
     (DState ConwayEra)
forall era. Lens' (DState era) (Accounts era)
forall (t :: * -> *) era.
CanSetAccounts t =>
Lens' (t era) (Accounts era)
accountsL ((ConwayAccounts ConwayEra
  -> Const
       (Map (Credential Staking) (AccountState ConwayEra))
       (ConwayAccounts ConwayEra))
 -> DState ConwayEra
 -> Const
      (Map (Credential Staking) (AccountState ConwayEra))
      (DState ConwayEra))
-> ((Map (Credential Staking) (AccountState ConwayEra)
     -> Const
          (Map (Credential Staking) (AccountState ConwayEra))
          (Map (Credential Staking) (AccountState ConwayEra)))
    -> ConwayAccounts ConwayEra
    -> Const
         (Map (Credential Staking) (AccountState ConwayEra))
         (ConwayAccounts ConwayEra))
-> Getting
     (Map (Credential Staking) (AccountState ConwayEra))
     (DState ConwayEra)
     (Map (Credential Staking) (AccountState ConwayEra))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential Staking) (AccountState ConwayEra)
 -> Const
      (Map (Credential Staking) (AccountState ConwayEra))
      (Map (Credential Staking) (AccountState ConwayEra)))
-> Accounts ConwayEra
-> Const
     (Map (Credential Staking) (AccountState ConwayEra))
     (Accounts ConwayEra)
(Map (Credential Staking) (AccountState ConwayEra)
 -> Const
      (Map (Credential Staking) (AccountState ConwayEra))
      (Map (Credential Staking) (AccountState ConwayEra)))
-> ConwayAccounts ConwayEra
-> Const
     (Map (Credential Staking) (AccountState ConwayEra))
     (ConwayAccounts ConwayEra)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens'
  (Accounts ConwayEra)
  (Map (Credential Staking) (AccountState ConwayEra))
accountsMapL
   in DStateStats
        { dssCredentialStaking :: Stat (Credential Staking)
dssCredentialStaking = Map (Credential Staking) (AccountState ConwayEra)
-> Stat (Credential Staking)
forall k v. Map k v -> Stat k
statMapKeys Map (Credential Staking) (AccountState ConwayEra)
accountsMap
        , dssDelegations :: Stat (KeyHash StakePool)
dssDelegations = Map (Credential Staking) (KeyHash StakePool)
-> Stat (KeyHash StakePool)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable ((AccountState ConwayEra -> Maybe (KeyHash StakePool))
-> Map (Credential Staking) (AccountState ConwayEra)
-> Map (Credential Staking) (KeyHash StakePool)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (AccountState ConwayEra
-> Getting
     (Maybe (KeyHash StakePool))
     (AccountState ConwayEra)
     (Maybe (KeyHash StakePool))
-> Maybe (KeyHash StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (KeyHash StakePool))
  (AccountState ConwayEra)
  (Maybe (KeyHash StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState ConwayEra) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL) Map (Credential Staking) (AccountState ConwayEra)
accountsMap)
        , dssKeyHashGenesis :: Stat (KeyHash GenesisRole)
dssKeyHashGenesis =
            [KeyHash GenesisRole] -> Stat (KeyHash GenesisRole)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (FutureGenDeleg -> KeyHash GenesisRole
fGenDelegGenKeyHash (FutureGenDeleg -> KeyHash GenesisRole)
-> [FutureGenDeleg] -> [KeyHash GenesisRole]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FutureGenDeleg GenDelegPair -> [FutureGenDeleg]
forall k a. Map k a -> [k]
Map.keys Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
              Stat (KeyHash GenesisRole)
-> Stat (KeyHash GenesisRole) -> Stat (KeyHash GenesisRole)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash GenesisRole) GenDelegPair
-> Stat (KeyHash GenesisRole)
forall k v. Map k v -> Stat k
statMapKeys (GenDelegs -> Map (KeyHash GenesisRole) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs)
        , dssKeyHashGenesisDelegate :: Stat (KeyHash GenesisDelegate)
dssKeyHashGenesisDelegate =
            [KeyHash GenesisDelegate] -> Stat (KeyHash GenesisDelegate)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (GenDelegPair -> KeyHash GenesisDelegate
genDelegKeyHash (GenDelegPair -> KeyHash GenesisDelegate)
-> [GenDelegPair] -> [KeyHash GenesisDelegate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FutureGenDeleg GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
              Stat (KeyHash GenesisDelegate)
-> Stat (KeyHash GenesisDelegate) -> Stat (KeyHash GenesisDelegate)
forall a. Semigroup a => a -> a -> a
<> [KeyHash GenesisDelegate] -> Stat (KeyHash GenesisDelegate)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable
                (GenDelegPair -> KeyHash GenesisDelegate
genDelegKeyHash (GenDelegPair -> KeyHash GenesisDelegate)
-> [GenDelegPair] -> [KeyHash GenesisDelegate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash GenesisRole) GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash GenesisRole) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs))
        , dssHashVerKeyVRF :: Stat (VRFVerKeyHash GenDelegVRF)
dssHashVerKeyVRF =
            [VRFVerKeyHash GenDelegVRF] -> Stat (VRFVerKeyHash GenDelegVRF)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (GenDelegPair -> VRFVerKeyHash GenDelegVRF
genDelegVrfHash (GenDelegPair -> VRFVerKeyHash GenDelegVRF)
-> [GenDelegPair] -> [VRFVerKeyHash GenDelegVRF]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FutureGenDeleg GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems Map FutureGenDeleg GenDelegPair
dsFutureGenDelegs)
              Stat (VRFVerKeyHash GenDelegVRF)
-> Stat (VRFVerKeyHash GenDelegVRF)
-> Stat (VRFVerKeyHash GenDelegVRF)
forall a. Semigroup a => a -> a -> a
<> [VRFVerKeyHash GenDelegVRF] -> Stat (VRFVerKeyHash GenDelegVRF)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable
                (GenDelegPair -> VRFVerKeyHash GenDelegVRF
genDelegVrfHash (GenDelegPair -> VRFVerKeyHash GenDelegVRF)
-> [GenDelegPair] -> [VRFVerKeyHash GenDelegVRF]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash GenesisRole) GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash GenesisRole) 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)
pssKeyHashStakePool :: PStateStats -> Stat (KeyHash StakePool)
pssPoolParamsStats :: PStateStats -> PoolParamsStats
pssKeyHashStakePool :: Stat (KeyHash StakePool)
pssPoolParamsStats :: PoolParamsStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"PStateStats"
      [ Doc ann
"KeyHashStakePool" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
pssKeyHashStakePool
      , PoolParamsStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PoolParamsStats -> Doc ann
pretty PoolParamsStats
pssPoolParamsStats
      ]

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

countPStateStats :: PState CurrentEra -> PStateStats
countPStateStats :: PState ConwayEra -> PStateStats
countPStateStats PState {Map (KeyHash StakePool) StakePoolParams
Map (KeyHash StakePool) StakePoolState
Map (KeyHash StakePool) EpochNo
Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes :: Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psStakePools :: Map (KeyHash StakePool) StakePoolState
psFutureStakePoolParams :: Map (KeyHash StakePool) StakePoolParams
psRetiring :: Map (KeyHash StakePool) EpochNo
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash StakePool) StakePoolParams
psRetiring :: forall era. PState era -> Map (KeyHash StakePool) EpochNo
psStakePools :: forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psVRFKeyHashes :: forall era.
PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
..} =
  PStateStats
    { pssKeyHashStakePool :: Stat (KeyHash StakePool)
pssKeyHashStakePool =
        Map (KeyHash StakePool) StakePoolState -> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash StakePool) StakePoolState
psStakePools
          Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash StakePool) StakePoolParams -> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash StakePool) StakePoolParams
psFutureStakePoolParams
          Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash StakePool) EpochNo -> Stat (KeyHash StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash StakePool) EpochNo
psRetiring
    , pssPoolParamsStats :: PoolParamsStats
pssPoolParamsStats =
        (StakePoolParams -> PoolParamsStats)
-> Map (KeyHash StakePool) StakePoolParams -> PoolParamsStats
forall m a. Monoid m => (a -> m) -> Map (KeyHash StakePool) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap StakePoolParams -> PoolParamsStats
countPoolParamsStats ((KeyHash StakePool -> StakePoolState -> StakePoolParams)
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolParams
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey KeyHash StakePool -> StakePoolState -> StakePoolParams
stakePoolStateToStakePoolParams Map (KeyHash StakePool) StakePoolState
psStakePools)
          PoolParamsStats -> PoolParamsStats -> PoolParamsStats
forall a. Semigroup a => a -> a -> a
<> (StakePoolParams -> PoolParamsStats)
-> Map (KeyHash StakePool) StakePoolParams -> PoolParamsStats
forall m a. Monoid m => (a -> m) -> Map (KeyHash StakePool) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap StakePoolParams -> PoolParamsStats
countPoolParamsStats Map (KeyHash StakePool) StakePoolParams
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
lssUTxOStats :: LedgerStateStats -> UTxOStats
lssDStateStats :: LedgerStateStats -> DStateStats
lssPStateStats :: LedgerStateStats -> PStateStats
lssUTxOStats :: UTxOStats
lssDStateStats :: DStateStats
lssPStateStats :: PStateStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"LedgerStateStats"
      [ UTxOStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UTxOStats -> Doc ann
pretty UTxOStats
lssUTxOStats
      , DStateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. DStateStats -> Doc ann
pretty DStateStats
lssDStateStats
      , PStateStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PStateStats -> Doc ann
pretty PStateStats
lssPStateStats
      ]

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

countLedgerStateStats :: LedgerState CurrentEra -> LedgerStateStats
countLedgerStateStats :: LedgerState ConwayEra -> LedgerStateStats
countLedgerStateStats LedgerState {CertState ConwayEra
UTxOState ConwayEra
lsUTxOState :: forall era. LedgerState era -> UTxOState era
lsUTxOState :: UTxOState ConwayEra
lsCertState :: CertState ConwayEra
lsCertState :: forall era. LedgerState era -> CertState era
..} =
  LedgerStateStats
    { lssUTxOStats :: UTxOStats
lssUTxOStats = UTxO ConwayEra -> UTxOStats
countUTxOStats (UTxOState ConwayEra -> UTxO ConwayEra
forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState ConwayEra
lsUTxOState)
    , lssDStateStats :: DStateStats
lssDStateStats = DState ConwayEra -> DStateStats
countDStateStats (CertState ConwayEra
ConwayCertState ConwayEra
lsCertState ConwayCertState ConwayEra
-> Getting
     (DState ConwayEra) (ConwayCertState ConwayEra) (DState ConwayEra)
-> DState ConwayEra
forall s a. s -> Getting a s a -> a
^. (DState ConwayEra -> Const (DState ConwayEra) (DState ConwayEra))
-> CertState ConwayEra
-> Const (DState ConwayEra) (CertState ConwayEra)
Getting
  (DState ConwayEra) (ConwayCertState ConwayEra) (DState ConwayEra)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState ConwayEra) (DState ConwayEra)
certDStateL)
    , lssPStateStats :: PStateStats
lssPStateStats = PState ConwayEra -> PStateStats
countPStateStats (CertState ConwayEra
ConwayCertState ConwayEra
lsCertState ConwayCertState ConwayEra
-> Getting
     (PState ConwayEra) (ConwayCertState ConwayEra) (PState ConwayEra)
-> PState ConwayEra
forall s a. s -> Getting a s a -> a
^. (PState ConwayEra -> Const (PState ConwayEra) (PState ConwayEra))
-> CertState ConwayEra
-> Const (PState ConwayEra) (CertState ConwayEra)
Getting
  (PState ConwayEra) (ConwayCertState ConwayEra) (PState ConwayEra)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState ConwayEra) (PState ConwayEra)
certPStateL)
    }

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 TxIx
Stat TxId
tisTxId :: TxInStats -> Stat TxId
tisTxIx :: TxInStats -> Stat TxIx
tisTxId :: Stat TxId
tisTxIx :: Stat TxIx
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord Doc ann
"TxInStats" [Doc ann
"TxId" Doc ann -> Stat TxId -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat TxId
tisTxId, Doc ann
"TxIx" Doc ann -> Stat TxIx -> Doc ann
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 [(TxId, TxIx)] -> ([TxId], [TxIx])
forall a b. [(a, b)] -> ([a], [b])
unzip ((TxIn -> (TxId, TxIx)) -> [TxIn] -> [(TxId, TxIx)]
forall a b. (a -> b) -> [a] -> [b]
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 = [TxId] -> Stat TxId
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable [TxId]
txIds
        , tisTxIx :: Stat TxIx
tisTxIx = [TxIx] -> Stat TxIx
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 Stat BootstrapAddress
-> Stat BootstrapAddress -> Stat BootstrapAddress
forall a. Semigroup a => a -> a -> a
<> Stat BootstrapAddress
y0)
      (Stat (Credential Payment)
x1 Stat (Credential Payment)
-> Stat (Credential Payment) -> Stat (Credential Payment)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Payment)
y1)
      (Stat (Credential Staking)
x2 Stat (Credential Staking)
-> Stat (Credential Staking) -> Stat (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Staking)
y2)
      (Stat Ptr
x3 Stat Ptr -> Stat Ptr -> Stat Ptr
forall a. Semigroup a => a -> a -> a
<> Stat Ptr
y3)
      (Stat Network
x4 Stat Network -> Stat Network -> Stat Network
forall a. Semigroup a => a -> a -> a
<> Stat Network
y4)
      (Stat Integer
x5 Stat Integer -> Stat Integer -> Stat Integer
forall a. Semigroup a => a -> a -> a
<> Stat Integer
y5)
      (Stat PolicyID
x6 Stat PolicyID -> Stat PolicyID -> Stat PolicyID
forall a. Semigroup a => a -> a -> a
<> Stat PolicyID
y6)
      (Stat AssetName
x7 Stat AssetName -> Stat AssetName -> Stat AssetName
forall a. Semigroup a => a -> a -> a
<> Stat AssetName
y7)
      (Stat Integer
x8 Stat Integer -> Stat Integer -> Stat Integer
forall a. Semigroup a => a -> a -> a
<> Stat Integer
y8)
      (Stat DataHash
x9 Stat DataHash -> Stat DataHash -> Stat DataHash
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 Stat BootstrapAddress
forall a. Monoid a => a
mempty Stat (Credential Payment)
forall a. Monoid a => a
mempty Stat (Credential Staking)
forall a. Monoid a => a
mempty Stat Ptr
forall a. Monoid a => a
mempty Stat Network
forall a. Monoid a => a
mempty Stat Integer
forall a. Monoid a => a
mempty Stat PolicyID
forall a. Monoid a => a
mempty Stat AssetName
forall a. Monoid a => a
mempty Stat Integer
forall a. Monoid a => a
mempty Stat DataHash
forall a. Monoid a => a
mempty

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

countTxOutStats :: [TxOut CurrentEra] -> TxOutStats
countTxOutStats :: [TxOut ConwayEra] -> TxOutStats
countTxOutStats = (BabbageTxOut ConwayEra -> TxOutStats)
-> [BabbageTxOut ConwayEra] -> TxOutStats
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap TxOut ConwayEra -> TxOutStats
BabbageTxOut ConwayEra -> TxOutStats
countTxOutStat
  where
    countTxOutStat :: TxOut CurrentEra -> TxOutStats
    countTxOutStat :: TxOut ConwayEra -> TxOutStats
countTxOutStat TxOut ConwayEra
txOut =
      let addr :: Addr
addr = TxOut ConwayEra
BabbageTxOut ConwayEra
txOut BabbageTxOut ConwayEra
-> Getting Addr (BabbageTxOut ConwayEra) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. (Addr -> Const Addr Addr)
-> TxOut ConwayEra -> Const Addr (TxOut ConwayEra)
Getting Addr (BabbageTxOut ConwayEra) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut ConwayEra) Addr
addrTxOutL
          MaryValue (Coin Integer
v) (MultiAsset Map PolicyID (Map AssetName Integer)
m) = TxOut ConwayEra
BabbageTxOut ConwayEra
txOut BabbageTxOut ConwayEra
-> Getting MaryValue (BabbageTxOut ConwayEra) MaryValue
-> MaryValue
forall s a. s -> Getting a s a -> a
^. (Value ConwayEra -> Const MaryValue (Value ConwayEra))
-> TxOut ConwayEra -> Const MaryValue (TxOut ConwayEra)
Getting MaryValue (BabbageTxOut ConwayEra) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut ConwayEra) (Value ConwayEra)
valueTxOutL
          !dataStat :: TxOutStats
dataStat =
            TxOutStats
-> (DataHash -> TxOutStats) -> StrictMaybe DataHash -> TxOutStats
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe
              TxOutStats
forall a. Monoid a => a
mempty
              (\DataHash
d -> TxOutStats
forall a. Monoid a => a
mempty {tosDataHash = statSingleton d})
              (TxOut ConwayEra
BabbageTxOut ConwayEra
txOut BabbageTxOut ConwayEra
-> Getting
     (StrictMaybe DataHash)
     (BabbageTxOut ConwayEra)
     (StrictMaybe DataHash)
-> StrictMaybe DataHash
forall s a. s -> Getting a s a -> a
^. (StrictMaybe DataHash
 -> Const (StrictMaybe DataHash) (StrictMaybe DataHash))
-> TxOut ConwayEra
-> Const (StrictMaybe DataHash) (TxOut ConwayEra)
Getting
  (StrictMaybe DataHash)
  (BabbageTxOut ConwayEra)
  (StrictMaybe DataHash)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut ConwayEra) (StrictMaybe DataHash)
dataHashTxOutL)
          !vmElems :: [Map AssetName Integer]
vmElems = Map PolicyID (Map AssetName Integer) -> [Map AssetName Integer]
forall k a. Map k a -> [a]
Map.elems Map PolicyID (Map AssetName Integer)
m
          !valueStat :: TxOutStats
valueStat =
            TxOutStats
dataStat
              { tosValue = statSingleton v
              , tosPolicyId = statMapKeys m
              , tosAssetName = foldMap statMapKeys vmElems
              , tosAssetValue = foldMap statFoldable vmElems
              }
          !networkStat :: TxOutStats
networkStat = TxOutStats
valueStat {tosNetwork = statSingleton (getNetwork addr)}
       in case Addr
addr of
            AddrBootstrap BootstrapAddress
addrBootstrap ->
              TxOutStats
networkStat {tosBootstrap = statSingleton 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 = statSingleton ptr}
                      StakeRefBase Credential Staking
cred ->
                        TxOutStats
networkStat {tosStakingCredential = statSingleton cred}
               in TxOutStats
stakeStat {tosPaymentCredential = statSingleton 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
usTxInStats :: UTxOStats -> TxInStats
usTxOutStats :: UTxOStats -> TxOutStats
usTxInStats :: TxInStats
usTxOutStats :: TxOutStats
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"UTxOStats"
      [TxInStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TxInStats -> Doc ann
pretty TxInStats
usTxInStats, TxOutStats -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TxOutStats -> Doc ann
pretty TxOutStats
usTxOutStats]

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

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

data AggregateStats = AggregateStats
  { AggregateStats -> Stat (Credential Staking)
gsCredentialStaking :: !(Stat (Credential Staking))
  , AggregateStats -> Stat (KeyHash StakePool)
gsKeyHashStakePool :: !(Stat (KeyHash StakePool))
  , AggregateStats -> Stat (KeyHash GenesisRole)
gsKeyHashGenesis :: !(Stat (KeyHash GenesisRole))
  , 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 GenesisRole)
x3 Stat (KeyHash GenesisDelegate)
x4 Stat (Hash HASH KeyRoleVRF)
x5 Stat ScriptHash
x6) (AggregateStats Stat (Credential Staking)
y1 Stat (KeyHash StakePool)
y2 Stat (KeyHash GenesisRole)
y3 Stat (KeyHash GenesisDelegate)
y4 Stat (Hash HASH KeyRoleVRF)
y5 Stat ScriptHash
y6) =
    Stat (Credential Staking)
-> Stat (KeyHash StakePool)
-> Stat (KeyHash GenesisRole)
-> Stat (KeyHash GenesisDelegate)
-> Stat (Hash HASH KeyRoleVRF)
-> Stat ScriptHash
-> AggregateStats
AggregateStats
      (Stat (Credential Staking)
x1 Stat (Credential Staking)
-> Stat (Credential Staking) -> Stat (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Stat (Credential Staking)
y1)
      (Stat (KeyHash StakePool)
x2 Stat (KeyHash StakePool)
-> Stat (KeyHash StakePool) -> Stat (KeyHash StakePool)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash StakePool)
y2)
      (Stat (KeyHash GenesisRole)
x3 Stat (KeyHash GenesisRole)
-> Stat (KeyHash GenesisRole) -> Stat (KeyHash GenesisRole)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash GenesisRole)
y3)
      (Stat (KeyHash GenesisDelegate)
x4 Stat (KeyHash GenesisDelegate)
-> Stat (KeyHash GenesisDelegate) -> Stat (KeyHash GenesisDelegate)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash GenesisDelegate)
y4)
      (Stat (Hash HASH KeyRoleVRF)
x5 Stat (Hash HASH KeyRoleVRF)
-> Stat (Hash HASH KeyRoleVRF) -> Stat (Hash HASH KeyRoleVRF)
forall a. Semigroup a => a -> a -> a
<> Stat (Hash HASH KeyRoleVRF)
y5)
      (Stat ScriptHash
x6 Stat ScriptHash -> Stat ScriptHash -> Stat ScriptHash
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 GenesisRole)
-> Stat (KeyHash GenesisDelegate)
-> Stat (Hash HASH KeyRoleVRF)
-> Stat ScriptHash
-> AggregateStats
AggregateStats Stat (Credential Staking)
forall a. Monoid a => a
mempty Stat (KeyHash StakePool)
forall a. Monoid a => a
mempty Stat (KeyHash GenesisRole)
forall a. Monoid a => a
mempty Stat (KeyHash GenesisDelegate)
forall a. Monoid a => a
mempty Stat (Hash HASH KeyRoleVRF)
forall a. Monoid a => a
mempty Stat ScriptHash
forall a. Monoid a => a
mempty

instance Pretty AggregateStats where
  pretty :: forall ann. AggregateStats -> Doc ann
pretty AggregateStats {Stat (Hash HASH KeyRoleVRF)
Stat (KeyHash GenesisDelegate)
Stat (KeyHash GenesisRole)
Stat (KeyHash StakePool)
Stat ScriptHash
Stat (Credential Staking)
gsCredentialStaking :: AggregateStats -> Stat (Credential Staking)
gsKeyHashStakePool :: AggregateStats -> Stat (KeyHash StakePool)
gsVerKeyVRF :: AggregateStats -> Stat (Hash HASH KeyRoleVRF)
gsKeyHashGenesis :: AggregateStats -> Stat (KeyHash GenesisRole)
gsKeyHashGenesisDelegate :: AggregateStats -> Stat (KeyHash GenesisDelegate)
gsScriptHash :: AggregateStats -> Stat ScriptHash
gsCredentialStaking :: Stat (Credential Staking)
gsKeyHashStakePool :: Stat (KeyHash StakePool)
gsKeyHashGenesis :: Stat (KeyHash GenesisRole)
gsKeyHashGenesisDelegate :: Stat (KeyHash GenesisDelegate)
gsVerKeyVRF :: Stat (Hash HASH KeyRoleVRF)
gsScriptHash :: Stat ScriptHash
..} =
    Doc ann -> [Doc ann] -> Doc ann
forall ann. Doc ann -> [Doc ann] -> Doc ann
prettyRecord
      Doc ann
"AggregateStats"
      [ Doc ann
"StakingCredential" Doc ann -> Stat (Credential Staking) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (Credential Staking)
gsCredentialStaking
      , Doc ann
"KeyHashStakePool" Doc ann -> Stat (KeyHash StakePool) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash StakePool)
gsKeyHashStakePool
      , Doc ann
"ScriptHash" Doc ann -> Stat ScriptHash -> Doc ann
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 = AggregateStats
forall a. Monoid a => a
mempty {gsCredentialStaking = s}

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

instance AggregateStat (Stat ScriptHash) where
  aggregateStat :: Stat ScriptHash -> AggregateStats
aggregateStat Stat ScriptHash
s = AggregateStats
forall a. Monoid a => a
mempty {gsScriptHash = 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 Set (KeyHash Payment)
forall a. Monoid a => a
mempty Set ScriptHash
forall a. Monoid a => a
mempty Set (KeyHash Staking)
forall a. Monoid a => a
mempty Set ScriptHash
forall a. Monoid a => a
mempty Set Ptr
forall a. Monoid a => a
mempty Set ScriptHash
forall a. Monoid a => a
mempty Set TxId
forall a. Monoid a => a
mempty Set TxIx
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
(Int -> UTxOStats' -> ShowS)
-> (UTxOStats' -> String)
-> ([UTxOStats'] -> ShowS)
-> Show UTxOStats'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOStats' -> ShowS
showsPrec :: Int -> UTxOStats' -> ShowS
$cshow :: UTxOStats' -> String
show :: UTxOStats' -> String
$cshowList :: [UTxOStats'] -> ShowS
showList :: [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 ConwayEra) Void IO ()
collectStats = do
  (uniques, stats) <- ((UTxOUniques, UTxOStats')
 -> (TxIn, BabbageTxOut ConwayEra) -> (UTxOUniques, UTxOStats'))
-> (UTxOUniques, UTxOStats')
-> ConduitT
     (TxIn, BabbageTxOut ConwayEra) Void IO (UTxOUniques, UTxOStats')
forall (m :: * -> *) a b o.
Monad m =>
(a -> b -> a) -> a -> ConduitT b o m a
foldlC (UTxOUniques, UTxOStats')
-> (TxIn, TxOut ConwayEra) -> (UTxOUniques, UTxOStats')
(UTxOUniques, UTxOStats')
-> (TxIn, BabbageTxOut ConwayEra) -> (UTxOUniques, UTxOStats')
collect (UTxOUniques
emptyUniques, UTxOStats'
initStats)
  lift $ reportStats uniques stats
  where
    collect ::
      (UTxOUniques, UTxOStats') ->
      (TxIn, TxOut CurrentEra) ->
      (UTxOUniques, UTxOStats')
    collect :: (UTxOUniques, UTxOStats')
-> (TxIn, TxOut ConwayEra) -> (UTxOUniques, UTxOStats')
collect (u :: UTxOUniques
u@UTxOUniques {Set (KeyHash Payment)
Set (KeyHash Staking)
Set ScriptHash
Set TxIx
Set Ptr
Set TxId
paymentKeys :: UTxOUniques -> Set (KeyHash Payment)
paymentScripts :: UTxOUniques -> Set ScriptHash
stakeKeys :: UTxOUniques -> Set (KeyHash Staking)
stakeScripts :: UTxOUniques -> Set ScriptHash
stakePtrs :: UTxOUniques -> Set Ptr
scripts :: UTxOUniques -> Set ScriptHash
txIds :: UTxOUniques -> Set TxId
txIxs :: UTxOUniques -> Set TxIx
paymentKeys :: Set (KeyHash Payment)
paymentScripts :: Set ScriptHash
stakeKeys :: Set (KeyHash Staking)
stakeScripts :: Set ScriptHash
stakePtrs :: Set Ptr
scripts :: Set ScriptHash
txIds :: Set TxId
txIxs :: Set TxIx
..}, s :: UTxOStats'
s@UTxOStats' {Int
statsTotalTxOuts :: UTxOStats' -> Int
statsByronTxOuts :: UTxOStats' -> Int
statsTotalPaymentKeys :: UTxOStats' -> Int
statsTotalPaymentScripts :: UTxOStats' -> Int
statsTotalStakeKeys :: UTxOStats' -> Int
statsTotalStakeScripts :: UTxOStats' -> Int
statsTotalStakePtrs :: UTxOStats' -> Int
stateTotalStakeNulls :: UTxOStats' -> Int
statsTotalTxOuts :: Int
statsByronTxOuts :: Int
statsTotalPaymentKeys :: Int
statsTotalPaymentScripts :: Int
statsTotalStakeKeys :: Int
statsTotalStakeScripts :: Int
statsTotalStakePtrs :: Int
stateTotalStakeNulls :: Int
..}) (TxIn TxId
txId TxIx
txIx, TxOut ConwayEra
txOut) =
      let u' :: UTxOUniques
u' = UTxOUniques
u {txIds = Set.insert txId txIds, txIxs = Set.insert txIx txIxs}
          s' :: UTxOStats'
s' = UTxOStats'
s {statsTotalTxOuts = statsTotalTxOuts + 1}
          addr :: Addr
addr = TxOut ConwayEra
BabbageTxOut ConwayEra
txOut BabbageTxOut ConwayEra
-> Getting Addr (BabbageTxOut ConwayEra) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. (Addr -> Const Addr Addr)
-> TxOut ConwayEra -> Const Addr (TxOut ConwayEra)
Getting Addr (BabbageTxOut ConwayEra) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut ConwayEra) 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 = stateTotalStakeNulls + 1})
              StakeRefPtr Ptr
ptr ->
                ( UTxOUniques
su {stakePtrs = Set.insert ptr stakePtrs}
                , UTxOStats'
ss {statsTotalStakePtrs = statsTotalStakePtrs + 1}
                )
              StakeRefBase Credential Staking
a
                | KeyHashObj KeyHash Staking
kh <- Credential Staking
a ->
                    ( UTxOUniques
su {stakeKeys = Set.insert kh stakeKeys}
                    , UTxOStats'
ss {statsTotalStakeKeys = statsTotalStakeKeys + 1}
                    )
                | ScriptHashObj ScriptHash
sh <- Credential Staking
a ->
                    ( UTxOUniques
su {stakeScripts = Set.insert sh stakeScripts}
                    , UTxOStats'
ss {statsTotalStakeScripts = statsTotalStakeScripts + 1}
                    )
       in case Addr
addr of
            AddrBootstrap BootstrapAddress
_ ->
              (UTxOUniques
u', UTxOStats'
s' {statsByronTxOuts = statsByronTxOuts + 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.insert kh paymentKeys}
                    , UTxOStats'
s' {statsTotalPaymentKeys = statsTotalPaymentKeys + 1}
                    )
              | ScriptHashObj ScriptHash
kh <- Credential Payment
pc ->
                  StakeReference
-> (UTxOUniques, UTxOStats') -> (UTxOUniques, UTxOStats')
updateStakingStats
                    StakeReference
sr
                    ( UTxOUniques
u' {paymentScripts = Set.insert kh paymentScripts}
                    , UTxOStats'
s' {statsTotalPaymentScripts = statsTotalPaymentScripts + 1}
                    )

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