add cookbook recipe for using a PostgreSQL connection pool

doc/cookbook/cabal.project

@@ -1,6 +1,7 @@
 packages:
   basic-auth/
   db-sqlite-simple/
+  db-postgres-pool/
   ../../servant
   ../../servant-server
   ../../servant-client-core

doc/cookbook/db-postgres-pool/PostgresPool.lhs

@@ -0,0 +1,142 @@
+# PostgreSQL connection pool
+
+Let's see how we can write a simple web application that uses a
+[PostgreSQL](https://www.postgresql.org/) database to store simple textual
+messages, just like in the SQLite cookbook recipe. The main difference,
+besides the database technology, is that in this example we will be using
+a pool of connections to talk to the database server. The pool abstraction
+will be provided by the
+[resource-pool](https://hackage.haskell.org/package/resource-pool) library.
+
+As usual, we start with a little bit of throat clearing.
+
+``` haskell
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+import Data.ByteString (ByteString)
+import Control.Concurrent
+import Control.Exception (bracket)
+import Control.Monad.IO.Class
+import Data.Pool
+import Database.PostgreSQL.Simple
+import Network.HTTP.Client (newManager, defaultManagerSettings)
+import Network.Wai.Handler.Warp
+import Servant
+import Servant.Client
+
+type DBConnectionString = ByteString
+```
+
+We will only care about a single type here, the messages. We want to
+be able to add a new one and retrieve them all, using two different
+endpoints.
+
+``` haskell
+type Message = String
+
+type API = ReqBody '[PlainText] Message :> Post '[JSON] NoContent
+      :<|> Get '[JSON] [Message]
+
+api :: Proxy API
+api = Proxy
+```
+
+We proceed with a simple function for creating a table
+for holding our messages if it doesn't already exist, given
+a PostgreSQL connection string.
+
+``` haskell
+initDB :: DBConnectionString -> IO ()
+initDB connstr = bracket (connectPostgreSQL connstr) close $ \conn -> do
+  execute_ conn
+    "CREATE TABLE IF NOT EXISTS messages (msg text not null)"
+  return ()
+```
+
+Next, our server implementation. It will be parametrised (take as
+argument) by the pool of database connections that handlers can use to
+talk to the PostgreSQL database. The resource pool abstraction allows us
+to flexibly set up a whole bunch of PostgreSQL connections tailored to our
+needs and then to forget about it all by simply asking for a connection
+using `withResource`.
+
+The handlers are straighforward. One takes care of inserting a new
+value in the database while the other fetches all messages and returns
+them. We also provide a function for serving our web app given a PostgreSQL
+connection pool, which simply calls servant-server's `serve` function.
+
+``` haskell
+server :: Pool Connection -> Server API
+server conns = postMessage :<|> getMessages
+
+  where postMessage :: Message -> Handler NoContent
+        postMessage msg = do
+          liftIO . withResource conns $ \conn ->
+            execute conn
+                    "INSERT INTO messages VALUES (?)"
+                    (Only msg)
+          return NoContent
+
+        getMessages :: Handler [Message]
+        getMessages = fmap (map fromOnly) . liftIO $
+         withResource conns $ \conn ->
+            query_ conn "SELECT msg FROM messages"
+
+runApp :: Pool Connection -> IO ()
+runApp conns = run 8080 (serve api $ server conns)
+```
+
+We will also need a function for initialising our connection pool.
+`resource-pool` is quite configurable, feel free to wander in
+[its documentation](https://hackage.haskell.org/package/resource-pool)
+to gain a better understanding of how it works and what the configuration
+knobs are. I will be using some dummy values in this example.
+
+``` haskell
+initConnectionPool :: DBConnectionString -> IO (Pool Connection)
+initConnectionPool connStr =
+  createPool (connectPostgreSQL connStr)
+             close
+             2 -- stripes
+             60 -- unused connections are kept open for a minute
+             10 -- max. 10 connections open per stripe
+```
+
+Let's finally derive some clients for our API and use them to
+insert two messages and retrieve them in `main`, after setting up
+our pool of database connections.
+
+``` haskell
+postMsg :: Message -> ClientM NoContent
+getMsgs :: ClientM [Message]
+postMsg :<|> getMsgs = client api
+
+main :: IO ()
+main = do
+  -- you could read this from some configuration file,
+  -- environment variable or somewhere else instead.
+  -- you will need to either change this connection string OR
+  -- set some environment variables (see
+  -- https://www.postgresql.org/docs/9.5/static/libpq-envars.html)
+  -- to point to a running PostgreSQL server for this example to work.
+  let connStr = ""
+  pool <- initConnectionPool connStr
+  initDB connStr
+  mgr <- newManager defaultManagerSettings
+  bracket (forkIO $ runApp pool) killThread $ \_ -> do
+    ms <- flip runClientM (ClientEnv mgr (BaseUrl Http "localhost" 8080 "")) $ do
+      postMsg "hello"
+      postMsg "world"
+      getMsgs
+    print ms
+```
+
+This program prints `Right ["hello","world"]` the first time it is executed,
+`Right ["hello","world","hello","world"]` the second time and so on.
+
+You could alternatively have the handlers live in `ReaderT (Pool Connection)`
+and access the pool using e.g `ask`, but this would be more complicated
+than simply taking the pool as argument.
+
+The entire source for this example is available [here](...).

doc/cookbook/db-postgres-pool/db-postgres-pool.cabal

@@ -0,0 +1,30 @@
+name:                cookbook-db-postgres-pool
+version:             0.1
+synopsis:            Simple PostgreSQL connection pool cookbook example
+homepage:            http://haskell-servant.readthedocs.org/
+license:             BSD3
+license-file:        ../../../servant/LICENSE
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable cookbook-db-postgres-pool
+  main-is:             PostgresPool.lhs
+  build-depends:       base == 4.*
+                     , bytestring
+                     , text
+                     , aeson
+                     , servant
+                     , servant-client
+                     , servant-server
+                     , warp
+                     , wai
+                     , http-types
+                     , markdown-unlit >= 0.4
+                     , http-client
+                     , postgresql-simple
+                     , resource-pool
+  default-language:    Haskell2010
+  ghc-options:         -Wall -pgmL markdown-unlit
+  build-tool-depends: markdown-unlit:markdown-unlit

doc/cookbook/index.rst

@@ -19,3 +19,4 @@ you name it!
 
   basic-auth/BasicAuth.lhs
   db-sqlite-simple/DBConnection.lhs
+  db-postgres-pool/PostgresPool.lhs