diff --git a/src/PaymentServer/Metrics.hs b/src/PaymentServer/Metrics.hs index 1c6c30e5fdbc266f1aa881469edd62f2c65b777f..92879f8d9a33b9fa6824f29509158b6c40f99f00 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 a789f38a2e6baa1969c3643e82bc6f7ff0500020..5d879594c879673a3ffffc98376c2df2c115bff1 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 fe383adf174bc5cffc6d7e5018931dd69fb19c86..874e18ac4147ee3ada81be5d5afc48b515d74f27 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