Remove custom reference counting logic.

[dmjio]

This patch removes additional reference counting logic in C that normally the GHC RTS would handle internally by the use of finalizers. I believe this additional reference counting logic is responsible for the bugs seen when compiling with -threaded in #35 when working with resource-pool.

The problem

On later versions of GHC (8.6.x and above), when executables are compiled with -threaded and run with +RTS -N -RTS a double free error can occur. I was not able to reproduce this error without using -threaded on the aforementioned GHC versions. This problem manifests itself in the below code (see #35 as well).

module Main ( main ) where
import qualified Data.Pool as Pool
import qualified Database.HDBC as Sql
import qualified Database.HDBC.PostgreSQL as Postgres

main :: IO ()
main = do
  putStr $ unlines
    [ "This program will attempt to crash."
    , "It will print out attempt numbers as it goes."
    , "Press Ctrl-C to exit."
    ]
  attempt 1

attempt :: Int -> IO ()
attempt n = if n > 32 then fail "Failed to crash!" else do
  print n
  pool <- Pool.createPool (Postgres.connectPostgreSQL "") Sql.disconnect 1 1 1
  Pool.withResource pool . const $ pure ()
  attempt $ n + 1

Error

[nix-shell:~/Desktop/hdbc-code]$ ghc -threaded Foo.hs -o foo && ./foo +RTS -N -RTS
[1 of 1] Compiling Main             ( Foo.hs, Foo.o )
Linking foo ...
This program will attempt to crash.
It will print out attempt numbers as it goes.
Press Ctrl-C to exit.
1
2
3
4
5
6
7
8
9
10
11
foo(57704,0x70000622e000) malloc: *** error for object 0x1000000000000000: pointer being freed was not allocated
foo(57704,0x70000622e000) malloc: *** set a breakpoint in malloc_error_break to debug
Abort trap: 6

The patch

This PR does the following:

• Uses safe instead of unsafe calls.
• Rely solely on the GHC RTS to call libpq finalizers when refs die.
• Remove manual calls to connection close.
• Removes spurious whitespace.
• Removes all custom C code that does additional ref counting bookkeeping.

Test cases

Was able to use an old version of QuickCheck to compile testpack and run the hdbc-postgresql test suite named runtests to produce 0 errors (compiling with -threaded and using all available cores via-N on GHC 8.8.4).

$ cabal run runtests -- +RTS -N -RTS
Up to date
+-------------------------------------------------------------------------
| Testing HDBC database module: postgresql, bound to client: 11.8
| Proxied driver: postgresql, bound to version: 3
| Connected to server version: 120003
+-------------------------------------------------------------------------

Cases: 68  Tried: 68  Errors: 0  Failures: 0

Furthermore, this seems to fix the following issues in orville and #35 , when used with @bos 's resource-pool package.

-- Foo.hs 
module Main ( main ) where
import qualified Data.Pool as Pool
import qualified Database.HDBC as Sql
import qualified Database.HDBC.PostgreSQL as Postgres

main :: IO ()
main = do
  putStr $ unlines
    [ "This program will attempt to crash."
    , "It will print out attempt numbers as it goes."
    , "Press Ctrl-C to exit."
    ]
  attempt 1

attempt :: Int -> IO ()
attempt n = if n > 32 then fail "Failed to crash!" else do
  print n
  pool <- Pool.createPool (Postgres.connectPostgreSQL "") Sql.disconnect 1 1 1
  Pool.withResource pool . const $ pure ()
  attempt $ n + 1

result

[nix-shell:~/Desktop/hdbc-code]$ ghc -threaded Foo.hs -o foo && ./foo +RTS -N -RTS && echo $?
[1 of 1] Compiling Main             ( Foo.hs, Foo.o )
Linking foo ...
This program will attempt to crash.
It will print out attempt numbers as it goes.
Press Ctrl-C to exit.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
foo: user error (Failed to crash!)

and for orville

-- Main.hs
{-# LANGUAGE OverloadedStrings #-}
module Main
  ( main
  ) where

import           Control.Concurrent                     (threadDelay)
import qualified Database.Orville.PostgreSQL            as O
import           Database.Orville.PostgreSQL.Connection (createConnectionPool)
import           System.Environment                     (getEnv)

main :: IO ()
main = run

run :: IO ()
run = do
  poolConn <- createConnectionPool 1 100000000 1 "host=localhost dbname=postgres port=5432 dbname=postgres"
  O.runOrville (O.migrateSchema []) $ O.newOrvilleEnv poolConn
  threadDelay 10000000

result

[nix-shell:~/Desktop/hdbc-code]$ ghc -threaded Main.hs -o main && ./main +RTS -N -RTS && echo $?
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking main ...
0

This code is obviously very sensitive and needs a lot of eyes on it before this PR can be approved and merged.

[dmjio]

@zenzike was wondering if I could get a review from you on this. I think this approach is sound.

[dmjio]

@jgoerzen would it be possible to get this merged?

[dmjio]

Ping @rsoeldner

[dmjio]

Ping @hesselink, can we get this merged / released as well? Tested with 8.4 up to 8.10

[hesselink]

Thanks! Released as 2.4.0.0