{-# 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.Char8 as C8
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.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Aeson
import Data.Maybe
import Data.Function
import Data.List
import Data.Char
import Data.Word
import Data.Array.ST hiding (range)
import Control.Arrow
import Control.Monad
import Control.Monad.ST
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 t t.
(IsString t, Fractional t) =>
Map MetricsName t
-> MetricsName -> Map MetricsName t -> Map MetricsName (t, t)
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 -> (MetricsName -> Maybe MetricsName -> MetricsName
forall a. a -> Maybe a -> a
fromMaybe "" (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),)) 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 t
-> MetricsName -> Map MetricsName t -> Map MetricsName (t, t)
toHistogram cs :: Map MetricsName t
cs hk :: MetricsName
hk rs :: Map MetricsName t
rs =
let ranges :: Map MetricsName (t, t)
ranges = (MetricsName -> t -> (t, t))
-> Map MetricsName t -> Map MetricsName (t, t)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
(\k :: MetricsName
k -> (, t -> Maybe t -> t
forall a. a -> Maybe a -> a
fromMaybe 0.0 (MetricsName -> Map MetricsName t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
k Map MetricsName t
cs))) Map MetricsName t
rs
sums :: Map MetricsName (t, t)
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 (t, t)
withZeroLabel = (t, t) -> Maybe (t, t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((t, t) -> Maybe (t, t)) -> (t -> (t, t)) -> t -> Maybe (t, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("",)
in [(MetricsName, (t, t))] -> Map MetricsName (t, t)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsName, (t, t))] -> Map MetricsName (t, t))
-> [(MetricsName, (t, t))] -> Map MetricsName (t, t)
forall a b. (a -> b) -> a -> b
$
((MetricsName, Maybe (t, t)) -> (MetricsName, (t, t)))
-> [(MetricsName, Maybe (t, t))] -> [(MetricsName, (t, t))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (t, t) -> (t, t))
-> (MetricsName, Maybe (t, t)) -> (MetricsName, (t, t))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (t, t) -> (t, t)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsName, Maybe (t, t))] -> [(MetricsName, (t, t))])
-> [(MetricsName, Maybe (t, t))] -> [(MetricsName, (t, t))]
forall a b. (a -> b) -> a -> b
$ ((MetricsName, Maybe (t, t)) -> Bool)
-> [(MetricsName, Maybe (t, t))] -> [(MetricsName, Maybe (t, t))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (t, t) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (t, t) -> Bool)
-> ((MetricsName, Maybe (t, t)) -> Maybe (t, t))
-> (MetricsName, Maybe (t, t))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName, Maybe (t, t)) -> Maybe (t, t)
forall a b. (a, b) -> b
snd)
[(MetricsName
v1, MetricsName -> Map MetricsName t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v1 Map MetricsName t
cs Maybe t -> (t -> Maybe (t, t)) -> Maybe (t, t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> Maybe (t, t)
forall t. t -> Maybe (t, t)
withZeroLabel)
,(MetricsName
v2, MetricsName -> Map MetricsName t -> Maybe t
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v2 Map MetricsName t
cs Maybe t -> (t -> Maybe (t, t)) -> Maybe (t, t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> Maybe (t, t)
forall t. t -> Maybe (t, t)
withZeroLabel)
]
in Map MetricsName (t, t)
ranges Map MetricsName (t, t)
-> Map MetricsName (t, t) -> Map MetricsName (t, t)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName (t, t)
sums
showPrometheusMetrics :: PrometheusMetrics -> L.ByteString
showPrometheusMetrics :: PrometheusMetrics -> ByteString
showPrometheusMetrics = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString)
-> (PrometheusMetrics -> Text) -> PrometheusMetrics -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> MetricsName -> (MetricsName, MetricsType) -> Text)
-> Text -> PrometheusMetrics -> Text
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey
(\a :: Text
a k :: MetricsName
k (h :: MetricsName
h, m :: MetricsType
m) ->
let k' :: Text
k' = MetricsName -> Text
TL.fromStrict MetricsName
k
in [Text] -> Text
TL.concat [Text
a, "# HELP ", Text
k', " ", MetricsName -> Text
TL.fromStrict MetricsName
h, "\n"
, "# TYPE ", Text
k', " ", MetricsType -> Text
forall p. IsString p => MetricsType -> p
showType MetricsType
m, "\n"
,case MetricsType
m of
Counter v :: Double
v -> [Text] -> Text
TL.concat
[Text
k', " ", String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v, "\n"]
Gauge v :: Double
v -> [Text] -> Text
TL.concat
[Text
k', " ", String -> Text
TL.pack (String -> Text) -> String -> Text
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' -> (Text, Double) -> Text
forall a b. (a, b) -> a
fst ((Text, Double) -> Text) -> (Text, Double) -> Text
forall a b. (a -> b) -> a -> b
$
((Text, Double)
-> MetricsName -> (MetricsName, Double) -> (Text, Double))
-> (Text, Double)
-> Map MetricsName (MetricsName, Double)
-> (Text, Double)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (MetricsName
-> Text
-> (Text, Double)
-> MetricsName
-> (MetricsName, Double)
-> (Text, Double)
forall a.
(Show a, RealFrac a) =>
MetricsName
-> Text
-> (Text, a)
-> MetricsName
-> (MetricsName, a)
-> (Text, a)
showHistogram MetricsName
k Text
k') ("", 0.0) Map MetricsName (MetricsName, Double)
h'
]
) ""
where showType :: MetricsType -> p
showType (Counter _) = "counter"
showType (Gauge _) = "gauge"
showType (Histogram _) = "histogram"
showHistogram :: MetricsName
-> Text
-> (Text, a)
-> MetricsName
-> (MetricsName, a)
-> (Text, a)
showHistogram k :: MetricsName
k k' :: Text
k' a :: (Text, a)
a@(t :: Text
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 ([Text] -> Text
TL.concat [Text
t
,MetricsName -> Text
TL.fromStrict MetricsName
c
," "
,String -> Text
TL.pack (String -> Text) -> String -> Text
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 ([Text] -> Text
TL.concat [Text
t
,Text
k'
,"_count "
,String -> Text
TL.pack (String -> Text) -> String -> Text
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 (Text, a)
a
else let n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
v
in ([Text] -> Text
TL.concat [Text
t
,Text
k'
,"_bucket{le=\"", MetricsName -> Text
TL.fromStrict MetricsName
l, "\"} "
,String -> Text
TL.pack (String -> Text) -> String -> Text
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
$ ByteString
-> (PrometheusConf -> ByteString)
-> Maybe PrometheusConf
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" (PrometheusMetrics -> ByteString
showPrometheusMetrics (PrometheusMetrics -> ByteString)
-> (PrometheusConf -> PrometheusMetrics)
-> PrometheusConf
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrometheusConf -> AllMetrtics -> PrometheusMetrics)
-> AllMetrtics -> PrometheusConf -> PrometheusMetrics
forall a b c. (a -> b -> c) -> b -> a -> c
flip PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' AllMetrtics
cs) Maybe PrometheusConf
pc
ngxExportIOYY 'toPrometheusMetrics
textPlain :: ByteString
textPlain :: ByteString
textPlain = "text/plain; version=0.0.4; charset=utf-8"
prometheusMetrics :: ByteString -> IO ContentHandlerResult
prometheusMetrics :: ByteString -> IO ContentHandlerResult
prometheusMetrics = (ByteString -> ContentHandlerResult)
-> IO ByteString -> IO ContentHandlerResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ByteString
textPlain, 200, []) (IO ByteString -> IO ContentHandlerResult)
-> (ByteString -> IO ByteString)
-> ByteString
-> IO ContentHandlerResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ByteString
toPrometheusMetrics
ngxExportAsyncHandler 'prometheusMetrics
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
extractValues :: ByteString -> [ByteString]
= (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
C8.null (ByteString -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> Bool
isDigit (Char -> Bool) -> (ByteString -> Char) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
C8.head)
([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> [ByteString]
C8.splitWith (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isDigit (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '.'))
statusLayout :: ByteString -> L.ByteString
statusLayout :: ByteString -> ByteString
statusLayout = String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "," ([String] -> String)
-> (ByteString -> [String]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show ([Int] -> [String])
-> (ByteString -> [Int]) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
statuses
where statuses :: ByteString -> [Int]
statuses s :: ByteString
s = (forall s. ST s [Int]) -> [Int]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [Int]) -> [Int])
-> (forall s. ST s [Int]) -> [Int]
forall a b. (a -> b) -> a -> b
$ do
STUArray s Int Int
a <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int, Int)
bs 0 :: ST s (STUArray s Int Int)
((Int, Int) -> ST s ()) -> [(Int, Int)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Int -> Int -> ST s ()) -> (Int, Int) -> ST s ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Int -> Int -> ST s ()) -> (Int, Int) -> ST s ())
-> (Int -> Int -> ST s ()) -> (Int, Int) -> ST s ()
forall a b. (a -> b) -> a -> b
$ STUArray s Int Int -> Int -> Int -> ST s ()
forall (f :: * -> *) (a :: * -> * -> *) e.
MArray a e f =>
a Int e -> Int -> e -> f ()
writeStatus STUArray s Int Int
a) ([(Int, Int)] -> ST s ()) -> [(Int, Int)] -> ST s ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [(Int, Int)]
toPairs ByteString
s
STUArray s Int Int -> ST s [Int]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems STUArray s Int Int
a
toPairs :: ByteString -> [(Int, Int)]
toPairs = ([ByteString] -> (Int, Int)) -> [[ByteString]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (Char -> Int
ord '0') (Int -> Int) -> ([ByteString] -> Int) -> [ByteString] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Int) -> ([ByteString] -> Char) -> [ByteString] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Char
C8.head (ByteString -> Char)
-> ([ByteString] -> ByteString) -> [ByteString] -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> Int)
-> ([ByteString] -> Int) -> [ByteString] -> (Int, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
([[ByteString]] -> [(Int, Int)])
-> (ByteString -> [[ByteString]]) -> ByteString -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> Bool)
-> [ByteString] -> [[ByteString]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Char -> Char -> Bool)
-> (ByteString -> Char) -> ByteString -> ByteString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ByteString -> Char
C8.head)
([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. Ord a => [a] -> [a]
sort
([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
extractValues
writeStatus :: a Int e -> Int -> e -> f ()
writeStatus a :: a Int e
a i :: Int
i = Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
lb Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ub) (f () -> f ()) -> (e -> f ()) -> e -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a Int e -> Int -> e -> f ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray a Int e
a Int
i
bs :: (Int, Int)
bs@(lb :: Int
lb, ub :: Int
ub) = (2, 5)
ngxExportYY 'statusLayout
cumulativeValue' :: (Num a, Read a) => ByteString -> a
cumulativeValue' :: ByteString -> a
cumulativeValue' = (ByteString -> a -> a) -> a -> [ByteString] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> a -> a
forall a. Num a => a -> a -> a
(+) (a -> a -> a) -> (ByteString -> a) -> ByteString -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> a
forall a. Read a => String -> a
read (String -> a) -> (ByteString -> String) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C8.unpack)) 0 ([ByteString] -> a)
-> (ByteString -> [ByteString]) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
extractValues
cumulativeValue :: ByteString -> L.ByteString
cumulativeValue :: ByteString -> ByteString
cumulativeValue = String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (ByteString -> Int) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Num Int, Read Int) => ByteString -> Int
forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Int
ngxExportYY 'cumulativeValue
cumulativeFPValue :: ByteString -> L.ByteString
cumulativeFPValue :: ByteString -> ByteString
cumulativeFPValue = String -> ByteString
C8L.pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. Show a => a -> String
show (Double -> String)
-> (ByteString -> Double) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Num Double, Read Double) => ByteString -> Double
forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Double
ngxExportYY 'cumulativeFPValue