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

1 files changed, 21 insertions, 10 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