module Network.Wai.Middleware.Prometheus (
prometheus
, PrometheusSettings (..)
, Default.def
, instrumentApp
, instrumentIO
, metricsApp
) where
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
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 qualified Data.Text as T
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Prometheus as Prom
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.Summary)
requestLatency = Prom.unsafeRegisterIO $ Prom.vector ("handler", "method", "status_code")
$ Prom.summary info Prom.defaultQuantiles
where info = Prom.Info "http_request_duration_microseconds"
"The HTTP request latencies in microseconds."
instrumentApp :: String
-> Wai.Application
-> Wai.Application
instrumentApp handler app req respond = do
start <- getCurrentTime
app req $ \res -> do
end <- getCurrentTime
let method = Just $ BS.unpack (Wai.requestMethod req)
let status = Just $ show (HTTP.statusCode (Wai.responseStatus res))
observeMicroSeconds handler method status start end
respond res
instrumentIO :: String
-> IO a
-> IO a
instrumentIO label io = do
start <- getCurrentTime
result <- io
end <- getCurrentTime
observeMicroSeconds label Nothing Nothing start end
return result
observeMicroSeconds :: String -> Maybe String -> Maybe String -> UTCTime -> UTCTime -> IO ()
observeMicroSeconds handler method status start end = do
let latency = fromRational $ toRational (end `diffUTCTime` start) * 1000000
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")]