{-# 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 hiding (Hash)
import Cardano.Ledger.Mary.Value
import Cardano.Ledger.PoolParams
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.PoolRank
import Cardano.Ledger.State
import Cardano.Ledger.TxIn
import Cardano.Ledger.UMap (rewardMap, sPoolMap)
import qualified Cardano.Ledger.UMap as UM (ptrMap)
import Conduit
import Control.Exception (throwIO)
import Control.Foldl (Fold (..))
import Control.Monad ((<=<))
import Control.SetAlgebra (range)
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. 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. 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
  NewEpochState ConwayEra
ls <- String -> IO (NewEpochState ConwayEra)
readNewEpochState String
fp
  UTxO ConwayEra -> IO (UTxO ConwayEra)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO ConwayEra -> IO (UTxO ConwayEra))
-> UTxO ConwayEra -> IO (UTxO ConwayEra)
forall a b. (a -> b) -> a -> b
$! UTxOState ConwayEra -> UTxO ConwayEra
forall era. UTxOState era -> UTxO era
utxosUtxo (UTxOState ConwayEra -> UTxO ConwayEra)
-> UTxOState ConwayEra -> UTxO ConwayEra
forall a b. (a -> b) -> a -> b
$ LedgerState ConwayEra -> UTxOState ConwayEra
forall era. LedgerState era -> UTxOState era
lsUTxOState (LedgerState ConwayEra -> UTxOState ConwayEra)
-> LedgerState ConwayEra -> UTxOState ConwayEra
forall a b. (a -> b) -> a -> b
$ EpochState ConwayEra -> LedgerState ConwayEra
forall era. EpochState era -> LedgerState era
esLState (EpochState ConwayEra -> LedgerState ConwayEra)
-> EpochState ConwayEra -> LedgerState ConwayEra
forall a b. (a -> b) -> a -> b
$ NewEpochState ConwayEra -> EpochState ConwayEra
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState ConwayEra
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) PoolParams
VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssPoolParams :: VMap VB VB (KeyHash 'StakePool) PoolParams
$sel:ssDelegations:SnapShot :: SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssPoolParams:SnapShot :: SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
$sel:ssStake:SnapShot :: 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) PoolParams -> Stat (KeyHash 'StakePool)
forall k v. Map k v -> Stat k
statMapKeys (VMap VB VB (KeyHash 'StakePool) PoolParams
-> Map (KeyHash 'StakePool) PoolParams
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams)
    , sssPoolParamsStats :: PoolParamsStats
sssPoolParamsStats = (PoolParams -> PoolParamsStats)
-> VMap VB VB (KeyHash 'StakePool) PoolParams -> PoolParamsStats
forall (vv :: * -> *) v m (kv :: * -> *) k.
(Vector vv v, Monoid m) =>
(v -> m) -> VMap kv vv k v -> m
VMap.foldMap PoolParams -> PoolParamsStats
countPoolParamsStats VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams
    }

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

instance Semigroup PoolParamsStats where
  <> :: PoolParamsStats -> PoolParamsStats -> PoolParamsStats
(<>) (PoolParamsStats Stat (KeyHash 'StakePool)
x1 Stat (Credential 'Staking)
x2 Stat (KeyHash 'Staking)
x3) (PoolParamsStats Stat (KeyHash 'StakePool)
y1 Stat (Credential 'Staking)
y2 Stat (KeyHash 'Staking)
y3) =
    Stat (KeyHash 'StakePool)
-> Stat (Credential 'Staking)
-> Stat (KeyHash 'Staking)
-> PoolParamsStats
PoolParamsStats
      (Stat (KeyHash 'StakePool)
x1 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 'Staking)
Stat (KeyHash 'StakePool)
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 'Staking)
Stat (KeyHash 'StakePool)
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 :: PoolParams -> PoolParamsStats
countPoolParamsStats :: PoolParams -> PoolParamsStats
countPoolParamsStats PoolParams {Set (KeyHash 'Staking)
StrictMaybe PoolMetadata
KeyHash 'StakePool
VRFVerKeyHash 'StakePoolVRF
StrictSeq StakePoolRelay
Coin
UnitInterval
RewardAccount
ppId :: KeyHash 'StakePool
ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppPledge :: Coin
ppCost :: Coin
ppMargin :: UnitInterval
ppRewardAccount :: RewardAccount
ppOwners :: Set (KeyHash 'Staking)
ppRelays :: StrictSeq StakePoolRelay
ppMetadata :: StrictMaybe PoolMetadata
ppId :: PoolParams -> KeyHash 'StakePool
ppVrf :: PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppPledge :: PoolParams -> Coin
ppCost :: PoolParams -> Coin
ppMargin :: PoolParams -> UnitInterval
ppRewardAccount :: PoolParams -> RewardAccount
ppOwners :: PoolParams -> Set (KeyHash 'Staking)
ppRelays :: PoolParams -> StrictSeq StakePoolRelay
ppMetadata :: PoolParams -> StrictMaybe PoolMetadata
..} =
  PoolParamsStats
    { ppsPoolId :: Stat (KeyHash 'StakePool)
ppsPoolId = KeyHash 'StakePool -> Stat (KeyHash 'StakePool)
forall a. a -> Stat a
statSingleton KeyHash 'StakePool
ppId
    , ppsRewardAccount :: Stat (Credential 'Staking)
ppsRewardAccount = Credential 'Staking -> Stat (Credential 'Staking)
forall a. a -> Stat a
statSingleton (RewardAccount -> Credential 'Staking
raCredential RewardAccount
ppRewardAccount)
    , ppsOwners :: Stat (KeyHash 'Staking)
ppsOwners = Set (KeyHash 'Staking) -> Stat (KeyHash 'Staking)
forall a. Set a -> Stat a
statSet Set (KeyHash 'Staking)
ppOwners
    }

data RewardUpdateStats = RewardUpdateStats

instance Pretty RewardUpdateStats where
  pretty :: forall ann. RewardUpdateStats -> Doc ann
pretty RewardUpdateStats {} =
    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
nesEL :: forall era. NewEpochState era -> EpochNo
nesBprev :: forall era. NewEpochState era -> BlocksMade
nesBcur :: forall era. NewEpochState era -> BlocksMade
nesRu :: forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesPd :: forall era. NewEpochState era -> PoolDistr
stashedAVVMAddresses :: forall era. NewEpochState era -> StashedAVVMAddresses era
..} =
  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 Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (NewEpochStateStats -> Doc Any) -> NewEpochStateStats -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NewEpochStateStats -> Doc Any
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
esChainAccountState :: forall era. EpochState era -> ChainAccountState
esSnapshots :: forall era. EpochState era -> SnapShots
esNonMyopic :: forall era. EpochState era -> NonMyopic
..} =
  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 'Genesis)
dssKeyHashGenesis :: !(Stat (KeyHash 'Genesis))
  , DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssKeyHashGenesisDelegate :: !(Stat (KeyHash 'GenesisDelegate))
  , DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssHashVerKeyVRF :: !(Stat (VRFVerKeyHash 'GenDelegVRF))
  }

instance Pretty DStateStats where
  pretty :: forall ann. DStateStats -> Doc ann
pretty DStateStats {Stat (KeyHash 'Genesis)
Stat (KeyHash 'GenesisDelegate)
Stat (KeyHash 'StakePool)
Stat (VRFVerKeyHash 'GenDelegVRF)
Stat (Credential 'Staking)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssCredentialStaking :: Stat (Credential 'Staking)
dssDelegations :: Stat (KeyHash 'StakePool)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
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 'Genesis) -> Doc ann
forall a ann. (Typeable a, Pretty a) => Doc ann -> a -> Doc ann
<:> Stat (KeyHash 'Genesis)
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 'Genesis)
Stat (KeyHash 'GenesisDelegate)
Stat (KeyHash 'StakePool)
Stat (VRFVerKeyHash 'GenDelegVRF)
Stat (Credential 'Staking)
dssCredentialStaking :: DStateStats -> Stat (Credential 'Staking)
dssDelegations :: DStateStats -> Stat (KeyHash 'StakePool)
dssKeyHashGenesis :: DStateStats -> Stat (KeyHash 'Genesis)
dssKeyHashGenesisDelegate :: DStateStats -> Stat (KeyHash 'GenesisDelegate)
dssHashVerKeyVRF :: DStateStats -> Stat (VRFVerKeyHash 'GenDelegVRF)
dssCredentialStaking :: Stat (Credential 'Staking)
dssDelegations :: Stat (KeyHash 'StakePool)
dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
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 DState {Map FutureGenDeleg GenDelegPair
InstantaneousRewards
GenDelegs
UMap
dsUnified :: UMap
dsFutureGenDelegs :: Map FutureGenDeleg GenDelegPair
dsGenDelegs :: GenDelegs
dsIRewards :: InstantaneousRewards
dsUnified :: forall era. DState era -> UMap
dsFutureGenDelegs :: forall era. DState era -> Map FutureGenDeleg GenDelegPair
dsGenDelegs :: forall era. DState era -> GenDelegs
dsIRewards :: forall era. DState era -> InstantaneousRewards
..} =
  DStateStats
    { dssCredentialStaking :: Stat (Credential 'Staking)
dssCredentialStaking =
        Map (Credential 'Staking) Coin -> Stat (Credential 'Staking)
forall k v. Map k v -> Stat k
statMapKeys (UMap -> Map (Credential 'Staking) Coin
rewardMap UMap
dsUnified)
          Stat (Credential 'Staking)
-> Stat (Credential 'Staking) -> Stat (Credential 'Staking)
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking) (KeyHash 'StakePool)
-> Stat (Credential 'Staking)
forall k v. Map k v -> Stat k
statMapKeys (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)
          Stat (Credential 'Staking)
-> Stat (Credential 'Staking) -> Stat (Credential 'Staking)
forall a. Semigroup a => a -> a -> a
<> Set (Credential 'Staking) -> Stat (Credential 'Staking)
forall a. Set a -> Stat a
statSet (Map Ptr (Credential 'Staking) -> Set (Credential 'Staking)
forall v k. Ord v => Map k v -> Set v
forall (f :: * -> * -> *) v k. (Basic f, Ord v) => f k v -> Set v
range (UMap -> Map Ptr (Credential 'Staking)
UM.ptrMap UMap
dsUnified))
    , dssDelegations :: Stat (KeyHash 'StakePool)
dssDelegations = Map (Credential 'Staking) (KeyHash 'StakePool)
-> Stat (KeyHash 'StakePool)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (UMap -> Map (Credential 'Staking) (KeyHash 'StakePool)
sPoolMap UMap
dsUnified)
    , dssKeyHashGenesis :: Stat (KeyHash 'Genesis)
dssKeyHashGenesis =
        [KeyHash 'Genesis] -> Stat (KeyHash 'Genesis)
forall a (t :: * -> *). (Ord a, Foldable t) => t a -> Stat a
statFoldable (FutureGenDeleg -> KeyHash 'Genesis
fGenDelegGenKeyHash (FutureGenDeleg -> KeyHash 'Genesis)
-> [FutureGenDeleg] -> [KeyHash 'Genesis]
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 'Genesis)
-> Stat (KeyHash 'Genesis) -> Stat (KeyHash 'Genesis)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'Genesis) GenDelegPair -> Stat (KeyHash 'Genesis)
forall k v. Map k v -> Stat k
statMapKeys (GenDelegs -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash 'Genesis) 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 'Genesis) GenDelegPair -> [GenDelegPair]
forall k a. Map k a -> [a]
Map.elems (GenDelegs -> Map (KeyHash 'Genesis) GenDelegPair
unGenDelegs GenDelegs
dsGenDelegs))
    }

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

instance Pretty PStateStats where
  pretty :: forall ann. PStateStats -> Doc ann
pretty PStateStats {PoolParamsStats
Stat (KeyHash 'StakePool)
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) Coin
Map (KeyHash 'StakePool) EpochNo
Map (KeyHash 'StakePool) PoolParams
psStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: Map (KeyHash 'StakePool) PoolParams
psRetiring :: Map (KeyHash 'StakePool) EpochNo
psDeposits :: Map (KeyHash 'StakePool) Coin
psStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams :: forall era. PState era -> Map (KeyHash 'StakePool) PoolParams
psRetiring :: forall era. PState era -> Map (KeyHash 'StakePool) EpochNo
psDeposits :: forall era. PState era -> Map (KeyHash 'StakePool) Coin
..} =
  PStateStats
    { pssKeyHashStakePool :: Stat (KeyHash 'StakePool)
pssKeyHashStakePool =
        Map (KeyHash 'StakePool) PoolParams -> Stat (KeyHash 'StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) PoolParams
psStakePoolParams
          Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'StakePool) -> Stat (KeyHash 'StakePool)
forall a. Semigroup a => a -> a -> a
<> Map (KeyHash 'StakePool) PoolParams -> Stat (KeyHash 'StakePool)
forall k v. Map k v -> Stat k
statMapKeys Map (KeyHash 'StakePool) PoolParams
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 =
        (PoolParams -> PoolParamsStats)
-> Map (KeyHash 'StakePool) PoolParams -> 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 PoolParams -> PoolParamsStats
countPoolParamsStats Map (KeyHash 'StakePool) PoolParams
psStakePoolParams
          PoolParamsStats -> PoolParamsStats -> PoolParamsStats
forall a. Semigroup a => a -> a -> a
<> (PoolParams -> PoolParamsStats)
-> Map (KeyHash 'StakePool) PoolParams -> 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 PoolParams -> PoolParamsStats
countPoolParamsStats Map (KeyHash 'StakePool) PoolParams
psFutureStakePoolParams
    }

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

instance Pretty LedgerStateStats where
  pretty :: forall ann. LedgerStateStats -> Doc ann
pretty LedgerStateStats {UTxOStats
PStateStats
DStateStats
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 'Genesis)
gsKeyHashGenesis :: !(Stat (KeyHash 'Genesis))
  , AggregateStats -> Stat (KeyHash 'GenesisDelegate)
gsKeyHashGenesisDelegate :: !(Stat (KeyHash 'GenesisDelegate))
  , AggregateStats -> Stat (Hash HASH KeyRoleVRF)
gsVerKeyVRF :: !(Stat (Hash HASH KeyRoleVRF))
  , AggregateStats -> Stat ScriptHash
gsScriptHash :: !(Stat ScriptHash)
  }

instance Semigroup AggregateStats where
  <> :: AggregateStats -> AggregateStats -> AggregateStats
(<>) (AggregateStats Stat (Credential 'Staking)
x1 Stat (KeyHash 'StakePool)
x2 Stat (KeyHash 'Genesis)
x3 Stat (KeyHash 'GenesisDelegate)
x4 Stat (Hash HASH KeyRoleVRF)
x5 Stat ScriptHash
x6) (AggregateStats Stat (Credential 'Staking)
y1 Stat (KeyHash 'StakePool)
y2 Stat (KeyHash 'Genesis)
y3 Stat (KeyHash 'GenesisDelegate)
y4 Stat (Hash HASH KeyRoleVRF)
y5 Stat ScriptHash
y6) =
    Stat (Credential 'Staking)
-> Stat (KeyHash 'StakePool)
-> Stat (KeyHash 'Genesis)
-> Stat (KeyHash 'GenesisDelegate)
-> Stat (Hash HASH KeyRoleVRF)
-> Stat ScriptHash
-> AggregateStats
AggregateStats
      (Stat (Credential 'Staking)
x1 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 'Genesis)
x3 Stat (KeyHash 'Genesis)
-> Stat (KeyHash 'Genesis) -> Stat (KeyHash 'Genesis)
forall a. Semigroup a => a -> a -> a
<> Stat (KeyHash 'Genesis)
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 'Genesis)
-> 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 'Genesis)
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 'Genesis)
Stat (KeyHash 'GenesisDelegate)
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 'Genesis)
gsKeyHashGenesisDelegate :: AggregateStats -> Stat (KeyHash 'GenesisDelegate)
gsScriptHash :: AggregateStats -> Stat ScriptHash
gsCredentialStaking :: Stat (Credential 'Staking)
gsKeyHashStakePool :: Stat (KeyHash 'StakePool)
gsKeyHashGenesis :: Stat (KeyHash 'Genesis)
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
  (UTxOUniques
uniques, UTxOStats'
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)
  IO () -> ConduitT (TxIn, BabbageTxOut ConwayEra) Void IO ()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (TxIn, BabbageTxOut ConwayEra) Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ConduitT (TxIn, BabbageTxOut ConwayEra) Void IO ())
-> IO () -> ConduitT (TxIn, BabbageTxOut ConwayEra) Void IO ()
forall a b. (a -> b) -> a -> b
$ UTxOUniques -> UTxOStats' -> IO ()
reportStats UTxOUniques
uniques UTxOStats'
stats
  where
    collect ::
      (UTxOUniques, UTxOStats') ->
      (TxIn, TxOut CurrentEra) ->
      (UTxOUniques, UTxOStats')
    collect :: (UTxOUniques, UTxOStats')
-> (TxIn, TxOut 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
      ]