ghc metrics probe

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
+

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)