From 03bd6c2c174159618cdb8a737b029cb922ce7ba2 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Thu, 17 Sep 2020 11:40:03 -0400
Subject: [PATCH] Glue the endpoint into the overall API
---
src/PaymentServer/Metrics.hs | 7 ++++++-
src/PaymentServer/Server.hs | 6 ++++++
test/Metrics.hs | 13 +++++++++++++
3 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/src/PaymentServer/Metrics.hs b/src/PaymentServer/Metrics.hs
index 1c6c30e..92879f8 100644
--- a/src/PaymentServer/Metrics.hs
+++ b/src/PaymentServer/Metrics.hs
@@ -2,8 +2,13 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
+-- | A module which provides Prometheus metrics publishing. Individual
+-- metrics are defined elsewhere in the codebase but they'll all be published
+-- by this module.
+
module PaymentServer.Metrics
- ( metricsAPI
+ ( MetricsAPI
+ , metricsAPI
, metricsServer
) where
diff --git a/src/PaymentServer/Server.hs b/src/PaymentServer/Server.hs
index a789f38..5d87959 100644
--- a/src/PaymentServer/Server.hs
+++ b/src/PaymentServer/Server.hs
@@ -35,6 +35,10 @@ import PaymentServer.Redemption
( RedemptionAPI
, redemptionServer
)
+import PaymentServer.Metrics
+ ( MetricsAPI
+ , metricsServer
+ )
import PaymentServer.Issuer
( Issuer
)
@@ -46,12 +50,14 @@ import PaymentServer.Persistence
type PaymentServerAPI
= "v1" :> "stripe" :> StripeAPI
:<|> "v1" :> "redeem" :> RedemptionAPI
+ :<|> MetricsAPI
-- | Create a server which uses the given database.
paymentServer :: VoucherDatabase d => StripeConfig -> Issuer -> d -> Server PaymentServerAPI
paymentServer stripeConfig issuer database =
stripeServer stripeConfig database
:<|> redemptionServer issuer database
+ :<|> metricsServer
paymentServerAPI :: Proxy PaymentServerAPI
paymentServerAPI = Proxy
diff --git a/test/Metrics.hs b/test/Metrics.hs
index fe383ad..874e18a 100644
--- a/test/Metrics.hs
+++ b/test/Metrics.hs
@@ -65,6 +65,7 @@ import PaymentServer.Persistence
tests :: TestTree
tests = testGroup "Metrics"
[ metricsTests
+ , serverTests
]
readMetrics :: Session SResponse
@@ -96,3 +97,15 @@ metricsTests =
, "# TYPE a_counter counter"
, "a_counter 1.0"
]
+
+-- | The metrics endpoint is hooked up to the overall application server.
+serverTests :: TestTree
+serverTests =
+ testCase "metrics endpoint" $
+ let
+ app :: Application
+ app = paymentServerApp mempty undefined undefined (undefined :: VoucherDatabaseState)
+ in
+ flip runSession app $ do
+ response <- readMetrics
+ assertStatus 200 response
--
GitLab