Safe Haskell | None |
---|---|
Language | Haskell2010 |
Prometheus is an open-source systems monitoring and alerting toolkit originally built at SoundCloud. Since its inception in 2012, many companies and organizations have adopted Prometheus, and the project has a very active developer and user community. It is now a standalone open source project and maintained independently of any company. To emphasize this and clarify the project's governance structure, Prometheus joined the Cloud Native Computing Foundation in 2016 as the second hosted project after Kubernetes.
This library provides a Haskell client to Prometheus. It supports:
- The metric types counter, gauge and histogram.
- Publishing metrics over HTTP (via WAI middleware).
- Pushing metrics to the Prometheus push gateway.
- Labels, along with dynamic labels.
- Instrumentation, both for internal Prometheus monitoring and GHC statistics.
The library is intended to be easy to use, because instrumentation is already boring enough - the last thing you want is to be 5 pages deep in obscure GHC extensions just to bump a counter!
Here's one example to demonstrate how you could use this library:
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} import Control.Concurrent import Control.Monad import Network.HTTP.Types.Status import Prometheus import System.Random import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp data Metrics = Metrics { iterations ::Counter
, timePerLoop ::Histogram
} main :: IO () main = do (metrics, registry) <-buildRegistry
$ do iterations <-register
"iterations" "Total completed iterations" mempty counter timePerLoop <-register
"time_per_loop" "Distribution of time per loop" mempty (histogram
ioDurationBuckets
) return Metrics{..} forkIO $ Warp.run 8000 $publishRegistryMiddleware
["metrics"] registry $ \req mkRes -> mkRes (Wai.responseLBS notFound404 mempty mempty) forever $time
(timePerLoop metrics) $ do threadDelay =<< randomIOincCounter
(iterations metrics)
- register :: (MonadState Registry m, MonadIO m) => MetricName -> MetricHelp -> HashMap Text Text -> Metric a -> m a
- data RegistrationFailure = MetricCollision {}
- data MetricName
- data MetricHelp
- data Metric a
- addLabel :: Text -> Metric metric -> Metric (Text -> IO metric)
- data Registry
- buildRegistry :: StateT Registry m a -> m (a, Registry)
- publishRegistryMiddleware :: [Text] -> Registry -> Middleware
- pushMetrics :: MonadIO m => Text -> StateT Registry IO (Registry -> m ThreadId)
- data Counter
- counter :: Metric Counter
- incCounter :: MonadIO m => Counter -> m ()
- incCounterBy :: MonadIO m => Counter -> Double -> m ()
- countExceptions :: (MonadMask m, MonadIO m) => Counter -> m a -> m a
- data Gauge
- gauge :: Metric Gauge
- incGauge :: MonadIO m => Gauge -> m ()
- decGauge :: MonadIO m => Gauge -> m ()
- adjustGauge :: MonadIO m => Gauge -> (Double -> Double) -> m ()
- setGauge :: MonadIO m => Gauge -> Double -> m ()
- data Histogram
- histogram :: Buckets -> Metric Histogram
- data Buckets
- linearBuckets :: Double -> Double -> Natural -> Buckets
- exponentialBuckets :: Double -> Double -> Natural -> Buckets
- ioDurationBuckets :: Buckets
- mkBuckets :: Foldable f => f Double -> Buckets
- observe :: MonadIO m => Double -> Histogram -> m ()
- time :: (MonadIO m, MonadMask m) => Histogram -> m a -> m a
Creating & Registering Metrics
:: (MonadState Registry m, MonadIO m) | |
=> MetricName | The name of this metric. |
-> MetricHelp | Descriptive text about what this metric measures. |
-> HashMap Text Text | A map of static labels, that will be applied whenever the metric is sampled.
For dynamic labels (labels that change), see |
-> Metric a | The metric to register. |
-> m a |
data RegistrationFailure Source #
Failures encountered when attempting to register a metric.
MetricCollision | A metric with the given name has already been registered. |
|
data MetricName Source #
The metric name specifies the general feature of a system that is measured
(e.g. http_requests_total
- the total number of HTTP requests received).
It may contain ASCII letters and digits, as well as underscores and colons.
It must match the regex [a-zA-Z_:][a-zA-Z0-9_:]*
.
Note that MetricName
has a IsString
instance. If you enable
{-# LANGUAGE OverloadedStrings #-}
, you can simply use string literals.
See also, the best practice for metric and label naming.
data MetricHelp Source #
User readable help text describing what a given metric represents.
addLabel :: Text -> Metric metric -> Metric (Text -> IO metric) Source #
Append a dynamic label to a metric. A dynamic label is a label that can be assigned different values at runtime. The returned metric is a function from label value to a configured metric. The child metric inherits all of the parent metric's labels.
As an example of where you might
use dynamic labels, consider the metric http_responses_total
, which counts
HTTP responses. If you want to track the status code, you can add a dynamic
label code
:
httpResponsesByCode <- register "http_responses_total" "HTTP responses" mempty (addLabel "code" counter) -- later okResponses <- httpResponsesByCode "200" incCounter okResponses
Registries
buildRegistry :: StateT Registry m a -> m (a, Registry) Source #
Given a computation that registers metrics, assemble a final registry.
This is really just runStateT
, but with a name that has more meaning.
Publishing Metrics
publishRegistryMiddleware :: [Text] -> Registry -> Middleware Source #
Build WAI middleware that responds to GET
requests to path
by streaming
Prometheus metrics. This is the typical way to expose instrumentation,
allowing Prometheus to collect metrics directly from the app by polling.
pushMetrics :: MonadIO m => Text -> StateT Registry IO (Registry -> m ThreadId) Source #
Fork a thread that collects information about the instrumentation process of this application itself. Specifically, the following metrics will be added:
haskell_prometheus_push_latency_seconds
: The latency when pushing metrics to a Pushgatewayhaskell_prometheus_push_interval_seconds
: The interval between pusheshaskell_prometheus_push_exceptions_total
: Total count of exceptions while pushing metrics
Metric Types
Counters
A counter is a cumulative metric that represents a single numerical value that only ever goes up. A counter is typically used to count requests served, tasks completed, errors occurred, etc. Counters should not be used to expose current counts of items whose number can also go down, e.g. the number of currently running threads. Use gauges for this use case.
incCounter :: MonadIO m => Counter -> m () Source #
Increment a counter by 1.
:: MonadIO m | |
=> Counter | |
-> Double | How much to increment a counter by. Note: negative values will be discarded. |
-> m () |
Increment a counter by a particular amount.
countExceptions :: (MonadMask m, MonadIO m) => Counter -> m a -> m a Source #
Instrument some code that may throw exceptions by counting the amount of exceptions thrown. The exception will not be caught, only counted.
Gauges
A gauge is a metric that represents a single numerical value that can arbitrarily go up and down.
Gauges are typically used for measured values like temperatures or current memory usage, but also "counts" that can go up and down, like the number of running threads.
adjustGauge :: MonadIO m => Gauge -> (Double -> Double) -> m () Source #
Apply a function to move a gauge.
Histograms
A histogram samples observations (usually things like request durations or response sizes) and counts them in configurable buckets. It also provides a sum of all observed values.
histogram :: Buckets -> Metric Histogram Source #
Create a new histogram that samples into a specific set of buckets.
The buckets (bins) that a Histrogram
can sample to.
linearBuckets :: Double -> Double -> Natural -> Buckets Source #
linearBuckets start width numBuckets
creates numBuckets
buckets, each
width
wide, where the lowest bucket has an upper bound of start
(assuming width
is positive).
exponentialBuckets :: Double -> Double -> Natural -> Buckets Source #
exponentialBuckets start factor numBuckets
creates numBuckets
buckets,
where the lowest bucket has an upper bound of start
and each following
bucket's upper bound is factor
times the previous bucket's upper bound.
ioDurationBuckets :: Buckets Source #
Pre-defined buckets that are probably suitable for IO operations. Upper-bounds are: 1μs, 10μs, 100μs, 1ms, 10ms, 100ms, 200ms, 300ms, 400ms, 500ms, 600ms, 700ms, 800ms, 900ms, 1s, 2s, 4s, 8s, 16s.
mkBuckets :: Foldable f => f Double -> Buckets Source #
Construct Buckets
from anything list-like containing bucket upper-bounds.
The input list will be sorted, and does not need to be sorted before hand.