mirror of
https://github.com/haskell-servant/servant-ekg.git
synced 2024-11-01 00:39:43 +01:00
Initial commit
This commit is contained in:
commit
d3bd502568
5 changed files with 99 additions and 0 deletions
4
.gitignore
vendored
Normal file
4
.gitignore
vendored
Normal file
|
@ -0,0 +1,4 @@
|
|||
*cabal.config
|
||||
*cabal.sandbox.config
|
||||
.cabal-sandbox/*
|
||||
*dist/
|
30
LICENSE
Normal file
30
LICENSE
Normal file
|
@ -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.
|
2
Setup.hs
Normal file
2
Setup.hs
Normal file
|
@ -0,0 +1,2 @@
|
|||
import Distribution.Simple
|
||||
main = defaultMain
|
24
ekg-servant.cabal
Normal file
24
ekg-servant.cabal
Normal file
|
@ -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 <engineering@lists.anchor.net.au>
|
||||
maintainer: Anchor Engineering <engineering@lists.anchor.net.au>
|
||||
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
|
39
lib/Servant/Ekg.hs
Normal file
39
lib/Servant/Ekg.hs
Normal file
|
@ -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
|
Loading…
Reference in a new issue