{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Haskoin.Store.Stats ( StatDist, withStats, createStatDist, addStatTime, addClientError, addServerError, addStatQuery, addStatItems, ) 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, TVar, atomically, liftIO, modifyTVar, newTQueueIO, newTVarIO, readTVar, 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 Text h Int p Text pfx 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 StatData = StatData { StatData -> [Int64] statTimes :: ![Int64], StatData -> Int64 statQueries :: !Int64, StatData -> Int64 statItems :: !Int64, StatData -> Int64 statClientErrors :: !Int64, StatData -> Int64 statServerErrors :: !Int64 } data StatDist = StatDist { StatDist -> TQueue Int64 distQueue :: !(TQueue Int64), StatDist -> TVar Int64 distQueries :: !(TVar Int64), StatDist -> TVar Int64 distItems :: !(TVar Int64), StatDist -> TVar Int64 distClientErrors :: !(TVar Int64), StatDist -> TVar Int64 distServerErrors :: !(TVar Int64) } createStatDist :: MonadIO m => Text -> Store -> m StatDist createStatDist :: Text -> Store -> m StatDist createStatDist Text t 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 TQueue Int64 distQueue <- IO (TQueue Int64) forall (m :: * -> *) a. MonadIO m => m (TQueue a) newTQueueIO TVar Int64 distQueries <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO Int64 0 TVar Int64 distItems <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO Int64 0 TVar Int64 distClientErrors <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO Int64 0 TVar Int64 distServerErrors <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO Int64 0 let metrics :: HashMap Text (StatData -> Value) metrics = [(Text, StatData -> Value)] -> HashMap Text (StatData -> 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 <> Text ".request_count", Int64 -> Value Counter (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> Int64 statQueries ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".item_count", Int64 -> Value Counter (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> Int64 statItems ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".client_errors", Int64 -> Value Counter (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> Int64 statClientErrors ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".server_errors", Int64 -> Value Counter (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> Int64 statServerErrors ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".mean_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mean ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".avg_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 avg ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".max_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 maxi ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".min_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 mini ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".p90max_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90max ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".p90avg_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90avg ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ), ( Text t Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ".var_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 var ([Int64] -> Int64) -> (StatData -> [Int64]) -> StatData -> Int64 forall b c a. (b -> c) -> (a -> b) -> a -> c . StatData -> [Int64] statTimes ) ] let sd :: StatDist sd = StatDist :: TQueue Int64 -> TVar Int64 -> TVar Int64 -> TVar Int64 -> TVar Int64 -> StatDist StatDist {TVar Int64 TQueue Int64 distServerErrors :: TVar Int64 distClientErrors :: TVar Int64 distItems :: TVar Int64 distQueries :: TVar Int64 distQueue :: TQueue Int64 distServerErrors :: TVar Int64 distClientErrors :: TVar Int64 distItems :: TVar Int64 distQueries :: TVar Int64 distQueue :: TQueue Int64 ..} HashMap Text (StatData -> Value) -> IO StatData -> Store -> IO () forall a. HashMap Text (a -> Value) -> IO a -> Store -> IO () registerGroup HashMap Text (StatData -> Value) metrics (StatDist -> IO StatData forall (m :: * -> *). MonadIO m => StatDist -> m StatData flush StatDist sd) Store store StatDist -> IO StatDist forall (m :: * -> *) a. Monad m => a -> m a return StatDist sd toDouble :: Int64 -> Double toDouble :: Int64 -> Double toDouble = Int64 -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral addStatTime :: MonadIO m => StatDist -> Int64 -> m () addStatTime :: StatDist -> Int64 -> m () addStatTime StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (Int64 -> IO ()) -> Int64 -> 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 ()) -> (Int64 -> STM ()) -> Int64 -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . TQueue Int64 -> Int64 -> STM () forall a. TQueue a -> a -> STM () writeTQueue (StatDist -> TQueue Int64 distQueue StatDist q) addStatQuery :: MonadIO m => StatDist -> m () addStatQuery :: StatDist -> m () addStatQuery StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . STM () -> IO () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> STM () -> m () forall a b. (a -> b) -> a -> b $ TVar Int64 -> (Int64 -> Int64) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (StatDist -> TVar Int64 distQueries StatDist q) (Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a + Int64 1) addStatItems :: MonadIO m => StatDist -> Int64 -> m () addStatItems :: StatDist -> Int64 -> m () addStatItems StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (Int64 -> IO ()) -> Int64 -> 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 ()) -> (Int64 -> STM ()) -> Int64 -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . TVar Int64 -> (Int64 -> Int64) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (StatDist -> TVar Int64 distItems StatDist q) ((Int64 -> Int64) -> STM ()) -> (Int64 -> Int64 -> Int64) -> Int64 -> STM () forall b c a. (b -> c) -> (a -> b) -> a -> c . Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a (+) addClientError :: MonadIO m => StatDist -> m () addClientError :: StatDist -> m () addClientError StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . STM () -> IO () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> STM () -> m () forall a b. (a -> b) -> a -> b $ TVar Int64 -> (Int64 -> Int64) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (StatDist -> TVar Int64 distClientErrors StatDist q) (Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a + Int64 1) addServerError :: MonadIO m => StatDist -> m () addServerError :: StatDist -> m () addServerError StatDist q = IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (STM () -> IO ()) -> STM () -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . STM () -> IO () forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM () -> m ()) -> STM () -> m () forall a b. (a -> b) -> a -> b $ TVar Int64 -> (Int64 -> Int64) -> STM () forall a. TVar a -> (a -> a) -> STM () modifyTVar (StatDist -> TVar Int64 distServerErrors StatDist q) (Int64 -> Int64 -> Int64 forall a. Num a => a -> a -> a + Int64 1) flush :: MonadIO m => StatDist -> m StatData flush :: StatDist -> m StatData flush StatDist {TVar Int64 TQueue Int64 distServerErrors :: TVar Int64 distClientErrors :: TVar Int64 distItems :: TVar Int64 distQueries :: TVar Int64 distQueue :: TQueue Int64 distServerErrors :: StatDist -> TVar Int64 distClientErrors :: StatDist -> TVar Int64 distItems :: StatDist -> TVar Int64 distQueries :: StatDist -> TVar Int64 distQueue :: StatDist -> TQueue Int64 ..} = STM StatData -> m StatData forall (m :: * -> *) a. MonadIO m => STM a -> m a atomically (STM StatData -> m StatData) -> STM StatData -> m StatData forall a b. (a -> b) -> a -> b $ do [Int64] statTimes <- TQueue Int64 -> STM [Int64] forall a. TQueue a -> STM [a] flushTQueue TQueue Int64 distQueue Int64 statQueries <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 distQueries Int64 statItems <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 distItems Int64 statClientErrors <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 distClientErrors Int64 statServerErrors <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 distServerErrors StatData -> STM StatData forall (m :: * -> *) a. Monad m => a -> m a return (StatData -> STM StatData) -> StatData -> STM StatData forall a b. (a -> b) -> a -> b $ StatData :: [Int64] -> Int64 -> Int64 -> Int64 -> Int64 -> StatData StatData {Int64 [Int64] statServerErrors :: Int64 statClientErrors :: Int64 statItems :: Int64 statQueries :: Int64 statTimes :: [Int64] statServerErrors :: Int64 statClientErrors :: Int64 statItems :: Int64 statQueries :: Int64 statTimes :: [Int64] ..} 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 Int64 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 Int64 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 [Int64] ls = case [Int64] chopped of [] -> Int64 0 Int64 h : [Int64] _ -> 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 * Int 1 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 10) [Int64] sorted p90avg :: [Int64] -> Int64 p90avg :: [Int64] -> Int64 p90avg [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 * Int 1 Int -> Int -> Int forall a. Integral a => a -> a -> a `div` Int 10) [Int64] sorted