upgrade to fork of hasql-pool 0.7.2 (fixes PostgREST#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 PostgREST/hasql-pool#1 - This change removes the db-pool-timeout option, since new hasql-pool doesn't provide timing out of idle connections. 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.
robx · Aug 24, 2022 · c653960 · c653960
1 parent 022e7ca
commit c653960
Show file tree

Hide file tree

Showing 23 changed files with 47 additions and 50 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -70,6 +70,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
 

diff --git a/nix/overlays/haskell-packages.nix b/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 = "df2ad3fad60b1353d9945e59ca27cbb2dc286c1d"; # branch flush-072, FIXME wait for merge
+            sha256 = "sha256-/VurSBThpts3zLWDVe9Xg62JZXff/x2JhczKDoKlxiA=";
+          })
+          { });
     } // extraOverrides final prev;
 in
 {

diff --git a/postgrest.cabal b/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

diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs
@@ -74,12 +74,12 @@ data AppState = AppState
 
 init :: AppConfig -> IO AppState
 init conf = do
-  newPool <- initPool conf
-  initWithPool newPool conf
+  pool <- initPool conf
+  initWithPool pool conf
 
 initWithPool :: SQL.Pool -> AppConfig -> IO AppState
-initWithPool newPool conf =
-  AppState newPool
+initWithPool pool conf =
+  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
+usePool AppState{..} session = SQL.use statePool session
 
 -- | 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

diff --git a/src/PostgREST/CLI.hs b/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"
       |

diff --git a/src/PostgREST/Config.hs b/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")

diff --git a/src/PostgREST/Error.hs b/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.SessionError (SQL.QueryError _ _ (SQL.ClientError _)))      = HTTP.status503
-pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) =
+pgErrorStatus _      (SQL.ConnectionUsageError _) = HTTP.status503
+pgErrorStatus _      SQL.PoolIsReleasedUsageError = HTTP.status500
+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" _ _ _

diff --git a/stack.yaml b/stack.yaml
@@ -14,7 +14,7 @@ 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
+  - hasql-pool-0.7.2@sha256:3f9178ab710e71e241617158c7d8e96a6c27de8e5bc8d140885dd13667899467,2414
   - lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
   - optparse-applicative-0.16.1.0@sha256:418c22ed6a19124d457d96bc66bd22c93ac22fad0c7100fe4972bbb4ac989731,4982
   - protolude-0.3.2@sha256:2a38b3dad40d238ab644e234b692c8911423f9d3ed0e36b62287c4a698d92cd1,2240

diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -33,12 +33,12 @@ packages:
   original:
     hackage: hasql-implicits-0.1.0.4@sha256:0848d3cbc9d94e1e539948fa0be4d0326b26335034161bf8076785293444ca6f,1361
 - completed:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
+    hackage: hasql-pool-0.7.2@sha256:3f9178ab710e71e241617158c7d8e96a6c27de8e5bc8d140885dd13667899467,2414
     pantry-tree:
-      size: 412
-      sha256: 2741a33f947d28b4076c798c20c1f646beecd21f5eaf522c8256cbeb34d4d6d0
+      size: 345
+      sha256: 70142f456d6613f8e0465321fdaa25811c013eca96c240501a490cbdb47d1c4a
   original:
-    hackage: hasql-pool-0.5.2.2@sha256:b56d4dea112d97a2ef4b2749508c0ca646828cb2d77b827e8dc433d249bb2062,2438
+    hackage: hasql-pool-0.7.2@sha256:3f9178ab710e71e241617158c7d8e96a6c27de8e5bc8d140885dd13667899467,2414
 - completed:
     hackage: lens-aeson-1.1.3@sha256:52c8eaecd2d1c2a969c0762277c4a8ee72c339a686727d5785932e72ef9c3050,1764
     pantry-tree:

diff --git a/test/io/configs/expected/aliases.config b/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"

diff --git a/test/io/configs/expected/boolean-numeric.config b/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 = ""

diff --git a/test/io/configs/expected/boolean-string.config b/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 = ""

diff --git a/test/io/configs/expected/defaults.config b/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 = ""

diff --git a/test/io/configs/expected/no-defaults-with-db-other-authenticator.config b/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"

diff --git a/test/io/configs/expected/no-defaults-with-db.config b/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"

diff --git a/test/io/configs/expected/no-defaults.config b/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"

diff --git a/test/io/configs/expected/types.config b/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 = ""

diff --git a/test/io/configs/no-defaults-env.yaml b/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

diff --git a/test/io/configs/no-defaults.config b/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"

diff --git a/test/io/test_io.py b/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
@@ -970,7 +968,6 @@ def sleep(i=i):
         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"
 

diff --git a/test/spec/Main.hs b/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
 

diff --git a/test/spec/QueryCost.hs b/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

diff --git a/test/spec/SpecHelper.hs b/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