diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Sebastian de Bellefon + +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 Sebastian de Bellefon nor the names of other + 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 +OWNER 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. diff --git a/Network/Wai/Metrics.hs b/Network/Wai/Metrics.hs new file mode 100644 --- /dev/null +++ b/Network/Wai/Metrics.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Network.Wai.Metrics +License : BSD3 +Stability : experimental + +A middleware to collect the following metrics from compatible web servers: + +* number of requests (counter @wai.request_count@) +* number of server errors (counter @wai.server_error_count@) +* latency distribution (distribution @wai.latency_distribution@) + + +Here's an example of reading these metrics from a Scotty server, and displaying them with EKG. + +> -- Compile with GHC option `-with-rtsopts=-T` for GC metrics +> import Web.Scotty +> import Control.Applicative +> import System.Remote.Monitoring (serverMetricStore, forkServer) +> import Network.Wai.Metrics +> +> main :: IO() +> main = do +> store <- serverMetricStore <$> forkServer "localhost" 8000 +> waiMetrics <- registerWaiMetrics store +> scotty 3000 $ do +> middleware (metrics waiMetrics) +> get "/" $ html "Ping" + +Now have a look at and display the request count by clicking on 'wai.request_count'. + +WAI metrics can also be stored in a bare EKG store, with no UI and no GC metrics. Use ekg-core's newStore function. + +Compatible web servers include the following: + +*Yesod +*Scotty +*Spock +*Servant +*Warp +-} +module Network.Wai.Metrics ( + registerWaiMetrics, + WaiMetrics(..), + metrics) where + +import Network.Wai +import System.Metrics +import Control.Monad (when) +import Data.Time.Clock +import qualified System.Metrics.Counter as Counter +import qualified System.Metrics.Distribution as Distribution +import Network.HTTP.Types.Status (statusIsServerError) + +{-| +The metrics to feed in WAI and register in EKG. +-} +data WaiMetrics = WaiMetrics { + requestCounter :: Counter.Counter + ,serverErrorCounter :: Counter.Counter + ,latencyDistribution :: Distribution.Distribution +} + +{-| +Register in EKG a number of metrics related to web server activity. + +* @wai.request_count@ +* @wai.server_error_count@ +* @wai.latency_distribution@ +-} +registerWaiMetrics :: Store -> IO WaiMetrics +registerWaiMetrics store = do + req <- createCounter "wai.request_count" store + err <- createCounter "wai.server_error_count" store + tim <- createDistribution "wai.latency_distribution" store + return $ WaiMetrics req err tim + +{-| +Create a middleware to be added to a WAI-based webserver. +-} +metrics :: WaiMetrics -> Middleware +metrics waiMetrics app req respond = do + Counter.inc (requestCounter waiMetrics) + start <- getCurrentTime + app req (respond' start) + where respond' :: UTCTime -> Response -> IO ResponseReceived + respond' start res = do + when (statusIsServerError $ responseStatus res) (Counter.inc (serverErrorCounter waiMetrics)) + end <- getCurrentTime + Distribution.add (latencyDistribution waiMetrics) (realToFrac $ diffUTCTime end start) + respond res diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/tests.hs b/tests.hs new file mode 100644 --- /dev/null +++ b/tests.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Control.Monad (replicateM_, liftM) +import Control.Concurrent (threadDelay) +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 Web.Scotty (scottyApp, middleware, get, html, raise) + +import Network.Wai (Application) +import qualified Network.Wai.Test as WT + +import System.Metrics +import qualified System.Metrics.Counter as Counter +import qualified System.Metrics.Distribution as Distribution + +import Network.Wai.Metrics + +-- Send a GET request to a WAI Application +httpGet :: BS.ByteString -> Application -> IO WT.SResponse +httpGet path = WT.runSession (WT.srequest (WT.SRequest req "")) + where req = WT.setRawPathInfo WT.defaultRequest path + +between :: Ord a => a -> a -> a -> Bool +between low high x = low <= x && x <= high + +-- Return the state of Wai Metrics after running n times +-- an action over a fresh scotty server +testServer :: (Application -> IO a) -> Int -> IO WaiMetrics +testServer action times = do + store <- newStore + waiMetrics <- registerWaiMetrics store + app <- scottyApp $ do + middleware (metrics waiMetrics) + get "/" $ html "Ping" + get "/error" $ raise "error" + get "/wait" $ liftIO (threadDelay 100000) >> html "Ping" + replicateM_ times (action app) + return waiMetrics + +-- Return the number of requests after running n times +-- an action over a fresh scotty server +readRequestCounter :: (Application -> IO a) -> Int -> IO Int64 +readRequestCounter action times = do + waiMetrics <- testServer action times + Counter.read (requestCounter waiMetrics) + +-- Return the number of server errors after running n times +-- an action over a fresh scotty server +readErrorCounter :: (Application -> IO a) -> Int -> IO Int64 +readErrorCounter action times = do + waiMetrics <- testServer action times + Counter.read (serverErrorCounter waiMetrics) + +-- Return the response time distribution after running n times +-- an action over a fresh scotty server +readResponseTime :: (Application -> IO a) -> Int -> IO Distribution.Stats +readResponseTime action times = do + waiMetrics <- testServer action times + Distribution.read (latencyDistribution waiMetrics) + +testRequestCounterScotty :: QC.NonNegative Int -> QC.Property +testRequestCounterScotty (QC.NonNegative n) = QCM.monadicIO test + where test = do c <- QCM.run $ readRequestCounter (httpGet "") n + QCM.assert $ fromIntegral c == n + +testErrorCounterScotty :: QC.NonNegative Int -> QC.Property +testErrorCounterScotty (QC.NonNegative n) = QCM.monadicIO test + where test = do c <- QCM.run $ readErrorCounter (httpGet "/error") n + QCM.assert $ fromIntegral c == n + +testResponseTimeScotty :: IO() +testResponseTimeScotty = do s <- readResponseTime (httpGet "/wait") 3 + assert $ between 0.1 0.11 (Distribution.mean s) + +tests :: TestTree +tests = testGroup "Metrics tests" [ + QC.testProperty "Request counter must be incremented in middleware" testRequestCounterScotty + , QC.testProperty "Error counter must be incremented in middleware" testErrorCounterScotty + , testCase "Request time average must be measured in middleware" testResponseTimeScotty] + +main :: IO() +main = defaultMain tests diff --git a/wai-middleware-metrics.cabal b/wai-middleware-metrics.cabal new file mode 100644 --- /dev/null +++ b/wai-middleware-metrics.cabal @@ -0,0 +1,50 @@ +name: wai-middleware-metrics +version: 0.2.0 +synopsis: A WAI middleware to collect EKG request metrics +description: This WAI middleware counts the number of requests, the number of server errors (http status >= 500) and keeps a latency distribution. + . + It can be added to any WAI-based webserver, such as Yesod, Scotty, Spock and Servant. + . + The counters are EKG Counters from ekg-core. +license: BSD3 +license-file: LICENSE +author: Sebastian de Bellefon +maintainer: arnaudpourseb@gmail.com +homepage: https://github.com/Helkafen/wai-middleware-metrics +category: Web +build-type: Simple +cabal-version: >=1.10 +Tested-with: GHC == 7.6.2, GHC == 7.6.3, GHC == 7.8.1, GHC == 7.8.2, GHC == 7.8.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 7.10.2 + +library + exposed-modules: Network.Wai.Metrics + build-depends: base >=4.6 && < 5 + , wai >= 3.0.0 + , ekg-core >= 0.1 + , http-types >= 0.8 + , time >= 1.4 + default-language: Haskell2010 + ghc-options: -Wall + +test-suite unit + build-depends: base >=4.6 && < 5 + , wai >= 3.0 + , ekg-core >= 0.1 + , wai-middleware-metrics + , tasty >= 0.10.1 + , tasty-hunit >= 0.8 + , tasty-quickcheck >= 0.8.2 + , QuickCheck == 2.7 + , scotty >= 0.8.0 + , transformers >= 0.3 + , bytestring >= 0.10.0.2 + , wai-extra >= 3.0.0 + , http-types >= 0.8 + , time >= 1.4 + type: exitcode-stdio-1.0 + main-is: tests.hs + default-language: Haskell2010 + +source-repository head + type: git + location: git://github.com/Helkafen/wai-middleware-metrics.git