hpqtypes 1.13.0.0 → 1.13.0.1

raw patch · 3 files changed

+20/−6 lines, 3 files

Files

• CHANGELOG.md +4/−0
• hpqtypes.cabal +1/−1
• src/Database/PostgreSQL/PQTypes/Internal/State.hs +15/−5

@@ -1,3 +1,7 @@+# hpqtypes-1.13.0.1 (2025-11-27)+* Fix a bug in `initConnectionState` and `finalizeConnectionState` that could+  lead to leaking connections.+ # hpqtypes-1.13.0.0 (2025-11-26) * Drop support for GHC < 9.2. * Include time spent executing queries in `ConnectionStats`.

@@ -1,7 +1,7 @@ cabal-version:       3.0 build-type:          Simple name:                hpqtypes-version:             1.13.0.0+version:             1.13.0.1 synopsis:            Haskell bindings to libpqtypes  description:         Efficient and easy-to-use bindings to (slightly modified)

@@ -46,9 +46,13 @@ -- operation, but if these queries are interrupted with an asynchronous -- exception, then a connection is leaked, so they need to be run with -- asynchronous exceptions hard masked with uninterruptibleMask.+--+-- What is more, these queries themselves can throw an exception if e.g. network+-- goes bye-bye and PostgreSQL can't be reached, therefore they need exception+-- handlers themselves so connections don't leak.  initConnectionState-  :: MonadBase IO m+  :: (MonadBase IO m, MonadMask m)   => InternalConnectionSource m cdata   -> ConnectionAcquisitionMode   -> m (ConnectionState cdata)@@ -69,11 +73,14 @@                 ReadWrite -> "READ WRITE"             ]     (conn, cdata) <- takeConnection ics-    _ <- liftBase . uninterruptibleMask_ $ runQueryIO @SQL conn initSql+    _ <- uninterruptibleMask_ $ do+      liftBase (runQueryIO @SQL conn initSql) `catch` \e -> do+        putConnection ics (conn, cdata) (ExitCaseException e)+        throwM e     pure $ Acquired tsIsolationLevel tsPermissions conn cdata  finalizeConnectionState-  :: (HasCallStack, MonadBase IO m)+  :: (HasCallStack, MonadBase IO m, MonadMask m)   => InternalConnectionSource m cdata   -> ExitCase r   -> ConnectionState cdata@@ -84,7 +91,10 @@     let finalizeSql = case ec of           ExitCaseSuccess _ -> "COMMIT"           _ -> "ROLLBACK"-    _ <- liftBase . uninterruptibleMask_ $ runQueryIO @SQL conn finalizeSql+    _ <- uninterruptibleMask_ $ do+      liftBase (runQueryIO @SQL conn finalizeSql) `catch` \e -> do+        putConnection ics (conn, cdata) (ExitCaseException e)+        throwM e     putConnection ics (conn, cdata) ec   Finalized -> error "finalized connection" @@ -202,7 +212,7 @@     Finalized -> error "finalized connection"  initConnectionData-  :: MonadBase IO m+  :: (MonadBase IO m, MonadMask m)   => ConnectionSourceM m   -> ConnectionAcquisitionMode   -> m (ConnectionData m)