Skip to content

Instantly share code, notes, and snippets.

@tfausak

tfausak/Dockerfile

Last active Mar 11, 2021
Embed
What would you like to do?
Exhibits the bug from this issue: https://github.com/yesodweb/persistent/issues/1199.

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)

https://github.com/yesodweb/persistent/issues/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.


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

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
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)
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