diff --git a/example/Main.hs b/example/Main.hs index 73c060d..2434127 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -43,7 +43,7 @@ main = do -- Instrument the app with the prometheus middlware using the default -- `PrometheusSettings`. This will cause the app to dump the metrics when -- the /metrics endpoint is accessed. - run port (P.prometheus P.def app) + run port (P.prometheus P.def {P.prometheusExportFormat = P.OpenMetricsOneZeroZero} app) app :: Wai.Application app request respond = do diff --git a/prometheus-client/src/Prometheus.hs b/prometheus-client/src/Prometheus.hs index 654d4ed..e75489b 100644 --- a/prometheus-client/src/Prometheus.hs +++ b/prometheus-client/src/Prometheus.hs @@ -14,6 +14,7 @@ module Prometheus ( -- * Exporting , exportMetricsAsText +, exportMetricsAsOpenMetrics1 -- * Metrics -- @@ -123,6 +124,8 @@ module Prometheus ( , exponentialBuckets , linearBuckets , getHistogram +, observeWithExemplar +, ExemplarMetadata(..) -- ** Vector -- @@ -200,7 +203,7 @@ module Prometheus ( -- >>> newtype CPUTime = MkCPUTime () -- >>> let info = Info "cpu_time" "The current CPU time" -- >>> let toValue = Data.ByteString.UTF8.fromString . show --- >>> let toSample = Sample "cpu_time" [] . toValue +-- >>> let toSample x = Sample "cpu_time" [] (toValue x) Nothing -- >>> let toSampleGroup = (:[]) . SampleGroup info GaugeType . (:[]) . toSample -- >>> let collectCPUTime = fmap toSampleGroup getCPUTime -- >>> let cpuTimeMetric = Metric (return (MkCPUTime (), collectCPUTime)) diff --git a/prometheus-client/src/Prometheus/Export/Text.hs b/prometheus-client/src/Prometheus/Export/Text.hs index 4cb1019..5928b75 100644 --- a/prometheus-client/src/Prometheus/Export/Text.hs +++ b/prometheus-client/src/Prometheus/Export/Text.hs @@ -2,6 +2,7 @@ module Prometheus.Export.Text ( exportMetricsAsText +, exportMetricsAsOpenMetrics1 ) where import Prometheus.Info @@ -16,7 +17,7 @@ import Data.Monoid ((<>), mempty, mconcat) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T - +import System.Clock -- $setup -- >>> :module +Prometheus @@ -39,10 +40,30 @@ import qualified Data.Text.Encoding as T exportMetricsAsText :: MonadIO m => m BS.ByteString exportMetricsAsText = do samples <- collectMetrics - return $ Build.toLazyByteString $ foldMap exportSampleGroup samples + return $ Build.toLazyByteString $ foldMap (exportSampleGroup TextZeroZeroFour) samples + +-- | Export all registered metrics in the OpenMetrics 1.0.0 format. +-- +-- For the full specification of the format, see the official Prometheus +-- . +-- +-- Note, you MUST set the content-type header to: +-- @application/openmetrics-text; version=1.0.0; charset=utf-8@ +-- for this format. +-- +-- The OpenMetrics spec lists more features than Prometheus actually supports. +-- The only additional benefit of OpenMetrics when using this library is that +-- exemplars are supported. +exportMetricsAsOpenMetrics1 :: MonadIO m => m BS.ByteString +exportMetricsAsOpenMetrics1 = do + samples <- collectMetrics + return $ Build.toLazyByteString $ (foldMap (exportSampleGroup OpenMetricsOneZeroZero) samples) <> Build.byteString "# EOF\n" + +data ExportFormat = TextZeroZeroFour | OpenMetricsOneZeroZero + deriving (Show, Eq, Ord) -exportSampleGroup :: SampleGroup -> Build.Builder -exportSampleGroup (SampleGroup info ty samples) = +exportSampleGroup :: ExportFormat -> SampleGroup -> Build.Builder +exportSampleGroup format (SampleGroup info ty samples) = if null samples then mempty else prefix <> exportedSamples @@ -55,6 +76,7 @@ exportSampleGroup (SampleGroup info ty samples) = , "# TYPE " <> name <> " " <> T.pack (show ty) ] escape '\n' = "\\n" + escape '"' = if format == OpenMetricsOneZeroZero then "\\\"" else "\"" escape '\\' = "\\\\" escape other = T.pack [other] @@ -63,17 +85,39 @@ exportSamples samples = mconcat [ exportSample s <> Build.charUtf8 '\n' | s <- samples ] exportSample :: Sample -> Build.Builder -exportSample (Sample name labels value) = +exportSample (Sample name labels value mExemplar) = Build.byteString (T.encodeUtf8 name) - <> (case labels of + <> buildLabelPairs labels + <> Build.charUtf8 ' ' + <> Build.byteString value + <> case mExemplar of + Nothing -> mempty + Just exemplar -> encodeExemplar exemplar + + where + encodeExemplar :: SampleExemplar -> Build.Builder + encodeExemplar (SampleExemplar labelPairs exemplarValue mTimestamp) = + Build.byteString " # " + <> buildLabelPairs labelPairs + <> Build.charUtf8 ' ' + <> Build.byteString exemplarValue + <> case mTimestamp of + Nothing -> mempty + Just timestamp -> Build.charUtf8 ' ' <> encodeTimespec timestamp + + encodeTimespec :: TimeSpec -> Build.Builder + encodeTimespec timespec = + Build.int64Dec (sec timespec) + <> Build.charUtf8 '.' + <> Build.int64Dec (nsec timespec) + + buildLabelPairs labelPairs = case labelPairs of [] -> mempty l:ls -> Build.charUtf8 '{' <> exportLabel l <> mconcat [ Build.charUtf8 ',' <> exportLabel l' | l' <- ls ] - <> Build.charUtf8 '}') - <> Build.charUtf8 ' ' - <> Build.byteString value + <> Build.charUtf8 '}' exportLabel :: (Text, Text) -> Build.Builder exportLabel (key, value) = diff --git a/prometheus-client/src/Prometheus/Metric.hs b/prometheus-client/src/Prometheus/Metric.hs index f3cbfbc..3914d9f 100644 --- a/prometheus-client/src/Prometheus/Metric.hs +++ b/prometheus-client/src/Prometheus/Metric.hs @@ -5,6 +5,7 @@ module Prometheus.Metric ( , Sample (..) , SampleGroup (..) , SampleType (..) +, SampleExemplar(..) ) where import Prometheus.Info @@ -13,6 +14,7 @@ import Prometheus.Label import Control.DeepSeq import qualified Data.ByteString as BS import Data.Text (Text) +import System.Clock -- | The type of a sample. This corresponds to the 5 types of metrics supported @@ -31,10 +33,16 @@ instance Show SampleType where show HistogramType = "histogram" show UntypedType = "untyped" +-- | A specific example for a metric. Contains key-value pairs for the sample +-- (e.g. a trace_id), the value of the sample encoded as a ByteString, +-- and an optional timestamp. +data SampleExemplar = SampleExemplar LabelPairs BS.ByteString (Maybe TimeSpec) + deriving (Show) + -- | A single value recorded at a moment in time. The sample type contains the --- name of the sample, a list of labels and their values, and the value encoded --- as a ByteString. -data Sample = Sample Text LabelPairs BS.ByteString +-- name of the sample, a list of labels and their values, the value encoded +-- as a ByteString, and an exemplar (counter and histogram only). +data Sample = Sample Text LabelPairs BS.ByteString (Maybe SampleExemplar) deriving (Show) -- | A Sample group is a list of samples that is tagged with meta data diff --git a/prometheus-client/src/Prometheus/Metric/Counter.hs b/prometheus-client/src/Prometheus/Metric/Counter.hs index 239a2e9..38f93b8 100644 --- a/prometheus-client/src/Prometheus/Metric/Counter.hs +++ b/prometheus-client/src/Prometheus/Metric/Counter.hs @@ -77,7 +77,7 @@ getCounter (MkCounter ioref) = liftIO $ IORef.readIORef ioref collectCounter :: Info -> IORef.IORef Double -> IO [SampleGroup] collectCounter info c = do value <- IORef.readIORef c - let sample = Sample (metricName info) [] (BS.fromString $ show value) + let sample = Sample (metricName info) [] (BS.fromString $ show value) Nothing return [SampleGroup info CounterType [sample]] -- | Count the amount of times an action throws any synchronous exception. diff --git a/prometheus-client/src/Prometheus/Metric/Gauge.hs b/prometheus-client/src/Prometheus/Metric/Gauge.hs index c0fd80f..8f0db9a 100644 --- a/prometheus-client/src/Prometheus/Metric/Gauge.hs +++ b/prometheus-client/src/Prometheus/Metric/Gauge.hs @@ -77,5 +77,5 @@ setGaugeToDuration metric io = do collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup] collectGauge info c = do value <- IORef.readIORef c - let sample = Sample (metricName info) [] (BS.fromString $ show value) + let sample = Sample (metricName info) [] (BS.fromString $ show value) Nothing return [SampleGroup info GaugeType [sample]] diff --git a/prometheus-client/src/Prometheus/Metric/Histogram.hs b/prometheus-client/src/Prometheus/Metric/Histogram.hs index e99da74..5188fe6 100644 --- a/prometheus-client/src/Prometheus/Metric/Histogram.hs +++ b/prometheus-client/src/Prometheus/Metric/Histogram.hs @@ -1,5 +1,6 @@ {-# language BangPatterns #-} {-# language OverloadedStrings #-} +{-# language RecordWildCards #-} module Prometheus.Metric.Histogram ( Histogram @@ -8,15 +9,19 @@ module Prometheus.Metric.Histogram ( , defaultBuckets , exponentialBuckets , linearBuckets +, observeWithExemplar +, ExemplarMetadata(..) -- * Exported for testing , BucketCounts(..) , insert +, insertWithExemplar , emptyCounts , getHistogram ) where import Prometheus.Info +import Prometheus.Label import Prometheus.Metric import Prometheus.Metric.Observer import Prometheus.MonadMonitor @@ -31,6 +36,7 @@ import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Numeric (showFFloat) +import System.Clock -- | A histogram. Counts the number of observations that fall within the -- specified buckets. @@ -51,6 +57,20 @@ histogram info buckets = Metric $ do -- | Upper-bound for a histogram bucket. type Bucket = Double +-- | A set of key-value pairs that correlates time series data +-- to a specific trace. +-- +-- The additional timestamp parameter is optional, but it's recommended +-- to more accurately show on a graph when the exemplar occurred. +data ExemplarMetadata = ExemplarMetadata LabelPairs !(Maybe TimeSpec) + deriving (Show) + +data HistogramExemplar = HistogramExemplar { + histExemplarLabelPairs :: LabelPairs +, histExemplarValue :: !Double +, histExemplarTimestamp :: !(Maybe TimeSpec) +} deriving (Show, Eq, Ord) + -- | Current state of a histogram. data BucketCounts = BucketCounts { -- | The sum of all the observations. @@ -61,11 +81,12 @@ data BucketCounts = BucketCounts { -- value is the number of observations less-than-or-equal-to -- that upper bound, but greater than the next lowest upper bound. , histCountsPerBucket :: !(Map.Map Bucket Int) +, histBucketExemplars :: !(Map.Map Bucket (Maybe HistogramExemplar)) } deriving (Show, Eq, Ord) emptyCounts :: [Bucket] -> BucketCounts emptyCounts buckets - | isStrictlyIncreasing buckets = BucketCounts 0 0 $ Map.fromList (zip buckets (repeat 0)) + | isStrictlyIncreasing buckets = BucketCounts 0 0 (Map.fromList (zip buckets (repeat 0))) (Map.fromList (zip buckets (repeat Nothing))) | otherwise = error ("Histogram buckets must be in increasing order, got: " ++ show buckets) where isStrictlyIncreasing xs = and (zipWith (<) xs (tail xs)) @@ -74,6 +95,20 @@ instance Observer Histogram where -- | Add a new observation to a histogram metric. observe h v = withHistogram h (insert v) +-- | Observe that a particular floating point value has occurred. +-- For example, observe that this request took 0.23s. +-- +-- In addition, tracks a set of key-value pairs called an [exemplar](https://grafana.com/docs/grafana/latest/fundamentals/exemplars/) +-- which are used to correlate time series data with traces. +-- +-- Typically the values tracked are "trace_id" and "span_id". +-- +-- This feature is experimental and must be [enabled on the Prometheus server](https://prometheus.io/docs/prometheus/latest/feature_flags/). +-- +-- > withLabel incomingHttpRequestSeconds "Signup_POST" (\hist -> observeWithExemplar hist 1.23 (P.ExemplarMetadata [("trace_id", "12345"), ("span_id", "67890")] Nothing)) +observeWithExemplar :: Histogram -> Double -> ExemplarMetadata -> IO () +observeWithExemplar h v (ExemplarMetadata labelPairs mTimestamp) = withHistogram h (insertWithExemplar v (Just (HistogramExemplar labelPairs v mTimestamp))) + -- | Transform the contents of a histogram. withHistogram :: MonadMonitor m => Histogram -> (BucketCounts -> BucketCounts) -> m () @@ -89,26 +124,36 @@ getHistogram (MkHistogram bucketsTVar) = -- | Record an observation. insert :: Double -> BucketCounts -> BucketCounts -insert value BucketCounts { histTotal = total, histCount = count, histCountsPerBucket = counts } = - BucketCounts (total + value) (count + 1) incCounts - where - incCounts = - case Map.lookupGE value counts of +insert value bucketCounts = insertWithExemplar value Nothing bucketCounts + +insertWithExemplar :: Double -> Maybe HistogramExemplar -> BucketCounts -> BucketCounts +insertWithExemplar value mHistogramExemplar BucketCounts { histTotal = total, histCount = count, histCountsPerBucket = counts, histBucketExemplars = existingExemplarMap } = + let updatedValues = case Map.lookupGE value counts of Nothing -> counts Just (upperBound, _) -> Map.adjust (+1) upperBound counts + updatedLabels = case mHistogramExemplar of + Nothing -> existingExemplarMap + Just newExemplar -> case Map.lookupGE value counts of + Nothing -> existingExemplarMap + Just (upperBound, _) -> Map.insert upperBound (Just newExemplar) existingExemplarMap + + in BucketCounts (total + value) (count + 1) updatedValues updatedLabels + -- | Collect the current state of a histogram. collectHistogram :: Info -> STM.TVar BucketCounts -> IO [SampleGroup] collectHistogram info bucketCounts = STM.atomically $ do - BucketCounts total count counts <- STM.readTVar bucketCounts - let sumSample = Sample (name <> "_sum") [] (bsShow total) - let countSample = Sample (name <> "_count") [] (bsShow count) - let infSample = Sample (name <> "_bucket") [(bucketLabel, "+Inf")] (bsShow count) - let samples = map toSample (cumulativeSum (Map.toAscList counts)) + BucketCounts total count counts mHistExemplarMap <- STM.readTVar bucketCounts + let sumSample = Sample (name <> "_sum") [] (bsShow total) Nothing + let countSample = Sample (name <> "_count") [] (bsShow count) Nothing + let infSample = Sample (name <> "_bucket") [(bucketLabel, "+Inf")] (bsShow count) Nothing + let upperBoundAndCount = cumulativeSum (Map.toAscList counts) + mHistExemplars = map snd (Map.toAscList mHistExemplarMap) + samples = map toSample (zip upperBoundAndCount mHistExemplars) return [SampleGroup info HistogramType $ samples ++ [infSample, sumSample, countSample]] where - toSample (upperBound, count') = - Sample (name <> "_bucket") [(bucketLabel, formatFloat upperBound)] $ bsShow count' + toSample ((upperBound, count'), mHistExemplar) = + Sample (name <> "_bucket") [(bucketLabel, formatFloat upperBound)] (bsShow count') (histExemlarToSampleExemplar <$> mHistExemplar) name = metricName info -- We don't particularly want scientific notation, so force regular @@ -120,6 +165,10 @@ collectHistogram info bucketCounts = STM.atomically $ do bsShow :: Show s => s -> BS.ByteString bsShow = BS.fromString . show + histExemlarToSampleExemplar :: HistogramExemplar -> SampleExemplar + histExemlarToSampleExemplar HistogramExemplar{..} = + SampleExemplar histExemplarLabelPairs (bsShow histExemplarValue) histExemplarTimestamp + -- | The label that defines the upper bound of a bucket of a histogram. @"le"@ -- is short for "less than or equal to". bucketLabel :: Text diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs index dcc5b5d..349a1d4 100644 --- a/prometheus-client/src/Prometheus/Metric/Summary.hs +++ b/prometheus-client/src/Prometheus/Metric/Summary.hs @@ -93,8 +93,8 @@ collectSummary info (MkSummary sketchVar quantiles_) = withMVar sketchVar $ \ske count_ <- ReqSketch.count sketch estimatedQuantileValues <- forM quantiles_ $ \qv -> (,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (toDouble $ fst qv) - let sumSample = Sample (metricName info <> "_sum") [] (bsShow itemSum) - let countSample = Sample (metricName info <> "_count") [] (bsShow count_) + let sumSample = Sample (metricName info <> "_sum") [] (bsShow itemSum) Nothing + let countSample = Sample (metricName info <> "_count") [] (bsShow count_) Nothing return [SampleGroup info SummaryType $ map toSample estimatedQuantileValues ++ [sumSample, countSample]] where bsShow :: Show s => s -> BS.ByteString @@ -102,8 +102,8 @@ collectSummary info (MkSummary sketchVar quantiles_) = withMVar sketchVar $ \ske toSample :: (Rational, Double) -> Sample toSample (q, estimatedValue) = - Sample (metricName info) [("quantile", T.pack . show $ toDouble q)] $ - bsShow estimatedValue + Sample (metricName info) [("quantile", T.pack . show $ toDouble q)] + (bsShow estimatedValue) Nothing toDouble :: Rational -> Double toDouble = fromRational diff --git a/prometheus-client/src/Prometheus/Metric/Vector.hs b/prometheus-client/src/Prometheus/Metric/Vector.hs index 117cc84..b1944f1 100644 --- a/prometheus-client/src/Prometheus/Metric/Vector.hs +++ b/prometheus-client/src/Prometheus/Metric/Vector.hs @@ -67,8 +67,8 @@ collectVector keys ioref = do adjustSamples labels (SampleGroup info ty samples) = SampleGroup info ty (map (prependLabels labels) samples) - prependLabels l (Sample name labels value) = - Sample name (labelPairs keys l ++ labels) value + prependLabels l (Sample name labels value exemplar) = + Sample name (labelPairs keys l ++ labels) value exemplar joinSamples [] = [] joinSamples s@(SampleGroup i t _:_) = [SampleGroup i t (extract s)] diff --git a/prometheus-client/tests/Prometheus/Export/TextSpec.hs b/prometheus-client/tests/Prometheus/Export/TextSpec.hs index ae719d0..20cfc96 100644 --- a/prometheus-client/tests/Prometheus/Export/TextSpec.hs +++ b/prometheus-client/tests/Prometheus/Export/TextSpec.hs @@ -70,6 +70,31 @@ spec = before_ unregisterAll $ after_ unregisterAll $ , "metric_sum 3.0" , "metric_count 3" ]) + it "renders histograms with exemplars" $ do + m <- register $ histogram (Info "metric" "help") defaultBuckets + observeWithExemplar m 1.0 (ExemplarMetadata [("trace_id", "1")] Nothing) + observeWithExemplar m 1.0 (ExemplarMetadata [("trace_id", "2")] Nothing) + observe m 1.0 + result <- exportMetricsAsOpenMetrics1 + result `shouldBe` LT.encodeUtf8 (LT.pack $ unlines [ + "# HELP metric help" + , "# TYPE metric histogram" + , "metric_bucket{le=\"0.005\"} 0" + , "metric_bucket{le=\"0.01\"} 0" + , "metric_bucket{le=\"0.025\"} 0" + , "metric_bucket{le=\"0.05\"} 0" + , "metric_bucket{le=\"0.1\"} 0" + , "metric_bucket{le=\"0.25\"} 0" + , "metric_bucket{le=\"0.5\"} 0" + , "metric_bucket{le=\"1.0\"} 3 # {trace_id=\"2\"} 1.0" + , "metric_bucket{le=\"2.5\"} 3" + , "metric_bucket{le=\"5.0\"} 3" + , "metric_bucket{le=\"10.0\"} 3" + , "metric_bucket{le=\"+Inf\"} 3" + , "metric_sum 3.0" + , "metric_count 3" + , "# EOF" + ]) it "renders vectors" $ do m <- register $ vector ("handler", "method") $ counter (Info "test_counter" "help string") diff --git a/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs b/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs index 1148b12..f33457d 100644 --- a/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs +++ b/prometheus-metrics-ghc/src/Prometheus/Metric/GHC.hs @@ -350,4 +350,4 @@ showCollector :: Show a => Text -> Text -> SampleType -> a -> LabelPairs -> IO [ showCollector name help sampleType value labels = do let info = Info name help let valueBS = BS.fromString $ show value - return [SampleGroup info sampleType [Sample name labels valueBS]] + return [SampleGroup info sampleType [Sample name labels valueBS Nothing]] diff --git a/prometheus-proc/src/Prometheus/Metric/Proc.hs b/prometheus-proc/src/Prometheus/Metric/Proc.hs index 7bf2553..ea5b7d8 100644 --- a/prometheus-proc/src/Prometheus/Metric/Proc.hs +++ b/prometheus-proc/src/Prometheus/Metric/Proc.hs @@ -172,6 +172,7 @@ metric metricName metricHelp metricType value = metricName [] ( fromString ( show value ) ) + Nothing ] diff --git a/wai-middleware-prometheus/src/Network/Wai/Middleware/Prometheus.hs b/wai-middleware-prometheus/src/Network/Wai/Middleware/Prometheus.hs index 34758d1..3f164f7 100644 --- a/wai-middleware-prometheus/src/Network/Wai/Middleware/Prometheus.hs +++ b/wai-middleware-prometheus/src/Network/Wai/Middleware/Prometheus.hs @@ -15,6 +15,8 @@ module Network.Wai.Middleware.Prometheus , instrumentIO , observeSeconds , metricsApp + , metricsAppWithFormat + , ExportFormat(..) ) where import qualified Data.Default as Default @@ -29,6 +31,12 @@ import qualified Network.Wai.Internal as Wai (Response(ResponseRaw)) import qualified Prometheus as Prom import System.Clock (Clock(..), TimeSpec, diffTimeSpec, getTime, toNanoSecs) +-- | What content type to export data in. +-- These formats are nearly identical; the only practical difference +-- is that OpenMetrics supports exemplars and requires this content-type header: +-- @application/openmetrics-text; version=1.0.0; charset=utf-8@ +data ExportFormat = PrometheusText | OpenMetricsOneZeroZero + deriving (Show, Eq, Ord) -- | Settings that control the behavior of the Prometheus middleware. data PrometheusSettings = PrometheusSettings { @@ -44,6 +52,8 @@ data PrometheusSettings = PrometheusSettings { -- ^ Whether the default instrumentation should be applied to the -- middleware that serves the metrics endpoint. The default value is -- True. + , prometheusExportFormat :: ExportFormat + -- ^ Which format to export metrics in. The default value is PrometheusText. } instance Default.Default PrometheusSettings where @@ -51,6 +61,7 @@ instance Default.Default PrometheusSettings where prometheusEndPoint = ["metrics"] , prometheusInstrumentApp = True , prometheusInstrumentPrometheus = True + , prometheusExportFormat = PrometheusText } {-# NOINLINE requestLatency #-} @@ -187,8 +198,8 @@ prometheus PrometheusSettings{..} app req respond = -- "prometheus" can be confused with actual prometheus. then if prometheusInstrumentPrometheus - then instrumentApp "prometheus" (const respondWithMetrics) req respond - else respondWithMetrics respond + then instrumentApp "prometheus" (const (respondWithMetrics prometheusExportFormat)) req respond + else respondWithMetrics prometheusExportFormat respond else if prometheusInstrumentApp then instrumentApp "app" app req respond @@ -196,14 +207,23 @@ prometheus PrometheusSettings{..} app req respond = -- | WAI Application that serves the Prometheus metrics page regardless of --- what the request is. +-- what the request is. Uses the Prometheus text format. metricsApp :: Wai.Application -metricsApp = const respondWithMetrics +metricsApp = const (respondWithMetrics PrometheusText) + +-- | WAI Application that serves the Prometheus metrics page regardless of +-- what the request is. +metricsAppWithFormat :: ExportFormat -> Wai.Application +metricsAppWithFormat format = const (respondWithMetrics format) -respondWithMetrics :: (Wai.Response -> IO Wai.ResponseReceived) +respondWithMetrics :: ExportFormat -> (Wai.Response -> IO Wai.ResponseReceived) -> IO Wai.ResponseReceived -respondWithMetrics respond = do - metrics <- Prom.exportMetricsAsText - respond $ Wai.responseLBS HTTP.status200 headers metrics +respondWithMetrics format respond = do + metrics <- case format of + PrometheusText -> Prom.exportMetricsAsText + OpenMetricsOneZeroZero -> Prom.exportMetricsAsOpenMetrics1 + respond $ Wai.responseLBS HTTP.status200 [(HTTP.hContentType, contentType)] metrics where - headers = [(HTTP.hContentType, "text/plain; version=0.0.4")] + contentType = case format of + PrometheusText -> "text/plain; version=0.0.4" + OpenMetricsOneZeroZero -> "application/openmetrics-text; version=1.0.0; charset=utf-8"