{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Cardano.Tracing.Metrics
( KESMetricsData (..)
, MaxKESEvolutions (..)
, OperationalCertStartKESPeriod (..)
, HasKESMetricsData (..)
) where
import Cardano.Prelude hiding (All, (:.:))
import Cardano.Crypto.KES.Class (Period)
import Data.SOP.Strict (All, hcmap, K (..), hcollapse)
import Ouroboros.Consensus.Block (ForgeStateInfo)
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.TypeFamilyWrappers (WrapForgeStateInfo (..))
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (OneEraForgeStateInfo (..))
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import Ouroboros.Consensus.Shelley.Node ()
import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
import Shelley.Spec.Ledger.OCert (KESPeriod (..))
data KESMetricsData
= NoKESMetricsData
| TPraosKESMetricsData
!Period
!MaxKESEvolutions
!OperationalCertStartKESPeriod
newtype MaxKESEvolutions = MaxKESEvolutions Word64
newtype OperationalCertStartKESPeriod = OperationalCertStartKESPeriod Period
class HasKESMetricsData blk where
getKESMetricsData :: Proxy blk -> ForgeStateInfo blk -> KESMetricsData
getKESMetricsData Proxy blk
_ ForgeStateInfo blk
_ = KESMetricsData
NoKESMetricsData
instance HasKESMetricsData (ShelleyBlock c) where
getKESMetricsData :: Proxy (ShelleyBlock c)
-> ForgeStateInfo (ShelleyBlock c) -> KESMetricsData
getKESMetricsData Proxy (ShelleyBlock c)
_ ForgeStateInfo (ShelleyBlock c)
forgeStateInfo =
Period
-> MaxKESEvolutions
-> OperationalCertStartKESPeriod
-> KESMetricsData
TPraosKESMetricsData Period
currKesPeriod MaxKESEvolutions
maxKesEvos OperationalCertStartKESPeriod
oCertStartKesPeriod
where
HotKey.KESInfo
{ kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod = KESPeriod Period
startKesPeriod
, kesEvolution :: KESInfo -> Period
kesEvolution = Period
currKesPeriod
, kesEndPeriod :: KESInfo -> KESPeriod
kesEndPeriod = KESPeriod Period
endKesPeriod
} = ForgeStateInfo (ShelleyBlock c)
KESInfo
forgeStateInfo
maxKesEvos :: MaxKESEvolutions
maxKesEvos = Word64 -> MaxKESEvolutions
MaxKESEvolutions (Word64 -> MaxKESEvolutions) -> Word64 -> MaxKESEvolutions
forall a b. (a -> b) -> a -> b
$
Period -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> Word64) -> Period -> Word64
forall a b. (a -> b) -> a -> b
$ Period
endKesPeriod Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
startKesPeriod
oCertStartKesPeriod :: OperationalCertStartKESPeriod
oCertStartKesPeriod = Period -> OperationalCertStartKESPeriod
OperationalCertStartKESPeriod Period
startKesPeriod
instance HasKESMetricsData ByronBlock where
instance All HasKESMetricsData xs => HasKESMetricsData (HardForkBlock xs) where
getKESMetricsData :: Proxy (HardForkBlock xs)
-> ForgeStateInfo (HardForkBlock xs) -> KESMetricsData
getKESMetricsData Proxy (HardForkBlock xs)
_ ForgeStateInfo (HardForkBlock xs)
forgeStateInfo =
NS (K KESMetricsData) xs -> KESMetricsData
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
(NS (K KESMetricsData) xs -> KESMetricsData)
-> (OneEraForgeStateInfo xs -> NS (K KESMetricsData) xs)
-> OneEraForgeStateInfo xs
-> KESMetricsData
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy HasKESMetricsData
-> (forall a.
HasKESMetricsData a =>
WrapForgeStateInfo a -> K KESMetricsData a)
-> NS WrapForgeStateInfo xs
-> NS (K KESMetricsData) xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
(xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
(f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (Proxy HasKESMetricsData
forall k (t :: k). Proxy t
Proxy @HasKESMetricsData) forall a.
HasKESMetricsData a =>
WrapForgeStateInfo a -> K KESMetricsData a
getOne
(NS WrapForgeStateInfo xs -> NS (K KESMetricsData) xs)
-> (OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs)
-> OneEraForgeStateInfo xs
-> NS (K KESMetricsData) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
forall (xs :: [*]).
OneEraForgeStateInfo xs -> NS WrapForgeStateInfo xs
getOneEraForgeStateInfo
(OneEraForgeStateInfo xs -> KESMetricsData)
-> OneEraForgeStateInfo xs -> KESMetricsData
forall a b. (a -> b) -> a -> b
$ OneEraForgeStateInfo xs
ForgeStateInfo (HardForkBlock xs)
forgeStateInfo
where
getOne :: forall blk. HasKESMetricsData blk
=> WrapForgeStateInfo blk
-> K KESMetricsData blk
getOne :: WrapForgeStateInfo blk -> K KESMetricsData blk
getOne = KESMetricsData -> K KESMetricsData blk
forall k a (b :: k). a -> K a b
K (KESMetricsData -> K KESMetricsData blk)
-> (WrapForgeStateInfo blk -> KESMetricsData)
-> WrapForgeStateInfo blk
-> K KESMetricsData blk
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy blk -> ForgeStateInfo blk -> KESMetricsData
forall blk.
HasKESMetricsData blk =>
Proxy blk -> ForgeStateInfo blk -> KESMetricsData
getKESMetricsData (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (ForgeStateInfo blk -> KESMetricsData)
-> (WrapForgeStateInfo blk -> ForgeStateInfo blk)
-> WrapForgeStateInfo blk
-> KESMetricsData
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapForgeStateInfo blk -> ForgeStateInfo blk
forall blk. WrapForgeStateInfo blk -> ForgeStateInfo blk
unwrapForgeStateInfo