Allow discarding postgres connections periodically to free memory. Wo…

…rks around #5087

Default is to never consider connections stale and discard. I'm not sure
that's a good default.

Also related: #3388 #4077

CHANGELOG.md

@@ -76,6 +76,7 @@ Read more about the session argument for computed fields in the [docs](https://h
 - server: raise error on startup when `--unauthorized-role` is ignored (#4736)
 - server: fix mishandling of GeoJSON inputs in subscriptions (fix #3239)
 - server: fix importing of allow list query from metadata (fix #4687)
+- server: add new `--stale-timeout` and `HASURA_GRAPHQL_PG_STALE_TIMEOUT` connection pool options, to work around space leak caused by libpq buffers (#5087)
 - server: flush log buffer during shutdown (#4800)
 - server: fix edge case with printing logs on startup failure (fix #4772)
 - console: provide option to cascade metadata on dependency conflicts on console (fix #1593)

server/cabal.project

@@ -36,7 +36,8 @@ package graphql-engine
 source-repository-package
   type: git
   location: https://github.com/hasura/pg-client-hs.git
-  tag: 70a849d09bea9461e72c5a5bbde06df65aab61c0
+  -- TODO merge https://github.com/hasura/pg-client-hs/pull/16 
+  tag: b526847a79966f0cd7b6de9365a83b4411ad2002 
 
 source-repository-package
   type: git

server/graphql-engine.cabal

@@ -42,6 +42,8 @@ common common-exe
   ghc-options:
     -threaded -rtsopts
     -- Re. `-I2` see #2565
+    -- TODO try the new: -Iw flag: 
+    --   http://downloads.haskell.org/~ghc/latest/docs/html/users_guide/runtime_control.html#rts-flag--Iw%20%E2%9F%A8seconds%E2%9F%A9 
     --
     -- `-qn2` limits the parallel GC to at most 2 capabilities. This came up in #3354/#3394, as the
     -- parallel GC was causing significant performance overhead. Folks in #ghc on freenode advised

server/src-lib/Hasura/Server/Init.hs

@@ -207,14 +207,15 @@ mkServeOptions rso = do
 #else
     defaultAPIs = [METADATA,GRAPHQL,PGDUMP,CONFIG]
 #endif
-    mkConnParams (RawConnParams s c i p) = do
+    mkConnParams (RawConnParams s c i stale p) = do
       stripes <- fromMaybe 1 <$> withEnv s (fst pgStripesEnv)
       -- Note: by Little's Law we can expect e.g. (with 50 max connections) a
       -- hard throughput cap at 1000RPS when db queries take 50ms on average:
       conns <- fromMaybe 50 <$> withEnv c (fst pgConnsEnv)
       iTime <- fromMaybe 180 <$> withEnv i (fst pgTimeoutEnv)
+      staleTime <- withEnv stale (fst pgStaleTimeoutEnv)
       allowPrepare <- fromMaybe True <$> withEnv p (fst pgUsePrepareEnv)
-      return $ Q.ConnParams stripes conns iTime allowPrepare
+      return $ Q.ConnParams stripes conns iTime allowPrepare staleTime
 
     mkAuthHook (AuthHookG mUrl mType) = do
       mUrlEnv <- withEnv mUrl $ fst authHookEnv
@@ -391,6 +392,13 @@ pgTimeoutEnv =
   , "Each connection's idle time before it is closed (default: 180 sec)"
   )
 
+pgStaleTimeoutEnv :: (String, String)
+pgStaleTimeoutEnv =
+  ( "HASURA_GRAPHQL_PG_STALE_TIMEOUT"
+  , "Time from connection creation after which the connection should be destroyed and a new one " 
+    <> "created. (default: none)"
+  )
+
 pgUsePrepareEnv :: (String, String)
 pgUsePrepareEnv =
   ( "HASURA_GRAPHQL_USE_PREPARED_STATEMENTS"
@@ -598,7 +606,7 @@ parseTxIsolation = optional $
 
 parseConnParams :: Parser RawConnParams
 parseConnParams =
-  RawConnParams <$> stripes <*> conns <*> timeout <*> allowPrepare
+  RawConnParams <$> stripes <*> conns <*> idleTimeout <*> staleTimeout <*> allowPrepare
   where
     stripes = optional $
       option auto
@@ -616,12 +624,20 @@ parseConnParams =
                help (snd pgConnsEnv)
             )
 
-    timeout = optional $
+    idleTimeout = optional $
       option auto
               ( long "timeout" <>
                 metavar "<SECONDS>" <>
                 help (snd pgTimeoutEnv)
               )
+
+    staleTimeout = fmap (fmap fromRational) $ optional $
+      option auto
+              ( long "stale-timeout" <>
+                metavar "<SECONDS>" <>
+                help (snd pgStaleTimeoutEnv)
+              )
+
     allowPrepare = optional $
       option (eitherReader parseStringAsBool)
               ( long "use-prepared-statements" <>

server/src-lib/Hasura/Server/Init/Config.hs

@@ -9,6 +9,7 @@ import qualified Data.Text                        as T
 import qualified Database.PG.Query                as Q
 
 import           Data.Char                        (toLower)
+import           Data.Time
 import           Network.Wai.Handler.Warp         (HostPreference)
 
 import qualified Hasura.Cache                     as Cache
@@ -26,6 +27,9 @@ data RawConnParams
   { rcpStripes      :: !(Maybe Int)
   , rcpConns        :: !(Maybe Int)
   , rcpIdleTime     :: !(Maybe Int)
+  , rcpStaleTime    :: !(Maybe NominalDiffTime)
+  -- ^ Time from connection creation after which to destroy a connection and
+  -- choose a different/new one.
   , rcpAllowPrepare :: !(Maybe Bool)
   } deriving (Show, Eq)
 
@@ -202,6 +206,11 @@ readJson = J.eitherDecodeStrict . txtToBs . T.pack
 class FromEnv a where
   fromEnv :: String -> Either String a
 
+-- Deserialize from seconds, in the usual way
+instance FromEnv NominalDiffTime where
+  fromEnv s = maybe (Left "could not parse as a Double") (Right . realToFrac) $
+                (readMaybe s :: Maybe Double)
+
 instance FromEnv String where
   fromEnv = Right