upgrade to fork of hasql-pool 0.7.2 (fixes #2401)

This version of hasql-pool is a simplified rewrite that doesn't use
the resource-pool package. The major API changes are that idle
connections are no longer timed out (and the corresponding setting
is gone), and that `release` makes the pool unusable, where it used
to remain usable and only flushed idle connections.

We depend on a PostgREST fork of 0.7.2 that gives us reliable
flushing, compare https://github.com/PostgREST/hasql-pool/pull/1

- hasql-pool 0.7 removes timing out of idle connections, so
  this change removes the db-pool-timeout option.
  Given that we were typically running with very high
  timeout settings, I don't anticipate the lack of timeout
  to introduce new issues, though we might want to consider
  introducing some retry-logic down the line when we
  encounter connection failures.
- See https://github.com/PostgREST/postgrest/issues/2422 for a
  discussion on depending on a forked dependency. Besides adding
  the dependency to the nix overlay, we're also adding it to
  stack.yaml and a new cabal.project to allow stack/cabal users
  to build the project.

.github/workflows/ci.yaml

@@ -224,6 +224,9 @@ jobs:
         run: |
           ghcup install ghc ${{ matrix.ghc }}
           ghcup set ghc ${{ matrix.ghc }}
+      - name: Copy cabal.project
+        run: |
+          cp cabal.project.non-nix cabal.project
       - name: Cache
         uses: actions/cache@v3
         with:

CHANGELOG.md

@@ -8,6 +8,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 ### Deprecated
 
 - #1385, Deprecate bulk-calls when including the `Prefer: params=multiple-objects` in the request. A function with a JSON array or object parameter should be used instead for a better performance.
+ - #2401, #2444, Fix SIGUSR1 to fully flush connections pool, remove `db-pool-timeout`. - @robx
 
 ## [10.0.0] - 2022-08-18
 
@@ -74,6 +75,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
  - #2410, Fix loop crash error on startup in Postgres 15 beta 3. Log: "UNION types \"char\" and text cannot be matched". - @yevon
  - #2397, Fix race conditions managing database connection helper - @robx
  - #2269, Allow `limit=0` in the request query to return an empty array - @gautam1168, @laurenceisla
+ - #2401, Ensure database connections can't outlive SIGUSR1 - @robx
 
 ### Changed
 

cabal.project.non-nix

@@ -0,0 +1,10 @@
+-- Settings to allow building with plain cabal. If this was
+-- named just cabal.project, it would interfere with the default
+-- nix build.
+
+packages: .
+
+source-repository-package
+  type: git
+  location: https://github.com/PostgREST/hasql-pool.git
+  tag: 4d462c4d47d762effefc7de6c85eaed55f144f1d

nix/overlays/haskell-packages.nix

@@ -31,6 +31,16 @@ let
       #
       # To get the sha256:
       #   nix-prefetch-url --unpack https://github.com/<owner>/<repo>/archive/<commit>.tar.gz
+
+      hasql-pool = lib.dontCheck (
+        prev.callCabal2nix "hasql-pool"
+          (super.fetchFromGitHub {
+            owner = "PostgREST";
+            repo = "hasql-pool";
+            rev = "4d462c4d47d762effefc7de6c85eaed55f144f1d"; # master as of 2022-08-26
+            sha256 = "sha256-UwX1PynimrQHm1KCs4BQXMwYYY3h4T5UAkgtEJ0EZQQ=";
+          })
+          { });
     } // extraOverrides final prev;
 in
 {

postgrest.cabal

@@ -88,7 +88,7 @@ library
                     , hasql                     >= 1.4 && < 1.6
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
                     , hasql-notifications       >= 0.1 && < 0.3
-                    , hasql-pool                >= 0.5 && < 0.6
+                    , hasql-pool                >= 0.7.2 && < 0.8
                     , hasql-transaction         >= 1.0.1 && < 1.1
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13
@@ -226,7 +226,7 @@ test-suite spec
                     , bytestring        >= 0.10.8 && < 0.12
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
-                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-pool        >= 0.7.2 && < 0.8
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.9
@@ -269,7 +269,7 @@ test-suite querycost
                     , contravariant     >= 1.4 && < 1.6
                     , hasql             >= 1.4 && < 1.6
                     , hasql-dynamic-statements >= 0.3.1 && < 0.4
-                    , hasql-pool        >= 0.5 && < 0.6
+                    , hasql-pool        >= 0.7.2 && < 0.8
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.9

src/PostgREST/AppState.hs

@@ -74,12 +74,12 @@ data AppState = AppState
 
 init :: AppConfig -> IO AppState
 init conf = do
-  newPool <- initPool conf
+  pool <- initPool conf
-  initWithPool newPool conf
+  initWithPool pool conf
 
 initWithPool :: SQL.Pool -> AppConfig -> IO AppState
-initWithPool newPool conf =
+initWithPool pool conf =
-  AppState newPool
+  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
@@ -93,23 +93,24 @@ initWithPool newPool conf =
     <*> newIORef 0
 
 destroy :: AppState -> IO ()
-destroy AppState{..} = SQL.release statePool
+destroy = destroyPool
 
 initPool :: AppConfig -> IO SQL.Pool
 initPool AppConfig{..} =
-  SQL.acquire (configDbPoolSize, configDbPoolTimeout, toUtf8 configDbUri)
+  SQL.acquire configDbPoolSize $ toUtf8 configDbUri
 
+-- | Run an action with a database connection.
 usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a)
 usePool AppState{..} = SQL.use statePool
 
 -- | Flush the connection pool so that any future use of the pool will
 -- use connections freshly established after this call.
---
--- FIXME: #2401 Connections that are in-use during the call to flushPool
--- will currently be returned to the pool and reused afterwards, in
--- conflict with the intention.
 flushPool :: AppState -> IO ()
-flushPool AppState{..} = SQL.release statePool
+flushPool AppState{..} = SQL.flush statePool
+
+-- | Destroy the pool on shutdown.
+destroyPool :: AppState -> IO ()
+destroyPool AppState{..} = SQL.release statePool
 
 getPgVersion :: AppState -> IO PgVersion
 getPgVersion = readIORef . statePgVersion

src/PostgREST/CLI.hs

@@ -148,9 +148,6 @@ exampleConfigFile =
       |## Number of open connections in the pool
       |db-pool = 10
       |
-      |## Time to live, in seconds, for an idle database pool connection
-      |db-pool-timeout = 3600
-      |
       |## Stored proc to exec immediately after auth
       |# db-pre-request = "stored_proc_name"
       |

src/PostgREST/Config.hs

@@ -46,7 +46,6 @@ import Data.List               (lookup)
 import Data.List.NonEmpty      (fromList, toList)
 import Data.Maybe              (fromJust)
 import Data.Scientific         (floatingOrInteger)
-import Data.Time.Clock         (NominalDiffTime)
 import Numeric                 (readOct, showOct)
 import System.Environment      (getEnvironment)
 import System.Posix.Types      (FileMode)
@@ -71,7 +70,6 @@ data AppConfig = AppConfig
   , configDbMaxRows             :: Maybe Integer
   , configDbPlanEnabled         :: Bool
   , configDbPoolSize            :: Int
-  , configDbPoolTimeout         :: NominalDiffTime
   , configDbPreRequest          :: Maybe QualifiedIdentifier
   , configDbPreparedStatements  :: Bool
   , configDbRootSpec            :: Maybe QualifiedIdentifier
@@ -131,7 +129,6 @@ toText conf =
       ,("db-max-rows",                   maybe "\"\"" show . configDbMaxRows)
       ,("db-plan-enabled",               T.toLower . show . configDbPlanEnabled)
       ,("db-pool",                       show . configDbPoolSize)
-      ,("db-pool-timeout",               show . floor . configDbPoolTimeout)
       ,("db-pre-request",            q . maybe mempty dumpQi . configDbPreRequest)
       ,("db-prepared-statements",        T.toLower . show . configDbPreparedStatements)
       ,("db-root-spec",              q . maybe mempty dumpQi . configDbRootSpec)
@@ -220,7 +217,6 @@ parser optPath env dbSettings =
                      (optInt "max-rows")
     <*> (fromMaybe False <$> optBool "db-plan-enabled")
     <*> (fromMaybe 10 <$> optInt "db-pool")
-    <*> (fromIntegral . fromMaybe 3600 <$> optInt "db-pool-timeout")
     <*> (fmap toQi <$> optWithAlias (optString "db-pre-request")
                                     (optString "pre-request"))
     <*> (fromMaybe True <$> optBool "db-prepared-statements")
@@ -356,7 +352,7 @@ 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_timeout", "db_config"]
+            "db_uri", "db_channel_enabled", "db_channel", "db_pool", "db_config"]
           then lookup dbSettingName dbSettings
           else Nothing
 

src/PostgREST/Error.hs

@@ -225,12 +225,17 @@ instance JSON.ToJSON PgError where
   toJSON (PgError _ usageError) = JSON.toJSON usageError
 
 instance JSON.ToJSON SQL.UsageError where
-  toJSON (SQL.ConnectionError e) = JSON.object [
+  toJSON (SQL.ConnectionUsageError e) = JSON.object [
     "code"    .= ConnectionErrorCode00,
     "message" .= ("Database connection error. Retrying the connection." :: Text),
     "details" .= (T.decodeUtf8With T.lenientDecode $ fromMaybe "" e :: Text),
     "hint"    .= JSON.Null]
-  toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error
+  toJSON (SQL.SessionUsageError e) = JSON.toJSON e -- SQL.Error
+  toJSON SQL.PoolIsReleasedUsageError = JSON.object [
+    "code"    .= InternalErrorCode00,
+    "message" .= ("Use of released pool" :: Text),
+    "details" .= JSON.Null,
+    "hint"    .= JSON.Null]
 
 instance JSON.ToJSON SQL.QueryError where
   toJSON (SQL.QueryError _ _ e) = JSON.toJSON e
@@ -255,9 +260,10 @@ instance JSON.ToJSON SQL.CommandError where
     "hint"    .= JSON.Null]
 
 pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status
-pgErrorStatus _      (SQL.ConnectionError _)                                      = HTTP.status503
+pgErrorStatus _      (SQL.ConnectionUsageError _) = HTTP.status503
-pgErrorStatus _      (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _)))      = HTTP.status503
+pgErrorStatus _      SQL.PoolIsReleasedUsageError = HTTP.status500
-pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
+pgErrorStatus _      (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ClientError _)))      = HTTP.status503
+pgErrorStatus authed (SQL.SessionUsageError (SQL.QueryError _ _ (SQL.ResultError rError))) =
   case rError of
     (SQL.ServerError c m _ _) ->
       case BS.unpack c of
@@ -296,12 +302,12 @@ pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rErr
     _                       -> HTTP.status500
 
 checkIsFatal :: PgError -> Maybe Text
-checkIsFatal (PgError _ (SQL.ConnectionError e))
+checkIsFatal (PgError _ (SQL.ConnectionUsageError e))
   | isAuthFailureMessage = Just $ toS failureMessage
   | otherwise = Nothing
   where isAuthFailureMessage = "FATAL:  password authentication failed" `isPrefixOf` failureMessage
         failureMessage = BS.unpack $ fromMaybe mempty e
-checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError))))
+checkIsFatal (PgError _ (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" _ _ _

stack.yaml

@@ -14,8 +14,9 @@ extra-deps:
   - configurator-pg-0.2.6@sha256:cd9b06a458428e493a4d6def725af7ab1ab0fef678fbd871f9586fc7f9aa70be,2849
   - hasql-dynamic-statements-0.3.1.1@sha256:2cfe6e75990e690f595a87cbe553f2e90fcd738610f6c66749c81cc4396b2cc4,2675
   - hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
-  - hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
   - lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
   - optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
   - protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240
   - ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
+  - git: https://github.com/PostgREST/hasql-pool.git
+    commit: 4d462c4d47d762effefc7de6c85eaed55f144f1d

stack.yaml.lock

@@ -32,13 +32,6 @@ packages:
       sha256: d49af8f8749ab7039fa668af4b78f997f7fa2928b4aded6798f573a3d08e76a0
   original:
     hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
-- completed:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
-    pantry-tree:
-      size: 412
-      sha256: 2741a33f947d28b4076c798c20c1f646beecd21f5eaf522c8256cbeb34d4d6d0
-  original:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
 - completed:
     hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
     pantry-tree:
@@ -67,6 +60,17 @@ packages:
       sha256: 557c438345de19f82bf01d676100da2a191ef06f624e7a4b90b09ac17cbb52a5
   original:
     hackage: ptr-0.16.8.2@sha256:708ebb95117f2872d2c5a554eb6804cf1126e86abe793b2673f913f14e5eb1ac,3959
+- completed:
+    name: hasql-pool
+    version: 0.7.2
+    git: https://github.com/PostgREST/hasql-pool.git
+    pantry-tree:
+      size: 570
+      sha256: a388a9fc47252f7ba06874bc7e8fca769e6f33752320a29724801c298be00816
+    commit: 4d462c4d47d762effefc7de6c85eaed55f144f1d
+  original:
+    git: https://github.com/PostgREST/hasql-pool.git
+    commit: 4d462c4d47d762effefc7de6c85eaed55f144f1d
 snapshots:
 - completed:
     size: 618951

test/io/configs/expected/aliases.config

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

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

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

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

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

test/io/configs/expected/defaults.config

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

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

@@ -5,7 +5,6 @@ db-extra-search-path = "public,extensions,other"
 db-max-rows = 100
 db-plan-enabled = true
 db-pool = 1
-db-pool-timeout = 100
 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,6 @@ db-extra-search-path = "public,extensions,private"
 db-max-rows = 1000
 db-plan-enabled = true
 db-pool = 1
-db-pool-timeout = 100
 db-pre-request = "test.custom_headers"
 db-prepared-statements = false
 db-root-spec = "root"

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

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

test/io/configs/expected/types.config

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

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

@@ -7,7 +7,6 @@ PGRST_DB_EXTRA_SEARCH_PATH: public, test
 PGRST_DB_MAX_ROWS: 1000
 PGRST_DB_PLAN_ENABLED: true
 PGRST_DB_POOL: 1
-PGRST_DB_POOL_TIMEOUT: 100
 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,6 @@ db-extra-search-path = "public, test"
 db-max-rows = 1000
 db-plan-enabled = true
 db-pool = 1
-db-pool-timeout = 100
 db-pre-request = "please_run_fast"
 db-prepared-statements = false
 db-root-spec = "openapi_v3"

test/io/test_io.py

@@ -123,7 +123,6 @@ def defaultenv(baseenv):
         "PGRST_DB_CONFIG": "true",
         "PGRST_LOG_LEVEL": "info",
         "PGRST_DB_POOL": "1",
-        "PGRST_DB_POOL_TIMEOUT": "1",
     }
 
 
@@ -139,7 +138,6 @@ def metapostgrest():
         "PGRST_DB_CONFIG": "true",
         "PGRST_LOG_LEVEL": "info",
         "PGRST_DB_POOL": "1",
-        "PGRST_DB_POOL_TIMEOUT": "1",
     }
     with run(env=env) as postgrest:
         yield postgrest
@@ -995,7 +993,6 @@ def test_pool_size(defaultenv, metapostgrest):
         assert delta > 1 and delta < 1.5
 
 
-@pytest.mark.xfail(reason="issue #2401")
 def test_change_statement_timeout_held_connection(defaultenv, metapostgrest):
     "Statement timeout changes take effect immediately, even with a request outliving the reconfiguration"
 

test/spec/Main.hs

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

test/spec/QueryCost.hs

@@ -24,7 +24,7 @@ import Test.Hspec
 
 main :: IO ()
 main = do
-  pool <- P.acquire (3, 10, "postgresql://")
+  pool <- P.acquire 3 "postgresql://"
 
   hspec $ describe "QueryCost" $
     context "call proc query" $ do

test/spec/SpecHelper.hs

@@ -79,7 +79,6 @@ baseCfg = let secret = Just $ encodeUtf8 "reallyreallyreallyreallyverysafe" in
   , configDbMaxRows             = Nothing
   , configDbPlanEnabled         = False
   , configDbPoolSize            = 10
-  , configDbPoolTimeout         = 10
   , configDbPreRequest          = Just $ QualifiedIdentifier "test" "switch_role"
   , configDbPreparedStatements  = True
   , configDbRootSpec            = Nothing