mdebray/tvl-depot
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
Show stats Download patch file Download diff file Expand all files Collapse all files

169
users/Profpatsch/my-prelude/src/Postgres/MonadPostgres.hs
View file

@ -370,20 +370,19 @@ addErrorInformation msg io =
-- print the query that was run and the query parameters, -- print the query that was run and the query parameters,
-- then rethrow inside an 'Error'. -- then rethrow inside an 'Error'.
handlePGException :: handlePGException ::
forall a params tools m. forall a params m.
( ToRow params, ( ToRow params,
MonadUnliftIO m, MonadUnliftIO m,
MonadLogger m, MonadLogger m
HasField "pgFormat" tools PgFormatPool
) => ) =>
tools -> PrettyPrintDatabaseQueries ->
Text -> Text ->
Query -> Query ->
-- | Depending on whether we used `format` or `formatMany`. -- | Depending on whether we used `format` or `formatMany`.
Either params (NonEmpty params) -> Either params (NonEmpty params) ->
IO a -> IO a ->
Transaction m a Transaction m a
handlePGException tools queryType query' params io = do handlePGException prettyQuery queryType query' params io = do
withRunInIO $ \unliftIO -> withRunInIO $ \unliftIO ->
io io
`catches` [ Handler $ unliftIO . logQueryException @SqlError, `catches` [ Handler $ unliftIO . logQueryException @SqlError,
@ -397,9 +396,10 @@ handlePGException tools queryType query' params io = do
throwErr err = liftIO $ throwAsError $ prettyErrorTree $ nestedMultiError "A Postgres query failed" err throwErr err = liftIO $ throwAsError $ prettyErrorTree $ nestedMultiError "A Postgres query failed" err
logQueryException :: (Exception e) => e -> Transaction m a logQueryException :: (Exception e) => e -> Transaction m a
logQueryException exc = do logQueryException exc = do
formattedQuery <- case params of formattedQuery <-
Left one -> pgFormatQuery' tools query' one case params of
Right many -> pgFormatQueryMany' tools query' many Left one -> pgFormatQuery' prettyQuery query' one
Right many -> pgFormatQueryMany' prettyQuery query' many
throwErr throwErr
( singleError [fmt|Query Type: {queryType}|] ( singleError [fmt|Query Type: {queryType}|]
:| [ nestedError "Exception" (exc & showPretty & newError & singleError), :| [ nestedError "Exception" (exc & showPretty & newError & singleError),
@ -533,55 +533,52 @@ runPGTransactionImpl zoom (Transaction transaction) = do
unliftIO $ runReaderT transaction conn unliftIO $ runReaderT transaction conn
executeImpl :: executeImpl ::
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) => (ToRow params, MonadUnliftIO m, MonadLogger m, Otel.MonadTracer m) =>
m tools ->
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
params -> params ->
Transaction m (Label "numberOfRowsAffected" Natural) Transaction m (Label "numberOfRowsAffected" Natural)
{-# INLINE executeImpl #-} {-# INLINE executeImpl #-}
executeImpl zoomTools zoomDbOptions qry params = executeImpl zoomDbOptions qry params =
Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasSingleParam params) traceQueryIfEnabled span logDatabaseQueries prettyQuery qry (HasSingleParam params)
conn <- Transaction ask conn <- Transaction ask
PG.execute conn qry params PG.execute conn qry params
& handlePGException tools "execute" qry (Left params) & handlePGException prettyQuery "execute" qry (Left params)
>>= toNumberOfRowsAffected "executeImpl" >>= toNumberOfRowsAffected "executeImpl"
executeImpl_ :: executeImpl_ ::
(MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) => ( MonadUnliftIO m,
m tools -> MonadLogger m,
Otel.MonadTracer m
) =>
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
Transaction m (Label "numberOfRowsAffected" Natural) Transaction m (Label "numberOfRowsAffected" Natural)
{-# INLINE executeImpl_ #-} {-# INLINE executeImpl_ #-}
executeImpl_ zoomTools zoomDbOptions qry = executeImpl_ zoomDbOptions qry =
Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled @() tools span logDatabaseQueries prettyQuery qry HasNoParams traceQueryIfEnabled @() span logDatabaseQueries prettyQuery qry HasNoParams
conn <- Transaction ask conn <- Transaction ask
PG.execute_ conn qry PG.execute_ conn qry
& handlePGException tools "execute_" qry (Left ()) & handlePGException prettyQuery "execute_" qry (Left ())
>>= toNumberOfRowsAffected "executeImpl_" >>= toNumberOfRowsAffected "executeImpl_"
executeManyImpl :: executeManyImpl ::
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) => (ToRow params, MonadUnliftIO m, MonadLogger m, Otel.MonadTracer m) =>
m tools ->
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
NonEmpty params -> NonEmpty params ->
Transaction m (Label "numberOfRowsAffected" Natural) Transaction m (Label "numberOfRowsAffected" Natural)
executeManyImpl zoomTools zoomDbOptions qry params = executeManyImpl zoomDbOptions qry params =
Otel.inSpan' "Postgres Query (executeMany)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (executeMany)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasMultiParams params) traceQueryIfEnabled span logDatabaseQueries prettyQuery qry (HasMultiParams params)
conn <- Transaction ask conn <- Transaction ask
PG.executeMany conn qry (params & toList) PG.executeMany conn qry (params & toList)
& handlePGException tools "executeMany" qry (Right params) & handlePGException prettyQuery "executeMany" qry (Right params)
>>= toNumberOfRowsAffected "executeManyImpl" >>= toNumberOfRowsAffected "executeManyImpl"
toNumberOfRowsAffected :: (MonadIO m) => Text -> Int64 -> m (Label "numberOfRowsAffected" Natural) toNumberOfRowsAffected :: (MonadIO m) => Text -> Int64 -> m (Label "numberOfRowsAffected" Natural)
@ -595,31 +592,31 @@ toNumberOfRowsAffected functionName i64 =
<&> label @"numberOfRowsAffected" <&> label @"numberOfRowsAffected"
executeManyReturningWithImpl :: executeManyReturningWithImpl ::
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) => ( ToRow params,
m tools -> MonadUnliftIO m,
MonadLogger m,
Otel.MonadTracer m
) =>
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
NonEmpty params -> NonEmpty params ->
Decoder r -> Decoder r ->
Transaction m [r] Transaction m [r]
{-# INLINE executeManyReturningWithImpl #-} {-# INLINE executeManyReturningWithImpl #-}
executeManyReturningWithImpl zoomTools zoomDbOptions qry params (Decoder fromRow) = do executeManyReturningWithImpl zoomDbOptions qry params (Decoder fromRow) = do
Otel.inSpan' "Postgres Query (executeManyReturning)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (executeManyReturning)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasMultiParams params) traceQueryIfEnabled span logDatabaseQueries prettyQuery qry (HasMultiParams params)
conn <- Transaction ask conn <- Transaction ask
PG.returningWith fromRow conn qry (params & toList) PG.returningWith fromRow conn qry (params & toList)
& handlePGException tools "executeManyReturning" qry (Right params) & handlePGException prettyQuery "executeManyReturning" qry (Right params)
foldRowsWithAccImpl :: foldRowsWithAccImpl ::
( ToRow params, ( ToRow params,
MonadUnliftIO m, MonadUnliftIO m,
MonadLogger m, MonadLogger m,
HasField "pgFormat" tools PgFormatPool,
Otel.MonadTracer m Otel.MonadTracer m
) => ) =>
m tools ->
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
params -> params ->
@ -628,11 +625,10 @@ foldRowsWithAccImpl ::
(a -> row -> Transaction m a) -> (a -> row -> Transaction m a) ->
Transaction m a Transaction m a
{-# INLINE foldRowsWithAccImpl #-} {-# INLINE foldRowsWithAccImpl #-}
foldRowsWithAccImpl zoomTools zoomDbOptions qry params (Decoder rowParser) accumulator f = do foldRowsWithAccImpl zoomDbOptions qry params (Decoder rowParser) accumulator f = do
Otel.inSpan' "Postgres Query (foldRowsWithAcc)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (foldRowsWithAcc)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasSingleParam params) traceQueryIfEnabled span logDatabaseQueries prettyQuery qry (HasSingleParam params)
conn <- Transaction ask conn <- Transaction ask
withRunInIO withRunInIO
( \runInIO -> ( \runInIO ->
@ -645,17 +641,18 @@ foldRowsWithAccImpl zoomTools zoomDbOptions qry params (Decoder rowParser) accum
params params
accumulator accumulator
(\acc row -> runInIO $ f acc row) (\acc row -> runInIO $ f acc row)
& handlePGException tools "fold" qry (Left params) & handlePGException prettyQuery "fold" qry (Left params)
& runInIO & runInIO
) )
pgFormatQueryNoParams' :: pgFormatQueryNoParams' ::
(MonadIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool) => (MonadIO m, MonadLogger m) =>
tools -> PrettyPrintDatabaseQueries ->
Query -> Query ->
Transaction m ByteString Transaction m ByteString
pgFormatQueryNoParams' tools q = pgFormatQueryNoParams' prettyQuery q = case prettyQuery of
lift $ pgFormatQueryByteString tools q.fromQuery DontPrettyPrintDatabaseQueries -> pure q.fromQuery
PrettyPrintDatabaseQueries pool -> lift $ pgFormatQueryByteString pool q.fromQuery
pgFormatQuery :: pgFormatQuery ::
(ToRow params, MonadIO m) => (ToRow params, MonadIO m) =>
@ -686,40 +683,36 @@ queryWithImpl ::
( ToRow params, ( ToRow params,
MonadUnliftIO m, MonadUnliftIO m,
MonadLogger m, MonadLogger m,
HasField "pgFormat" tools PgFormatPool,
Otel.MonadTracer m Otel.MonadTracer m
) => ) =>
m tools ->
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) -> m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
Query -> Query ->
params -> params ->
Decoder r -> Decoder r ->
Transaction m [r] Transaction m [r]
{-# INLINE queryWithImpl #-} {-# INLINE queryWithImpl #-}
queryWithImpl zoomTools zoomDbOptions qry params (Decoder fromRow) = do queryWithImpl zoomDbOptions qry params (Decoder fromRow) = do
Otel.inSpan' "Postgres Query (queryWith)" Otel.defaultSpanArguments $ \span -> do Otel.inSpan' "Postgres Query (queryWith)" Otel.defaultSpanArguments $ \span -> do
tools <- lift @Transaction zoomTools
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions (logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasSingleParam params) traceQueryIfEnabled span logDatabaseQueries prettyQuery qry (HasSingleParam params)
conn <- Transaction ask conn <- Transaction ask
PG.queryWith fromRow conn qry params PG.queryWith fromRow conn qry params
& handlePGException tools "query" qry (Left params) & handlePGException prettyQuery "query" qry (Left params)
queryWithImpl_ :: queryWithImpl_ ::
( MonadUnliftIO m, ( MonadUnliftIO m,
MonadLogger m, MonadLogger m
HasField "pgFormat" tools PgFormatPool
) => ) =>
m tools -> m PrettyPrintDatabaseQueries ->
Query -> Query ->
Decoder r -> Decoder r ->
Transaction m [r] Transaction m [r]
{-# INLINE queryWithImpl_ #-} {-# INLINE queryWithImpl_ #-}
queryWithImpl_ zoomTools qry (Decoder fromRow) = do queryWithImpl_ zoomDbOptions qry (Decoder fromRow) = do
tools <- lift @Transaction zoomTools prettyQuery <- lift @Transaction zoomDbOptions
conn <- Transaction ask conn <- Transaction ask
liftIO (PG.queryWith_ fromRow conn qry) liftIO (PG.queryWith_ fromRow conn qry)
& handlePGException tools "query" qry (Left ()) & handlePGException prettyQuery "query" qry (Left ())
data SingleRowError = SingleRowError data SingleRowError = SingleRowError
{ -- | How many columns were actually returned by the query { -- | How many columns were actually returned by the query
@ -733,30 +726,32 @@ instance Exception SingleRowError where
pgFormatQuery' :: pgFormatQuery' ::
( MonadIO m, ( MonadIO m,
ToRow params, ToRow params,
MonadLogger m, MonadLogger m
HasField "pgFormat" tools PgFormatPool
) => ) =>
tools -> PrettyPrintDatabaseQueries ->
Query -> Query ->
params -> params ->
Transaction m ByteString Transaction m ByteString
pgFormatQuery' tools q p = pgFormatQuery' prettyQuery q p = case prettyQuery of
pgFormatQuery q p DontPrettyPrintDatabaseQueries -> pgFormatQuery q p
>>= lift . pgFormatQueryByteString tools PrettyPrintDatabaseQueries pool ->
pgFormatQuery q p
>>= lift . pgFormatQueryByteString pool
pgFormatQueryMany' :: pgFormatQueryMany' ::
( MonadIO m, ( MonadIO m,
ToRow params, ToRow params,
MonadLogger m, MonadLogger m
HasField "pgFormat" tools PgFormatPool
) => ) =>
tools -> PrettyPrintDatabaseQueries ->
Query -> Query ->
NonEmpty params -> NonEmpty params ->
Transaction m ByteString Transaction m ByteString
pgFormatQueryMany' tools q p = pgFormatQueryMany' prettyQuery q p = case prettyQuery of
pgFormatQueryMany q p DontPrettyPrintDatabaseQueries -> pgFormatQueryMany q p
>>= lift . pgFormatQueryByteString tools PrettyPrintDatabaseQueries pool ->
pgFormatQueryMany q p
>>= lift . pgFormatQueryByteString pool
-- | Read the executable name "pg_format" -- | Read the executable name "pg_format"
postgresToolsParser :: ToolParserT IO (Label "pgFormat" Tool) postgresToolsParser :: ToolParserT IO (Label "pgFormat" Tool)
@ -764,17 +759,16 @@ postgresToolsParser = label @"pgFormat" <$> readTool "pg_format"
pgFormatQueryByteString :: pgFormatQueryByteString ::
( MonadIO m, ( MonadIO m,
MonadLogger m, MonadLogger m
HasField "pgFormat" tools PgFormatPool
) => ) =>
tools -> PgFormatPool ->
ByteString -> ByteString ->
m ByteString m ByteString
pgFormatQueryByteString tools queryBytes = do pgFormatQueryByteString pool queryBytes = do
res <- res <-
liftIO $ liftIO $
runPgFormat runPgFormat
tools.pgFormat pool
(queryBytes) (queryBytes)
case res.exitCode of case res.exitCode of
ExitSuccess -> pure (res.formatted) ExitSuccess -> pure (res.formatted)
@ -832,8 +826,11 @@ data PrettyPrintDatabaseQueries
= -- | Do not pretty-print database querios = -- | Do not pretty-print database querios
DontPrettyPrintDatabaseQueries DontPrettyPrintDatabaseQueries
| -- | Pretty-print database queries, slow | -- | Pretty-print database queries, slow
PrettyPrintDatabaseQueries PrettyPrintDatabaseQueries PgFormatPool
deriving stock (Show, Enum, Bounded)
instance Show PrettyPrintDatabaseQueries where
show DontPrettyPrintDatabaseQueries = "DontPrettyPrintDatabaseQueries"
show (PrettyPrintDatabaseQueries _) = "PrettyPrintDatabaseQueries"
data HasQueryParams param data HasQueryParams param
= HasNoParams = HasNoParams
@ -845,29 +842,25 @@ traceQueryIfEnabled ::
( ToRow params, ( ToRow params,
MonadUnliftIO m, MonadUnliftIO m,
MonadLogger m, MonadLogger m,
HasField "pgFormat" tools PgFormatPool,
Otel.MonadTracer m Otel.MonadTracer m
) => ) =>
tools ->
Otel.Span -> Otel.Span ->
DebugLogDatabaseQueries -> DebugLogDatabaseQueries ->
PrettyPrintDatabaseQueries -> PrettyPrintDatabaseQueries ->
Query -> Query ->
HasQueryParams params -> HasQueryParams params ->
Transaction m () Transaction m ()
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry params = do traceQueryIfEnabled span logDatabaseQueries prettyQuery qry params = do
-- In case we have query logging enabled, we want to do that -- In case we have query logging enabled, we want to do that
let formattedQuery = case prettyQuery of let formattedQuery =
DontPrettyPrintDatabaseQueries -> pure qry.fromQuery withEvent
PrettyPrintDatabaseQueries -> do span
withEvent "Query Format start"
span "Query Format end"
"Query Format start" $ case params of
"Query Format end" HasNoParams -> pgFormatQueryNoParams' prettyQuery qry
$ case params of HasSingleParam p -> pgFormatQuery' prettyQuery qry p
HasNoParams -> pgFormatQueryNoParams' tools qry HasMultiParams ps -> pgFormatQueryMany' prettyQuery qry ps
HasSingleParam p -> pgFormatQuery' tools qry p
HasMultiParams ps -> pgFormatQueryMany' tools qry ps
let doLog errs = let doLog errs =
Otel.addAttributes Otel.addAttributes
@ -884,7 +877,7 @@ traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry params = do
q <- formattedQuery q <- formattedQuery
Otel.inSpan "Postgres EXPLAIN Query" Otel.defaultSpanArguments $ do Otel.inSpan "Postgres EXPLAIN Query" Otel.defaultSpanArguments $ do
queryWithImpl_ queryWithImpl_
(pure tools) (pure prettyQuery)
( "EXPLAIN " ( "EXPLAIN "
<> ( <> (
-- TODO: this is not nice, but the only way to get the `executeMany` form to work with this -- TODO: this is not nice, but the only way to get the `executeMany` form to work with this

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

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