module Network.Wai.Middleware.Prometheus (
prometheus
, PrometheusSettings (..)
, Default.def
, instrumentApp
, instrumentIO
) where
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import qualified Data.ByteString.Builder as BS
import qualified Data.Default as Default
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.Label1 Prom.Summary)
requestLatency = Prom.unsafeRegisterIO $ Prom.vector "handler"
$ 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 =
observeMicroSeconds handler (app req respond)
instrumentIO :: String
-> IO a
-> IO a
instrumentIO = observeMicroSeconds
observeMicroSeconds :: String -> IO a -> IO a
observeMicroSeconds handler io = do
start <- getCurrentTime
result <- io
end <- getCurrentTime
let latency = fromRational $ toRational (end `diffUTCTime` start) * 1000000
Prom.withLabel handler (Prom.observe latency) requestLatency
return result
prometheus :: PrometheusSettings -> Wai.Middleware
prometheus PrometheusSettings{..} app req respond =
if Wai.requestMethod req == HTTP.methodGet
&& Wai.pathInfo req == prometheusEndPoint
then measure measureMetrics "prometheus" $ respondWithMetrics respond
else measure measureApp "app" $ app req respond
where
measureMetrics = prometheusInstrumentPrometheus
measureApp = prometheusInstrumentApp
measure shouldInstrument handler io
| shouldInstrument = observeMicroSeconds handler io
| otherwise = io
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")]