A PostgreSQL connection pool in Haskell

In order to create a connection pool we need two things:

1. a library which creates connections to PostgreSQL,
2. a connection manager which maintains the connections.

For 1. we will use the postgresql-simple library and for 2. we will take advantage of the resource-pool. For our test purposes we can create a small table with some data:

CREATE TABLE films (
id       integer PRIMARY KEY,
title    varchar(20) NOT NULL
);

And some data:

INSERT INTO films VALUES (1, 'Star Trek')
INSERT INTO films VALUES (2, 'Star Wars')
INSERT INTO films VALUES (3, 'Stardust')

First we need to define properties which will be used by our PostgreSQL connections. In my case I have the user “testuser” with password “testuser” and database “testdb”.

connectionInfo ∷ ConnectInfo
connectionInfo = defaultConnectInfo {
connectHost = "localhost"
, connectPort = 5432
, connectUser = "testuser"
, connectPassword = "testuser"
, connectDatabase = "testdb" }

And this is all we need to create a connection pool with createPool:

myPool ∷ IO (Pool Connection)
myPool = createPool (connect connectionInfo) close 1 10 10

The first argument is a function which creates new connections. The second argument is a function which closes the connections. The rest of the arguments are as follows:

• subpools - the pool can have several independent pools, in our case it’s 1,
• the maximum idle time of a connection (in seconds) before it is closed (in our case it’s 10),
• the maximum amount of connections in the pool (in our case max. 10 connections).

That’s it, we are done. We can test the connection pool with the following functions:

printMovies ∷ Connection -> IO ()
printMovies conn = do
    x <- query_ conn "select title from public.films"
    let films = map fromOnly (x ∷ [Only String])
    print films

listMovies ∷ Pool Connection -> IO ()
listMovies pool = do
    withResource pool printMovies

We can define a simple function which prints the current number of connections in PostgreSQL:

connectionCount ∷ IO ()
connectionCount = do
    conn <- connect connectionInfo
    x <- query_ conn "SELECT COUNT (*) FROM pg_stat_activity"
    let c = fromOnly ∘ head $ (x ∷ [Only Integer])
    close conn
   print c

We can run these functions in multiple threads to check that the connection pool works:

main ∷ IO ()
main = do
    pool <- myPool
    let x = forkIO $ listMovies pool
    forM [1‥100] $ const x
    wait 5
    connectionCount
    wait 10
    connectionCount
    destroyAllResources pool
  where wait s = threadDelay (10^6 * s)

We get the following output:

"11"
"1"

Note: We have 10 active connections + the connection in connectionCount through which we queried the connections on PostgreSQL. After 10 seconds have elapsed we only have 1 open connection (the connectionCount’s connection).