diff --git a/PaymentServer.cabal b/PaymentServer.cabal index 2db7528141b6a7c84896a56430c24acb4cc5fb4d..ad233b8d51579539b5ee8146920761a97681178a 100644 --- a/PaymentServer.cabal +++ b/PaymentServer.cabal @@ -75,6 +75,7 @@ test-suite PaymentServer-tests , tasty-hunit , directory , async + , sqlite-simple , PaymentServer default-language: Haskell2010 diff --git a/misc/load-test.py b/misc/load-test.py index 2144bc6084062c6391bf244b1e7b08e23e42928f..d83af5e718b0e31ae59e7a6ec6a082207ae0f060 100755 --- a/misc/load-test.py +++ b/misc/load-test.py @@ -61,7 +61,7 @@ from twisted.internet.defer import ( PARALLELISM = 50 ITERATIONS = 16 -NUM_TOKENS = 5000 +NUM_TOKENS = 100000 def a_random_token(): diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs index dd30d76a48c86d19af244d27dc1d929a1b941b7b..0c5ff96a6c9f2a7d8699e8c4c758e0061c9f5bc3 100644 --- a/src/PaymentServer/Persistence.hs +++ b/src/PaymentServer/Persistence.hs @@ -5,7 +5,7 @@ module PaymentServer.Persistence ( Voucher , Fingerprint - , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint) + , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint, DatabaseUnavailable) , PaymentError(AlreadyPaid, PaymentFailed) , VoucherDatabase(payForVoucher, redeemVoucher, redeemVoucherWithCounter) , VoucherDatabaseState(MemoryDB, SQLiteDB) @@ -72,6 +72,8 @@ data RedeemError = -- fingerprint. We check for this case to prevent a misbehaving client from -- accidentally creating worthless tokens. | DuplicateFingerprint + -- | The database is too busy right now. Try again later. + | DatabaseUnavailable deriving (Show, Eq) -- | A fingerprint cryptographically identifies a redemption of a voucher. @@ -191,16 +193,21 @@ instance VoucherDatabase VoucherDatabaseState where fingerprint redeemVoucherWithCounter SQLiteDB { connect = connect } voucher fingerprint counter = - bracket connect Sqlite.close $ \conn -> - Sqlite.withExclusiveTransaction conn $ - redeemVoucherHelper - (isVoucherPaid conn) - (getVoucherFingerprint conn) - (getVoucherCounterForFingerprint conn) - (insertVoucherAndFingerprint conn) - voucher - counter - fingerprint + bracket connect Sqlite.close redeemIt `catch` transformBusy + where + redeemIt conn = + Sqlite.withExclusiveTransaction conn $ + redeemVoucherHelper + (isVoucherPaid conn) + (getVoucherFingerprint conn) + (getVoucherCounterForFingerprint conn) + (insertVoucherAndFingerprint conn) + voucher + counter + fingerprint + + transformBusy (Sqlite.SQLError Sqlite.ErrorBusy _ _) = + return . Left $ DatabaseUnavailable -- | Look up the voucher, counter tuple which previously performed a @@ -336,7 +343,7 @@ sqlite path = initialize :: Sqlite.Connection -> IO Sqlite.Connection initialize dbConn = do let exec = Sqlite.execute_ dbConn - exec "PRAGMA busy_timeout = 1000" + exec "PRAGMA busy_timeout = 60000" exec "PRAGMA foreign_keys = ON" Sqlite.withExclusiveTransaction dbConn $ do exec "CREATE TABLE IF NOT EXISTS vouchers (id INTEGER PRIMARY KEY, name TEXT UNIQUE)" diff --git a/src/PaymentServer/Redemption.hs b/src/PaymentServer/Redemption.hs index 6c0cf7bbab8ad85e875fff20826331c9cb6e2e8a..d1735fc648956accc3b0b8579290f984d62e2542 100644 --- a/src/PaymentServer/Redemption.hs +++ b/src/PaymentServer/Redemption.hs @@ -54,6 +54,7 @@ import Servant , Handler , ServerError(errBody, errHeaders) , err400 + , err500 , throwError ) import Servant.API @@ -68,7 +69,7 @@ import Crypto.Hash ) import PaymentServer.Persistence ( VoucherDatabase(redeemVoucherWithCounter) - , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint) + , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint, DatabaseUnavailable) , Fingerprint , Voucher ) @@ -159,7 +160,7 @@ maxCounter = 16 type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result -jsonErr400 reason = err400 +jsonErr err reason = err { errBody = encode reason , errHeaders = [ ("Content-Type", "application/json;charset=utf-8") ] } @@ -192,23 +193,25 @@ retry op = redeem :: VoucherDatabase d => Issuer -> d -> Redeem -> Handler Result redeem issue database (Redeem voucher tokens counter) = if counter < 0 || counter >= maxCounter then - throwError $ jsonErr400 (CounterOutOfBounds 0 maxCounter counter) + throwError $ jsonErr err400 (CounterOutOfBounds 0 maxCounter counter) else do let fingerprint = fingerprintFromTokens tokens result <- liftIO . retry $ redeemVoucherWithCounter database voucher fingerprint counter case result of Left NotPaid -> do - throwError $ jsonErr400 Unpaid + throwError $ jsonErr err400 Unpaid Left AlreadyRedeemed -> do - throwError $ jsonErr400 DoubleSpend + throwError $ jsonErr err400 DoubleSpend Left DuplicateFingerprint -> do - throwError $ jsonErr400 $ OtherFailure "fingerprint already used" + throwError $ jsonErr err400 $ OtherFailure "fingerprint already used" + Left DatabaseUnavailable -> do + throwError $ jsonErr err500 $ OtherFailure "database temporarily unavailable" Right () -> do let result = issue tokens case result of Left reason -> do - throwError $ jsonErr400 $ OtherFailure reason + throwError $ jsonErr err400 $ OtherFailure reason Right (ChallengeBypass key signatures proof) -> return $ Succeeded key signatures proof diff --git a/test/Persistence.hs b/test/Persistence.hs index 7c0f97582c983e8157edd8a5198607ad31800bbb..bd280946a62cf0ed731f5b2297047f0a4ea07705 100644 --- a/test/Persistence.hs +++ b/test/Persistence.hs @@ -36,12 +36,15 @@ import System.Directory ( getTemporaryDirectory ) +import qualified Database.SQLite.Simple as Sqlite + import PaymentServer.Persistence ( Voucher , Fingerprint - , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint) + , RedeemError(NotPaid, AlreadyRedeemed, DuplicateFingerprint, DatabaseUnavailable) , PaymentError(AlreadyPaid) , VoucherDatabase(payForVoucher, redeemVoucher, redeemVoucherWithCounter) + , VoucherDatabaseState(SQLiteDB) , memory , sqlite ) @@ -187,8 +190,31 @@ memoryDatabaseVoucherPaymentTests = makeVoucherPaymentTests "memory" $ do -- | Instantiate the persistence tests for the sqlite3 backend. sqlite3DatabaseVoucherPaymentTests :: TestTree sqlite3DatabaseVoucherPaymentTests = - makeVoucherPaymentTests "sqlite3" $ - do - tempdir <- getTemporaryDirectory - (path, handle) <- openTempFile tempdir "voucher-.db" - return . sqlite . Text.pack $ path + testGroup "" + [ genericTests + , sqlite3Tests + ] + where + makeDatabase = do + tempdir <- getTemporaryDirectory + (path, handle) <- openTempFile tempdir "voucher-.db" + return . sqlite . Text.pack $ path + + genericTests = makeVoucherPaymentTests "sqlite3" makeDatabase + + sqlite3Tests = + testGroup "SQLite3-specific voucher" + [ testCase "database is busy" $ do + getDB <- makeDatabase + db <- getDB + case db of + (SQLiteDB connect) -> do + conn <- connect + -- Tweak the timeout down so the test completes quickly + Sqlite.execute_ conn "PRAGMA busy_timeout = 0" + -- Acquire a write lock before letting the application code run so that + -- the application code is denied the write lock. + Sqlite.withExclusiveTransaction conn $ do + result <- redeemVoucher db voucher fingerprint + assertEqual "Redeeming voucher while database busy" result $ Left DatabaseUnavailable + ]