@@ -0,0 +1,142 @@
1+# PostgreSQL connection pool
3+Let's see how we can write a simple web application that uses a
4+[PostgreSQL](https://www.postgresql.org/) database to store simple textual
5+messages, just like in the SQLite cookbook recipe. The main difference,
6+besides the database technology, is that in this example we will be using
7+a pool of connections to talk to the database server. The pool abstraction
8+will be provided by the
9+[resource-pool](https://hackage.haskell.org/package/resource-pool) library.
11+As usual, we start with a little bit of throat clearing.
14+{-# LANGUAGE DataKinds #-}
15+{-# LANGUAGE OverloadedStrings #-}
16+{-# LANGUAGE TypeOperators #-}
17+import Data.ByteString (ByteString)
18+import Control.Concurrent
19+import Control.Exception (bracket)
20+import Control.Monad.IO.Class
22+import Database.PostgreSQL.Simple
23+import Network.HTTP.Client (newManager, defaultManagerSettings)
24+import Network.Wai.Handler.Warp
28+type DBConnectionString = ByteString
31+We will only care about a single type here, the messages. We want to
32+be able to add a new one and retrieve them all, using two different
38+type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
39+ :<|> Get '[JSON] [Message]
45+We proceed with a simple function for creating a table
46+for holding our messages if it doesn't already exist, given
47+a PostgreSQL connection string.
50+initDB :: DBConnectionString -> IO ()
51+initDB connstr = bracket (connectPostgreSQL connstr) close $ \conn -> do
53+ "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
57+Next, our server implementation. It will be parametrised (take as
58+argument) by the pool of database connections that handlers can use to
59+talk to the PostgreSQL database. The resource pool abstraction allows us
60+to flexibly set up a whole bunch of PostgreSQL connections tailored to our
61+needs and then to forget about it all by simply asking for a connection
64+The handlers are straighforward. One takes care of inserting a new
65+value in the database while the other fetches all messages and returns
66+them. We also provide a function for serving our web app given a PostgreSQL
67+connection pool, which simply calls servant-server's `serve` function.
70+server :: Pool Connection -> Server API
71+server conns = postMessage :<|> getMessages
73+ where postMessage :: Message -> Handler NoContent
75+ liftIO . withResource conns $ \conn ->
77+ "INSERT INTO messages VALUES (?)"
81+ getMessages :: Handler [Message]
82+ getMessages = fmap (map fromOnly) . liftIO $
83+ withResource conns $ \conn ->
84+ query_ conn "SELECT msg FROM messages"
86+runApp :: Pool Connection -> IO ()
87+runApp conns = run 8080 (serve api $ server conns)
90+We will also need a function for initialising our connection pool.
91+`resource-pool` is quite configurable, feel free to wander in
92+[its documentation](https://hackage.haskell.org/package/resource-pool)
93+to gain a better understanding of how it works and what the configuration
94+knobs are. I will be using some dummy values in this example.
97+initConnectionPool :: DBConnectionString -> IO (Pool Connection)
98+initConnectionPool connStr =
99+ createPool (connectPostgreSQL connStr)
102+ 60 -- unused connections are kept open for a minute
103+ 10 -- max. 10 connections open per stripe
106+Let's finally derive some clients for our API and use them to
107+insert two messages and retrieve them in `main`, after setting up
108+our pool of database connections.
111+postMsg :: Message -> ClientM NoContent
112+getMsgs :: ClientM [Message]
113+postMsg :<|> getMsgs = client api
117+ -- you could read this from some configuration file,
118+ -- environment variable or somewhere else instead.
119+ -- you will need to either change this connection string OR
120+ -- set some environment variables (see
121+ -- https://www.postgresql.org/docs/9.5/static/libpq-envars.html)
122+ -- to point to a running PostgreSQL server for this example to work.
124+ pool <- initConnectionPool connStr
126+ mgr <- newManager defaultManagerSettings
127+ bracket (forkIO $ runApp pool) killThread $ \_ -> do
128+ ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
135+This program prints `Right ["hello","world"]` the first time it is executed,
136+`Right ["hello","world","hello","world"]` the second time and so on.
138+You could alternatively have the handlers live in `ReaderT (Pool Connection)`
139+and access the pool using e.g `ask`, but this would be more complicated
140+than simply taking the pool as argument.
142+The entire source for this example is available [here](...).