diff --git a/test/Persistence.hs b/test/Persistence.hs
index 48b9dab6430e42628e1bb0211b42d0fdbda1cf40..4d435e5b058847d2c39b3e1a59fd767dcf34f4e4 100644
--- a/test/Persistence.hs
+++ b/test/Persistence.hs
@@ -74,57 +74,70 @@ failPayment = throwIO ArbitraryException
 makeVoucherPaymentTests
   :: VoucherDatabase d
   => Text.Text           -- ^ A distinctive identifier for this group's label.
-  -> IO d                -- ^ An operation that creates a new, empty voucher
-                         -- database.
+  -> IO (IO d)           -- ^ An operation that creates a new, empty voucher
+                         -- database and results in an operation that creates
+                         -- a new connection to that database.
   -> TestTree
 makeVoucherPaymentTests label makeDatabase =
   testGroup ("voucher payments (" ++ Text.unpack label ++ ")")
   [ testCase "not paid for" $ do
-      db <- makeDatabase
-      result <- redeemVoucher db voucher fingerprint
+      connect <- makeDatabase
+      conn <- connect
+      result <- redeemVoucher conn voucher fingerprint
       assertEqual "redeeming unpaid voucher" (Left NotPaid) result
   , testCase "paid for" $ do
-      db <- makeDatabase
-      () <- payForVoucher db voucher paySuccessfully
-      result <- redeemVoucher db voucher fingerprint
+      connect <- makeDatabase
+      conn <- connect
+      () <- payForVoucher conn voucher paySuccessfully
+      result <- redeemVoucher conn voucher fingerprint
       assertEqual "redeeming paid voucher" (Right ()) result
   , testCase "allowed double redemption" $ do
-      db <- makeDatabase
-      () <- payForVoucher db voucher paySuccessfully
-      let redeem = redeemVoucher db voucher fingerprint
+      connect <- makeDatabase
+      conn <- connect
+      () <- payForVoucher conn voucher paySuccessfully
+      let redeem = redeemVoucher conn voucher fingerprint
       first <- redeem
       second <- redeem
       assertEqual "redeeming paid voucher" (Right ()) first
       assertEqual "re-redeeming paid voucher" (Right ()) second
   , testCase "disallowed double redemption" $ do
-      db <- makeDatabase
-      () <- payForVoucher db voucher paySuccessfully
-      let redeem = redeemVoucher db voucher
+      connect <- makeDatabase
+      conn <- connect
+      () <- payForVoucher conn voucher paySuccessfully
+      let redeem = redeemVoucher conn voucher
       first <- redeem fingerprint
       second <- redeem (Text.cons 'a' $ Text.tail fingerprint)
       assertEqual "redeeming paid voucher" (Right ()) first
       assertEqual "re-redeeming paid voucher" (Left AlreadyRedeemed) second
   , testCase "pay with exception" $ do
-      db <- makeDatabase
-      payResult <- try $ payForVoucher db voucher failPayment
+      connect <- makeDatabase
+      conn <- connect
+      payResult <- try $ payForVoucher conn voucher failPayment
       assertEqual "failing a payment for a voucher" (Left ArbitraryException) payResult
-      result <- redeemVoucher db voucher fingerprint
+      result <- redeemVoucher conn voucher fingerprint
       assertEqual "redeeming voucher with failed payment" (Left NotPaid) result
   , testCase "disallowed double payment" $ do
-      db <- makeDatabase
-      let pay = payForVoucher db voucher paySuccessfully
+      connect <- makeDatabase
+      conn <- connect
+      let pay = payForVoucher conn voucher paySuccessfully
       () <- pay
       payResult <- try pay
       assertEqual "double-paying for a voucher" (Left AlreadyPaid) payResult
-      redeemResult <- redeemVoucher db voucher fingerprint
+      redeemResult <- redeemVoucher conn 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
+      connect <- makeDatabase
+      connA <- connect
+      connB <- connect
+      -- It doesn't matter which connection pays for the vouchers.  They
+      -- payments are concurrent and the connections are to the same database.
+      () <- payForVoucher connA voucher paySuccessfully
+      () <- payForVoucher connA anotherVoucher paySuccessfully
+
+      -- It does matter which connection is used to redeem the voucher.  A
+      -- connection can only do one thing at a time.
+      let redeem = redeemVoucher connA voucher fingerprint
+      let anotherRedeem = redeemVoucher connB anotherVoucher fingerprint
 
       result <- withAsync redeem $ \r1 -> do
         withAsync anotherRedeem $ \r2 -> do
@@ -135,7 +148,9 @@ makeVoucherPaymentTests label makeDatabase =
 
 -- | Instantiate the persistence tests for the memory backend.
 memoryDatabaseVoucherPaymentTests :: TestTree
-memoryDatabaseVoucherPaymentTests = makeVoucherPaymentTests "memory" memory
+memoryDatabaseVoucherPaymentTests = makeVoucherPaymentTests "memory" $ do
+  db <- memory
+  return $ return db
 
 -- | Instantiate the persistence tests for the sqlite3 backend.
 sqlite3DatabaseVoucherPaymentTests :: TestTree
@@ -144,4 +159,4 @@ sqlite3DatabaseVoucherPaymentTests =
   do
     tempdir <- getTemporaryDirectory
     (path, handle) <- openTempFile tempdir "voucher-.db"
-    getDBConnection $ Text.pack path
+    return . getDBConnection . Text.pack $ path