{-# LANGUAGE OverloadedStrings #-} module Haskoin.Store.Stats ( StatDist , StatEntry(..) , withStats , createStatDist , addStatEntry ) where import Control.Concurrent.STM.TQueue (TQueue, flushTQueue, writeTQueue) import qualified Control.Foldl as L import Control.Monad (forever) import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.Int (Int64) import Data.List (sort, sortBy) import Data.Maybe (fromMaybe) import Data.Ord (Down (..), comparing) import Data.String.Conversions (cs) import Data.Text (Text) import System.Metrics (Store, Value (..), newStore, registerGcMetrics, registerGroup, sampleAll) import System.Remote.Monitoring.Statsd (defaultStatsdOptions, flushInterval, forkStatsd, host, port, prefix) import UnliftIO (MonadIO, atomically, liftIO, newTQueueIO, withAsync) import UnliftIO.Concurrent (threadDelay) withStats :: MonadIO m => Text -> Int -> Text -> (Store -> m a) -> m a withStats :: Text -> Int -> Text -> (Store -> m a) -> m a withStats h :: Text h p :: Int p pfx :: Text pfx go :: Store -> m a go = do Store store <- IO Store -> m Store forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO Store newStore Statsd _statsd <- IO Statsd -> m Statsd forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Statsd -> m Statsd) -> IO Statsd -> m Statsd forall a b. (a -> b) -> a -> b $ StatsdOptions -> Store -> IO Statsd forkStatsd StatsdOptions defaultStatsdOptions { prefix :: Text prefix = Text pfx , host :: Text host = Text h , port :: Int port = Int p } Store store IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ Store -> IO () registerGcMetrics Store store Store -> m a go Store store data StatEntry = StatEntry { StatEntry -> Int64 statValue :: !Int64 , StatEntry -> Int64 statCount :: !Int64 } type StatDist = TQueue StatEntry createStatDist :: MonadIO m => Text -> Store -> m StatDist createStatDist :: Text -> Store -> m StatDist createStatDist t :: Text t store :: Store store = IO StatDist -> m StatDist forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO StatDist -> m StatDist) -> IO StatDist -> m StatDist forall a b. (a -> b) -> a -> b $ do StatDist q <- IO StatDist forall (m :: * -> *) a. MonadIO m => m (TQueue a) newTQueueIO let metrics :: HashMap Text ([StatEntry] -> Value) metrics = [(Text, [StatEntry] -> Value)] -> HashMap Text ([StatEntry] -> Value) forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HashMap.fromList [ (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".query_count", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Int64 forall a b. (Integral a, Num b) => a -> b fromIntegral (Int -> Int64) -> ([StatEntry] -> Int) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".item_count", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a sum ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 count) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.mean", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mean ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.avg", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 avg ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.max", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 maxi ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.min", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mini ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.p90max", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90max ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.p90min", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90min ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.p90avg", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90avg ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_query.var", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 var ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . (StatEntry -> Int64) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> [a] -> [b] map StatEntry -> Int64 value) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.mean", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mean ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.avg", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 avg ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.max", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 maxi ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.min", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mini ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.p90max", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90max ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.p90min", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90min ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.p90avg", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90avg ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) , (Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> ".per_item.var", Int64 -> Value Gauge (Int64 -> Value) -> ([StatEntry] -> Int64) -> [StatEntry] -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 var ([Int64] -> Int64) -> ([StatEntry] -> [Int64]) -> [StatEntry] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . [StatEntry] -> [Int64] normalize) ] HashMap Text ([StatEntry] -> Value) -> IO [StatEntry] -> Store -> IO () forall a. HashMap Text (a -> Value) -> IO a -> Store -> IO () registerGroup HashMap Text ([StatEntry] -> Value) metrics (StatDist -> IO [StatEntry] forall (m :: * -> *). MonadIO m => StatDist -> m [StatEntry] flush StatDist q) Store store StatDist -> IO StatDist forall (m :: * -> *) a. Monad m => a -> m a return StatDist q where count :: StatEntry -> Int64 count = StatEntry -> Int64 statCount value :: StatEntry -> Int64 value = StatEntry -> Int64 statValue toDouble :: Int64 -> Double toDouble :: Int64 -> Double toDouble = Int64 -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral addStatEntry :: MonadIO m => StatDist -> StatEntry -> m () addStatEntry :: StatDist -> StatEntry -> m () addStatEntry q :: StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (StatEntry -> IO ()) -> StatEntry -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . STM () -> IO () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> IO ()) -> (StatEntry -> STM ()) -> StatEntry -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . StatDist -> StatEntry -> STM () forall a. TQueue a -> a -> STM () writeTQueue StatDist q flush :: MonadIO m => StatDist -> m [StatEntry] flush :: StatDist -> m [StatEntry] flush = STM [StatEntry] -> m [StatEntry] forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM [StatEntry] -> m [StatEntry]) -> (StatDist -> STM [StatEntry]) -> StatDist -> m [StatEntry] forall b c a. (b -> c) -> (a -> b) -> a -> c . StatDist -> STM [StatEntry] forall a. TQueue a -> STM [a] flushTQueue average :: Fractional a => L.Fold a a average :: Fold a a average = a -> a -> a forall a. Fractional a => a -> a -> a (/) (a -> a -> a) -> Fold a a -> Fold a (a -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Fold a a forall a. Num a => Fold a a L.sum Fold a (a -> a) -> Fold a a -> Fold a a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Fold a a forall b a. Num b => Fold a b L.genericLength avg :: [Int64] -> Int64 avg :: [Int64] -> Int64 avg = Double -> Int64 forall a b. (RealFrac a, Integral b) => a -> b round (Double -> Int64) -> ([Int64] -> Double) -> [Int64] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Fold Double Double -> [Double] -> Double forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b L.fold Fold Double Double forall a. Fractional a => Fold a a average ([Double] -> Double) -> ([Int64] -> [Double]) -> [Int64] -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int64 -> Double) -> [Int64] -> [Double] forall a b. (a -> b) -> [a] -> [b] map Int64 -> Double toDouble mean :: [Int64] -> Int64 mean :: [Int64] -> Int64 mean = Double -> Int64 forall a b. (RealFrac a, Integral b) => a -> b round (Double -> Int64) -> ([Int64] -> Double) -> [Int64] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Fold Double Double -> [Double] -> Double forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b L.fold Fold Double Double forall a. Fractional a => Fold a a L.mean ([Double] -> Double) -> ([Int64] -> [Double]) -> [Int64] -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int64 -> Double) -> [Int64] -> [Double] forall a b. (a -> b) -> [a] -> [b] map Int64 -> Double toDouble maxi :: [Int64] -> Int64 maxi :: [Int64] -> Int64 maxi = Int64 -> Maybe Int64 -> Int64 forall a. a -> Maybe a -> a fromMaybe 0 (Maybe Int64 -> Int64) -> ([Int64] -> Maybe Int64) -> [Int64] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Fold Int64 (Maybe Int64) -> [Int64] -> Maybe Int64 forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b L.fold Fold Int64 (Maybe Int64) forall a. Ord a => Fold a (Maybe a) L.maximum mini :: [Int64] -> Int64 mini :: [Int64] -> Int64 mini = Int64 -> Maybe Int64 -> Int64 forall a. a -> Maybe a -> a fromMaybe 0 (Maybe Int64 -> Int64) -> ([Int64] -> Maybe Int64) -> [Int64] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Fold Int64 (Maybe Int64) -> [Int64] -> Maybe Int64 forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b L.fold Fold Int64 (Maybe Int64) forall a. Ord a => Fold a (Maybe a) L.minimum var :: [Int64] -> Int64 var :: [Int64] -> Int64 var = Double -> Int64 forall a b. (RealFrac a, Integral b) => a -> b round (Double -> Int64) -> ([Int64] -> Double) -> [Int64] -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . Fold Double Double -> [Double] -> Double forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b L.fold Fold Double Double forall a. Fractional a => Fold a a L.variance ([Double] -> Double) -> ([Int64] -> [Double]) -> [Int64] -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . (Int64 -> Double) -> [Int64] -> [Double] forall a b. (a -> b) -> [a] -> [b] map Int64 -> Double toDouble p90max :: [Int64] -> Int64 p90max :: [Int64] -> Int64 p90max ls :: [Int64] ls = case [Int64] chopped of [] -> 0 h :: Int64 h:_ -> Int64 h where sorted :: [Int64] sorted = (Int64 -> Int64 -> Ordering) -> [Int64] -> [Int64] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy ((Int64 -> Down Int64) -> Int64 -> Int64 -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing Int64 -> Down Int64 forall a. a -> Down a Down) [Int64] ls len :: Int len = [Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted chopped :: [Int64] chopped = Int -> [Int64] -> [Int64] forall a. Int -> [a] -> [a] drop ([Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted Int -> Int -> Int forall a. Num a => a -> a -> a * 1 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` 10) [Int64] sorted p90min :: [Int64] -> Int64 p90min :: [Int64] -> Int64 p90min ls :: [Int64] ls = case [Int64] chopped of [] -> 0 h :: Int64 h:_ -> Int64 h where sorted :: [Int64] sorted = [Int64] -> [Int64] forall a. Ord a => [a] -> [a] sort [Int64] ls len :: Int len = [Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted chopped :: [Int64] chopped = Int -> [Int64] -> [Int64] forall a. Int -> [a] -> [a] drop ([Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted Int -> Int -> Int forall a. Num a => a -> a -> a * 1 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` 10) [Int64] sorted p90avg :: [Int64] -> Int64 p90avg :: [Int64] -> Int64 p90avg ls :: [Int64] ls = [Int64] -> Int64 avg [Int64] chopped where sorted :: [Int64] sorted = (Int64 -> Int64 -> Ordering) -> [Int64] -> [Int64] forall a. (a -> a -> Ordering) -> [a] -> [a] sortBy ((Int64 -> Down Int64) -> Int64 -> Int64 -> Ordering forall a b. Ord a => (b -> a) -> b -> b -> Ordering comparing Int64 -> Down Int64 forall a. a -> Down a Down) [Int64] ls len :: Int len = [Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted chopped :: [Int64] chopped = Int -> [Int64] -> [Int64] forall a. Int -> [a] -> [a] drop ([Int64] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [Int64] sorted Int -> Int -> Int forall a. Num a => a -> a -> a * 1 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` 10) [Int64] sorted normalize :: [StatEntry] -> [Int64] normalize :: [StatEntry] -> [Int64] normalize = (StatEntry -> [Int64]) -> [StatEntry] -> [Int64] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap ((StatEntry -> [Int64]) -> [StatEntry] -> [Int64]) -> (StatEntry -> [Int64]) -> [StatEntry] -> [Int64] forall a b. (a -> b) -> a -> b $ \(StatEntry x :: Int64 x i :: Int64 i) -> Int -> Int64 -> [Int64] forall a. Int -> a -> [a] replicate (Int64 -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral Int64 i) (Double -> Int64 forall a b. (RealFrac a, Integral b) => a -> b round (Int64 -> Double toDouble Int64 x Double -> Double -> Double forall a. Fractional a => a -> a -> a / Int64 -> Double toDouble Int64 i))