{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Bcc.Tracing.Metrics
  ( KESMetricsData (..)
  , MaxKESEvolutions (..)
  , OperationalCertStartKESPeriod (..)
  , HasKESMetricsData (..)
  , HasKESInfo (..)
  , ForgingStats (..)
  , ForgeThreadStats (..)
  , mapForgingCurrentThreadStats
  , mapForgingCurrentThreadStats_
  , mapForgingStatsTxsProcessed
  , mkForgingStats
  , threadStatsProjection
  ) where

import           Bcc.Prelude hiding (All, (:.:))

import           Bcc.Crypto.KES.Class (Period)
import           Control.Concurrent.STM
import           Data.IORef (IORef, atomicModifyIORef', newIORef)
import qualified Data.Map.Strict as Map
import           Data.SOP.Strict (All, hcmap, K (..), hcollapse)
import           Shardagnostic.Consensus.Block (ForgeStateInfo, ForgeStateUpdateError)
import           Shardagnostic.Consensus.Cole.Ledger.Block (ColeBlock)
import           Shardagnostic.Consensus.HardFork.Combinator
import           Shardagnostic.Consensus.TypeFamilyWrappers (WrapForgeStateInfo (..), WrapForgeStateUpdateError (..))
import           Shardagnostic.Consensus.HardFork.Combinator.AcrossEras (OneEraForgeStateInfo (..), OneEraForgeStateUpdateError (..))
import           Shardagnostic.Consensus.Sophie.Ledger.Block (SophieBlock)
import           Shardagnostic.Consensus.Sophie.Node ()
import qualified Shardagnostic.Consensus.Sophie.Protocol.HotKey as HotKey
import           Bcc.Protocol.TOptimum.OCert (KESPeriod (..))

-- | KES-related data to be traced as metrics.
data KESMetricsData
  = NoKESMetricsData
  -- ^ The current protocol does not support KES.
  | TOptimumKESMetricsData
      !Period
      -- ^ The current KES period of the hot key, relative to the start KES
      -- period of the operational certificate.
      !MaxKESEvolutions
      -- ^ The configured max KES evolutions.
      !OperationalCertStartKESPeriod
      -- ^ The start KES period of the configured operational certificate.

-- | The maximum number of evolutions that a KES key can undergo before it is
-- considered expired.
newtype MaxKESEvolutions = MaxKESEvolutions Word64

-- | The start KES period of the configured operational certificate.
newtype OperationalCertStartKESPeriod = OperationalCertStartKESPeriod Period

class HasKESMetricsData blk where
  -- Because 'ForgeStateInfo' is a type family, we need a Proxy argument to
  -- disambiguate.
  getKESMetricsData :: Proxy blk -> ForgeStateInfo blk -> KESMetricsData

  -- Default to 'NoKESMetricsData'
  getKESMetricsData Proxy blk
_ ForgeStateInfo blk
_ = KESMetricsData
NoKESMetricsData

instance HasKESMetricsData (SophieBlock c) where
  getKESMetricsData :: Proxy (SophieBlock c)
-> ForgeStateInfo (SophieBlock c) -> KESMetricsData
getKESMetricsData Proxy (SophieBlock c)
_ ForgeStateInfo (SophieBlock c)
forgeStateInfo =
      Period
-> MaxKESEvolutions
-> OperationalCertStartKESPeriod
-> KESMetricsData
TOptimumKESMetricsData 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 (SophieBlock 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 ColeBlock 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 =
      case ForgeStateInfo (HardForkBlock xs)
forgeStateInfo of
        CurrentEraLacksBlockForging _ -> KESMetricsData
NoKESMetricsData
        CurrentEraForgeStateUpdated currentEraForgeStateInfo ->
            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
currentEraForgeStateInfo
    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

class HasKESInfo blk where
  getKESInfo :: Proxy blk -> ForgeStateUpdateError blk -> Maybe HotKey.KESInfo
  getKESInfo Proxy blk
_ ForgeStateUpdateError blk
_ = Maybe KESInfo
forall a. Maybe a
Nothing

instance HasKESInfo (SophieBlock era) where
  getKESInfo :: Proxy (SophieBlock era)
-> ForgeStateUpdateError (SophieBlock era) -> Maybe KESInfo
getKESInfo Proxy (SophieBlock era)
_ (HotKey.KESCouldNotEvolve ki _) = KESInfo -> Maybe KESInfo
forall a. a -> Maybe a
Just KESInfo
ki
  getKESInfo Proxy (SophieBlock era)
_ (HotKey.KESKeyAlreadyPoisoned ki _) = KESInfo -> Maybe KESInfo
forall a. a -> Maybe a
Just KESInfo
ki

instance HasKESInfo ColeBlock

instance All HasKESInfo xs => HasKESInfo (HardForkBlock xs) where
  getKESInfo :: Proxy (HardForkBlock xs)
-> ForgeStateUpdateError (HardForkBlock xs) -> Maybe KESInfo
getKESInfo Proxy (HardForkBlock xs)
_ =
      NS (K (Maybe KESInfo)) xs -> Maybe KESInfo
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
    (NS (K (Maybe KESInfo)) xs -> Maybe KESInfo)
-> (OneEraForgeStateUpdateError xs -> NS (K (Maybe KESInfo)) xs)
-> OneEraForgeStateUpdateError xs
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy HasKESInfo
-> (forall a.
    HasKESInfo a =>
    WrapForgeStateUpdateError a -> K (Maybe KESInfo) a)
-> NS WrapForgeStateUpdateError xs
-> NS (K (Maybe KESInfo)) 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 HasKESInfo
forall k (t :: k). Proxy t
Proxy @HasKESInfo) forall a.
HasKESInfo a =>
WrapForgeStateUpdateError a -> K (Maybe KESInfo) a
getOne
    (NS WrapForgeStateUpdateError xs -> NS (K (Maybe KESInfo)) xs)
-> (OneEraForgeStateUpdateError xs
    -> NS WrapForgeStateUpdateError xs)
-> OneEraForgeStateUpdateError xs
-> NS (K (Maybe KESInfo)) xs
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OneEraForgeStateUpdateError xs -> NS WrapForgeStateUpdateError xs
forall (xs :: [*]).
OneEraForgeStateUpdateError xs -> NS WrapForgeStateUpdateError xs
getOneEraForgeStateUpdateError
   where
    getOne :: forall blk. HasKESInfo blk
           => WrapForgeStateUpdateError blk
           -> K (Maybe HotKey.KESInfo) blk
    getOne :: WrapForgeStateUpdateError blk -> K (Maybe KESInfo) blk
getOne = Maybe KESInfo -> K (Maybe KESInfo) blk
forall k a (b :: k). a -> K a b
K (Maybe KESInfo -> K (Maybe KESInfo) blk)
-> (WrapForgeStateUpdateError blk -> Maybe KESInfo)
-> WrapForgeStateUpdateError blk
-> K (Maybe KESInfo) 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 -> ForgeStateUpdateError blk -> Maybe KESInfo
forall blk.
HasKESInfo blk =>
Proxy blk -> ForgeStateUpdateError blk -> Maybe KESInfo
getKESInfo (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk) (ForgeStateUpdateError blk -> Maybe KESInfo)
-> (WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk)
-> WrapForgeStateUpdateError blk
-> Maybe KESInfo
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk
forall blk.
WrapForgeStateUpdateError blk -> ForgeStateUpdateError blk
unwrapForgeStateUpdateError

-- | This structure stores counters of blockchain-related events,
--   per individual forge thread.
--   These counters are driven by traces.
data ForgingStats
  = ForgingStats
  { ForgingStats -> IORef Int
fsTxsProcessedNum :: !(IORef Int)
    -- ^ Transactions removed from mempool.
  , ForgingStats -> TVar (Map ThreadId (TVar ForgeThreadStats))
fsState           :: !(TVar (Map ThreadId (TVar ForgeThreadStats)))
  , ForgingStats -> TVar Int64
fsBlocksUncoupled :: !(TVar Int64)
    -- ^ Blocks forged since last restart not on the current chain
  }

-- | Per-forging-thread statistics.
data ForgeThreadStats = ForgeThreadStats
  { ForgeThreadStats -> Int
ftsNodeCannotForgeNum        :: !Int
  , ForgeThreadStats -> Int
ftsNodeIsLeaderNum           :: !Int
  , ForgeThreadStats -> Int
ftsBlocksForgedNum           :: !Int
  , ForgeThreadStats -> Int
ftsSlotsMissedNum            :: !Int
    -- ^ Potentially missed slots.  Note that this is not the same as the number
    -- of missed blocks, since this includes all occurences of not reaching a
    -- leadership check decision, whether or not leadership was possible or not.
    --
    -- Also note that when the aggregate total for this metric is reported in the
    -- multi-pool case, it can be much larger than the actual number of slots
    -- occuring since node start, for it is a sum total for all threads.
  , ForgeThreadStats -> Int
ftsLastSlot                  :: !Int
  }

mkForgingStats :: IO ForgingStats
mkForgingStats :: IO ForgingStats
mkForgingStats =
  IORef Int
-> TVar (Map ThreadId (TVar ForgeThreadStats))
-> TVar Int64
-> ForgingStats
ForgingStats
    (IORef Int
 -> TVar (Map ThreadId (TVar ForgeThreadStats))
 -> TVar Int64
 -> ForgingStats)
-> IO (IORef Int)
-> IO
     (TVar (Map ThreadId (TVar ForgeThreadStats))
      -> TVar Int64 -> ForgingStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
    IO
  (TVar (Map ThreadId (TVar ForgeThreadStats))
   -> TVar Int64 -> ForgingStats)
-> IO (TVar (Map ThreadId (TVar ForgeThreadStats)))
-> IO (TVar Int64 -> ForgingStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map ThreadId (TVar ForgeThreadStats)
-> IO (TVar (Map ThreadId (TVar ForgeThreadStats)))
forall a. a -> IO (TVar a)
newTVarIO Map ThreadId (TVar ForgeThreadStats)
forall a. Monoid a => a
mempty
    IO (TVar Int64 -> ForgingStats)
-> IO (TVar Int64) -> IO ForgingStats
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int64 -> IO (TVar Int64)
forall a. a -> IO (TVar a)
newTVarIO Int64
0

mapForgingStatsTxsProcessed ::
     ForgingStats
  -> (Int -> Int)
  -> IO Int
mapForgingStatsTxsProcessed :: ForgingStats -> (Int -> Int) -> IO Int
mapForgingStatsTxsProcessed ForgingStats
fs Int -> Int
f =
  IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (ForgingStats -> IORef Int
fsTxsProcessedNum ForgingStats
fs) ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$
    \Int
txCount -> (Int -> Int -> (Int, Int)) -> Int -> (Int, Int)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (,) (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int
f Int
txCount

mapForgingCurrentThreadStats ::
     ForgingStats
  -> (ForgeThreadStats -> (ForgeThreadStats, a))
  -> IO a
mapForgingCurrentThreadStats :: ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats { TVar (Map ThreadId (TVar ForgeThreadStats))
fsState :: TVar (Map ThreadId (TVar ForgeThreadStats))
fsState :: ForgingStats -> TVar (Map ThreadId (TVar ForgeThreadStats))
fsState } ForgeThreadStats -> (ForgeThreadStats, a)
f = do
  ThreadId
tid <- IO ThreadId
myThreadId
  Map ThreadId (TVar ForgeThreadStats)
allStats <- TVar (Map ThreadId (TVar ForgeThreadStats))
-> IO (Map ThreadId (TVar ForgeThreadStats))
forall a. TVar a -> IO a
readTVarIO TVar (Map ThreadId (TVar ForgeThreadStats))
fsState
  TVar ForgeThreadStats
varStats <- case ThreadId
-> Map ThreadId (TVar ForgeThreadStats)
-> Maybe (TVar ForgeThreadStats)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ThreadId
tid Map ThreadId (TVar ForgeThreadStats)
allStats of
    Maybe (TVar ForgeThreadStats)
Nothing -> do
      TVar ForgeThreadStats
varStats <- ForgeThreadStats -> IO (TVar ForgeThreadStats)
forall a. a -> IO (TVar a)
newTVarIO (ForgeThreadStats -> IO (TVar ForgeThreadStats))
-> ForgeThreadStats -> IO (TVar ForgeThreadStats)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Int -> Int -> ForgeThreadStats
ForgeThreadStats Int
0 Int
0 Int
0 Int
0 Int
0
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Map ThreadId (TVar ForgeThreadStats))
-> (Map ThreadId (TVar ForgeThreadStats)
    -> Map ThreadId (TVar ForgeThreadStats))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map ThreadId (TVar ForgeThreadStats))
fsState ((Map ThreadId (TVar ForgeThreadStats)
  -> Map ThreadId (TVar ForgeThreadStats))
 -> STM ())
-> (Map ThreadId (TVar ForgeThreadStats)
    -> Map ThreadId (TVar ForgeThreadStats))
-> STM ()
forall a b. (a -> b) -> a -> b
$ ThreadId
-> TVar ForgeThreadStats
-> Map ThreadId (TVar ForgeThreadStats)
-> Map ThreadId (TVar ForgeThreadStats)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ThreadId
tid TVar ForgeThreadStats
varStats
      TVar ForgeThreadStats -> IO (TVar ForgeThreadStats)
forall (m :: * -> *) a. Monad m => a -> m a
return TVar ForgeThreadStats
varStats
    Just TVar ForgeThreadStats
varStats ->
      TVar ForgeThreadStats -> IO (TVar ForgeThreadStats)
forall (m :: * -> *) a. Monad m => a -> m a
return TVar ForgeThreadStats
varStats
  STM a -> IO a
forall a. STM a -> IO a
atomically (STM a -> IO a) -> STM a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    ForgeThreadStats
stats <- TVar ForgeThreadStats -> STM ForgeThreadStats
forall a. TVar a -> STM a
readTVar TVar ForgeThreadStats
varStats
    let !(!ForgeThreadStats
stats', a
x) = ForgeThreadStats -> (ForgeThreadStats, a)
f ForgeThreadStats
stats
    TVar ForgeThreadStats -> ForgeThreadStats -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar ForgeThreadStats
varStats ForgeThreadStats
stats'
    a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

mapForgingCurrentThreadStats_ ::
     ForgingStats
  -> (ForgeThreadStats -> ForgeThreadStats)
  -> IO ()
mapForgingCurrentThreadStats_ :: ForgingStats -> (ForgeThreadStats -> ForgeThreadStats) -> IO ()
mapForgingCurrentThreadStats_ ForgingStats
fs ForgeThreadStats -> ForgeThreadStats
f =
  IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ForgingStats
-> (ForgeThreadStats -> (ForgeThreadStats, ())) -> IO ()
forall a.
ForgingStats -> (ForgeThreadStats -> (ForgeThreadStats, a)) -> IO a
mapForgingCurrentThreadStats ForgingStats
fs ((, ()) (ForgeThreadStats -> (ForgeThreadStats, ()))
-> (ForgeThreadStats -> ForgeThreadStats)
-> ForgeThreadStats
-> (ForgeThreadStats, ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ForgeThreadStats -> ForgeThreadStats
f)

threadStatsProjection ::
     ForgingStats
  -> (ForgeThreadStats -> a)
  -> IO [a]
threadStatsProjection :: ForgingStats -> (ForgeThreadStats -> a) -> IO [a]
threadStatsProjection ForgingStats
fs ForgeThreadStats -> a
f = STM [a] -> IO [a]
forall a. STM a -> IO a
atomically (STM [a] -> IO [a]) -> STM [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ do
  Map ThreadId (TVar ForgeThreadStats)
allStats <- TVar (Map ThreadId (TVar ForgeThreadStats))
-> STM (Map ThreadId (TVar ForgeThreadStats))
forall a. TVar a -> STM a
readTVar (ForgingStats -> TVar (Map ThreadId (TVar ForgeThreadStats))
fsState ForgingStats
fs)
  (TVar ForgeThreadStats -> STM a)
-> [TVar ForgeThreadStats] -> STM [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ForgeThreadStats -> a) -> STM ForgeThreadStats -> STM a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForgeThreadStats -> a
f (STM ForgeThreadStats -> STM a)
-> (TVar ForgeThreadStats -> STM ForgeThreadStats)
-> TVar ForgeThreadStats
-> STM a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TVar ForgeThreadStats -> STM ForgeThreadStats
forall a. TVar a -> STM a
readTVar) ([TVar ForgeThreadStats] -> STM [a])
-> [TVar ForgeThreadStats] -> STM [a]
forall a b. (a -> b) -> a -> b
$ Map ThreadId (TVar ForgeThreadStats) -> [TVar ForgeThreadStats]
forall k a. Map k a -> [a]
Map.elems Map ThreadId (TVar ForgeThreadStats)
allStats