gc-live-mem-stat

.fixme/log

@@ -243,3 +243,6 @@ fixme-set "workflow" "backlog" "G8FMaRmAga"
 (fixme-set "workflow" "test" "6taLaHDEpJ")
 (fixme-set "workflow" "test" "6taLaHDEpJ")
 (fixme-set "workflow" "test" "3YEidKkHwW")
+
+(fixme-set "assigned" "voidlizard" "8TFq4jSHUM")
+(fixme-set "workflow" "test" "8TFq4jSHUM")

docs/devlog.md

@@ -1,6 +1,9 @@
 
 ## 2023-02-28
 
+TODO: gc-live-mem-stat
+  Выводить в лог размер активной памяти
+
 TODO: cache-purge-loop
   выросло количество потребляемой памяти, скорее
   всего, нужно чистить кэши в тредах и в DownloadEnv.

hbs2-peer/app/CheckMetrics.hs

@@ -0,0 +1,38 @@
+module CheckMetrics where
+
+import HBS2.Prelude.Plated
+import HBS2.Clock
+import HBS2.System.Logger.Simple
+
+import Data.Foldable
+import Data.Functor
+import Control.Monad
+-- import GHC.Stats
+import System.Metrics
+import Data.HashMap.Strict qualified as HashMap
+
+
+checkMetrics :: MonadIO m => Store -> m ()
+checkMetrics store = do
+
+  liftIO $ registerGcMetrics store
+
+  let supported = HashMap.fromList $ fmap (,()) [ "rts.gc.current_bytes_used"
+                                                , "rts.gc.max_bytes_used"
+                                                , "rts.gc.cpu_ms"
+                                                , "rts.gc.num_gcs"
+                                                , "rts.gc.bytes_allocated"
+                                                ]
+
+  forever 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)
+
+      debug $ "metric" <+> pretty k <> colon <+> vv
+

hbs2-peer/app/PeerMain.hs

@@ -35,6 +35,7 @@ import DownloadQ
 import PeerInfo
 import PeerConfig
 import Bootstrap
+import CheckMetrics
 
 import Data.Text qualified as Text
 import Data.Foldable (for_)
@@ -60,6 +61,8 @@ import System.Exit
 import System.IO
 import Data.Set (Set)
 import GHC.TypeLits
+import GHC.Stats
+import System.Metrics
 
 defStorageThreads :: Integral a => a
 defStorageThreads = 4
@@ -348,6 +351,9 @@ forKnownPeers m = do
 runPeer :: forall e . e ~ UDP => PeerOpts -> IO ()
 runPeer opts = Exception.handle myException $ do
 
+  metrics <- newStore
+
+
   xdg <- getXdgDirectory XdgData defStorePath <&> fromString
 
   conf <- peerConfigRead (view peerConfig opts)
@@ -531,6 +537,8 @@ runPeer opts = Exception.handle myException $ do
                   debug "sending local peer announce"
                   request localMulticast (PeerAnnounce @e pnonce)
 
+                peerThread (checkMetrics metrics)
+
                 peerThread (peerPingLoop @e)
 
                 peerThread (bootstrapDnsLoop @e conf)

hbs2-peer/hbs2-peer.cabal

@@ -54,6 +54,7 @@ common common-deps
         , vector
         , interpolatedstring-perl6
         , filelock
+        , ekg-core
 
 common shared-properties
   ghc-options:
@@ -67,7 +68,7 @@ common shared-properties
         -- -fno-warn-unused-binds
         -threaded
         -rtsopts
-        "-with-rtsopts=-N4 -A64m -AL256m -I0"
+        "-with-rtsopts=-N4 -A64m -AL256m -I0 -T"
 
 
   default-language:    Haskell2010
@@ -112,6 +113,7 @@ executable hbs2-peer
                     , RPC
                     , PeerTypes
                     , PeerConfig
+                    , CheckMetrics
 
     -- other-extensions:
     build-depends:    base