bump version to 10.2.0

To 2.13.3

.github/actions/setup-nix/action.yaml

@@ -12,6 +12,8 @@ runs:
   using: composite
   steps:
     - uses: cachix/install-nix-action@v18
+      with:
+        install_url: https://releases.nixos.org/nix/nix-2.13.3/install
     - uses: cachix/cachix-action@v12
       with:
         name: postgrest

.github/workflows/ci.yaml

@@ -86,10 +86,6 @@ jobs:
         if: always()
         run: postgrest-with-postgresql-${{ matrix.pgVersion }} -f test/io/fixtures.sql postgrest-test-io
 
-      - name: Run query cost tests
-        if: always()
-        run: postgrest-with-postgresql-${{ matrix.pgVersion }} postgrest-test-querycost
-
 
   Test-Memory-Nix:
     name: Test memory (Nix)
@@ -253,7 +249,7 @@ jobs:
       - uses: actions/checkout@v3
       - id: Remote-Dir
         name: Unique directory name for the remote build
-        run: echo "::set-output name=remotepath::postgrest-build-$(uuidgen)"
+        run: echo "remotepath=postgrest-build-$(uuidgen)" >> "$GITHUB_OUTPUT"
       - name: Copy script files to the remote server
         uses: appleboy/scp-action@master
         with:
@@ -326,14 +322,14 @@ jobs:
             exit 1
           else
             echo "Version to be released is $cabal_version"
-            echo "::set-output name=version::$cabal_version"
+            echo "version=$cabal_version" >> "$GITHUB_OUTPUT"
           fi
 
           if [[ "$cabal_version" != *.*.*.* ]]; then
             echo "Version is for a full release (version does not have four components)"
           else
             echo "Version is for a pre-release (version has four components, e.g., 1.1.1.1)"
-            echo "::set-output name=isprerelease::1"
+            echo "isprerelease=1" >> "$GITHUB_OUTPUT"
           fi
       - name: Identify changes from CHANGELOG.md
         run: |

CHANGELOG.md

@@ -3,6 +3,19 @@
 All notable changes to this project will be documented in this file.
 This project adheres to [Semantic Versioning](http://semver.org/).
 
+## [10.2.0] - 2023-04-12
+
+### Added
+
+ - #2663, Limit maximal postgresql connection lifetime - @robx
+   + New option `db-pool-max-lifetime` (default 30m)
+   + `db-pool-acquisition-timeout` is no longer optional and defaults to 10s
+   + Fixes postgresql resource leak with long-lived connections (#2638)
+
+### Fixed
+
+ - #2667, Fix `db-pool-acquisition-timeout` not logging to stderr when the timeout is reached - @steve-chavez
+
 ## [10.1.2] - 2023-02-01
 
 ### Fixed

cabal.project.non-nix

@@ -17,4 +17,4 @@ packages: .
 source-repository-package
   type: git
   location: https://github.com/PostgREST/postgresql-libpq.git
-  tag: 33ff97db570b5b432255f5f24a68db51453f6eb8
+  tag: 890a0a16cf57dd401420fdc6c7d576fb696003bc

nix/README.md

@@ -208,12 +208,6 @@ postgrest-loadtest-against master
 postgrest-loadtest-report
 ```
 
-Our query cost tests ensure that our generated queries don't surpass a threshold EXPLAIN cost.
-
-```bash
-postgrest-test-querycost
-```
-
 doctests for some of our modules are also available:
 
 ```bash

nix/nixpkgs-version.nix

@@ -1,6 +1,6 @@
 # Pinned version of Nixpkgs, generated with postgrest-nixpkgs-upgrade.
 {
-  date = "2022-10-28";
+  date = "2023-01-12";
-  rev = "f44ba1be526c8da9e79a5759feca2365204003f6";
+  rev = "92f9580a4c369b4b51a7b6a5e77da43720134c9f";
-  tarballHash = "0npbwsdjw88py5w2pjflwh94wgi4jmnmls0k1n7q8m6h94w1y1ps";
+  tarballHash = "0w9bz4f2bmkj4a59n4z279zcgs9clyc40a4ny312rafyaknzghvw";
 }

nix/overlays/haskell-packages.nix

@@ -29,33 +29,33 @@ let
       # To fill in the sha256:
       #   update-nix-fetchgit nix/overlays/haskell-packages.nix
 
-      hashtables = lib.dontCheck prev.hashtables_1_3_1;
-      hasql = lib.dontCheck prev.hasql_1_6_1_4;
-      hasql-dynamic-statements = lib.dontCheck prev.hasql-dynamic-statements_0_3_1_2;
-      hasql-pool = lib.dontCheck
-        (prev.callHackageDirect
-          {
-            pkg = "hasql-pool";
-            ver = "0.8.0.6";
-            sha256 = "sha256-2u/cwPk8XfXffaDRzGeyzhL+9k2+2T4b8bGOZwz8AX0=";
-          }
-          { });
-      hasql-transaction = lib.dontCheck prev.hasql-transaction_1_0_1_2;
-      isomorphism-class = lib.unmarkBroken prev.isomorphism-class;
-      lens = lib.dontCheck prev.lens_5_2;
-      postgresql-binary = lib.dontCheck prev.postgresql-binary_0_13_1;
-      text-builder = lib.dontCheck prev.text-builder_0_6_7;
-      text-builder-dev = lib.dontCheck prev.text-builder-dev_0_3_3;
-
       postgresql-libpq = lib.dontCheck
         (prev.callCabal2nix "postgresql-libpq"
           (super.fetchFromGitHub {
             owner = "PostgREST";
             repo = "postgresql-libpq";
-            rev = "cef92cb4c07b56568dffdbf4b719258b82183119"; # master
+            rev = "890a0a16cf57dd401420fdc6c7d576fb696003bc"; # master
-            sha256 = "0r59klrz47qcnd22s47h612mlz3jbg40wwalfj3f6djwg0cdyr85";
+            sha256 = "1wmyhldk0k14y8whp1p4akrkqxf5snh8qsbm7fv5f7kz95nyffd0";
           })
           { });
+
+      hasql-notifications = lib.dontCheck
+        (prev.callHackageDirect
+          {
+            pkg = "hasql-notifications";
+            ver = "0.2.0.4";
+            sha256 = "sha256-fm1xiDyvDkb5WLOJ73/s8wrWEW23XFS7luAv2brfr8I=";
+          }
+          { });
+
+      hasql-pool = lib.dontCheck
+        (prev.callHackageDirect
+          {
+            pkg = "hasql-pool";
+            ver = "0.9";
+            sha256 = "sha256-5UshbbaBVY8eJ/9VagNVVxonRwMcd7UmGqDc35pJNFY=";
+          }
+          { });
     } // extraOverrides final prev;
 in
 {

nix/tools/devTools.nix

@@ -77,7 +77,6 @@ let
       }
       ''
         ${tests}/bin/postgrest-test-spec
-        ${tests}/bin/postgrest-test-querycost
         ${tests}/bin/postgrest-test-doctests
         ${tests}/bin/postgrest-test-io
         ${style}/bin/postgrest-lint
@@ -165,6 +164,7 @@ let
           # The following unsets all GIT_ variables.
           unset "''${!GIT_@}"
 
+          # shellcheck disable=SC2317
           function restore () {
             ref="$(git stash list --format=format:%gD --grep "$1" -n1)"
             # this will avoid merge conflicts when applying the stash

nix/tools/release/default.nix

@@ -106,7 +106,7 @@ let
         echo "Tagging ..."
         git tag "v$new_version" > /dev/null
 
-        trap "Couldn't find remote. Please push manually ..." ERR
+        trap "echo Remote not found. Please push manually ..." ERR
         remote="$(git remote -v | grep PostgREST/postgrest | grep push | cut -f1)"
         trap "" ERR
 

nix/tools/tests.nix

@@ -32,18 +32,6 @@ let
           test:spec -- "''${_arg_leftovers[@]}"
       '';
 
-  testQuerycost =
-    checkedShellScript
-      {
-        name = "postgrest-test-querycost";
-        docs = "Run the Haskell test suite for query costs";
-        inRootDir = true;
-        withEnv = postgrest.env;
-      }
-      ''
-        ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
-      '';
-
   testDoctests =
     checkedShellScript
       {
@@ -140,7 +128,7 @@ let
           rm -rf coverage/*
 
           # build once before running all the tests
-          ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec test:querycost
+          ${cabal-install}/bin/cabal v2-build ${devCabalOptions} exe:postgrest lib:postgrest test:spec
 
           (
             trap 'echo Found dead code: Check file list above.' ERR ;
@@ -155,14 +143,11 @@ let
           HPCTIXFILE="$tmpdir"/spec.tix \
             ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:spec
 
-          HPCTIXFILE="$tmpdir"/querycost.tix \
-            ${withTools.withPg} ${cabal-install}/bin/cabal v2-run ${devCabalOptions} test:querycost
-
           # Note: No coverage for doctests, as doctests leverage GHCi and GHCi does not support hpc
 
           # collect all the tix files
           ${ghc}/bin/hpc sum  --union --exclude=Paths_postgrest --output="$tmpdir"/tests.tix \
-            "$tmpdir"/io*.tix "$tmpdir"/spec.tix "$tmpdir"/querycost.tix
+            "$tmpdir"/io*.tix "$tmpdir"/spec.tix
 
           # prepare the overlay
           ${ghc}/bin/hpc overlay --output="$tmpdir"/overlay.tix test/coverage.overlay
@@ -234,7 +219,6 @@ buildToolbox
   tools =
     [
       testSpec
-      testQuerycost
       testDoctests
       testSpecIdempotence
       testIO

nix/tools/withTools.nix

@@ -69,6 +69,7 @@ let
         pg_ctl -l "$tmpdir/db.log" -w start -o "-F -c listen_addresses=\"\" -c hba_file=$HBA_FILE -k $PGHOST -c log_statement=\"all\"" \
           >> "$setuplog"
 
+        # shellcheck disable=SC2317
         stop () {
           log "Stopping the database cluster..."
           pg_ctl stop -m i >> "$setuplog"
@@ -260,6 +261,7 @@ let
         echo -n "Starting postgrest... "
         ./result/bin/postgrest ${legacyConfig} > "$tmpdir"/run.log 2>&1 &
         pid=$!
+        # shellcheck disable=SC2317
         cleanup() {
           kill "$pid" || true
         }

postgrest.cabal

@@ -1,5 +1,5 @@
 name:               postgrest
-version:            10.1.2
+version:            10.2.0
 synopsis:           REST API for any Postgres database
 description:        Reads the schema of a PostgreSQL database and creates RESTful routes
                     for tables, views, and functions, supporting all HTTP methods that security
@@ -72,7 +72,7 @@ library
                       PostgREST.Workers
   other-modules:      Paths_postgrest
   build-depends:      base                      >= 4.9 && < 4.17
-                    , HTTP                      >= 4000.3.7 && < 4000.4
+                    , HTTP                      >= 4000.3.7 && < 4000.5
                     , Ranged-sets               >= 0.3 && < 0.5
                     , aeson                     >= 2.0.3 && < 2.2
                     , auto-update               >= 0.1.4 && < 0.2
@@ -90,7 +90,7 @@ library
                     , hasql                     >= 1.6.1.1 && < 1.7
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
                     , hasql-notifications       >= 0.1 && < 0.3
-                    , hasql-pool                >= 0.8.0.6 && < 0.9
+                    , hasql-pool                >= 0.9 && < 0.10
                     , hasql-transaction         >= 1.0.1 && < 1.1
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13
@@ -98,11 +98,11 @@ library
                     , interpolatedstring-perl6  >= 1 && < 1.1
                     , jose                      >= 0.8.5.1 && < 0.11
                     , lens                      >= 4.14 && < 5.3
-                    , lens-aeson                >= 1.0.1 && < 1.2
+                    , lens-aeson                >= 1.0.1 && < 1.3
                     , mtl                       >= 2.2.2 && < 2.3
                     , network                   >= 2.6 && < 3.2
                     , network-uri               >= 2.6.1 && < 2.8
-                    , optparse-applicative      >= 0.13 && < 0.17
+                    , optparse-applicative      >= 0.13 && < 0.18
                     , parsec                    >= 3.1.11 && < 3.2
                     , protolude                 >= 0.3.1 && < 0.4
                     , regex-tdfa                >= 1.2.2 && < 1.4
@@ -228,69 +228,32 @@ test-suite spec
                     , bytestring        >= 0.10.8 && < 0.12
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
-                    , hasql-pool        >= 0.8.0.2 && < 0.9
+                    , hasql-pool        >= 0.9 && < 0.10
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
-                    , hspec             >= 2.3 && < 2.9
+                    , hspec             >= 2.3 && < 2.10
                     , hspec-wai         >= 0.10 && < 0.12
                     , hspec-wai-json    >= 0.10 && < 0.12
                     , http-types        >= 0.12.3 && < 0.13
                     , lens              >= 4.14 && < 5.3
-                    , lens-aeson        >= 1.0.1 && < 1.2
+                    , lens-aeson        >= 1.0.1 && < 1.3
                     , monad-control     >= 1.0.1 && < 1.1
                     , postgrest
                     , process           >= 1.4.2 && < 1.7
                     , protolude         >= 0.3.1 && < 0.4
                     , regex-tdfa        >= 1.2.2 && < 1.4
+                    , scientific        >= 0.3.4 && < 0.4
                     , text              >= 1.2.2 && < 1.3
                     , transformers-base >= 0.4.4 && < 0.5
                     , wai               >= 3.2.1 && < 3.3
                     , wai-extra         >= 3.0.19 && < 3.2
-  ghc-options:        -O0 -Werror -Wall -fwarn-identities
+  ghc-options:        -threaded -O0 -Werror -Wall -fwarn-identities
                       -fno-spec-constr -optP-Wno-nonportable-include-path
                       -fno-warn-missing-signatures
                       -fwrite-ide-info
                       -- https://github.com/PostgREST/postgrest/issues/387
                       -with-rtsopts=-K33K
 
-test-suite querycost
-  type:               exitcode-stdio-1.0
-  default-language:   Haskell2010
-  default-extensions: OverloadedStrings
-                      QuasiQuotes
-                      NoImplicitPrelude
-  hs-source-dirs:     test/spec
-  main-is:            QueryCost.hs
-  other-modules:      SpecHelper
-  build-depends:      base              >= 4.9 && < 4.17
-                    , aeson             >= 2.0.3 && < 2.2
-                    , base64-bytestring >= 1 && < 1.3
-                    , bytestring        >= 0.10.8 && < 0.12
-                    , case-insensitive  >= 1.2 && < 1.3
-                    , containers        >= 0.5.7 && < 0.7
-                    , contravariant     >= 1.4 && < 1.6
-                    , hasql             >= 1.6 && < 1.7
-                    , hasql-dynamic-statements >= 0.3.1 && < 0.4
-                    , hasql-pool        >= 0.8.0.2 && < 0.9
-                    , hasql-transaction >= 1.0.1 && < 1.1
-                    , heredoc           >= 0.2 && < 0.3
-                    , hspec             >= 2.3 && < 2.9
-                    , hspec-wai         >= 0.10 && < 0.12
-                    , hspec-wai-json    >= 0.10 && < 0.12
-                    , http-types        >= 0.12.3 && < 0.13
-                    , lens              >= 4.14 && < 5.3
-                    , lens-aeson        >= 1.0.1 && < 1.2
-                    , postgrest
-                    , process           >= 1.4.2 && < 1.7
-                    , protolude         >= 0.3.1 && < 0.4
-                    , regex-tdfa        >= 1.2.2 && < 1.4
-                    , wai-extra         >= 3.0.19 && < 3.2
-  ghc-options:        -O0 -Werror -Wall -fwarn-identities
-                      -fno-spec-constr -optP-Wno-nonportable-include-path
-                      -fwrite-ide-info
-                      -- https://github.com/PostgREST/postgrest/issues/387
-                      -with-rtsopts=-K1K
-
 test-suite doctests
   type:               exitcode-stdio-1.0
   default-language:   Haskell2010

src/PostgREST/ApiRequest/QueryParams.hs

@@ -139,7 +139,7 @@ parse qs =
     <*> (fmap snd <$> (pRequestFilter `traverse` filtersRoot))
     <*> pRequestFilter `traverse` filtersNotRoot
     <*> pure (S.fromList (fst <$> filters))
-    <*> sequenceA (pRequestOnConflict <$> onConflict)
+    <*> pRequestOnConflict `traverse` onConflict
   where
     logic = filter (endingIn ["and", "or"] . fst) nonemptyParams
     select = fromMaybe "*" $ lookupParam "select"

src/PostgREST/App.hs

@@ -9,6 +9,7 @@ Some of its functionality includes:
 - Producing HTTP Headers according to RFCs.
 - Content Negotiation
 -}
+{-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE RecordWildCards #-}
 module PostgREST.App
   ( SignalHandlerInstaller
@@ -19,13 +20,14 @@ module PostgREST.App
 
 
 import Control.Monad.Except     (liftEither)
-import Data.Either.Combinators  (mapLeft)
+import Data.Either.Combinators  (mapLeft, whenLeft)
 import Data.Maybe               (fromJust)
 import Data.String              (IsString (..))
 import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort,
                                  setServerName)
 import System.Posix.Types       (FileMode)
 
+import qualified Hasql.Pool                 as SQL
 import qualified Hasql.Transaction.Sessions as SQL
 import qualified Network.Wai                as Wai
 import qualified Network.Wai.Handler.Warp   as Warp
@@ -153,9 +155,13 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache jsonDbS pgVer aut
 
 runDbHandler :: AppState.AppState -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b
 runDbHandler appState mode authenticated prepared handler = do
-  dbResp <-
+  dbResp <- lift $ do
-    let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in
+    let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction
-    lift . AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
+    res <- AppState.usePool appState . transaction SQL.ReadCommitted mode $ runExceptT handler
+    whenLeft res (\case
+      SQL.AcquisitionTimeoutUsageError -> AppState.debounceLogAcquisitionTimeout appState -- this can happen rapidly for many requests, so we debounce
+      _ -> pure ())
+    return res
 
   resp <-
     liftEither . mapLeft Error.PgErr $

src/PostgREST/AppState.hs

@@ -16,6 +16,7 @@ module PostgREST.AppState
   , init
   , initWithPool
   , logWithZTime
+  , logPgrstError
   , putConfig
   , putSchemaCache
   , putIsListenerOn
@@ -25,13 +26,18 @@ module PostgREST.AppState
   , signalListener
   , usePool
   , waitListener
+  , debounceLogAcquisitionTimeout
   ) where
 
-import qualified Hasql.Pool    as SQL
+import qualified Data.ByteString.Lazy as LBS
-import qualified Hasql.Session as SQL
+import qualified Data.Text.Encoding   as T
+import qualified Hasql.Pool           as SQL
+import qualified Hasql.Session        as SQL
+import qualified PostgREST.Error      as Error
 
 import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
                            updateAction)
+import Control.Debounce
 import Data.IORef         (IORef, atomicWriteIORef, newIORef,
                            readIORef)
 import Data.Time          (ZonedTime, defaultTimeLocale, formatTime,
@@ -47,29 +53,31 @@ import Protolude
 
 data AppState = AppState
   -- | Database connection pool
-  { statePool         :: SQL.Pool
+  { statePool                     :: SQL.Pool
   -- | Database server version, will be updated by the connectionWorker
-  , statePgVersion    :: IORef PgVersion
+  , statePgVersion                :: IORef PgVersion
   -- | No schema cache at the start. Will be filled in by the connectionWorker
-  , stateSchemaCache  :: IORef (Maybe SchemaCache)
+  , stateSchemaCache              :: IORef (Maybe SchemaCache)
   -- | Cached SchemaCache in json
-  , stateJsonDbS      :: IORef ByteString
+  , stateJsonDbS                  :: IORef ByteString
   -- | Binary semaphore to make sure just one connectionWorker can run at a time
-  , stateWorkerSem    :: MVar ()
+  , stateWorkerSem                :: MVar ()
   -- | Binary semaphore used to sync the listener(NOTIFY reload) with the connectionWorker.
-  , stateListener     :: MVar ()
+  , stateListener                 :: MVar ()
   -- | State of the LISTEN channel, used for the admin server checks
-  , stateIsListenerOn :: IORef Bool
+  , stateIsListenerOn             :: IORef Bool
   -- | Config that can change at runtime
-  , stateConf         :: IORef AppConfig
+  , stateConf                     :: IORef AppConfig
   -- | Time used for verifying JWT expiration
-  , stateGetTime      :: IO UTCTime
+  , stateGetTime                  :: IO UTCTime
   -- | Time with time zone used for worker logs
-  , stateGetZTime     :: IO ZonedTime
+  , stateGetZTime                 :: IO ZonedTime
   -- | Used for killing the main thread in case a subthread fails
-  , stateMainThreadId :: ThreadId
+  , stateMainThreadId             :: ThreadId
   -- | Keeps track of when the next retry for connecting to database is scheduled
-  , stateRetryNextIn  :: IORef Int
+  , stateRetryNextIn              :: IORef Int
+  -- | Logs a pool error with a debounce
+  , debounceLogAcquisitionTimeout :: IO ()
   }
 
 init :: AppConfig -> IO AppState
@@ -78,8 +86,8 @@ init conf = do
   initWithPool pool conf
 
 initWithPool :: SQL.Pool -> AppConfig -> IO AppState
-initWithPool pool conf =
+initWithPool pool conf = do
-  AppState pool
+  appState <- AppState pool
     <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step
     <*> newIORef Nothing
     <*> newIORef mempty
@@ -91,16 +99,28 @@ initWithPool pool conf =
     <*> mkAutoUpdate defaultUpdateSettings { updateAction = getZonedTime }
     <*> myThreadId
     <*> newIORef 0
+    <*> pure (pure ())
+
+  deb <-
+    let oneSecond = 1000000 in
+    mkDebounce defaultDebounceSettings
+       { debounceAction = logPgrstError appState SQL.AcquisitionTimeoutUsageError
+       , debounceFreq = 5*oneSecond
+       , debounceEdge = leadingEdge -- logs at the start and the end
+       }
+
+  return appState { debounceLogAcquisitionTimeout = deb }
 
 destroy :: AppState -> IO ()
 destroy = destroyPool
 
 initPool :: AppConfig -> IO SQL.Pool
 initPool AppConfig{..} =
-  SQL.acquire configDbPoolSize timeoutMilliseconds $ toUtf8 configDbUri
+  SQL.acquire
-  where
+    configDbPoolSize
-    timeoutMilliseconds = (* oneSecond) <$> configDbPoolAcquisitionTimeout
+    (fromIntegral configDbPoolAcquisitionTimeout)
-    oneSecond = 1000000
+    (fromIntegral configDbPoolMaxLifetime)
+    (toUtf8 configDbUri)
 
 -- | Run an action with a database connection.
 usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
@@ -157,6 +177,9 @@ logWithZTime appState txt = do
   zTime <- stateGetZTime appState
   hPutStrLn stderr $ toS (formatTime defaultTimeLocale "%d/%b/%Y:%T %z: " zTime) <> txt
 
+logPgrstError :: AppState -> SQL.UsageError -> IO ()
+logPgrstError appState e = logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ Error.errorPayload $ Error.PgError False e
+
 getMainThreadId :: AppState -> ThreadId
 getMainThreadId = stateMainThreadId
 

src/PostgREST/CLI.hs

@@ -151,6 +151,9 @@ exampleConfigFile =
       |## Time in seconds to wait to acquire a slot from the connection pool
       |# db-pool-acquisition-timeout = 10
       |
+      |## Time in seconds after which to recycle pool connections
+      |# db-pool-max-lifetime = 1800
+      |
       |## Stored proc to exec immediately after auth
       |# db-pre-request = "stored_proc_name"
       |

src/PostgREST/Config.hs

@@ -70,7 +70,8 @@ data AppConfig = AppConfig
   , configDbMaxRows                :: Maybe Integer
   , configDbPlanEnabled            :: Bool
   , configDbPoolSize               :: Int
-  , configDbPoolAcquisitionTimeout :: Maybe Int
+  , configDbPoolAcquisitionTimeout :: Int
+  , configDbPoolMaxLifetime        :: Int
   , configDbPreRequest             :: Maybe QualifiedIdentifier
   , configDbPreparedStatements     :: Bool
   , configDbRootSpec               :: Maybe QualifiedIdentifier
@@ -130,7 +131,8 @@ toText conf =
       ,("db-max-rows",                   maybe "\"\"" show . configDbMaxRows)
       ,("db-plan-enabled",               T.toLower . show . configDbPlanEnabled)
       ,("db-pool",                       show . configDbPoolSize)
-      ,("db-pool-acquisition-timeout",   maybe "\"\"" show . configDbPoolAcquisitionTimeout)
+      ,("db-pool-acquisition-timeout",   show . configDbPoolAcquisitionTimeout)
+      ,("db-pool-max-lifetime",          show . configDbPoolMaxLifetime)
       ,("db-pre-request",            q . maybe mempty dumpQi . configDbPreRequest)
       ,("db-prepared-statements",        T.toLower . show . configDbPreparedStatements)
       ,("db-root-spec",              q . maybe mempty dumpQi . configDbRootSpec)
@@ -219,7 +221,8 @@ parser optPath env dbSettings =
                      (optInt "max-rows")
     <*> (fromMaybe False <$> optBool "db-plan-enabled")
     <*> (fromMaybe 10 <$> optInt "db-pool")
-    <*> optInt "db-pool-acquisition-timeout"
+    <*> (fromMaybe 10 <$> optInt "db-pool-acquisition-timeout")
+    <*> (fromMaybe 1800 <$> optInt "db-pool-max-lifetime")
     <*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
                                     (optString "pre-request"))
     <*> (fromMaybe True <$> optBool "db-prepared-statements")
@@ -355,7 +358,8 @@ parser optPath env dbSettings =
           let dbSettingName = T.pack $ dashToUnderscore <$> toS key in
           if dbSettingName `notElem` [
             "server_host", "server_port", "server_unix_socket", "server_unix_socket_mode", "admin_server_port", "log_level",
-            "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_acquisition_timeout", "db_config"]
+            "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_pool_acquisition_timeout",
+            "db_pool_max_lifetime", "db_config"]
           then lookup dbSettingName dbSettings
           else Nothing
 

src/PostgREST/Error.hs

@@ -424,13 +424,13 @@ pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError
 
     _                       -> HTTP.status500
 
-checkIsFatal :: PgError -> Maybe Text
+checkIsFatal :: SQL.UsageError -> Maybe Text
-checkIsFatal (PgError _ (SQL.ConnectionUsageError e))
+checkIsFatal (SQL.ConnectionUsageError e)
   | isAuthFailureMessage = Just $ toS failureMessage
   | otherwise = Nothing
   where isAuthFailureMessage = "FATAL:  password authentication failed" `isInfixOf` failureMessage
         failureMessage = BS.unpack $ fromMaybe mempty e
-checkIsFatal (PgError _ (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverError))))
+checkIsFatal(SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError serverError)))
   = case serverError of
       -- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal.
       SQL.ServerError "42601" _ _ _ _

src/PostgREST/SchemaCache.hs

@@ -399,7 +399,7 @@ test         | personnages_view     | test       | actors_view      | personnage
 -}
 addViewM2OAndO2ORels :: [ViewKeyDependency] -> [Relationship] -> [Relationship]
 addViewM2OAndO2ORels keyDeps rels =
-  rels ++ concat (viewRels <$> rels)
+  rels ++ concatMap viewRels rels
   where
     isM2O card = case card of {M2O _ _ -> True; _ -> False;}
     isO2O card = case card of {O2O _ _ -> True; _ -> False;}
@@ -449,7 +449,7 @@ addViewM2OAndO2ORels keyDeps rels =
         , keyDepColsTblVw <- expandKeyDepCols $ keyDepCols tblVw ]
       else []
     viewRels _ = []
-    expandKeyDepCols kdc = zip (fst <$> kdc) <$> sequenceA (snd <$> kdc)
+    expandKeyDepCols kdc = zip (fst <$> kdc) <$> traverse snd kdc
 
 addInverseRels :: [Relationship] -> [Relationship]
 addInverseRels rels =
@@ -485,7 +485,7 @@ addViewPrimaryKeys tabs keyDeps =
     -- * We don't have any logic that requires the client to name a PK column (compared to the column hints in embedding for FKs),
     --   so we don't need to know about the other references.
     -- * We need to choose a single reference for each column, otherwise we'd output too many columns in location headers etc.
-    takeFirstPK pkCols = catMaybes $ head . snd <$> pkCols
+    takeFirstPK = mapMaybe (head . snd)
 
 allTables :: PgVersion -> Bool -> SQL.Statement [Schema] TablesMap
 allTables pgVer =

src/PostgREST/Workers.hs

@@ -13,7 +13,6 @@ import qualified Data.Aeson                 as JSON
 import qualified Data.ByteString            as BS
 import qualified Data.ByteString.Lazy       as LBS
 import qualified Data.Text                  as T
-import qualified Data.Text.Encoding         as T
 import qualified Hasql.Notifications        as SQL
 import qualified Hasql.Session              as SQL
 import qualified Hasql.Transaction.Sessions as SQL
@@ -32,8 +31,7 @@ import PostgREST.AppState         (AppState)
 import PostgREST.Config           (AppConfig (..), readAppConfig)
 import PostgREST.Config.Database  (queryDbSettings, queryPgVersion)
 import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion)
-import PostgREST.Error            (PgError (PgError), checkIsFatal,
+import PostgREST.Error            (checkIsFatal)
-                                   errorPayload)
 import PostgREST.SchemaCache      (querySchemaCache)
 
 import qualified PostgREST.AppState as AppState
@@ -131,9 +129,8 @@ establishConnection appState =
       pgVersion <- AppState.usePool appState queryPgVersion
       case pgVersion of
         Left e -> do
-          let err = PgError False e
+          AppState.logPgrstError appState e
-          AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
+          case checkIsFatal e of
-          case checkIsFatal err of
             Just reason ->
               return $ FatalConnectionError reason
             Nothing ->
@@ -168,19 +165,16 @@ loadSchemaCache appState = do
       querySchemaCache (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements
   case result of
     Left e -> do
-      let
+      case checkIsFatal e of
-        err = PgError False e
-        putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
-      case checkIsFatal err of
         Just hint -> do
           AppState.logWithZTime appState "A fatal error ocurred when loading the schema cache"
-          putErr
+          AppState.logPgrstError appState e
           AppState.logWithZTime appState hint
           return SCFatalFail
         Nothing -> do
           AppState.putSchemaCache appState Nothing
           AppState.logWithZTime appState "An error ocurred when loading the schema cache"
-          putErr
+          AppState.logPgrstError appState e
           return SCOnRetry
 
     Right sCache -> do
@@ -249,18 +243,15 @@ reReadConfig startingUp appState = do
       qDbSettings <- AppState.usePool appState $ queryDbSettings configDbPreparedStatements
       case qDbSettings of
         Left e -> do
-          let
-            err = PgError False e
-            putErr = AppState.logWithZTime appState . T.decodeUtf8 . LBS.toStrict $ errorPayload err
           AppState.logWithZTime appState
             "An error ocurred when trying to query database settings for the config parameters"
-          case checkIsFatal err of
+          case checkIsFatal e of
             Just hint -> do
-              putErr
+              AppState.logPgrstError appState e
               AppState.logWithZTime appState hint
               killThread (AppState.getMainThreadId appState)
             Nothing -> do
-              putErr
+              AppState.logPgrstError appState e
           pure []
         Right x -> pure x
     else

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-19.14 # 2022-07-01, GHC 9.0.2
+resolver: lts-20.6 # 2023-01-09, GHC 9.2.5
 
 nix:
   packages:
@@ -10,23 +10,7 @@ nix:
   pure: false
 
 extra-deps:
-  - HTTP-4000.3.16
-  - configurator-pg-0.2.6
-  - hashable-1.4.1.0
-  - hashtables-1.3
-  - hasql-1.6.1.1
-  - hasql-dynamic-statements-0.3.1.2
-  - hasql-implicits-0.1.0.5
-  - hasql-notifications-0.2.0.3
-  - hasql-pool-0.8.0.6
-  - hasql-transaction-1.0.1.2
-  - isomorphism-class-0.1.0.6
-  - lens-aeson-1.1.3
-  - optparse-applicative-0.16.1.0
-  - postgresql-binary-0.12.5
-  - protolude-0.3.2
-  - ptr-0.16.8.2
-  - text-builder-0.6.7
-  - text-builder-dev-0.3.3
   - git: https://github.com/PostgREST/postgresql-libpq.git
-    commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
+    commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
+  - hasql-notifications-0.2.0.4
+  - hasql-pool-0.9

stack.yaml.lock

@@ -5,145 +5,33 @@
 
 packages:
 - completed:
-    hackage: HTTP-4000.3.16@sha256:6042643c15a0b43e522a6693f1e322f05000d519543a84149cb80aeffee34f71,5947
+    commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
-    pantry-tree:
+    git: https://github.com/PostgREST/postgresql-libpq.git
-      size: 1428
-      sha256: b73a7f6d21cf20bbf819e19039409c9010efb5000d2b72cdd8fd67a9027c14e8
-  original:
-    hackage: HTTP-4000.3.16
-- completed:
-    hackage: configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
-    pantry-tree:
-      size: 2463
-      sha256: 97efe7a22afc93033bda5adcffdabc0f1c30dc32b2c3ba02114ce7cd74c942fd
-  original:
-    hackage: configurator-pg-0.2.6
-- completed:
-    hackage: hashable-1.4.1.0@sha256:50b2f002c68fe67730ee7a3cd8607486197dd99b084255005ad51ecd6970a41b,5019
-    pantry-tree:
-      size: 1248
-      sha256: 9af2f7a42674f7effcabbebc043f97057240783f1709338a77f58216f4a5f18c
-  original:
-    hackage: hashable-1.4.1.0
-- completed:
-    hackage: hashtables-1.3@sha256:ab21804fdafbbd8ad918b2911dabb729ae0ea891780fe66bf7804cbcd07edadf,10379
-    pantry-tree:
-      size: 2895
-      sha256: e71f113ad989dbc994e0fb52bcc219d62930de9afa8b3441bf7909e864481b33
-  original:
-    hackage: hashtables-1.3
-- completed:
-    hackage: hasql-1.6.1.1@sha256:948a2137308cc5354e4997bc3666753867124cd25db792424cb9614b1c1b44cf,6626
-    pantry-tree:
-      size: 2622
-      sha256: 28d21bf061522fc513f040e9c383b90532222b7258216cc094e07736add8be10
-  original:
-    hackage: hasql-1.6.1.1
-- completed:
-    hackage: hasql-dynamic-statements-0.3.1.2@sha256:417aa533c84f074e2fa16bb2c4d4231326aa512097dd1025d915388e56acd1eb,2675
-    pantry-tree:
-      size: 595
-      sha256: 91696d3f3e0ef3254772ae5a8e4e89be68285febb49b302ed83d85ac4037a417
-  original:
-    hackage: hasql-dynamic-statements-0.3.1.2
-- completed:
-    hackage: hasql-implicits-0.1.0.5@sha256:d16aacad6dc21428d72447d3ae8bcc03839a2f0aa1ec29c797ed9aca4609f9af,1361
-    pantry-tree:
-      size: 264
-      sha256: 0451b99a0a1d02db673d0c40acdf60d4e769e15852eed9e8dc05bffaf43efb70
-  original:
-    hackage: hasql-implicits-0.1.0.5
-- completed:
-    hackage: hasql-notifications-0.2.0.3@sha256:aca3f7ee847a8f0b7ef6f989dc48f4a094a06c1a34e92aa3c8bb230085966ea6,2027
-    pantry-tree:
-      size: 452
-      sha256: 999f0f2856a00d21f4498a8a58452bbefc4ea972fe2984fd234a68a5fe61d98b
-  original:
-    hackage: hasql-notifications-0.2.0.3
-- completed:
-    hackage: hasql-pool-0.8.0.6@sha256:b63bb83409bab5bc20ff24f5d62205e9b117701a0fc24531ddeac20ab8c2a42c,1818
-    pantry-tree:
-      size: 346
-      sha256: c4100946b7eae44375511e35a393abe2e1db0e5637c68cea8f53176b796bfd5b
-  original:
-    hackage: hasql-pool-0.8.0.6
-- completed:
-    hackage: hasql-transaction-1.0.1.2@sha256:297b158cd1f0727f9b0e175bd7d3741c1bcb725a8094956d0ee79b41aafdb30a,2890
-    pantry-tree:
-      size: 983
-      sha256: 3679e6d5c835cc17a8fa0c252b8221e282880044b7219aa1de2531bbd5c40691
-  original:
-    hackage: hasql-transaction-1.0.1.2
-- completed:
-    hackage: isomorphism-class-0.1.0.6@sha256:d93da31287359c761953b876354de28381f409c5c50e3241c572a443e50c553d,1703
-    pantry-tree:
-      size: 465
-      sha256: c97f922d1ae8f1a0db4c28fac9383d2716934879e95ff0b2b88ebb861d6fba14
-  original:
-    hackage: isomorphism-class-0.1.0.6
-- completed:
-    hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
-    pantry-tree:
-      size: 541
-      sha256: b31392b78f2a03111c805f4400007778eb93b49f998ab41dfbebaaf9b5526bad
-  original:
-    hackage: lens-aeson-1.1.3
-- completed:
-    hackage: optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
-    pantry-tree:
-      size: 2979
-      sha256: dd092d843091c08691485d68a1908517079b1bc6f3d73928f37635a19dc27fc1
-  original:
-    hackage: optparse-applicative-0.16.1.0
-- completed:
-    hackage: postgresql-binary-0.12.5@sha256:de9da3cba9be541d6c75ae8da2858c33d83dc1b2e0c639b0b9781816b78a91f4,5594
-    pantry-tree:
-      size: 1619
-      sha256: b392337f91031a5b3407393e2f04dfe4e7a28019e88eae6a9370538b90e28c51
-  original:
-    hackage: postgresql-binary-0.12.5
-- completed:
-    hackage: protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
-    pantry-tree:
-      size: 1594
-      sha256: a36d2912ac552d950ba4476de7d950b56b82dd28e48b9f4d0efee938f10bc525
-  original:
-    hackage: protolude-0.3.2
-- completed:
-    hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
-    pantry-tree:
-      size: 1303
-      sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
-  original:
-    hackage: ptr-0.16.8.2
-- completed:
-    hackage: text-builder-0.6.7@sha256:efbb3e06107e9c8d1cfe85c963938ca9f375a74379af03da3173be4ef5c37bcf,2364
-    pantry-tree:
-      size: 425
-      sha256: cd0ae197e6f9f3860a8ab71f5b87c4a8452ed1fce2fdfd35e36d68ded6e6648e
-  original:
-    hackage: text-builder-0.6.7
-- completed:
-    hackage: text-builder-dev-0.3.3@sha256:79ec422defcc2e5b34f94129c72b98d34b2efc1ed8bbd945ccb8f4f535a892c3,2784
-    pantry-tree:
-      size: 724
-      sha256: 8883631a132438e7892fcb13e89d6bbcdc0ac76c56fbea8df8d7aa482ce81f73
-  original:
-    hackage: text-builder-dev-0.3.3
-- completed:
     name: postgresql-libpq
-    version: 0.9.4.3
-    git: https://github.com/PostgREST/postgresql-libpq.git
     pantry-tree:
-      size: 1081
+      sha256: 074668b9669b9c49f3c522c8af5c608799a1965e203c463b188b2632995beac2
-      sha256: 0df271e48af32eb8292a45301af45e114110d54099ee73dbc609d39770e8175e
+      size: 1414
-    commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
+    version: 0.9.4.3
   original:
+    commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc
     git: https://github.com/PostgREST/postgresql-libpq.git
-    commit: 33ff97db570b5b432255f5f24a68db51453f6eb8
+- completed:
+    hackage: hasql-notifications-0.2.0.4@sha256:9a09fa9b97feadd9492c8bd8bc6b9cffe0513510102f08374b0c45ecd479ed67,2028
+    pantry-tree:
+      sha256: 56f9e240728e7a65711dde45fa2e2075b914e32cd370424aaa4572392378a60e
+      size: 452
+  original:
+    hackage: hasql-notifications-0.2.0.4
+- completed:
+    hackage: hasql-pool-0.9@sha256:db7a37f6b3a922c37adc3c7ced47a7c10786d1f171e47a735a6e812a587ba44c,2111
+    pantry-tree:
+      sha256: 49b1181d28c6f5317e794671c2dae155754b834bdcfa30f7e5dbad28e4cf0249
+      size: 346
+  original:
+    hackage: hasql-pool-0.9
 snapshots:
 - completed:
-    size: 618951
+    sha256: 4905c93319aa94aa53da8f41d614d7bacdbfe6c63a8c6132d32e6e62f24a9af4
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/14.yaml
+    size: 649315
-    sha256: 4c31d4ef975b0211078862566aedf3b82b6cea569fc2cde4c72a51e5a8d236ce
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/6.yaml
-  original: lts-19.14
+  original: lts-20.6

test/io/configs/expected/aliases.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public"
 db-max-rows = 1000
 db-plan-enabled = false
 db-pool = 10
-db-pool-acquisition-timeout = ""
+db-pool-acquisition-timeout = 10
+db-pool-max-lifetime = 1800
 db-pre-request = "check_alias"
 db-prepared-statements = true
 db-root-spec = "open_alias"

test/io/configs/expected/boolean-numeric.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public"
 db-max-rows = ""
 db-plan-enabled = false
 db-pool = 10
-db-pool-acquisition-timeout = ""
+db-pool-acquisition-timeout = 10
+db-pool-max-lifetime = 1800
 db-pre-request = ""
 db-prepared-statements = false
 db-root-spec = ""

test/io/configs/expected/boolean-string.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public"
 db-max-rows = ""
 db-plan-enabled = false
 db-pool = 10
-db-pool-acquisition-timeout = ""
+db-pool-acquisition-timeout = 10
+db-pool-max-lifetime = 1800
 db-pre-request = ""
 db-prepared-statements = false
 db-root-spec = ""

test/io/configs/expected/defaults.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public"
 db-max-rows = ""
 db-plan-enabled = false
 db-pool = 10
-db-pool-acquisition-timeout = ""
+db-pool-acquisition-timeout = 10
+db-pool-max-lifetime = 1800
 db-pre-request = ""
 db-prepared-statements = true
 db-root-spec = ""

test/io/configs/expected/no-defaults-with-db-other-authenticator.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public,extensions,other"
 db-max-rows = 100
 db-plan-enabled = true
 db-pool = 1
-db-pool-acquisition-timeout = 10
+db-pool-acquisition-timeout = 30
+db-pool-max-lifetime = 3600
 db-pre-request = "test.other_custom_headers"
 db-prepared-statements = false
 db-root-spec = "other_root"

test/io/configs/expected/no-defaults-with-db.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public,extensions,private"
 db-max-rows = 1000
 db-plan-enabled = true
 db-pool = 1
-db-pool-acquisition-timeout = 10
+db-pool-acquisition-timeout = 30
+db-pool-max-lifetime = 3600
 db-pre-request = "test.custom_headers"
 db-prepared-statements = false
 db-root-spec = "root"

test/io/configs/expected/no-defaults.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public,test"
 db-max-rows = 1000
 db-plan-enabled = true
 db-pool = 1
-db-pool-acquisition-timeout = 10
+db-pool-acquisition-timeout = 30
+db-pool-max-lifetime = 3600
 db-pre-request = "please_run_fast"
 db-prepared-statements = false
 db-root-spec = "openapi_v3"

test/io/configs/expected/types.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public"
 db-max-rows = ""
 db-plan-enabled = false
 db-pool = 10
-db-pool-acquisition-timeout = ""
+db-pool-acquisition-timeout = 10
+db-pool-max-lifetime = 1800
 db-pre-request = ""
 db-prepared-statements = true
 db-root-spec = ""

test/io/configs/no-defaults-env.yaml

@@ -7,7 +7,8 @@ PGRST_DB_EXTRA_SEARCH_PATH: public, test
 PGRST_DB_MAX_ROWS: 1000
 PGRST_DB_PLAN_ENABLED: true
 PGRST_DB_POOL: 1
-PGRST_DB_POOL_ACQUISITION_TIMEOUT: 10
+PGRST_DB_POOL_ACQUISITION_TIMEOUT: 30
+PGRST_DB_POOL_MAX_LIFETIME: 3600
 PGRST_DB_PREPARED_STATEMENTS: false
 PGRST_DB_PRE_REQUEST: please_run_fast
 PGRST_DB_ROOT_SPEC: openapi_v3

test/io/configs/no-defaults.config

@@ -5,7 +5,8 @@ db-extra-search-path = "public, test"
 db-max-rows = 1000
 db-plan-enabled = true
 db-pool = 1
-db-pool-acquisition-timeout = 10
+db-pool-acquisition-timeout = 30
+db-pool-max-lifetime = 3600
 db-pre-request = "please_run_fast"
 db-prepared-statements = false
 db-root-spec = "openapi_v3"

test/io/test_io.py

@@ -572,6 +572,16 @@ def test_pool_acquisition_timeout(defaultenv, metapostgrest):
         data = response.json()
         assert data["message"] == "Timed out acquiring connection from connection pool."
 
+        # ensure the message appears on the logs as well
+        output = None
+        for _ in range(10):
+            output = postgrest.process.stdout.readline()
+            if output:
+                break
+            time.sleep(0.1)
+
+        assert "Timed out acquiring connection from connection pool." in output.decode()
+
 
 def test_change_statement_timeout_held_connection(defaultenv, metapostgrest):
     "Statement timeout changes take effect immediately, even with a request outliving the reconfiguration"

test/spec/Feature/Query/PlanSpec.hs

@@ -13,9 +13,10 @@ import           Network.HTTP.Types
 import           Test.Hspec           hiding (pendingWith)
 import           Test.Hspec.Wai
 import           Test.Hspec.Wai.JSON
+import           Text.Heredoc
 
-import PostgREST.Config.PgVersion (PgVersion, pgVersion100,
+import PostgREST.Config.PgVersion (PgVersion, pgVersion120,
-                                   pgVersion120, pgVersion130)
+                                   pgVersion130)
 import Protolude                  hiding (get)
 import SpecHelper
 
@@ -26,7 +27,7 @@ spec actualPgVersion = do
       r <- request methodGet "/projects?id=in.(1,2,3)"
              (acceptHdrs "application/vnd.pgrst.plan+json") ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
@@ -35,14 +36,14 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
-            then Just [aesonQQ|15.63|]
+            then 15.63
-            else Just [aesonQQ|15.69|]
+            else 15.69
 
     it "outputs the total cost for a single filter on a view" $ do
       r <- request methodGet "/projects_view?id=gt.2"
              (acceptHdrs "application/vnd.pgrst.plan+json") ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
@@ -51,8 +52,8 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
-            then Just [aesonQQ|24.28|]
+            then 24.28
-            else Just [aesonQQ|32.28|]
+            else 32.28
 
     it "outputs blocks info when using the buffers option" $
       if actualPgVersion >= pgVersion130
@@ -158,7 +159,7 @@ spec actualPgVersion = do
       r <- request methodPost "/projects"
              (acceptHdrs "application/vnd.pgrst.plan+json") [json|{"id":100, "name": "Project 100"}|]
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
@@ -167,14 +168,14 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
-            then Just [aesonQQ|3.28|]
+            then 3.28
-            else Just [aesonQQ|3.33|]
+            else 3.33
 
     it "outputs the total cost for an update" $ do
       r <- request methodPatch "/projects?id=eq.3"
              (acceptHdrs "application/vnd.pgrst.plan+json") [json|{"name": "Patched Project"}|]
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
@@ -183,28 +184,28 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion > pgVersion120
-            then Just [aesonQQ|12.45|]
+            then 12.45
-            else Just [aesonQQ|12.5|]
+            else 12.5
 
     it "outputs the total cost for a delete" $ do
       r <- request methodDelete "/projects?id=in.(1,2,3)"
              (acceptHdrs "application/vnd.pgrst.plan+json") ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
       liftIO $ do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` Just [aesonQQ|15.68|]
+        totalCost `shouldBe` 15.68
 
     it "outputs the total cost for a single upsert" $ do
       r <- request methodPut "/tiobe_pls?name=eq.Go"
             (acceptHdrs "application/vnd.pgrst.plan+json")
             [json| [ { "name": "Go", "rank": 19 } ]|]
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
@@ -213,8 +214,8 @@ spec actualPgVersion = do
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         totalCost `shouldBe`
           if actualPgVersion >= pgVersion120
-            then Just [aesonQQ|1.3|]
+            then 1.3
-            else Just [aesonQQ|1.35|]
+            else 1.35
 
     it "outputs the plan for application/vnd.pgrst.object" $ do
       r <- request methodDelete "/projects?id=eq.6"
@@ -232,14 +233,14 @@ spec actualPgVersion = do
       r <- request methodGet "/rpc/getallprojects?id=in.(1,2,3)"
              (acceptHdrs "application/vnd.pgrst.plan+json") ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      let totalCost  = planCost r
           resHeaders = simpleHeaders r
           resStatus  = simpleStatus r
 
       liftIO $ do
         resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+json; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
-        totalCost `shouldBe` Just [aesonQQ|68.57|]
+        totalCost `shouldBe` 68.57
 
     it "outputs the plan for text/xml" $ do
       r <- request methodGet "/rpc/return_scalar_xml"
@@ -282,33 +283,56 @@ spec actualPgVersion = do
   describe "resource embedding costs" $ do
     it "a one to many doesn't surpass a threshold" $ do
       r <- request methodGet "/clients?select=*,projects(*)&id=eq.1"
-             (acceptHdrs "application/vnd.pgrst.plan+json") ""
+             [planHdr] ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      liftIO $ planCost r `shouldSatisfy` (< 33.3)
-      liftIO $ totalCost `shouldBe`
-          if actualPgVersion > pgVersion120
-            then Just [aesonQQ|33.25|]
-            else Just [aesonQQ|33.27|]
 
     it "a many to one doesn't surpass a threshold" $ do
       r <- request methodGet "/projects?select=*,clients(*)&id=eq.1"
-             (acceptHdrs "application/vnd.pgrst.plan+json") ""
+             [planHdr] ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      liftIO $ planCost r `shouldSatisfy` (< 16.5)
-      liftIO $ totalCost `shouldBe`
-          if actualPgVersion > pgVersion120
-            then Just [aesonQQ|16.39|]
-            else Just [aesonQQ|16.41|]
 
     it "a many to many doesn't surpass a threshold" $ do
       r <- request methodGet "/users?select=*,tasks(*)&id=eq.1"
              (acceptHdrs "application/vnd.pgrst.plan+json") ""
 
-      let totalCost  = simpleBody r ^? nth 0 . key "Plan" . key "Total Cost"
+      liftIO $ planCost r `shouldSatisfy` (< 70.9)
-      liftIO $ totalCost `shouldBe`
+
-          if | actualPgVersion > pgVersion120 -> Just [aesonQQ|69.34|]
+
-             | actualPgVersion > pgVersion100 -> Just [aesonQQ|69.36|]
+  describe "function call costs" $ do
-             | otherwise                      -> Just [aesonQQ|70.81|]
+    it "should not exceed cost when calling setof composite proc" $ do
+      r <- request methodGet "/rpc/get_projects_below?id=3"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 36.4)
+
+    it "should not exceed cost when calling setof composite proc with empty params" $ do
+      r <- request methodGet "/rpc/getallprojects"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 71.0)
+
+    it "should not exceed cost when calling scalar proc" $ do
+      r <- request methodGet "/rpc/add_them?a=3&b=4"
+             [planHdr] ""
+
+      liftIO $ planCost r `shouldSatisfy` (< 1.18)
+
+    context "params=multiple-objects" $ do
+      it "should not exceed cost when calling setof composite proc" $ do
+        r <- request methodPost "/rpc/get_projects_below"
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"id": 1}, {"id": 4}] |]
+
+        liftIO $ planCost r `shouldSatisfy` (< 4503.4)
+
+      it "should not exceed cost when calling scalar proc" $ do
+        r <- request methodPost "/rpc/add_them"
+               [planHdr, ("Prefer", "params=multiple-objects")]
+               [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]
+
+        liftIO $ planCost r `shouldSatisfy` (< 5.85)
 
 disabledSpec :: SpecWith ((), Application)
 disabledSpec =

test/spec/Main.hs

@@ -64,7 +64,7 @@ import qualified Feature.RpcPreRequestGucsSpec
 
 main :: IO ()
 main = do
-  pool <- P.acquire 3 Nothing $ toUtf8 $ configDbUri testCfg
+  pool <- P.acquire 3 10 60 $ toUtf8 $ configDbUri testCfg
 
   actualPgVersion <- either (panic . show) id <$> P.use pool queryPgVersion
 

test/spec/QueryCost.hs

@@ -1,86 +0,0 @@
--- TODO Can be replaced now by obtaining the EXPLAIN plan and adding the cost tests on PlanSpec.hs
-module Main where
-
-import           Control.Lens                      ((^?))
-import qualified Data.Aeson.Lens                   as L
-import qualified Hasql.Decoders                    as HD
-import qualified Hasql.DynamicStatements.Snippet   as H
-import qualified Hasql.DynamicStatements.Statement as H
-import qualified Hasql.Pool                        as P
-import qualified Hasql.Statement                   as H
-import qualified Hasql.Transaction                 as HT
-import qualified Hasql.Transaction.Sessions        as HT
-import           Text.Heredoc
-
-import Protolude hiding (get, toS)
-
-import PostgREST.Plan.CallPlan
-import PostgREST.Query.QueryBuilder (callPlanToQuery)
-
-import PostgREST.SchemaCache.Identifiers
-import PostgREST.SchemaCache.Proc
-
-import Test.Hspec
-
-main :: IO ()
-main = do
-  pool <- P.acquire 3 Nothing "postgresql://"
-
-  hspec $ describe "QueryCost" $
-    context "call proc query" $ do
-      it "should not exceed cost when calling setof composite proc" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
-          (KeyParams [ProcParam "id" "int" True False])
-          (Just [str| {"id": 3} |]) False False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 40)
-
-      it "should not exceed cost when calling setof composite proc with empty params" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "getallprojects") (KeyParams []) Nothing False False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 30)
-
-      it "should not exceed cost when calling scalar proc" $ do
-        cost <- exec pool $
-          callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
-          (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
-          (Just [str| {"a": 3, "b": 4} |]) True False [])
-        liftIO $
-          cost `shouldSatisfy` (< Just 10)
-
-      context "params=multiple-objects" $ do
-        it "should not exceed cost when calling setof composite proc" $ do
-          cost <- exec pool $
-            callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "get_projects_below")
-            (KeyParams [ProcParam "id" "int" True False])
-            (Just [str| [{"id": 1}, {"id": 4}] |]) False True [])
-          liftIO $ do
-            -- lower bound needed for now to make sure that cost is not Nothing
-            cost `shouldSatisfy` (> Just 2000)
-            cost `shouldSatisfy` (< Just 2100)
-
-        it "should not exceed cost when calling scalar proc" $ do
-          cost <- exec pool $
-            callPlanToQuery (FunctionCall (QualifiedIdentifier "test" "add_them")
-            (KeyParams [ProcParam "a" "int" True False, ProcParam "b" "int" True False])
-            (Just [str| [{"a": 3, "b": 4}, {"a": 1, "b": 2}, {"a": 8, "b": 7}] |]) True False [])
-          liftIO $
-            cost `shouldSatisfy` (< Just 10)
-
-
-exec :: P.Pool -> H.Snippet -> IO (Maybe Int64)
-exec pool query =
-  join . rightToMaybe <$>
-  P.use pool (HT.transaction HT.ReadCommitted HT.Read $ HT.statement mempty $ explainCost query)
-
-explainCost :: H.Snippet -> H.Statement () (Maybe Int64)
-explainCost query =
-  H.dynamicallyParameterized snippet decodeExplain False
- where
-   snippet = "EXPLAIN (FORMAT JSON) " <> query
-   decodeExplain :: HD.Result (Maybe Int64)
-   decodeExplain =
-     let row = HD.singleRow $ HD.column $ HD.nonNullable HD.bytea in
-     (^? L.nth 0 . L.key "Plan" .  L.key "Total Cost" . L._Integral) <$> row

test/spec/SpecHelper.hs

@@ -1,9 +1,12 @@
 module SpecHelper where
 
+import           Control.Lens           ((^?))
+import           Data.Aeson.Lens
 import qualified Data.ByteString.Base64 as B64 (decodeLenient)
 import qualified Data.ByteString.Char8  as BS
 import qualified Data.ByteString.Lazy   as BL
 import qualified Data.Map.Strict        as M
+import           Data.Scientific        (toRealFloat)
 import qualified Data.Set               as S
 
 import Data.Aeson           (Value (..), decode, encode)
@@ -79,7 +82,8 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
   , configDbMaxRows             = Nothing
   , configDbPlanEnabled         = False
   , configDbPoolSize            = 10
-  , configDbPoolAcquisitionTimeout = Nothing
+  , configDbPoolAcquisitionTimeout = 10
+  , configDbPoolMaxLifetime     = 1800
   , configDbPreRequest          = Just $ QualifiedIdentifier "test" "switch_role"
   , configDbPreparedStatements  = True
   , configDbRootSpec            = Nothing
@@ -213,6 +217,9 @@ rangeHdrsWithCount r = ("Prefer", "count=exact") : rangeHdrs r
 acceptHdrs :: BS.ByteString -> [Header]
 acceptHdrs mime = [(hAccept, mime)]
 
+planHdr :: Header
+planHdr = (hAccept, "application/vnd.pgrst.plan+json")
+
 rangeUnit :: Header
 rangeUnit = ("Range-Unit" :: CI BS.ByteString, "items")
 
@@ -276,3 +283,13 @@ requestMutation method path body =
 
 data BaseTable = BaseTable ByteString ByteString Value
 data MutationCheck = MutationCheck BaseTable (WaiExpectation ())
+
+planCost :: SResponse -> Float
+planCost resp =
+  let res = simpleBody resp ^? nth 0 . key "Plan" . key "Total Cost" in
+  -- big value in case parsing fails
+  fromMaybe 1000000000.0 $ unbox =<< res
+  where
+    unbox :: Value -> Maybe Float
+    unbox (Number n) = Just $ toRealFloat n
+    unbox _          = Nothing