{-# LANGUAGE OverloadedStrings #-}
module Metrics where

import Data.Text (Text, pack)
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Prometheus (Counter, Gauge, Info (..), MonadMonitor, Vector, addCounter, counter, decGauge,
                   gauge, incCounter, incGauge, register, setGauge, vector, withLabel)

import qualified Network.HTTP.Types as Http


type HttpMethodLabel = Text
type HttpStatusCode = Text

-- We want to store for each (HTTP method, HTTP status code) pair how many times it has been called
type HttpRequestCounter = Vector (HttpMethodLabel, HttpStatusCode) Counter

countHttpRequest :: MonadMonitor m => Http.Method -> Http.Status -> HttpRequestCounter -> m ()
countHttpRequest :: Method -> Status -> HttpRequestCounter -> m ()
countHttpRequest Method
method Status
status HttpRequestCounter
httpRequestCounter = HttpRequestCounter
-> (HttpMethodLabel, HttpMethodLabel) -> (Counter -> IO ()) -> m ()
forall label (m :: * -> *) metric.
(Label label, MonadMonitor m) =>
Vector label metric -> label -> (metric -> IO ()) -> m ()
withLabel HttpRequestCounter
httpRequestCounter (HttpMethodLabel, HttpMethodLabel)
label Counter -> IO ()
forall (m :: * -> *). MonadMonitor m => Counter -> m ()
incCounter
  where
    label :: (HttpMethodLabel, HttpMethodLabel)
label = (HttpMethodLabel
textMethod, HttpMethodLabel
textStatusCode)
    textMethod :: HttpMethodLabel
textMethod = OnDecodeError -> Method -> HttpMethodLabel
decodeUtf8With OnDecodeError
lenientDecode Method
method
    textStatusCode :: HttpMethodLabel
textStatusCode = String -> HttpMethodLabel
pack (String -> HttpMethodLabel) -> String -> HttpMethodLabel
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Status -> Int
Http.statusCode Status
status


data IcepeakMetrics = IcepeakMetrics
  { IcepeakMetrics -> HttpRequestCounter
icepeakMetricsRequestCounter    :: HttpRequestCounter
  -- TODO: the following line can be removed after dashboard has been updated to use icepeak_data_size_bytes
  , IcepeakMetrics -> Gauge
icepeakMetricsDataSize          :: Gauge
  , IcepeakMetrics -> Gauge
icepeakMetricsDataSizeBytes     :: Gauge
  , IcepeakMetrics -> Gauge
icepeakMetricsJournalSize       :: Gauge
  , IcepeakMetrics -> Counter
icepeakMetricsDataWritten       :: Counter
  , IcepeakMetrics -> Counter
icepeakMetricsDataWrittenTotal  :: Counter
  , IcepeakMetrics -> Counter
icepeakMetricsJournalWritten    :: Counter
  , IcepeakMetrics -> Gauge
icepeakMetricsSubscriberCount   :: Gauge
  }

createAndRegisterIcepeakMetrics :: IO IcepeakMetrics
createAndRegisterIcepeakMetrics :: IO IcepeakMetrics
createAndRegisterIcepeakMetrics = HttpRequestCounter
-> Gauge
-> Gauge
-> Gauge
-> Counter
-> Counter
-> Counter
-> Gauge
-> IcepeakMetrics
IcepeakMetrics
  (HttpRequestCounter
 -> Gauge
 -> Gauge
 -> Gauge
 -> Counter
 -> Counter
 -> Counter
 -> Gauge
 -> IcepeakMetrics)
-> IO HttpRequestCounter
-> IO
     (Gauge
      -> Gauge
      -> Gauge
      -> Counter
      -> Counter
      -> Counter
      -> Gauge
      -> IcepeakMetrics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Metric HttpRequestCounter -> IO HttpRequestCounter
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register ((HttpMethodLabel, HttpMethodLabel)
-> Metric Counter -> Metric HttpRequestCounter
forall l m. Label l => l -> Metric m -> Metric (Vector l m)
vector (HttpMethodLabel
"method", HttpMethodLabel
"status") Metric Counter
requestCounter)
  -- TODO: the following line can be removed after dashboard has been updated to use icepeak_data_size_bytes
  IO
  (Gauge
   -> Gauge
   -> Gauge
   -> Counter
   -> Counter
   -> Counter
   -> Gauge
   -> IcepeakMetrics)
-> IO Gauge
-> IO
     (Gauge
      -> Gauge
      -> Counter
      -> Counter
      -> Counter
      -> Gauge
      -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Gauge -> IO Gauge
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Gauge
gauge (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_data_size" HttpMethodLabel
"Size of data file in bytes."))
  IO
  (Gauge
   -> Gauge
   -> Counter
   -> Counter
   -> Counter
   -> Gauge
   -> IcepeakMetrics)
-> IO Gauge
-> IO
     (Gauge -> Counter -> Counter -> Counter -> Gauge -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Gauge -> IO Gauge
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Gauge
gauge (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_data_size_bytes" HttpMethodLabel
"Size of data file in bytes."))
  IO
  (Gauge -> Counter -> Counter -> Counter -> Gauge -> IcepeakMetrics)
-> IO Gauge
-> IO (Counter -> Counter -> Counter -> Gauge -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Gauge -> IO Gauge
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Gauge
gauge (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_journal_size_bytes"
                            HttpMethodLabel
"Size of journal file in bytes."))
  -- TODO: the following line can be removed after dashboard has been updated to use icepeak_data_size_bytes
  IO (Counter -> Counter -> Counter -> Gauge -> IcepeakMetrics)
-> IO Counter -> IO (Counter -> Counter -> Gauge -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Counter -> IO Counter
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Counter
counter (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_data_written" HttpMethodLabel
"Total number of bytes written so far."))
  IO (Counter -> Counter -> Gauge -> IcepeakMetrics)
-> IO Counter -> IO (Counter -> Gauge -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Counter -> IO Counter
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Counter
counter (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_data_written_bytes_total" HttpMethodLabel
"Total number of bytes written so far."))
  IO (Counter -> Gauge -> IcepeakMetrics)
-> IO Counter -> IO (Gauge -> IcepeakMetrics)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Counter -> IO Counter
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Counter
counter (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_journal_written_bytes_total"
                              HttpMethodLabel
"Total number of bytes written to the journal so far."))
  IO (Gauge -> IcepeakMetrics) -> IO Gauge -> IO IcepeakMetrics
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Metric Gauge -> IO Gauge
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
register (Info -> Metric Gauge
gauge
    (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_subscriber_count" HttpMethodLabel
"Number of websocket subscriber connections."))
  where
    requestCounter :: Metric Counter
requestCounter = Info -> Metric Counter
counter (HttpMethodLabel -> HttpMethodLabel -> Info
Info HttpMethodLabel
"icepeak_http_requests"
                                   HttpMethodLabel
"Total number of HTTP requests since starting Icepeak.")

notifyRequest :: Http.Method -> Http.Status -> IcepeakMetrics -> IO ()
notifyRequest :: Method -> Status -> IcepeakMetrics -> IO ()
notifyRequest Method
method Status
status = Method -> Status -> HttpRequestCounter -> IO ()
forall (m :: * -> *).
MonadMonitor m =>
Method -> Status -> HttpRequestCounter -> m ()
countHttpRequest Method
method Status
status (HttpRequestCounter -> IO ())
-> (IcepeakMetrics -> HttpRequestCounter)
-> IcepeakMetrics
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IcepeakMetrics -> HttpRequestCounter
icepeakMetricsRequestCounter

setDataSize :: (MonadMonitor m, Real a) => a -> IcepeakMetrics -> m ()
setDataSize :: a -> IcepeakMetrics -> m ()
setDataSize a
val IcepeakMetrics
metrics = do
  -- TODO: the following line can be removed after dashboard has been updated to use icepeak_data_size_bytes
  Gauge -> Double -> m ()
forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
setGauge (IcepeakMetrics -> Gauge
icepeakMetricsDataSize      IcepeakMetrics
metrics) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
val)
  Gauge -> Double -> m ()
forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
setGauge (IcepeakMetrics -> Gauge
icepeakMetricsDataSizeBytes IcepeakMetrics
metrics) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
val)

setJournalSize :: (MonadMonitor m, Real a) => a -> IcepeakMetrics -> m ()
setJournalSize :: a -> IcepeakMetrics -> m ()
setJournalSize a
val IcepeakMetrics
metrics = Gauge -> Double -> m ()
forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
setGauge (IcepeakMetrics -> Gauge
icepeakMetricsJournalSize IcepeakMetrics
metrics) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
val)

-- | Increment the total data written to disk by the given number of bytes.
-- Returns True, when it actually increased the counter and otherwise False.
incrementDataWritten :: (MonadMonitor m, Real a) => a -> IcepeakMetrics -> m Bool
incrementDataWritten :: a -> IcepeakMetrics -> m Bool
incrementDataWritten a
num_bytes IcepeakMetrics
metrics = do
  -- Ignore the result to silence linter.
  -- TODO: the following line can be removed after dashboard has been updated to use icepeak_data_size_bytes
  Bool
_ <- Counter -> Double -> m Bool
forall (m :: * -> *). MonadMonitor m => Counter -> Double -> m Bool
addCounter (IcepeakMetrics -> Counter
icepeakMetricsDataWritten IcepeakMetrics
metrics) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
num_bytes)
  Counter -> Double -> m Bool
forall (m :: * -> *). MonadMonitor m => Counter -> Double -> m Bool
addCounter (IcepeakMetrics -> Counter
icepeakMetricsDataWrittenTotal IcepeakMetrics
metrics) (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
num_bytes)

-- | Increment the data written to the journal by the given number of bytes.
-- Returns True, when it actually increased the counter and otherwise False.
incrementJournalWritten :: (MonadMonitor m, Real a) => a -> IcepeakMetrics -> m Bool
incrementJournalWritten :: a -> IcepeakMetrics -> m Bool
incrementJournalWritten a
num_bytes IcepeakMetrics
metrics = Counter -> Double -> m Bool
forall (m :: * -> *). MonadMonitor m => Counter -> Double -> m Bool
addCounter (IcepeakMetrics -> Counter
icepeakMetricsJournalWritten IcepeakMetrics
metrics)
  (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
num_bytes)

incrementSubscribers :: MonadMonitor m => IcepeakMetrics -> m ()
incrementSubscribers :: IcepeakMetrics -> m ()
incrementSubscribers = Gauge -> m ()
forall (m :: * -> *). MonadMonitor m => Gauge -> m ()
incGauge (Gauge -> m ())
-> (IcepeakMetrics -> Gauge) -> IcepeakMetrics -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IcepeakMetrics -> Gauge
icepeakMetricsSubscriberCount

decrementSubscribers :: MonadMonitor m => IcepeakMetrics -> m ()
decrementSubscribers :: IcepeakMetrics -> m ()
decrementSubscribers = Gauge -> m ()
forall (m :: * -> *). MonadMonitor m => Gauge -> m ()
decGauge (Gauge -> m ())
-> (IcepeakMetrics -> Gauge) -> IcepeakMetrics -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IcepeakMetrics -> Gauge
icepeakMetricsSubscriberCount