@@ -0,0 +1,142 @@
1+# PostgreSQL connection pool
2+
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.
10+
11+As usual, we start with a little bit of throat clearing.
12+
13+``` haskell
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
21+import Data.Pool
22+import Database.PostgreSQL.Simple
23+import Network.HTTP.Client (newManager, defaultManagerSettings)
24+import Network.Wai.Handler.Warp
25+import Servant
26+import Servant.Client
27+
28+type DBConnectionString = ByteString
29+```
30+
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
33+endpoints.
34+
35+``` haskell
36+type Message = String
37+
38+type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
39+ :<|> Get '[JSON] [Message]
40+
41+api :: Proxy API
42+api = Proxy
43+```
44+
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.
48+
49+``` haskell
50+initDB :: DBConnectionString -> IO ()
51+initDB connstr = bracket (connectPostgreSQL connstr) close $ \conn -> do
52+ execute_ conn
53+ "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
54+ return ()
55+```
56+
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
62+using `withResource`.
63+
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.
68+
69+``` haskell
70+server :: Pool Connection -> Server API
71+server conns = postMessage :<|> getMessages
72+
73+ where postMessage :: Message -> Handler NoContent
74+ postMessage msg = do
75+ liftIO . withResource conns $ \conn ->
76+ execute conn
77+ "INSERT INTO messages VALUES (?)"
78+ (Only msg)
79+ return NoContent
80+
81+ getMessages :: Handler [Message]
82+ getMessages = fmap (map fromOnly) . liftIO $
83+ withResource conns $ \conn ->
84+ query_ conn "SELECT msg FROM messages"
85+
86+runApp :: Pool Connection -> IO ()
87+runApp conns = run 8080 (serve api $ server conns)
88+```
89+
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.
95+
96+``` haskell
97+initConnectionPool :: DBConnectionString -> IO (Pool Connection)
98+initConnectionPool connStr =
99+ createPool (connectPostgreSQL connStr)
100+ close
101+ 2 -- stripes
102+ 60 -- unused connections are kept open for a minute
103+ 10 -- max. 10 connections open per stripe
104+```
105+
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.
109+
110+``` haskell
111+postMsg :: Message -> ClientM NoContent
112+getMsgs :: ClientM [Message]
113+postMsg :<|> getMsgs = client api
114+
115+main :: IO ()
116+main = do
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.
123+ let connStr = ""
124+ pool <- initConnectionPool connStr
125+ initDB connStr
126+ mgr <- newManager defaultManagerSettings
127+ bracket (forkIO $ runApp pool) killThread $ \_ -> do
128+ ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
129+ postMsg "hello"
130+ postMsg "world"
131+ getMsgs
132+ print ms
133+```
134+
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.
137+
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.
141+
142+The entire source for this example is available [here](...).