diff --git a/.fixme/log b/.fixme/log index d0286448..67a187ff 100644 --- a/.fixme/log +++ b/.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") \ No newline at end of file diff --git a/docs/devlog.md b/docs/devlog.md index c74ec2cb..048d4be4 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -1,6 +1,9 @@ ## 2023-02-28 +TODO: gc-live-mem-stat + Выводить в лог размер активной памяти + TODO: cache-purge-loop выросло количество потребляемой памяти, скорее всего, нужно чистить кэши в тредах и в DownloadEnv. diff --git a/hbs2-peer/app/CheckMetrics.hs b/hbs2-peer/app/CheckMetrics.hs new file mode 100644 index 00000000..bff2f526 --- /dev/null +++ b/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 + diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 76c23eb6..1f298db6 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/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) diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index af574dac..a02f6dcc 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/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