{-# LANGUAGE OverloadedStrings #-} module Haskoin.Store.Stats ( StatDist , withStats , createStatDist , addStatTime , addStatItems , addClientError , addServerError , addStatQuery ) 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 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 StatData = StatData { StatData -> [Int64] statTimes :: ![Int64], StatData -> Int64 statItems :: !Int64, StatData -> Int64 statQueries :: !Int64, StatData -> Int64 statClientErrors :: !Int64, StatData -> Int64 statServerErrors :: !Int64 } data StatDist = StatDist { StatDist -> TQueue Int64 distQueue :: !(TQueue Int64), StatDist -> TVar Int64 distItems :: !(TVar Int64), StatDist -> TVar Int64 distQueries :: !(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 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 TQueue Int64 q <- IO (TQueue Int64) forall (m :: * -> *) a. MonadIO m => m (TQueue a) newTQueueIO TVar Int64 items <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO 0 TVar Int64 queries <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO 0 TVar Int64 client_errors <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO 0 TVar Int64 server_errors <- Int64 -> IO (TVar Int64) forall (m :: * -> *) a. MonadIO m => a -> m (TVar a) newTVarIO 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 <> ".query_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 <> ".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 <> ".errors.client", 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 <> ".errors.server", 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 <> ".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 <> ".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 <> ".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 <> ".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 <> ".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 <> ".p90min_ms", Int64 -> Value Gauge (Int64 -> Value) -> (StatData -> Int64) -> StatData -> Value forall b c a. (b -> c) -> (a -> b) -> a -> c . [Int64] -> Int64 p90min ([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 <> ".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 <> ".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 = TQueue Int64 -> TVar Int64 -> TVar Int64 -> TVar Int64 -> TVar Int64 -> StatDist StatDist TQueue Int64 q TVar Int64 items TVar Int64 queries TVar Int64 client_errors TVar Int64 server_errors 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 q :: 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) addStatItems :: MonadIO m => StatDist -> Int64 -> m () addStatItems :: StatDist -> Int64 -> m () addStatItems q :: 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 (+) addStatQuery :: MonadIO m => StatDist -> m () addStatQuery :: StatDist -> m () addStatQuery q :: 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 +1) addClientError :: MonadIO m => StatDist -> m () addClientError :: StatDist -> m () addClientError q :: 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 +1) addServerError :: MonadIO m => StatDist -> m () addServerError :: StatDist -> m () addServerError q :: 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 +1) flush :: MonadIO m => StatDist -> m StatData flush :: StatDist -> m StatData flush (StatDist q :: TQueue Int64 q i :: TVar Int64 i n :: TVar Int64 n c :: TVar Int64 c s :: TVar Int64 s) = 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] ts <- TQueue Int64 -> STM [Int64] forall a. TQueue a -> STM [a] flushTQueue TQueue Int64 q Int64 is <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 i Int64 qs <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 n Int64 ce <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 c Int64 se <- TVar Int64 -> STM Int64 forall a. TVar a -> STM a readTVar TVar Int64 s 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 $ [Int64] -> Int64 -> Int64 -> Int64 -> Int64 -> StatData StatData [Int64] ts Int64 is Int64 qs Int64 ce Int64 se 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