diff --git a/PaymentServer.cabal b/PaymentServer.cabal
index 134ce45a529fc52c21f8806b3bc2299dd34f5ea6..c80b5951c0f6ad2e78b087a9cff2c9441d4ebaa1 100644
--- a/PaymentServer.cabal
+++ b/PaymentServer.cabal
@@ -86,6 +86,7 @@ test-suite PaymentServer-tests
                      , wai-extra
                      , servant-server
                      , prometheus-client
+                     , stripe-core
                      , PaymentServer
   default-language: Haskell2010
 
diff --git a/nix/PaymentServer.nix b/nix/PaymentServer.nix
index 861ed69234842b225433f4a88831db097ca551a7..a8df27a4643c47274a384d63fc4d6c9d8e99a530 100644
--- a/nix/PaymentServer.nix
+++ b/nix/PaymentServer.nix
@@ -115,6 +115,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }:
             (hsPkgs."wai-extra" or (buildDepError "wai-extra"))
             (hsPkgs."servant-server" or (buildDepError "servant-server"))
             (hsPkgs."prometheus-client" or (buildDepError "prometheus-client"))
+            (hsPkgs."stripe-core" or (buildDepError "stripe-core"))
             (hsPkgs."PaymentServer" or (buildDepError "PaymentServer"))
             ];
           };
diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs
index 478821e790fd69516905ebf51167b9003e913fb5..8ec3753e0556cadf445eb7847fbd78d861b8a710 100644
--- a/src/PaymentServer/Persistence.hs
+++ b/src/PaymentServer/Persistence.hs
@@ -7,6 +7,7 @@ module PaymentServer.Persistence
   , Fingerprint
   , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint, DatabaseUnavailable)
   , PaymentError(AlreadyPaid, PaymentFailed)
+  , ProcessorResult
   , VoucherDatabase(payForVoucher, redeemVoucher, redeemVoucherWithCounter)
   , VoucherDatabaseState(MemoryDB, SQLiteDB)
   , memory
@@ -50,6 +51,9 @@ import Data.Maybe
 import Web.Stripe.Error
   ( StripeError
   )
+import Web.Stripe.Types
+  ( ChargeId(ChargeId)
+  )
 
 -- | A voucher is a unique identifier which can be associated with a payment.
 -- A paid voucher can be redeemed for ZKAPs which can themselves be exchanged
@@ -111,19 +115,28 @@ type Fingerprint = Text
 -- allowed).
 type RedemptionKey = (Voucher, Integer)
 
+-- | The result of completing payment processing.  This is either an error
+-- indicating that the payment has *not* been completed (funds will not move)
+-- or a payment processor-specific identifier for the completed transaction
+-- (funds will move).
+type ProcessorResult = Either PaymentError ChargeId
+
 -- | A VoucherDatabase provides persistence for state related to vouchers.
 class VoucherDatabase d where
   -- | Change the state of the given voucher to indicate that it has been paid.
   payForVoucher
-    :: d             -- ^ The database in which to record the change
-    -> Voucher       -- ^ A voucher which should be considered paid
-    -> IO a          -- ^ An operation which completes the payment.  This is
-                     -- evaluated in the context of a database transaction so
-                     -- that if it fails the voucher is not marked as paid in
-                     -- the database but if it succeeds the database state is
-                     -- not confused by a competing transaction run around the
-                     -- same time.
-    -> IO a
+    :: d
+    -- ^ The database in which to record the change
+    -> Voucher
+    -- ^ A voucher which should be considered paid
+    -> IO ProcessorResult
+    -- ^ An operation which completes the payment.  This is evaluated in the
+    -- context of a database transaction so that if it fails the voucher is
+    -- not marked as paid in the database but if it succeeds the database
+    -- state is not confused by a competing transaction run around the same
+    -- time.
+    -> IO ProcessorResult
+    -- ^ The result of the attempt to complete payment processing.
 
   -- | Attempt to redeem a voucher.  If it has not been redeemed before or it
   -- has been redeemed with the same fingerprint, the redemption succeeds.
@@ -180,8 +193,12 @@ instance VoucherDatabase VoucherDatabaseState where
       else
       do
         result <- pay
-        -- Only modify the paid set if the payment succeeds.
-        modifyIORef paidRef (Set.insert voucher)
+        case result of
+          Right chargeId ->
+            -- Only modify the paid set if the payment succeeds.
+            modifyIORef paidRef (Set.insert voucher)
+
+          Left _ -> return ()
         return result
 
   payForVoucher SQLiteDB{ connect = connect } voucher pay =
@@ -329,32 +346,34 @@ getVoucherFingerprint dbConn (voucher, counter) =
     listToMaybe <$> Sqlite.query dbConn sql ((voucher :: Text), (counter :: Integer))
 
 -- | Mark the given voucher as paid in the database.
-insertVoucher :: Sqlite.Connection -> Voucher -> IO a -> IO a
+insertVoucher :: Sqlite.Connection -> Voucher -> IO ProcessorResult -> IO ProcessorResult
 insertVoucher dbConn voucher pay =
-  -- Begin an immediate transaction so that it includes the IO.  The first
-  -- thing we do is execute our one and only statement so the transaction is
-  -- immediate anyway but it doesn't hurt to be explicit.
-  Sqlite.withImmediateTransaction dbConn $
+  -- Begin an immediate transaction so that it includes the IO.  The
+  -- transaction is immediate so that we can first check that the voucher is
+  -- unique and then proceed to do the IO without worrying that another
+  -- request will concurrently begin operating on the same voucher.
+  Sqlite.withExclusiveTransaction dbConn $
   do
-    -- Vouchers must be unique in this table.  This might fail if someone is
-    -- trying to double-pay for a voucher.  In this case, we won't ever
-    -- finalize the payment.
-    Sqlite.execute dbConn "INSERT INTO vouchers (name) VALUES (?)" (Sqlite.Only voucher)
-      `catch` handleConstraintError
-    -- If we managed to insert the voucher, try to finalize the payment.  If
-    -- this succeeds, the transaction is committed and we expect the payment
-    -- system to actually be moving money around.  If it fails, we expect the
-    -- payment system *not* to move money around and the voucher should not be
-    -- marked as paid.  The transaction will be rolled back so, indeed, it
-    -- won't be marked thus.
-    pay
-
-  where
-    handleConstraintError Sqlite.SQLError { Sqlite.sqlError = Sqlite.ErrorConstraint } =
-      throwIO AlreadyPaid
-    handleConstraintError e =
-      throwIO e
-
+    -- Vouchers must be unique in this table.  Check to see if this one
+    -- already exists.
+    rows <- Sqlite.query dbConn "SELECT 1 FROM vouchers WHERE name = ?" (Sqlite.Only voucher) :: IO [Sqlite.Only Int]
+    if length rows /= 0
+      then throwIO AlreadyPaid
+      else
+      do
+        -- If the voucher isn't present yet, try to finalize the payment.  If
+        -- this succeeds, the transaction is committed and we expect the
+        -- payment system to actually be moving money around.  If it fails, we
+        -- expect the payment system *not* to move money around and the
+        -- voucher should not be marked as paid.  The transaction will be
+        -- rolled back so, indeed, it won't be marked thus.
+        result <- pay
+        case result of
+          Right (ChargeId chargeId) -> do
+            Sqlite.execute dbConn "INSERT INTO vouchers (name, charge_id) VALUES (?, ?)" (voucher, chargeId)
+            return result
+          Left err ->
+            return result
 
 -- | Mark the given voucher as having been redeemed (with the given
 -- fingerprint) in the database.
diff --git a/src/PaymentServer/Processors/Stripe.hs b/src/PaymentServer/Processors/Stripe.hs
index c279b4bbaf7f6601f55835dceb23a5b95f2de647..1696eaf619feb53b5ca46b246b13434a44572280 100644
--- a/src/PaymentServer/Processors/Stripe.hs
+++ b/src/PaymentServer/Processors/Stripe.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module PaymentServer.Processors.Stripe
   ( StripeAPI
@@ -47,7 +48,7 @@ import Web.Stripe.Error
   , StripeErrorType(InvalidRequest, APIError, ConnectionFailure, CardError)
   )
 import Web.Stripe.Types
-  ( Charge(Charge, chargeMetaData)
+  ( Charge(Charge, chargeId)
   , MetaData(MetaData)
   , Currency
   )
@@ -70,6 +71,7 @@ import PaymentServer.Persistence
   ( Voucher
   , VoucherDatabase(payForVoucher)
   , PaymentError(AlreadyPaid, PaymentFailed)
+  , ProcessorResult
   )
 
 data Acknowledgement = Ok
@@ -149,7 +151,7 @@ withSuccessFailureMetrics attemptCount successCount op = do
 charge :: VoucherDatabase d => StripeConfig -> d -> Charges -> Handler Acknowledgement
 charge stripeConfig d (Charges token voucher amount currency) = do
   currency' <- getCurrency currency
-  result <- liftIO ((payForVoucher d voucher (completeStripeCharge currency')) :: IO (Either PaymentError Charge))
+  result <- liftIO ((payForVoucher d voucher (completeStripeCharge currency')) :: IO ProcessorResult)
   case result of
     Left AlreadyPaid ->
       throwError voucherAlreadyPaid
@@ -157,8 +159,7 @@ charge stripeConfig d (Charges token voucher amount currency) = do
       liftIO $ print "Stripe createCharge failed:"
       liftIO $ print msg
       throwError . errorForStripeType $ errorType
-    Right Charge { chargeMetaData = metadata } ->
-      checkVoucherMetadata metadata
+    Right chargeId -> return Ok
     where
       getCurrency :: Text -> Handler Currency
       getCurrency maybeCurrency =
@@ -167,30 +168,20 @@ charge stripeConfig d (Charges token voucher amount currency) = do
           Nothing -> throwError unsupportedCurrency
 
       tokenId = TokenId token
-      completeStripeCharge :: Currency -> IO (Either PaymentError Charge)
+      completeStripeCharge :: Currency -> IO ProcessorResult
       completeStripeCharge currency' = do
-        result <- (stripe stripeConfig charge) :: IO (Either StripeError Charge)
+        result <- stripe stripeConfig charge
         case result of
           Left any ->
             return . Left $ PaymentFailed any
-          Right any ->
-            return . Right $ any
+          Right (Charge { chargeId }) ->
+            return . Right $ chargeId
           where
           charge =
             createCharge (Amount amount) currency'
             -&- tokenId
             -&- MetaData [("Voucher", voucher)]
 
-      checkVoucherMetadata :: MetaData -> Handler Acknowledgement
-      checkVoucherMetadata metadata =
-        -- verify that we are getting the same metadata that we sent.
-        case metadata of
-          MetaData [("Voucher", v)] ->
-            if v == voucher
-            then return Ok
-            else throwError voucherCodeMismatch
-          _ -> throwError voucherCodeNotFound
-
       -- "Invalid request errors arise when your request has invalid parameters."
       errorForStripeType InvalidRequest    = internalServerError
 
@@ -211,7 +202,6 @@ charge stripeConfig d (Charges token voucher amount currency) = do
 
       serviceUnavailable  = jsonErr 503 "Service temporarily unavailable"
       internalServerError = jsonErr 500 "Internal server error"
-      voucherCodeMismatch = jsonErr 500 "Voucher code mismatch"
       unsupportedCurrency = jsonErr 400 "Invalid currency specified"
       voucherCodeNotFound = jsonErr 400 "Voucher code not found"
       stripeChargeFailed  = jsonErr 400 "Stripe charge didn't succeed"
diff --git a/test/Persistence.hs b/test/Persistence.hs
index f5af37807dfa6a015c5759580c07218400d48f43..ba91eecc7ca421f674ea7d9d94f65f99a61ccd51 100644
--- a/test/Persistence.hs
+++ b/test/Persistence.hs
@@ -38,13 +38,22 @@ import System.Directory
 
 import qualified Database.SQLite.Simple as Sqlite
 
+import Web.Stripe.Types
+  ( ChargeId(ChargeId)
+  )
+import Web.Stripe.Error
+  ( StripeErrorType(CardError)
+  , StripeError(StripeError)
+  )
+
 import PaymentServer.Persistence
   ( Voucher
   , Fingerprint
   , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint, DatabaseUnavailable)
-  , PaymentError(AlreadyPaid)
+  , PaymentError(AlreadyPaid, PaymentFailed)
   , VoucherDatabase(payForVoucher, redeemVoucher, redeemVoucherWithCounter)
   , VoucherDatabaseState(SQLiteDB)
+  , ProcessorResult
   , memory
   , sqlite
   , upgradeSchema
@@ -70,14 +79,24 @@ anotherVoucher = "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz"
 fingerprint = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
 anotherFingerprint = "cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc"
 
+aChargeId :: ChargeId
+aChargeId = ChargeId "abc"
+
 -- Mock a successful payment.
-paySuccessfully :: IO ()
-paySuccessfully = return ()
+paySuccessfully :: IO ProcessorResult
+paySuccessfully = return . Right $ aChargeId
 
 -- Mock a failed payment.
-failPayment :: IO ()
+failPayment :: IO ProcessorResult
 failPayment = throwIO ArbitraryException
 
+-- Mock a payment that fails at the processor rather than with an IO
+-- exception.
+aStripeError :: StripeError
+aStripeError = StripeError CardError "Card rejected because reasons" Nothing Nothing Nothing
+failPaymentProcessing :: IO ProcessorResult
+failPaymentProcessing = return $ Left $ PaymentFailed aStripeError
+
 -- | Create a group of tests related to voucher payment and redemption.
 makeVoucherPaymentTests
   :: VoucherDatabase d
@@ -96,13 +115,13 @@ makeVoucherPaymentTests label makeDatabase =
   , testCase "paid for" $ do
       connect <- makeDatabase
       conn <- connect
-      () <- payForVoucher conn voucher paySuccessfully
+      Right _ <- payForVoucher conn voucher paySuccessfully
       result <- redeemVoucher conn voucher fingerprint
       assertEqual "redeeming paid voucher" (Right True) result
   , testCase "allowed double redemption" $ do
       connect <- makeDatabase
       conn <- connect
-      () <- payForVoucher conn voucher paySuccessfully
+      Right _ <- payForVoucher conn voucher paySuccessfully
       let redeem = redeemVoucher conn voucher fingerprint
       first <- redeem
       second <- redeem
@@ -111,7 +130,7 @@ makeVoucherPaymentTests label makeDatabase =
   , testCase "disallowed double redemption" $ do
       connect <- makeDatabase
       conn <- connect
-      () <- payForVoucher conn voucher paySuccessfully
+      Right _ <- payForVoucher conn voucher paySuccessfully
       let redeem = redeemVoucher conn voucher
       first <- redeem fingerprint
       second <- redeem (Text.cons 'a' $ Text.tail fingerprint)
@@ -120,7 +139,7 @@ makeVoucherPaymentTests label makeDatabase =
   , testCase "allowed redemption varying by counter" $ do
       connect <- makeDatabase
       conn <- connect
-      () <- payForVoucher conn voucher paySuccessfully
+      Right _ <- payForVoucher conn voucher paySuccessfully
       let redeem = redeemVoucherWithCounter conn voucher
       first <- redeem fingerprint 0
       second <- redeem anotherFingerprint 1
@@ -129,12 +148,20 @@ makeVoucherPaymentTests label makeDatabase =
   , testCase "disallowed redemption varying by counter but not fingerprint" $ do
       connect <- makeDatabase
       conn <- connect
-      () <- payForVoucher conn voucher paySuccessfully
+      Right _ <- payForVoucher conn voucher paySuccessfully
       let redeem = redeemVoucherWithCounter conn voucher
       first <- redeem fingerprint 0
       second <- redeem fingerprint 1
       assertEqual "redeemed with counter 0" (Right True) first
       assertEqual "redeemed with counter 1" (Left DuplicateFingerprint) second
+  , testCase "pay with processor error" $ do
+      connect <- makeDatabase
+      conn <- connect
+      actual <- payForVoucher conn voucher failPaymentProcessing
+      let expected = Left $ PaymentFailed aStripeError
+      assertEqual "failing payment processing for a voucher" expected actual
+      result <- redeemVoucher conn voucher fingerprint
+      assertEqual "redeeming voucher with failed payment" (Left NotPaid) result
   , testCase "pay with exception" $ do
       connect <- makeDatabase
       conn <- connect
@@ -146,7 +173,7 @@ makeVoucherPaymentTests label makeDatabase =
       connect <- makeDatabase
       conn <- connect
       let pay = payForVoucher conn voucher paySuccessfully
-      () <- pay
+      Right _ <- pay
       payResult <- try pay
       assertEqual "double-paying for a voucher" (Left AlreadyPaid) payResult
       redeemResult <- redeemVoucher conn voucher fingerprint
@@ -163,15 +190,15 @@ makeVoucherPaymentTests label makeDatabase =
         withAsync anotherPayment $ \p2 -> do
           waitBoth p1 p2
 
-      assertEqual "Both payments should succeed" ((), ()) result
+      assertEqual "Both payments should succeed" (Right aChargeId, Right aChargeId) result
   , testCase "concurrent redemption" $ do
       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
+      Right _ <- payForVoucher connA voucher paySuccessfully
+      Right _ <- 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.