Postgres connections are returned to Pool too quickly

[codygman]

When a query (especially long running) is interrupted while using a connection from a Pool, that connection is almost immediately returned to the pool even if the query is still running on that connection.

Another async consumer picks up the connection out of the pool to do it's work and you get:

libpq: failed (another command is already in progress

The gist of it is:

• Create a connection pool of 1
• In another thread acquire the connection from the pool doing some long running query like 10000 inserts
• Kill that thread before it finishes
• immediately try doing some other query using that same pool

I've created a reproducable repo here that just requires stack and docker (for the postgres server):

https://github.com/codygman/persistent-postgresql-query-in-progress-repro/blob/master/src/Main.hs

[codygman]

I originally thought this was haskellari/postgresql-simple#69 but after testing that doesn't seem to be the case.

Also related is #981 but the conclusions there seem to indicate you should be safe if you're using a pool.

[codygman]

It seems that RelException does come up after using Debug.trace in unsafeAcquireSqlConnFromPool in this commit:

relType: ReleaseNormal
relType: ReleaseNormal
killed thread
relType: ReleaseException
result: Left libpq: failed (another command is already in progress

[codygman]

And now for some real confusion... The issue still happens after calling Pool.destroyAllResources. I'm either really misunderstanding something or this is a pretty big issue.

This commit: https://github.com/codygman/persistent-postgresql-query-in-progress-repro/blob/958e66963c0ad9761149f7ef97fd5ec0d7322f73/src/Main.hs#L29

[codygman]

I'm wondering if this could be related to bos/pool#32.

[codygman]

I'm fairly confident this issue is something to do with persistent-postgresql since this equivalent code only using Data.Pool and Postgresql-simple doesn't have the same issue:

main :: IO ()
main = do

  -- I started a postgres server with:
  -- docker run --rm --name some-postgres -p 5432:5432 -e POSTGRES_PASSWORD=secret postgres

  pool <- Pool.createPool (PGS.connect PGS.defaultConnectInfo { PGS.connectPassword = "secret" } ) PGS.close 1 10 1
  
  threadId <- Concurrent.forkIO $ do
      Pool.withResource pool $ \conn -> do
        let numThings :: Int = 100000000
        putStrLn $ "start inserting " <> show numThings <> " things"
        Monad.forM_ [1 .. numThings] $ \_ ->  do
          PGS.execute_ conn "insert into foo values(1);"


  putStrLn "waiting for insert thread to make progress"
  Concurrent.threadDelay 5000000
  Monad.void $ Concurrent.killThread threadId
  putStrLn "killing insert thread"

  Pool.withResource pool $ \conn -> do
    PGS.execute_ conn "insert into foo values(1);"

  putStrLn "done"

https://github.com/codygman/persistent-postgresql-query-in-progress-repro/blob/3e84e282ccda34f4ca465a8605706254ca323234/src/Main.hs#L37

[codygman]

It looks like Persistent does the right thing here by catching any exceptions when destroying the pool but this is the only thing I could imagine being wrong that would exhibit this behavior:

createSqlPoolWithConfig mkConn config = do
    logFunc <- askLoggerIO
    -- Resource pool will swallow any exceptions from close. We want to log
    -- them instead.
    let loggedClose :: backend -> IO ()
        loggedClose backend = close' backend `UE.catchAny` \e -> runLoggingT
          (logError $ T.pack $ "Error closing database connection in pool: " ++ show e)
          logFunc
    liftIO $ createPool 
        (mkConn logFunc) 
        loggedClose 
        (connectionPoolConfigStripes config)
        (connectionPoolConfigIdleTimeout config)
        (connectionPoolConfigSize config)

persistent/persistent/Database/Persist/Sql/Run.hs

Line 227 in f82154f

-- Resource pool will swallow any exceptions from close. We want to log

Especially since Postgresql-simple doesn't seem affected.

[codygman]

~~Wow... I just verified that the use of UE.catchAny is causing this issue locally by removing it from the local copy of persistent I'm using with my test code. Now to figure out why in the world that could be. ~~

Edit: Nevermind... I left Pool.destroyAllResources from earlier.

However as I noted above Pool.destroyAllResources being called didn't prevent the error. Removing the UE.catchAny call did fix Pool.destroyAllResources working as expected.

[codygman]

This very much seems like it could be related:

snoyberg/conduit#425

Also today I tried layering on some of the extra exception handling that Persistent does to see if I could get to the error from my postgresql-simple base:

https://github.com/codygman/persistent-postgresql-query-in-progress-repro/blob/41ebcea31c2caf3e7e40d57f9385a80f5982f071/src/Main.hs#L33

I wasn't able too though... The above issue makes me wonder if adding in resourceT stuff will cause the issue to show up though.

[tfausak]

I work with @codygman and am also looking into this issue. I was able to create a slightly smaller reproduction of the bug, which you can find here: https://gist.github.com/tfausak/ee019365d628a36fc3480d30d38bed0c

{-# language OverloadedStrings #-}

import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStdoutLoggingT)
import Database.Persist.Postgresql (rawExecute, runSqlPool, withPostgresqlPool)

main :: IO ()
main = runStdoutLoggingT . withPostgresqlPool "" 1 $ \ pool -> liftIO $ do
  threadId <- forkIO
    . runStdoutLoggingT
    $ runSqlPool (rawExecute "select pg_sleep(1)" []) pool

  putStrLn "Waiting for the thread to start ..."
  threadDelay 500000

  putStrLn "Killing the thread ..."
  killThread threadId

  -- Wait around a little bit for the error to be output.
  threadDelay 500000
  putStrLn "Done."

I do not see the same behavior when using withPostgresqlConn, which suggests the bug is somewhere in the handling of connection pools.

Also if I switch from forkIO to async, the problem goes away.

[codygman]

Also if I switch from forkIO to async, the problem goes away.

It actually even works if you call async within the forkIO which I found surprising:

https://gist.github.com/codygman/d38a049092301ade8e8e1bb362cac778

[codygman]

Perusing through issues in conduit (the resourcet repo is in there) I also found a comment from @snoyberg that might be helpful here:

The issue is that, if you use forkIO, the child thread isn't registered as using the internal state. Then, when the parent thread stops using the internal state, it will automatically clean up all of the resources still in the state, even though the child thread may be using them.

When you use resourceForkIO instead, it increments a counter to let the parent thread know that someone else is using the state. Only when the last thread finally stops using the step will the counter go down to 0 and the resources be cleaned up, when we know that no one is using them.

snoyberg/conduit#441 (comment)

This makes me wonder how much Persistent could do to prevent such an issue from happening though... or if consumers just always have to be aware of this issue.

[codygman]

The more I think about this the more I think about masking. That led me to try:

runStdoutLoggingT . withPostgresqlPool "" 1 $ \ pool -> liftIO $ do
  threadId <- uninterruptibleMask_ $ forkIOWithUnmask $ \unmask ->
    unmask (void . runStdoutLoggingT $ runSqlPool (rawExecute "select pg_sleep(1)" []) pool)
      `finally` putStrLn "cleanup in child thread"

That didn't resolve the issue but it was inspired by revisiting the forkIOWithUnmask section of Asynchronous Exception Handling in Haskell that says:

This unmask action does not restore a previous masking state. Instead, it ensures that all masking is disabled. This is usually the behavior desired in the forked thread, since we want the forked thread to respond to async exceptions we send it, even if the parent thread is in a masked state.

[codygman]

uninterruptibleMask_ does seem to fix it, though the docs say to use this with care. Condensing everything down:

Working code with uninterruptibleMask:

{-# language OverloadedStrings #-}

import Control.Concurrent (forkIO, killThread, threadDelay)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStdoutLoggingT)
import Database.Persist.Postgresql (rawExecute, runSqlPool, withPostgresqlPool)
import Control.Exception

main :: IO ()
main = uninterruptibleMask_ . runStdoutLoggingT . withPostgresqlPool "" 1 $ \ pool -> liftIO $ do
  threadId <- forkIO
    . runStdoutLoggingT
    $ runSqlPool (rawExecute "select pg_sleep(1)" []) pool

  putStrLn "Waiting for the thread to start ..."
  threadDelay 500000

  putStrLn "Killing the thread ..."
  killThread threadId

  -- Wait around a little bit for the error to be output.
  threadDelay 500000
  putStrLn "Done."

This uncovers an error with the Query that returns a result it wasn't expecting:

libpq-error: QueryError {qeMessage = "execute resulted in Col 1-column result", qeQuery = "select pg_sleep(1)"}

[codygman]

A lot of related discussion here: fpco/safe-exceptions#3