{-# 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
                                  ) 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.Encoding as T
import           Data.Aeson
import           Data.Maybe
import           Data.Function
import           Data.List
import           Data.Char
import           Data.Word
import           Data.Array.ST hiding (range)
import           Control.Arrow
import           Control.Monad
import           Control.Monad.ST
import           System.IO.Unsafe
import           GHC.Generics
import           Safe

type ServerName = Text
type MetricsName = Text
type MetricsHelp = Text
type MetricsLabel = Text
type CounterValue = Word64
type MetricsData = Map MetricsName CounterValue
type HistogramData = Map MetricsName (MetricsLabel, Double)
type MetricsToLabelMap = Map MetricsName MetricsLabel

data PrometheusConf =
    PrometheusConf { PrometheusConf -> Map MetricsName MetricsName
pcMetrics :: Map MetricsName MetricsHelp
                   , PrometheusConf -> [MetricsName]
pcGauges :: [MetricsName]
                   , PrometheusConf -> [MetricsName]
pcScale1000 :: [MetricsName]
                   } deriving ReadPrec [PrometheusConf]
ReadPrec PrometheusConf
Int -> ReadS PrometheusConf
ReadS [PrometheusConf]
(Int -> ReadS PrometheusConf)
-> ReadS [PrometheusConf]
-> ReadPrec PrometheusConf
-> ReadPrec [PrometheusConf]
-> Read PrometheusConf
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PrometheusConf]
$creadListPrec :: ReadPrec [PrometheusConf]
readPrec :: ReadPrec PrometheusConf
$creadPrec :: ReadPrec PrometheusConf
readList :: ReadS [PrometheusConf]
$creadList :: ReadS [PrometheusConf]
readsPrec :: Int -> ReadS PrometheusConf
$creadsPrec :: Int -> ReadS PrometheusConf
Read

data HistogramLayout =
    HistogramLayout { HistogramLayout -> Map MetricsName MetricsName
range :: MetricsToLabelMap
                    , HistogramLayout -> (MetricsName, MetricsName)
cnt :: (MetricsName, MetricsLabel)
                    , HistogramLayout -> (MetricsName, MetricsName)
err :: (MetricsName, MetricsLabel)
                    } deriving (forall x. HistogramLayout -> Rep HistogramLayout x)
-> (forall x. Rep HistogramLayout x -> HistogramLayout)
-> Generic HistogramLayout
forall x. Rep HistogramLayout x -> HistogramLayout
forall x. HistogramLayout -> Rep HistogramLayout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistogramLayout x -> HistogramLayout
$cfrom :: forall x. HistogramLayout -> Rep HistogramLayout x
Generic

instance FromJSON HistogramLayout

type AllCounters = Map ServerName MetricsData
type AllHistogramsLayout = Map ServerName (Map MetricsName HistogramLayout)
type AllOtherCounters = MetricsData

type AllMetrtics =
    (ServerName, AllCounters, AllHistogramsLayout, AllOtherCounters)

data MetricsType = Counter Double
                 | Gauge Double
                 | Histogram HistogramData

type PrometheusMetrics = Map MetricsName (MetricsHelp, MetricsType)

conf :: IORef (Maybe PrometheusConf)
conf :: IORef (Maybe PrometheusConf)
conf = IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf)
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe PrometheusConf)) -> IORef (Maybe PrometheusConf))
-> IO (IORef (Maybe PrometheusConf))
-> IORef (Maybe PrometheusConf)
forall a b. (a -> b) -> a -> b
$ Maybe PrometheusConf -> IO (IORef (Maybe PrometheusConf))
forall a. a -> IO (IORef a)
newIORef Maybe PrometheusConf
forall a. Maybe a
Nothing
{-# NOINLINE conf #-}

-- $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 three exporters:
-- __/prometheusConf/__ which is an 'ignitionService' in terms of module
-- "NgxExport.Tools", __/toPrometheusMetrics/__ to convert /custom counters/ to
-- Prometheus metrics, and __/scale1000/__: a small utility to convert small
-- floating point numbers to integers by multiplying them by /1000/ (this fits
-- well for dealing with request durations, for instance).
--
-- 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;
--             }
--
--             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.
--
-- ==== 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 MetricsType
cntsH, cntsC :: Map MetricsName MetricsType
cntsC) =
            if Bool
-> (Map MetricsName HistogramLayout -> Bool)
-> Maybe (Map MetricsName HistogramLayout)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True Map MetricsName HistogramLayout -> Bool
forall k a. Map k a -> Bool
M.null Maybe (Map MetricsName HistogramLayout)
hs'
                then (Map MetricsName MetricsType
forall k a. Map k a
M.empty, (MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType Map MetricsName Double
cnts')
                else let hs'' :: Map MetricsName HistogramLayout
hs'' = Maybe (Map MetricsName HistogramLayout)
-> Map MetricsName HistogramLayout
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Map MetricsName HistogramLayout)
hs'
                         rs :: ([MetricsName], Map MetricsName MetricsName)
rs = Map MetricsName HistogramLayout -> [MetricsName]
forall k a. Map k a -> [k]
M.keys (Map MetricsName HistogramLayout -> [MetricsName])
-> (Map MetricsName HistogramLayout -> Map MetricsName MetricsName)
-> Map MetricsName HistogramLayout
-> ([MetricsName], Map MetricsName MetricsName)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (HistogramLayout
 -> Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> Map MetricsName MetricsName
-> Map MetricsName HistogramLayout
-> Map MetricsName MetricsName
forall a b k. (a -> b -> b) -> b -> Map k a -> b
M.foldr HistogramLayout
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
labeledRange Map MetricsName MetricsName
forall k a. Map k a
M.empty (Map MetricsName HistogramLayout
 -> ([MetricsName], Map MetricsName MetricsName))
-> Map MetricsName HistogramLayout
-> ([MetricsName], Map MetricsName MetricsName)
forall a b. (a -> b) -> a -> b
$ Map MetricsName HistogramLayout
hs''
                         cntsH' :: Map MetricsName Double
cntsH' = (MetricsName -> Double -> Bool)
-> Map MetricsName Double -> Map MetricsName Double
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (([MetricsName], Map MetricsName MetricsName)
-> MetricsName -> Double -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(t MetricsName, Map MetricsName a) -> MetricsName -> b -> Bool
hCounter ([MetricsName], Map MetricsName MetricsName)
rs) Map MetricsName Double
cnts'
                         cntsC' :: Map MetricsName Double
cntsC' = Map MetricsName Double
cnts' Map MetricsName Double
-> Map MetricsName Double -> Map MetricsName Double
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference` Map MetricsName Double
cntsH'
                         cntsH'' :: Map MetricsName (Map MetricsName (MetricsName, Double))
cntsH'' = (MetricsName
 -> HistogramLayout -> Map MetricsName (MetricsName, Double))
-> Map MetricsName HistogramLayout
-> Map MetricsName (Map MetricsName (MetricsName, Double))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
                             (\k :: MetricsName
k -> Map MetricsName Double
-> MetricsName
-> Map MetricsName MetricsName
-> Map MetricsName (MetricsName, Double)
forall a b.
(IsString a, Fractional b) =>
Map MetricsName b
-> MetricsName -> Map MetricsName a -> Map MetricsName (a, b)
toHistogram Map MetricsName Double
cntsH' MetricsName
k (Map MetricsName MetricsName
 -> Map MetricsName (MetricsName, Double))
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName (MetricsName, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsName MetricsName
range) Map MetricsName HistogramLayout
hs''
                     in ((Map MetricsName (MetricsName, Double) -> MetricsType)
-> Map MetricsName (Map MetricsName (MetricsName, Double))
-> Map MetricsName MetricsType
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Map MetricsName (MetricsName, Double) -> MetricsType
Histogram Map MetricsName (Map MetricsName (MetricsName, Double))
cntsH'', (MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType Map MetricsName Double
cntsC')
        cntsA :: Map MetricsName MetricsType
cntsA = Map MetricsName MetricsType
cntsH Map MetricsName MetricsType
-> Map MetricsName MetricsType -> Map MetricsName MetricsType
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName MetricsType
cntsC Map MetricsName MetricsType
-> Map MetricsName MetricsType -> Map MetricsName MetricsType
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union`
            (MetricsName -> Double -> MetricsType)
-> Map MetricsName Double -> Map MetricsName MetricsType
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey MetricsName -> Double -> MetricsType
cType (AllOtherCounters -> Map MetricsName Double
toValues AllOtherCounters
ocnts)
    in (MetricsName -> MetricsType -> (MetricsName, MetricsType))
-> Map MetricsName MetricsType -> PrometheusMetrics
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (\k :: MetricsName
k v :: MetricsType
v -> case MetricsName -> Map MetricsName MetricsName -> Maybe MetricsName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
k Map MetricsName MetricsName
pcMetrics of
                                 Nothing -> ("", MetricsType
v)
                                 Just h :: MetricsName
h -> (MetricsName
h, MetricsType
v)
                    ) Map MetricsName MetricsType
cntsA
    where labeledRange :: HistogramLayout
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
labeledRange = Map MetricsName MetricsName
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Map MetricsName MetricsName
 -> Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName MetricsName
-> Map MetricsName MetricsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName -> Bool)
-> Map MetricsName MetricsName -> Map MetricsName MetricsName
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool) -> (MetricsName -> Bool) -> MetricsName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsName -> Bool
T.null) (Map MetricsName MetricsName -> Map MetricsName MetricsName)
-> (HistogramLayout -> Map MetricsName MetricsName)
-> HistogramLayout
-> Map MetricsName MetricsName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistogramLayout -> Map MetricsName MetricsName
range
          hCounter :: (t MetricsName, Map MetricsName a) -> MetricsName -> b -> Bool
hCounter (ks :: t MetricsName
ks, ts :: Map MetricsName a
ts) k :: MetricsName
k = Bool -> b -> Bool
forall a b. a -> b -> a
const (Bool -> b -> Bool) -> Bool -> b -> Bool
forall a b. (a -> b) -> a -> b
$
              MetricsName
k MetricsName -> Map MetricsName a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map MetricsName a
ts Bool -> Bool -> Bool
||
                  Bool -> [Bool] -> Bool
forall a. a -> [a] -> a
headDef Bool
False
                      ((Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Bool -> Bool
not ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$
                          (MetricsName -> [Bool] -> [Bool])
-> [Bool] -> t MetricsName -> [Bool]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v :: MetricsName
v ->
                                     let v1 :: MetricsName
v1 = MetricsName
v MetricsName -> MetricsName -> MetricsName
`T.append` "_sum"
                                         v2 :: MetricsName
v2 = MetricsName
v MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt"
                                     in ((MetricsName
k MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
v1 Bool -> Bool -> Bool
|| MetricsName
k MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
v2) Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
:)
                                ) [] t MetricsName
ks
                      )
          cType :: MetricsName -> Double -> MetricsType
cType k :: MetricsName
k v :: Double
v = if MetricsName
k MetricsName -> [MetricsName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [MetricsName]
pcGauges
                          then Double -> MetricsType
Gauge Double
v
                          else Double -> MetricsType
Counter Double
v
          toHistogram :: Map MetricsName b
-> MetricsName -> Map MetricsName a -> Map MetricsName (a, b)
toHistogram cs :: Map MetricsName b
cs hk :: MetricsName
hk rs :: Map MetricsName a
rs =
              let ranges :: Map MetricsName (a, b)
ranges = (MetricsName -> a -> (a, b))
-> Map MetricsName a -> Map MetricsName (a, b)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey
                      (\k :: MetricsName
k l :: a
l -> case MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
k Map MetricsName b
cs of
                                   Just v :: b
v -> (a
l, b
v)
                                   Nothing -> (a
l, 0.0)
                      ) Map MetricsName a
rs
                  sums :: Map MetricsName (a, b)
sums = let v1 :: MetricsName
v1 = MetricsName
hk MetricsName -> MetricsName -> MetricsName
`T.append` "_sum"
                             v2 :: MetricsName
v2 = MetricsName
hk MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt"
                             withZeroLabel :: t -> Maybe (a, t)
withZeroLabel = (a, t) -> Maybe (a, t)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, t) -> Maybe (a, t)) -> (t -> (a, t)) -> t -> Maybe (a, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("",)
                         in [(MetricsName, (a, b))] -> Map MetricsName (a, b)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(MetricsName, (a, b))] -> Map MetricsName (a, b))
-> [(MetricsName, (a, b))] -> Map MetricsName (a, b)
forall a b. (a -> b) -> a -> b
$
                             ((MetricsName, Maybe (a, b)) -> (MetricsName, (a, b)))
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (a, b) -> (a, b))
-> (MetricsName, Maybe (a, b)) -> (MetricsName, (a, b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Maybe (a, b) -> (a, b)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))])
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, (a, b))]
forall a b. (a -> b) -> a -> b
$ ((MetricsName, Maybe (a, b)) -> Bool)
-> [(MetricsName, Maybe (a, b))] -> [(MetricsName, Maybe (a, b))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (a, b) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (a, b) -> Bool)
-> ((MetricsName, Maybe (a, b)) -> Maybe (a, b))
-> (MetricsName, Maybe (a, b))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName, Maybe (a, b)) -> Maybe (a, b)
forall a b. (a, b) -> b
snd)
                                 [(MetricsName
v1, MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v1 Map MetricsName b
cs Maybe b -> (b -> Maybe (a, b)) -> Maybe (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Maybe (a, b)
forall t. t -> Maybe (a, t)
withZeroLabel)
                                 ,(MetricsName
v2, MetricsName -> Map MetricsName b -> Maybe b
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MetricsName
v2 Map MetricsName b
cs Maybe b -> (b -> Maybe (a, b)) -> Maybe (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Maybe (a, b)
forall t. t -> Maybe (a, t)
withZeroLabel)
                                 ]
              in Map MetricsName (a, b)
ranges Map MetricsName (a, b)
-> Map MetricsName (a, b) -> Map MetricsName (a, b)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map MetricsName (a, b)
sums

showPrometheusMetrics :: PrometheusMetrics -> L.ByteString
showPrometheusMetrics :: PrometheusMetrics -> ByteString
showPrometheusMetrics = ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (PrometheusMetrics -> ByteString)
-> PrometheusMetrics
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetricsName -> ByteString
T.encodeUtf8 (MetricsName -> ByteString)
-> (PrometheusMetrics -> MetricsName)
-> PrometheusMetrics
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetricsName
 -> MetricsName -> (MetricsName, MetricsType) -> MetricsName)
-> MetricsName -> PrometheusMetrics -> MetricsName
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey
    (\a :: MetricsName
a k :: MetricsName
k (h :: MetricsName
h, m :: MetricsType
m) -> [MetricsName] -> MetricsName
T.concat [MetricsName
a, "# HELP ", MetricsName
k, " ", MetricsName
h, "\n"
                             ,   "# TYPE ", MetricsName
k, " ", MetricsType -> MetricsName
forall p. IsString p => MetricsType -> p
showType MetricsType
m, "\n"
                             ,case MetricsType
m of
                                  Counter v :: Double
v ->
                                      [MetricsName] -> MetricsName
T.concat [MetricsName
k, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v, "\n"]
                                  Gauge v :: Double
v ->
                                      [MetricsName] -> MetricsName
T.concat [MetricsName
k, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v, "\n"]
                                  Histogram h' :: Map MetricsName (MetricsName, Double)
h' -> (MetricsName, Double) -> MetricsName
forall a b. (a, b) -> a
fst ((MetricsName, Double) -> MetricsName)
-> (MetricsName, Double) -> MetricsName
forall a b. (a -> b) -> a -> b
$
                                      ((MetricsName, Double)
 -> MetricsName -> (MetricsName, Double) -> (MetricsName, Double))
-> (MetricsName, Double)
-> Map MetricsName (MetricsName, Double)
-> (MetricsName, Double)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
M.foldlWithKey (MetricsName
-> (MetricsName, Double)
-> MetricsName
-> (MetricsName, Double)
-> (MetricsName, Double)
forall a.
(Show a, RealFrac a) =>
MetricsName
-> (MetricsName, a)
-> MetricsName
-> (MetricsName, a)
-> (MetricsName, a)
showHistogram MetricsName
k)
                                          ("", 0.0) Map MetricsName (MetricsName, Double)
h'
                             ]
    ) ""
    where showType :: MetricsType -> p
showType (Counter _) = "counter"
          showType (Gauge _) = "gauge"
          showType (Histogram _) = "histogram"
          showHistogram :: MetricsName
-> (MetricsName, a)
-> MetricsName
-> (MetricsName, a)
-> (MetricsName, a)
showHistogram k :: MetricsName
k a :: (MetricsName, a)
a@(t :: MetricsName
t, n :: a
n) c :: MetricsName
c (l :: MetricsName
l, v :: a
v) =
              if MetricsName -> Bool
T.null MetricsName
l
                  then if MetricsName
k MetricsName -> MetricsName -> MetricsName
`T.append` "_sum" MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
c
                           then ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
c, " ", String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
v, "\n"]
                                ,a
n
                                )
                           else if MetricsName
k MetricsName -> MetricsName -> MetricsName
`T.append` "_cnt" MetricsName -> MetricsName -> Bool
forall a. Eq a => a -> a -> Bool
== MetricsName
c
                                    then ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
k, "_count "
                                                   ,String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$
                                                       CounterValue -> String
forall a. Show a => a -> String
show (a -> CounterValue
forall a b. (RealFrac a, Integral b) => a -> b
round a
v :: Word64)
                                                   ,"\n"
                                                   ]
                                         ,a
n
                                         )
                                     else (MetricsName, a)
a
                  else let n' :: a
n' = a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
v
                       in ([MetricsName] -> MetricsName
T.concat [MetricsName
t, MetricsName
k, "_bucket{le=\"", MetricsName
l, "\"} "
                                    ,String -> MetricsName
T.pack (String -> MetricsName) -> String -> MetricsName
forall a b. (a -> b) -> a -> b
$ CounterValue -> String
forall a. Show a => a -> String
show (a -> CounterValue
forall a b. (RealFrac a, Integral b) => a -> b
round a
n' :: Word64)
                                    ,"\n"
                                    ]
                          ,a
n'
                          )

toPrometheusMetrics :: ByteString -> IO L.ByteString
toPrometheusMetrics :: ByteString -> IO ByteString
toPrometheusMetrics v :: ByteString
v = do
    let cs :: AllMetrtics
cs = Maybe AllMetrtics -> AllMetrtics
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe AllMetrtics -> AllMetrtics)
-> Maybe AllMetrtics -> AllMetrtics
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe AllMetrtics
forall a. FromJSON a => ByteString -> Maybe a
readFromByteStringAsJSON @AllMetrtics ByteString
v
    Maybe PrometheusConf
pc <- IORef (Maybe PrometheusConf) -> IO (Maybe PrometheusConf)
forall a. IORef a -> IO a
readIORef IORef (Maybe PrometheusConf)
conf
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ case Maybe PrometheusConf
pc of
        Just c :: PrometheusConf
c -> PrometheusMetrics -> ByteString
showPrometheusMetrics (PrometheusMetrics -> ByteString)
-> PrometheusMetrics -> ByteString
forall a b. (a -> b) -> a -> b
$ PrometheusConf -> AllMetrtics -> PrometheusMetrics
toPrometheusMetrics' PrometheusConf
c AllMetrtics
cs
        Nothing -> ""

ngxExportIOYY 'toPrometheusMetrics

-- | 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;
--
--         haskell_run ! $hs_u_response_times $upstream_response_time;
--         haskell_run __/cumulativeFPValue/__ $hs_u_response_time $hs_u_response_times;
--
--         histogram $__/hst_u_response_time/__ 11 $u_response_time_bucket;
--         haskell_run scale1000 $hs_u_response_time_scaled $hs_u_response_time;
--         counter $__/hst_u_response_time_sum/__ inc $hs_u_response_time_scaled;
--
--         counter $__/hst_u_response_time_00/__ undo;
--         counter $__/hst_u_response_time_cnt/__ undo;
-- @
--
-- Notice that the first bucket /hst_u_response_time_00/ and the total count
-- value /hst_u_response_time_cnt/ of histogram /hst_u_response_time/ were
-- temporarily disabled to not count visiting unrelated locations (i.e. /\//,
-- /\/1/, and /\/404/): the two counters will be later re-enabled in locations
-- related to proxying requests.
--
-- 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 {
--             counter $__/hst_u_response_time_00/__ inc $inc_hst_u_response_time_00;
--             counter $__/hst_u_response_time_cnt/__ inc $inc_hst_u_response_time_cnt;
--             error_page 404 \@status404;
--             proxy_intercept_errors on;
--             proxy_pass http:\/\/backends;
--         }
--
--         location \@status404 {
--             counter $__/hst_u_response_time_00/__ inc $inc_hst_u_response_time_00;
--             counter $__/hst_u_response_time_cnt/__ inc $inc_hst_u_response_time_cnt;
--             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/metrics'
-- > # 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