diff options
Diffstat (limited to 'users/Profpatsch/whatcd-resolver')
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/AppT.hs | 31 | ||||
-rw-r--r-- | users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs | 13 |
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 {..} |