git.iko.soy/servant
on d64c232 help sign in
servant/doc/cookbook/db-postgres-pool/PostgresPool.lhs
143 lines 5.1 kB history raw
1# PostgreSQL connection pool
3Let's see how we can write a simple web application that uses a
4[PostgreSQL](https://www.postgresql.org/) database to store simple textual
5messages, just like in the SQLite cookbook recipe. The main difference,
6besides the database technology, is that in this example we will be using
7a pool of connections to talk to the database server. The pool abstraction
8will be provided by the
9[resource-pool](https://hackage.haskell.org/package/resource-pool) library.
11As usual, we start with a little bit of throat clearing.
13``` haskell
14{-# LANGUAGE DataKinds #-}
15{-# LANGUAGE OverloadedStrings #-}
16{-# LANGUAGE TypeOperators #-}
17import Data.ByteString (ByteString)
18import Control.Concurrent
19import Control.Exception (bracket)
20import Control.Monad.IO.Class
21import Data.Pool
22import Database.PostgreSQL.Simple
23import Network.HTTP.Client (newManager, defaultManagerSettings)
24import Network.Wai.Handler.Warp
25import Servant
26import Servant.Client
28type DBConnectionString = ByteString
29```
31We will only care about a single type here, the messages. We want to
32be able to add a new one and retrieve them all, using two different
33endpoints.
35``` haskell
36type Message = String
38type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
39 :<|> Get '[JSON] [Message]
41api :: Proxy API
42api = Proxy
43```
45We proceed with a simple function for creating a table
46for holding our messages if it doesn't already exist, given
47a PostgreSQL connection string.
49``` haskell
50initDB :: DBConnectionString -> IO ()
51initDB connstr = bracket (connectPostgreSQL connstr) close $ \conn -> do
52 execute_ conn
53 "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
54 return ()
55```
57Next, our server implementation. It will be parametrised (take as
58argument) by the pool of database connections that handlers can use to
59talk to the PostgreSQL database. The resource pool abstraction allows us
60to flexibly set up a whole bunch of PostgreSQL connections tailored to our
61needs and then to forget about it all by simply asking for a connection
62using `withResource`.
64The handlers are straightforward. One takes care of inserting a new
65value in the database while the other fetches all messages and returns
66them. We also provide a function for serving our web app given a PostgreSQL
67connection pool, which simply calls servant-server's `serve` function.
69``` haskell
70server :: Pool Connection -> Server API
71server conns = postMessage :<|> getMessages
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
81 getMessages :: Handler [Message]
82 getMessages = fmap (map fromOnly) . liftIO $
83 withResource conns $ \conn ->
84 query_ conn "SELECT msg FROM messages"
86runApp :: Pool Connection -> IO ()
87runApp conns = run 8080 (serve api $ server conns)
88```
90We 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)
93to gain a better understanding of how it works and what the configuration
94knobs are. I will be using some dummy values in this example.
96``` haskell
97initConnectionPool :: DBConnectionString -> IO (Pool Connection)
98initConnectionPool 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```
106Let's finally derive some clients for our API and use them to
107insert two messages and retrieve them in `main`, after setting up
108our pool of database connections.
110``` haskell
111postMsg :: Message -> ClientM NoContent
112getMsgs :: ClientM [Message]
113postMsg :<|> getMsgs = client api
115main :: IO ()
116main = 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 (mkClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
129 postMsg "hello"
130 postMsg "world"
131 getMsgs
132 print ms
133```
135This program prints `Right ["hello","world"]` the first time it is executed,
136`Right ["hello","world","hello","world"]` the second time and so on.
138You could alternatively have the handlers live in `ReaderT (Pool Connection)`
139and access the pool using e.g `ask`, but this would be more complicated
140than simply taking the pool as argument.
142The entire source for this example is available as a cabal project
143[here](https://github.com/haskell-servant/servant/tree/master/doc/cookbook/db-postgres-pool).