-- | 'StateLockMetrics' for txp.

module Pos.DB.Txp.MemState.Metrics
    ( recordTxpMetrics
    ) where

import           Universum

import           Data.Aeson.Types (ToJSON (..))
import           Formatting (sformat, shown, (%))
import qualified System.Metrics as Metrics
import qualified System.Metrics.Gauge as Metrics.Gauge

import           Pos.Chain.Txp (MemPool (_mpSize))
import           Pos.Core.JsonLog.LogEvents (JLEvent (..), JLMemPool (..),
                     MemPoolModifyReason (..))
import           Pos.Core.Metrics.Constants (withCardanoNamespace)
import           Pos.DB.GState.Lock (StateLockMetrics (..))
import           Pos.Util.Wlog (logDebug)

-- | 'StateLockMetrics' to record txp MemPool metrics.
recordTxpMetrics :: Metrics.Store -> TVar MemPool -> IO (StateLockMetrics MemPoolModifyReason)
recordTxpMetrics ekgStore memPoolVar = do
    ekgMemPoolSize <-
        Metrics.createGauge (withCardanoNamespace "MemPoolSize") ekgStore
    ekgMemPoolWaitTimeApplyBlock <-
        Metrics.createGauge (withCardanoNamespace "MemPoolWaitTimeApplyBlock_microseconds") ekgStore
    ekgMemPoolModifyTimeApplyBlock <-
        Metrics.createGauge (withCardanoNamespace "MemPoolModifyTimeApplyBlock_microseconds") ekgStore
    ekgMemPoolWaitTimeApplyBlockWithRollback <-
        Metrics.createGauge (withCardanoNamespace "MemPoolWaitTimeApplyBlockWithRollback_microseconds") ekgStore
    ekgMemPoolModifyTimeApplyBlockWithRollback <-
        Metrics.createGauge (withCardanoNamespace "MemPoolModifyTimeApplyBlockWithRollback_microseconds") ekgStore
    ekgMemPoolWaitTimeProcessTx <-
        Metrics.createGauge (withCardanoNamespace "MemPoolWaitTimeProcessTx_microseconds") ekgStore
    ekgMemPoolModifyTimeProcessTx <-
        Metrics.createGauge (withCardanoNamespace "MemPoolModifyTimeProcessTx_microseconds") ekgStore
    ekgMemPoolQueueLength <-
        Metrics.createGauge (withCardanoNamespace "MemPoolQueueLength") ekgStore

    -- An exponential moving average is used for the time gauges (wait
    -- and modify durations). The parameter alpha is chosen somewhat
    -- arbitrarily.
    -- FIXME take alpha from configuration/CLI, or use a better
    -- estimator.
    let alpha :: Double
        alpha = 0.75

    -- This TxpMetrics specifies what to do when waiting on the
    -- mempool lock, when the mempool lock has been granted, and
    -- when that lock has been released. It updates EKG metrics
    -- and also logs each data point at debug level.
    pure StateLockMetrics
        { slmWait = \reason -> do
              liftIO $ Metrics.Gauge.inc ekgMemPoolQueueLength
              qlen <- liftIO $ Metrics.Gauge.read ekgMemPoolQueueLength
              logDebug $ sformat ("MemPool metrics wait: "%shown%" queue length is "%shown) reason qlen

        , slmAcquire = \reason timeWaited -> do
              liftIO $ Metrics.Gauge.dec ekgMemPoolQueueLength
              let ekgMemPoolWaitTime = case reason of
                      ApplyBlock             -> ekgMemPoolWaitTimeApplyBlock
                      ApplyBlockWithRollback -> ekgMemPoolWaitTimeApplyBlockWithRollback
                      ProcessTransaction     -> ekgMemPoolWaitTimeProcessTx
              timeWaited' <- liftIO $ Metrics.Gauge.read ekgMemPoolWaitTime
              -- Assume a 0-value estimate means we haven't taken
              -- any samples yet.
              let new_ = if timeWaited' == 0
                        then fromIntegral timeWaited
                        else round $ alpha * fromIntegral timeWaited + (1 - alpha) * fromIntegral timeWaited'
              liftIO $ Metrics.Gauge.set ekgMemPoolWaitTime new_
              logDebug $ sformat ("MemPool metrics acquire: "%shown
                                  %" wait time was "%shown) reason timeWaited

        , slmRelease = \reason timeWaited timeElapsed memAllocated -> do
              qlen <- liftIO $ Metrics.Gauge.read ekgMemPoolQueueLength
              oldMemPoolSize <- liftIO $ Metrics.Gauge.read ekgMemPoolSize
              newMemPoolSize <- _mpSize <$> readTVarIO memPoolVar
              liftIO $ Metrics.Gauge.set ekgMemPoolSize (fromIntegral newMemPoolSize)
              let ekgMemPoolModifyTime = case reason of
                      ApplyBlock             -> ekgMemPoolModifyTimeApplyBlock
                      ApplyBlockWithRollback -> ekgMemPoolModifyTimeApplyBlockWithRollback
                      ProcessTransaction     -> ekgMemPoolModifyTimeProcessTx
              timeElapsed' <- liftIO $ Metrics.Gauge.read ekgMemPoolModifyTime
              let new_ = if timeElapsed' == 0
                        then fromIntegral timeElapsed
                        else round $ alpha * fromIntegral timeElapsed + (1 - alpha) * fromIntegral timeElapsed'
              liftIO $ Metrics.Gauge.set ekgMemPoolModifyTime new_
              logDebug $ sformat ("MemPool metrics release: "%shown
                                  %" modify time was "%shown%" size is "%shown)
                         reason timeElapsed newMemPoolSize
              pure . toJSON . JLMemPoolEvent $ JLMemPool
                  reason
                  (fromIntegral timeWaited)
                  (fromIntegral qlen)
                  (fromIntegral timeElapsed)
                  (fromIntegral oldMemPoolSize)
                  (fromIntegral newMemPoolSize)
                  (fromIntegral memAllocated)
        }
