commit d3bd502568fb300d3e04c4d4bf2aa9795f472f4e Author: Timo von Holtz Date: Fri May 1 12:40:08 2015 +1000 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b68c698 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*cabal.config +*cabal.sandbox.config +.cabal-sandbox/* +*dist/ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ef288d0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2015, Anchor Systems + +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 Anchor Systems 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/Setup.hs b/Setup.hs new file mode 100644 index 0000000..4467109 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ekg-servant.cabal b/ekg-servant.cabal new file mode 100644 index 0000000..06526c9 --- /dev/null +++ b/ekg-servant.cabal @@ -0,0 +1,24 @@ +name: ekg-servant +version: 0.1.0.0 +synopsis: Helpers for using ekg with servant +description: Helpers for using ekg with servant +license: BSD3 +license-file: LICENSE +author: Anchor Engineering +maintainer: Anchor Engineering +category: System +build-type: Simple +cabal-version: >=1.10 + +source-repository HEAD + type: git + location: https://github.com/anchor/ekg-servant.git + +library + exposed-modules: Servant.Ekg + build-depends: base >=4.7 && <4.9 + , ekg-core + , http-types + , time + , wai + default-language: Haskell2010 \ No newline at end of file diff --git a/lib/Servant/Ekg.hs b/lib/Servant/Ekg.hs new file mode 100644 index 0000000..aa7e7e2 --- /dev/null +++ b/lib/Servant/Ekg.hs @@ -0,0 +1,39 @@ +module Servant.Ekg where + +import Control.Exception +import Data.Time.Clock +import Network.HTTP.Types +import Network.Wai +import qualified System.Metrics.Counter as Counter +import qualified System.Metrics.Distribution as Distribution +import qualified System.Metrics.Gauge as Gauge + + +gaugeInflight :: Gauge.Gauge -> Middleware +gaugeInflight inflight application request respond = + bracket_ (Gauge.inc inflight) + (Gauge.dec inflight) + (application request respond) + +-- | Count responses with 2XX, 4XX, 5XX, and XXX response codes. +countResponseCodes + :: (Counter.Counter, Counter.Counter, Counter.Counter, Counter.Counter) + -> Middleware +countResponseCodes (c2XX, c4XX, c5XX, cXXX) application request respond = + application request respond' + where + respond' res = count (responseStatus res) >> respond res + count Status{statusCode = sc } + | 200 <= sc && sc < 300 = Counter.inc c2XX + | 400 <= sc && sc < 500 = Counter.inc c4XX + | 500 <= sc && sc < 600 = Counter.inc c5XX + | otherwise = Counter.inc cXXX + +responseTimeDistribution :: Distribution.Distribution -> Middleware +responseTimeDistribution dist application request respond = + bracket getCurrentTime stop $ const $ application request respond + where + stop t1 = do + t2 <- getCurrentTime + let dt = diffUTCTime t2 t1 + Distribution.add dist $ fromRational $ toRational dt