Skip to content

Instantly share code, notes, and snippets.

@codygman
Forked from tfausak/Dockerfile
Last active March 10, 2021 22:31
Show Gist options
  • Save codygman/d38a049092301ade8e8e1bb362cac778 to your computer and use it in GitHub Desktop.
Save codygman/d38a049092301ade8e8e1bb362cac778 to your computer and use it in GitHub Desktop.

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)

yesodweb/persistent#1199


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.

version: '3.7'
services:
haskell:
build: .
command: stack build --file-watch --exec libpq-error
depends_on:
- postgres
environment:
PGHOST: postgres
PGUSER: postgres
STACK_ROOT: $PWD/.stack/root
STACK_WORK: .stack/work
init: true
tty: true
volumes:
- .:$PWD
working_dir: $PWD
postgres:
environment:
POSTGRES_HOST_AUTH_METHOD: trust
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"
USER $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, async
ghc-options:
-Weverything
-Wno-all-missed-specialisations
-Wno-implicit-prelude
-Wno-missing-exported-signatures
-Wno-missing-safe-haskell-mode
-Wno-prepositive-qualified-module
-Wno-unsafe
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)
import Control.Concurrent.Async (async)
import Control.Monad (void)
main :: IO ()
main = runStdoutLoggingT . withPostgresqlPool "" 1 $ \ pool -> liftIO $ do
threadId <- forkIO
. void
-- TODO what does async do exactly that makes ResourceT magically work correctly?
-- maybe it's the doFork here:
-- https://hackage.haskell.org/package/async-2.2.3/docs/src/Control.Concurrent.Async.html#asyncUsing
-- or maybe it's rawForkIO here
-- https://hackage.haskell.org/package/async-2.2.3/docs/src/Control.Concurrent.Async.html#rawForkIO
-- TODO can we inline pieces to see if one fixes the issue in isolation?
. async
. 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