{-# 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 (..),
requestBody,
requestHeaders)
import Network.HTTP.Types (hContentType)
import Network.Wreq.Session (newSession, put)
import Network.Wreq.Types (Putable (..))
import System.Metrics.Prometheus.Encode.Text (encodeMetrics)
import System.Metrics.Prometheus.MetricId (Labels (..))
import System.Metrics.Prometheus.Registry (RegistrySample)
pushHttpTextMetrics :: String
-> Text
-> Labels
-> Int
-> IO RegistrySample
-> IO ()
pushHttpTextMetrics base job (Labels ls) frequency getSample = do
session <- newSession
forever $ getSample >>= put session url >> threadDelay frequency
where
url = base ++ "/metrics/job/" ++ unpack job ++
foldMapWithKey (\k v -> "/" ++ unpack k ++ "/" ++ unpack v) ls
instance Putable RegistrySample where
putPayload = (pure .) . metricsRequest
metricsRequest :: RegistrySample -> Request -> Request
metricsRequest s req = req
{ requestBody = RequestBodyLBS . toLazyByteString $ encodeMetrics s
, requestHeaders = contentType : requestHeaders req
}
where contentType = (hContentType, "text/plain; version=0.0.4")