From 6f02c2c096082c78b9b0bcdb08992306738d9ad5 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Fri, 18 Sep 2020 12:53:33 -0400
Subject: [PATCH] Use servant-prometheus to generate HTTP endpoint metrics
automatically
---
PaymentServer.cabal | 1 +
src/PaymentServer/Main.hs | 4 +++-
src/PaymentServer/Server.hs | 13 +++++++++++++
stack.yaml | 2 ++
4 files changed, 19 insertions(+), 1 deletion(-)
diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index f6997bd..134ce45 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -45,6 +45,7 @@ library
, sqlite-simple
, retry
, prometheus-client
+ , servant-prometheus
default-language: Haskell2010
ghc-options: -Wmissing-import-lists -Wunused-imports
pkgconfig-depends: libchallenge_bypass_ristretto_ffi
diff --git a/src/PaymentServer/Main.hs b/src/PaymentServer/Main.hs
index f32512a..e7d700c 100644
--- a/src/PaymentServer/Main.hs
+++ b/src/PaymentServer/Main.hs
@@ -72,6 +72,7 @@ import PaymentServer.Issuer
)
import PaymentServer.Server
( paymentServerApp
+ , makeMetricsMiddleware
)
import Options.Applicative
@@ -313,5 +314,6 @@ getApp config =
let
origins = corsOrigins config
app = paymentServerApp origins stripeConfig' issuer db
+ metricsMiddleware <- makeMetricsMiddleware
logger <- mkRequestLogger (def { outputFormat = Detailed True})
- return $ logger app
+ return . logger . metricsMiddleware $ app
diff --git a/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs
index 5d87959..8842dab 100644
--- a/src/PaymentServer/Server.hs
+++ b/src/PaymentServer/Server.hs
@@ -6,6 +6,7 @@
-- interactions.
module PaymentServer.Server
( paymentServerApp
+ , makeMetricsMiddleware
) where
import Network.Wai.Middleware.Cors
@@ -22,6 +23,11 @@ import Servant
, (:>)
, (:<|>)((:<|>))
)
+import Servant.Prometheus
+ ( MeasureQuantiles(WithQuantiles)
+ , monitorServant
+ , makeMeters
+ )
import Web.Stripe.Client
( StripeConfig
@@ -83,3 +89,10 @@ paymentServerApp corsOrigins stripeConfig issuer =
cors' = cors (const $ Just corsResourcePolicy)
in
cors' . app
+
+
+-- | Create middleware which captures metrics for the payment server app.
+makeMetricsMiddleware :: IO (Application -> Application)
+makeMetricsMiddleware = do
+ meters <- makeMeters paymentServerAPI WithQuantiles
+ return $ monitorServant paymentServerAPI meters
diff --git a/stack.yaml b/stack.yaml
index 0af84a3..3a42436 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -41,6 +41,8 @@ extra-deps:
- "stripe-core-2.5.0"
- "stripe-haskell-2.5.0"
- "stripe-http-client-2.5.0"
+ - github: "PrivateStorageio/servant-prometheus"
+ commit: "ec21c5ed50e6f6f8e52916ce71cd68fcd0166cad"
# Override default flag values for local packages and extra-deps
# flags: {}
--
GitLab