{-# LANGUAGE OverloadedStrings #-}
module System.Metrics.Prometheus.Http.Push
( pushHttpTextMetrics
)
where
import Control.Concurrent (threadDelay)
import Control.Monad (forever)
import Data.ByteString.Builder (toLazyByteString)
import Data.Map (foldMapWithKey)
import Data.Text (Text, unpack)
import Network.HTTP.Client (Request (..),
RequestBody (..),
defaultManagerSettings,
httpNoBody, newManager,
requestBody,
requestFromURI,
requestHeaders)
import Network.HTTP.Types (hContentType, methodPut)
import Network.URI (URI (..), URIAuth,
nullURI)
import System.Metrics.Prometheus.Encode.Text (encodeMetrics)
import System.Metrics.Prometheus.MetricId (Labels (..))
import System.Metrics.Prometheus.Registry (RegistrySample)
pushHttpTextMetrics :: URIAuth
-> Text
-> Labels
-> Int
-> IO RegistrySample
-> IO ()
pushHttpTextMetrics gatewayName jobName labels frequencyMicros getSample = do
manager <- newManager defaultManagerSettings
requestUri <- requestFromURI $ buildUri gatewayName jobName labels
forever $ getSample >>= flip httpNoBody manager . request requestUri >> threadDelay frequencyMicros
where
request req sample = req
{ method = methodPut
, requestBody = RequestBodyLBS . toLazyByteString $ encodeMetrics sample
, requestHeaders = [(hContentType, "text/plain; version=0.0.4")]
}
buildUri :: URIAuth -> Text -> Labels -> URI
buildUri gatewayName jobName (Labels ls) = nullURI
{ uriScheme = "http:"
, uriAuthority = Just gatewayName
, uriPath = "/metrics/job/" ++ unpack jobName ++ foldMapWithKey labelPath ls
}
where labelPath k v = "/" ++ unpack k ++ "/" ++ unpack v