From 9a96cfe2bcfa987d6ee9fe0eda10d293bcc57831 Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Wed, 18 Mar 2020 08:57:00 -0400
Subject: [PATCH] Add a failing test for the case
---
PaymentServer.cabal | 1 +
test/Persistence.hs | 19 +++++++++++++++++++
2 files changed, 20 insertions(+)
diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 0c5286c..dd51a39 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -73,6 +73,7 @@ test-suite PaymentServer-tests
, tasty
, tasty-hunit
, directory
+ , async
, PaymentServer
default-language: Haskell2010
diff --git a/test/Persistence.hs b/test/Persistence.hs
index f425e2f..48b9dab 100644
--- a/test/Persistence.hs
+++ b/test/Persistence.hs
@@ -15,6 +15,11 @@ import Control.Exception
, try
)
+import Control.Concurrent.Async
+ ( withAsync
+ , waitBoth
+ )
+
import Test.Tasty
( TestTree
, testGroup
@@ -54,6 +59,7 @@ tests = testGroup "Persistence"
-- Some dummy values that should be replaced by the use of QuickCheck.
voucher = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+anotherVoucher = "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"
fingerprint = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-- Mock a successful payment.
@@ -112,6 +118,19 @@ makeVoucherPaymentTests label makeDatabase =
assertEqual "double-paying for a voucher" (Left AlreadyPaid) payResult
redeemResult <- redeemVoucher db voucher fingerprint
assertEqual "redeeming double-paid voucher" (Right ()) redeemResult
+ , testCase "concurrent redemption" $ do
+ db <- makeDatabase
+ () <- payForVoucher db voucher paySuccessfully
+ () <- payForVoucher db anotherVoucher paySuccessfully
+
+ let redeem = redeemVoucher db voucher fingerprint
+ let anotherRedeem = redeemVoucher db anotherVoucher fingerprint
+
+ result <- withAsync redeem $ \r1 -> do
+ withAsync anotherRedeem $ \r2 -> do
+ waitBoth r1 r2
+
+ assertEqual "Both redemptions should succeed" (Right (), Right ()) result
]
-- | Instantiate the persistence tests for the memory backend.
--
GitLab