diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs index 0c5ff96a6c9f2a7d8699e8c4c758e0061c9f5bc3..dc499a4e6325abb0055ced3e46e33b929eb50168 100644 --- a/src/PaymentServer/Persistence.hs +++ b/src/PaymentServer/Persistence.hs @@ -37,6 +37,9 @@ import qualified Database.SQLite.Simple as Sqlite import Database.SQLite.Simple.FromRow ( FromRow(fromRow) ) + +import qualified Prometheus as P + import Data.Maybe ( listToMaybe ) @@ -259,6 +262,7 @@ redeemVoucherHelper isVoucherPaid lookupFingerprint lookupVoucherCounter markVou return $ Left NotPaid (True, Nothing) -> do markVoucherRedeemed (voucher, counter) fingerprint + P.incCounter voucherRedeemed return $ Right () (True, Just fingerprint') -> if fingerprint == fingerprint' then @@ -267,6 +271,18 @@ redeemVoucherHelper isVoucherPaid lookupFingerprint lookupVoucherCounter markVou return $ Left AlreadyRedeemed +metricName :: Text -> Text +metricName name = mappend "redemption." name + + +voucherRedeemed :: P.Counter +voucherRedeemed + = P.unsafeRegister + $ P.counter + $ P.Info (metricName "voucher_redeemed") + "The number of unique (voucher, counter) pairs which have been redeemed." + + -- | Create a new, empty MemoryVoucherDatabase. memory :: IO VoucherDatabaseState memory = do diff --git a/test/Metrics.hs b/test/Metrics.hs index 54eca21d6760afba4d65108af98511eab0d0561d..67392b2b6f3e68b8e978197a614e996fdebff4a9 100644 --- a/test/Metrics.hs +++ b/test/Metrics.hs @@ -35,7 +35,7 @@ import Network.Wai.Test , request , assertStatus , assertContentType - , assertBody + , assertBodyContains ) import Servant @@ -89,7 +89,7 @@ metricsTests = response <- readMetrics assertStatus 200 response assertContentType "text/plain" response - assertBody expectedMetrics response + assertBodyContains expectedMetrics response where expectedMetrics = pack . unlines $ [ "# HELP a_counter A test counter."