40 lines
1.4 KiB
Haskell
40 lines
1.4 KiB
Haskell
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
|