From d7ba9ffd970d7b4caa99ba93433f613d4773b17c Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Wed, 18 Mar 2020 09:54:19 -0400
Subject: [PATCH] Test concurrent payment too, just to be sure
Still not testing the web code path but ... types and stuff!@
---
test/Persistence.hs | 13 +++++++++++++
1 file changed, 13 insertions(+)
diff --git a/test/Persistence.hs b/test/Persistence.hs
index caf789f..a66196f 100644
--- a/test/Persistence.hs
+++ b/test/Persistence.hs
@@ -125,6 +125,19 @@ makeVoucherPaymentTests label makeDatabase =
assertEqual "double-paying for a voucher" (Left AlreadyPaid) payResult
redeemResult <- redeemVoucher conn voucher fingerprint
assertEqual "redeeming double-paid voucher" (Right ()) redeemResult
+ , testCase "concurrent payment" $ do
+ connect <- makeDatabase
+ connA <- connect
+ connB <- connect
+
+ let payment = payForVoucher connA voucher paySuccessfully
+ let anotherPayment = payForVoucher connB anotherVoucher paySuccessfully
+
+ result <- withAsync payment $ \p1 -> do
+ withAsync anotherPayment $ \p2 -> do
+ waitBoth p1 p2
+
+ assertEqual "Both payments should succeed" ((), ()) result
, testCase "concurrent redemption" $ do
connect <- makeDatabase
connA <- connect
--
GitLab