fix(users/Profpatsch/whatcd-resolver): fix postgres query log r/8448

The queries would not be interpolated anymore, because we didn’t pass
the thing down deep enough.

Also only init the `pgFormatPool` if we want to use the formatter,
this saves on a bunch of subprocesses.

Change-Id: I8d69ef5aab4d8eac1cbfb1c3991d4edaacba254f
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12139
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI

2 files changed, 28 insertions, 16 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs
index f1015f27ebe0..397ea5c33b2f 100644
--- a/users/Profpatsch/whatcd-resolver/src/AppT.hs
+++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs
@@ -25,10 +25,14 @@ import UnliftIO
 import Prelude hiding (span)
 
 data Context = Context
-  { config :: T2 "logDatabaseQueries" DebugLogDatabaseQueries "prettyPrintDatabaseQueries" PrettyPrintDatabaseQueries,
+  { pgConfig ::
+      T2
+        "logDatabaseQueries"
+        DebugLogDatabaseQueries
+        "prettyPrintDatabaseQueries"
+        PrettyPrintDatabaseQueries,
+    pgConnPool :: (Pool Postgres.Connection),
     tracer :: Otel.Tracer,
-    pgFormat :: PgFormatPool,
-    pgConnPool :: Pool Postgres.Connection,
     transmissionSessionId :: IORef (Maybe ByteString),
     redactedApiKey :: ByteString
   }
@@ -147,17 +151,24 @@ recordException span dat = liftIO $ do
 -- * Postgres
 
 instance (MonadThrow m, MonadUnliftIO m) => MonadPostgres (AppT m) where
-  execute = executeImpl (AppT ask) dbConfig
-  executeMany = executeManyImpl (AppT ask) dbConfig
-  executeManyReturningWith = executeManyReturningWithImpl (AppT ask) dbConfig
-  queryWith = queryWithImpl (AppT ask) dbConfig
-  queryWith_ = queryWithImpl_ (AppT ask)
+  execute = executeImpl dbConfig
+  executeMany = executeManyImpl dbConfig
+  executeManyReturningWith = executeManyReturningWithImpl dbConfig
+  queryWith = queryWithImpl dbConfig
+  queryWith_ = queryWithImpl_ (dbConfig <&> snd)
 
-  foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) dbConfig
+  foldRowsWithAcc = foldRowsWithAccImpl dbConfig
   runTransaction = runPGTransaction
 
 dbConfig :: (Monad m) => AppT m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries)
-dbConfig = AppT $ asks (\c -> (c.config.logDatabaseQueries, c.config.prettyPrintDatabaseQueries))
+dbConfig =
+  AppT $
+    asks
+      ( \c ->
+          ( c.pgConfig.logDatabaseQueries,
+            c.pgConfig.prettyPrintDatabaseQueries
+          )
+      )
 
 runPGTransaction :: (MonadUnliftIO m) => Transaction (AppT m) a -> AppT m a
 runPGTransaction (Transaction transaction) = do
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index d3219be9164b..169d3b82aa46 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -776,12 +776,13 @@ httpTorrent span req =
 runAppWith :: AppT IO a -> IO (Either TmpPg.StartError a)
 runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
   tool <- readTools (label @"toolsEnvVar" "WHATCD_RESOLVER_TOOLS") (readTool "pg_format")
-  pgFormat <- initPgFormatPool (label @"pgFormat" tool)
   prettyPrintDatabaseQueries <-
-    Env.lookupEnv "WHATCD_RESOLVER_PRETTY_PRINT_DATABASE_QUERIES" <&> \case
-      Just _ -> PrettyPrintDatabaseQueries
-      Nothing -> DontPrettyPrintDatabaseQueries
-  let config =
+    Env.lookupEnv "WHATCD_RESOLVER_PRETTY_PRINT_DATABASE_QUERIES" >>= \case
+      Nothing -> pure DontPrettyPrintDatabaseQueries
+      Just _ -> do
+        pgFormat <- initPgFormatPool (label @"pgFormat" tool)
+        pure $ PrettyPrintDatabaseQueries pgFormat
+  let pgConfig =
         T2
           (label @"logDatabaseQueries" LogDatabaseQueries)
           (label @"prettyPrintDatabaseQueries" prettyPrintDatabaseQueries)
@@ -800,7 +801,7 @@ runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
         logInfo "WHATCD_RESOLVER_REDACTED_API_KEY was not set, trying pass"
         runCommandExpect0 "pass" ["internet/redacted/api-keys/whatcd-resolver"]
   let newAppT = do
-        logInfo [fmt|Running with config: {showPretty config}|]
+        logInfo [fmt|Running with config: {showPretty pgConfig}|]
         logInfo [fmt|Connected to database at {db & TmpPg.toDataDirectory} on socket {db & TmpPg.toConnectionString}|]
         appT
   runReaderT newAppT.unAppT Context {..}