prometheus-effect 1.0.0 → 1.1.0
raw patch · 6 files changed
+251/−46 lines, 6 filesdep +criteriondep +prometheus-effectdep +randomdep −http-streamsdep −io-streamsdep ~basedep ~http-typesnew-component:exe:testPVP ok
version bump matches the API change (PVP)
Dependencies added: criterion, prometheus-effect, random, warp, weigh
Dependencies removed: http-streams, io-streams
Dependency ranges changed: base, http-types
API changes (from Hackage documentation)
- Prometheus.GHC: ghcStats :: (MonadState Registry m, MonadIO m) => m (IO ThreadId)
+ Prometheus.GHC: ghcStats :: (MonadState Registry m, MonadIO m) => m (Maybe (IO ThreadId))
Files
- ChangeLog.md +14/−0
- Prometheus/GHC.hs +49/−43
- bench/Bench.hs +48/−0
- prometheus-effect.cabal +30/−3
- test/Test.hs +64/−0
- weight/Weight.hs +46/−0
ChangeLog.md view
@@ -1,3 +1,17 @@+# 1.1.0++- `Prometheus.GHC.ghcStats` now has the type `m (Maybe (IO ThreadId))`.+ + This was changed to clarify what happens if GC stats aren't enabled, in which case you'll just get `Nothing` back.+ + Don't forget to actually run the stats collector thread though! For example,+ + ```haskell+ (startGhcStats, registry) <- buildRegistry ghcStats+ for_ startGhcStats id+ ```+ + # 1.0.0 Initial release.
Prometheus/GHC.hs view
@@ -7,6 +7,7 @@ import Control.Monad (forever) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State (MonadState)+import Control.Retry import Data.Monoid (mempty) import qualified GHC.Stats as GHC import Prometheus@@ -48,8 +49,18 @@ * @ghc_prometheus_collection_time_seconds@: Amount of time spent by the Prometheus library collecting GHC statistics * @ghc_prometheus_record_time_seconds@: Amount of time spent by the Prometheus library recording GHC statistics -}-ghcStats :: (MonadState Registry m, MonadIO m) => m (IO ThreadId)+ghcStats :: (MonadState Registry m, MonadIO m) => m (Maybe (IO ThreadId)) ghcStats = do+ enabled <- liftIO GHC.getGCStatsEnabled+ case enabled of+ False -> do+ liftIO $ putStrLn "GHC Statisics are not enabled."+ return Nothing+ True ->+ fmap Just mkGhcStats++mkGhcStats :: (MonadState Registry m, MonadIO m) => m (IO ThreadId)+mkGhcStats = do bytesAllocated <- newUnlabelledMetric "ghc_bytes_allocated_total"@@ -151,45 +162,40 @@ "Amount of time spent by the Prometheus library recording GHC statistics" (histogram (exponentialBuckets 1e-12 10 10)) return $- liftIO $- forkIO $ do- enabled <- GHC.getGCStatsEnabled- case enabled of- False -> putStrLn "GHC Statisics are not enabled."- True ->- forever $ do- stats <- time ghcStatsTime GHC.getGCStats- time ghcRecordTime $ do- setGauge bytesAllocated (fromIntegral $ GHC.bytesAllocated stats)- setGauge numGcs (fromIntegral $ GHC.numGcs stats)- setGauge maxBytesUsed (fromIntegral $ GHC.maxBytesUsed stats)- setGauge- numByteUsageSamples- (fromIntegral $ GHC.numByteUsageSamples stats)- setGauge- cumulativeBytesUsed- (fromIntegral $ GHC.cumulativeBytesUsed stats)- setGauge bytesCopied (fromIntegral $ GHC.bytesCopied stats)- setGauge- currentBytesUsed- (fromIntegral $ GHC.currentBytesUsed stats)- setGauge- currentBytesSlop- (fromIntegral $ GHC.currentBytesSlop stats)- setGauge maxBytesSlop (fromIntegral $ GHC.maxBytesSlop stats)- setGauge- peakBytesAllocated- (fromIntegral $ GHC.peakMegabytesAllocated stats * 1000000)- setGauge mutatorCpuSeconds (GHC.mutatorCpuSeconds stats)- setGauge mutatorWallSeconds (GHC.mutatorWallSeconds stats)- setGauge gcCpuSeconds (GHC.gcCpuSeconds stats)- setGauge gcWallSeconds (GHC.gcWallSeconds stats)- setGauge cpuSeconds (GHC.cpuSeconds stats)- setGauge wallSeconds (GHC.wallSeconds stats)- setGauge- parTotBytesCopied- (fromIntegral $ GHC.parTotBytesCopied stats)- setGauge- parMaxBytesCopied- (fromIntegral $ GHC.parMaxBytesCopied stats)- threadDelay 1000000+ forkIO $+ recoverAll (capDelay 60000000 (exponentialBackoff 100)) $ const $ forever $ do+ stats <- time ghcStatsTime GHC.getGCStats+ time ghcRecordTime $ do+ setGauge bytesAllocated (fromIntegral $ GHC.bytesAllocated stats)+ setGauge numGcs (fromIntegral $ GHC.numGcs stats)+ setGauge maxBytesUsed (fromIntegral $ GHC.maxBytesUsed stats)+ setGauge+ numByteUsageSamples+ (fromIntegral $ GHC.numByteUsageSamples stats)+ setGauge+ cumulativeBytesUsed+ (fromIntegral $ GHC.cumulativeBytesUsed stats)+ setGauge bytesCopied (fromIntegral $ GHC.bytesCopied stats)+ setGauge+ currentBytesUsed+ (fromIntegral $ GHC.currentBytesUsed stats)+ setGauge+ currentBytesSlop+ (fromIntegral $ GHC.currentBytesSlop stats)+ setGauge maxBytesSlop (fromIntegral $ GHC.maxBytesSlop stats)+ setGauge+ peakBytesAllocated+ (fromIntegral $ GHC.peakMegabytesAllocated stats * 1000000)+ setGauge mutatorCpuSeconds (GHC.mutatorCpuSeconds stats)+ setGauge mutatorWallSeconds (GHC.mutatorWallSeconds stats)+ setGauge gcCpuSeconds (GHC.gcCpuSeconds stats)+ setGauge gcWallSeconds (GHC.gcWallSeconds stats)+ setGauge cpuSeconds (GHC.cpuSeconds stats)+ setGauge wallSeconds (GHC.wallSeconds stats)+ setGauge+ parTotBytesCopied+ (fromIntegral $ GHC.parTotBytesCopied stats)+ setGauge+ parMaxBytesCopied+ (fromIntegral $ GHC.parMaxBytesCopied stats)+ threadDelay 1000000
+ bench/Bench.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+module Main where++import Control.Monad+import Control.Concurrent+import Criterion+import Criterion.Main+import Prometheus+import System.Mem++data Metrics = Metrics+ { aCounter :: Counter+ , aGauge :: Gauge+ , aHistogram :: Histogram+ }++main :: IO ()+main = do+ (noopMetrics, _) <-+ buildRegistry $ do+ aCounter <- register "noop_counter" "" mempty counter+ aGauge <- register "noop_gauge" "" mempty gauge+ aHistogram <- register "noop_histo" "" mempty (histogram (linearBuckets 1 1 10))+ return Metrics {..}+ (metrics, retainedRegistry) <-+ buildRegistry $ do+ aCounter <- register "counter" "" mempty counter+ aGauge <- register "gauge" "" mempty gauge+ aHistogram <- register "histo" "" mempty (histogram (linearBuckets 1 1 10))+ return Metrics {..}+ performGC+ threadDelay 10000+ putStrLn "Running benchmarks:"+ defaultMainWith defaultConfig $+ [ makeBenchmarks "noop" noopMetrics+ , makeBenchmarks "registered" metrics+ ]+ seq retainedRegistry (return ())++makeBenchmarks groupLabel Metrics {..} =+ bgroup+ groupLabel+ [ bench "incCounter" (nfIO (replicateM_ n $ incCounter aCounter))+ , bench "incGauge" (nfIO (replicateM_ n $ incGauge aGauge))+ , bench "observe" (nfIO (replicateM_ n $ observe 9 aHistogram))+ ]+ where+ n = 10000
prometheus-effect.cabal view
@@ -1,5 +1,5 @@ name: prometheus-effect-version: 1.0.0+version: 1.1.0 synopsis: Instrument applications with metrics and publish/push to Prometheus description: [Prometheus](https://prometheus.io) is an open-source systems monitoring and@@ -24,6 +24,7 @@ build-type: Simple extra-source-files: ChangeLog.md cabal-version: >=1.10+homepage: https://github.com/ocharles/prometheus-effect library exposed-modules: Prometheus@@ -33,9 +34,7 @@ , bytestring , clock , hashable >= 1.2.4.0- , http-streams , http-types >= 0.9.1- , io-streams , mtl , retry , safe-exceptions@@ -52,3 +51,31 @@ default-language: Haskell2010 -- Use -O2 for a 50% performance increase in observe ghc-options: -Wall -O2++executable test+ hs-source-dirs: test+ build-depends: base, warp, prometheus-effect, http-types, wai, random, text+ default-language: Haskell2010+ main-is: Test.hs++test-suite weight+ hs-source-dirs: weight+ build-depends: base+ , weigh+ , prometheus-effect+ , text+ default-language: Haskell2010+ ghc-options: -Wall+ main-is: Weight.hs+ type: exitcode-stdio-1.0++benchmark benchmarks+ hs-source-dirs: bench+ build-depends: base+ , criterion+ , prometheus-effect+ , text+ default-language: Haskell2010+ ghc-options: -Wall+ main-is: Bench.hs+ type: exitcode-stdio-1.0
+ test/Test.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE ApplicativeDo, RecordWildCards, OverloadedStrings #-}+module Main where++import Control.Applicative+import Control.Concurrent+import Data.Foldable+import Data.Monoid+import Data.Text+import Network.HTTP.Types+import Network.Wai+import Network.Wai.Handler.Warp+import Prometheus+import Prometheus.GHC+import System.Random++data Metrics = Metrics+ { testcounter :: Text -> IO Counter+ , testhistogram :: Histogram+ , testcounterTimer :: Histogram+ , testhistogramTimer :: Histogram+ }++main :: IO ()+main = do+ (launchStatsCollection, ghcStatsRegistry) <- buildRegistry ghcStats+ for_ launchStatsCollection id+ (launchPusher, pushRegistry) <-+ buildRegistry (pushMetrics "http://localhost:9091/metrics/job/j/instance/i")+ (Metrics {..}, myRegistry) <-+ buildRegistry $ do+ testcounter <-+ register+ "prom_test_counter"+ "Testing"+ mempty+ (addLabel "test_label" counter)+ testhistogram <-+ register+ "prom_test_histo"+ ""+ mempty+ (histogram (exponentialBuckets 1e-12 10 10))+ testcounterTimer <-+ register+ "prom_incCounter"+ ""+ mempty+ (histogram (exponentialBuckets 1e-12 10 10))+ testhistogramTimer <-+ register+ "prom_observe"+ ""+ mempty+ (histogram (exponentialBuckets 1e-12 10 10))+ return Metrics {..}+ let registry = myRegistry <> ghcStatsRegistry <> pushRegistry+ launchPusher registry+ run 5811 $+ publishRegistryMiddleware ["metrics"] registry $ \req respond -> do+ time testcounterTimer $ do+ incCounter =<< testcounter "foo"+ incCounter =<< testcounter "bar"+ time testhistogramTimer $ observe 1 testhistogram+ respond $ responseLBS status200 [] "Hello World"
+ weight/Weight.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}++module Main where++import Data.Monoid+import Weigh+import Prometheus+import Data.Text+import System.Mem+import Control.Concurrent++data Metrics = Metrics+ { testCounter :: Counter+ , testGauge :: Gauge+ , testHistogram :: Histogram+ , testDyns :: Text -> IO Counter+ }++main :: IO ()+main = do+ (Metrics {..}, registry) <-+ buildRegistry $+ Metrics <$> register "counter" "" mempty counter <*>+ register "gauge" "" mempty gauge <*>+ register "histogram" "" mempty (histogram (linearBuckets 0 1 10))+ <*> register "dyn" "" mempty (addLabel "k" counter)+ performGC+ threadDelay 10000+ incCounter testCounter+ -- putStrLn "Going"+ mainWith $ do+ action "incCounter" (incCounter testCounter)+ action "addCounter" (incCounterBy testCounter 10)+ action "incGauge" (incGauge testGauge)+ action "decGauge" (decGauge testGauge)+ action "resetGauge" (setGauge testGauge 10)+ action "observe" (observe 1 testHistogram)+ action "incDynNew" (testDyns "hello" >>= incCounter)+ action "incDynExisting" (testDyns "hello" >>= incCounter)+ seq registry (return ())+-- action "incCounter" (incCounter c)+-- action "addCounter" (addCounter 10 c)+-- action "incGauge" (incGaugeBy 1 g)+-- action "decGauge" (decGaugeBy 1 g)+-- action "resetGauge" (resetGauge 10 g)+-- action "observe" (observe 1 h)