maurice/snix
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Profpatsch 2024-08-06 11:42:38 +02:00
parent 2510cd6a5c
commit 13d79e04d8
3 changed files with 109 additions and 104 deletions
Download patch file Download diff file Expand all files Collapse all files

31
users/Profpatsch/whatcd-resolver/src/AppT.hs
View file

@ -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

13
users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
View file

@ -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 {..}