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