{-# 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)

{- | Some minimal report wrapper.
Has low expectations on the client.
-}
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

-- | A set of counters tracking .
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

-- | A default runtime for the `dropReports` route.
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

-- | Count and drop reports.
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