libpq: another command in progress

[brandon-leapyear]

#1199 is marked done, but we still saw an instance of this error on persistent-postgresql-2.13.5.0.

#1199 mentioned an issue in postgresql-simple, but I commented that it's unrelated, because persistent uses its own transaction logic: haskellari/postgresql-simple#69 (comment)

I was able to make a repro for postgresql-simple that fails with postgresql-simple, but making an equivalent repro using persistent-postgresql works fine:

{-# LANGUAGE OverloadedStrings, TypeApplications #-}

import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Control.Monad.Reader (ReaderT (..), runReaderT)
import Database.Persist.Postgresql
import Database.Persist.Sql
import UnliftIO.Async (race)
import UnliftIO.Concurrent (threadDelay)

main :: IO ()
main =
  runNoLoggingT . withPostgresqlConn "..." $ \conn ->
    (`runSqlConn` conn) $ do
      res <- race (threadDelay 1000000) (rawSql "select pg_sleep(5)" [])
      case res of
        Left () -> liftIO $ putStrLn "Timed out."
        Right [Single PersistNull] -> liftIO $ putStrLn "Done."
        Right _ -> error "Impossible."
      rawSql "select 1" [] >>= liftIO . print @[Single PersistValue]

So it seems like something else is causing this libpq error other than the naive kill-query-mid-transaction.

cc @codygman