feat: log schema cache stats to stderr

PostgREST · Feb 7, 2024 · 7834f6a · 7834f6a
1 parent 71887e4
commit 7834f6a
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 6 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -9,6 +9,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 
  - #2887, Add Preference `max-affected` to limit affected resources - @taimoorzaeem
  - #3171, Add an ability to dump config via admin API - @skywriter
+ - #3171, Log schema cache stats to stderr - @steve-chavez
 
 ### Fixed
 

diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs
@@ -46,6 +46,7 @@ import qualified Network.HTTP.Types.Status  as HTTP
 import qualified Network.Socket             as NS
 import qualified PostgREST.Error            as Error
 import           PostgREST.Version          (prettyVersion)
+import           System.TimeIt              (timeItT)
 
 import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate,
                            updateAction)
@@ -58,6 +59,8 @@ import Data.Time          (ZonedTime, defaultTimeLocale, formatTime,
                            getZonedTime)
 import Data.Time.Clock    (UTCTime, getCurrentTime)
 
+import Numeric (showFFloat)
+
 import PostgREST.Config                  (AppConfig (..),
                                           LogLevel (..),
                                           addFallbackAppName,
@@ -67,8 +70,9 @@ import PostgREST.Config.Database         (queryDbSettings,
                                           queryRoleSettings)
 import PostgREST.Config.PgVersion        (PgVersion (..),
                                           minimumPgVersion)
-import PostgREST.SchemaCache             (SchemaCache,
-                                          querySchemaCache)
+import PostgREST.SchemaCache             (SchemaCache (..),
+                                          querySchemaCache,
+                                          showSummary)
 import PostgREST.SchemaCache.Identifiers (dumpQi)
 import PostgREST.Unix                    (createAndBindDomainSocket)
 
@@ -307,9 +311,9 @@ data SCacheStatus
 loadSchemaCache :: AppState -> IO SCacheStatus
 loadSchemaCache appState = do
   conf@AppConfig{..} <- getConfig appState
-  result <-
+  (resultTime, result) <-
     let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in
-    usePool appState conf . transaction SQL.ReadCommitted SQL.Read $
+    timeItT $ usePool appState conf . transaction SQL.ReadCommitted SQL.Read $
       querySchemaCache conf
   case result of
     Left e -> do
@@ -326,9 +330,14 @@ loadSchemaCache appState = do
           return SCOnRetry
 
     Right sCache -> do
-      putSchemaCache appState (Just sCache)
-      logWithZTime appState "Schema cache loaded"
+      putSchemaCache appState $ Just sCache
+      logWithZTime appState $ "Schema cache queried in " <> showMillis resultTime  <> " milliseconds"
+      (sCacheLoadTime, _) <- timeItT $ logWithZTime appState $ showSummary sCache
+      logWithZTime appState $ "Schema cache loaded in " <> showMillis sCacheLoadTime <> " milliseconds"
       return SCLoaded
+  where
+    showMillis :: Double -> Text
+    showMillis x = toS $ showFFloat (Just 1) (x * 1000) ""
 
 -- | Current database connection status data ConnectionStatus
 data ConnectionStatus

diff --git a/src/PostgREST/SchemaCache.hs b/src/PostgREST/SchemaCache.hs
@@ -24,6 +24,7 @@ module PostgREST.SchemaCache
   , accessibleTables
   , accessibleFuncs
   , schemaDescription
+  , showSummary
   ) where
 
 import Control.Monad.Extra (whenJust)
@@ -34,6 +35,7 @@ import qualified Data.Aeson.Types           as JSON
 import qualified Data.HashMap.Strict        as HM
 import qualified Data.HashMap.Strict.InsOrd as HMI
 import qualified Data.Set                   as S
+import qualified Data.Text                  as T
 import qualified Hasql.Decoders             as HD
 import qualified Hasql.Encoders             as HE
 import qualified Hasql.Statement            as SQL
@@ -94,6 +96,16 @@ instance JSON.ToJSON SchemaCache where
     , "dbTimezones"       .= JSON.emptyArray
     ]
 
+showSummary :: SchemaCache -> Text
+showSummary (SchemaCache tbls rels routs reps mediaHdlrs _) =
+  T.intercalate ", "
+  [ "Relations: " <> show (HM.size tbls)
+  , "Relationships: " <> show (HM.size rels)
+  , "Routines: " <> show (HM.size routs)
+  , "Domain Representations: " <> show (HM.size reps)
+  , "Media Type Handlers: " <> show (HM.size mediaHdlrs)
+  ]
+
 -- | A view foreign key or primary key dependency detected on its source table
 -- Each column of the key could be referenced multiple times in the view, e.g.
 --