{-# 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))