packages feed

statsd-rupp (empty) → 0.1.0.0

raw patch · 8 files changed

+990/−0 lines, 8 filesdep +basedep +bytestringdep +hspecsetup-changed

Dependencies added: base, bytestring, hspec, network, statsd-rupp, unliftio, unordered-containers

Files

+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Changelog for `statsd-rupp`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - 2023-09-02++- Initial release.
+ LICENSE view
@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2023, JP Rupp++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+# statsd-rupp++StatsD client library for Haskell.++It can report both individual samples like simple StatsD clients, and+statistical aggregations like StatsD servers.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/System/Metrics/StatsD.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoFieldSelectors #-}++module System.Metrics.StatsD+  ( StatCounter,+    StatGauge,+    StatTiming,+    StatSet,+    Stats,+    StatConfig (..),+    newStatCounter,+    newStatGauge,+    newStatTiming,+    newStatSet,+    incrementCounter,+    setGauge,+    addTiming,+    newSetElement,+    withStats,+    defStatConfig,+    parseReport,+  )+where++import Control.Monad (MonadPlus (..))+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as C+import Data.HashSet qualified as HashSet+import System.Metrics.StatsD.Internal+  ( Key,+    MetricData (..),+    Report (..),+    Sampling,+    StatConfig (..),+    StatCounter (..),+    StatGauge (..),+    StatSet (..),+    StatTiming (..),+    Stats,+    Value (..),+    newMetric,+    newStats,+    processSample,+    statsLoop,+    validateKey,+  )+import Text.Read (readMaybe)+import UnliftIO (MonadIO, MonadUnliftIO)+import UnliftIO.Async (link, withAsync)++defStatConfig :: StatConfig+defStatConfig =+  StatConfig+    { reportStats = True,+      reportSamples = True,+      namespace = "",+      statsPrefix = "stats",+      prefixCounter = "counters",+      prefixTimer = "timers",+      prefixGauge = "gauges",+      prefixSet = "sets",+      server = "127.0.0.1",+      port = 8125,+      flushInterval = 1000,+      timingPercentiles = [90, 95],+      newline = False+    }++newStatCounter ::+  (MonadIO m) => Stats -> Key -> Sampling -> m (Maybe StatCounter)+newStatCounter stats key sampling = do+  success <- newMetric stats key (CounterData 0)+  if success+    then return $ Just $ StatCounter stats key sampling+    else return Nothing++newStatGauge ::+  (MonadIO m) => Stats -> Key -> Int -> Int -> m (Maybe StatGauge)+newStatGauge stats key sampling ini = do+  success <- newMetric stats key (GaugeData ini)+  if success+    then return $ Just $ StatGauge stats key sampling+    else return Nothing++newStatTiming :: (MonadIO m) => Stats -> Key -> Int -> m (Maybe StatTiming)+newStatTiming stats key sampling = do+  success <- newMetric stats key (TimingData [])+  if success+    then return $ Just $ StatTiming stats key sampling+    else return Nothing++newStatSet :: (MonadIO m) => Stats -> Key -> m (Maybe StatSet)+newStatSet stats key = do+  success <- newMetric stats key (SetData HashSet.empty)+  if success+    then return $ Just $ StatSet stats key+    else return Nothing++incrementCounter :: (MonadIO m) => StatCounter -> Int -> m ()+incrementCounter StatCounter {..} =+  processSample stats sampling key . Counter++setGauge :: (MonadIO m) => StatGauge -> Int -> m ()+setGauge StatGauge {..} =+  processSample stats sampling key . Gauge++addTiming :: (MonadIO m) => StatTiming -> Int -> m ()+addTiming StatTiming {..} =+  processSample stats sampling key . Timing++newSetElement :: (MonadIO m) => StatSet -> String -> m ()+newSetElement StatSet {..} =+  processSample stats 1 key . Set++withStats :: (MonadUnliftIO m) => StatConfig -> (Stats -> m a) -> m a+withStats cfg go = do+  stats <- newStats cfg+  if cfg.reportStats+    then withAsync (statsLoop stats) (\a -> link a >> go stats)+    else go stats++parseReport :: (MonadPlus m) => ByteString -> m Report+parseReport bs =+  case C.split '|' bs of+    [kv, t] -> do+      (k, v) <- parseKeyValue kv t+      return $ Report k v 1+    [kv, t, r] -> do+      (k, v) <- parseKeyValue kv t+      x <- parseRate r+      return $ Report k v x+    _ -> mzero+  where+    parseRead :: (MonadPlus m, Read a) => String -> m a+    parseRead = maybe mzero return . readMaybe+    parseKeyValue kv t = do+      case C.split ':' kv of+        [k, v] -> do+          key <- parseKey k+          value <- parseValue v t+          return (key, value)+        _ -> mzero+    parseKey k =+      let s = C.unpack k+       in if validateKey s+            then return s+            else mzero+    parseValue v t =+      let s = C.unpack v+       in case t of+            "c" -> Counter <$> parseRead s+            "g" -> Gauge <$> parseRead s+            "s" -> return $ Set s+            "ms" -> Timing <$> parseRead s+            _ -> mzero+    parseRate r = case C.unpack r of+      '@' : s -> parseRead s+      _ -> mzero
+ src/System/Metrics/StatsD/Internal.hs view
@@ -0,0 +1,469 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoFieldSelectors #-}++module System.Metrics.StatsD.Internal+  ( Stats (..),+    StatConfig (..),+    Key,+    Index,+    Sampling,+    Counter,+    Gauge,+    Timing,+    SetElement,+    TimingData,+    SetData,+    MetricData (..),+    Store (..),+    Metrics,+    Value (..),+    Sample (..),+    Report (..),+    StatCounter (..),+    StatGauge (..),+    StatTiming (..),+    StatSet (..),+    addMetric,+    newMetric,+    validateKey,+    addReading,+    newReading,+    processSample,+    newStats,+    statsLoop,+    statsFlush,+    flushStats,+    catKey,+    statReports,+    TimingStats (..),+    makeTimingStats,+    extractPercentiles,+    timingReports,+    trimPercentile,+    percentileSuffix,+    timingStats,+    cumulativeSums,+    cumulativeSquares,+    stdev,+    mean,+    median,+    flush,+    toReport,+    format,+    submit,+    connectStatsD,+  )+where++import Control.Monad (forM_, forever, when)+import Data.ByteString.Char8 qualified as C+import Data.Char (isAlphaNum, isAscii)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet (HashSet)+import Data.HashSet qualified as HashSet+import Data.List (intercalate, sort)+import Network.Socket (Socket)+import Network.Socket qualified as Net+import Network.Socket.ByteString qualified as Net+import Text.Printf (printf)+import UnliftIO (MonadIO, liftIO)+import UnliftIO.Concurrent (threadDelay)+import UnliftIO.STM+  ( STM,+    TVar,+    atomically,+    modifyTVar,+    newTVarIO,+    readTVar,+    stateTVar,+  )++type Key = String++data Stats = Stats+  { metrics :: !(TVar Metrics),+    cfg :: !StatConfig,+    socket :: !Socket+  }++data StatConfig = StatConfig+  { reportStats :: !Bool,+    reportSamples :: !Bool,+    namespace :: !String,+    statsPrefix :: !String,+    prefixCounter :: !String,+    prefixTimer :: !String,+    prefixGauge :: !String,+    prefixSet :: !String,+    server :: !String,+    port :: !Int,+    flushInterval :: !Int,+    timingPercentiles :: ![Int],+    newline :: !Bool+  }+  deriving (Show, Read, Eq, Ord)++type Index = Int++type Sampling = Int++type Counter = Int++type Gauge = Int++type Timing = Int++type SetElement = String++type TimingData = [Int]++type SetData = HashSet String++data MetricData+  = CounterData !Counter+  | GaugeData !Gauge+  | TimingData !TimingData+  | SetData !(HashSet String)++data Store = Store+  { index :: !Index,+    dat :: !(Maybe MetricData)+  }++type Metrics = HashMap Key Store++data Value+  = Counter !Counter+  | Gauge !Gauge+  | Timing !Timing+  | Set !SetElement+  | Metric !Int+  | Other !String !String+  deriving (Eq, Ord, Show, Read)++data Report = Report+  { key :: !Key,+    value :: !Value,+    rate :: !Double+  }+  deriving (Eq, Ord, Show, Read)++data Sample = Sample+  { key :: !Key,+    value :: !Value,+    sampling :: !Sampling,+    index :: !Index+  }+  deriving (Eq, Ord, Show, Read)++data StatCounter = StatCounter+  { stats :: !Stats,+    key :: !Key,+    sampling :: !Sampling+  }++data StatGauge = StatGauge+  { stats :: !Stats,+    key :: !Key,+    sampling :: !Sampling+  }++data StatTiming = StatTiming+  { stats :: !Stats,+    key :: !Key,+    sampling :: !Sampling+  }++data StatSet = StatSet+  { stats :: !Stats,+    key :: !Key+  }++addMetric :: StatConfig -> Key -> MetricData -> Metrics -> Metrics+addMetric cfg key md =+  HashMap.insert key $+    Store 0 $+      if cfg.reportStats+        then Just md+        else Nothing++newMetric :: (MonadIO m) => Stats -> Key -> MetricData -> m Bool+newMetric stats key store+  | validateKey key =+      atomically $ do+        exists <- HashMap.member key <$> readTVar stats.metrics+        if exists+          then return False+          else do+            modifyTVar stats.metrics (addMetric stats.cfg key store)+            return True+  | otherwise = return False++validateKey :: String -> Bool+validateKey t = not (null t) && all valid t+  where+    valid c = elem c ("._-" :: [Char]) || isAscii c && isAlphaNum c++addReading :: Value -> Key -> Metrics -> Metrics+addReading reading = HashMap.adjust adjust+  where+    adjust m = m {index = m.index + 1, dat = change <$> m.dat}+    change store = case (reading, store) of+      (Counter c, CounterData s) -> CounterData (s + c)+      (Gauge i, GaugeData _) -> GaugeData i+      (Timing t, TimingData s) -> TimingData (t : s)+      (Set e, SetData s) -> SetData (HashSet.insert e s)+      _ -> error "Stats reading mismatch"++newReading :: Stats -> Key -> Value -> STM Int+newReading stats key reading = do+  modifyTVar stats.metrics (addReading reading key)+  maybe 0 (.index) . HashMap.lookup key <$> readTVar stats.metrics++processSample ::+  (MonadIO m) => Stats -> Sampling -> Key -> Value -> m ()+processSample stats sampling key val = do+  idx <- atomically $ newReading stats key val+  when stats.cfg.reportSamples $+    submit stats $+      Sample key val sampling idx++newStats :: (MonadIO m) => StatConfig -> m Stats+newStats cfg = do+  m <- newTVarIO HashMap.empty+  h <- connectStatsD cfg.server cfg.port+  return $ Stats m cfg h++statsLoop :: (MonadIO m) => Stats -> m ()+statsLoop stats = forever $ do+  threadDelay $ stats.cfg.flushInterval * 1000+  statsFlush stats++statsFlush :: (MonadIO m) => Stats -> m ()+statsFlush stats = do+  reports <-+    atomically $+      stateTVar stats.metrics (flushStats stats.cfg)+  mapM_ (send stats) reports++flushStats :: StatConfig -> Metrics -> ([Report], Metrics)+flushStats cfg metrics =+  let f xs key m = maybe xs ((<> xs) . statReports cfg key) m.dat+      rs = HashMap.foldlWithKey' f [] metrics+      g m = m {dat = flush <$> m.dat}+      ms = HashMap.map g metrics+   in (rs, ms)++catKey :: [Key] -> Key+catKey = intercalate "." . filter (not . null)++statReports :: StatConfig -> Key -> MetricData -> [Report]+statReports cfg key dat = case dat of+  CounterData c ->+    [ Report+        { key = catKey [cfg.statsPrefix, cfg.prefixCounter, key, "count"],+          value = Counter c,+          rate = 1.0+        },+      Report+        { key = catKey [cfg.statsPrefix, cfg.prefixCounter, key, "rate"],+          value = Counter (computeRate cfg c),+          rate = 1.0+        }+    ]+  GaugeData s ->+    [ Report+        { key = catKey [cfg.statsPrefix, cfg.prefixGauge, key],+          value = Gauge s,+          rate = 1.0+        }+    ]+  SetData s ->+    [ Report+        { key = catKey [cfg.statsPrefix, cfg.prefixSet, key, "count"],+          value = Counter (HashSet.size s),+          rate = 1.0+        }+    ]+  TimingData s -> timingReports cfg key s++data TimingStats = TimingStats+  { timings :: ![Int],+    cumsums :: ![Int],+    cumsquares :: ![Int]+  }+  deriving (Eq, Ord, Show, Read)++makeTimingStats :: TimingData -> TimingStats+makeTimingStats timings =+  TimingStats+    { timings = sorted,+      cumsums = cumulativeSums sorted,+      cumsquares = cumulativeSquares sorted+    }+  where+    sorted = sort timings++extractPercentiles :: StatConfig -> [Int]+extractPercentiles =+  HashSet.toList+    . HashSet.fromList+    . filter (\x -> x > 0 && x < 100)+    . (.timingPercentiles)++timingReports :: StatConfig -> Key -> TimingData -> [Report]+timingReports cfg key timings =+  concatMap (timingStats cfg key tstats) percentiles+  where+    tstats = makeTimingStats timings+    percentiles = 100 : extractPercentiles cfg++trimPercentile :: Int -> TimingStats -> TimingStats+trimPercentile pc ts =+  ts+    { timings = f ts.timings,+      cumsums = f ts.cumsums,+      cumsquares = f ts.cumsquares+    }+  where+    f ls = take (length ls * pc `div` 100) ls++percentileSuffix :: Int -> String+percentileSuffix pc+  | 100 <= pc = ""+  | 0 > pc = "0"+  | otherwise = "_" <> show pc++computeRate :: StatConfig -> Int -> Int+computeRate cfg i =+  round (fromIntegral i * 1000.0 / fromIntegral cfg.flushInterval :: Double)++mean :: TimingStats -> Int+mean ts = last ts.cumsums `div` length ts.timings++timingStats :: StatConfig -> Key -> TimingStats -> Int -> [Report]+timingStats cfg key tstats pc =+  mkr "count" (Counter (length ts.timings))+    : [mkr "count_ps" (Counter rate) | 100 <= pc]+      <> if null ts.timings+        then []+        else stats+  where+    k s =+      catKey+        [ cfg.statsPrefix,+          cfg.prefixTimer,+          key,+          s <> percentileSuffix pc+        ]+    ts = trimPercentile pc tstats+    rate = computeRate cfg (length ts.timings)+    mkr s v = Report {key = k s, value = v, rate = 1.0}+    stats =+      [ mkr "mean" (Timing (mean ts)),+        mkr "upper" (Timing (last ts.timings)),+        mkr "lower" (Timing (head ts.timings)),+        mkr "sum" (Timing (last ts.cumsums)),+        mkr "sum_squares" (Timing (last ts.cumsquares)),+        mkr "median" (Timing (median ts))+      ]+        <> [ mkr "std" (Timing (stdev ts))+             | 100 <= pc+           ]++cumulativeSums :: (Num a) => [a] -> [a]+cumulativeSums = scanl1 (+)++cumulativeSquares :: (Num a) => [a] -> [a]+cumulativeSquares = scanl1 (+) . map (\x -> x * x)++stdev :: TimingStats -> Int+stdev ts =+  round $ sqrt var+  where+    len = length ts.timings+    var = fromIntegral diffsum / fromIntegral len :: Double+    diffsum = sum $ map ((^ (2 :: Int)) . subtract (mean ts)) ts.timings++median :: TimingStats -> Int+median ts+  | null ts.timings = 0+  | even (length ts.timings) =+      let lower = ts.timings !! middle+          upper = ts.timings !! subtract 1 middle+       in (lower + upper) `div` 2+  | otherwise =+      ts.timings !! middle+  where+    middle = length ts.timings `div` 2++flush :: MetricData -> MetricData+flush (CounterData _) = CounterData 0+flush (GaugeData g) = GaugeData g+flush (TimingData _) = TimingData []+flush (SetData _) = SetData HashSet.empty++toReport :: Sample -> Maybe Report+toReport sample+  | sample.sampling > 0 && sample.index `mod` sample.sampling == 0 =+      Just+        Report+          { key = sample.key,+            value = sample.value,+            rate = 1.0 / fromIntegral sample.sampling+          }+  | otherwise = Nothing++format :: StatConfig -> Report -> String+format cfg report+  | cfg.newline = printf "%s:%s\n" key val+  | otherwise = printf "%s:%s" key val+  where+    key = catKey [cfg.namespace, report.key]+    rate+      | report.rate < 1.0 = printf "|@%f" report.rate+      | otherwise = "" :: String+    val =+      case report.value of+        Counter i ->+          printf "%d|c%s" i rate+        Gauge g ->+          printf "%d|g" g+        Timing t ->+          printf "%d|ms%s" t rate+        Set e ->+          printf "%s|s" e+        Metric m ->+          printf "%s|m" m+        Other d t ->+          printf "%s|%s" t d :: String++submit :: (MonadIO m) => Stats -> Sample -> m ()+submit stats sample =+  forM_ (toReport sample) (send stats)++send :: (MonadIO m) => Stats -> Report -> m ()+send stats report =+  liftIO $+    Net.sendAll stats.socket $+      C.pack $+        format stats.cfg report++connectStatsD :: (MonadIO m) => String -> Int -> m Socket+connectStatsD host port = liftIO $ do+  as <-+    Net.getAddrInfo+      Nothing+      (Just host)+      (Just $ show port)+  a <- case as of+    a : _ -> return a+    [] -> error $ "Cannot resolve: " <> host <> ":" <> show port+  sock <- Net.socket (Net.addrFamily a) Net.Datagram Net.defaultProtocol+  Net.connect sock (Net.addrAddress a)+  return sock
+ statsd-rupp.cabal view
@@ -0,0 +1,61 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           statsd-rupp+version:        0.1.0.0+synopsis:       Simple StatsD Client+description:    Please see the README on GitHub at <https://github.com/jprupp/statsd-rupp#readme>+category:       System+homepage:       https://github.com/jprupp/statsd-rupp#readme+bug-reports:    https://github.com/jprupp/statsd-rupp/issues+author:         Jean-Pieerre Rupp+maintainer:     jprupp@protonmail.ch+copyright:      2023 Jean-Pierre Rupp+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/jprupp/statsd-rupp++library+  exposed-modules:+      System.Metrics.StatsD+      System.Metrics.StatsD.Internal+  other-modules:+      Paths_statsd_rupp+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.11.5.1 && <2+    , network >=3.1.4.0 && <4+    , unliftio >=0.2.25 && <2+    , unordered-containers >=0.2.19.1 && <2+  default-language: Haskell2010++test-suite statsd-rupp-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_statsd_rupp+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.11.5.1 && <2+    , hspec+    , network >=3.1.4.0 && <4+    , statsd-rupp+    , unliftio >=0.2.25 && <2+    , unordered-containers >=0.2.19.1 && <2+  default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Monad+import Data.ByteString.Char8 qualified as B+import Data.HashMap.Strict qualified as HashMap+import Data.List (sort)+import Data.Maybe+import Network.Socket+import Network.Socket.ByteString+import System.Metrics.StatsD+import System.Metrics.StatsD.Internal+import Test.Hspec+import UnliftIO++testConfig :: StatConfig+testConfig = defStatConfig {flushInterval = 50}++main :: IO ()+main = hspec $ around (withMockStats testConfig) $ do+  describe "counter" $ do+    it "creates two counters" $ \(stats, _) -> do+      Just _ <- newStatCounter stats "planets" 1+      Just _ <- newStatCounter stats "moons" 1+      return () :: Expectation+    it "reports two counters" $ \(stats, report) -> do+      Just planets <- newStatCounter stats "planets" 1+      Just moons <- newStatCounter stats "moons" 1+      incrementCounter planets 10+      incrementCounter moons 20+      rs <- replicateM 2 report+      let rs' =+            [ Report "planets" (Counter 10) 1.0,+              Report "moons" (Counter 20) 1.0+            ]+      rs `shouldMatchList` rs'+    it "filters reported samples" $ \(stats, report) -> do+      Just c <- newStatCounter stats "moons" 4+      let counts = [11 .. 30]+      forM_ counts (incrementCounter c)+      rs <- replicateM 5 report+      let rs' =+            [ Report "moons" (Counter x) 0.25+              | (i, x) <- zip [(1 :: Int) ..] counts,+                i `mod` 4 == 0+            ]+      rs `shouldMatchList` rs'+      r <- report+      r.key `shouldNotBe` "moons"+    it "reports counter stats" $ \(stats, report) -> do+      Just c <- newStatCounter stats "planets" 4+      replicateM_ 20 (incrementCounter c 10)+      replicateM_ 5 report+      do+        rs <- replicateM 2 report+        let rs' =+              [ Report "stats.counters.planets.count" (Counter 200) 1.0,+                Report "stats.counters.planets.rate" (Counter 4000) 1.0+              ]+        rs `shouldMatchList` rs'+      do+        rs <- replicateM 2 report+        let rs' =+              [ Report "stats.counters.planets.count" (Counter 0) 1.0,+                Report "stats.counters.planets.rate" (Counter 0) 1.0+              ]+        rs `shouldMatchList` rs'+  describe "timing" $ do+    it "reports timing events" $ \(stats, report) -> do+      let timings = [51 .. 55]+      Just t <- newStatTiming stats "trips" 1+      forM_ timings (addTiming t)+      rs <- replicateM (length timings) report+      let rs' = map (\n -> Report "trips" (Timing n) 1.0) timings+      rs `shouldMatchList` rs'+    it "reports empty timing stats" $ \(stats, report) -> do+      Just _ <- newStatTiming stats "holes" 1+      rs <- replicateM 8 report+      let rs' =+            concatMap+              (replicate 2)+              [ Report "stats.timers.holes.count" (Counter 0) 1.0,+                Report "stats.timers.holes.count_ps" (Counter 0) 1.0,+                Report "stats.timers.holes.count_90" (Counter 0) 1.0,+                Report "stats.timers.holes.count_95" (Counter 0) 1.0+              ]+      rs `shouldMatchList` rs'+    it "filters reported samples" $ \(stats, report) -> do+      let timings = [1001 .. 2000]+      Just t <- newStatTiming stats "cats" 100+      forM_ timings (addTiming t)+      rs <- replicateM 10 report+      let rs' =+            [ Report "cats" (Timing x) 0.01+              | (i, x) <- zip [(1 :: Int) ..] timings,+                i `mod` 100 == 0+            ]+      rs `shouldMatchList` rs'+    it "computes timing stats correctly" $ const $ do+      let ps = reverse [5 .. 800] ++ [801 .. 1500]+          p90 = take (length ps * 90 `div` 100) (sort ps)+          p95 = take (length ps * 95 `div` 100) (sort ps)+          mean' ls = sum ls `div` length ls+          sumsq = sum . map (\x -> x * x)+          stdev' ls =+            let l = fromIntegral (length ls)+                ds = map (subtract (mean' ls)) ls+                s = fromIntegral $ sumsq ds :: Double+                v = s / l+             in round (sqrt v)+          median' ls+            | even (length ls) =+                let x = length ls `div` 2+                    y = x - 1+                 in (sort ls !! x + sort ls !! y) `div` 2+            | otherwise = sort ls !! (length ls `div` 2)+          ts = makeTimingStats ps+          t90 = trimPercentile 90 ts+          t95 = trimPercentile 95 ts+      length ts.timings `shouldBe` length ps+      mean ts `shouldBe` mean' ps+      stdev ts `shouldBe` stdev' ps+      last ts.cumsquares `shouldBe` sumsq ps+      last ts.cumsums `shouldBe` sum ps+      median ts `shouldBe` median' ps+      length t90.timings `shouldBe` length p90+      mean t90 `shouldBe` mean' p90+      stdev t90 `shouldBe` stdev' p90+      last t90.cumsquares `shouldBe` sumsq p90+      last t90.cumsums `shouldBe` sum p90+      median t90 `shouldBe` median' p90+      length t95.timings `shouldBe` length p95+      mean t95 `shouldBe` mean' p95+      stdev t95 `shouldBe` stdev' p95+      last t95.cumsquares `shouldBe` sumsq p95+      last t95.cumsums `shouldBe` sum p95+      median t95 `shouldBe` median' p95+    it "reports timing stats" $ \(stats, report) -> do+      let timings = [5 .. 1500]+      Just t <- newStatTiming stats "kittens" 0+      forM_ timings (addTiming t)+      let l = length timings+          r k v = Report ("stats.timers.kittens." <> k) v 1.0+      do+        let rs' =+              [ r "count" (Counter l),+                r "count_ps" (Counter (l * 20)),+                r "std" (Timing 432),+                r "mean" (Timing 752),+                r "lower" (Timing 5),+                r "upper" (Timing 1500),+                r "sum" (Timing 1125740),+                r "sum_squares" (Timing 1126125220),+                r "median" (Timing 752),+                r "count_95" (Counter 1421),+                r "mean_95" (Timing 715),+                r "lower_95" (Timing 5),+                r "upper_95" (Timing 1425),+                r "sum_95" (Timing 1016015),+                r "sum_squares_95" (Timing 965562395),+                r "median_95" (Timing 715),+                r "count_90" (Counter 1346),+                r "mean_90" (Timing 677),+                r "lower_90" (Timing 5),+                r "upper_90" (Timing 1350),+                r "sum_90" (Timing 911915),+                r "sum_squares_90" (Timing 821036445),+                r "median_90" (Timing 677)+              ]+        rs <- replicateM (length rs') report+        rs `shouldMatchList` rs'+      do+        let rs' =+              concatMap+                (replicate 2)+                [ r "count" (Counter 0),+                  r "count_ps" (Counter 0),+                  r "count_90" (Counter 0),+                  r "count_95" (Counter 0)+                ]+        rs <- replicateM (length rs') report+        rs `shouldMatchList` rs'+  describe "gauge" $ do+    it "reports gauge set events" $ \(stats, report) -> do+      let gauges = [51 .. 55]+      Just g <- newStatGauge stats "speed" 1 50+      forM_ gauges (setGauge g)+      rs <- replicateM (length gauges) report+      let rs' = map (\n -> Report "speed" (Gauge n) 1.0) gauges+      rs `shouldMatchList` rs'+    it "reports gauge stats" $ \(stats, report) -> do+      let gauges = [51 .. 55]+      Just g <- newStatGauge stats "speed" 1 50+      r <- report+      r `shouldBe` Report "stats.gauges.speed" (Gauge 50) 1.0+      forM_ gauges (setGauge g)+      replicateM_ (length gauges) report+      rs <- replicateM 2 report+      let rs' = replicate 2 $ Report "stats.gauges.speed" (Gauge 55) 1.0+      rs `shouldMatchList` rs'+  describe "set" $ do+    it "reports set events" $ \(stats, report) -> do+      let set = ["one", "two", "three", "three"]+      Just s <- newStatSet stats "numbers"+      forM_ set (newSetElement s)+      rs <- replicateM (length set) report+      let rs' = map (\x -> Report "numbers" (Set x) 1.0) set+      rs `shouldMatchList` rs'+    it "reports set stats" $ \(stats, report) -> do+      let set = ["two", "three", "one", "two", "three", "three"]+      Just s <- newStatSet stats "numbers"+      forM_ set (newSetElement s)+      let rs' =+            [ Report "stats.sets.numbers.count" (Counter 3) 1.0,+              Report "stats.sets.numbers.count" (Counter 0) 1.0+            ]+      rs <- replicateM (length set + length rs') report+      rs `shouldEndWith` rs'++withMockStats ::+  (MonadUnliftIO m) =>+  StatConfig ->+  ((Stats, m Report) -> m a) ->+  m a+withMockStats cfg go =+  withMockSockets $ \(s1, s2) -> do+    q <- newTQueueIO+    withAsync (fwd s2 q) $ \a1 -> do+      link a1+      m <- newTVarIO HashMap.empty+      let s = Stats m cfg {newline = True} s1+      withAsync (statsLoop s) $ \a2 -> do+        link a2+        go (s, atomically (readTQueue q))+  where+    fwd s2 q = forever $ do+      bs <- liftIO $ B.lines <$> recv s2 (2 ^ (20 :: Int))+      let rs = mapMaybe parseReport bs+      mapM_ (atomically . writeTQueue q) rs++withMockSockets :: (MonadUnliftIO m) => ((Socket, Socket) -> m a) -> m a+withMockSockets =+  bracket+    (liftIO (socketPair AF_UNIX Stream 0))+    (\(s1, s2) -> liftIO (close s1 >> close s2))