module Data.Metrics.Middleware.Prometheus
( waiPrometheusMiddleware,
normalizeWaiRequestRoute,
)
where
import Data.Metrics.Types (Paths, treeLookup)
import Data.Metrics.WaiRoute (treeToPaths)
import Data.Text.Encoding qualified as T
import Imports
import Network.Wai qualified as Wai
import Network.Wai.Middleware.Prometheus qualified as Promth
import Network.Wai.Routing.Route (Routes, prepare)
waiPrometheusMiddleware :: (Monad m) => Routes a m b -> Wai.Middleware
waiPrometheusMiddleware :: forall (m :: * -> *) a b. Monad m => Routes a m b -> Middleware
waiPrometheusMiddleware Routes a m b
routes =
PrometheusSettings -> Middleware
Promth.prometheus PrometheusSettings
conf Middleware -> Middleware -> Middleware
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Request -> Text) -> Middleware
instrument (Paths -> Request -> Text
normalizeWaiRequestRoute Paths
paths)
where
instrument :: (Request -> Text) -> Middleware
instrument = (Response -> Maybe Response) -> (Request -> Text) -> Middleware
Promth.instrumentHandlerValueWithFilter Response -> Maybe Response
Promth.ignoreRawResponses
paths :: Paths
paths = Tree (App m) -> Paths
forall a. HasCallStack => Tree a -> Paths
treeToPaths (Tree (App m) -> Paths) -> Tree (App m) -> Paths
forall a b. (a -> b) -> a -> b
$ Routes a m b -> Tree (App m)
forall (m :: * -> *) a b. Monad m => Routes a m b -> Tree (App m)
prepare Routes a m b
routes
conf :: PrometheusSettings
conf =
PrometheusSettings
forall a. Default a => a
Promth.def
{ Promth.prometheusEndPoint = ["i", "metrics"],
Promth.prometheusInstrumentApp = False
}
normalizeWaiRequestRoute :: Paths -> Wai.Request -> Text
normalizeWaiRequestRoute :: Paths -> Request -> Text
normalizeWaiRequestRoute Paths
paths Request
req = Text
pathInfo
where
mPathInfo :: Maybe ByteString
mPathInfo :: Maybe ByteString
mPathInfo = Paths -> [ByteString] -> Maybe ByteString
treeLookup Paths
paths (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> [Text] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> [Text]
Wai.pathInfo Request
req)
pathInfo :: Text
pathInfo :: Text
pathInfo = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"N/A" Maybe ByteString
mPathInfo