{-# LANGUAGE KindSignatures #-}
module Prod.Reports (
ReportsApi,
Report (..),
countReports,
Runtime,
initRuntime,
)
where
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
import GHC.TypeLits (Symbol)
import Prod.Tracer
import qualified Prometheus as Prometheus
import Servant (JSON, Post, ReqBody, Summary, (:>))
import Servant.Server (Handler)
data Report a = Report {forall a. Report a -> Int
posixTime :: Int, forall a. Report a -> Int
backoff :: Int, forall a. Report a -> [a]
events :: [a]}
instance (FromJSON a) => FromJSON (Report a) where
parseJSON :: Value -> Parser (Report a)
parseJSON = String
-> (Object -> Parser (Report a)) -> Value -> Parser (Report a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Report" ((Object -> Parser (Report a)) -> Value -> Parser (Report a))
-> (Object -> Parser (Report a)) -> Value -> Parser (Report a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
Int -> Int -> [a] -> Report a
forall a. Int -> Int -> [a] -> Report a
Report (Int -> Int -> [a] -> Report a)
-> Parser Int -> Parser (Int -> [a] -> Report a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"t" Parser (Int -> [a] -> Report a)
-> Parser Int -> Parser ([a] -> Report a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"b" Parser ([a] -> Report a) -> Parser [a] -> Parser (Report a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [a]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"es"
instance (ToJSON a) => ToJSON (Report a) where
toJSON :: Report a -> Value
toJSON (Report Int
t Int
b [a]
es) = [Pair] -> Value
object [Key
"t" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
t, Key
"b" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int
b, Key
"es" Key -> [a] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [a]
es]
type ReportsApi a =
Summary "receives and acknowledge some reports"
:> "reports"
:> ReqBody '[JSON] (Report a)
:> Post '[JSON] Int
data Counters
= Counters
{ Counters -> Counter
reports_count :: !Prometheus.Counter
, Counters -> Counter
reported_events :: !Prometheus.Counter
, Counters -> Summary
reported_sizes :: !Prometheus.Summary
, Counters -> Summary
reported_backoffs :: !Prometheus.Summary
}
newCounters :: IO Counters
newCounters :: IO Counters
newCounters =
Counter -> Counter -> Summary -> Summary -> Counters
Counters
(Counter -> Counter -> Summary -> Summary -> Counters)
-> IO Counter -> IO (Counter -> Summary -> Summary -> Counters)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO Counter
forall {m :: * -> *}. MonadIO m => Text -> m Counter
counts Text
"reports"
IO (Counter -> Summary -> Summary -> Counters)
-> IO Counter -> IO (Summary -> Summary -> Counters)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> IO Counter
forall {m :: * -> *}. MonadIO m => Text -> m Counter
counts Text
"report_events"
IO (Summary -> Summary -> Counters)
-> IO Summary -> IO (Summary -> Counters)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> IO Summary
forall {m :: * -> *}. MonadIO m => Text -> m Summary
summary Text
"report_sizes"
IO (Summary -> Counters) -> IO Summary -> IO Counters
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> IO Summary
forall {m :: * -> *}. MonadIO m => Text -> m Summary
summary Text
"report_backoffs"
where
counts :: Text -> m Counter
counts Text
k =
Metric Counter -> m Counter
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
Prometheus.register (Metric Counter -> m Counter) -> Metric Counter -> m Counter
forall a b. (a -> b) -> a -> b
$
Info -> Metric Counter
Prometheus.counter (Text -> Text -> Info
Prometheus.Info Text
k Text
"")
summary :: Text -> m Summary
summary Text
k =
Metric Summary -> m Summary
forall (m :: * -> *) s. MonadIO m => Metric s -> m s
Prometheus.register (Metric Summary -> m Summary) -> Metric Summary -> m Summary
forall a b. (a -> b) -> a -> b
$
Info -> [Quantile] -> Metric Summary
Prometheus.summary (Text -> Text -> Info
Prometheus.Info Text
k Text
"") [Quantile]
Prometheus.defaultQuantiles
data Runtime a = Runtime {forall a. Runtime a -> Counters
counters :: !Counters, forall a. Runtime a -> Tracer IO (Report a)
tracer :: !(Tracer IO (Report a))}
initRuntime :: Tracer IO (Report a) -> IO (Runtime a)
initRuntime :: forall a. Tracer IO (Report a) -> IO (Runtime a)
initRuntime Tracer IO (Report a)
tracer = Counters -> Tracer IO (Report a) -> Runtime a
forall a. Counters -> Tracer IO (Report a) -> Runtime a
Runtime (Counters -> Tracer IO (Report a) -> Runtime a)
-> IO Counters -> IO (Tracer IO (Report a) -> Runtime a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Counters
newCounters IO (Tracer IO (Report a) -> Runtime a)
-> IO (Tracer IO (Report a)) -> IO (Runtime a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tracer IO (Report a) -> IO (Tracer IO (Report a))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tracer IO (Report a)
tracer
countReports :: Runtime a -> Report a -> Handler Int
countReports :: forall a. Runtime a -> Report a -> Handler Int
countReports (Runtime Counters
counters Tracer IO (Report a)
tracer) Report a
report = do
let size :: Int
size = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Report a -> [a]
forall a. Report a -> [a]
events Report a
report)
let dsize :: Double
dsize = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size
IO () -> Handler ()
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ do
Tracer IO (Report a) -> Report a -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
runTracer Tracer IO (Report a)
tracer (Report a -> IO ()) -> Report a -> IO ()
forall a b. (a -> b) -> a -> b
$ Report a
report
Counter -> IO ()
forall (m :: * -> *). MonadMonitor m => Counter -> m ()
Prometheus.incCounter (Counters -> Counter
reports_count Counters
counters)
Counter -> Double -> IO Bool
forall (m :: * -> *). MonadMonitor m => Counter -> Double -> m Bool
Prometheus.addCounter (Counters -> Counter
reported_events Counters
counters) Double
dsize
Summary -> Double -> IO ()
forall metric (m :: * -> *).
(Observer metric, MonadMonitor m) =>
metric -> Double -> m ()
forall (m :: * -> *). MonadMonitor m => Summary -> Double -> m ()
Prometheus.observe (Counters -> Summary
reported_sizes Counters
counters) Double
dsize
Summary -> Double -> IO ()
forall metric (m :: * -> *).
(Observer metric, MonadMonitor m) =>
metric -> Double -> m ()
forall (m :: * -> *). MonadMonitor m => Summary -> Double -> m ()
Prometheus.observe (Counters -> Summary
reported_backoffs Counters
counters) (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Report a -> Int
forall a. Report a -> Int
backoff Report a
report)
Int -> Handler Int
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
size