Handle exceptions during initialization and close the db

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