diff --git a/src/PaymentServer/Persistence.hs b/src/PaymentServer/Persistence.hs index b11ad9d0b0629ef73d2ba8ae340f3ba1e5b5d3c3..572fd16755a7357e29054f0e8dac40aa544b2864 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