{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

module System.Metrics.StatsD.Internal
  ( Stats (..),
    newStats,
    StatParams,
    newParams,
    StatConfig (..),
    MetricData (..),
    Store (..),
    Metrics,
    newMetrics,
    Value (..),
    Sample (..),
    Report (..),
    StatCounter (..),
    StatGauge (..),
    StatTiming (..),
    StatSet (..),
    addMetric,
    newMetric,
    validateKey,
    addReading,
    newReading,
    processSample,
    statsLoop,
    statsFlush,
    flushStats,
    catKey,
    statReports,
    TimingStats (..),
    makeTimingStats,
    timingReports,
    trimPercentile,
    percentileSuffix,
    timingStats,
    cumulativeSums,
    cumulativeSquares,
    stdev,
    mean,
    median,
    flush,
    toReport,
    formatReport,
    submit,
    connectStatsD,
    parseReport,
    parseRead,
    parseInt,
  )
where

import Control.Monad (MonadPlus (..), forM_, forever, guard, unless, 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 (nub, 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
  ( STM,
    TVar,
    atomically,
    modifyTVar,
    newTVarIO,
    readTVar,
    stateTVar,
  )

data Stats = Stats
  { Stats -> TVar Metrics
metrics :: !(TVar Metrics),
    Stats -> Socket
socket :: !Socket,
    Stats -> StatParams
params :: !StatParams
  }

data StatParams = StatParams
  { StatParams -> ByteString
pfx :: !ByteString,
    StatParams -> ByteString
pfxCounter :: !ByteString,
    StatParams -> ByteString
pfxTimer :: !ByteString,
    StatParams -> ByteString
pfxGauge :: !ByteString,
    StatParams -> ByteString
pfxSet :: !ByteString,
    StatParams -> Int
flush :: !Int,
    StatParams -> Bool
stats :: !Bool,
    StatParams -> Bool
samples :: !Bool,
    StatParams -> [Int]
percentiles :: ![Int],
    StatParams -> Bool
newline :: !Bool
  }

data StatConfig = StatConfig
  { StatConfig -> Bool
reportStats :: !Bool,
    StatConfig -> Bool
reportSamples :: !Bool,
    StatConfig -> String
namespace :: !String,
    StatConfig -> String
prefixStats :: !String,
    StatConfig -> String
prefixCounter :: !String,
    StatConfig -> String
prefixTimer :: !String,
    StatConfig -> String
prefixGauge :: !String,
    StatConfig -> String
prefixSet :: !String,
    StatConfig -> String
statsdServer :: !String,
    StatConfig -> Int
statsdPort :: !Int,
    StatConfig -> Int
flushInterval :: !Int,
    StatConfig -> [Int]
timingPercentiles :: ![Int],
    StatConfig -> Bool
appendNewline :: !Bool
  }
  deriving (Int -> StatConfig -> ShowS
[StatConfig] -> ShowS
StatConfig -> String
(Int -> StatConfig -> ShowS)
-> (StatConfig -> String)
-> ([StatConfig] -> ShowS)
-> Show StatConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatConfig -> ShowS
showsPrec :: Int -> StatConfig -> ShowS
$cshow :: StatConfig -> String
show :: StatConfig -> String
$cshowList :: [StatConfig] -> ShowS
showList :: [StatConfig] -> ShowS
Show, ReadPrec [StatConfig]
ReadPrec StatConfig
Int -> ReadS StatConfig
ReadS [StatConfig]
(Int -> ReadS StatConfig)
-> ReadS [StatConfig]
-> ReadPrec StatConfig
-> ReadPrec [StatConfig]
-> Read StatConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StatConfig
readsPrec :: Int -> ReadS StatConfig
$creadList :: ReadS [StatConfig]
readList :: ReadS [StatConfig]
$creadPrec :: ReadPrec StatConfig
readPrec :: ReadPrec StatConfig
$creadListPrec :: ReadPrec [StatConfig]
readListPrec :: ReadPrec [StatConfig]
Read, StatConfig -> StatConfig -> Bool
(StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool) -> Eq StatConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatConfig -> StatConfig -> Bool
== :: StatConfig -> StatConfig -> Bool
$c/= :: StatConfig -> StatConfig -> Bool
/= :: StatConfig -> StatConfig -> Bool
Eq, Eq StatConfig
Eq StatConfig
-> (StatConfig -> StatConfig -> Ordering)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> Bool)
-> (StatConfig -> StatConfig -> StatConfig)
-> (StatConfig -> StatConfig -> StatConfig)
-> Ord StatConfig
StatConfig -> StatConfig -> Bool
StatConfig -> StatConfig -> Ordering
StatConfig -> StatConfig -> StatConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StatConfig -> StatConfig -> Ordering
compare :: StatConfig -> StatConfig -> Ordering
$c< :: StatConfig -> StatConfig -> Bool
< :: StatConfig -> StatConfig -> Bool
$c<= :: StatConfig -> StatConfig -> Bool
<= :: StatConfig -> StatConfig -> Bool
$c> :: StatConfig -> StatConfig -> Bool
> :: StatConfig -> StatConfig -> Bool
$c>= :: StatConfig -> StatConfig -> Bool
>= :: StatConfig -> StatConfig -> Bool
$cmax :: StatConfig -> StatConfig -> StatConfig
max :: StatConfig -> StatConfig -> StatConfig
$cmin :: StatConfig -> StatConfig -> StatConfig
min :: StatConfig -> StatConfig -> StatConfig
Ord)

data MetricData
  = CounterData !Int
  | GaugeData !Int
  | TimingData ![Int]
  | SetData !(HashSet ByteString)

data Store = Store
  { Store -> Int
index :: !Int,
    Store -> Maybe MetricData
dat :: !(Maybe MetricData)
  }

type Metrics = HashMap ByteString Store

data Value
  = Counter !Int
  | Gauge !Int !Bool
  | Timing !Int
  | Set !ByteString
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Eq Value
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Value -> Value -> Ordering
compare :: Value -> Value -> Ordering
$c< :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
>= :: Value -> Value -> Bool
$cmax :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
min :: Value -> Value -> Value
Ord, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show, ReadPrec [Value]
ReadPrec Value
Int -> ReadS Value
ReadS [Value]
(Int -> ReadS Value)
-> ReadS [Value]
-> ReadPrec Value
-> ReadPrec [Value]
-> Read Value
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Value
readsPrec :: Int -> ReadS Value
$creadList :: ReadS [Value]
readList :: ReadS [Value]
$creadPrec :: ReadPrec Value
readPrec :: ReadPrec Value
$creadListPrec :: ReadPrec [Value]
readListPrec :: ReadPrec [Value]
Read)

data Report = Report
  { Report -> ByteString
key :: !ByteString,
    Report -> Value
value :: !Value,
    Report -> Double
rate :: !Double
  }
  deriving (Report -> Report -> Bool
(Report -> Report -> Bool)
-> (Report -> Report -> Bool) -> Eq Report
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
/= :: Report -> Report -> Bool
Eq, Eq Report
Eq Report
-> (Report -> Report -> Ordering)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Bool)
-> (Report -> Report -> Report)
-> (Report -> Report -> Report)
-> Ord Report
Report -> Report -> Bool
Report -> Report -> Ordering
Report -> Report -> Report
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Report -> Report -> Ordering
compare :: Report -> Report -> Ordering
$c< :: Report -> Report -> Bool
< :: Report -> Report -> Bool
$c<= :: Report -> Report -> Bool
<= :: Report -> Report -> Bool
$c> :: Report -> Report -> Bool
> :: Report -> Report -> Bool
$c>= :: Report -> Report -> Bool
>= :: Report -> Report -> Bool
$cmax :: Report -> Report -> Report
max :: Report -> Report -> Report
$cmin :: Report -> Report -> Report
min :: Report -> Report -> Report
Ord, Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Report -> ShowS
showsPrec :: Int -> Report -> ShowS
$cshow :: Report -> String
show :: Report -> String
$cshowList :: [Report] -> ShowS
showList :: [Report] -> ShowS
Show, ReadPrec [Report]
ReadPrec Report
Int -> ReadS Report
ReadS [Report]
(Int -> ReadS Report)
-> ReadS [Report]
-> ReadPrec Report
-> ReadPrec [Report]
-> Read Report
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Report
readsPrec :: Int -> ReadS Report
$creadList :: ReadS [Report]
readList :: ReadS [Report]
$creadPrec :: ReadPrec Report
readPrec :: ReadPrec Report
$creadListPrec :: ReadPrec [Report]
readListPrec :: ReadPrec [Report]
Read)

data Sample = Sample
  { Sample -> ByteString
key :: !ByteString,
    Sample -> Value
value :: !Value,
    Sample -> Int
sampling :: !Int,
    Sample -> Int
index :: !Int
  }
  deriving (Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
/= :: Sample -> Sample -> Bool
Eq, Eq Sample
Eq Sample
-> (Sample -> Sample -> Ordering)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool)
-> (Sample -> Sample -> Sample)
-> (Sample -> Sample -> Sample)
-> Ord Sample
Sample -> Sample -> Bool
Sample -> Sample -> Ordering
Sample -> Sample -> Sample
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Sample -> Sample -> Ordering
compare :: Sample -> Sample -> Ordering
$c< :: Sample -> Sample -> Bool
< :: Sample -> Sample -> Bool
$c<= :: Sample -> Sample -> Bool
<= :: Sample -> Sample -> Bool
$c> :: Sample -> Sample -> Bool
> :: Sample -> Sample -> Bool
$c>= :: Sample -> Sample -> Bool
>= :: Sample -> Sample -> Bool
$cmax :: Sample -> Sample -> Sample
max :: Sample -> Sample -> Sample
$cmin :: Sample -> Sample -> Sample
min :: Sample -> Sample -> Sample
Ord, Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> String
(Int -> Sample -> ShowS)
-> (Sample -> String) -> ([Sample] -> ShowS) -> Show Sample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sample -> ShowS
showsPrec :: Int -> Sample -> ShowS
$cshow :: Sample -> String
show :: Sample -> String
$cshowList :: [Sample] -> ShowS
showList :: [Sample] -> ShowS
Show, ReadPrec [Sample]
ReadPrec Sample
Int -> ReadS Sample
ReadS [Sample]
(Int -> ReadS Sample)
-> ReadS [Sample]
-> ReadPrec Sample
-> ReadPrec [Sample]
-> Read Sample
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Sample
readsPrec :: Int -> ReadS Sample
$creadList :: ReadS [Sample]
readList :: ReadS [Sample]
$creadPrec :: ReadPrec Sample
readPrec :: ReadPrec Sample
$creadListPrec :: ReadPrec [Sample]
readListPrec :: ReadPrec [Sample]
Read)

data StatCounter = StatCounter
  { StatCounter -> Stats
stats :: !Stats,
    StatCounter -> ByteString
key :: !ByteString,
    StatCounter -> Int
sampling :: !Int
  }

data StatGauge = StatGauge
  { StatGauge -> Stats
stats :: !Stats,
    StatGauge -> ByteString
key :: !ByteString
  }

data StatTiming = StatTiming
  { StatTiming -> Stats
stats :: !Stats,
    StatTiming -> ByteString
key :: !ByteString,
    StatTiming -> Int
sampling :: !Int
  }

data StatSet = StatSet
  { StatSet -> Stats
stats :: !Stats,
    StatSet -> ByteString
key :: !ByteString
  }

addMetric :: StatParams -> ByteString -> MetricData -> Metrics -> Metrics
addMetric :: StatParams -> ByteString -> MetricData -> Metrics -> Metrics
addMetric StatParams
params ByteString
key MetricData
dat =
  ByteString -> Store -> Metrics -> Metrics
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert ByteString
key (Store -> Metrics -> Metrics) -> Store -> Metrics -> Metrics
forall a b. (a -> b) -> a -> b
$
    Int -> Maybe MetricData -> Store
Store Int
0 (Maybe MetricData -> Store) -> Maybe MetricData -> Store
forall a b. (a -> b) -> a -> b
$
      if StatParams
params.stats then MetricData -> Maybe MetricData
forall a. a -> Maybe a
Just MetricData
dat else Maybe MetricData
forall a. Maybe a
Nothing

newMetric :: (MonadIO m) => Stats -> ByteString -> MetricData -> m ()
newMetric :: forall (m :: * -> *).
MonadIO m =>
Stats -> ByteString -> MetricData -> m ()
newMetric Stats
stats ByteString
key MetricData
store = do
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
validateKey ByteString
key) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    IOError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"Metric key is invalid"
  Bool
e <- STM Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Bool -> m Bool) -> STM Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Bool
exists <- ByteString -> Metrics -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member ByteString
key (Metrics -> Bool) -> STM Metrics -> STM Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Metrics -> STM Metrics
forall a. TVar a -> STM a
readTVar Stats
stats.metrics
    if Bool
exists
      then Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      else do
        TVar Metrics -> (Metrics -> Metrics) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar
          Stats
stats.metrics
          (StatParams -> ByteString -> MetricData -> Metrics -> Metrics
addMetric Stats
stats.params ByteString
key MetricData
store)
        Bool -> STM Bool
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
e (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IOError -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (IOError -> m ()) -> IOError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"StatsD key exists: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
C.unpack ByteString
key

validateKey :: ByteString -> Bool
validateKey :: ByteString -> Bool
validateKey ByteString
t = Bool -> Bool
not (ByteString -> Bool
C.null ByteString
t) Bool -> Bool -> Bool
&& (Char -> Bool) -> ByteString -> Bool
C.all Char -> Bool
valid ByteString
t
  where
    valid :: Char -> Bool
valid Char
c = Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (String
"._-" :: [Char]) Bool -> Bool -> Bool
|| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
c

addReading :: Value -> ByteString -> Metrics -> Metrics
addReading :: Value -> ByteString -> Metrics -> Metrics
addReading Value
reading = (Store -> Store) -> ByteString -> Metrics -> Metrics
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HashMap.adjust Store -> Store
adjust
  where
    adjust :: Store -> Store
adjust Store
m = Store
m {$sel:index:Store :: Int
index = Store
m.index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, $sel:dat:Store :: Maybe MetricData
dat = MetricData -> MetricData
change (MetricData -> MetricData) -> Maybe MetricData -> Maybe MetricData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Store
m.dat}
    change :: MetricData -> MetricData
change MetricData
store = case (Value
reading, MetricData
store) of
      (Counter Int
c, CounterData Int
s) ->
        Int -> MetricData
CounterData (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c)
      (Gauge Int
i Bool
False, GaugeData Int
_) ->
        Int -> MetricData
GaugeData Int
i
      (Gauge Int
i Bool
True, GaugeData Int
g)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
g -> Int -> MetricData
GaugeData Int
forall a. Bounded a => a
maxBound
        | Bool
otherwise -> Int -> MetricData
GaugeData (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
g Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i))
      (Timing Int
t, TimingData [Int]
s) ->
        [Int] -> MetricData
TimingData (Int
t Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
s)
      (Set ByteString
e, SetData HashSet ByteString
s) ->
        HashSet ByteString -> MetricData
SetData (ByteString -> HashSet ByteString -> HashSet ByteString
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert ByteString
e HashSet ByteString
s)
      (Value, MetricData)
_ -> String -> MetricData
forall a. HasCallStack => String -> a
error String
"Stats reading mismatch"

newReading :: Stats -> ByteString -> Value -> STM Int
newReading :: Stats -> ByteString -> Value -> STM Int
newReading Stats
stats ByteString
key Value
reading = do
  TVar Metrics -> (Metrics -> Metrics) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Stats
stats.metrics (Value -> ByteString -> Metrics -> Metrics
addReading Value
reading ByteString
key)
  Int -> (Store -> Int) -> Maybe Store -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (.index) (Maybe Store -> Int) -> (Metrics -> Maybe Store) -> Metrics -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Metrics -> Maybe Store
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup ByteString
key
    (Metrics -> Int) -> STM Metrics -> STM Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Metrics -> STM Metrics
forall a. TVar a -> STM a
readTVar Stats
stats.metrics

processSample ::
  (MonadIO m) => Stats -> Int -> ByteString -> Value -> m ()
processSample :: forall (m :: * -> *).
MonadIO m =>
Stats -> Int -> ByteString -> Value -> m ()
processSample Stats
stats Int
sampling ByteString
key Value
val = do
  Int
idx <- STM Int -> m Int
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Int -> m Int) -> STM Int -> m Int
forall a b. (a -> b) -> a -> b
$ Stats -> ByteString -> Value -> STM Int
newReading Stats
stats ByteString
key Value
val
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Stats
stats.params.samples (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Stats -> Sample -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Sample -> m ()
submit Stats
stats (Sample -> m ()) -> Sample -> m ()
forall a b. (a -> b) -> a -> b
$
      ByteString -> Value -> Int -> Int -> Sample
Sample ByteString
key Value
val Int
sampling Int
idx

newMetrics :: (MonadIO m) => m (TVar Metrics)
newMetrics :: forall (m :: * -> *). MonadIO m => m (TVar Metrics)
newMetrics = Metrics -> m (TVar Metrics)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Metrics
forall k v. HashMap k v
HashMap.empty

newParams :: StatConfig -> StatParams
newParams :: StatConfig -> StatParams
newParams StatConfig
cfg
  | Bool
v =
      StatParams
        { $sel:pfx:StatParams :: ByteString
pfx = ByteString
pfx,
          $sel:pfxCounter:StatParams :: ByteString
pfxCounter = ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
          $sel:pfxGauge:StatParams :: ByteString
pfxGauge = ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bg ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
          $sel:pfxTimer:StatParams :: ByteString
pfxTimer = ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bt ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
          $sel:pfxSet:StatParams :: ByteString
pfxSet = ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
be ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".",
          $sel:newline:StatParams :: Bool
newline = StatConfig
cfg.appendNewline,
          $sel:stats:StatParams :: Bool
stats = StatConfig
cfg.reportStats,
          $sel:samples:StatParams :: Bool
samples = StatConfig
cfg.reportSamples,
          $sel:percentiles:StatParams :: [Int]
percentiles = Int
100 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int]
forall a. Eq a => [a] -> [a]
nub StatConfig
cfg.timingPercentiles,
          $sel:flush:StatParams :: Int
flush = StatConfig
cfg.flushInterval
        }
  | Bool
otherwise = String -> StatParams
forall a. HasCallStack => String -> a
error String
"StatsD config invalid"
  where
    bn :: ByteString
bn = String -> ByteString
C.pack StatConfig
cfg.namespace
    bs :: ByteString
bs = String -> ByteString
C.pack StatConfig
cfg.prefixStats
    bg :: ByteString
bg = String -> ByteString
C.pack StatConfig
cfg.prefixGauge
    bc :: ByteString
bc = String -> ByteString
C.pack StatConfig
cfg.prefixCounter
    bt :: ByteString
bt = String -> ByteString
C.pack StatConfig
cfg.prefixTimer
    be :: ByteString
be = String -> ByteString
C.pack StatConfig
cfg.prefixSet
    v :: Bool
v =
      (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ByteString -> Bool
validateKey [ByteString
bs, ByteString
bg, ByteString
bc, ByteString
bt, ByteString
be]
        Bool -> Bool -> Bool
&& Bool -> Bool -> Bool -> Bool
forall a. a -> a -> Bool -> a
bool (ByteString -> Bool
validateKey ByteString
bn) Bool
True (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StatConfig
cfg.namespace)
        Bool -> Bool -> Bool
&& StatConfig
cfg.flushInterval Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        Bool -> Bool -> Bool
&& (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
pc -> Int
pc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
100 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pc) StatConfig
cfg.timingPercentiles
    pfx :: ByteString
pfx =
      if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null StatConfig
cfg.namespace
        then ByteString
""
        else ByteString
bn ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
    s :: ByteString
s = ByteString
pfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."

newStats :: StatConfig -> TVar Metrics -> Socket -> Stats
newStats :: StatConfig -> TVar Metrics -> Socket -> Stats
newStats StatConfig
cfg TVar Metrics
metrics Socket
socket =
  Stats
    { $sel:metrics:Stats :: TVar Metrics
metrics = TVar Metrics
metrics,
      $sel:socket:Stats :: Socket
socket = Socket
socket,
      $sel:params:Stats :: StatParams
params = StatConfig -> StatParams
newParams StatConfig
cfg
    }

statsLoop :: (MonadIO m) => Stats -> m ()
statsLoop :: forall (m :: * -> *). MonadIO m => Stats -> m ()
statsLoop Stats
stats = m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Int -> m ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Stats
stats.params.flush Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
  Stats -> m ()
forall (m :: * -> *). MonadIO m => Stats -> m ()
statsFlush Stats
stats

statsFlush :: (MonadIO m) => Stats -> m ()
statsFlush :: forall (m :: * -> *). MonadIO m => Stats -> m ()
statsFlush Stats
stats = do
  (Report -> m ()) -> [Report] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Stats -> Report -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats)
    ([Report] -> m ()) -> m [Report] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STM [Report] -> m [Report]
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically
      (TVar Metrics -> (Metrics -> ([Report], Metrics)) -> STM [Report]
forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar Stats
stats.metrics (StatParams -> Metrics -> ([Report], Metrics)
flushStats Stats
stats.params))

flushStats :: StatParams -> Metrics -> ([Report], Metrics)
flushStats :: StatParams -> Metrics -> ([Report], Metrics)
flushStats StatParams
params Metrics
metrics =
  let f :: [Report] -> ByteString -> r -> [Report]
f [Report]
xs ByteString
key r
m = [Report]
-> (MetricData -> [Report]) -> Maybe MetricData -> [Report]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Report]
xs (([Report] -> [Report] -> [Report]
forall a. Semigroup a => a -> a -> a
<> [Report]
xs) ([Report] -> [Report])
-> (MetricData -> [Report]) -> MetricData -> [Report]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatParams -> ByteString -> MetricData -> [Report]
statReports StatParams
params ByteString
key) r
m.dat
      rs :: [Report]
rs = ([Report] -> ByteString -> Store -> [Report])
-> [Report] -> Metrics -> [Report]
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HashMap.foldlWithKey' [Report] -> ByteString -> Store -> [Report]
forall {r}.
HasField "dat" r (Maybe MetricData) =>
[Report] -> ByteString -> r -> [Report]
f [] Metrics
metrics
      g :: Store -> Store
g Store
m = Store
m {$sel:dat:Store :: Maybe MetricData
dat = MetricData -> MetricData
flush (MetricData -> MetricData) -> Maybe MetricData -> Maybe MetricData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Store
m.dat}
      ms :: Metrics
ms = (Store -> Store) -> Metrics -> Metrics
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.map Store -> Store
g Metrics
metrics
   in ([Report]
rs, Metrics
ms)

catKey :: [ByteString] -> ByteString
catKey :: [ByteString] -> ByteString
catKey = ByteString -> [ByteString] -> ByteString
C.intercalate ByteString
"." ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
C.null)

statReports :: StatParams -> ByteString -> MetricData -> [Report]
statReports :: StatParams -> ByteString -> MetricData -> [Report]
statReports StatParams
params ByteString
key MetricData
dat = case MetricData
dat of
  CounterData Int
c ->
    [ Report
        { $sel:key:Report :: ByteString
key = StatParams
params.pfxCounter ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".count",
          $sel:value:Report :: Value
value = Int -> Value
Counter Int
c,
          $sel:rate:Report :: Double
rate = Double
1.0
        },
      Report
        { $sel:key:Report :: ByteString
key = StatParams
params.pfxCounter ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".rate",
          $sel:value:Report :: Value
value = Int -> Value
Counter (StatParams -> Int -> Int
computeRate StatParams
params Int
c),
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  GaugeData Int
s ->
    [ Report
        { $sel:key:Report :: ByteString
key = StatParams
params.pfxGauge ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key,
          $sel:value:Report :: Value
value = Int -> Bool -> Value
Gauge Int
s Bool
False,
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  SetData HashSet ByteString
s ->
    [ Report
        { $sel:key:Report :: ByteString
key = StatParams
params.pfxSet ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
".count",
          $sel:value:Report :: Value
value = Int -> Value
Counter (HashSet ByteString -> Int
forall a. HashSet a -> Int
HashSet.size HashSet ByteString
s),
          $sel:rate:Report :: Double
rate = Double
1.0
        }
    ]
  TimingData [Int]
s -> StatParams -> ByteString -> [Int] -> [Report]
timingReports StatParams
params ByteString
key [Int]
s

data TimingStats = TimingStats
  { TimingStats -> Vector Int
timings :: !(Vector Int),
    TimingStats -> Vector Int
cumsums :: !(Vector Int),
    TimingStats -> Vector Int
cumsquares :: !(Vector Int)
  }
  deriving (TimingStats -> TimingStats -> Bool
(TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool) -> Eq TimingStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimingStats -> TimingStats -> Bool
== :: TimingStats -> TimingStats -> Bool
$c/= :: TimingStats -> TimingStats -> Bool
/= :: TimingStats -> TimingStats -> Bool
Eq, Eq TimingStats
Eq TimingStats
-> (TimingStats -> TimingStats -> Ordering)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> Bool)
-> (TimingStats -> TimingStats -> TimingStats)
-> (TimingStats -> TimingStats -> TimingStats)
-> Ord TimingStats
TimingStats -> TimingStats -> Bool
TimingStats -> TimingStats -> Ordering
TimingStats -> TimingStats -> TimingStats
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimingStats -> TimingStats -> Ordering
compare :: TimingStats -> TimingStats -> Ordering
$c< :: TimingStats -> TimingStats -> Bool
< :: TimingStats -> TimingStats -> Bool
$c<= :: TimingStats -> TimingStats -> Bool
<= :: TimingStats -> TimingStats -> Bool
$c> :: TimingStats -> TimingStats -> Bool
> :: TimingStats -> TimingStats -> Bool
$c>= :: TimingStats -> TimingStats -> Bool
>= :: TimingStats -> TimingStats -> Bool
$cmax :: TimingStats -> TimingStats -> TimingStats
max :: TimingStats -> TimingStats -> TimingStats
$cmin :: TimingStats -> TimingStats -> TimingStats
min :: TimingStats -> TimingStats -> TimingStats
Ord, Int -> TimingStats -> ShowS
[TimingStats] -> ShowS
TimingStats -> String
(Int -> TimingStats -> ShowS)
-> (TimingStats -> String)
-> ([TimingStats] -> ShowS)
-> Show TimingStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimingStats -> ShowS
showsPrec :: Int -> TimingStats -> ShowS
$cshow :: TimingStats -> String
show :: TimingStats -> String
$cshowList :: [TimingStats] -> ShowS
showList :: [TimingStats] -> ShowS
Show, ReadPrec [TimingStats]
ReadPrec TimingStats
Int -> ReadS TimingStats
ReadS [TimingStats]
(Int -> ReadS TimingStats)
-> ReadS [TimingStats]
-> ReadPrec TimingStats
-> ReadPrec [TimingStats]
-> Read TimingStats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TimingStats
readsPrec :: Int -> ReadS TimingStats
$creadList :: ReadS [TimingStats]
readList :: ReadS [TimingStats]
$creadPrec :: ReadPrec TimingStats
readPrec :: ReadPrec TimingStats
$creadListPrec :: ReadPrec [TimingStats]
readListPrec :: ReadPrec [TimingStats]
Read)

makeTimingStats :: [Int] -> TimingStats
makeTimingStats :: [Int] -> TimingStats
makeTimingStats [Int]
timings =
  TimingStats
    { $sel:timings:TimingStats :: Vector Int
timings = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int]
sorted,
      $sel:cumsums:TimingStats :: Vector Int
cumsums = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> [Int]
forall a. Num a => [a] -> [a]
cumulativeSums [Int]
sorted),
      $sel:cumsquares:TimingStats :: Vector Int
cumsquares = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> [Int]
forall a. Num a => [a] -> [a]
cumulativeSquares [Int]
sorted)
    }
  where
    sorted :: [Int]
sorted = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int]
timings

timingReports :: StatParams -> ByteString -> [Int] -> [Report]
timingReports :: StatParams -> ByteString -> [Int] -> [Report]
timingReports StatParams
params ByteString
key [Int]
timings =
  (Int -> [Report]) -> [Int] -> [Report]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StatParams -> ByteString -> TimingStats -> Int -> [Report]
timingStats StatParams
params ByteString
key TimingStats
tstats) StatParams
params.percentiles
  where
    tstats :: TimingStats
tstats = [Int] -> TimingStats
makeTimingStats [Int]
timings

trimPercentile :: Int -> TimingStats -> TimingStats
trimPercentile :: Int -> TimingStats -> TimingStats
trimPercentile Int
pc TimingStats
ts =
  TimingStats
ts
    { $sel:timings:TimingStats :: Vector Int
timings = Vector Int -> Vector Int
forall {a}. Vector a -> Vector a
f TimingStats
ts.timings,
      $sel:cumsums:TimingStats :: Vector Int
cumsums = Vector Int -> Vector Int
forall {a}. Vector a -> Vector a
f TimingStats
ts.cumsums,
      $sel:cumsquares:TimingStats :: Vector Int
cumsquares = Vector Int -> Vector Int
forall {a}. Vector a -> Vector a
f TimingStats
ts.cumsquares
    }
  where
    f :: Vector a -> Vector a
f Vector a
ls = Int -> Vector a -> Vector a
forall a. Int -> Vector a -> Vector a
V.take (Vector a -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector a
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pc Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100) Vector a
ls

percentileSuffix :: Int -> ByteString
percentileSuffix :: Int -> ByteString
percentileSuffix Int
pc
  | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
100 = ByteString
""
  | Bool
otherwise = String -> ByteString
C.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"_%d" Int
pc

computeRate :: StatParams -> Int -> Int
computeRate :: StatParams -> Int -> Int
computeRate StatParams
params Int
i = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` StatParams
params.flush

mean :: TimingStats -> Int
mean :: TimingStats -> Int
mean TimingStats
ts = Vector Int -> Int
forall a. Vector a -> a
V.last TimingStats
ts.cumsums Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings

timingStats :: StatParams -> ByteString -> TimingStats -> Int -> [Report]
timingStats :: StatParams -> ByteString -> TimingStats -> Int -> [Report]
timingStats StatParams
params ByteString
key TimingStats
tstats Int
pc =
  [[Report]] -> [Report]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [ByteString -> Value -> Report
mkr ByteString
"count" (Int -> Value
Counter (Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings))],
      [ByteString -> Value -> Report
mkr ByteString
"count_ps" (Int -> Value
Counter Int
rate) | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
100],
      [ByteString -> Value -> Report
mkr ByteString
"std" (Int -> Value
Timing (TimingStats -> Int
stdev TimingStats
ts)) | Int
pc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
100, Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"mean" (Int -> Value
Timing (TimingStats -> Int
mean TimingStats
ts)) | Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"upper" (Int -> Value
Timing (Vector Int -> Int
forall a. Vector a -> a
V.last TimingStats
ts.timings)) | Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"lower" (Int -> Value
Timing (Vector Int -> Int
forall a. Vector a -> a
V.head TimingStats
ts.timings)) | Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"sum" (Int -> Value
Timing (Vector Int -> Int
forall a. Vector a -> a
V.last TimingStats
ts.cumsums)) | Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"sum_squares" (Int -> Value
Timing (Vector Int -> Int
forall a. Vector a -> a
V.last TimingStats
ts.cumsquares)) | Bool -> Bool
not Bool
empty],
      [ByteString -> Value -> Report
mkr ByteString
"median" (Int -> Value
Timing (TimingStats -> Int
median TimingStats
ts)) | Bool -> Bool
not Bool
empty]
    ]
  where
    ts :: TimingStats
ts = Int -> TimingStats -> TimingStats
trimPercentile Int
pc TimingStats
tstats
    empty :: Bool
empty = Vector Int -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TimingStats
ts.timings
    rate :: Int
rate = StatParams -> Int -> Int
computeRate StatParams
params (Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings)
    sfx :: ByteString
sfx = Int -> ByteString
percentileSuffix Int
pc
    pfx :: ByteString
pfx = StatParams
params.pfxTimer ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
key ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"."
    mkr :: ByteString -> Value -> Report
mkr ByteString
s Value
v = Report {$sel:key:Report :: ByteString
key = ByteString
pfx ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sfx, $sel:value:Report :: Value
value = Value
v, $sel:rate:Report :: Double
rate = Double
1.0}

cumulativeSums :: (Num a) => [a] -> [a]
cumulativeSums :: forall a. Num a => [a] -> [a]
cumulativeSums = (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
forall a. Num a => a -> a -> a
(+)

cumulativeSquares :: (Num a) => [a] -> [a]
cumulativeSquares :: forall a. Num a => [a] -> [a]
cumulativeSquares = (a -> a -> a) -> [a] -> [a]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 a -> a -> a
forall a. Num a => a -> a -> a
(+) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x)

stdev :: TimingStats -> Int
stdev :: TimingStats -> Int
stdev TimingStats
ts =
  Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Floating a => a -> a
sqrt Double
var
  where
    len :: Int
len = Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings
    var :: Double
var = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len :: Double
    ds :: Int
ds = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (TimingStats -> Int
mean TimingStats
ts)) (Vector Int -> [Int]
forall a. Vector a -> [a]
V.toList TimingStats
ts.timings)

median :: TimingStats -> Int
median :: TimingStats -> Int
median TimingStats
ts
  | Vector Int -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null TimingStats
ts.timings = Int
0
  | Int -> Bool
forall a. Integral a => a -> Bool
even (Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings) =
      let lower :: Int
lower = TimingStats
ts.timings Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
middle
          upper :: Int
upper = TimingStats
ts.timings Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1 Int
middle
       in (Int
lower Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
upper) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
  | Bool
otherwise =
      TimingStats
ts.timings Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! Int
middle
  where
    middle :: Int
middle = Vector Int -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TimingStats
ts.timings Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

flush :: MetricData -> MetricData
flush :: MetricData -> MetricData
flush (CounterData Int
_) = Int -> MetricData
CounterData Int
0
flush (GaugeData Int
g) = Int -> MetricData
GaugeData Int
g
flush (TimingData [Int]
_) = [Int] -> MetricData
TimingData []
flush (SetData HashSet ByteString
_) = HashSet ByteString -> MetricData
SetData HashSet ByteString
forall a. HashSet a
HashSet.empty

toReport :: Sample -> Maybe Report
toReport :: Sample -> Maybe Report
toReport Sample
sample
  | Sample
sample.sampling Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Sample
sample.index Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Sample
sample.sampling Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
      Report -> Maybe Report
forall a. a -> Maybe a
Just
        Report
          { $sel:key:Report :: ByteString
key = Sample
sample.key,
            $sel:value:Report :: Value
value = Sample
sample.value,
            $sel:rate:Report :: Double
rate = Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Sample
sample.sampling
          }
  | Bool
otherwise = Maybe Report
forall a. Maybe a
Nothing

formatReport :: Report -> ByteString
formatReport :: Report -> ByteString
formatReport Report
report = ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
builder
  where
    builder :: Builder
builder = ByteString -> Builder
byteString Report
report.key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char8 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val
    rate :: Builder
rate
      | Report
report.rate Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1.0 =
          String -> Builder
string8 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"|@%f" Report
report.rate
      | Bool
otherwise = Builder
forall a. Monoid a => a
mempty
    val :: Builder
val =
      case Report
report.value of
        Counter Int
i ->
          Int -> Builder
intDec Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"|c" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rate
        Gauge Int
g Bool
False ->
          Int -> Builder
intDec Int
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"|g"
        Gauge Int
g Bool
True ->
          let sign :: Builder
sign = if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
g then Char -> Builder
char8 Char
'+' else Builder
forall a. Monoid a => a
mempty
           in Builder
sign Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
intDec Int
g Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"|g"
        Timing Int
t ->
          Int -> Builder
intDec Int
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"|ms" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
rate
        Set ByteString
e ->
          ByteString -> Builder
byteString ByteString
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"|s"

submit :: (MonadIO m) => Stats -> Sample -> m ()
submit :: forall (m :: * -> *). MonadIO m => Stats -> Sample -> m ()
submit Stats
stats Sample
sample =
  Maybe Report -> (Report -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Sample -> Maybe Report
toReport Sample
sample) (Stats -> Report -> m ()
forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats)

send :: (MonadIO m) => Stats -> Report -> m ()
send :: forall (m :: * -> *). MonadIO m => Stats -> Report -> m ()
send Stats
stats Report
report =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    (IOError -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(IOError -> m a) -> m a -> m a
handleIO (IO () -> IOError -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$
        Socket -> ByteString -> IO Int
Net.send
          Stats
stats.socket
          (Report -> ByteString
formatReport Report
report ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Bool -> ByteString
forall a. a -> a -> Bool -> a
bool ByteString
"" ByteString
"\n" Stats
stats.params.newline)

connectStatsD :: (MonadIO m) => String -> Int -> m Socket
connectStatsD :: forall (m :: * -> *). MonadIO m => String -> Int -> m Socket
connectStatsD String
host Int
port = IO Socket -> m Socket
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> m Socket) -> IO Socket -> m Socket
forall a b. (a -> b) -> a -> b
$ do
  [AddrInfo]
as <-
    Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
Net.getAddrInfo
      Maybe AddrInfo
forall a. Maybe a
Nothing
      (String -> Maybe String
forall a. a -> Maybe a
Just String
host)
      (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
port)
  AddrInfo
a <- case [AddrInfo]
as of
    AddrInfo
a : [AddrInfo]
_ -> AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AddrInfo
a
    [] -> String -> IO AddrInfo
forall a. HasCallStack => String -> a
error (String -> IO AddrInfo) -> String -> IO AddrInfo
forall a b. (a -> b) -> a -> b
$ String
"Cannot resolve: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
host String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
port
  Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
Net.socket (AddrInfo -> Family
Net.addrFamily AddrInfo
a) SocketType
Net.Datagram ProtocolNumber
Net.defaultProtocol
  Socket -> SockAddr -> IO ()
Net.connect Socket
sock (AddrInfo -> SockAddr
Net.addrAddress AddrInfo
a)
  Socket -> IO Socket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock

parseReport :: (MonadPlus m) => ByteString -> m Report
parseReport :: forall (m :: * -> *). MonadPlus m => ByteString -> m Report
parseReport ByteString
bs =
  case Char -> ByteString -> [ByteString]
C.split Char
'|' ByteString
bs of
    [ByteString
kv, ByteString
t] -> do
      (ByteString
k, Value
v) <- ByteString -> ByteString -> m (ByteString, Value)
forall {m :: * -> *}.
MonadPlus m =>
ByteString -> ByteString -> m (ByteString, Value)
parseKeyValue ByteString
kv ByteString
t
      Report -> m Report
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Report -> m Report) -> Report -> m Report
forall a b. (a -> b) -> a -> b
$ ByteString -> Value -> Double -> Report
Report ByteString
k Value
v Double
1.0
    [ByteString
kv, ByteString
t, ByteString
r] -> do
      (ByteString
k, Value
v) <- ByteString -> ByteString -> m (ByteString, Value)
forall {m :: * -> *}.
MonadPlus m =>
ByteString -> ByteString -> m (ByteString, Value)
parseKeyValue ByteString
kv ByteString
t
      Double
x <- ByteString -> m Double
forall {m :: * -> *} {b}.
(MonadPlus m, Read b, Ord b, Fractional b) =>
ByteString -> m b
parseRate ByteString
r
      Report -> m Report
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Report -> m Report) -> Report -> m Report
forall a b. (a -> b) -> a -> b
$ ByteString -> Value -> Double -> Report
Report ByteString
k Value
v Double
x
    [ByteString]
_ -> m Report
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    parseKeyValue :: ByteString -> ByteString -> m (ByteString, Value)
parseKeyValue ByteString
kv ByteString
t = do
      case Char -> ByteString -> [ByteString]
C.split Char
':' ByteString
kv of
        [ByteString
key, ByteString
v] -> do
          Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
validateKey ByteString
key)
          Value
value <- ByteString -> ByteString -> m Value
forall {f :: * -> *}.
MonadPlus f =>
ByteString -> ByteString -> f Value
parseValue ByteString
v ByteString
t
          (ByteString, Value) -> m (ByteString, Value)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
key, Value
value)
        [ByteString]
_ -> m (ByteString, Value)
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    parseValue :: ByteString -> ByteString -> f Value
parseValue ByteString
v ByteString
t =
      case ByteString -> String
C.unpack ByteString
t of
        String
"c" -> Int -> Value
Counter (Int -> Value) -> f Int -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f Int
forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseNatural ByteString
v
        String
"g" ->
          case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
v of
            Just (Char
'+', ByteString
_) -> Int -> Bool -> Value
Gauge (Int -> Bool -> Value) -> f Int -> f (Bool -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f Int
forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseInt ByteString
v f (Bool -> Value) -> f Bool -> f Value
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Just (Char
'-', ByteString
_) -> Int -> Bool -> Value
Gauge (Int -> Bool -> Value) -> f Int -> f (Bool -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f Int
forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseInt ByteString
v f (Bool -> Value) -> f Bool -> f Value
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
            Maybe (Char, ByteString)
_ -> Int -> Bool -> Value
Gauge (Int -> Bool -> Value) -> f Int -> f (Bool -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f Int
forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseNatural ByteString
v f (Bool -> Value) -> f Bool -> f Value
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> f Bool
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        String
"s" -> do
          Bool -> f ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Bool
validateKey ByteString
v)
          Value -> f Value
forall a. a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Value
Set ByteString
v)
        String
"ms" -> Int -> Value
Timing (Int -> Value) -> f Int -> f Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> f Int
forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseNatural ByteString
v
        String
_ -> f Value
forall a. f a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    parseRate :: ByteString -> m b
parseRate ByteString
r = case ByteString -> Maybe (Char, ByteString)
C.uncons ByteString
r of
      Just (Char
'@', ByteString
s) -> do
        b
t <- ByteString -> m b
forall (m :: * -> *) a. (MonadPlus m, Read a) => ByteString -> m a
parseRead ByteString
s
        Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b
t b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0.0)
        Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (b
t b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
1.0)
        b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
t
      Maybe (Char, ByteString)
_ -> m b
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseRead :: (MonadPlus m, Read a) => ByteString -> m a
parseRead :: forall (m :: * -> *) a. (MonadPlus m, Read a) => ByteString -> m a
parseRead = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m a) -> (ByteString -> Maybe a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a)
-> (ByteString -> String) -> ByteString -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack

parseInt :: (MonadPlus m) => ByteString -> m Int
parseInt :: forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseInt ByteString
bs = case ByteString -> Maybe (Int, ByteString)
C.readInt ByteString
bs of
  Just (Int
i, ByteString
bs') | ByteString -> Bool
B.null ByteString
bs' -> Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
  Maybe (Int, ByteString)
_ -> m Int
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseNatural :: (MonadPlus m) => ByteString -> m Int
parseNatural :: forall (m :: * -> *). MonadPlus m => ByteString -> m Int
parseNatural ByteString
bs = case ByteString -> Maybe (Int, ByteString)
C.readInt ByteString
bs of
  Just (Int
i, ByteString
bs') | ByteString -> Bool
B.null ByteString
bs' -> Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i) m () -> m Int -> m Int
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m Int
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i
  Maybe (Int, ByteString)
_ -> m Int
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero