diff --git a/hbs2-peer/app/CheckMetrics.hs b/hbs2-peer/app/CheckMetrics.hs index b18d8bd6..fb66bebf 100644 --- a/hbs2-peer/app/CheckMetrics.hs +++ b/hbs2-peer/app/CheckMetrics.hs @@ -1,17 +1,16 @@ module CheckMetrics where import HBS2.Prelude.Plated -import HBS2.Clock import PeerLogger -import Control.Monad import System.Metrics import Data.HashMap.Strict qualified as HashMap +import Streaming.Prelude qualified as S -checkMetrics :: MonadIO m => Store -> m () -checkMetrics store = do +checkMetrics :: MonadIO m => Store -> AnyProbe -> m () +checkMetrics store probe = do liftIO $ registerGcMetrics store @@ -26,11 +25,13 @@ checkMetrics store = do pause @'Seconds 30 debug "checkMetrics" me <- liftIO $ sampleAll store <&> flip HashMap.intersection supported <&> HashMap.toList - for_ me $ \(k,v) -> do - let vv = case v of - Gauge x -> pretty x - Counter x -> pretty x - other -> pretty (show other) + values <- S.toList_ $ for_ me $ \(k,v) -> do + vv <- case v of + Gauge x -> S.yield (k, fromIntegral x) >> pure (pretty x) + Counter x -> S.yield (k, fromIntegral x) >> pure (pretty x) + other -> pure (pretty (show other)) debug $ "metric" <+> pretty k <> colon <+> vv + acceptReport probe values + diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 74f07e94..d1e3caab 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -738,7 +738,9 @@ runPeer opts = respawnOnError opts $ runResourceT do let tcpProbeWait = runReader (cfgValue @PeerTcpProbeWaitKey) syn & fromInteger @(Timeout 'Seconds) . fromMaybe 300 - let addProbe p = liftIO $ atomically $ modifyTVar probes (p:) + let + addProbe :: forall m . MonadIO m => AnyProbe -> m () + addProbe p = liftIO $ atomically $ modifyTVar probes (p:) -- let downloadThreadNum = runReader (cfgValue @PeerDownloadThreadKey) syn & fromMaybe 1 @@ -1140,7 +1142,10 @@ runPeer opts = respawnOnError opts $ runResourceT do peerThread "httpWorker" (httpWorker conf peerMeta denv) - peerThread "checkMetrics" (checkMetrics metrics) + metricsProbe <- newSimpleProbe "ghc.runtime" + addProbe metricsProbe + + peerThread "checkMetrics" (checkMetrics metrics metricsProbe) peerThread "peerPingLoop" (peerPingLoop @e conf penv)