{-# 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 :: forall (m :: * -> *) a.
MonadIO m =>
Text -> Int -> Text -> (Store -> m a) -> m a
withStats Text
h Int
p Text
pfx Store -> m a
go = do
  Store
store <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Store
newStore
  Statsd
_statsd <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 :: forall (m :: * -> *). MonadIO m => Text -> Store -> m StatDist
createStatDist Text
t Store
store = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  TQueue Int64
distQueue <- forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
  TVar Int64
distQueries <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int64
0
  TVar Int64
distItems <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int64
0
  TVar Int64
distClientErrors <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int64
0
  TVar Int64
distServerErrors <- forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int64
0
  let metrics :: HashMap Text (StatData -> Value)
metrics =
        forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
          [ ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".request_count",
              Int64 -> Value
Counter forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> Int64
statQueries
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".item_count",
              Int64 -> Value
Counter forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> Int64
statItems
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".client_errors",
              Int64 -> Value
Counter forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> Int64
statClientErrors
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".server_errors",
              Int64 -> Value
Counter forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> Int64
statServerErrors
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".mean_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
mean forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".avg_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
avg forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".max_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
maxi forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".min_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
mini forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".p90max_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
p90max forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".p90avg_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
p90avg forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            ),
            ( Text
t forall a. Semigroup a => a -> a -> a
<> Text
".var_ms",
              Int64 -> Value
Gauge forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Int64
var forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatData -> [Int64]
statTimes
            )
          ]
  let sd :: StatDist
sd = 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
..}
  forall a. HashMap Text (a -> Value) -> IO a -> Store -> IO ()
registerGroup HashMap Text (StatData -> Value)
metrics (forall (m :: * -> *). MonadIO m => StatDist -> m StatData
flush StatDist
sd) Store
store
  forall (m :: * -> *) a. Monad m => a -> m a
return StatDist
sd

toDouble :: Int64 -> Double
toDouble :: Int64 -> Double
toDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral

addStatTime :: MonadIO m => StatDist -> Int64 -> m ()
addStatTime :: forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatTime StatDist
q =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TQueue a -> a -> STM ()
writeTQueue (StatDist -> TQueue Int64
distQueue StatDist
q)

addStatQuery :: MonadIO m => StatDist -> m ()
addStatQuery :: forall (m :: * -> *). MonadIO m => StatDist -> m ()
addStatQuery StatDist
q =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (StatDist -> TVar Int64
distQueries StatDist
q) (forall a. Num a => a -> a -> a
+ Int64
1)

addStatItems :: MonadIO m => StatDist -> Int64 -> m ()
addStatItems :: forall (m :: * -> *). MonadIO m => StatDist -> Int64 -> m ()
addStatItems StatDist
q =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (StatDist -> TVar Int64
distItems StatDist
q) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(+)

addClientError :: MonadIO m => StatDist -> m ()
addClientError :: forall (m :: * -> *). MonadIO m => StatDist -> m ()
addClientError StatDist
q =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (StatDist -> TVar Int64
distClientErrors StatDist
q) (forall a. Num a => a -> a -> a
+ Int64
1)

addServerError :: MonadIO m => StatDist -> m ()
addServerError :: forall (m :: * -> *). MonadIO m => StatDist -> m ()
addServerError StatDist
q =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (StatDist -> TVar Int64
distServerErrors StatDist
q) (forall a. Num a => a -> a -> a
+ Int64
1)

flush :: MonadIO m => StatDist -> m StatData
flush :: forall (m :: * -> *). MonadIO m => 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
..} = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
  [Int64]
statTimes <- forall a. TQueue a -> STM [a]
flushTQueue TQueue Int64
distQueue
  Int64
statQueries <- forall a. TVar a -> STM a
readTVar TVar Int64
distQueries
  Int64
statItems <- forall a. TVar a -> STM a
readTVar TVar Int64
distItems
  Int64
statClientErrors <- forall a. TVar a -> STM a
readTVar TVar Int64
distClientErrors
  Int64
statServerErrors <- forall a. TVar a -> STM a
readTVar TVar Int64
distServerErrors
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall a. Fractional a => Fold a a
average = forall a. Fractional a => a -> a -> a
(/) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Num a => Fold a a
L.sum forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b a. Num b => Fold a b
L.genericLength

avg :: [Int64] -> Int64
avg :: [Int64] -> Int64
avg = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold forall a. Fractional a => Fold a a
average forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Double
toDouble

mean :: [Int64] -> Int64
mean :: [Int64] -> Int64
mean = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold forall a. Fractional a => Fold a a
L.mean forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Int64 -> Double
toDouble

maxi :: [Int64] -> Int64
maxi :: [Int64] -> Int64
maxi = forall a. a -> Maybe a -> a
fromMaybe Int64
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold forall a. Ord a => Fold a (Maybe a)
L.maximum

mini :: [Int64] -> Int64
mini :: [Int64] -> Int64
mini = forall a. a -> Maybe a -> a
fromMaybe Int64
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold forall a. Ord a => Fold a (Maybe a)
L.minimum

var :: [Int64] -> Int64
var :: [Int64] -> Int64
var = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
L.fold forall a. Fractional a => Fold a a
L.variance forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a. a -> Down a
Down) [Int64]
ls
    len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
sorted
    chopped :: [Int64]
chopped = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
sorted forall a. Num a => a -> a -> a
* Int
1 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 = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a. a -> Down a
Down) [Int64]
ls
    len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
sorted
    chopped :: [Int64]
chopped = forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int64]
sorted forall a. Num a => a -> a -> a
* Int
1 forall a. Integral a => a -> a -> a
`div` Int
10) [Int64]
sorted