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

-----------------------------------------------------------------------------
-- |
-- Module      :  NgxExport.Tools.Prometheus
-- Copyright   :  (c) Alexey Radkov 2020
-- License     :  BSD-style
--
-- Maintainer  :  alexey.radkov@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (requires Template Haskell)
--
-- Prometheus metrics from the more extra tools collection for
-- <http://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

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 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 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 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
/= :: MetricsRole -> MetricsRole -> Bool
$c/= :: MetricsRole -> MetricsRole -> Bool
== :: MetricsRole -> MetricsRole -> Bool
$c== :: 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", __/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/__ = [\"cnt_stub_status_active\"]
--                 , __/pcScale1000/__ = [\"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 {
--             echo $cnt_collection;
--         }
--
--         location \/histograms {
--             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
$ \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 (Map MetricsName (MetricsName, MetricsRole, Double))
cntsH, cntsC :: Map MetricsName Double
cntsC, cntsG :: Map MetricsName Double
cntsG) =
            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 let (cntsG' :: Map MetricsName Double
cntsG', cntsC' :: Map MetricsName Double
cntsC') = (MetricsName -> Double -> Bool)
-> Map MetricsName Double
-> (Map MetricsName Double, Map MetricsName Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsName -> Double -> Bool
forall b. MetricsName -> b -> Bool
gCounter Map MetricsName Double
cnts'
                     in (Map
  MetricsName (Map MetricsName (MetricsName, MetricsRole, Double))
forall k a. Map k a
M.empty, Map MetricsName Double
cntsC', Map MetricsName Double
cntsG')
                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', (cntsG' :: Map MetricsName Double
cntsG', cntsC' :: Map MetricsName Double
cntsC')) =
                             (Map MetricsName Double
 -> (Map MetricsName Double, Map MetricsName Double))
-> (Map MetricsName Double, Map MetricsName Double)
-> (Map MetricsName Double,
    (Map MetricsName Double, Map MetricsName Double))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((MetricsName -> Double -> Bool)
-> Map MetricsName Double
-> (Map MetricsName Double, Map MetricsName Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsName -> Double -> Bool
forall b. MetricsName -> b -> Bool
gCounter) ((Map MetricsName Double, Map MetricsName Double)
 -> (Map MetricsName Double,
     (Map MetricsName Double, Map MetricsName Double)))
-> (Map MetricsName Double, Map MetricsName Double)
-> (Map MetricsName Double,
    (Map MetricsName Double, Map MetricsName Double))
forall a b. (a -> b) -> a -> b
$
                             (MetricsName -> Double -> Bool)
-> Map MetricsName Double
-> (Map MetricsName Double, Map MetricsName Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (([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'
                         cntsH'' :: Map
  MetricsName (Map MetricsName (MetricsName, MetricsRole, Double))
cntsH'' = (MetricsName
 -> HistogramLayout
 -> Map MetricsName (MetricsName, MetricsRole, Double))
-> Map MetricsName HistogramLayout
-> Map
     MetricsName (Map MetricsName (MetricsName, MetricsRole, 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, MetricsRole, Double)
forall t t.
(IsString t, Fractional t) =>
Map MetricsName t
-> MetricsName
-> Map MetricsName t
-> Map MetricsName (t, MetricsRole, t)
toHistogram Map MetricsName Double
cntsH' MetricsName
k (Map MetricsName MetricsName
 -> Map MetricsName (MetricsName, MetricsRole, Double))
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName (MetricsName, MetricsRole, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsName MetricsName
range) Map MetricsName HistogramLayout
hs''
                     in (Map
  MetricsName (Map MetricsName (MetricsName, MetricsRole, Double))
cntsH'', Map MetricsName Double
cntsC', Map MetricsName Double
cntsG')
        (cntsOC :: Map MetricsName Double
cntsOC, cntsOG :: Map MetricsName Double
cntsOG) = (MetricsName -> Double -> Bool)
-> Map MetricsName Double
-> (Map MetricsName Double, Map MetricsName Double)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey MetricsName -> Double -> Bool
forall b. MetricsName -> b -> Bool
gCounter (Map MetricsName Double
 -> (Map MetricsName Double, Map MetricsName Double))
-> Map MetricsName Double
-> (Map MetricsName Double, Map MetricsName Double)
forall a b. (a -> b) -> a -> b
$ AllOtherCounters -> Map MetricsName Double
toValues AllOtherCounters
ocnts
        -- the _err counters from the Nginx custom counters module will be
        -- automatically deleted in such ordering of unions, but only if there
        -- are custom labels (i.e. annotations) for the given histogram
        cntsA :: Map MetricsName [MetricsType]
cntsA = (Map MetricsName (MetricsName, MetricsRole, Double)
 -> MetricsName -> MetricsType)
-> Map
     MetricsName (Map MetricsName (MetricsName, MetricsRole, Double))
-> Map MetricsName [MetricsType]
forall a b.
(a -> MetricsName -> b) -> Map MetricsName a -> Map MetricsName [b]
collect Map MetricsName (MetricsName, MetricsRole, Double)
-> MetricsName -> MetricsType
Histogram Map
  MetricsName (Map MetricsName (MetricsName, MetricsRole, Double))
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` (Double -> MetricsName -> MetricsType)
-> Map MetricsName Double -> Map MetricsName [MetricsType]
forall a b.
(a -> MetricsName -> b) -> Map MetricsName a -> Map MetricsName [b]
collect Double -> MetricsName -> MetricsType
Counter (Map MetricsName Double
cntsC Map MetricsName Double
-> Map MetricsName Double -> Map MetricsName Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName Double
cntsOC)
                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` (Double -> MetricsName -> MetricsType)
-> Map MetricsName Double -> Map MetricsName [MetricsType]
forall a b.
(a -> MetricsName -> b) -> Map MetricsName a -> Map MetricsName [b]
collect Double -> MetricsName -> MetricsType
Gauge (Map MetricsName Double
cntsG Map MetricsName Double
-> Map MetricsName Double -> Map MetricsName Double
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName Double
cntsOG)
    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
                      )
          gCounter :: MetricsName -> b -> Bool
gCounter = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool)
-> (MetricsName -> Bool) -> MetricsName -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName -> [MetricsName] -> Bool)
-> [MetricsName] -> MetricsName -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip MetricsName -> [MetricsName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [MetricsName]
pcGauges
          toHistogram :: Map MetricsName t
-> MetricsName
-> Map MetricsName t
-> Map MetricsName (t, MetricsRole, t)
toHistogram cs :: Map MetricsName t
cs hk :: MetricsName
hk rs :: Map MetricsName t
rs =
              let ranges :: Map MetricsName (t, MetricsRole, t)
ranges = (MetricsName -> t -> (t, MetricsRole, t))
-> Map MetricsName t -> Map MetricsName (t, MetricsRole, t)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
                      (\k :: MetricsName
k ->
                          (, MetricsRole
HistogramBucket, 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, MetricsRole, 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 -> t -> m (t, t, t)
withZeroLabel r :: t
r = (t, t, t) -> m (t, t, t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((t, t, t) -> m (t, t, t)) -> (t -> (t, t, t)) -> t -> m (t, t, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("", t
r,)
                         in [(MetricsName, (t, MetricsRole, t))]
-> Map MetricsName (t, MetricsRole, t)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsName, (t, MetricsRole, t))]
 -> Map MetricsName (t, MetricsRole, t))
-> [(MetricsName, (t, MetricsRole, t))]
-> Map MetricsName (t, MetricsRole, t)
forall a b. (a -> b) -> a -> b
$
                             ((MetricsName, Maybe (t, MetricsRole, t))
 -> (MetricsName, (t, MetricsRole, t)))
-> [(MetricsName, Maybe (t, MetricsRole, t))]
-> [(MetricsName, (t, MetricsRole, t))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (t, MetricsRole, t) -> (t, MetricsRole, t))
-> (MetricsName, Maybe (t, MetricsRole, t))
-> (MetricsName, (t, MetricsRole, t))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (t, MetricsRole, t) -> (t, MetricsRole, t)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsName, Maybe (t, MetricsRole, t))]
 -> [(MetricsName, (t, MetricsRole, t))])
-> [(MetricsName, Maybe (t, MetricsRole, t))]
-> [(MetricsName, (t, MetricsRole, t))]
forall a b. (a -> b) -> a -> b
$ ((MetricsName, Maybe (t, MetricsRole, t)) -> Bool)
-> [(MetricsName, Maybe (t, MetricsRole, t))]
-> [(MetricsName, Maybe (t, MetricsRole, t))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (t, MetricsRole, t) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (t, MetricsRole, t) -> Bool)
-> ((MetricsName, Maybe (t, MetricsRole, t))
    -> Maybe (t, MetricsRole, t))
-> (MetricsName, Maybe (t, MetricsRole, t))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName, Maybe (t, MetricsRole, t))
-> Maybe (t, MetricsRole, 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, MetricsRole, t)) -> Maybe (t, MetricsRole, t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                     MetricsRole -> t -> Maybe (t, MetricsRole, t)
forall (m :: * -> *) t t t.
(Monad m, IsString t) =>
t -> t -> m (t, t, t)
withZeroLabel MetricsRole
HistogramSum
                                  )
                                 ,(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, MetricsRole, t)) -> Maybe (t, MetricsRole, t)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                     MetricsRole -> t -> Maybe (t, MetricsRole, t)
forall (m :: * -> *) t t t.
(Monad m, IsString t) =>
t -> t -> m (t, t, t)
withZeroLabel MetricsRole
HistogramCount
                                  )
                                 ]
              in Map MetricsName (t, MetricsRole, t)
ranges Map MetricsName (t, MetricsRole, t)
-> Map MetricsName (t, MetricsRole, t)
-> Map MetricsName (t, MetricsRole, t)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName (t, MetricsRole, t)
sums
          collect :: (a -> MetricsName -> b) -> Map MetricsName a -> Map MetricsName [b]
collect cType :: a -> MetricsName -> b
cType =
              [(MetricsName, [b])] -> Map MetricsName [b]
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
              ([(MetricsName, [b])] -> Map MetricsName [b])
-> (Map MetricsName a -> [(MetricsName, [b])])
-> Map MetricsName a
-> Map MetricsName [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(MetricsName, (a, MetricsName))] -> (MetricsName, [b]))
-> [[(MetricsName, (a, MetricsName))]] -> [(MetricsName, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (((MetricsName, (a, MetricsName)) -> MetricsName
forall a b. (a, b) -> a
fst ((MetricsName, (a, MetricsName)) -> MetricsName)
-> ([(MetricsName, (a, MetricsName))]
    -> (MetricsName, (a, MetricsName)))
-> [(MetricsName, (a, MetricsName))]
-> MetricsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MetricsName, (a, MetricsName))]
-> (MetricsName, (a, MetricsName))
forall a. [a] -> a
head) ([(MetricsName, (a, MetricsName))] -> MetricsName)
-> ([(MetricsName, (a, MetricsName))] -> [b])
-> [(MetricsName, (a, MetricsName))]
-> (MetricsName, [b])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((MetricsName, (a, MetricsName)) -> b)
-> [(MetricsName, (a, MetricsName))] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> MetricsName -> b) -> (a, MetricsName) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> MetricsName -> b
cType ((a, MetricsName) -> b)
-> ((MetricsName, (a, MetricsName)) -> (a, MetricsName))
-> (MetricsName, (a, MetricsName))
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName, (a, MetricsName)) -> (a, MetricsName)
forall a b. (a, b) -> b
snd))
              ([[(MetricsName, (a, MetricsName))]] -> [(MetricsName, [b])])
-> (Map MetricsName a -> [[(MetricsName, (a, MetricsName))]])
-> Map MetricsName a
-> [(MetricsName, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsName, (a, MetricsName))
 -> (MetricsName, (a, MetricsName)) -> Bool)
-> [(MetricsName, (a, MetricsName))]
-> [[(MetricsName, (a, MetricsName))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (MetricsName -> MetricsName -> Bool)
-> ((MetricsName, (a, MetricsName)) -> MetricsName)
-> (MetricsName, (a, MetricsName))
-> (MetricsName, (a, MetricsName))
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (MetricsName, (a, MetricsName)) -> MetricsName
forall a b. (a, b) -> a
fst)
              ([(MetricsName, (a, MetricsName))]
 -> [[(MetricsName, (a, MetricsName))]])
-> (Map MetricsName a -> [(MetricsName, (a, MetricsName))])
-> Map MetricsName a
-> [[(MetricsName, (a, MetricsName))]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MetricsName, a) -> (MetricsName, (a, MetricsName)))
-> [(MetricsName, a)] -> [(MetricsName, (a, MetricsName))]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: MetricsName
k, v :: a
v) ->
                        let (k' :: MetricsName
k', a :: MetricsName
a) =
                                (MetricsName -> MetricsName)
-> (MetricsName, MetricsName) -> (MetricsName, MetricsName)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (\a' :: MetricsName
a' ->
                                            if MetricsName -> Bool
T.null MetricsName
a'
                                                then ""
                                                else (Char -> Char) -> MetricsName -> MetricsName
T.map
                                                     (\c :: Char
c ->
                                                         if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ')'
                                                             then '"'
                                                             else Char
c
                                                     ) (MetricsName -> MetricsName) -> MetricsName -> MetricsName
forall a b. (a -> b) -> a -> b
$ MetricsName -> MetricsName
T.tail MetricsName
a'
                                       ) ((MetricsName, MetricsName) -> (MetricsName, MetricsName))
-> (MetricsName, MetricsName) -> (MetricsName, MetricsName)
forall a b. (a -> b) -> a -> b
$ MetricsName -> MetricsName -> (MetricsName, MetricsName)
T.breakOn "@" MetricsName
k
                        in (MetricsName
k', (a
v, MetricsName
a))
                    )
              ([(MetricsName, a)] -> [(MetricsName, (a, MetricsName))])
-> (Map MetricsName a -> [(MetricsName, a)])
-> Map MetricsName a
-> [(MetricsName, (a, MetricsName))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map MetricsName a -> [(MetricsName, a)]
forall k a. Map k a -> [(k, a)]
M.toList

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

-- | 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 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
*)

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

-- $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/__ = [\"cnt_stub_status_active\"]
--                 , __/pcScale1000/__ = [\"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 (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

-- $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 = [\"cnt_stub_status_active\"]
--                 , pcScale1000 = [\"__/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 counter
-- > cnt_stub_status_active 1.0
-- > # HELP cnt_uptime Nginx master uptime
-- > # TYPE cnt_uptime gauge
-- > cnt_uptime 70.0
-- > # HELP cnt_uptime_reload Nginx master uptime after reload
-- > # TYPE cnt_uptime_reload gauge
-- > 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
--
-- Notice that the histogram error counters from /nginx-custom-counters-module/
-- are not shown in annotated histograms.