From ff243f7a79192471960aac2bd17282e47f271ece Mon Sep 17 00:00:00 2001
From: Jean-Paul Calderone <exarkun@twistedmatrix.com>
Date: Thu, 10 Sep 2020 16:21:18 -0400
Subject: [PATCH] Handle exceptions during initialization and close the db
---
src/PaymentServer/Persistence.hs | 19 +++++++++++++++----
1 file changed, 15 insertions(+), 4 deletions(-)
diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs
index b11ad9d..572fd16 100644
--- a/src/PaymentServer/Persistence.hs
+++ b/src/PaymentServer/Persistence.hs
@@ -332,15 +332,26 @@ insertVoucherAndFingerprint dbConn (voucher, counter) fingerprint =
sqlite :: Text -> IO VoucherDatabaseState
sqlite path =
let
- connect :: IO Sqlite.Connection
- connect = do
- dbConn <- Sqlite.open (unpack path)
+ initialize :: Sqlite.Connection -> IO ()
+ initialize dbConn = do
let exec = Sqlite.execute_ dbConn
exec "PRAGMA busy_timeout = 1000"
exec "PRAGMA foreign_keys = ON"
Sqlite.withExclusiveTransaction dbConn $ do
exec "CREATE TABLE IF NOT EXISTS vouchers (id INTEGER PRIMARY KEY, name TEXT UNIQUE)"
exec "CREATE TABLE IF NOT EXISTS redeemed (id INTEGER PRIMARY KEY, voucher_id INTEGER, counter INTEGER, fingerprint TEXT, FOREIGN KEY (voucher_id) REFERENCES vouchers(id))"
- return dbConn
+
+ cleanup :: Sqlite.Connection -> Sqlite.SQLError -> IO ()
+ cleanup dbConn e = do
+ -- Don't leak the open connection.
+ Sqlite.close dbConn
+ -- Propagate the exception
+ throwIO e
+
+ connect :: IO Sqlite.Connection
+ connect = do
+ dbConn <- Sqlite.open (unpack path)
+ catch (initialize dbConn) (cleanup dbConn)
+ return dbConn
in
return . SQLiteDB $ connect
--
GitLab