{-# LANGUAGE TemplateHaskell, DeriveGeneric, RecordWildCards #-}
{-# LANGUAGE TypeApplications, TupleSections, OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport.Tools.Prometheus
-- Copyright   :  (c) Alexey Radkov 2020-2022
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  stable
-- Portability :  non-portable (requires Template Haskell)
--
-- Prometheus metrics from the more extra tools collection for
-- <https://github.com/lyokha/nginx-haskell-module nginx-haskell-module>.
--
-----------------------------------------------------------------------------


module NgxExport.Tools.Prometheus (
    -- * Exporters
    -- $exporters

    -- * Utilities
    -- *** Scaling functions
                                   scale
                                  ,scale1000
    -- *** Converting lists of values to counters
    -- $convertingListsOfValuesToCounters

    -- * Parameterization of metrics with custom labels
    -- $parameterization
                                  ) where

import           NgxExport
import           NgxExport.Tools.Read
import           NgxExport.Tools.SimpleService
import           NgxExport.Tools.SplitService

import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HS
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 MetricsAnnotation = Text
type CounterValue = Word64
type MetricsData = Map MetricsName CounterValue
type HistogramData = Map MetricsName (MetricsLabel, MetricsRole, Double)
type MetricsToLabelMap = Map MetricsName MetricsLabel

data PrometheusConf =
    PrometheusConf { PrometheusConf -> Map MetricsHelp MetricsHelp
pcMetrics :: Map MetricsName MetricsHelp
                   , PrometheusConf -> HashSet MetricsHelp
pcGauges :: HashSet MetricsName
                   , PrometheusConf -> HashSet MetricsHelp
pcScale1000 :: HashSet 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
$creadsPrec :: Int -> ReadS PrometheusConf
readsPrec :: Int -> ReadS PrometheusConf
$creadList :: ReadS [PrometheusConf]
readList :: ReadS [PrometheusConf]
$creadPrec :: ReadPrec PrometheusConf
readPrec :: ReadPrec PrometheusConf
$creadListPrec :: ReadPrec [PrometheusConf]
readListPrec :: ReadPrec [PrometheusConf]
Read

data HistogramLayout =
    HistogramLayout { HistogramLayout -> Map MetricsHelp MetricsHelp
range :: MetricsToLabelMap
                    , HistogramLayout -> (MetricsHelp, MetricsHelp)
cnt :: (MetricsName, MetricsLabel)
                    , HistogramLayout -> (MetricsHelp, MetricsHelp)
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
$cfrom :: forall x. HistogramLayout -> Rep HistogramLayout x
from :: forall x. HistogramLayout -> Rep HistogramLayout x
$cto :: forall x. Rep HistogramLayout x -> HistogramLayout
to :: forall x. Rep HistogramLayout x -> HistogramLayout
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 MetricsAnnotation
                 | Gauge Double MetricsAnnotation
                 | Histogram HistogramData MetricsAnnotation

data MetricsRole = HistogramBucket
                 | HistogramSum
                 | HistogramCount deriving MetricsRole -> MetricsRole -> Bool
(MetricsRole -> MetricsRole -> Bool)
-> (MetricsRole -> MetricsRole -> Bool) -> Eq MetricsRole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricsRole -> MetricsRole -> Bool
== :: MetricsRole -> MetricsRole -> Bool
$c/= :: MetricsRole -> MetricsRole -> Bool
/= :: MetricsRole -> MetricsRole -> Bool
Eq

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 #-}

-- $exporters
--
-- This module is aimed to convert custom counters from
-- [nginx-custom-counters-module](https://github.com/lyokha/nginx-custom-counters-module)
-- to Prometheus metrics. For this, it exposes four exporters:
-- __/prometheusConf/__ which is an 'ignitionService' in terms of module
-- "NgxExport.Tools.SplitService", __/toPrometheusMetrics/__ to convert
-- /custom counters/ to Prometheus metrics, __/prometheusMetrics/__ which is a
-- content handler aiming to return Prometheus metrics to the client, and a
-- handy utility __/scale1000/__ to convert small floating point numbers to
-- integers by multiplying them by /1000/ (which fits well for dealing with
-- request durations).
--
-- The module makes use of a few custom data types which are not exported while
-- still needed when writing Nginx configurations. In the following example they
-- are used in configurations of /simpleService_prometheusConf/ and
-- /toPrometheusMetrics/.
--
-- ==== File /test_tools_extra_prometheus.hs/
-- @
-- module TestToolsExtraPrometheus where
--
-- import NgxExport.Tools.Prometheus ()
-- @
--
-- The file does not contain any significant declarations as we are going to use
-- only the exporters.
--
-- ==== File /nginx.conf/
-- @
-- user                    nobody;
-- worker_processes        2;
--
-- events {
--     worker_connections  1024;
-- }
--
-- http {
--     default_type        application\/octet-stream;
--     sendfile            on;
--
--     map $status $inc_cnt_4xx {
--         default         0;
--         \'~^4(?:\\d){2}\'  1;
--     }
--
--     map $status $inc_cnt_5xx {
--         default         0;
--         \'~^5(?:\\d){2}\'  1;
--     }
--
--     map_to_range_index $hs_request_time $request_time_bucket
--         0.005
--         0.01
--         0.05
--         0.1
--         0.5
--         1.0
--         5.0
--         10.0
--         30.0
--         60.0;
--
--     map_to_range_index $hs_bytes_sent $bytes_sent_bucket
--         0
--         10
--         100
--         1000
--         10000;
--
--     haskell load \/var\/lib\/nginx\/test_tools_extra_prometheus.so;
--
--     haskell_run_service __/simpleService_prometheusConf/__ $hs_prometheus_conf
--             \'__/PrometheusConf/__
--                 { __/pcMetrics/__ = fromList
--                     [(\"cnt_4xx\", \"Number of responses with 4xx status\")
--                     ,(\"cnt_5xx\", \"Number of responses with 5xx status\")
--                     ,(\"cnt_stub_status_active\", \"Active requests\")
--                     ,(\"cnt_uptime\", \"Nginx master uptime\")
--                     ,(\"cnt_uptime_reload\", \"Nginx master uptime after reload\")
--                     ,(\"hst_request_time\", \"Request duration\")
--                     ]
--                 , __/pcGauges/__ = fromList
--                     [\"cnt_stub_status_active\"]
--                 , __/pcScale1000/__ = fromList
--                     [\"hst_request_time_sum\"]
--                 }';
--
--     haskell_var_empty_on_error $hs_prom_metrics;
--
--     counters_survive_reload on;
--
--     server {
--         listen       8010;
--         server_name  __/main/__;
--         error_log    \/tmp\/nginx-test-haskell-error.log;
--         access_log   \/tmp\/nginx-test-haskell-access.log;
--
--         counter $cnt_4xx inc $inc_cnt_4xx;
--         counter $cnt_5xx inc $inc_cnt_5xx;
--
--         \# cache $request_time and $bytes_sent
--         haskell_run ! $hs_request_time $request_time;
--         haskell_run ! $hs_bytes_sent $bytes_sent;
--
--         histogram $hst_request_time 11 $request_time_bucket;
--         haskell_run __/scale1000/__ $hs_request_time_scaled $hs_request_time;
--         counter $hst_request_time_sum inc $hs_request_time_scaled;
--
--         histogram $hst_bytes_sent 6 $bytes_sent_bucket;
--         counter $hst_bytes_sent_sum inc $hs_bytes_sent;
--
--         location \/ {
--             echo_sleep 0.5;
--             echo Ok;
--         }
--
--         location \/1 {
--             echo_sleep 1.0;
--             echo Ok;
--         }
--
--         location \/404 {
--             return 404;
--         }
--     }
--
--     server {
--         listen       8020;
--         server_name  stats;
--
--         location \/ {
--             haskell_run __/toPrometheusMetrics/__ $hs_prom_metrics
--                     '[\"__/main/__\"
--                      ,$__/cnt_collection/__
--                      ,$__/cnt_histograms/__
--                      ,{\"cnt_stub_status_active\": $cnt_stub_status_active
--                       ,\"cnt_uptime\": $cnt_uptime
--                       ,\"cnt_uptime_reload\": $cnt_uptime_reload
--                       }
--                      ]\';
--
--             if ($hs_prom_metrics = \'\') {
--                 return 503;
--             }
--
--             default_type \"text/plain; version=0.0.4; charset=utf-8\";
--
--             echo -n $hs_prom_metrics;
--         }
--
--         location \/counters {
--             default_type application/json;
--             echo $cnt_collection;
--         }
--
--         location \/histograms {
--             default_type application/json;
--             echo $cnt_histograms;
--         }
--
--         location \/uptime {
--             echo "Uptime (after reload): $cnt_uptime ($cnt_uptime_reload)";
--         }
--     }
-- }
-- @
--
-- Type /PrometheusConf/ contains fields /pcMetrics/, /pcGauges/, and
-- /pcScale1000/. Field /pcMetrics/ is a map from metrics names to help
-- messages: this can be used to bind small descriptions to the metrics as
-- /nginx-custom-counters-module/ does not provide such functionality. Setting
-- descriptions to counters is optional. Field /pcGauges/ lists counters that
-- must be regarded as gauges: the number of currently active requests is
-- obviously a gauge. Field /pcScale1000/ contains a list of counters that were
-- scaled with /scale1000/ and must be converted back.
--
-- Handler /toPrometheusMetrics/ expects 4 fields: the name of the
-- /counter set identifier/ &#8212; in our example there is only one counter
-- set /main/, predefined variables /cnt_collection/ and /cnt_histograms/ from
-- /nginx-custom-counters-module/, and a list of additional counters &#8212; in
-- our example there are three additional counters /cnt_stub_status_active/,
-- /cnt_uptime/, and /cnt_uptime_reload/ which are also defined in
-- /nginx-custom-counters-module/.
--
-- To fulfill histogram description in Prometheus, the /sum/ value must be
-- provided. Histogram sums are not supported in /nginx-custom-counters-module/,
-- and therefore they must be declared in separate counters. In this example
-- there are two histograms collecting request durations and the number of sent
-- bytes, and accordingly, there are two sum counters: /hst_request_time_sum/
-- and /hst_bytes_sent_sum/. As request durations may last milliseconds while
-- being shown in seconds, they must be scaled with /scale1000/.
--
-- To further ensure histogram validity, it is important to have the last bucket
-- in a histogram labeled as /\"+Inf\"/. This is achieved automatically when
-- the number of range boundaries in directive /map_to_range_index/ is less by
-- one than the number in the corresponding histogram declaration: in this
-- example, the map for /request_time_bucket/ has 10 range boundaries while
-- histogram /hst_request_time/ has 11 buckets, the map for /bytes_sent_bucket/
-- has 5 range boundaries while histogram /hst_bytes_sent/ has 6 buckets.
--
-- Notice that the variable handler /toPrometheusMetrics/ and directive /echo/
-- in location /\// can be replaced with a single content handler
-- /prometheusMetrics/ like in the following block.
--
-- @
--         location \/ {
--             haskell_async_content __/prometheusMetrics/__
--                     '[\"__/main/__\"
--                      ,$__/cnt_collection/__
--                      ,$__/cnt_histograms/__
--                      ,{\"cnt_stub_status_active\": $cnt_stub_status_active
--                       ,\"cnt_uptime\": $cnt_uptime
--                       ,\"cnt_uptime_reload\": $cnt_uptime_reload
--                       }
--                      ]\';
--         }
-- @
--
-- ==== A simple test
--
-- Let's look at the metrics right after starting Nginx.
--
-- > $ curl -s 'http://localhost:8020/'
-- > # HELP cnt_4xx Number of responses with 4xx status
-- > # TYPE cnt_4xx counter
-- > cnt_4xx 0.0
-- > # HELP cnt_5xx Number of responses with 5xx status
-- > # TYPE cnt_5xx counter
-- > cnt_5xx 0.0
-- > # HELP cnt_stub_status_active Active requests
-- > # TYPE cnt_stub_status_active gauge
-- > cnt_stub_status_active 1.0
-- > # HELP cnt_uptime Nginx master uptime
-- > # TYPE cnt_uptime counter
-- > cnt_uptime 8.0
-- > # HELP cnt_uptime_reload Nginx master uptime after reload
-- > # TYPE cnt_uptime_reload counter
-- > cnt_uptime_reload 8.0
-- > # HELP hst_bytes_sent 
-- > # TYPE hst_bytes_sent histogram
-- > hst_bytes_sent_bucket{le="0"} 0
-- > hst_bytes_sent_bucket{le="10"} 0
-- > hst_bytes_sent_bucket{le="100"} 0
-- > hst_bytes_sent_bucket{le="1000"} 0
-- > hst_bytes_sent_bucket{le="10000"} 0
-- > hst_bytes_sent_bucket{le="+Inf"} 0
-- > hst_bytes_sent_count 0
-- > hst_bytes_sent_sum 0.0
-- > # HELP hst_bytes_sent_err 
-- > # TYPE hst_bytes_sent_err counter
-- > hst_bytes_sent_err 0.0
-- > # HELP hst_request_time Request duration
-- > # TYPE hst_request_time histogram
-- > hst_request_time_bucket{le="0.005"} 0
-- > hst_request_time_bucket{le="0.01"} 0
-- > hst_request_time_bucket{le="0.05"} 0
-- > hst_request_time_bucket{le="0.1"} 0
-- > hst_request_time_bucket{le="0.5"} 0
-- > hst_request_time_bucket{le="1.0"} 0
-- > hst_request_time_bucket{le="5.0"} 0
-- > hst_request_time_bucket{le="10.0"} 0
-- > hst_request_time_bucket{le="30.0"} 0
-- > hst_request_time_bucket{le="60.0"} 0
-- > hst_request_time_bucket{le="+Inf"} 0
-- > hst_request_time_count 0
-- > hst_request_time_sum 0.0
-- > # HELP hst_request_time_err 
-- > # TYPE hst_request_time_err counter
-- > hst_request_time_err 0.0
--
-- Run some requests and look at the metrics again.
--
-- > $ for i in {1..20} ; do curl -D- 'http://localhost:8010/' & done
-- >   ...
-- > $ for i in {1..30} ; do curl -D- 'http://localhost:8010/1' & done
-- >   ...
-- > $ curl 'http://127.0.0.1:8010/404'
-- >   ...
--
-- > $ curl -s 'http://localhost:8020/'
-- > # HELP cnt_4xx Number of responses with 4xx status
-- > # TYPE cnt_4xx counter
-- > cnt_4xx 1.0
-- > # HELP cnt_5xx Number of responses with 5xx status
-- > # TYPE cnt_5xx counter
-- > cnt_5xx 0.0
-- > # HELP cnt_stub_status_active Active requests
-- > # TYPE cnt_stub_status_active gauge
-- > cnt_stub_status_active 1.0
-- > # HELP cnt_uptime Nginx master uptime
-- > # TYPE cnt_uptime counter
-- > cnt_uptime 371.0
-- > # HELP cnt_uptime_reload Nginx master uptime after reload
-- > # TYPE cnt_uptime_reload counter
-- > cnt_uptime_reload 371.0
-- > # HELP hst_bytes_sent 
-- > # TYPE hst_bytes_sent histogram
-- > hst_bytes_sent_bucket{le="0"} 0
-- > hst_bytes_sent_bucket{le="10"} 0
-- > hst_bytes_sent_bucket{le="100"} 0
-- > hst_bytes_sent_bucket{le="1000"} 51
-- > hst_bytes_sent_bucket{le="10000"} 51
-- > hst_bytes_sent_bucket{le="+Inf"} 51
-- > hst_bytes_sent_count 51
-- > hst_bytes_sent_sum 9458.0
-- > # HELP hst_bytes_sent_err 
-- > # TYPE hst_bytes_sent_err counter
-- > hst_bytes_sent_err 0.0
-- > # HELP hst_request_time Request duration
-- > # TYPE hst_request_time histogram
-- > hst_request_time_bucket{le="0.005"} 1
-- > hst_request_time_bucket{le="0.01"} 1
-- > hst_request_time_bucket{le="0.05"} 1
-- > hst_request_time_bucket{le="0.1"} 1
-- > hst_request_time_bucket{le="0.5"} 13
-- > hst_request_time_bucket{le="1.0"} 44
-- > hst_request_time_bucket{le="5.0"} 51
-- > hst_request_time_bucket{le="10.0"} 51
-- > hst_request_time_bucket{le="30.0"} 51
-- > hst_request_time_bucket{le="60.0"} 51
-- > hst_request_time_bucket{le="+Inf"} 51
-- > hst_request_time_count 51
-- > hst_request_time_sum 40.006
-- > # HELP hst_request_time_err 
-- > # TYPE hst_request_time_err counter
-- > hst_request_time_err 0.0

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
$ \PrometheusConf
a -> do
    IORef (Maybe PrometheusConf) -> Maybe PrometheusConf -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""

ngxExportSimpleServiceTyped 'prometheusConf ''PrometheusConf SingleShotService

toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' :: PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' PrometheusConf {Map MetricsHelp MetricsHelp
HashSet MetricsHelp
pcMetrics :: PrometheusConf -> Map MetricsHelp MetricsHelp
pcGauges :: PrometheusConf -> HashSet MetricsHelp
pcScale1000 :: PrometheusConf -> HashSet MetricsHelp
pcMetrics :: Map MetricsHelp MetricsHelp
pcGauges :: HashSet MetricsHelp
pcScale1000 :: HashSet MetricsHelp
..} (MetricsHelp
srv, AllCounters
cnts, AllHistogramsLayout
hs, AllOtherCounters
ocnts) =
    let toValues :: AllOtherCounters -> Map MetricsHelp Double
toValues = (MetricsHelp -> CounterValue -> Double)
-> AllOtherCounters -> Map MetricsHelp Double
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
            (\MetricsHelp
k CounterValue
v -> (if MetricsHelp
k MetricsHelp -> HashSet MetricsHelp -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet MetricsHelp
pcScale1000
                          then (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
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 MetricsHelp Double
cnts' = Map MetricsHelp Double
-> (AllOtherCounters -> Map MetricsHelp Double)
-> Maybe AllOtherCounters
-> Map MetricsHelp Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map MetricsHelp Double
forall k a. Map k a
M.empty AllOtherCounters -> Map MetricsHelp Double
toValues (Maybe AllOtherCounters -> Map MetricsHelp Double)
-> Maybe AllOtherCounters -> Map MetricsHelp Double
forall a b. (a -> b) -> a -> b
$ MetricsHelp -> AllCounters -> Maybe AllOtherCounters
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
srv AllCounters
cnts
        hs' :: Maybe (Map MetricsHelp HistogramLayout)
hs' = MetricsHelp
-> AllHistogramsLayout -> Maybe (Map MetricsHelp HistogramLayout)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
srv AllHistogramsLayout
hs
        (Map
  MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH, Map MetricsHelp Double
cntsC, Map MetricsHelp Double
cntsG) =
            if Bool
-> (Map MetricsHelp HistogramLayout -> Bool)
-> Maybe (Map MetricsHelp HistogramLayout)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Map MetricsHelp HistogramLayout -> Bool
forall k a. Map k a -> Bool
M.null Maybe (Map MetricsHelp HistogramLayout)
hs'
                then let (Map MetricsHelp Double
cntsG', Map MetricsHelp Double
cntsC') = (MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter Map MetricsHelp Double
cnts'
                     in (Map
  MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
forall k a. Map k a
M.empty, Map MetricsHelp Double
cntsC', Map MetricsHelp Double
cntsG')
                else let hs'' :: Map MetricsHelp HistogramLayout
hs'' = Maybe (Map MetricsHelp HistogramLayout)
-> Map MetricsHelp HistogramLayout
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map MetricsHelp HistogramLayout)
hs'
                         rs :: ([MetricsHelp], Map MetricsHelp MetricsHelp)
rs = Map MetricsHelp HistogramLayout -> [MetricsHelp]
forall k a. Map k a -> [k]
M.keys (Map MetricsHelp HistogramLayout -> [MetricsHelp])
-> (Map MetricsHelp HistogramLayout -> Map MetricsHelp MetricsHelp)
-> Map MetricsHelp HistogramLayout
-> ([MetricsHelp], Map MetricsHelp MetricsHelp)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (HistogramLayout
 -> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp HistogramLayout
-> Map MetricsHelp MetricsHelp
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr HistogramLayout
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
labeledRange Map MetricsHelp MetricsHelp
forall k a. Map k a
M.empty (Map MetricsHelp HistogramLayout
 -> ([MetricsHelp], Map MetricsHelp MetricsHelp))
-> Map MetricsHelp HistogramLayout
-> ([MetricsHelp], Map MetricsHelp MetricsHelp)
forall a b. (a -> b) -> a -> b
$ Map MetricsHelp HistogramLayout
hs''
                         (Map MetricsHelp Double
cntsH', (Map MetricsHelp Double
cntsG', Map MetricsHelp Double
cntsC')) =
                             (Map MetricsHelp Double
 -> (Map MetricsHelp Double, Map MetricsHelp Double))
-> (Map MetricsHelp Double, Map MetricsHelp Double)
-> (Map MetricsHelp Double,
    (Map MetricsHelp Double, Map MetricsHelp Double))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter) ((Map MetricsHelp Double, Map MetricsHelp Double)
 -> (Map MetricsHelp Double,
     (Map MetricsHelp Double, Map MetricsHelp Double)))
-> (Map MetricsHelp Double, Map MetricsHelp Double)
-> (Map MetricsHelp Double,
    (Map MetricsHelp Double, Map MetricsHelp Double))
forall a b. (a -> b) -> a -> b
$
                             (MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (([MetricsHelp], Map MetricsHelp MetricsHelp)
-> MetricsHelp -> Double -> Bool
forall {t :: * -> *} {a} {b}.
Foldable t =>
(t MetricsHelp, Map MetricsHelp a) -> MetricsHelp -> b -> Bool
hCounter ([MetricsHelp], Map MetricsHelp MetricsHelp)
rs) Map MetricsHelp Double
cnts'
                         cntsH'' :: Map
  MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH'' = (MetricsHelp
 -> HistogramLayout
 -> Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> Map MetricsHelp HistogramLayout
-> Map
     MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
                             (\MetricsHelp
k -> Map MetricsHelp Double
-> MetricsHelp
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
forall {a} {a}.
(IsString a, Fractional a) =>
Map MetricsHelp a
-> MetricsHelp
-> Map MetricsHelp a
-> Map MetricsHelp (a, MetricsRole, a)
toHistogram Map MetricsHelp Double
cntsH' MetricsHelp
k (Map MetricsHelp MetricsHelp
 -> Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsHelp MetricsHelp
range) Map MetricsHelp HistogramLayout
hs''
                     in (Map
  MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH'', Map MetricsHelp Double
cntsC', Map MetricsHelp Double
cntsG')
        (Map MetricsHelp Double
cntsOG, Map MetricsHelp Double
cntsOC) = (MetricsHelp -> Double -> Bool)
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsHelp -> Double -> Bool
forall {b}. MetricsHelp -> b -> Bool
gCounter (Map MetricsHelp Double
 -> (Map MetricsHelp Double, Map MetricsHelp Double))
-> Map MetricsHelp Double
-> (Map MetricsHelp Double, Map MetricsHelp Double)
forall a b. (a -> b) -> a -> b
$ AllOtherCounters -> Map MetricsHelp Double
toValues AllOtherCounters
ocnts
        cntsA :: Map MetricsHelp [MetricsType]
cntsA = (Map MetricsHelp (MetricsHelp, MetricsRole, Double)
 -> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map
     MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Map MetricsHelp (MetricsHelp, MetricsRole, Double)
-> MetricsHelp -> MetricsType
Histogram MetricsHelp -> MetricsHelp
forall a. a -> a
id Map
  MetricsHelp (Map MetricsHelp (MetricsHelp, MetricsRole, Double))
cntsH
                Map MetricsHelp [MetricsType]
-> Map MetricsHelp [MetricsType] -> Map MetricsHelp [MetricsType]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` (Double -> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map MetricsHelp Double
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Double -> MetricsHelp -> MetricsType
Counter MetricsHelp -> MetricsHelp
renameErrCounter
                    (Map MetricsHelp Double
cntsC Map MetricsHelp Double
-> Map MetricsHelp Double -> Map MetricsHelp Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp Double
cntsOC)
                Map MetricsHelp [MetricsType]
-> Map MetricsHelp [MetricsType] -> Map MetricsHelp [MetricsType]
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` (Double -> MetricsHelp -> MetricsType)
-> (MetricsHelp -> MetricsHelp)
-> Map MetricsHelp Double
-> Map MetricsHelp [MetricsType]
forall {a} {b} {k1}.
(a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect Double -> MetricsHelp -> MetricsType
Gauge MetricsHelp -> MetricsHelp
forall a. a -> a
id (Map MetricsHelp Double
cntsG Map MetricsHelp Double
-> Map MetricsHelp Double -> Map MetricsHelp Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp Double
cntsOG)
    in (MetricsHelp -> [MetricsType] -> (MetricsHelp, [MetricsType]))
-> Map MetricsHelp [MetricsType] -> PrometheusMetrics
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\MetricsHelp
k -> (MetricsHelp -> Maybe MetricsHelp -> MetricsHelp
forall a. a -> Maybe a -> a
fromMaybe MetricsHelp
"" (MetricsHelp -> Map MetricsHelp MetricsHelp -> Maybe MetricsHelp
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
k Map MetricsHelp MetricsHelp
pcMetrics),)) Map MetricsHelp [MetricsType]
cntsA
    where labeledRange :: HistogramLayout
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
labeledRange = Map MetricsHelp MetricsHelp
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Map MetricsHelp MetricsHelp
 -> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp MetricsHelp
-> Map MetricsHelp MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp -> Bool)
-> Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool) -> (MetricsHelp -> Bool) -> MetricsHelp -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsHelp -> Bool
T.null) (Map MetricsHelp MetricsHelp -> Map MetricsHelp MetricsHelp)
-> (HistogramLayout -> Map MetricsHelp MetricsHelp)
-> HistogramLayout
-> Map MetricsHelp MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsHelp MetricsHelp
range
          hCounter :: (t MetricsHelp, Map MetricsHelp a) -> MetricsHelp -> b -> Bool
hCounter (t MetricsHelp
ks, Map MetricsHelp a
ts) MetricsHelp
k = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool) -> Bool -> b -> Bool
forall a b. (a -> b) -> a -> b
$
              MetricsHelp
k MetricsHelp -> Map MetricsHelp a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MetricsHelp 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
$
                          (MetricsHelp -> [Bool] -> [Bool])
-> [Bool] -> t MetricsHelp -> [Bool]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\MetricsHelp
v ->
                                     let v1 :: MetricsHelp
v1 = MetricsHelp
v MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_sum"
                                         v2 :: MetricsHelp
v2 = MetricsHelp
v MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_cnt"
                                     in ((MetricsHelp
k MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsHelp
v1 Bool -> Bool -> Bool
|| MetricsHelp
k MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsHelp
v2) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)
                                ) [] t MetricsHelp
ks
                      )
          gCounter :: MetricsHelp -> b -> Bool
gCounter = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool)
-> (MetricsHelp -> Bool) -> MetricsHelp -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp -> HashSet MetricsHelp -> Bool)
-> HashSet MetricsHelp -> MetricsHelp -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip MetricsHelp -> HashSet MetricsHelp -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member HashSet MetricsHelp
pcGauges
          toHistogram :: Map MetricsHelp a
-> MetricsHelp
-> Map MetricsHelp a
-> Map MetricsHelp (a, MetricsRole, a)
toHistogram Map MetricsHelp a
cs MetricsHelp
hk Map MetricsHelp a
rs =
              let ranges :: Map MetricsHelp (a, MetricsRole, a)
ranges = (MetricsHelp -> a -> (a, MetricsRole, a))
-> Map MetricsHelp a -> Map MetricsHelp (a, MetricsRole, a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
                      (\MetricsHelp
k ->
                          (, MetricsRole
HistogramBucket, a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0.0 (MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
k Map MetricsHelp a
cs))
                      ) Map MetricsHelp a
rs
                  sums :: Map MetricsHelp (a, MetricsRole, a)
sums = let v1 :: MetricsHelp
v1 = MetricsHelp
hk MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_sum"
                             v2 :: MetricsHelp
v2 = MetricsHelp
hk MetricsHelp -> MetricsHelp -> MetricsHelp
`T.append` MetricsHelp
"_cnt"
                             withZeroLabel :: t -> a -> m (t, t, a)
withZeroLabel t
r = (t, t, a) -> m (t, t, a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((t, t, a) -> m (t, t, a)) -> (a -> (t, t, a)) -> a -> m (t, t, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
"", t
r,)
                         in [(MetricsHelp, (a, MetricsRole, a))]
-> Map MetricsHelp (a, MetricsRole, a)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsHelp, (a, MetricsRole, a))]
 -> Map MetricsHelp (a, MetricsRole, a))
-> [(MetricsHelp, (a, MetricsRole, a))]
-> Map MetricsHelp (a, MetricsRole, a)
forall a b. (a -> b) -> a -> b
$
                             ((MetricsHelp, Maybe (a, MetricsRole, a))
 -> (MetricsHelp, (a, MetricsRole, a)))
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, (a, MetricsRole, a))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (a, MetricsRole, a) -> (a, MetricsRole, a))
-> (MetricsHelp, Maybe (a, MetricsRole, a))
-> (MetricsHelp, (a, MetricsRole, a))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (a, MetricsRole, a) -> (a, MetricsRole, a)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsHelp, Maybe (a, MetricsRole, a))]
 -> [(MetricsHelp, (a, MetricsRole, a))])
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, (a, MetricsRole, a))]
forall a b. (a -> b) -> a -> b
$ ((MetricsHelp, Maybe (a, MetricsRole, a)) -> Bool)
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
-> [(MetricsHelp, Maybe (a, MetricsRole, a))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (a, MetricsRole, a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, MetricsRole, a) -> Bool)
-> ((MetricsHelp, Maybe (a, MetricsRole, a))
    -> Maybe (a, MetricsRole, a))
-> (MetricsHelp, Maybe (a, MetricsRole, a))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp, Maybe (a, MetricsRole, a))
-> Maybe (a, MetricsRole, a)
forall a b. (a, b) -> b
snd)
                                 [(MetricsHelp
v1, MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
v1 Map MetricsHelp a
cs Maybe a
-> (a -> Maybe (a, MetricsRole, a)) -> Maybe (a, MetricsRole, a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                     MetricsRole -> a -> Maybe (a, MetricsRole, a)
forall {m :: * -> *} {t} {t} {a}.
(Monad m, IsString t) =>
t -> a -> m (t, t, a)
withZeroLabel MetricsRole
HistogramSum
                                  )
                                 ,(MetricsHelp
v2, MetricsHelp -> Map MetricsHelp a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsHelp
v2 Map MetricsHelp a
cs Maybe a
-> (a -> Maybe (a, MetricsRole, a)) -> Maybe (a, MetricsRole, a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                     MetricsRole -> a -> Maybe (a, MetricsRole, a)
forall {m :: * -> *} {t} {t} {a}.
(Monad m, IsString t) =>
t -> a -> m (t, t, a)
withZeroLabel MetricsRole
HistogramCount
                                  )
                                 ]
              in Map MetricsHelp (a, MetricsRole, a)
ranges Map MetricsHelp (a, MetricsRole, a)
-> Map MetricsHelp (a, MetricsRole, a)
-> Map MetricsHelp (a, MetricsRole, a)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsHelp (a, MetricsRole, a)
sums
          collect :: (a -> MetricsHelp -> b)
-> (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp [b]
collect a -> MetricsHelp -> b
cType k1 -> MetricsHelp
renameErrCounterF =
              [(MetricsHelp, [b])] -> Map MetricsHelp [b]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
              ([(MetricsHelp, [b])] -> Map MetricsHelp [b])
-> (Map k1 a -> [(MetricsHelp, [b])])
-> Map k1 a
-> Map MetricsHelp [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(MetricsHelp, (a, MetricsHelp))] -> (MetricsHelp, [b]))
-> [[(MetricsHelp, (a, MetricsHelp))]] -> [(MetricsHelp, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp
forall a b. (a, b) -> a
fst ((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp)
-> ([(MetricsHelp, (a, MetricsHelp))]
    -> (MetricsHelp, (a, MetricsHelp)))
-> [(MetricsHelp, (a, MetricsHelp))]
-> MetricsHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MetricsHelp, (a, MetricsHelp))]
-> (MetricsHelp, (a, MetricsHelp))
forall a. HasCallStack => [a] -> a
head) ([(MetricsHelp, (a, MetricsHelp))] -> MetricsHelp)
-> ([(MetricsHelp, (a, MetricsHelp))] -> [b])
-> [(MetricsHelp, (a, MetricsHelp))]
-> (MetricsHelp, [b])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((MetricsHelp, (a, MetricsHelp)) -> b)
-> [(MetricsHelp, (a, MetricsHelp))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> MetricsHelp -> b) -> (a, MetricsHelp) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> MetricsHelp -> b
cType ((a, MetricsHelp) -> b)
-> ((MetricsHelp, (a, MetricsHelp)) -> (a, MetricsHelp))
-> (MetricsHelp, (a, MetricsHelp))
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsHelp, (a, MetricsHelp)) -> (a, MetricsHelp)
forall a b. (a, b) -> b
snd))
              ([[(MetricsHelp, (a, MetricsHelp))]] -> [(MetricsHelp, [b])])
-> (Map k1 a -> [[(MetricsHelp, (a, MetricsHelp))]])
-> Map k1 a
-> [(MetricsHelp, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsHelp, (a, MetricsHelp))
 -> (MetricsHelp, (a, MetricsHelp)) -> Bool)
-> [(MetricsHelp, (a, MetricsHelp))]
-> [[(MetricsHelp, (a, MetricsHelp))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (MetricsHelp -> MetricsHelp -> Bool
forall a. Eq a => a -> a -> Bool
(==) (MetricsHelp -> MetricsHelp -> Bool)
-> ((MetricsHelp, (a, MetricsHelp)) -> MetricsHelp)
-> (MetricsHelp, (a, MetricsHelp))
-> (MetricsHelp, (a, MetricsHelp))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (MetricsHelp, (a, MetricsHelp)) -> MetricsHelp
forall a b. (a, b) -> a
fst)
              ([(MetricsHelp, (a, MetricsHelp))]
 -> [[(MetricsHelp, (a, MetricsHelp))]])
-> (Map k1 a -> [(MetricsHelp, (a, MetricsHelp))])
-> Map k1 a
-> [[(MetricsHelp, (a, MetricsHelp))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsHelp, a) -> (MetricsHelp, (a, MetricsHelp)))
-> [(MetricsHelp, a)] -> [(MetricsHelp, (a, MetricsHelp))]
forall a b. (a -> b) -> [a] -> [b]
map (\(MetricsHelp
k, a
v) ->
                        let (MetricsHelp
k', MetricsHelp
a) =
                                (MetricsHelp -> MetricsHelp)
-> (MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\MetricsHelp
a' ->
                                            if MetricsHelp -> Bool
T.null MetricsHelp
a'
                                                then MetricsHelp
""
                                                else (Char -> Char) -> MetricsHelp -> MetricsHelp
T.map
                                                     (\Char
c ->
                                                         if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'(' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')'
                                                             then Char
'"'
                                                             else Char
c
                                                     ) (MetricsHelp -> MetricsHelp) -> MetricsHelp -> MetricsHelp
forall a b. (a -> b) -> a -> b
$ HasCallStack => MetricsHelp -> MetricsHelp
MetricsHelp -> MetricsHelp
T.tail MetricsHelp
a'
                                       ) ((MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp))
-> (MetricsHelp, MetricsHelp) -> (MetricsHelp, MetricsHelp)
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
T.breakOn MetricsHelp
"@" MetricsHelp
k
                        in (MetricsHelp
k', (a
v, MetricsHelp
a))
                    )
              ([(MetricsHelp, a)] -> [(MetricsHelp, (a, MetricsHelp))])
-> (Map k1 a -> [(MetricsHelp, a)])
-> Map k1 a
-> [(MetricsHelp, (a, MetricsHelp))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map MetricsHelp a -> [(MetricsHelp, a)]
forall k a. Map k a -> [(k, a)]
M.toList
              (Map MetricsHelp a -> [(MetricsHelp, a)])
-> (Map k1 a -> Map MetricsHelp a)
-> Map k1 a
-> [(MetricsHelp, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> MetricsHelp) -> Map k1 a -> Map MetricsHelp a
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeys k1 -> MetricsHelp
renameErrCounterF
          renameErrCounter :: MetricsHelp -> MetricsHelp
renameErrCounter MetricsHelp
k =
              let s :: MetricsHelp
s = MetricsHelp
"_err"
                  (MetricsHelp
b, (MetricsHelp
a, MetricsHelp
e)) =
                      (MetricsHelp -> (MetricsHelp, MetricsHelp))
-> (MetricsHelp, MetricsHelp)
-> (MetricsHelp, (MetricsHelp, MetricsHelp))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\MetricsHelp
v -> (MetricsHelp, MetricsHelp)
-> (MetricsHelp -> (MetricsHelp, MetricsHelp))
-> Maybe MetricsHelp
-> (MetricsHelp, MetricsHelp)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MetricsHelp
v, MetricsHelp
"") (, MetricsHelp
s) (Maybe MetricsHelp -> (MetricsHelp, MetricsHelp))
-> Maybe MetricsHelp -> (MetricsHelp, MetricsHelp)
forall a b. (a -> b) -> a -> b
$ MetricsHelp -> MetricsHelp -> Maybe MetricsHelp
T.stripSuffix MetricsHelp
s MetricsHelp
v) ((MetricsHelp, MetricsHelp)
 -> (MetricsHelp, (MetricsHelp, MetricsHelp)))
-> (MetricsHelp, MetricsHelp)
-> (MetricsHelp, (MetricsHelp, MetricsHelp))
forall a b. (a -> b) -> a -> b
$
                          HasCallStack =>
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
MetricsHelp -> MetricsHelp -> (MetricsHelp, MetricsHelp)
T.breakOn MetricsHelp
"@" MetricsHelp
k
              in [MetricsHelp] -> MetricsHelp
T.concat [MetricsHelp
b, MetricsHelp
e, MetricsHelp
a]

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 -> MetricsHelp -> (MetricsHelp, [MetricsType]) -> Text)
-> Text -> PrometheusMetrics -> Text
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey
    (\Text
a MetricsHelp
k (MetricsHelp
h, [MetricsType]
ms) ->
        let k' :: Text
k' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
k
        in [Text] -> Text
TL.concat [Text
a, Text
"# HELP ", Text
k', Text
" ", MetricsHelp -> Text
TL.fromStrict MetricsHelp
h, Text
"\n"
                     ,   Text
"# TYPE ", Text
k', Text
" ", MetricsType -> Text
forall {a}. IsString a => MetricsType -> a
showType (MetricsType -> Text) -> MetricsType -> Text
forall a b. (a -> b) -> a -> b
$ [MetricsType] -> MetricsType
forall a. HasCallStack => [a] -> a
head [MetricsType]
ms, Text
"\n"
                     ,(Text -> MetricsType -> Text) -> Text -> [MetricsType] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Text -> Text -> MetricsType -> Text
showCounter Text
k') Text
"" [MetricsType]
ms
                     ]
    ) Text
""
    where showType :: MetricsType -> a
showType (Counter Double
_ MetricsHelp
_) = a
"counter"
          showType (Gauge Double
_ MetricsHelp
_) = a
"gauge"
          showType (Histogram Map MetricsHelp (MetricsHelp, MetricsRole, Double)
_ MetricsHelp
_) = a
"histogram"
          showCounter :: Text -> Text -> MetricsType -> Text
showCounter Text
k Text
a MetricsType
m =
              [Text] -> Text
TL.concat [Text
a
                        ,case MetricsType
m of
                            Counter Double
v MetricsHelp
anno -> [Text] -> Text
TL.concat
                                [Text
k, MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" ", [Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
v, Text
"\n"]
                            Gauge Double
v MetricsHelp
anno -> [Text] -> Text
TL.concat
                                [Text
k, MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" ", [Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Double -> [Char]
forall a. Show a => a -> [Char]
show Double
v, Text
"\n"]
                            Histogram Map MetricsHelp (MetricsHelp, MetricsRole, Double)
h' MetricsHelp
anno -> (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)
 -> MetricsHelp
 -> (MetricsHelp, MetricsRole, Double)
 -> (Text, Double))
-> (Text, Double)
-> Map MetricsHelp (MetricsHelp, MetricsRole, Double)
-> (Text, Double)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (Text
-> MetricsHelp
-> (Text, Double)
-> MetricsHelp
-> (MetricsHelp, MetricsRole, Double)
-> (Text, Double)
forall {a} {p}.
(Show a, RealFrac a) =>
Text
-> MetricsHelp
-> (Text, a)
-> p
-> (MetricsHelp, MetricsRole, a)
-> (Text, a)
showHistogram Text
k MetricsHelp
anno)
                                    (Text
"", Double
0.0) Map MetricsHelp (MetricsHelp, MetricsRole, Double)
h'
                        ]
          showAnno :: MetricsHelp -> Text
showAnno MetricsHelp
x = let x' :: Text
x' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
x
                       in if Text -> Bool
TL.null Text
x'
                              then Text
x'
                              else [Text] -> Text
TL.concat [Text
"{", Text
x', Text
"}"]
          showAnnoH :: MetricsHelp -> Text
showAnnoH MetricsHelp
x = let x' :: Text
x' = MetricsHelp -> Text
TL.fromStrict MetricsHelp
x
                        in if Text -> Bool
TL.null Text
x'
                               then Text
x'
                               else [Text] -> Text
TL.concat [Text
",", Text
x']
          showHistogram :: Text
-> MetricsHelp
-> (Text, a)
-> p
-> (MetricsHelp, MetricsRole, a)
-> (Text, a)
showHistogram Text
k MetricsHelp
anno a :: (Text, a)
a@(Text
t, a
n) p
_ (MetricsHelp
l, MetricsRole
r, a
v) =
              if MetricsHelp -> Bool
T.null MetricsHelp
l
                  then case MetricsRole
r of
                      MetricsRole
HistogramSum ->
                          ([Text] -> Text
TL.concat [Text
t, Text
k, Text
"_sum"
                                     ,MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" "
                                     ,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall a. Show a => a -> [Char]
show a
v
                                     ,Text
"\n"
                                     ]
                          ,a
n
                          )
                      MetricsRole
HistogramCount ->
                          ([Text] -> Text
TL.concat [Text
t, Text
k, Text
"_count"
                                     ,MetricsHelp -> Text
showAnno MetricsHelp
anno, Text
" "
                                     ,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ CounterValue -> [Char]
forall a. Show a => a -> [Char]
show (a -> CounterValue
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
v :: Word64)
                                     ,Text
"\n"
                                     ]
                          ,a
n
                          )
                      MetricsRole
_  -> (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
                                     ,Text
"_bucket{le=\"", MetricsHelp -> Text
TL.fromStrict MetricsHelp
l, Text
"\""
                                     ,MetricsHelp -> Text
showAnnoH MetricsHelp
anno, Text
"} "
                                     ,[Char] -> Text
TL.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ CounterValue -> [Char]
forall a. Show a => a -> [Char]
show (a -> CounterValue
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
n' :: Word64)
                                     ,Text
"\n"
                                     ]
                          ,a
n'
                          )

toPrometheusMetrics :: ByteString -> IO L.ByteString
toPrometheusMetrics :: ByteString -> IO ByteString
toPrometheusMetrics 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
$ 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 a. a -> IO a
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 ByteString
"" (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 = ByteString
"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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ByteString
textPlain, Int
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

-- | Multiplies a floating point value by a factor.
--
-- Returns an integer value as the result of rounding the scaled floating point
-- value.
scale
    :: Int          -- ^ Factor
    -> Double       -- ^ Floating point value
    -> Int
scale :: Int -> Double -> Int
scale Int
n = Double -> Int
forall b. Integral b => Double -> b
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
*)

-- | Multiplies a floating point value by /1000/.
--
-- The floating point value gets read from a 'ByteString'. Throws an exception
-- on conversion failure which results in returning an empty string.
scale1000
    :: ByteString   -- ^ Floating point value
    -> L.ByteString
scale1000 :: ByteString -> ByteString
scale1000 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
$ forall a. Read a => ByteString -> Maybe a
readFromByteString @Double ByteString
v
              in [Char] -> ByteString
C8L.pack ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Double -> Int
scale Int
1000 Double
v'

ngxExportYY 'scale1000

-- $convertingListsOfValuesToCounters
--
-- This module has limited support for extracting data from lists of values.
-- Normally, variables from Nginx upstream module such as /upstream_status/,
-- /upstream_response_time/ and others contain lists of values separated by
-- commas and semicolons. With handler __/statusLayout/__, numbers of /2xx/,
-- /3xx/, /4xx/ and /5xx/ responses from backends can be collected in a
-- comma-separated list. Handlers __/cumulativeValue/__ and
-- __/cumulativeFPValue/__ can be used to count cumulative integer and floating
-- point numbers from lists of values.
--
-- Let's add checking upstream statuses and cumulative response times from all
-- servers in an upstream into the original file /nginx.conf/ from the previous
-- example.
--
-- ==== File /nginx.conf/: checking upstream statuses and response times
-- @
--     upstream backends {
--         server 127.0.0.1:8030 max_fails=0;
--         server 127.0.0.1:8040 max_fails=0;
--     }
-- @
-- @
--     server {
--         listen       8030;
--         server_name  backend1;
--
--         location \/ {
--             echo_sleep 0.5;
--             echo_status 404;
--             echo \"Backend1 Ok\";
--         }
--     }
--
--     server {
--         listen       8040;
--         server_name  backend2;
--
--         location \/ {
--             echo_status 504;
--             echo \"Backend2 Ok\";
--         }
--     }
-- @
--
-- Here we added upstream /backends/ with two virtual servers that will play
-- the role of backends. One of them will wait for half a second and return
-- HTTP status /404/, while the other will return HTTP status /504/ immediately.
-- Both servers are tagged with /max_fails=0/ to prevent blacklisting them.
--
-- We also have to add counters and mappings.
--
-- @
--     map $hs_upstream_status $inc_cnt_u_4xx {
--         default                               0;
--         \'~^(?:(?:\\d+),){2}(?P\<m_status\>\\d+)\'  $m_status;
--     }
--
--     map $hs_upstream_status $inc_cnt_u_5xx {
--         default                               0;
--         \'~^(?:(?:\\d+),){3}(?P\<m_status\>\\d+)\'  $m_status;
--     }
--
--     map_to_range_index $hs_u_response_time $u_response_time_bucket
--         0.005
--         0.01
--         0.05
--         0.1
--         0.5
--         1.0
--         5.0
--         10.0
--         30.0
--         60.0;
-- @
-- @
--         haskell_run __/statusLayout/__ $hs_upstream_status $upstream_status;
--         counter $__/cnt_u_4xx/__ inc $inc_cnt_u_4xx;
--         counter $__/cnt_u_5xx/__ inc $inc_cnt_u_5xx;
--
--         \# cache $upstream_response_time
--         haskell_run ! $hs_u_response_times $upstream_response_time;
--
--         histogram $__/hst_u_response_time/__ 11 $u_response_time_bucket;
--         histogram $__/hst_u_response_time/__ undo;
--         haskell_run __/cumulativeFPValue/__ $hs_u_response_time $hs_u_response_times;
--         haskell_run __/scale1000/__ $hs_u_response_time_scaled $hs_u_response_time;
-- @
--
-- Notice that histogram /hst_u_response_time/ was disabled on this level to
-- not count visiting unrelated locations (i.e. /\//, /\/1/, and /\/404/): the
-- histogram will be re-enabled later in locations related to proxying requests.
-- The sum counter will also be declared inside the proxying locations and take
-- the value of /hs_u_response_time_scaled/ as the input value.
--
-- So many new variables require a bigger hash table to store them.
--
-- @
--     variables_hash_max_size 4096;
-- @
--
-- And finally, we have to update counters declarations in
-- /simpleService_prometheusConf/ and add location /\/backends/ in the main
-- server.
--
-- @
--     haskell_run_service __/simpleService_prometheusConf/__ $hs_prometheus_conf
--             \'__/PrometheusConf/__
--                 { __/pcMetrics/__ = fromList
--                     [(\"cnt_4xx\", \"Number of responses with 4xx status\")
--                     ,(\"cnt_5xx\", \"Number of responses with 5xx status\")
--                     ,(\"__/cnt_u_4xx/__\"
--                      ,\"Number of responses from upstreams with 4xx status\")
--                     ,(\"__/cnt_u_5xx/__\"
--                      ,\"Number of responses from upstreams with 5xx status\")
--                     ,(\"cnt_stub_status_active\", \"Active requests\")
--                     ,(\"cnt_uptime\", \"Nginx master uptime\")
--                     ,(\"cnt_uptime_reload\", \"Nginx master uptime after reload\")
--                     ,(\"hst_request_time\", \"Request duration\")
--                     ,(\"__/hst_u_response_time/__\"
--                      ,\"Response time from all servers in a single upstream\")
--                     ]
--                 , __/pcGauges/__ = fromList
--                     [\"cnt_stub_status_active\"]
--                 , __/pcScale1000/__ = fromList
--                     [\"hst_request_time_sum\"
--                     ,\"__/hst_u_response_time_sum/__\"
--                     ]
--                 }\';
-- @
-- @
--         location \/backends {
--             histogram $__/hst_u_response_time/__ reuse;
--             counter $__/hst_u_response_time_sum/__ inc $hs_u_response_time_scaled;
--             error_page 404 \@status404;
--             proxy_intercept_errors on;
--             proxy_pass http:\/\/backends;
--         }
--
--         location \@status404 {
--             histogram $__/hst_u_response_time/__ reuse;
--             counter $__/hst_u_response_time_sum/__ inc $hs_u_response_time_scaled;
--             echo_sleep 0.2;
--             echo \"Caught 404\";
--         }
-- @
--
-- We are going to additionally increase response time by /0.2/ seconds when a
-- backend server responds with HTTP status /404/, and this is why location
-- /\@status404/ was added.
--
-- ==== A simple test
--
-- After restart of Nginx.
--
-- > $ for i in {1..20} ; do curl -D- 'http://localhost:8010/backends' & done
-- >   ...
--
-- > $ curl -s 'http://127.0.0.1:8020/'
-- > # HELP cnt_4xx Number of responses with 4xx status
-- > # TYPE cnt_4xx counter
-- > cnt_4xx 11.0
-- > # HELP cnt_5xx Number of responses with 5xx status
-- > # TYPE cnt_5xx counter
-- > cnt_5xx 9.0
-- > # HELP cnt_stub_status_active Active requests
-- > # TYPE cnt_stub_status_active gauge
-- > cnt_stub_status_active 1.0
-- > # HELP cnt_u_4xx Number of responses from upstreams with 4xx status
-- > # TYPE cnt_u_4xx counter
-- > cnt_u_4xx 11.0
-- > # HELP cnt_u_5xx Number of responses from upstreams with 5xx status
-- > # TYPE cnt_u_5xx counter
-- > cnt_u_5xx 9.0
-- > # HELP cnt_uptime Nginx master uptime
-- > # TYPE cnt_uptime counter
-- > cnt_uptime 63.0
-- > # HELP cnt_uptime_reload Nginx master uptime after reload
-- > # TYPE cnt_uptime_reload counter
-- > cnt_uptime_reload 63.0
-- > # HELP hst_bytes_sent
-- > # TYPE hst_bytes_sent histogram
-- > hst_bytes_sent_bucket{le="0"} 0
-- > hst_bytes_sent_bucket{le="10"} 0
-- > hst_bytes_sent_bucket{le="100"} 0
-- > hst_bytes_sent_bucket{le="1000"} 20
-- > hst_bytes_sent_bucket{le="10000"} 20
-- > hst_bytes_sent_bucket{le="+Inf"} 20
-- > hst_bytes_sent_count 20
-- > hst_bytes_sent_sum 4032.0
-- > # HELP hst_bytes_sent_err
-- > # TYPE hst_bytes_sent_err counter
-- > hst_bytes_sent_err 0.0
-- > # HELP hst_request_time Request duration
-- > # TYPE hst_request_time histogram
-- > hst_request_time_bucket{le="0.005"} 9
-- > hst_request_time_bucket{le="0.01"} 9
-- > hst_request_time_bucket{le="0.05"} 9
-- > hst_request_time_bucket{le="0.1"} 9
-- > hst_request_time_bucket{le="0.5"} 9
-- > hst_request_time_bucket{le="1.0"} 20
-- > hst_request_time_bucket{le="5.0"} 20
-- > hst_request_time_bucket{le="10.0"} 20
-- > hst_request_time_bucket{le="30.0"} 20
-- > hst_request_time_bucket{le="60.0"} 20
-- > hst_request_time_bucket{le="+Inf"} 20
-- > hst_request_time_count 20
-- > hst_request_time_sum 7.721
-- > # HELP hst_request_time_err
-- > # TYPE hst_request_time_err counter
-- > hst_request_time_err 0.0
-- > # HELP hst_u_response_time Response time from all servers in a single upstream
-- > # TYPE hst_u_response_time histogram
-- > hst_u_response_time_bucket{le="0.005"} 9
-- > hst_u_response_time_bucket{le="0.01"} 9
-- > hst_u_response_time_bucket{le="0.05"} 9
-- > hst_u_response_time_bucket{le="0.1"} 9
-- > hst_u_response_time_bucket{le="0.5"} 13
-- > hst_u_response_time_bucket{le="1.0"} 20
-- > hst_u_response_time_bucket{le="5.0"} 20
-- > hst_u_response_time_bucket{le="10.0"} 20
-- > hst_u_response_time_bucket{le="30.0"} 20
-- > hst_u_response_time_bucket{le="60.0"} 20
-- > hst_u_response_time_bucket{le="+Inf"} 20
-- > hst_u_response_time_count 20
-- > hst_u_response_time_sum 5.519
-- > # HELP hst_u_response_time_err
-- > # TYPE hst_u_response_time_err counter
-- > hst_u_response_time_err 0.0
--
-- Counters look good. Numbers of visiting backend servers are almost equal (11
-- and 9), the sum of cumulative response times from backends is approximately 5
-- seconds, while the sum of all requests durations is approximately 7 seconds
-- which corresponds to 11 visits to location /\@status404/ and the sleep time
-- /0.2/ seconds that was added there.

extractValues :: ByteString -> [ByteString]
extractValues :: ByteString -> [ByteString]
extractValues = (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 a b.
(ByteString -> a -> b) -> (ByteString -> a) -> ByteString -> b
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 a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.'))

statusLayout :: ByteString -> L.ByteString
statusLayout :: ByteString -> ByteString
statusLayout = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char])
-> (ByteString -> [[Char]]) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [Char]
forall a. Show a => a -> [Char]
show ([Int] -> [[Char]])
-> (ByteString -> [Int]) -> ByteString -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
statuses
    where statuses :: ByteString -> [Int]
statuses 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 i. Ix i => (i, i) -> Int -> ST s (STUArray s i Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int, Int)
bs Int
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 :: * -> * -> *} {a}.
MArray a a f =>
a Int a -> Int -> a -> 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 Char
'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. HasCallStack => [a] -> a
head ([ByteString] -> Int)
-> ([ByteString] -> Int) -> [ByteString] -> (Int, Int)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [ByteString] -> Int
forall a. [a] -> 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 a -> Int -> a -> f ()
writeStatus a Int a
a 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 ()) -> (a -> f ()) -> a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a Int a -> Int -> a -> f ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray a Int a
a Int
i
          bs :: (Int, Int)
bs@(Int
lb, Int
ub) = (Int
2, Int
5)

ngxExportYY 'statusLayout

cumulativeValue' :: (Num a, Read a) => ByteString -> a
cumulativeValue' :: forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' = (ByteString -> a -> a) -> a -> [ByteString] -> a
forall a b. (a -> b -> b) -> b -> [a] -> b
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
. ([Char] -> a
forall a. Read a => [Char] -> a
read ([Char] -> a) -> (ByteString -> [Char]) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C8.unpack)) a
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 = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> (ByteString -> Int) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Int

ngxExportYY 'cumulativeValue

cumulativeFPValue :: ByteString -> L.ByteString
cumulativeFPValue :: ByteString -> ByteString
cumulativeFPValue = [Char] -> ByteString
C8L.pack ([Char] -> ByteString)
-> (ByteString -> [Char]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char])
-> (ByteString -> Double) -> ByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Num a, Read a) => ByteString -> a
cumulativeValue' @Double

ngxExportYY 'cumulativeFPValue

-- $parameterization
--
-- In the previous examples we used many counters which served similar purposes.
-- For example, counters /cnt_4xx/, /cnt_5xx/, /cnt_u_4xx/, and /cnt_u_5xx/
-- counted response statuses in different conditions: particularly, the 2 former
-- counters counted /4xx/ and /5xx/ response statuses sent to clients, while the
-- latter 2 counters counted /4xx/ and /5xx/ response statuses received from the
-- upstream. It feels that they could be shown as a single compound counter
-- parameterized by the range of values and the origin. We also had two
-- histograms /hst_request_time/ and /hst_u_response_time/ which could also be
-- combined in a single entity parameterized by the scope (the time of the whole
-- request against the time spent in the upstream).
--
-- Fortunately, Prometheus provides a mechanism to make such custom
-- parameterizations by using /labels/ in metrics. This module supports the
-- parameterization with labels by expecting special /annotations/ attached to
-- the names of the counters.
--
-- Let's parameterize the status counters and the request times as it was
-- proposed at the beginning of this section.
--
-- ==== File /nginx.conf/: changes related to counters annotations
-- @
--     haskell_run_service simpleService_prometheusConf $hs_prometheus_conf
--             \'PrometheusConf
--                 { pcMetrics = fromList
--                     [(\"__/cnt_status/__\", \"Number of responses with given status\")
--                     ,(\"cnt_stub_status_active\", \"Active requests\")
--                     ,(\"cnt_uptime\", \"Nginx master uptime\")
--                     ,(\"cnt_uptime_reload\", \"Nginx master uptime after reload\")
--                     ,(\"__/hst_request_time/__\", \"Request duration\")
--                     ]
--                 , pcGauges = fromList
--                     [\"cnt_stub_status_active\"]
--                 , pcScale1000 = fromList
--                     [\"__/hst_request_time@\scope=(total)_sum/__\"
--                     ,\"__/hst_request_time\@scope=(in_upstreams)_sum/__\"
--                     ]
--                 }\';
--
-- @
-- @
--         counter $__/cnt_status\@value=(4xx),from=(response)/__ inc $inc_cnt_4xx;
--         counter $__/cnt_status\@value=(5xx),from=(response)/__ inc $inc_cnt_5xx;
--
--         haskell_run statusLayout $hs_upstream_status $upstream_status;
--         counter $__/cnt_status\@value=(4xx),from=(upstream)/__ inc $inc_cnt_u_4xx;
--         counter $__/cnt_status\@value=(5xx),from=(upstream)/__ inc $inc_cnt_u_5xx;
--
--         # cache $request_time and $bytes_sent
--         haskell_run ! $hs_request_time $request_time;
--         haskell_run ! $hs_bytes_sent $bytes_sent;
--
--         histogram $__/hst_request_time\@scope=(total)/__ 11 $request_time_bucket;
--         haskell_run scale1000 $hs_request_time_scaled $hs_request_time;
--         counter $hst_request_time\@scope=(total)_sum inc $hs_request_time_scaled;
--
--         histogram $hst_bytes_sent 6 $bytes_sent_bucket;
--         counter $hst_bytes_sent_sum inc $hs_bytes_sent;
--
--         # cache $upstream_response_time
--         haskell_run ! $hs_u_response_times $upstream_response_time;
--
--         histogram $__/hst_request_time\@scope=(in_upstreams)/__ 11
--                 $u_response_time_bucket;
--         histogram $__/hst_request_time\@scope=(in_upstreams)/__ undo;
--         haskell_run cumulativeFPValue $hs_u_response_time $hs_u_response_times;
--         haskell_run scale1000 $hs_u_response_time_scaled $hs_u_response_time;
--
--         location \/ {
--             echo_sleep 0.5;
--             echo Ok;
--         }
--
--         location \/1 {
--             echo_sleep 1.0;
--             echo Ok;
--         }
--
--         location \/404 {
--             return 404;
--         }
--
--         location \/backends {
--             histogram $__/hst_request_time\@scope=(in_upstreams)/__ reuse;
--             counter $__/hst_request_time\@scope=(in_upstreams)_sum/__ inc
--                     $hs_u_response_time_scaled;
--             error_page 404 \@status404;
--             proxy_intercept_errors on;
--             proxy_pass http:\/\/backends;
--         }
--
--         location \@status404 {
--             histogram $__/hst_request_time\@scope=(in_upstreams)/__ reuse;
--             counter $__/hst_request_time\@scope=(in_upstreams)_sum/__ inc
--                     $hs_u_response_time_scaled;
--             echo_sleep 0.2;
--             echo \"Caught 404\";
--         }
-- @
--
-- Notice that the 4 status counters were combined into a compound counter
-- /cnt_status/ whose name was annotated by a tail starting with /\@/. This
-- annotation gets put in the list of labels of the Prometheus metrics with
-- symbols /(/ and /)/ replaced by /\"/ without any further validation. The
-- request time histograms and the corresponding sum counters were annotated in
-- a similar way. Annotations in histogram sum counters must be put between the
-- base name of the counter and the suffix /_sum/.
--
-- ==== A simple test
--
-- > $ curl 'http://127.0.0.1:8010/404'
-- >   ...
-- > $ for i in {1..20} ; do curl -D- 'http://localhost:8010/backends' & done
-- >   ...
--
-- > $ curl -s 'http://localhost:8020/'
-- > # HELP cnt_status Number of responses with given status
-- > # TYPE cnt_status counter
-- > cnt_status{value="4xx",from="response"} 11.0
-- > cnt_status{value="4xx",from="upstream"} 10.0
-- > cnt_status{value="5xx",from="response"} 10.0
-- > cnt_status{value="5xx",from="upstream"} 10.0
-- > # HELP cnt_stub_status_active Active requests
-- > # TYPE cnt_stub_status_active gauge
-- > cnt_stub_status_active 1.0
-- > # HELP cnt_uptime Nginx master uptime
-- > # TYPE cnt_uptime counter
-- > cnt_uptime 70.0
-- > # HELP cnt_uptime_reload Nginx master uptime after reload
-- > # TYPE cnt_uptime_reload counter
-- > cnt_uptime_reload 70.0
-- > # HELP hst_bytes_sent 
-- > # TYPE hst_bytes_sent histogram
-- > hst_bytes_sent_bucket{le="0"} 0
-- > hst_bytes_sent_bucket{le="10"} 0
-- > hst_bytes_sent_bucket{le="100"} 0
-- > hst_bytes_sent_bucket{le="1000"} 21
-- > hst_bytes_sent_bucket{le="10000"} 21
-- > hst_bytes_sent_bucket{le="+Inf"} 21
-- > hst_bytes_sent_count 21
-- > hst_bytes_sent_sum 4348.0
-- > # HELP hst_bytes_sent_err 
-- > # TYPE hst_bytes_sent_err counter
-- > hst_bytes_sent_err 0.0
-- > # HELP hst_request_time Request duration
-- > # TYPE hst_request_time histogram
-- > hst_request_time_bucket{le="0.005",scope="in_upstreams"} 10
-- > hst_request_time_bucket{le="0.01",scope="in_upstreams"} 10
-- > hst_request_time_bucket{le="0.05",scope="in_upstreams"} 10
-- > hst_request_time_bucket{le="0.1",scope="in_upstreams"} 10
-- > hst_request_time_bucket{le="0.5",scope="in_upstreams"} 14
-- > hst_request_time_bucket{le="1.0",scope="in_upstreams"} 20
-- > hst_request_time_bucket{le="5.0",scope="in_upstreams"} 20
-- > hst_request_time_bucket{le="10.0",scope="in_upstreams"} 20
-- > hst_request_time_bucket{le="30.0",scope="in_upstreams"} 20
-- > hst_request_time_bucket{le="60.0",scope="in_upstreams"} 20
-- > hst_request_time_bucket{le="+Inf",scope="in_upstreams"} 20
-- > hst_request_time_count{scope="in_upstreams"} 20
-- > hst_request_time_sum{scope="in_upstreams"} 5.012
-- > hst_request_time_bucket{le="0.005",scope="total"} 11
-- > hst_request_time_bucket{le="0.01",scope="total"} 11
-- > hst_request_time_bucket{le="0.05",scope="total"} 11
-- > hst_request_time_bucket{le="0.1",scope="total"} 11
-- > hst_request_time_bucket{le="0.5",scope="total"} 11
-- > hst_request_time_bucket{le="1.0",scope="total"} 21
-- > hst_request_time_bucket{le="5.0",scope="total"} 21
-- > hst_request_time_bucket{le="10.0",scope="total"} 21
-- > hst_request_time_bucket{le="30.0",scope="total"} 21
-- > hst_request_time_bucket{le="60.0",scope="total"} 21
-- > hst_request_time_bucket{le="+Inf",scope="total"} 21
-- > hst_request_time_count{scope="total"} 21
-- > hst_request_time_sum{scope="total"} 7.02
-- > # HELP hst_request_time_err 
-- > # TYPE hst_request_time_err counter
-- > hst_request_time_err{scope="in_upstreams"} 0.0
-- > hst_request_time_err{scope="total"} 0.0