fix(users/Profpatsch/whatcd-resolver): SQL formatting off
It turns out the pg_format thing is just too slow for my use-cases most of the time, even when pooling the mf. Most queries stay 90%+ in the perl script, even though they are very fast to execute on their own, screwing up the traces a lot. So instead I replace the `postgres-simple` quasi-quoter that strips whitespace (and tends to screw up queries anyway) with a simple one that just removes the outer indentation up to the first line. Why did I spend so much time on pg_format haha Change-Id: I911cd869deec68aa5cf430ff4d111b0662ec6d28 Reviewed-on: https://cl.tvl.fyi/c/depot/+/12138 Tested-by: BuildkiteCI Reviewed-by: Profpatsch <mail@profpatsch.de>
This commit is contained in:
parent
3202d008d5
commit
2510cd6a5c
4 changed files with 78 additions and 53 deletions
|
@ -38,6 +38,7 @@ import Database.PostgreSQL.Simple.Types (Query (..))
|
||||||
import GHC.IO.Handle (Handle)
|
import GHC.IO.Handle (Handle)
|
||||||
import GHC.Records (getField)
|
import GHC.Records (getField)
|
||||||
import Label
|
import Label
|
||||||
|
import Language.Haskell.TH.Quote (QuasiQuoter)
|
||||||
import OpenTelemetry.Trace.Core (NewEvent (newEventName))
|
import OpenTelemetry.Trace.Core (NewEvent (newEventName))
|
||||||
import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
|
import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
|
||||||
import OpenTelemetry.Trace.Monad qualified as Otel
|
import OpenTelemetry.Trace.Monad qualified as Otel
|
||||||
|
@ -45,6 +46,7 @@ import PossehlAnalyticsPrelude
|
||||||
import Postgres.Decoder
|
import Postgres.Decoder
|
||||||
import Postgres.Decoder qualified as Dec
|
import Postgres.Decoder qualified as Dec
|
||||||
import Pretty (showPretty)
|
import Pretty (showPretty)
|
||||||
|
import PyF qualified
|
||||||
import Seconds
|
import Seconds
|
||||||
import System.Exit (ExitCode (..))
|
import System.Exit (ExitCode (..))
|
||||||
import Tool
|
import Tool
|
||||||
|
@ -140,6 +142,10 @@ class (Monad m) => MonadPostgres (m :: Type -> Type) where
|
||||||
-- Only handlers should run transactions.
|
-- Only handlers should run transactions.
|
||||||
runTransaction :: Transaction m a -> m a
|
runTransaction :: Transaction m a -> m a
|
||||||
|
|
||||||
|
-- | Quasi-Quoter for multi-line SQL literals. Trims leading whitespace up to the least-indented line.
|
||||||
|
sql :: QuasiQuoter
|
||||||
|
sql = PyF.fmtTrim
|
||||||
|
|
||||||
-- | Run a query, passing parameters. Prefer 'queryWith' if possible.
|
-- | Run a query, passing parameters. Prefer 'queryWith' if possible.
|
||||||
query ::
|
query ::
|
||||||
forall m params r.
|
forall m params r.
|
||||||
|
@ -397,7 +403,7 @@ handlePGException tools queryType query' params io = do
|
||||||
throwErr
|
throwErr
|
||||||
( singleError [fmt|Query Type: {queryType}|]
|
( singleError [fmt|Query Type: {queryType}|]
|
||||||
:| [ nestedError "Exception" (exc & showPretty & newError & singleError),
|
:| [ nestedError "Exception" (exc & showPretty & newError & singleError),
|
||||||
nestedError "Query" (formattedQuery & newError & singleError)
|
nestedError "Query" (formattedQuery & bytesToTextUtf8Lenient & newError & singleError)
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
logFormatException :: FormatError -> Transaction m a
|
logFormatException :: FormatError -> Transaction m a
|
||||||
|
@ -529,16 +535,16 @@ runPGTransactionImpl zoom (Transaction transaction) = do
|
||||||
executeImpl ::
|
executeImpl ::
|
||||||
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
|
||||||
Query ->
|
Query ->
|
||||||
params ->
|
params ->
|
||||||
Transaction m (Label "numberOfRowsAffected" Natural)
|
Transaction m (Label "numberOfRowsAffected" Natural)
|
||||||
{-# INLINE executeImpl #-}
|
{-# INLINE executeImpl #-}
|
||||||
executeImpl zoomTools zoomDebugLogDatabaseQueries qry params =
|
executeImpl zoomTools 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
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
|
traceQueryIfEnabled tools 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 tools "execute" qry (Left params)
|
||||||
|
@ -547,15 +553,15 @@ executeImpl zoomTools zoomDebugLogDatabaseQueries qry params =
|
||||||
executeImpl_ ::
|
executeImpl_ ::
|
||||||
(MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
(MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
|
||||||
Query ->
|
Query ->
|
||||||
Transaction m (Label "numberOfRowsAffected" Natural)
|
Transaction m (Label "numberOfRowsAffected" Natural)
|
||||||
{-# INLINE executeImpl_ #-}
|
{-# INLINE executeImpl_ #-}
|
||||||
executeImpl_ zoomTools zoomDebugLogDatabaseQueries qry =
|
executeImpl_ zoomTools zoomDbOptions qry =
|
||||||
Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
|
Otel.inSpan' "Postgres Query (execute)" Otel.defaultSpanArguments $ \span -> do
|
||||||
tools <- lift @Transaction zoomTools
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled @() tools span logDatabaseQueries qry HasNoParams
|
traceQueryIfEnabled @() tools 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 tools "execute_" qry (Left ())
|
||||||
|
@ -564,15 +570,15 @@ executeImpl_ zoomTools zoomDebugLogDatabaseQueries qry =
|
||||||
executeManyImpl ::
|
executeManyImpl ::
|
||||||
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
|
||||||
Query ->
|
Query ->
|
||||||
NonEmpty params ->
|
NonEmpty params ->
|
||||||
Transaction m (Label "numberOfRowsAffected" Natural)
|
Transaction m (Label "numberOfRowsAffected" Natural)
|
||||||
executeManyImpl zoomTools zoomDebugLogDatabaseQueries qry params =
|
executeManyImpl zoomTools 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
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry (HasMultiParams params)
|
traceQueryIfEnabled tools 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 tools "executeMany" qry (Right params)
|
||||||
|
@ -591,17 +597,17 @@ toNumberOfRowsAffected functionName i64 =
|
||||||
executeManyReturningWithImpl ::
|
executeManyReturningWithImpl ::
|
||||||
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
(ToRow params, MonadUnliftIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool, Otel.MonadTracer m) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
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 zoomDebugLogDatabaseQueries qry params (Decoder fromRow) = do
|
executeManyReturningWithImpl zoomTools 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
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry (HasMultiParams params)
|
traceQueryIfEnabled tools 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 tools "executeManyReturning" qry (Right params)
|
||||||
|
@ -614,7 +620,7 @@ foldRowsWithAccImpl ::
|
||||||
Otel.MonadTracer m
|
Otel.MonadTracer m
|
||||||
) =>
|
) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
|
||||||
Query ->
|
Query ->
|
||||||
params ->
|
params ->
|
||||||
Decoder row ->
|
Decoder row ->
|
||||||
|
@ -622,11 +628,11 @@ foldRowsWithAccImpl ::
|
||||||
(a -> row -> Transaction m a) ->
|
(a -> row -> Transaction m a) ->
|
||||||
Transaction m a
|
Transaction m a
|
||||||
{-# INLINE foldRowsWithAccImpl #-}
|
{-# INLINE foldRowsWithAccImpl #-}
|
||||||
foldRowsWithAccImpl zoomTools zoomDebugLogDatabaseQueries qry params (Decoder rowParser) accumulator f = do
|
foldRowsWithAccImpl zoomTools 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
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
|
traceQueryIfEnabled tools span logDatabaseQueries prettyQuery qry (HasSingleParam params)
|
||||||
conn <- Transaction ask
|
conn <- Transaction ask
|
||||||
withRunInIO
|
withRunInIO
|
||||||
( \runInIO ->
|
( \runInIO ->
|
||||||
|
@ -647,7 +653,7 @@ pgFormatQueryNoParams' ::
|
||||||
(MonadIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool) =>
|
(MonadIO m, MonadLogger m, HasField "pgFormat" tools PgFormatPool) =>
|
||||||
tools ->
|
tools ->
|
||||||
Query ->
|
Query ->
|
||||||
Transaction m Text
|
Transaction m ByteString
|
||||||
pgFormatQueryNoParams' tools q =
|
pgFormatQueryNoParams' tools q =
|
||||||
lift $ pgFormatQueryByteString tools q.fromQuery
|
lift $ pgFormatQueryByteString tools q.fromQuery
|
||||||
|
|
||||||
|
@ -684,17 +690,17 @@ queryWithImpl ::
|
||||||
Otel.MonadTracer m
|
Otel.MonadTracer m
|
||||||
) =>
|
) =>
|
||||||
m tools ->
|
m tools ->
|
||||||
m DebugLogDatabaseQueries ->
|
m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries) ->
|
||||||
Query ->
|
Query ->
|
||||||
params ->
|
params ->
|
||||||
Decoder r ->
|
Decoder r ->
|
||||||
Transaction m [r]
|
Transaction m [r]
|
||||||
{-# INLINE queryWithImpl #-}
|
{-# INLINE queryWithImpl #-}
|
||||||
queryWithImpl zoomTools zoomDebugLogDatabaseQueries qry params (Decoder fromRow) = do
|
queryWithImpl zoomTools 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
|
tools <- lift @Transaction zoomTools
|
||||||
logDatabaseQueries <- lift @Transaction zoomDebugLogDatabaseQueries
|
(logDatabaseQueries, prettyQuery) <- lift @Transaction zoomDbOptions
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry (HasSingleParam params)
|
traceQueryIfEnabled tools 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 tools "query" qry (Left params)
|
||||||
|
@ -733,7 +739,7 @@ pgFormatQuery' ::
|
||||||
tools ->
|
tools ->
|
||||||
Query ->
|
Query ->
|
||||||
params ->
|
params ->
|
||||||
Transaction m Text
|
Transaction m ByteString
|
||||||
pgFormatQuery' tools q p =
|
pgFormatQuery' tools q p =
|
||||||
pgFormatQuery q p
|
pgFormatQuery q p
|
||||||
>>= lift . pgFormatQueryByteString tools
|
>>= lift . pgFormatQueryByteString tools
|
||||||
|
@ -747,7 +753,7 @@ pgFormatQueryMany' ::
|
||||||
tools ->
|
tools ->
|
||||||
Query ->
|
Query ->
|
||||||
NonEmpty params ->
|
NonEmpty params ->
|
||||||
Transaction m Text
|
Transaction m ByteString
|
||||||
pgFormatQueryMany' tools q p =
|
pgFormatQueryMany' tools q p =
|
||||||
pgFormatQueryMany q p
|
pgFormatQueryMany q p
|
||||||
>>= lift . pgFormatQueryByteString tools
|
>>= lift . pgFormatQueryByteString tools
|
||||||
|
@ -763,7 +769,7 @@ pgFormatQueryByteString ::
|
||||||
) =>
|
) =>
|
||||||
tools ->
|
tools ->
|
||||||
ByteString ->
|
ByteString ->
|
||||||
m Text
|
m ByteString
|
||||||
pgFormatQueryByteString tools queryBytes = do
|
pgFormatQueryByteString tools queryBytes = do
|
||||||
res <-
|
res <-
|
||||||
liftIO $
|
liftIO $
|
||||||
|
@ -771,7 +777,7 @@ pgFormatQueryByteString tools queryBytes = do
|
||||||
tools.pgFormat
|
tools.pgFormat
|
||||||
(queryBytes)
|
(queryBytes)
|
||||||
case res.exitCode of
|
case res.exitCode of
|
||||||
ExitSuccess -> pure (res.formatted & bytesToTextUtf8Lenient)
|
ExitSuccess -> pure (res.formatted)
|
||||||
ExitFailure status -> do
|
ExitFailure status -> do
|
||||||
logWarn [fmt|pg_format failed with status {status} while formatting the query, using original query string. Is there a syntax error?|]
|
logWarn [fmt|pg_format failed with status {status} while formatting the query, using original query string. Is there a syntax error?|]
|
||||||
logDebug
|
logDebug
|
||||||
|
@ -784,7 +790,7 @@ pgFormatQueryByteString tools queryBytes = do
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
logDebug [fmt|pg_format stdout: stderr|]
|
logDebug [fmt|pg_format stdout: stderr|]
|
||||||
pure (queryBytes & bytesToTextUtf8Lenient)
|
pure (queryBytes)
|
||||||
|
|
||||||
pgFormatStartCommandWaitForInput ::
|
pgFormatStartCommandWaitForInput ::
|
||||||
( MonadIO m,
|
( MonadIO m,
|
||||||
|
@ -821,6 +827,14 @@ data DebugLogDatabaseQueries
|
||||||
LogDatabaseQueriesAndExplain
|
LogDatabaseQueriesAndExplain
|
||||||
deriving stock (Show, Enum, Bounded)
|
deriving stock (Show, Enum, Bounded)
|
||||||
|
|
||||||
|
-- | Whether to pipe database queries thru `pg_format` before logging them. This takes a long (long! 200ms+) time per query, so should only be used in debugging environments where speed is not an issue.
|
||||||
|
data PrettyPrintDatabaseQueries
|
||||||
|
= -- | Do not pretty-print database querios
|
||||||
|
DontPrettyPrintDatabaseQueries
|
||||||
|
| -- | Pretty-print database queries, slow
|
||||||
|
PrettyPrintDatabaseQueries
|
||||||
|
deriving stock (Show, Enum, Bounded)
|
||||||
|
|
||||||
data HasQueryParams param
|
data HasQueryParams param
|
||||||
= HasNoParams
|
= HasNoParams
|
||||||
| HasSingleParam param
|
| HasSingleParam param
|
||||||
|
@ -837,12 +851,15 @@ traceQueryIfEnabled ::
|
||||||
tools ->
|
tools ->
|
||||||
Otel.Span ->
|
Otel.Span ->
|
||||||
DebugLogDatabaseQueries ->
|
DebugLogDatabaseQueries ->
|
||||||
|
PrettyPrintDatabaseQueries ->
|
||||||
Query ->
|
Query ->
|
||||||
HasQueryParams params ->
|
HasQueryParams params ->
|
||||||
Transaction m ()
|
Transaction m ()
|
||||||
traceQueryIfEnabled tools span logDatabaseQueries qry params = do
|
traceQueryIfEnabled tools 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 = do
|
let formattedQuery = case prettyQuery of
|
||||||
|
DontPrettyPrintDatabaseQueries -> pure qry.fromQuery
|
||||||
|
PrettyPrintDatabaseQueries -> do
|
||||||
withEvent
|
withEvent
|
||||||
span
|
span
|
||||||
"Query Format start"
|
"Query Format start"
|
||||||
|
@ -856,7 +873,7 @@ traceQueryIfEnabled tools span logDatabaseQueries qry params = do
|
||||||
Otel.addAttributes
|
Otel.addAttributes
|
||||||
span
|
span
|
||||||
$ HashMap.fromList
|
$ HashMap.fromList
|
||||||
$ ( ("_.postgres.query", Otel.toAttribute @Text errs.query)
|
$ ( ("_.postgres.query", Otel.toAttribute @Text (errs.query & bytesToTextUtf8Lenient))
|
||||||
: ( errs.explain
|
: ( errs.explain
|
||||||
& \case
|
& \case
|
||||||
Nothing -> []
|
Nothing -> []
|
||||||
|
@ -872,7 +889,7 @@ traceQueryIfEnabled tools span logDatabaseQueries qry params = do
|
||||||
<> (
|
<> (
|
||||||
-- 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
|
||||||
-- because we need the query with all elements already interpolated.
|
-- because we need the query with all elements already interpolated.
|
||||||
Query (q & textToBytesUtf8)
|
Query q
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
(Dec.fromField @Text)
|
(Dec.fromField @Text)
|
||||||
|
|
|
@ -25,7 +25,7 @@ import UnliftIO
|
||||||
import Prelude hiding (span)
|
import Prelude hiding (span)
|
||||||
|
|
||||||
data Context = Context
|
data Context = Context
|
||||||
{ config :: Label "logDatabaseQueries" DebugLogDatabaseQueries,
|
{ config :: T2 "logDatabaseQueries" DebugLogDatabaseQueries "prettyPrintDatabaseQueries" PrettyPrintDatabaseQueries,
|
||||||
tracer :: Otel.Tracer,
|
tracer :: Otel.Tracer,
|
||||||
pgFormat :: PgFormatPool,
|
pgFormat :: PgFormatPool,
|
||||||
pgConnPool :: Pool Postgres.Connection,
|
pgConnPool :: Pool Postgres.Connection,
|
||||||
|
@ -40,7 +40,7 @@ newtype AppException = AppException Text
|
||||||
deriving anyclass (Exception)
|
deriving anyclass (Exception)
|
||||||
|
|
||||||
instance Show AppException where
|
instance Show AppException where
|
||||||
showsPrec _ (AppException t) = ("AppException: "++) . (textToString t++)
|
showsPrec _ (AppException t) = ("AppException: " ++) . (textToString t ++)
|
||||||
|
|
||||||
-- * Logging & Opentelemetry
|
-- * Logging & Opentelemetry
|
||||||
|
|
||||||
|
@ -147,15 +147,18 @@ 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) (AppT $ asks (.config.logDatabaseQueries))
|
execute = executeImpl (AppT ask) dbConfig
|
||||||
executeMany = executeManyImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
|
executeMany = executeManyImpl (AppT ask) dbConfig
|
||||||
executeManyReturningWith = executeManyReturningWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
|
executeManyReturningWith = executeManyReturningWithImpl (AppT ask) dbConfig
|
||||||
queryWith = queryWithImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
|
queryWith = queryWithImpl (AppT ask) dbConfig
|
||||||
queryWith_ = queryWithImpl_ (AppT ask)
|
queryWith_ = queryWithImpl_ (AppT ask)
|
||||||
|
|
||||||
foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) (AppT $ asks (.config.logDatabaseQueries))
|
foldRowsWithAcc = foldRowsWithAccImpl (AppT ask) dbConfig
|
||||||
runTransaction = runPGTransaction
|
runTransaction = runPGTransaction
|
||||||
|
|
||||||
|
dbConfig :: (Monad m) => AppT m (DebugLogDatabaseQueries, PrettyPrintDatabaseQueries)
|
||||||
|
dbConfig = AppT $ asks (\c -> (c.config.logDatabaseQueries, c.config.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
|
||||||
pool <- AppT ask <&> (.pgConnPool)
|
pool <- AppT ask <&> (.pgConnPool)
|
||||||
|
|
|
@ -12,7 +12,6 @@ import Data.Aeson.KeyMap qualified as KeyMap
|
||||||
import Data.Error.Tree
|
import Data.Error.Tree
|
||||||
import Data.List qualified as List
|
import Data.List qualified as List
|
||||||
import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
|
import Database.PostgreSQL.Simple (Binary (Binary), Only (..))
|
||||||
import Database.PostgreSQL.Simple.SqlQQ (sql)
|
|
||||||
import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
|
import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
|
||||||
import FieldParser qualified as Field
|
import FieldParser qualified as Field
|
||||||
import Http qualified
|
import Http qualified
|
||||||
|
|
|
@ -18,7 +18,6 @@ import Data.Map.Strict qualified as Map
|
||||||
import Data.Pool qualified as Pool
|
import Data.Pool qualified as Pool
|
||||||
import Data.Text qualified as Text
|
import Data.Text qualified as Text
|
||||||
import Database.PostgreSQL.Simple qualified as Postgres
|
import Database.PostgreSQL.Simple qualified as Postgres
|
||||||
import Database.PostgreSQL.Simple.SqlQQ (sql)
|
|
||||||
import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
|
import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
|
||||||
import Database.Postgres.Temp qualified as TmpPg
|
import Database.Postgres.Temp qualified as TmpPg
|
||||||
import FieldParser (FieldParser, FieldParser' (..))
|
import FieldParser (FieldParser, FieldParser' (..))
|
||||||
|
@ -778,7 +777,14 @@ 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)
|
pgFormat <- initPgFormatPool (label @"pgFormat" tool)
|
||||||
let config = label @"logDatabaseQueries" LogDatabaseQueries
|
prettyPrintDatabaseQueries <-
|
||||||
|
Env.lookupEnv "WHATCD_RESOLVER_PRETTY_PRINT_DATABASE_QUERIES" <&> \case
|
||||||
|
Just _ -> PrettyPrintDatabaseQueries
|
||||||
|
Nothing -> DontPrettyPrintDatabaseQueries
|
||||||
|
let config =
|
||||||
|
T2
|
||||||
|
(label @"logDatabaseQueries" LogDatabaseQueries)
|
||||||
|
(label @"prettyPrintDatabaseQueries" prettyPrintDatabaseQueries)
|
||||||
pgConnPool <-
|
pgConnPool <-
|
||||||
Pool.newPool $
|
Pool.newPool $
|
||||||
Pool.defaultPoolConfig
|
Pool.defaultPoolConfig
|
||||||
|
|
Loading…
Reference in a new issue