Skip to content

Instantly share code, notes, and snippets.

Last active July 13, 2023 21:18
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 3 You must be signed in to fork a gist
  • Save tfausak/ee019365d628a36fc3480d30d38bed0c to your computer and use it in GitHub Desktop.
Save tfausak/ee019365d628a36fc3480d30d38bed0c to your computer and use it in GitHub Desktop.
Exhibits a libpq bug.

This script shows an error with the persistent-postgresql Haskell library. It reliably crashes with this output:

libpq-error: libpq: failed (another command is already in progress)


As far as I can tell this only affects PostgreSQL while using a pool. If withPostgresqlPool is changed to withPostgresqlConn, this error does not happen.

Switching from forkIO to async appears to make this problem go away.

I cannot reproduce this problem using postgresql-simple and resource-pool directly.

I don't get the error if I use rawSql instead of rawExecute.

version: '3.7'
build: .
command: stack build --file-watch --exec libpq-error
- postgres
PGHOST: postgres
PGUSER: postgres
STACK_ROOT: $PWD/.stack/root
STACK_WORK: .stack/work
init: true
tty: true
- .:$PWD
working_dir: $PWD
image: postgres:11.11
FROM haskell:8.10
RUN apt-get update && apt-get install --yes libpq-dev
ARG USER=haskell
RUN useradd --create-home "$USER"
build-type: Simple
cabal-version: >= 1.2
name: libpq-error
version: 2021.3.10
executable libpq-error
build-depends: base, monad-logger, persistent-postgresql
main-is: Main.hs
{-# 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."
allow-different-user: true
compiler: ghc-8.10.2
resolver: lts-17.5
system-ghc: true
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment