diff --git a/Network/Wai/Metrics.hs b/Network/Wai/Metrics.hs --- a/Network/Wai/Metrics.hs +++ b/Network/Wai/Metrics.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + {-| Module : Network.Wai.Metrics License : BSD3 @@ -41,23 +42,29 @@ -} module Network.Wai.Metrics ( registerWaiMetrics, + registerNamedWaiMetrics, WaiMetrics(..), metrics) where -import Network.Wai -import System.Metrics -import Control.Applicative -import Data.Time.Clock -import qualified System.Metrics.Counter as Counter +import Control.Applicative +import Data.Monoid ((<>)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Time.Clock +import Network.HTTP.Types.Status (statusCode) +import Network.Wai +import Prelude +import System.Metrics +import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Distribution as Distribution -import Network.HTTP.Types.Status (statusCode) + {-| The metrics to feed in WAI and register in EKG. -} data WaiMetrics = WaiMetrics { - requestCounter :: Counter.Counter - ,latencyDistribution :: Distribution.Distribution + requestCounter :: Counter.Counter + ,latencyDistribution :: Distribution.Distribution ,statusCode100Counter :: Counter.Counter ,statusCode200Counter :: Counter.Counter ,statusCode300Counter :: Counter.Counter @@ -66,7 +73,7 @@ } {-| -Register in EKG a number of metrics related to web server activity. +Register in EKG a number of metrics related to web server activity using empty namespace. * @wai.request_count@ * @wai.response_status_1xx@ @@ -77,15 +84,36 @@ * @wai.latency_distribution@ -} registerWaiMetrics :: Store -> IO WaiMetrics -registerWaiMetrics store = +registerWaiMetrics = registerNamedWaiMetrics "" + + +{-| +Register in EKG a number of metrics related to web server activity with a +namespace. + +* @.wai.request_count@ +* @.wai.response_status_1xx@ +* @.wai.response_status_2xx@ +* @.wai.response_status_3xx@ +* @.wai.response_status_4xx@ +* @.wai.response_status_5xx@ +* @.wai.latency_distribution@ +-} +registerNamedWaiMetrics :: Text -> Store -> IO WaiMetrics +registerNamedWaiMetrics namespace store = WaiMetrics - <$> createCounter "wai.request_count" store - <*> createDistribution "wai.latency_distribution" store - <*> createCounter "wai.response_status_1xx" store - <*> createCounter "wai.response_status_2xx" store - <*> createCounter "wai.response_status_3xx" store - <*> createCounter "wai.response_status_4xx" store - <*> createCounter "wai.response_status_5xx" store + <$> createCounter (namespace' <> "wai.request_count") store + <*> createDistribution (namespace' <> "wai.latency_distribution") store + <*> createCounter (namespace' <> "wai.response_status_1xx") store + <*> createCounter (namespace' <> "wai.response_status_2xx") store + <*> createCounter (namespace' <> "wai.response_status_3xx") store + <*> createCounter (namespace' <> "wai.response_status_4xx") store + <*> createCounter (namespace' <> "wai.response_status_5xx") store + where + -- append a '.' to a given namespace, if not empty + namespace' + |Text.null namespace = namespace + |otherwise = namespace <> "." {-| Create a middleware to be added to a WAI-based webserver. diff --git a/tests.hs b/tests.hs --- a/tests.hs +++ b/tests.hs @@ -2,27 +2,28 @@ module Main where -import Control.Monad (replicateM_, liftM) -import Control.Concurrent (threadDelay) -import Control.Monad.IO.Class (liftIO) -import Data.Int (Int64) +import Control.Concurrent (threadDelay) +import Control.Monad (liftM, replicateM_) +import Control.Monad.IO.Class (liftIO) +import Data.Int (Int64) -import Test.Tasty -import Test.Tasty.HUnit -import qualified Test.Tasty.QuickCheck as QC -import qualified Test.QuickCheck.Monadic as QCM -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS +import qualified Test.QuickCheck.Monadic as QCM +import Test.Tasty +import Test.Tasty.HUnit +import qualified Test.Tasty.QuickCheck as QC -import Web.Scotty (scottyApp, middleware, get, html, raise) +import Web.Scotty (get, html, middleware, raise, + scottyApp) -import Network.Wai (Application) -import qualified Network.Wai.Test as WT +import Network.Wai (Application) +import qualified Network.Wai.Test as WT -import System.Metrics -import qualified System.Metrics.Counter as Counter +import System.Metrics +import qualified System.Metrics.Counter as Counter import qualified System.Metrics.Distribution as Distribution -import Network.Wai.Metrics +import Network.Wai.Metrics -- Send a GET request to a WAI Application httpGet :: BS.ByteString -> Application -> IO WT.SResponse @@ -40,9 +41,9 @@ waiMetrics <- registerWaiMetrics store app <- scottyApp $ do middleware (metrics waiMetrics) - get "/" $ html "Ping" + get "/" $ html "Ping" get "/error" $ raise "error" - get "/wait" $ liftIO (threadDelay 100000) >> html "Ping" + get "/wait" $ liftIO (threadDelay 100000) >> html "Ping" replicateM_ times (action app) return waiMetrics diff --git a/wai-middleware-metrics.cabal b/wai-middleware-metrics.cabal --- a/wai-middleware-metrics.cabal +++ b/wai-middleware-metrics.cabal @@ -1,5 +1,5 @@ name: wai-middleware-metrics -version: 0.2.2 +version: 0.2.3 synopsis: A WAI middleware to collect EKG request metrics description: This WAI middleware counts the number of requests, the number of responses by status code and keeps a latency distribution. . @@ -19,10 +19,11 @@ library exposed-modules: Network.Wai.Metrics build-depends: base >=4.6 && < 5 - , wai >= 3.0.0 , ekg-core >= 0.1 , http-types >= 0.8 + , text >= 1.2 , time >= 1.4 + , wai >= 3.0.0 default-language: Haskell2010 ghc-options: -Wall @@ -41,6 +42,7 @@ , wai-extra >= 3.0.0 , http-types >= 0.8 , time >= 1.4 + , text >= 1.2 type: exitcode-stdio-1.0 main-is: tests.hs default-language: Haskell2010 @@ -57,6 +59,7 @@ , ekg-core >= 0.1 , http-types >= 0.8 , time >= 1.4 + , text > 1.2 type: exitcode-stdio-1.0 main-is: Benchmark.hs default-language: Haskell2010