{-# LANGUAGE TemplateHaskell, DeriveGeneric, RecordWildCards #-}
{-# LANGUAGE TypeApplications, TupleSections, OverloadedStrings #-}
module NgxExport.Tools.Prometheus (
scale
,scale1000
) where
import NgxExport
import NgxExport.Tools
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.IORef
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Aeson
import Data.Maybe
import Data.Word
import Control.Arrow
import System.IO.Unsafe
import GHC.Generics
import Safe
type ServerName = Text
type MetricsName = Text
type MetricsHelp = Text
type MetricsLabel = Text
type CounterValue = Word64
type MetricsData = Map MetricsName CounterValue
type HistogramData = Map MetricsName (MetricsLabel, Double)
type MetricsToLabelMap = Map MetricsName MetricsLabel
data PrometheusConf =
PrometheusConf { PrometheusConf -> Map MetricsName MetricsName
pcMetrics :: Map MetricsName MetricsHelp
, PrometheusConf -> [MetricsName]
pcGauges :: [MetricsName]
, PrometheusConf -> [MetricsName]
pcScale1000 :: [MetricsName]
} deriving ReadPrec [PrometheusConf]
ReadPrec PrometheusConf
Int -> ReadS PrometheusConf
ReadS [PrometheusConf]
(Int -> ReadS PrometheusConf)
-> ReadS [PrometheusConf]
-> ReadPrec PrometheusConf
-> ReadPrec [PrometheusConf]
-> Read PrometheusConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrometheusConf]
$creadListPrec :: ReadPrec [PrometheusConf]
readPrec :: ReadPrec PrometheusConf
$creadPrec :: ReadPrec PrometheusConf
readList :: ReadS [PrometheusConf]
$creadList :: ReadS [PrometheusConf]
readsPrec :: Int -> ReadS PrometheusConf
$creadsPrec :: Int -> ReadS PrometheusConf
Read
data HistogramLayout =
HistogramLayout { HistogramLayout -> Map MetricsName MetricsName
range :: MetricsToLabelMap
, HistogramLayout -> (MetricsName, MetricsName)
cnt :: (MetricsName, MetricsLabel)
, HistogramLayout -> (MetricsName, MetricsName)
err :: (MetricsName, MetricsLabel)
} deriving (forall x. HistogramLayout -> Rep HistogramLayout x)
-> (forall x. Rep HistogramLayout x -> HistogramLayout)
-> Generic HistogramLayout
forall x. Rep HistogramLayout x -> HistogramLayout
forall x. HistogramLayout -> Rep HistogramLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistogramLayout x -> HistogramLayout
$cfrom :: forall x. HistogramLayout -> Rep HistogramLayout x
Generic
instance FromJSON HistogramLayout
type AllCounters = Map ServerName MetricsData
type AllHistogramsLayout = Map ServerName (Map MetricsName HistogramLayout)
type AllOtherCounters = MetricsData
type AllMetrtics =
(ServerName, AllCounters, AllHistogramsLayout, AllOtherCounters)
data MetricsType = Counter Double
| Gauge Double
| Histogram HistogramData
type PrometheusMetrics = Map MetricsName (MetricsHelp, MetricsType)
conf :: IORef (Maybe PrometheusConf)
conf :: IORef (Maybe PrometheusConf)
conf = IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf))
-> IO (IORef (Maybe PrometheusConf))
-> IORef (Maybe PrometheusConf)
forall a b. (a -> b) -> a -> b
$ Maybe PrometheusConf -> IO (IORef (Maybe PrometheusConf))
forall a. a -> IO (IORef a)
newIORef Maybe PrometheusConf
forall a. Maybe a
Nothing
{-# NOINLINE conf #-}
prometheusConf :: PrometheusConf -> Bool -> IO L.ByteString
prometheusConf :: PrometheusConf -> Bool -> IO ByteString
prometheusConf = (PrometheusConf -> IO ByteString)
-> PrometheusConf -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((PrometheusConf -> IO ByteString)
-> PrometheusConf -> Bool -> IO ByteString)
-> (PrometheusConf -> IO ByteString)
-> PrometheusConf
-> Bool
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \a :: PrometheusConf
a -> do
IORef (Maybe PrometheusConf) -> Maybe PrometheusConf -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (Maybe PrometheusConf)
conf (Maybe PrometheusConf -> IO ()) -> Maybe PrometheusConf -> IO ()
forall a b. (a -> b) -> a -> b
$ PrometheusConf -> Maybe PrometheusConf
forall a. a -> Maybe a
Just PrometheusConf
a
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ""
ngxExportSimpleServiceTyped
'prometheusConf ''PrometheusConf SingleShotService
toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' PrometheusConf {..} (srv :: MetricsName
srv, cnts :: AllCounters
cnts, hs :: AllHistogramsLayout
hs, ocnts :: AllOtherCounters
ocnts) =
let toValues :: AllOtherCounters -> Map MetricsName Double
toValues = (MetricsName -> CounterValue -> Double)
-> AllOtherCounters -> Map MetricsName Double
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\k :: MetricsName
k v :: CounterValue
v -> (if MetricsName
k MetricsName -> [MetricsName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MetricsName]
pcScale1000
then (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1000)
else Double -> Double
forall a. a -> a
id
) (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ CounterValue -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral CounterValue
v
)
cnts' :: Map MetricsName Double
cnts' = Map MetricsName Double
-> (AllOtherCounters -> Map MetricsName Double)
-> Maybe AllOtherCounters
-> Map MetricsName Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map MetricsName Double
forall k a. Map k a
M.empty AllOtherCounters -> Map MetricsName Double
toValues (Maybe AllOtherCounters -> Map MetricsName Double)
-> Maybe AllOtherCounters -> Map MetricsName Double
forall a b. (a -> b) -> a -> b
$ MetricsName -> AllCounters -> Maybe AllOtherCounters
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
srv AllCounters
cnts
hs' :: Maybe (Map MetricsName HistogramLayout)
hs' = MetricsName
-> AllHistogramsLayout -> Maybe (Map MetricsName HistogramLayout)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
srv AllHistogramsLayout
hs
(cntsH :: Map MetricsName MetricsType
cntsH, cntsC :: Map MetricsName MetricsType
cntsC) =
if Bool
-> (Map MetricsName HistogramLayout -> Bool)
-> Maybe (Map MetricsName HistogramLayout)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Map MetricsName HistogramLayout -> Bool
forall k a. Map k a -> Bool
M.null Maybe (Map MetricsName HistogramLayout)
hs'
then (Map MetricsName MetricsType
forall k a. Map k a
M.empty, (MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType Map MetricsName Double
cnts')
else let hs'' :: Map MetricsName HistogramLayout
hs'' = Maybe (Map MetricsName HistogramLayout)
-> Map MetricsName HistogramLayout
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map MetricsName HistogramLayout)
hs'
rs :: ([MetricsName], Map MetricsName MetricsName)
rs = Map MetricsName HistogramLayout -> [MetricsName]
forall k a. Map k a -> [k]
M.keys (Map MetricsName HistogramLayout -> [MetricsName])
-> (Map MetricsName HistogramLayout -> Map MetricsName MetricsName)
-> Map MetricsName HistogramLayout
-> ([MetricsName], Map MetricsName MetricsName)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (HistogramLayout
-> Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> Map MetricsName MetricsName
-> Map MetricsName HistogramLayout
-> Map MetricsName MetricsName
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr HistogramLayout
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
labeledRange Map MetricsName MetricsName
forall k a. Map k a
M.empty (Map MetricsName HistogramLayout
-> ([MetricsName], Map MetricsName MetricsName))
-> Map MetricsName HistogramLayout
-> ([MetricsName], Map MetricsName MetricsName)
forall a b. (a -> b) -> a -> b
$ Map MetricsName HistogramLayout
hs''
cntsH' :: Map MetricsName Double
cntsH' = (MetricsName -> Double -> Bool)
-> Map MetricsName Double -> Map MetricsName Double
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (([MetricsName], Map MetricsName MetricsName)
-> MetricsName -> Double -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(t MetricsName, Map MetricsName a) -> MetricsName -> b -> Bool
hCounter ([MetricsName], Map MetricsName MetricsName)
rs) Map MetricsName Double
cnts'
cntsC' :: Map MetricsName Double
cntsC' = Map MetricsName Double
cnts' Map MetricsName Double
-> Map MetricsName Double -> Map MetricsName Double
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map MetricsName Double
cntsH'
cntsH'' :: Map MetricsName (Map MetricsName (MetricsName, Double))
cntsH'' = (MetricsName
-> HistogramLayout -> Map MetricsName (MetricsName, Double))
-> Map MetricsName HistogramLayout
-> Map MetricsName (Map MetricsName (MetricsName, Double))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\k :: MetricsName
k -> Map MetricsName Double
-> MetricsName
-> Map MetricsName MetricsName
-> Map MetricsName (MetricsName, Double)
forall a b.
(IsString a, Fractional b) =>
Map MetricsName b
-> MetricsName -> Map MetricsName a -> Map MetricsName (a, b)
toHistogram Map MetricsName Double
cntsH' MetricsName
k (Map MetricsName MetricsName
-> Map MetricsName (MetricsName, Double))
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName (MetricsName, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsName MetricsName
range) Map MetricsName HistogramLayout
hs''
in ((Map MetricsName (MetricsName, Double) -> MetricsType)
-> Map MetricsName (Map MetricsName (MetricsName, Double))
-> Map MetricsName MetricsType
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Map MetricsName (MetricsName, Double) -> MetricsType
Histogram Map MetricsName (Map MetricsName (MetricsName, Double))
cntsH'', (MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType Map MetricsName Double
cntsC')
cntsA :: Map MetricsName MetricsType
cntsA = Map MetricsName MetricsType
cntsH Map MetricsName MetricsType
-> Map MetricsName MetricsType -> Map MetricsName MetricsType
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName MetricsType
cntsC Map MetricsName MetricsType
-> Map MetricsName MetricsType -> Map MetricsName MetricsType
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union`
(MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType (AllOtherCounters -> Map MetricsName Double
toValues AllOtherCounters
ocnts)
in (MetricsName -> MetricsType -> (MetricsName, MetricsType))
-> Map MetricsName MetricsType -> PrometheusMetrics
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\k :: MetricsName
k v :: MetricsType
v -> case MetricsName -> Map MetricsName MetricsName -> Maybe MetricsName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
k Map MetricsName MetricsName
pcMetrics of
Nothing -> ("", MetricsType
v)
Just h :: MetricsName
h -> (MetricsName
h, MetricsType
v)
) Map MetricsName MetricsType
cntsA
where labeledRange :: HistogramLayout
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
labeledRange = Map MetricsName MetricsName
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Map MetricsName MetricsName
-> Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName MetricsName
-> Map MetricsName MetricsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName -> Bool)
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool) -> (MetricsName -> Bool) -> MetricsName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsName -> Bool
T.null) (Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName MetricsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsName MetricsName
range
hCounter :: (t MetricsName, Map MetricsName a) -> MetricsName -> b -> Bool
hCounter (ks :: t MetricsName
ks, ts :: Map MetricsName a
ts) k :: MetricsName
k = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool) -> Bool -> b -> Bool
forall a b. (a -> b) -> a -> b
$
MetricsName
k MetricsName -> Map MetricsName a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MetricsName a
ts Bool -> Bool -> Bool
||
Bool -> [Bool] -> Bool
forall a. a -> [a] -> a
headDef Bool
False
((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Bool -> Bool
not ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$
(MetricsName -> [Bool] -> [Bool])
-> [Bool] -> t MetricsName -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v :: MetricsName
v ->
let v1 :: MetricsName
v1 = MetricsName
v MetricsName -> MetricsName -> MetricsName
`T.append` "_sum"
v2 :: MetricsName
v2 = MetricsName
v MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt"
in ((MetricsName
k MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
v1 Bool -> Bool -> Bool
|| MetricsName
k MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
v2) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)
) [] t MetricsName
ks
)
cType :: MetricsName -> Double -> MetricsType
cType k :: MetricsName
k v :: Double
v = if MetricsName
k MetricsName -> [MetricsName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MetricsName]
pcGauges
then Double -> MetricsType
Gauge Double
v
else Double -> MetricsType
Counter Double
v
toHistogram :: Map MetricsName b
-> MetricsName -> Map MetricsName a -> Map MetricsName (a, b)
toHistogram cs :: Map MetricsName b
cs hk :: MetricsName
hk rs :: Map MetricsName a
rs =
let ranges :: Map MetricsName (a, b)
ranges = (MetricsName -> a -> (a, b))
-> Map MetricsName a -> Map MetricsName (a, b)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\k :: MetricsName
k l :: a
l -> case MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
k Map MetricsName b
cs of
Just v :: b
v -> (a
l, b
v)
Nothing -> (a
l, 0.0)
) Map MetricsName a
rs
sums :: Map MetricsName (a, b)
sums = let v1 :: MetricsName
v1 = MetricsName
hk MetricsName -> MetricsName -> MetricsName
`T.append` "_sum"
v2 :: MetricsName
v2 = MetricsName
hk MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt"
withZeroLabel :: t -> Maybe (a, t)
withZeroLabel = (a, t) -> Maybe (a, t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, t) -> Maybe (a, t)) -> (t -> (a, t)) -> t -> Maybe (a, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("",)
in [(MetricsName, (a, b))] -> Map MetricsName (a, b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsName, (a, b))] -> Map MetricsName (a, b))
-> [(MetricsName, (a, b))] -> Map MetricsName (a, b)
forall a b. (a -> b) -> a -> b
$
((MetricsName, Maybe (a, b)) -> (MetricsName, (a, b)))
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (a, b) -> (a, b))
-> (MetricsName, Maybe (a, b)) -> (MetricsName, (a, b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (a, b) -> (a, b)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))])
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))]
forall a b. (a -> b) -> a -> b
$ ((MetricsName, Maybe (a, b)) -> Bool)
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, Maybe (a, b))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (a, b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, b) -> Bool)
-> ((MetricsName, Maybe (a, b)) -> Maybe (a, b))
-> (MetricsName, Maybe (a, b))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName, Maybe (a, b)) -> Maybe (a, b)
forall a b. (a, b) -> b
snd)
[(MetricsName
v1, MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v1 Map MetricsName b
cs Maybe b -> (b -> Maybe (a, b)) -> Maybe (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Maybe (a, b)
forall t. t -> Maybe (a, t)
withZeroLabel)
,(MetricsName
v2, MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v2 Map MetricsName b
cs Maybe b -> (b -> Maybe (a, b)) -> Maybe (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Maybe (a, b)
forall t. t -> Maybe (a, t)
withZeroLabel)
]
in Map MetricsName (a, b)
ranges Map MetricsName (a, b)
-> Map MetricsName (a, b) -> Map MetricsName (a, b)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName (a, b)
sums
showPrometheusMetrics :: PrometheusMetrics -> L.ByteString
showPrometheusMetrics :: PrometheusMetrics -> ByteString
showPrometheusMetrics = ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (PrometheusMetrics -> ByteString)
-> PrometheusMetrics
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsName -> ByteString
T.encodeUtf8 (MetricsName -> ByteString)
-> (PrometheusMetrics -> MetricsName)
-> PrometheusMetrics
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName
-> MetricsName -> (MetricsName, MetricsType) -> MetricsName)
-> MetricsName -> PrometheusMetrics -> MetricsName
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey
(\a :: MetricsName
a k :: MetricsName
k (h :: MetricsName
h, m :: MetricsType
m) -> [MetricsName] -> MetricsName
T.concat [MetricsName
a, "# HELP ", MetricsName
k, " ", MetricsName
h, "\n"
, "# TYPE ", MetricsName
k, " ", MetricsType -> MetricsName
forall p. IsString p => MetricsType -> p
showType MetricsType
m, "\n"
,case MetricsType
m of
Counter v :: Double
v ->
[MetricsName] -> MetricsName
T.concat [MetricsName
k, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v, "\n"]
Gauge v :: Double
v ->
[MetricsName] -> MetricsName
T.concat [MetricsName
k, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v, "\n"]
Histogram h' :: Map MetricsName (MetricsName, Double)
h' -> (MetricsName, Double) -> MetricsName
forall a b. (a, b) -> a
fst ((MetricsName, Double) -> MetricsName)
-> (MetricsName, Double) -> MetricsName
forall a b. (a -> b) -> a -> b
$
((MetricsName, Double)
-> MetricsName -> (MetricsName, Double) -> (MetricsName, Double))
-> (MetricsName, Double)
-> Map MetricsName (MetricsName, Double)
-> (MetricsName, Double)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (MetricsName
-> (MetricsName, Double)
-> MetricsName
-> (MetricsName, Double)
-> (MetricsName, Double)
forall a.
(Show a, RealFrac a) =>
MetricsName
-> (MetricsName, a)
-> MetricsName
-> (MetricsName, a)
-> (MetricsName, a)
showHistogram MetricsName
k)
("", 0.0) Map MetricsName (MetricsName, Double)
h'
]
) ""
where showType :: MetricsType -> p
showType (Counter _) = "counter"
showType (Gauge _) = "gauge"
showType (Histogram _) = "histogram"
showHistogram :: MetricsName
-> (MetricsName, a)
-> MetricsName
-> (MetricsName, a)
-> (MetricsName, a)
showHistogram k :: MetricsName
k a :: (MetricsName, a)
a@(t :: MetricsName
t, n :: a
n) c :: MetricsName
c (l :: MetricsName
l, v :: a
v) =
if MetricsName -> Bool
T.null MetricsName
l
then if MetricsName
k MetricsName -> MetricsName -> MetricsName
`T.append` "_sum" MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
c
then ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
c, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v, "\n"]
,a
n
)
else if MetricsName
k MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt" MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
c
then ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
k, "_count "
,String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$
CounterValue -> String
forall a. Show a => a -> String
show (a -> CounterValue
forall a b. (RealFrac a, Integral b) => a -> b
round a
v :: Word64)
,"\n"
]
,a
n
)
else (MetricsName, a)
a
else let n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
v
in ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
k, "_bucket{le=\"", MetricsName
l, "\"} "
,String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ CounterValue -> String
forall a. Show a => a -> String
show (a -> CounterValue
forall a b. (RealFrac a, Integral b) => a -> b
round a
n' :: Word64)
,"\n"
]
,a
n'
)
toPrometheusMetrics :: ByteString -> IO L.ByteString
toPrometheusMetrics :: ByteString -> IO ByteString
toPrometheusMetrics v :: ByteString
v = do
let cs :: AllMetrtics
cs = Maybe AllMetrtics -> AllMetrtics
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AllMetrtics -> AllMetrtics)
-> Maybe AllMetrtics -> AllMetrtics
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe AllMetrtics
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @AllMetrtics ByteString
v
Maybe PrometheusConf
pc <- IORef (Maybe PrometheusConf) -> IO (Maybe PrometheusConf)
forall a. IORef a -> IO a
readIORef IORef (Maybe PrometheusConf)
conf
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ case Maybe PrometheusConf
pc of
Just c :: PrometheusConf
c -> PrometheusMetrics -> ByteString
showPrometheusMetrics (PrometheusMetrics -> ByteString)
-> PrometheusMetrics -> ByteString
forall a b. (a -> b) -> a -> b
$ PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' PrometheusConf
c AllMetrtics
cs
Nothing -> ""
ngxExportIOYY 'toPrometheusMetrics
scale
:: Int
-> Double
-> Int
scale :: Int -> Double -> Int
scale n :: Int
n = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Double -> Double) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Num a => a -> a -> a
*)
scale1000
:: ByteString
-> L.ByteString
scale1000 :: ByteString -> ByteString
scale1000 v :: ByteString
v = let v' :: Double
v' = Maybe Double -> Double
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Double
forall a. Read a => ByteString -> Maybe a
readFromByteString @Double ByteString
v
in String -> ByteString
C8L.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int -> Double -> Int
scale 1000 Double
v'
ngxExportYY 'scale1000