diff --git a/CHANGELOG.md b/CHANGELOG.md index 85ce1ba0629..21cf719eb4b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -13,6 +13,7 @@ This project adheres to [Semantic Versioning](http://semver.org/). - #3171, #3046, Log schema cache stats to stderr - @steve-chavez - #3210, Dump schema cache through admin API - @taimoorzaeem - #2676, Performance improvement on bulk json inserts, around 10% increase on requests per second by removing `json_typeof` from write queries - @steve-chavez + - #3214, Log connection pool events on log-level=info - @steve-chavez ### Fixed diff --git a/nix/overlays/haskell-packages.nix b/nix/overlays/haskell-packages.nix index 744fb231d4a..3a6a0adcee9 100644 --- a/nix/overlays/haskell-packages.nix +++ b/nix/overlays/haskell-packages.nix @@ -60,18 +60,26 @@ let } { }; + hasql-pool = + lib.dontCheck (prev.callHackageDirect + { + pkg = "hasql-pool"; + ver = "1.0.1"; + sha256 = "sha256-Hf1f7lX0LWkjrb25SDBovCYPRdmUP1H6pAxzi7kT4Gg="; + } + { } + ); + postgresql-libpq = lib.dontCheck (prev.postgresql-libpq_0_10_0_0.override { postgresql = super.libpq; }); - hasql-pool = lib.dontCheck prev.hasql-pool_0_10; - hasql-notifications = lib.dontCheck (prev.callHackageDirect { pkg = "hasql-notifications"; - ver = "0.2.1.0"; - sha256 = "sha256-MEIirDKR81KpiBOnWJbVInWevL6Kdb/XD1Qtd8e6KsQ="; + ver = "0.2.1.1"; + sha256 = "sha256-oPhKA/pSQGJvgQyhsi7CVr9iDT7uWpKUz0iJfXsaxXo="; } { } ); diff --git a/postgrest.cabal b/postgrest.cabal index 3f77bca6268..1893f263787 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -108,8 +108,8 @@ library , gitrev >= 1.2 && < 1.4 , hasql >= 1.6.1.1 && < 1.7 , hasql-dynamic-statements >= 0.3.1 && < 0.4 - , hasql-notifications >= 0.2.1.0 && < 0.3 - , hasql-pool >= 0.10 && < 0.11 + , hasql-notifications >= 0.2.1.1 && < 0.3 + , hasql-pool >= 1.0.1 && < 1.1 , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3 , http-types >= 0.12.2 && < 0.13 @@ -254,7 +254,7 @@ test-suite spec , bytestring >= 0.10.8 && < 0.13 , case-insensitive >= 1.2 && < 1.3 , containers >= 0.5.7 && < 0.7 - , hasql-pool >= 0.10 && < 0.11 + , hasql-pool >= 1.0.1 && < 1.1 , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3 , hspec >= 2.3 && < 2.12 diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index cbea46e40e7..76c8e4a39ab 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -39,6 +39,7 @@ import qualified Data.Text as T (unpack) import Hasql.Connection (acquire) import qualified Hasql.Notifications as SQL import qualified Hasql.Pool as SQL +import qualified Hasql.Pool.Config as SQL import qualified Hasql.Session as SQL import qualified Hasql.Transaction.Sessions as SQL import qualified Network.HTTP.Types.Status as HTTP @@ -122,7 +123,7 @@ init :: AppConfig -> IO AppState init conf@AppConfig{configLogLevel} = do loggerState <- Logger.init let observer = Logger.observationLogger loggerState configLogLevel - pool <- initPool conf + pool <- initPool conf observer (sock, adminSock) <- initSockets conf state' <- initWithPool (sock, adminSock) pool conf loggerState observer pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock} @@ -193,14 +194,16 @@ initSockets AppConfig{..} = do pure (sock, adminSock) -initPool :: AppConfig -> IO SQL.Pool -initPool AppConfig{..} = - SQL.acquire - configDbPoolSize - (fromIntegral configDbPoolAcquisitionTimeout) - (fromIntegral configDbPoolMaxLifetime) - (fromIntegral configDbPoolMaxIdletime) - (toUtf8 $ addFallbackAppName prettyVersion configDbUri) +initPool :: AppConfig -> ObservationHandler -> IO SQL.Pool +initPool AppConfig{..} observer = + SQL.acquire $ SQL.settings + [ SQL.size configDbPoolSize + , SQL.acquisitionTimeout $ fromIntegral configDbPoolAcquisitionTimeout + , SQL.agingTimeout $ fromIntegral configDbPoolMaxLifetime + , SQL.idlenessTimeout $ fromIntegral configDbPoolMaxIdletime + , SQL.staticConnectionSettings (toUtf8 $ addFallbackAppName prettyVersion configDbUri) + , SQL.observationHandler $ observer . HasqlPoolObs + ] -- | Run an action with a database connection. usePool :: AppState -> SQL.Session a -> IO (Either SQL.UsageError a) diff --git a/src/PostgREST/Logger.hs b/src/PostgREST/Logger.hs index dcee2d0ec08..55ab16a6c3f 100644 --- a/src/PostgREST/Logger.hs +++ b/src/PostgREST/Logger.hs @@ -81,6 +81,9 @@ observationLogger loggerState logLevel obs = case obs of o@(QueryErrorCodeHighObs _) -> do when (logLevel >= LogError) $ do logWithZTime loggerState $ observationMessage o + o@(HasqlPoolObs _) -> do + when (logLevel >= LogInfo) $ do + logWithZTime loggerState $ observationMessage o o -> logWithZTime loggerState $ observationMessage o diff --git a/src/PostgREST/Observation.hs b/src/PostgREST/Observation.hs index 3cb863584e9..afefbe0a2e6 100644 --- a/src/PostgREST/Observation.hs +++ b/src/PostgREST/Observation.hs @@ -9,14 +9,15 @@ module PostgREST.Observation , ObservationHandler ) where -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Hasql.Connection as SQL -import qualified Hasql.Pool as SQL -import qualified Network.Socket as NS -import Numeric (showFFloat) -import qualified PostgREST.Error as Error +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Hasql.Connection as SQL +import qualified Hasql.Pool as SQL +import qualified Hasql.Pool.Observation as SQL +import qualified Network.Socket as NS +import Numeric (showFFloat) +import qualified PostgREST.Error as Error import Protolude import Protolude.Partial (fromJust) @@ -50,6 +51,7 @@ data Observation | QueryRoleSettingsErrorObs SQL.UsageError | QueryErrorCodeHighObs SQL.UsageError | PoolAcqTimeoutObs SQL.UsageError + | HasqlPoolObs SQL.Observation type ObservationHandler = Observation -> IO () @@ -111,6 +113,18 @@ observationMessage = \case "Config reloaded" PoolAcqTimeoutObs usageErr -> jsonMessage usageErr + HasqlPoolObs (SQL.ConnectionObservation uuid status) -> + "Connection " <> show uuid <> ( + case status of + SQL.ConnectingConnectionStatus -> " is being established" + SQL.ReadyForUseConnectionStatus -> " is available" + SQL.InUseConnectionStatus -> " is used" + SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of + SQL.AgingConnectionTerminationReason -> "max lifetime" + SQL.IdlenessConnectionTerminationReason -> "max idletime" + SQL.ReleaseConnectionTerminationReason -> "release" + SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message. + ) where showMillis :: Double -> Text showMillis x = toS $ showFFloat (Just 1) (x * 1000) "" diff --git a/test/spec/Main.hs b/test/spec/Main.hs index 044fe0b1b36..882fb7eb36f 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -1,6 +1,7 @@ module Main where import qualified Hasql.Pool as P +import qualified Hasql.Pool.Config as P import qualified Hasql.Transaction.Sessions as HT import Data.Function (id) @@ -70,7 +71,13 @@ import qualified Feature.RpcPreRequestGucsSpec main :: IO () main = do let observer = const $ pure () - pool <- P.acquire 3 10 60 60 $ toUtf8 $ configDbUri testCfg + pool <- P.acquire $ P.settings + [ P.size 3 + , P.acquisitionTimeout 10 + , P.agingTimeout 60 + , P.idlenessTimeout 60 + , P.staticConnectionSettings (toUtf8 $ configDbUri testCfg) + ] actualPgVersion <- either (panic . show) id <$> P.use pool (queryPgVersion False)