{-# 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 validateValue :: Value -> Bool validateValue :: Value -> Bool validateValue (Counter Int c) = Int c Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 validateValue (Gauge Int g Bool False) = Int g Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 validateValue (Gauge Int _ Bool True) = Bool True validateValue (Timing Int t) = Int t Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 0 validateValue (Set ByteString e) = ByteString -> Bool validateKey ByteString e 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 Bool -> m () -> m () forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Int 0 Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int sampling) (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 "StatsD sampling rate must not be negative" Bool -> m () -> m () forall (f :: * -> *). Applicative f => Bool -> f () -> f () unless (Value -> Bool validateValue Value val) (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 value is not valid for key \"" String -> ShowS forall a. Semigroup a => a -> a -> a <> ByteString -> String C.unpack ByteString key String -> ShowS forall a. Semigroup a => a -> a -> a <> String "\": " String -> ShowS forall a. Semigroup a => a -> a -> a <> Value -> String forall a. Show a => a -> String show Value val 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