From b7535679842890f4d366b89f2563624ddce3ffd3 Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Mon, 23 Aug 2021 15:50:16 -0400
Subject: [PATCH 1/7] Implement experimental alternative to existing Summary
algorithm
---
prometheus-client/prometheus-client.cabal | 4 +
.../src/Prometheus/Metric/Summary.hs | 178 ++++--------------
.../tests/Prometheus/Metric/SummarySpec.hs | 68 +------
stack.yaml | 3 +-
4 files changed, 44 insertions(+), 209 deletions(-)
diff --git a/prometheus-client/prometheus-client.cabal b/prometheus-client/prometheus-client.cabal
index 4aa118f..78f10f4 100644
--- a/prometheus-client/prometheus-client.cabal
+++ b/prometheus-client/prometheus-client.cabal
@@ -41,6 +41,7 @@ library
, clock
, containers
, deepseq
+ , primitive
, mtl >=2
, stm >=2.3
, transformers
@@ -48,6 +49,7 @@ library
, utf8-string
, exceptions
, text
+ , data-sketches
ghc-options: -Wall
test-suite doctest
@@ -83,6 +85,8 @@ test-suite spec
, deepseq
, exceptions
, text
+ , primitive
+ , data-sketches
ghc-options: -Wall
benchmark bench
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index 83f3f46..230cf84 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -1,5 +1,7 @@
{-# language BangPatterns #-}
+{-# language DataKinds #-}
{-# language OverloadedStrings #-}
+{-# language TypeApplications #-}
module Prometheus.Metric.Summary (
Summary
@@ -9,15 +11,6 @@ module Prometheus.Metric.Summary (
, observe
, observeDuration
, getSummary
-
-, dumpEstimator
-, emptyEstimator
-, Estimator (..)
-, Item (..)
-, insert
-, compress
-, query
-, invariant
) where
import Prometheus.Info
@@ -25,171 +18,70 @@ import Prometheus.Metric
import Prometheus.Metric.Observer
import Prometheus.MonadMonitor
-import qualified Control.Concurrent.STM as STM
+import Control.Concurrent.MVar
import Control.DeepSeq
+import Control.Monad
import Control.Monad.IO.Class
+import Control.Monad.Primitive
import qualified Data.ByteString.UTF8 as BS
import Data.Foldable (foldr')
import Data.Int (Int64)
import Data.Monoid ((<>))
import qualified Data.Text as T
+import DataSketches.Quantiles.RelativeErrorQuantile
+import qualified DataSketches.Quantiles.RelativeErrorQuantile as ReqSketch
-
-newtype Summary = MkSummary (STM.TVar Estimator)
+data Summary = MkSummary
+ { reqSketch :: MVar (ReqSketch 6 (PrimState IO))
+ , quantiles :: [Quantile]
+ }
instance NFData Summary where
- rnf (MkSummary a) = a `seq` ()
+ rnf (MkSummary a b) = a `seq` b `seq` ()
+
+
+type Quantile = (Rational, Rational)
-- | Creates a new summary metric with a given name, help string, and a list of
-- quantiles. A reasonable set set of quantiles is provided by
-- 'defaultQuantiles'.
summary :: Info -> [Quantile] -> Metric Summary
summary info quantiles = Metric $ do
- valueTVar <- STM.newTVarIO (emptyEstimator quantiles)
- return (MkSummary valueTVar, collectSummary info valueTVar)
-
-withSummary :: MonadMonitor m
- => Summary -> (Estimator -> Estimator) -> m ()
-withSummary (MkSummary !valueTVar) f =
- doIO $ STM.atomically $ do
- STM.modifyTVar' valueTVar compress
- STM.modifyTVar' valueTVar f
+ -- valueTVar <- STM.newTVarIO (emptyEstimator quantiles)
+ mv <- newMVar =<< mkReqSketch @6 HighRanksAreAccurate
+ let summary_ = MkSummary mv quantiles
+ return (summary_, collectSummary info summary_)
instance Observer Summary where
-- | Adds a new observation to a summary metric.
- observe s v = withSummary s (insert v)
+ observe s v = doIO $ withMVar (reqSketch s) (\s -> update s v)
-- | Retrieves a list of tuples containing a quantile and its associated value.
getSummary :: MonadIO m => Summary -> m [(Rational, Double)]
-getSummary (MkSummary valueTVar) = liftIO $ do
- estimator <- STM.atomically $ do
- STM.modifyTVar' valueTVar compress
- STM.readTVar valueTVar
- let quantiles = map fst $ estQuantiles estimator
- let values = map (query estimator) quantiles
- return $ zip quantiles values
-
-collectSummary :: Info -> STM.TVar Estimator -> IO [SampleGroup]
-collectSummary info valueTVar = STM.atomically $ do
- STM.modifyTVar' valueTVar compress
- estimator@(Estimator count itemSum _ _) <- STM.readTVar valueTVar
- let quantiles = map fst $ estQuantiles estimator
- let samples = map (toSample estimator) quantiles
+getSummary (MkSummary sketchVar quantiles) = liftIO $ withMVar sketchVar $ \sketch -> do
+ forM quantiles $ \qv ->
+ (,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (fromRational $ fst qv)
+
+collectSummary :: Info -> Summary -> IO [SampleGroup]
+collectSummary info (MkSummary sketchVar quantiles) = withMVar sketchVar $ \sketch -> do
+ itemSum <- getSum sketch
+ count <- getN 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)
- return [SampleGroup info SummaryType $ samples ++ [sumSample, countSample]]
+ return [SampleGroup info SummaryType $ map toSample estimatedQuantileValues ++ [sumSample, countSample]]
where
bsShow :: Show s => s -> BS.ByteString
bsShow = BS.fromString . show
- toSample estimator q =
+ toSample :: (Rational, Double) -> Sample
+ toSample (q, estimatedValue) =
Sample (metricName info) [("quantile", T.pack . show $ toDouble q)] $
- bsShow $ query estimator q
+ bsShow estimatedValue
toDouble :: Rational -> Double
toDouble = fromRational
-dumpEstimator :: Summary -> IO Estimator
-dumpEstimator (MkSummary valueTVar) =
- STM.atomically $ STM.readTVar valueTVar
-
--- | A quantile is a pair of a quantile value and an associated acceptable error
--- value.
-type Quantile = (Rational, Rational)
-
-data Item = Item {
- itemValue :: Double
-, itemG :: !Int64
-, itemD :: !Int64
-} deriving (Eq, Show)
-
-instance Ord Item where
- compare a b = itemValue a `compare` itemValue b
-
-data Estimator = Estimator {
- estCount :: !Int64
-, estSum :: !Double
-, estQuantiles :: [Quantile]
-, estItems :: [Item]
-} deriving (Show)
-
defaultQuantiles :: [Quantile]
-defaultQuantiles = [(0.5, 0.05), (0.9, 0.01), (0.99, 0.001)]
-
-emptyEstimator :: [Quantile] -> Estimator
-emptyEstimator quantiles = Estimator 0 0 quantiles []
-
-insert :: Double -> Estimator -> Estimator
-insert value estimator@(Estimator oldCount oldSum quantiles items) =
- newEstimator $ insertItem 0 items
- where
- newEstimator = Estimator (oldCount + 1) (oldSum + value) quantiles
-
- insertItem _ [] = [Item value 1 0]
- insertItem r [x]
- -- The first two cases cover the scenario where the initial size of
- -- the list is one.
- | r == 0 && value < itemValue x = Item value 1 0 : [x]
- | r == 0 = x : [Item value 1 0]
- -- The last case covers the scenario where the we have walked off
- -- the end of a list with more than 1 element in the final case of
- -- insertItem in which case we already know that x < value.
- | otherwise = x : [Item value 1 0]
- insertItem r (x:y:xs)
- -- This first case only covers the scenario where value is less than
- -- the first item in a multi-item list. For subsequent steps of
- -- a multi valued list, this case cannot happen as it would have
- -- fallen through to the case below in the previous step.
- | value <= itemValue x = Item value 1 0 : x : y : xs
- | value <= itemValue y = x : Item value 1 (calcD $ r + itemG x)
- : y : xs
- | otherwise = x : insertItem (itemG x + r) (y : xs)
-
- calcD r = max 0
- $ floor (invariant estimator (fromIntegral r)) - 1
-
-
-compress :: Estimator -> Estimator
-compress est@(Estimator _ _ _ []) = est
-compress est@(Estimator _ _ _ items) = est {
- estItems = (minItem :)
- $ foldr' compressPair []
- $ drop 1 -- The exact minimum item must be kept exactly.
- $ zip items
- $ scanl (+) 0 (map itemG items)
- }
- where
- minItem = head items
- compressPair (a, _) [] = [a]
- compressPair (a@(Item _ aG _), r) (b@(Item bVal bG bD):bs)
- | bD == 0 = a : b : bs
- | aG + bG + bD <= inv = Item bVal (aG + bG) bD : bs
- | otherwise = a : b : bs
- where
- inv = floor $ invariant est (fromIntegral r)
-
-query :: Estimator -> Rational -> Double
-query est@(Estimator count _ _ items) q = findQuantile allRs items
- where
- allRs = scanl (+) 0 $ map itemG items
-
- n = fromIntegral count
- f = invariant est
-
- rank = q * n
- bound = rank + (f rank / 2)
-
- findQuantile _ [] = 0 / 0 -- NaN
- findQuantile _ [a] = itemValue a
- findQuantile (_:bR:rs) (a@(Item{}):b@(Item _ bG bD):xs)
- | fromIntegral (bR + bG + bD) > bound = itemValue a
- | otherwise = findQuantile (bR:rs) (b:xs)
- findQuantile _ _ = error "Query impossibility"
-
-invariant :: Estimator -> Rational -> Rational
-invariant (Estimator count _ quantiles _) r = max 1
- $ minimum $ map fj quantiles
- where
- n = fromIntegral count
- fj (q, e) | q * n <= r = 2 * e * r / q
- | otherwise = 2 * e * (n - r) / (1 - q)
+defaultQuantiles = [(0.5, 0.05), (0.9, 0.01), (0.99, 0.001)]
\ No newline at end of file
diff --git a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
index c038cb7..0cc7c34 100644
--- a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
+++ b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
@@ -2,9 +2,6 @@
module Prometheus.Metric.SummarySpec (
spec
-
-, prop_boundedRank
-, prop_invariant
, rankOf
) where
@@ -44,7 +41,6 @@ spec = describe "Prometheus.Metric.Summary" $ do
m <- register $ summary (Info "name" "help") quantiles
mapM_ (m `observe`) observations
checkQuantiles m smallWindowSize =<< getQuantiles quantiles m
- context "Maintains invariants" invariantTests
where
checkBadObservations observations =
it ("computes quantiles correctly for " ++ show observations) $ do
@@ -116,7 +112,7 @@ checkQuantiles :: Summary
-> Double
-> [(Rational, Rational, Double)] -> IO ()
checkQuantiles m windowSize values = do
- estimator <- dumpEstimator m
+ -- estimator <- dumpEstimator m
forM_ values $ \(q, e, actual) -> do
let expected = fromIntegral $ (ceiling $ fromRat q * windowSize :: Int) - 1
let minValue = expected - (fromRat e * windowSize)
@@ -127,9 +123,11 @@ checkQuantiles m windowSize values = do
, " was not within acceptable error range (", show e , "). "
, "Got ", show actual, ", but wanted ", show expected
, " (", show minValue, " <= v <= ", show maxValue, ")."
+ {-
, if estCount estimator <= 100
then "\nEstimator = " ++ show estimator
else ""
+ -}
]
quantiles :: [Quantile]
@@ -143,66 +141,6 @@ getQuantiles qs s = do
where
sortQuantiles = sortBy (\(a, _) (b, _) -> compare a b)
---------------------------------------------------------------------------------
--- QuickCheck tests
-
-invariantTests :: Spec
-invariantTests = do
- it "Maintains g + d is bounded above by the invariant f" $
- property prop_invariant
- it "Compression maintains g + d is bounded above by the invariant f" $
- property prop_invariantAfterCompress
- it "Maintains that rank is bounded by r + g and r + g + d" $
- property prop_boundedRank
- it "Compression maintains that rank is bounded by r + g and r + g + d" $
- property prop_boundedRankAfterCompress
-
-prop_invariant :: NonEmptyList Double -> Property
-prop_invariant (NonEmpty events) =
- let estimator = estimatorAfterObserving events
- rvgds = rvgdsFromEstimator estimator
- in whenFail (putStrLn $ "[(R, V, G, D)] -> " ++ show rvgds) $
- flip all rvgds $ \(r, _, g, d) ->
- let f = invariant estimator (fromIntegral r)
- in fromIntegral (g + d) <= f
-
-prop_invariantAfterCompress :: NonEmptyList Double -> Property
-prop_invariantAfterCompress (NonEmpty events) =
- let estimator = estimatorAfterObserving events
- rvgds = rvgdsFromEstimator $ compress estimator
- in whenFail (putStrLn $ "[(R, V, G, D)] -> " ++ show rvgds) $
- flip all rvgds $ \(r, _, g, d) ->
- let f = invariant estimator (fromIntegral r)
- in fromIntegral (g + d) <= f
-
-prop_boundedRank :: NonEmptyList Double -> Property
-prop_boundedRank (NonEmpty events) =
- let rvgds = rvgdsFromEstimator $ estimatorAfterObserving events
- vs = map (\(_, v, _, _) -> v) rvgds
- in whenFail (putStrLn $ "[(R, V, G, D)] -> " ++ show rvgds) $
- flip all rvgds $ \(r, v, g, d) ->
- let (minRank, maxRank) = rankOf v vs
- in r + g <= maxRank && minRank <= r + g + d
-
-prop_boundedRankAfterCompress :: NonEmptyList Double -> Property
-prop_boundedRankAfterCompress (NonEmpty events) =
- let rvgds = rvgdsFromEstimator $ estimatorAfterObserving events
- vs = map (\(_, v, _, _) -> v) rvgds
- in whenFail (putStrLn $ "[(R, V, G, D)] -> " ++ show rvgds) $
- flip all rvgds $ \(r, v, g, d) ->
- let (minRank, maxRank) = rankOf v vs
- in r + g <= maxRank && minRank <= r + g + d
-
-rvgdsFromEstimator :: Estimator -> [(Int64, Double, Int64, Int64)]
-rvgdsFromEstimator estimator = rvgds
- where
- items = estItems estimator
- rs = scanl (+) 0 $ map itemG items
- rvgds = zipWith (\r (Item v g d) -> (r, v, g, d)) rs items
-
-estimatorAfterObserving :: [Double] -> Estimator
-estimatorAfterObserving = foldr insert (emptyEstimator [(0.5, 0)])
-
-- | Return a tuple that describes the range of that an element's true rank can
-- be in. For example, in the list [0, 0, 0, 1] the result for querying 0 will
-- be (0, 2) and the result for querying 1 will be (3, 3).
diff --git a/stack.yaml b/stack.yaml
index 85060e5..d3dea92 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -7,4 +7,5 @@ packages:
- wai-middleware-prometheus
extra-deps:
- unix-memory-0.1.2
-resolver: lts-12.14
+- data-sketches-0.1.0.0
+resolver: lts-18.5
From 1a02fd828376de50f310bcbddb52ba824c651a0a Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Tue, 24 Aug 2021 14:09:16 -0400
Subject: [PATCH 2/7] Fix tests by using <= as rank criteria
---
.../src/Prometheus/Metric/Summary.hs | 27 +++++++++----------
1 file changed, 13 insertions(+), 14 deletions(-)
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index 230cf84..47c0979 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -2,7 +2,7 @@
{-# language DataKinds #-}
{-# language OverloadedStrings #-}
{-# language TypeApplications #-}
-
+{-# language TypeOperators #-}
module Prometheus.Metric.Summary (
Summary
, Quantile
@@ -24,11 +24,9 @@ import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Primitive
import qualified Data.ByteString.UTF8 as BS
-import Data.Foldable (foldr')
-import Data.Int (Int64)
-import Data.Monoid ((<>))
import qualified Data.Text as T
import DataSketches.Quantiles.RelativeErrorQuantile
+import DataSketches.Quantiles.RelativeErrorQuantile.Types
import qualified DataSketches.Quantiles.RelativeErrorQuantile as ReqSketch
data Summary = MkSummary
@@ -46,30 +44,31 @@ type Quantile = (Rational, Rational)
-- quantiles. A reasonable set set of quantiles is provided by
-- 'defaultQuantiles'.
summary :: Info -> [Quantile] -> Metric Summary
-summary info quantiles = Metric $ do
+summary info quantiles_ = Metric $ do
-- valueTVar <- STM.newTVarIO (emptyEstimator quantiles)
- mv <- newMVar =<< mkReqSketch @6 HighRanksAreAccurate
- let summary_ = MkSummary mv quantiles
+ rs <- mkReqSketch @6 HighRanksAreAccurate
+ mv <- newMVar (rs {criterion = (:<=)})
+ let summary_ = MkSummary mv quantiles_
return (summary_, collectSummary info summary_)
instance Observer Summary where
-- | Adds a new observation to a summary metric.
- observe s v = doIO $ withMVar (reqSketch s) (\s -> update s v)
+ observe s v = doIO $ withMVar (reqSketch s) (`update` v)
-- | Retrieves a list of tuples containing a quantile and its associated value.
getSummary :: MonadIO m => Summary -> m [(Rational, Double)]
-getSummary (MkSummary sketchVar quantiles) = liftIO $ withMVar sketchVar $ \sketch -> do
- forM quantiles $ \qv ->
+getSummary (MkSummary sketchVar quantiles_) = liftIO $ withMVar sketchVar $ \sketch -> do
+ forM quantiles_ $ \qv ->
(,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (fromRational $ fst qv)
collectSummary :: Info -> Summary -> IO [SampleGroup]
-collectSummary info (MkSummary sketchVar quantiles) = withMVar sketchVar $ \sketch -> do
+collectSummary info (MkSummary sketchVar quantiles_) = withMVar sketchVar $ \sketch -> do
itemSum <- getSum sketch
- count <- getN sketch
- estimatedQuantileValues <- forM quantiles $ \qv ->
+ count_ <- getN 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 countSample = Sample (metricName info <> "_count") [] (bsShow count_)
return [SampleGroup info SummaryType $ map toSample estimatedQuantileValues ++ [sumSample, countSample]]
where
bsShow :: Show s => s -> BS.ByteString
From e84c8ef6a7c027bf428107c9250c9a05e726b29b Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Tue, 24 Aug 2021 16:32:19 -0400
Subject: [PATCH 3/7] Update Summary to calculate appropriate precision
requirements
---
.../src/Prometheus/Metric/Summary.hs | 40 ++++++++++++++-----
stack.yaml | 2 +-
2 files changed, 30 insertions(+), 12 deletions(-)
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index 47c0979..bfeccb5 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -26,11 +26,14 @@ import Control.Monad.Primitive
import qualified Data.ByteString.UTF8 as BS
import qualified Data.Text as T
import DataSketches.Quantiles.RelativeErrorQuantile
-import DataSketches.Quantiles.RelativeErrorQuantile.Types
import qualified DataSketches.Quantiles.RelativeErrorQuantile as ReqSketch
+import Data.Maybe (mapMaybe)
+import Prelude hiding (maximum)
+import qualified Prelude
+import Data.Word
-data Summary = MkSummary
- { reqSketch :: MVar (ReqSketch 6 (PrimState IO))
+data Summary = MkSummary
+ { reqSketch :: MVar (ReqSketch (PrimState IO))
, quantiles :: [Quantile]
}
@@ -40,32 +43,47 @@ instance NFData Summary where
type Quantile = (Rational, Rational)
+determineK :: Quantile -> Maybe Word32
+determineK (rank_, acceptableError) = go 4
+ where
+ go k =
+ let rse = relativeStandardError (fromIntegral k) (fromRational rank_) HighRanksAreAccurate 50000
+ in if abs (rse - fromRational rank_) <= fromRational acceptableError
+ then Just k
+ else if k < 1024
+ then go (k + 2)
+ else Nothing
+
+
-- | Creates a new summary metric with a given name, help string, and a list of
-- quantiles. A reasonable set set of quantiles is provided by
-- 'defaultQuantiles'.
summary :: Info -> [Quantile] -> Metric Summary
summary info quantiles_ = Metric $ do
- -- valueTVar <- STM.newTVarIO (emptyEstimator quantiles)
- rs <- mkReqSketch @6 HighRanksAreAccurate
- mv <- newMVar (rs {criterion = (:<=)})
+ rs <- mkReqSketch kInt HighRanksAreAccurate
+ mv <- newMVar $ rs {criterion = (:<=)}
let summary_ = MkSummary mv quantiles_
return (summary_, collectSummary info summary_)
+ where
+ kInt = fromIntegral $ case mapMaybe determineK quantiles_ of
+ [] -> error "Unable to create a Summary meeting the provided quantile precision requirements"
+ xs -> Prelude.maximum xs
instance Observer Summary where
-- | Adds a new observation to a summary metric.
- observe s v = doIO $ withMVar (reqSketch s) (`update` v)
+ observe s v = doIO $ withMVar (reqSketch s) (`ReqSketch.insert` v)
-- | Retrieves a list of tuples containing a quantile and its associated value.
getSummary :: MonadIO m => Summary -> m [(Rational, Double)]
getSummary (MkSummary sketchVar quantiles_) = liftIO $ withMVar sketchVar $ \sketch -> do
- forM quantiles_ $ \qv ->
+ forM quantiles_ $ \qv ->
(,) <$> pure (fst qv) <*> ReqSketch.quantile sketch (fromRational $ fst qv)
collectSummary :: Info -> Summary -> IO [SampleGroup]
collectSummary info (MkSummary sketchVar quantiles_) = withMVar sketchVar $ \sketch -> do
- itemSum <- getSum sketch
- count_ <- getN sketch
- estimatedQuantileValues <- forM quantiles_ $ \qv ->
+ itemSum <- ReqSketch.sum sketch
+ 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_)
diff --git a/stack.yaml b/stack.yaml
index d3dea92..ec9efad 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -7,5 +7,5 @@ packages:
- wai-middleware-prometheus
extra-deps:
- unix-memory-0.1.2
-- data-sketches-0.1.0.0
+- data-sketches-0.3.0.0
resolver: lts-18.5
From 67636ef5fe8484dd4333176f24bbc30989bb1139 Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Tue, 24 Aug 2021 16:35:23 -0400
Subject: [PATCH 4/7] Start determineK with slightly higher accuracy
---
prometheus-client/src/Prometheus/Metric/Summary.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index bfeccb5..bfc5064 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -44,7 +44,7 @@ instance NFData Summary where
type Quantile = (Rational, Rational)
determineK :: Quantile -> Maybe Word32
-determineK (rank_, acceptableError) = go 4
+determineK (rank_, acceptableError) = go 6
where
go k =
let rse = relativeStandardError (fromIntegral k) (fromRational rank_) HighRanksAreAccurate 50000
From 9151269888abffaefa2439e2f67512aa2af0fa33 Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Tue, 24 Aug 2021 16:56:02 -0400
Subject: [PATCH 5/7] Clean up some comments and bump version due to estimator
removal
---
prometheus-client/prometheus-client.cabal | 2 +-
prometheus-client/src/Prometheus/Metric/Summary.hs | 3 ---
prometheus-client/tests/Prometheus/Metric/SummarySpec.hs | 6 ------
prometheus-metrics-ghc/prometheus-metrics-ghc.cabal | 2 +-
prometheus-proc/prometheus-proc.cabal | 2 +-
wai-middleware-prometheus/wai-middleware-prometheus.cabal | 2 +-
6 files changed, 4 insertions(+), 13 deletions(-)
diff --git a/prometheus-client/prometheus-client.cabal b/prometheus-client/prometheus-client.cabal
index 78f10f4..30d4e02 100644
--- a/prometheus-client/prometheus-client.cabal
+++ b/prometheus-client/prometheus-client.cabal
@@ -1,5 +1,5 @@
name: prometheus-client
-version: 1.0.1
+version: 1.1.0
synopsis: Haskell client library for http://prometheus.io.
description: Haskell client library for http://prometheus.io.
homepage: https://github.com/fimad/prometheus-haskell
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index bfc5064..4807179 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -1,8 +1,5 @@
{-# language BangPatterns #-}
-{-# language DataKinds #-}
{-# language OverloadedStrings #-}
-{-# language TypeApplications #-}
-{-# language TypeOperators #-}
module Prometheus.Metric.Summary (
Summary
, Quantile
diff --git a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
index 0cc7c34..a736129 100644
--- a/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
+++ b/prometheus-client/tests/Prometheus/Metric/SummarySpec.hs
@@ -112,7 +112,6 @@ checkQuantiles :: Summary
-> Double
-> [(Rational, Rational, Double)] -> IO ()
checkQuantiles m windowSize values = do
- -- estimator <- dumpEstimator m
forM_ values $ \(q, e, actual) -> do
let expected = fromIntegral $ (ceiling $ fromRat q * windowSize :: Int) - 1
let minValue = expected - (fromRat e * windowSize)
@@ -123,11 +122,6 @@ checkQuantiles m windowSize values = do
, " was not within acceptable error range (", show e , "). "
, "Got ", show actual, ", but wanted ", show expected
, " (", show minValue, " <= v <= ", show maxValue, ")."
- {-
- , if estCount estimator <= 100
- then "\nEstimator = " ++ show estimator
- else ""
- -}
]
quantiles :: [Quantile]
diff --git a/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal b/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal
index bd6c3fb..1debd72 100644
--- a/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal
+++ b/prometheus-metrics-ghc/prometheus-metrics-ghc.cabal
@@ -25,7 +25,7 @@ library
Prometheus.Metric.GHC
build-depends:
base >=4.7 && <5
- , prometheus-client >=1.0.0 && <1.1
+ , prometheus-client >=1.0.0 && <1.2
, utf8-string >=0.3
, text
ghc-options: -Wall
diff --git a/prometheus-proc/prometheus-proc.cabal b/prometheus-proc/prometheus-proc.cabal
index bea4f12..2f9737b 100644
--- a/prometheus-proc/prometheus-proc.cabal
+++ b/prometheus-proc/prometheus-proc.cabal
@@ -20,7 +20,7 @@ library
build-depends: base >=4.10 && <4.15
, directory >= 1.2.5.0 && < 1.4
, filepath >=1.4 && <1.5
- , prometheus-client >= 1.0.0 && < 1.1
+ , prometheus-client >= 1.0.0 && < 1.2
, regex-applicative >=0.3 && <0.4
, text >= 0.7 && < 1.3
, unix >=2.7 && <2.8
diff --git a/wai-middleware-prometheus/wai-middleware-prometheus.cabal b/wai-middleware-prometheus/wai-middleware-prometheus.cabal
index be73a65..b22d45b 100644
--- a/wai-middleware-prometheus/wai-middleware-prometheus.cabal
+++ b/wai-middleware-prometheus/wai-middleware-prometheus.cabal
@@ -29,7 +29,7 @@ library
, clock
, data-default
, http-types
- , prometheus-client >=1.0.0 && <1.1
+ , prometheus-client >=1.0.0 && <1.2
, text >=0.11
, wai >=3.0
ghc-options: -Wall
From 3f1f93cfd7f5f1c253bf539302b3cf0ef6667020 Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Wed, 25 Aug 2021 10:44:35 -0400
Subject: [PATCH 6/7] Fix NFData instance
---
prometheus-client/src/Prometheus/Metric/Summary.hs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index 4807179..6963ea7 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -35,7 +35,7 @@ data Summary = MkSummary
}
instance NFData Summary where
- rnf (MkSummary a b) = a `seq` b `seq` ()
+ rnf (MkSummary a b) = a `seq` b `deepseq` ()
type Quantile = (Rational, Rational)
From eaf7d11d424da78fb8b0058151ce6464605bc120 Mon Sep 17 00:00:00 2001
From: Ian Duncan <ian@mercury.com>
Date: Wed, 25 Aug 2021 22:18:01 -0400
Subject: [PATCH 7/7] Add note about what determineK does
---
prometheus-client/src/Prometheus/Metric/Summary.hs | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/prometheus-client/src/Prometheus/Metric/Summary.hs b/prometheus-client/src/Prometheus/Metric/Summary.hs
index 6963ea7..dcc5b5d 100644
--- a/prometheus-client/src/Prometheus/Metric/Summary.hs
+++ b/prometheus-client/src/Prometheus/Metric/Summary.hs
@@ -40,6 +40,17 @@ instance NFData Summary where
type Quantile = (Rational, Rational)
+-- | K is a parameter divisible by two, in the range 4-1024 used in the RelativeErrorQuantile algorithm to
+-- determine how many items must be retained per compaction section. As the value increases, the accuracy
+-- of the sketch increases as well. This function iterates on the k value starting from 6
+-- (conservative on space, but reasonably accurate) until it finds a K value that satisfies the specified
+-- error bounds for the given quantile. Note: this algorithm maintains highest accuracy for the upper tail
+-- of the quantile when passed the 'HighRanksAreAccurate', sampling out more items at lower ranks during
+-- the compaction process. Thus, extremely tight error bounds on low quantile values may cause this
+-- function to return 'Nothing'.
+--
+-- If another smart constructor was exposed for summary creation, specific k values & LowRanksAreAccurate
+-- could be used to refine accuracy settings to bias towards lower quantiles when retaining accurate samples.
determineK :: Quantile -> Maybe Word32
determineK (rank_, acceptableError) = go 6
where