prometheus-wai-middleware (empty) → 1.0.0.0

raw patch · 6 files changed

+198/−0 lines, 6 filesdep +asyncdep +basedep +clocksetup-changed

Dependencies added: async, base, clock, containers, http-types, prometheus, prometheus-wai-middleware, text, wai, warp

Files

CHANGELOG.md +5/−0
LICENSE +29/−0
Setup.hs +2/−0
exec/Main.hs +32/−0
prometheus-wai-middleware.cabal +46/−0
src/Network/Wai/Middleware/Prometheus.hs +84/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for prometheus-wai-middleware++## 1.0.0.0 - 2020-06-26++First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2020-present, Bitnomial, Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+  list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+  this list of conditions and the following disclaimer in the documentation+  and/or other materials provided with the distribution.++* Neither the name of the copyright holder nor the names of its+  contributors may be used to endorse or promote products derived from+  this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ exec/Main.hs view

@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Concurrent.Async                       (async)+import           Control.Monad.IO.Class                         (liftIO)+import           Network.HTTP.Types.Status                      (status200,+                                                                 status404)+import           Network.Wai                                    (pathInfo,+                                                                 responseLBS)+import           Network.Wai.Handler.Warp                       (run)+import           System.Metrics.Prometheus.Concurrent.RegistryT (runRegistryT)+import           System.Metrics.Prometheus.Http.Scrape          (serveHttpTextMetricsT)+import           System.Metrics.Prometheus.MetricId             (fromList)++import           Network.Wai.Middleware.Prometheus              (applicationMetrics,+                                                                 instrumentApplication)+++main :: IO ()+main = runRegistryT $ do+    ms <- applicationMetrics $ fromList [("app", "example_server")]+    let webserver = run 8080 . instrumentApplication ms $ \req respond ->+            respond (makeResponse req)+    liftIO $ async webserver+    serveHttpTextMetricsT 8081 []+  where+    success = responseLBS status200 [] "ok"+    failure = responseLBS status404 [] mempty+    makeResponse req+        | pathInfo req == ["test"] = success+        | otherwise = failure

+ prometheus-wai-middleware.cabal view

@@ -0,0 +1,46 @@+cabal-version:       2.2+name:                prometheus-wai-middleware+version:             1.0.0.0+synopsis:            Instrument a wai application with various metrics+description:         See https://github.com/bitnomial/prometheus-wai-middleware/tree/master/readme.md+bug-reports:         https://github.com/bitnomial/prometheus-wai-middleware/issues+license:             BSD-3-Clause+license-file:        LICENSE+author:              Ian Shipman+maintainer:          ian.shipman@bitnomial.com+copyright:           2020 Bitnomial, Inc.+category:            Web+build-type:          Simple+extra-source-files:  CHANGELOG.md++source-repository head+  type:     git+  location: https://github.com/bitnomial/prometheus-wai-middleware++library+  default-language: Haskell2010+  hs-source-dirs:   src/+  exposed-modules:+    Network.Wai.Middleware.Prometheus+  build-depends:+      base        >= 4.12  && < 4.14+    , containers  >= 0.5   && < 0.7+    , clock      ^>= 0.8+    , http-types  >= 0.8   && < 0.13+    , prometheus ^>= 2.1.3+    , text       ^>= 1.2+    , wai        ^>= 3.2+++executable prometheus-wai-middleware-example+  default-language: Haskell2010+  hs-source-dirs:   exec/+  main-is:          Main.hs+  build-depends:+      async                     ^>= 2.2+    , base                       >= 4.12  && < 4.14+    , http-types                 >= 0.8   && < 0.13+    , prometheus                ^>= 2.1.3+    , prometheus-wai-middleware+    , wai                       ^>= 3.2+    , warp                       >= 3.2   && < 3.5

+ src/Network/Wai/Middleware/Prometheus.hs view

@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}++module Network.Wai.Middleware.Prometheus+    ( ApplicationMetrics+    , applicationMetrics+    , countStatusCode+    , observeDuration+    , instrumentApplication+    ) where++import           Control.Monad.IO.Class                         (MonadIO)+import           Data.Map.Strict                                (Map, fromList)+import qualified Data.Map.Strict                                as Map+import           Data.Text                                      (pack)+import           Network.HTTP.Types                             (Status (..))+import           Network.Wai                                    (Middleware,+                                                                 responseStatus)+import           System.Clock                                   (Clock (Monotonic),+                                                                 TimeSpec (..),+                                                                 diffTimeSpec,+                                                                 getTime,+                                                                 toNanoSecs)+import           System.Metrics.Prometheus.Concurrent.RegistryT (RegistryT,+                                                                 registerCounter,+                                                                 registerHistogram)+import           System.Metrics.Prometheus.Metric.Counter       (Counter, inc)+import           System.Metrics.Prometheus.Metric.Histogram     (Histogram,+                                                                 observe)+import           System.Metrics.Prometheus.MetricId             (Labels (..))+++data ApplicationMetrics = ApplicationMetrics+    { statusCodeMetrics :: Map Int Counter+    , durationMetrics   :: Histogram+    }+++-- | Increment the count for a specific status code, by number+countStatusCode :: ApplicationMetrics -> Int -> IO ()+countStatusCode ms s = mapM_ inc . Map.lookup s $ statusCodeMetrics ms+++-- | Add a request duration observation in ms+observeDuration :: ApplicationMetrics -> Double -> IO ()+observeDuration ms i = observe i $ durationMetrics ms+++-- | Set up the metrics for HTTP response codes and request handling durations.  We identify the response code counters+-- by @http_requests_total@ with codes labeled by @http_response_code@.  We identify the duration histogram by+-- @http_request_duration_milliseconds@ Use labels to identify your particular application.+applicationMetrics :: MonadIO m => Labels -> RegistryT m ApplicationMetrics+applicationMetrics ls =+    ApplicationMetrics . fromList <$> traverse codeCounter codes <*> hist+  where+    codeCounter i = (i, ) <$> registerCounter "http_requests_total" (mkLabels i)+    mkLabels i    = Labels $ fromList [("http_response_code", (pack . show) i)] <> unLabels ls++    codes = [100 .. 103]+         <> [200 .. 208] <> [226]+         <> [300 .. 308]+         <> [400 .. 418] <> [421 .. 426] <> [428, 429, 431, 451]+         <> [500 .. 508] <> [510, 511]++    hist           = registerHistogram "http_request_duration_milliseconds" ls durationBounds+    durationBounds = [1 .. 20] <> [30, 40 .. 200] <> [300, 400 .. 900] <> [1000, 2000 .. 10000]+++-- | This middleware adds response code tracking and request duration statistics for the application, aggregating across all requests+instrumentApplication :: ApplicationMetrics -> Middleware+instrumentApplication ms app req respond = do+    t0 <- getTime Monotonic+    app req $ \r -> do+        t1 <- getTime Monotonic+        countStatusCode ms (statusCode $ responseStatus r)+        observeDuration ms $ diffTimeMS t0 t1+        respond r+++diffTimeMS :: TimeSpec -> TimeSpec -> Double+diffTimeMS t0 t1 = toMS $ t1 `diffTimeSpec` t0+  where+    toMS = fromIntegral . (`quot` oneMillion) . toNanoSecs+    oneMillion = 1000000