module Network.Wai.Middleware.Prometheus (
prometheus
, PrometheusSettings (..)
, Default.def
, instrumentApp
, instrumentIO
, metricsApp
) where
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Char8 as BS
import qualified Data.Default as Default
import Data.Maybe (fromMaybe)
import Data.Ratio ((%))
import qualified Data.Text as T
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Prometheus as Prom
import System.Clock (Clock(..), TimeSpec, diffTimeSpec, getTime, toNanoSecs)
data PrometheusSettings = PrometheusSettings {
prometheusEndPoint :: [T.Text]
, prometheusInstrumentApp :: Bool
, prometheusInstrumentPrometheus :: Bool
}
instance Default.Default PrometheusSettings where
def = PrometheusSettings {
prometheusEndPoint = ["metrics"]
, prometheusInstrumentApp = True
, prometheusInstrumentPrometheus = True
}
requestLatency :: Prom.Metric (Prom.Vector Prom.Label3 Prom.Histogram)
requestLatency = Prom.unsafeRegisterIO $ Prom.vector ("handler", "method", "status_code")
$ Prom.histogram info Prom.defaultBuckets
where info = Prom.Info "http_request_duration_seconds"
"The HTTP request latencies in seconds."
instrumentApp :: String
-> Wai.Application
-> Wai.Application
instrumentApp handler app req respond = do
start <- getTime Monotonic
app req $ \res -> do
end <- getTime Monotonic
let method = Just $ BS.unpack (Wai.requestMethod req)
let status = Just $ show (HTTP.statusCode (Wai.responseStatus res))
observeSeconds handler method status start end
respond res
instrumentIO :: String
-> IO a
-> IO a
instrumentIO label io = do
start <- getTime Monotonic
result <- io
end <- getTime Monotonic
observeSeconds label Nothing Nothing start end
return result
observeSeconds :: String -> Maybe String -> Maybe String -> TimeSpec -> TimeSpec -> IO ()
observeSeconds handler method status start end = do
let latency = fromRational $ toRational (toNanoSecs (end `diffTimeSpec` start) % 1000000000)
Prom.withLabel (handler, fromMaybe "" method, fromMaybe "" status)
(Prom.observe latency)
requestLatency
prometheus :: PrometheusSettings -> Wai.Middleware
prometheus PrometheusSettings{..} app req respond =
if Wai.requestMethod req == HTTP.methodGet
&& Wai.pathInfo req == prometheusEndPoint
then instrumentApp "prometheus" (const respondWithMetrics) req respond
else instrumentApp "app" app req respond
metricsApp :: Wai.Application
metricsApp = const respondWithMetrics
respondWithMetrics :: (Wai.Response -> IO Wai.ResponseReceived)
-> IO Wai.ResponseReceived
respondWithMetrics respond = do
metrics <- Prom.exportMetricsAsText
respond $ Wai.responseBuilder HTTP.status200 headers $ BS.byteString metrics
where
headers = [(HTTP.hContentType, "text/plain; version=0.0.4")]