statsd-rupp 0.3.0.1 → 0.4.0.0

raw patch · 5 files changed

+551/−444 lines, 5 filesdep +QuickCheckdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• src/System/Metrics/StatsD.hs +22/−66
• src/System/Metrics/StatsD/Internal.hs +223/−169
• statsd-rupp.cabal +5/−2
• test/Spec.hs +294/−207

@@ -8,6 +8,13 @@  ## Unreleased +## 0.4.0.0 - 2023-09-04++- Use vectors where pertient.+- Use bytestrings internally.+- Change configuration parameters.+- Code and test refactoring.+ ## 0.3.0.1 - 2023-09-02  - Ignore IO errors when sending UDP packets to the network.

@@ -25,19 +25,13 @@     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,+  ( MetricData (..),     StatConfig (..),     StatCounter (..),     StatGauge (..),@@ -45,55 +39,57 @@     StatTiming (..),     Stats,     Value (..),+    connectStatsD,     newMetric,+    newMetrics,     newStats,     processSample,     statsLoop,-    validateKey,   )-import Text.Read (readMaybe) import UnliftIO (MonadIO, MonadUnliftIO) import UnliftIO.Async (link, withAsync) +type Key = String+ defStatConfig :: StatConfig defStatConfig =   StatConfig     { reportStats = True,       reportSamples = True,       namespace = "",-      statsPrefix = "stats",+      prefixStats = "stats",       prefixCounter = "counters",       prefixTimer = "timers",       prefixGauge = "gauges",       prefixSet = "sets",-      server = "127.0.0.1",-      port = 8125,+      statsdServer = "127.0.0.1",+      statsdPort = 8125,       flushInterval = 1000,       timingPercentiles = [90, 95],-      newline = False+      appendNewline = False     }  newStatCounter ::-  (MonadIO m) => Stats -> Key -> Sampling -> m StatCounter+  (MonadIO m) => Stats -> Key -> Int -> m StatCounter newStatCounter stats key sampling = do-  newMetric stats key (CounterData 0)-  return $ StatCounter stats key sampling+  newMetric stats (C.pack key) (CounterData 0)+  return $ StatCounter stats (C.pack key) sampling  newStatGauge ::   (MonadIO m) => Stats -> Key -> Int -> m StatGauge newStatGauge stats key ini = do-  newMetric stats key (GaugeData ini)-  return $ StatGauge stats key+  newMetric stats (C.pack key) (GaugeData ini)+  return $ StatGauge stats (C.pack key)  newStatTiming :: (MonadIO m) => Stats -> Key -> Int -> m StatTiming newStatTiming stats key sampling = do-  newMetric stats key (TimingData [])-  return $ StatTiming stats key sampling+  newMetric stats (C.pack key) (TimingData [])+  return $ StatTiming stats (C.pack key) sampling  newStatSet :: (MonadIO m) => Stats -> Key -> m StatSet newStatSet stats key = do-  newMetric stats key (SetData HashSet.empty)-  return $ StatSet stats key+  newMetric stats (C.pack key) (SetData HashSet.empty)+  return $ StatSet stats (C.pack key)  incrementCounter :: (MonadIO m) => StatCounter -> Int -> m () incrementCounter StatCounter {..} =@@ -116,53 +112,13 @@  newSetElement :: (MonadIO m) => StatSet -> String -> m () newSetElement StatSet {..} =-  processSample stats 1 key . Set+  processSample stats 1 key . Set . C.pack  withStats :: (MonadUnliftIO m) => StatConfig -> (Stats -> m a) -> m a withStats cfg go = do-  stats <- newStats cfg+  metrics <- newMetrics+  socket <- connectStatsD cfg.statsdServer cfg.statsdPort+  let stats = newStats cfg metrics socket   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" ->-              case s of-                '+' : n -> Gauge <$> parseRead n <*> pure True-                '-' : _ -> Gauge <$> parseRead s <*> pure True-                _ -> Gauge <$> parseRead s <*> pure False-            "s" -> return $ Set s-            "ms" -> Timing <$> parseRead s-            _ -> mzero-    parseRate r = case C.unpack r of-      '@' : s -> parseRead s-      _ -> mzero

@@ -7,19 +7,14 @@  module System.Metrics.StatsD.Internal   ( Stats (..),+    newStats,+    StatParams,+    newParams,     StatConfig (..),-    Key,-    Index,-    Sampling,-    Counter,-    Gauge,-    Timing,-    SetElement,-    Timings,-    SetData,     MetricData (..),     Store (..),     Metrics,+    newMetrics,     Value (..),     Sample (..),     Report (..),@@ -33,7 +28,6 @@     addReading,     newReading,     processSample,-    newStats,     statsLoop,     statsFlush,     flushStats,@@ -53,24 +47,35 @@     median,     flush,     toReport,-    format,+    formatReport,     submit,     connectStatsD,+    parseReport,+    parseRead,+    parseInt,   ) where -import Control.Monad (forM_, forever, void, when)+import Control.Monad (MonadPlus (..), forM_, forever, void, when)+import Data.Bool (bool)+import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.ByteString.Builder (byteString, char8, intDec, string8, toLazyByteString) import Data.ByteString.Char8 qualified as C+import Data.ByteString.Lazy qualified as L 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 Data.List (sort)+import Data.Vector (Vector, (!))+import Data.Vector qualified as V import Network.Socket (Socket) import Network.Socket qualified as Net import Network.Socket.ByteString qualified as Net import Text.Printf (printf)+import Text.Read (readMaybe) import UnliftIO (MonadIO, handleIO, liftIO, throwIO) import UnliftIO.Concurrent (threadDelay) import UnliftIO.STM@@ -83,115 +88,106 @@     stateTVar,   ) -type Key = String- data Stats = Stats   { metrics :: !(TVar Metrics),-    cfg :: !StatConfig,-    socket :: !Socket+    socket :: !Socket,+    params :: !StatParams   } +data StatParams = StatParams+  { pfx :: !ByteString,+    pfxCounter :: !ByteString,+    pfxTimer :: !ByteString,+    pfxGauge :: !ByteString,+    pfxSet :: !ByteString,+    flush :: !Int,+    stats :: !Bool,+    samples :: !Bool,+    percentiles :: ![Int],+    newline :: !Bool+  }+ data StatConfig = StatConfig   { reportStats :: !Bool,     reportSamples :: !Bool,     namespace :: !String,-    statsPrefix :: !String,+    prefixStats :: !String,     prefixCounter :: !String,     prefixTimer :: !String,     prefixGauge :: !String,     prefixSet :: !String,-    server :: !String,-    port :: !Int,+    statsdServer :: !String,+    statsdPort :: !Int,     flushInterval :: !Int,     timingPercentiles :: ![Int],-    newline :: !Bool+    appendNewline :: !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 Timings = [Int]--type SetData = HashSet String- data MetricData-  = CounterData !Counter-  | GaugeData !Gauge-  | TimingData !Timings-  | SetData !(HashSet String)+  = CounterData !Int+  | GaugeData !Int+  | TimingData ![Int]+  | SetData !(HashSet ByteString)  data Store = Store-  { index :: !Index,+  { index :: !Int,     dat :: !(Maybe MetricData)   } -type Metrics = HashMap Key Store+type Metrics = HashMap ByteString Store  data Value-  = Counter !Counter-  | Gauge !Gauge !Bool-  | Timing !Timing-  | Set !SetElement-  | Metric !Int-  | Other !String !String+  = Counter !Int+  | Gauge !Int !Bool+  | Timing !Int+  | Set !ByteString   deriving (Eq, Ord, Show, Read)  data Report = Report-  { key :: !Key,+  { key :: !ByteString,     value :: !Value,     rate :: !Double   }   deriving (Eq, Ord, Show, Read)  data Sample = Sample-  { key :: !Key,+  { key :: !ByteString,     value :: !Value,-    sampling :: !Sampling,-    index :: !Index+    sampling :: !Int,+    index :: !Int   }   deriving (Eq, Ord, Show, Read)  data StatCounter = StatCounter   { stats :: !Stats,-    key :: !Key,-    sampling :: !Sampling+    key :: !ByteString,+    sampling :: !Int   }  data StatGauge = StatGauge   { stats :: !Stats,-    key :: !Key+    key :: !ByteString   }  data StatTiming = StatTiming   { stats :: !Stats,-    key :: !Key,-    sampling :: !Sampling+    key :: !ByteString,+    sampling :: !Int   }  data StatSet = StatSet   { stats :: !Stats,-    key :: !Key+    key :: !ByteString   } -addMetric :: StatConfig -> Key -> MetricData -> Metrics -> Metrics-addMetric cfg key md =+addMetric :: StatParams -> ByteString -> MetricData -> Metrics -> Metrics+addMetric params key dat =   HashMap.insert key $     Store 0 $-      if cfg.reportStats-        then Just md-        else Nothing+      if params.stats then Just dat else Nothing -newMetric :: (MonadIO m) => Stats -> Key -> MetricData -> m ()+newMetric :: (MonadIO m) => Stats -> ByteString -> MetricData -> m () newMetric stats key store   | validateKey key = do       e <- atomically $ do@@ -199,21 +195,23 @@         if exists           then return True           else do-            modifyTVar stats.metrics (addMetric stats.cfg key store)+            modifyTVar+              stats.metrics+              (addMetric stats.params key store)             return False       when e $         throwIO $           userError $-            "A metric already exists with key: " <> key+            "A metric already exists with key: " <> C.unpack key   | otherwise =-      throwIO $ userError $ "Metric key is invalid: " <> key+      throwIO $ userError $ "Metric key is invalid: " <> C.unpack key -validateKey :: String -> Bool-validateKey t = not (null t) && all valid t+validateKey :: ByteString -> Bool+validateKey t = not (C.null t) && C.all valid t   where     valid c = elem c ("._-" :: [Char]) || isAscii c && isAlphaNum c -addReading :: Value -> Key -> Metrics -> Metrics+addReading :: Value -> ByteString -> Metrics -> Metrics addReading reading = HashMap.adjust adjust   where     adjust m = m {index = m.index + 1, dat = change <$> m.dat}@@ -225,108 +223,137 @@       (Set e, SetData s) -> SetData (HashSet.insert e s)       _ -> error "Stats reading mismatch" -newReading :: Stats -> Key -> Value -> STM Int+newReading :: Stats -> ByteString -> Value -> STM Int newReading stats key reading = do   modifyTVar stats.metrics (addReading reading key)-  maybe 0 (.index) . HashMap.lookup key <$> readTVar stats.metrics+  maybe 0 (.index) . HashMap.lookup key+    <$> readTVar stats.metrics  processSample ::-  (MonadIO m) => Stats -> Sampling -> Key -> Value -> m ()+  (MonadIO m) => Stats -> Int -> ByteString -> Value -> m () processSample stats sampling key val = do   idx <- atomically $ newReading stats key val-  when stats.cfg.reportSamples $+  when stats.params.samples $     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+newMetrics :: (MonadIO m) => m (TVar Metrics)+newMetrics = newTVarIO HashMap.empty +newParams :: StatConfig -> StatParams+newParams cfg =+  StatParams+    { pfx = p,+      pfxCounter = s <> C.pack cfg.prefixCounter <> ".",+      pfxGauge = s <> C.pack cfg.prefixGauge <> ".",+      pfxTimer = s <> C.pack cfg.prefixTimer <> ".",+      pfxSet = s <> C.pack cfg.prefixSet <> ".",+      newline = cfg.appendNewline,+      stats = cfg.reportStats,+      samples = cfg.reportSamples,+      percentiles = extractPercentiles cfg,+      flush = abs cfg.flushInterval+    }+  where+    p =+      if null cfg.namespace+        then ""+        else C.pack cfg.namespace <> "."+    s =+      if null cfg.prefixStats+        then p+        else p <> C.pack cfg.prefixStats <> "."++newStats :: StatConfig -> TVar Metrics -> Socket -> Stats+newStats cfg metrics socket =+  Stats+    { metrics = metrics,+      socket = socket,+      params = newParams cfg+    }+ statsLoop :: (MonadIO m) => Stats -> m () statsLoop stats = forever $ do-  threadDelay $ stats.cfg.flushInterval * 1000+  threadDelay (stats.params.flush * 1000)   statsFlush stats  statsFlush :: (MonadIO m) => Stats -> m () statsFlush stats = do-  reports <--    atomically $-      stateTVar stats.metrics (flushStats stats.cfg)-  mapM_ (send stats) reports+  mapM_ (send stats)+    =<< atomically+      (stateTVar stats.metrics (flushStats stats.params)) -flushStats :: StatConfig -> Metrics -> ([Report], Metrics)-flushStats cfg metrics =-  let f xs key m = maybe xs ((<> xs) . statReports cfg key) m.dat+flushStats :: StatParams -> Metrics -> ([Report], Metrics)+flushStats params metrics =+  let f xs key m = maybe xs ((<> xs) . statReports params 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)+catKey :: [ByteString] -> ByteString+catKey = C.intercalate "." . filter (not . C.null) -statReports :: StatConfig -> Key -> MetricData -> [Report]-statReports cfg key dat = case dat of+statReports :: StatParams -> ByteString -> MetricData -> [Report]+statReports params key dat = case dat of   CounterData c ->     [ Report-        { key = catKey [cfg.statsPrefix, cfg.prefixCounter, key, "count"],+        { key = params.pfxCounter <> key <> ".count",           value = Counter c,           rate = 1.0         },       Report-        { key = catKey [cfg.statsPrefix, cfg.prefixCounter, key, "rate"],-          value = Counter (computeRate cfg c),+        { key = params.pfxCounter <> key <> ".rate",+          value = Counter (computeRate params c),           rate = 1.0         }     ]   GaugeData s ->     [ Report-        { key = catKey [cfg.statsPrefix, cfg.prefixGauge, key],+        { key = params.pfxGauge <> key,           value = Gauge s False,           rate = 1.0         }     ]   SetData s ->     [ Report-        { key = catKey [cfg.statsPrefix, cfg.prefixSet, key, "count"],+        { key = params.pfxSet <> key <> ".count",           value = Counter (HashSet.size s),           rate = 1.0         }     ]-  TimingData s -> timingReports cfg key s+  TimingData s -> timingReports params key s  data TimingStats = TimingStats-  { timings :: ![Int],-    cumsums :: ![Int],-    cumsquares :: ![Int]+  { timings :: !(Vector Int),+    cumsums :: !(Vector Int),+    cumsquares :: !(Vector Int)   }   deriving (Eq, Ord, Show, Read) -makeTimingStats :: Timings -> TimingStats+makeTimingStats :: [Int] -> TimingStats makeTimingStats timings =   TimingStats-    { timings = sorted,-      cumsums = cumulativeSums sorted,-      cumsquares = cumulativeSquares sorted+    { timings = V.fromList sorted,+      cumsums = V.fromList (cumulativeSums sorted),+      cumsquares = V.fromList (cumulativeSquares sorted)     }   where     sorted = sort timings  extractPercentiles :: StatConfig -> [Int] extractPercentiles =-  HashSet.toList+  (100 :)+    . HashSet.toList     . HashSet.fromList     . filter (\x -> x > 0 && x < 100)     . (.timingPercentiles) -timingReports :: StatConfig -> Key -> Timings -> [Report]-timingReports cfg key timings =-  concatMap (timingStats cfg key tstats) percentiles+timingReports :: StatParams -> ByteString -> [Int] -> [Report]+timingReports params key timings =+  concatMap (timingStats params key tstats) params.percentiles   where     tstats = makeTimingStats timings-    percentiles = 100 : extractPercentiles cfg  trimPercentile :: Int -> TimingStats -> TimingStats trimPercentile pc ts =@@ -336,50 +363,39 @@       cumsquares = f ts.cumsquares     }   where-    f ls = take (length ls * pc `div` 100) ls+    f ls = V.take (length ls * pc `div` 100) ls -percentileSuffix :: Int -> String+percentileSuffix :: Int -> ByteString percentileSuffix pc-  | 100 <= pc = ""-  | 0 > pc = "0"-  | otherwise = "_" <> show pc+  | pc == 100 = ""+  | otherwise = C.pack $ printf "_%d" pc -computeRate :: StatConfig -> Int -> Int-computeRate cfg i =-  round (fromIntegral i * 1000.0 / fromIntegral cfg.flushInterval :: Double)+computeRate :: StatParams -> Int -> Int+computeRate params i = i * 1000 `div` params.flush  mean :: TimingStats -> Int-mean ts = last ts.cumsums `div` length ts.timings+mean ts = V.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+timingStats :: StatParams -> ByteString -> TimingStats -> Int -> [Report]+timingStats params key tstats pc =+  concat+    [ [mkr "count" (Counter (length ts.timings))],+      [mkr "count_ps" (Counter rate) | pc == 100],+      [mkr "std" (Timing (stdev ts)) | pc == 100, not empty],+      [mkr "mean" (Timing (mean ts)) | not empty],+      [mkr "upper" (Timing (V.last ts.timings)) | not empty],+      [mkr "lower" (Timing (V.head ts.timings)) | not empty],+      [mkr "sum" (Timing (V.last ts.cumsums)) | not empty],+      [mkr "sum_squares" (Timing (V.last ts.cumsquares)) | not empty],+      [mkr "median" (Timing (median ts)) | not empty]+    ]   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-           ]+    empty = null ts.timings+    rate = computeRate params (length ts.timings)+    sfx = percentileSuffix pc+    pfx = params.pfxTimer <> key <> "."+    mkr s v = Report {key = pfx <> s <> sfx, value = v, rate = 1.0}  cumulativeSums :: (Num a) => [a] -> [a] cumulativeSums = scanl1 (+)@@ -392,18 +408,18 @@   round $ sqrt var   where     len = length ts.timings-    var = fromIntegral diffsum / fromIntegral len :: Double-    diffsum = sum $ map ((^ (2 :: Int)) . subtract (mean ts)) ts.timings+    var = fromIntegral ds / fromIntegral len :: Double+    ds = sum $ map ((^ (2 :: Int)) . subtract (mean ts)) (V.toList 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+      let lower = ts.timings ! middle+          upper = ts.timings ! subtract 1 middle        in (lower + upper) `div` 2   | otherwise =-      ts.timings !! middle+      ts.timings ! middle   where     middle = length ts.timings `div` 2 @@ -424,31 +440,27 @@           }   | otherwise = Nothing -format :: StatConfig -> Report -> String-format cfg report-  | cfg.newline = printf "%s:%s\n" key val-  | otherwise = printf "%s:%s" key val+formatReport :: Report -> ByteString+formatReport report = L.toStrict $ toLazyByteString builder   where-    key = catKey [cfg.namespace, report.key]+    builder = byteString report.key <> char8 ':' <> val     rate-      | report.rate < 1.0 = printf "|@%f" report.rate-      | otherwise = "" :: String+      | report.rate < 1.0 =+          string8 $ printf "|@%f" report.rate+      | otherwise = mempty     val =       case report.value of         Counter i ->-          printf "%d|c%s" i rate+          intDec i <> "|c" <> rate         Gauge g False ->-          printf "%d|g" g+          intDec g <> "|g"         Gauge g True ->-          printf "%+d|g" g+          let sign = if 0 <= g then char8 '+' else mempty+           in sign <> intDec g <> "|g"         Timing t ->-          printf "%d|ms%s" t rate+          intDec t <> "|ms" <> rate         Set e ->-          printf "%s|s" e-        Metric m ->-          printf "%s|m" m-        Other d t ->-          printf "%s|%s" t d :: String+          byteString e <> "|s"  submit :: (MonadIO m) => Stats -> Sample -> m () submit stats sample =@@ -459,8 +471,9 @@   liftIO $     handleIO (const (return ())) $       void $-        Net.send stats.socket $-          C.pack (format stats.cfg report)+        Net.send+          stats.socket+          (formatReport report <> bool "" "\n" stats.params.newline)  connectStatsD :: (MonadIO m) => String -> Int -> m Socket connectStatsD host port = liftIO $ do@@ -475,3 +488,44 @@   sock <- Net.socket (Net.addrFamily a) Net.Datagram Net.defaultProtocol   Net.connect sock (Net.addrAddress a)   return sock++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.0+    [kv, t, r] -> do+      (k, v) <- parseKeyValue kv t+      x <- parseRate r+      return $ Report k v x+    _ -> mzero+  where+    parseKeyValue kv t = do+      case C.split ':' kv of+        [key, v] -> do+          value <- parseValue v t+          return (key, value)+        _ -> mzero+    parseValue v t =+      case C.unpack t of+        "c" -> Counter <$> parseRead v+        "g" ->+          case C.uncons v of+            Just ('+', n) -> Gauge <$> parseInt n <*> pure True+            Just ('-', _) -> Gauge <$> parseInt v <*> pure True+            _ -> Gauge <$> parseRead v <*> pure False+        "s" -> return $ Set v+        "ms" -> Timing <$> parseRead v+        _ -> mzero+    parseRate r = case C.uncons r of+      Just ('@', s) -> parseRead s+      _ -> mzero++parseRead :: (MonadPlus m, Read a) => ByteString -> m a+parseRead = maybe mzero return . readMaybe . C.unpack++parseInt :: (MonadPlus m) => ByteString -> m Int+parseInt bs = case C.readInt bs of+  Just (i, bs') | B.null bs' -> return i+  _ -> mzero

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           statsd-rupp-version:        0.3.0.1+version:        0.4.0.0 synopsis:       Simple StatsD Client description:    Please see the README on GitHub at <https://github.com/jprupp/statsd-rupp#readme> category:       System@@ -40,6 +40,7 @@     , network >=3.1.4.0 && <4     , unliftio >=0.2.25 && <2     , unordered-containers >=0.2.19.1 && <2+    , vector >=0.13.0 && <2   default-language: Haskell2010  test-suite statsd-rupp-test@@ -51,11 +52,13 @@       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+      QuickCheck+    , 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+    , vector >=0.13.0 && <2   default-language: Haskell2010

@@ -3,236 +3,251 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}  import Control.Monad-import Data.ByteString.Char8 qualified as B+import Data.ByteString (ByteString)+import Data.ByteString.Char8 qualified as C+import Data.Char import Data.HashMap.Strict qualified as HashMap import Data.List (sort) import Data.Maybe+import Data.Vector qualified as V import Network.Socket import Network.Socket.ByteString import System.Metrics.StatsD import System.Metrics.StatsD.Internal import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck 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-      _ <- newStatCounter stats "planets" 1-      _ <- newStatCounter stats "moons" 1-      return () :: Expectation-    it "reports on two counters" $ \(stats, report) -> do-      planets <- newStatCounter stats "planets" 1-      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-      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 stats" $ \(stats, report) -> do-      c <- newStatCounter stats "planets" 4-      replicateM_ 20 (incrementCounter c 10)-      replicateM_ 5 report-      do+main = hspec $ do+  describe "parser" $ do+    prop "formats and parses a report" $ \r ->+      (parseReport . formatReport) r `shouldBe` Just r+  describe "statistics" $ do+    prop "calculates timing lengths" $ \ps -> do+      let ts = makeTimingStats ps+      length ts.timings `shouldBe` length ps+    prop "calculates p75 and p95 timing lengths" $ \ps -> do+      let ts = makeTimingStats ps+      length (trimPercentile 95 ts).timings `shouldBe` length (percent 95 ps)+      length (trimPercentile 75 ts).timings `shouldBe` length (percent 75 ps)+    prop "computes median" $ \ps ->+      not (null ps) ==> do+        let ts = makeTimingStats ps+        median ts `shouldBe` med ps+    prop "computes p75 and p95 median" $ \ps ->+      2 <= length ps ==> do+        let ts = makeTimingStats ps+        median (trimPercentile 95 ts) `shouldBe` med (percent 95 ps)+        median (trimPercentile 75 ts) `shouldBe` med (percent 75 ps)+    prop "computes mean" $ \ps ->+      not (null ps) ==> do+        let ts = makeTimingStats ps+        mean ts `shouldBe` mea ps+    prop "computes p75 and p95 mean" $ \ps ->+      2 <= length ps ==> do+        let ts = makeTimingStats ps+        mean (trimPercentile 95 ts) `shouldBe` mea (percent 95 ps)+        mean (trimPercentile 75 ts) `shouldBe` mea (percent 75 ps)+    prop "computes stdev" $ \ps ->+      not (null ps) ==> do+        let ts = makeTimingStats ps+        stdev ts `shouldBe` std ps+    prop "computes sums" $ \ps ->+      not (null ps) ==> do+        let ts = makeTimingStats ps+        V.last ts.cumsums `shouldBe` sum ps+    prop "computes p75 and p95 sums" $ \ps ->+      2 <= length ps ==> do+        let ts = makeTimingStats ps+        V.last (trimPercentile 95 ts).cumsums `shouldBe` sum (percent 95 ps)+        V.last (trimPercentile 75 ts).cumsums `shouldBe` sum (percent 75 ps)+    prop "computes sum of squares" $ \ps ->+      not (null ps) ==> do+        let ts = makeTimingStats ps+        V.last ts.cumsquares `shouldBe` sumsq ps+    prop "computes p75 and p95 sum of squares" $ \ps ->+      2 <= length ps ==> do+        let ts = makeTimingStats ps+        V.last (trimPercentile 95 ts).cumsquares `shouldBe` sumsq (percent 95 ps)+        V.last (trimPercentile 75 ts).cumsquares `shouldBe` sumsq (percent 75 ps)+  around (withMockStats testConfig) $ do+    describe "counter" $ do+      it "creates two counters" $ \(stats, _) -> do+        _ <- newStatCounter stats "planets" 1+        _ <- newStatCounter stats "moons" 1+        return () :: Expectation+      it "reports on two counters" $ \(stats, report) -> do+        planets <- newStatCounter stats "planets" 1+        moons <- newStatCounter stats "moons" 1+        incrementCounter planets 10+        incrementCounter moons 20         rs <- replicateM 2 report         let rs' =-              [ Report "stats.counters.planets.count" (Counter 200) 1.0,-                Report "stats.counters.planets.rate" (Counter 4000) 1.0+              [ Report "planets" (Counter 10) 1.0,+                Report "moons" (Counter 20) 1.0               ]         rs `shouldMatchList` rs'-      do-        rs <- replicateM 2 report+      it "filters reported samples" $ \(stats, report) -> do+        c <- newStatCounter stats "moons" 4+        let counts = [11 .. 30]+        forM_ counts (incrementCounter c)+        rs <- replicateM 5 report         let rs' =-              [ Report "stats.counters.planets.count" (Counter 0) 1.0,-                Report "stats.counters.planets.rate" (Counter 0) 1.0+              [ Report "moons" (Counter x) 0.25+                | (i, x) <- zip [(1 :: Int) ..] counts,+                  i `mod` 4 == 0               ]         rs `shouldMatchList` rs'-  describe "timing" $ do-    it "reports events" $ \(stats, report) -> do-      let timings = [51 .. 55]-      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 stats" $ \(stats, report) -> do-      _ <- 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]-      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 stats" $ 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 stats" $ \(stats, report) -> do-      let timings = [5 .. 1500]-      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+        r <- report+        r.key `shouldNotBe` "moons"+      it "reports stats" $ \(stats, report) -> do+        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 events" $ \(stats, report) -> do+        let timings = [51 .. 55]+        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 stats" $ \(stats, report) -> do+        _ <- newStatTiming stats "holes" 1+        replicateM_ 2 $ do+          let rs' =+                [ 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 <- replicateM (length rs') report+          rs `shouldMatchList` rs'+      it "filters reported samples" $ \(stats, report) -> do+        let timings = [1001 .. 2000]+        t <- newStatTiming stats "cats" 100+        forM_ timings (addTiming t)+        rs <- replicateM 10 report         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)+              [ Report "cats" (Timing x) 0.01+                | (i, x) <- zip [(1 :: Int) ..] timings,+                  i `mod` 100 == 0               ]-        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)+      it "reports stats" $ \(stats, report) -> do+        let timings = [5 .. 1500]+        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 <- 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 set events" $ \(stats, report) -> do+        let gauges = [51 .. 55]+        g <- newStatGauge stats "speed" 50+        forM_ gauges (setGauge g)+        rs <- replicateM (length gauges) report+        let rs' = map (\n -> Report "speed" (Gauge n False) 1.0) gauges         rs `shouldMatchList` rs'-  describe "gauge" $ do-    it "reports set events" $ \(stats, report) -> do-      let gauges = [51 .. 55]-      g <- newStatGauge stats "speed" 50-      forM_ gauges (setGauge g)-      rs <- replicateM (length gauges) report-      let rs' = map (\n -> Report "speed" (Gauge n False) 1.0) gauges-      rs `shouldMatchList` rs'-    it "reports stats" $ \(stats, report) -> do-      let gauges = [51 .. 55]-      g <- newStatGauge stats "radius" 50-      r <- report-      r `shouldBe` Report "stats.gauges.radius" (Gauge 50 False) 1.0-      forM_ gauges (setGauge g)-      replicateM_ (length gauges) report-      rs <- replicateM 2 report-      let rs' = replicate 2 $ Report "stats.gauges.radius" (Gauge 55 False) 1.0-      rs `shouldMatchList` rs'-    it "increments and decrements value" $ \(stats, report) -> do-      g <- newStatGauge stats "breadth" 50-      incrementGauge g 5-      report `shouldReturn` Report "breadth" (Gauge 5 True) 1.0-      report `shouldReturn` Report "stats.gauges.breadth" (Gauge 55 False) 1.0-      incrementGauge g (-10)-      report `shouldReturn` Report "breadth" (Gauge (-10) True) 1.0-      report `shouldReturn` Report "stats.gauges.breadth" (Gauge 45 False) 1.0-      decrementGauge g 50-      report `shouldReturn` Report "breadth" (Gauge (-50) True) 1.0-      report `shouldReturn` Report "stats.gauges.breadth" (Gauge 0 False) 1.0-      decrementGauge g (-25)-      report `shouldReturn` Report "breadth" (Gauge 25 True) 1.0-      report `shouldReturn` Report "stats.gauges.breadth" (Gauge 25 False) 1.0-  describe "set" $ do-    it "reports events" $ \(stats, report) -> do-      let set = ["one", "two", "three", "three"]-      s <- newStatSet stats "potatoes"-      forM_ set (newSetElement s)-      rs <- replicateM (length set) report-      let rs' = map (\x -> Report "potatoes" (Set x) 1.0) set-      rs `shouldMatchList` rs'-    it "reports stats" $ \(stats, report) -> do-      let set = ["two", "three", "one", "two", "three", "three"]-      s <- newStatSet stats "bananas"-      forM_ set (newSetElement s)-      let rs' =-            [ Report "stats.sets.bananas.count" (Counter 3) 1.0,-              Report "stats.sets.bananas.count" (Counter 0) 1.0-            ]-      rs <- replicateM (length set + length rs') report-      rs `shouldEndWith` rs'+      it "reports stats" $ \(stats, report) -> do+        let gauges = [51 .. 55]+        g <- newStatGauge stats "radius" 50+        r <- report+        r `shouldBe` Report "stats.gauges.radius" (Gauge 50 False) 1.0+        forM_ gauges (setGauge g)+        replicateM_ (length gauges) report+        rs <- replicateM 2 report+        let rs' = replicate 2 $ Report "stats.gauges.radius" (Gauge 55 False) 1.0+        rs `shouldMatchList` rs'+      it "increments and decrements value" $ \(stats, report) -> do+        g <- newStatGauge stats "breadth" 50+        incrementGauge g 5+        report `shouldReturn` Report "breadth" (Gauge 5 True) 1.0+        report `shouldReturn` Report "stats.gauges.breadth" (Gauge 55 False) 1.0+        incrementGauge g (-10)+        report `shouldReturn` Report "breadth" (Gauge (-10) True) 1.0+        report `shouldReturn` Report "stats.gauges.breadth" (Gauge 45 False) 1.0+        decrementGauge g 50+        report `shouldReturn` Report "breadth" (Gauge (-50) True) 1.0+        report `shouldReturn` Report "stats.gauges.breadth" (Gauge 0 False) 1.0+        decrementGauge g (-25)+        report `shouldReturn` Report "breadth" (Gauge 25 True) 1.0+        report `shouldReturn` Report "stats.gauges.breadth" (Gauge 25 False) 1.0+    describe "set" $ do+      it "reports events" $ \(stats, report) -> do+        let set = ["one", "two", "three", "three"]+        s <- newStatSet stats "potatoes"+        forM_ set (newSetElement s)+        rs <- replicateM (length set) report+        let rs' = map (\x -> Report "potatoes" (Set (C.pack x)) 1.0) set+        rs `shouldMatchList` rs'+      it "reports stats" $ \(stats, report) -> do+        let set = ["two", "three", "one", "two", "three", "three"]+        s <- newStatSet stats "bananas"+        forM_ set (newSetElement s)+        let rs' =+              [ Report "stats.sets.bananas.count" (Counter 3) 1.0,+                Report "stats.sets.bananas.count" (Counter 0) 1.0+              ]+        rs <- replicateM (length set + length rs') report+        rs `shouldEndWith` rs'  withMockStats ::   (MonadUnliftIO m) =>@@ -245,13 +260,13 @@     withAsync (fwd s2 q) $ \a1 -> do       link a1       m <- newTVarIO HashMap.empty-      let s = Stats m cfg {newline = True} s1+      let s = newStats cfg {appendNewline = True} m 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))+      bs <- liftIO $ C.lines <$> recv s2 (2 ^ (20 :: Int))       let rs = map (fromJust . parseReport) bs       mapM_ (atomically . writeTQueue q) rs @@ -260,3 +275,75 @@   bracket     (liftIO (socketPair AF_UNIX Stream 0))     (\(s1, s2) -> liftIO (close s1 >> close s2))++testConfig :: StatConfig+testConfig = defStatConfig {flushInterval = 50}++med :: [Int] -> Int+med ls+  | odd (length ls) =+      sort ls !! (length ls `div` 2)+  | otherwise =+      let ix = length ls `div` 2+          x = sort ls !! ix+          y = sort ls !! (ix - 1)+       in (x + y) `div` 2++mea :: [Int] -> Int+mea ls = sum ls `div` length ls++sumsq :: [Int] -> Int+sumsq = sum . map (\x -> x * x)++percent :: Int -> [Int] -> [Int]+percent pc ls = take (length ls * pc `div` 100) (sort ls)++std :: [Int] -> Int+std ls =+  let l = fromIntegral (length ls)+      ds = map (subtract (mea ls)) ls+      s = fromIntegral $ sumsq ds :: Double+      v = s / l+   in round (sqrt v)++genValidString :: Gen ByteString+genValidString =+  C.pack <$> listOf1 (arbitraryASCIIChar `suchThat` isValidChar)++isValidChar :: Char -> Bool+isValidChar c =+  isAscii c && (isAlpha c || isNumber c || isWhitelist c)+  where+    isWhitelist = flip elem (".-_" :: [Char])++genRate :: Gen Double+genRate = arbitrary `suchThat` \n -> n > 0.0 && n <= 1.0++genNatural :: Gen Int+genNatural = arbitrary `suchThat` (0 <=)++instance Arbitrary Value where+  arbitrary =+    oneof [counter, gauge, timing, set]+    where+      counter = Counter <$> genNatural+      timing = Timing <$> arbitrary+      set = Set <$> genValidString+      gauge = do+        t <- arbitrary+        v <-+          if t+            then arbitrary+            else genNatural+        return $ Gauge v t++instance Arbitrary Report where+  arbitrary = do+    key <- genValidString+    value <- arbitrary+    rate <- case value of+      Counter {} -> genRate+      Gauge {} -> pure 1.0+      Timing {} -> genRate+      Set {} -> pure 1.0+    return $ Report key value rate