voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

ghc metrics probe

This commit is contained in:
voidlizard 2024-11-01 07:00:39 +03:00
parent fe4f8946f8
commit befc867208
2 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
hbs2-peer/app/CheckMetrics.hs
View File

@ -1,17 +1,16 @@
module CheckMetrics where module CheckMetrics where
import HBS2.Prelude.Plated import HBS2.Prelude.Plated
import HBS2.Clock
import PeerLogger import PeerLogger
import Control.Monad
import System.Metrics import System.Metrics
import Data.HashMap.Strict qualified as HashMap import Data.HashMap.Strict qualified as HashMap
import Streaming.Prelude qualified as S
checkMetrics :: MonadIO m => Store -> m () checkMetrics :: MonadIO m => Store -> AnyProbe -> m ()
checkMetrics store = do checkMetrics store probe = do
liftIO $ registerGcMetrics store liftIO $ registerGcMetrics store
@ -26,11 +25,13 @@ checkMetrics store = do
pause @'Seconds 30 pause @'Seconds 30
debug "checkMetrics" debug "checkMetrics"
me <- liftIO $ sampleAll store <&> flip HashMap.intersection supported <&> HashMap.toList me <- liftIO $ sampleAll store <&> flip HashMap.intersection supported <&> HashMap.toList
for_ me $ \(k,v) -> do values <- S.toList_ $ for_ me $ \(k,v) -> do
let vv = case v of vv <- case v of
Gauge x -> pretty x Gauge x -> S.yield (k, fromIntegral x) >> pure (pretty x)
Counter x -> pretty x Counter x -> S.yield (k, fromIntegral x) >> pure (pretty x)
other -> pretty (show other) other -> pure (pretty (show other))
debug $ "metric" <+> pretty k <> colon <+> vv debug $ "metric" <+> pretty k <> colon <+> vv
acceptReport probe values

9
hbs2-peer/app/PeerMain.hs
View File

@ -738,7 +738,9 @@ runPeer opts = respawnOnError opts $ runResourceT do
let tcpProbeWait = runReader (cfgValue @PeerTcpProbeWaitKey) syn let tcpProbeWait = runReader (cfgValue @PeerTcpProbeWaitKey) syn
& fromInteger @(Timeout 'Seconds) . fromMaybe 300 & 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 -- 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 "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) peerThread "peerPingLoop" (peerPingLoop @e conf penv)