From 398206ba5a689f541e5d5e2f52c975507ab24479 Mon Sep 17 00:00:00 2001 From: Andrei Dziahel Date: Tue, 2 Jan 2024 17:38:28 +0100 Subject: [PATCH] otel: add opentelemetry traces --- postgrest.cabal | 5 ++ src/PostgREST/App.hs | 116 ++++++++++++++++++--------------- src/PostgREST/AppState.hs | 20 ++++-- src/PostgREST/CLI.hs | 14 ++-- src/PostgREST/OpenTelemetry.hs | 16 +++++ stack.yaml | 10 +++ stack.yaml.lock | 70 ++++++++++++++++++++ test/spec/Main.hs | 9 +-- 8 files changed, 189 insertions(+), 71 deletions(-) create mode 100644 src/PostgREST/OpenTelemetry.hs diff --git a/postgrest.cabal b/postgrest.cabal index d3887b7bfbb..f7308c014e7 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -59,6 +59,7 @@ library PostgREST.Query.QueryBuilder PostgREST.Query.SqlFragment PostgREST.Query.Statements + PostgREST.OpenTelemetry PostgREST.Plan PostgREST.Plan.CallPlan PostgREST.Plan.MutatePlan @@ -103,6 +104,9 @@ library , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3 , http-types >= 0.12.2 && < 0.13 + , hs-opentelemetry-sdk >= 0.0.3.6 && < 0.0.4 + , hs-opentelemetry-instrumentation-wai + , hs-opentelemetry-utils-exceptions , insert-ordered-containers >= 0.2.2 && < 0.3 , interpolatedstring-perl6 >= 1 && < 1.1 , jose >= 0.8.5.1 && < 0.12 @@ -247,6 +251,7 @@ test-suite spec , hasql-pool >= 0.10 && < 0.11 , hasql-transaction >= 1.0.1 && < 1.1 , heredoc >= 0.2 && < 0.3 + , hs-opentelemetry-sdk >= 0.0.3.6 && < 0.0.4 , hspec >= 2.3 && < 2.12 , hspec-wai >= 0.10 && < 0.12 , hspec-wai-json >= 0.10 && < 0.12 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index d58a284cc97..fc7503be8c2 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -45,11 +45,11 @@ import qualified PostgREST.Unix as Unix (installSignalHandlers) import PostgREST.ApiRequest (Action (..), ApiRequest (..), Mutation (..), Target (..)) -import PostgREST.AppState (AppState) +import PostgREST.AppState (AppState, getOTelTracer) import PostgREST.Auth (AuthResult (..)) import PostgREST.Config (AppConfig (..)) import PostgREST.Config.PgVersion (PgVersion (..)) -import PostgREST.Error (Error) +import PostgREST.Error (Error (..)) import PostgREST.Observation (Observation (..)) import PostgREST.Query (DbHandler) import PostgREST.Response.Performance (ServerTiming (..), @@ -58,12 +58,15 @@ import PostgREST.SchemaCache (SchemaCache (..)) import PostgREST.SchemaCache.Routine (Routine (..)) import PostgREST.Version (docsVersion, prettyVersion) -import qualified Data.ByteString.Char8 as BS -import qualified Data.List as L -import qualified Network.HTTP.Types as HTTP -import qualified Network.Socket as NS -import Protolude hiding (Handler) -import System.TimeIt (timeItT) +import qualified Data.ByteString.Char8 as BS +import qualified Data.List as L +import qualified Network.HTTP.Types as HTTP +import qualified Network.Socket as NS +import OpenTelemetry.Instrumentation.Wai (newOpenTelemetryWaiMiddleware) +import OpenTelemetry.Trace (defaultSpanArguments) +import OpenTelemetry.Utils.Exceptions (inSpanM) +import Protolude hiding (Handler) +import System.TimeIt (timeItT) type Handler = ExceptT Error @@ -88,7 +91,9 @@ run appState observer = do port <- NS.socketPort $ AppState.getSocketREST appState observer $ AppServerPortObs port - Warp.runSettingsSocket (serverSettings conf) (AppState.getSocketREST appState) app + oTelMWare <- newOpenTelemetryWaiMiddleware + + Warp.runSettingsSocket (serverSettings conf) (AppState.getSocketREST appState) (oTelMWare app) serverSettings :: AppConfig -> Warp.Settings serverSettings AppConfig{..} = @@ -106,27 +111,28 @@ postgrest conf appState connWorker observer = Logger.middleware (configLogLevel conf) $ -- fromJust can be used, because the auth middleware will **always** add -- some AuthResult to the vault. - \req respond -> case fromJust $ Auth.getResult req of - Left err -> respond $ Error.errorResponseFor err - Right authResult -> do - appConf <- AppState.getConfig appState -- the config must be read again because it can reload - maybeSchemaCache <- AppState.getSchemaCache appState - pgVer <- AppState.getPgVersion appState - - let - eitherResponse :: IO (Either Error Wai.Response) - eitherResponse = - runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req observer - - response <- either Error.errorResponseFor identity <$> eitherResponse - -- Launch the connWorker when the connection is down. The postgrest - -- function can respond successfully (with a stale schema cache) before - -- the connWorker is done. - when (isServiceUnavailable response) connWorker - resp <- do - delay <- AppState.getRetryNextIn appState - return $ addRetryHint delay response - respond resp + \req respond -> inSpanM (getOTelTracer appState) "respond" defaultSpanArguments $ + case fromJust $ Auth.getResult req of + Left err -> respond $ Error.errorResponseFor err + Right authResult -> do + appConf <- AppState.getConfig appState -- the config must be read again because it can reload + maybeSchemaCache <- AppState.getSchemaCache appState + pgVer <- AppState.getPgVersion appState + + let + eitherResponse :: IO (Either Error Wai.Response) + eitherResponse = inSpanM (getOTelTracer appState) "eitherResponse" defaultSpanArguments $ + runExceptT $ postgrestResponse appState appConf maybeSchemaCache pgVer authResult req observer + + response <- either Error.errorResponseFor identity <$> eitherResponse + -- Launch the connWorker when the connection is down. The postgrest + -- function can respond successfully (with a stale schema cache) before + -- the connWorker is done. + when (isServiceUnavailable response) connWorker + resp <- do + delay <- AppState.getRetryNextIn appState + return $ addRetryHint delay response + respond resp postgrestResponse :: AppState.AppState @@ -172,54 +178,54 @@ handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime observer = case (iAction, iTarget) of (ActionRead headersOnly, TargetIdent identifier) -> do - (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq - (respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet + (planTime', wrPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationCreate, TargetIdent identifier) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet + (planTime', mrPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationUpdate, TargetIdent identifier) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationSingleUpsert, TargetIdent identifier) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionMutate MutationDelete, TargetIdent identifier) -> do - (planTime', mrPlan) <- withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl mempty (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInvoke invMethod, TargetProc identifier _) -> do - (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod - (txTime', resultSet) <- withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdFuncSettings $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer - (respTime', pgrst) <- withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet + (planTime', cPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod + (txTime', resultSet) <- withOTel "query" $ withTiming $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdFuncSettings $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.invokeResponse cPlan invMethod (Plan.crProc cPlan) apiReq resultSet return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInspect headersOnly, TargetDefaultSpec tSchema) -> do - (planTime', iPlan) <- withTiming $ liftEither $ Plan.inspectPlan apiReq - (txTime', oaiResult) <- withTiming $ runQuery roleIsoLvl mempty (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema - (respTime', pgrst) <- withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile + (planTime', iPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.inspectPlan apiReq + (txTime', oaiResult) <- withOTel "query" $ withTiming $ runQuery roleIsoLvl [] (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.openApiResponse (T.decodeUtf8 prettyVersion, docsVersion) headersOnly oaiResult conf sCache iSchema iNegotiatedByProfile return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' txTime' respTime') pgrst (ActionInfo, TargetIdent identifier) -> do - (respTime', pgrst) <- withTiming $ liftEither $ Response.infoIdentResponse identifier sCache + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.infoIdentResponse identifier sCache return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst (ActionInfo, TargetProc identifier _) -> do - (planTime', cPlan) <- withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead - (respTime', pgrst) <- withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) + (planTime', cPlan) <- withOTel "plan" $ withTiming $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead + (respTime', pgrst) <- withOTel "response" $ withTiming $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst (ActionInfo, TargetDefaultSpec _) -> do @@ -244,6 +250,8 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A withTiming = calcTiming $ configServerTimingEnabled conf + withOTel label = inSpanM (getOTelTracer appState) label defaultSpanArguments + calcTiming :: Bool -> Handler IO a -> Handler IO (Maybe Double, a) calcTiming timingEnabled f = if timingEnabled then do diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 4b367b8a665..41f54760d34 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -16,6 +16,7 @@ module PostgREST.AppState , getJwtCache , getSocketREST , getSocketAdmin + , getOTelTracer , init , initSockets , initWithPool @@ -71,6 +72,7 @@ import PostgREST.Unix (createAndBindDomainSocket) import Data.Streaming.Network (bindPortTCP, bindRandomPortTCP) import Data.String (IsString (..)) +import OpenTelemetry.Trace (Tracer) import Protolude data AuthResult = AuthResult @@ -107,19 +109,21 @@ data AppState = AppState , stateSocketREST :: NS.Socket -- | Network socket for the admin UI , stateSocketAdmin :: Maybe NS.Socket + -- | OpenTelemetry tracer + , oTelTracer :: Tracer } type AppSockets = (NS.Socket, Maybe NS.Socket) -init :: AppConfig -> (Observation -> IO ()) -> IO AppState -init conf observer = do +init :: AppConfig -> Tracer -> (Observation -> IO ()) -> IO AppState +init conf tracer observer = do pool <- initPool conf (sock, adminSock) <- initSockets conf - state' <- initWithPool (sock, adminSock) pool conf observer - pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock } + state' <- initWithPool (sock, adminSock) pool tracer conf observer + pure state' { stateSocketREST = sock, stateSocketAdmin = adminSock} -initWithPool :: AppSockets -> SQL.Pool -> AppConfig -> (Observation -> IO() ) -> IO AppState -initWithPool (sock, adminSock) pool conf observer = do +initWithPool :: AppSockets -> SQL.Pool -> Tracer -> AppConfig -> (Observation -> IO() ) -> IO AppState +initWithPool (sock, adminSock) pool tracer conf observer = do appState <- AppState pool <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step <*> newIORef Nothing @@ -134,6 +138,7 @@ initWithPool (sock, adminSock) pool conf observer = do <*> C.newCache Nothing <*> pure sock <*> pure adminSock + <*> pure tracer debPoolTimeout <- @@ -263,6 +268,9 @@ getSocketREST = stateSocketREST getSocketAdmin :: AppState -> Maybe NS.Socket getSocketAdmin = stateSocketAdmin +getOTelTracer :: AppState -> Tracer +getOTelTracer = oTelTracer + getMainThreadId :: AppState -> ThreadId getMainThreadId = stateMainThreadId diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 2e9f79be71d..2a7066eb5b9 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -17,10 +17,11 @@ import qualified Options.Applicative as O import Data.Text.IO (hPutStrLn) import Text.Heredoc (str) -import PostgREST.AppState (AppState) -import PostgREST.Config (AppConfig (..)) -import PostgREST.SchemaCache (querySchemaCache) -import PostgREST.Version (prettyVersion) +import PostgREST.AppState (AppState) +import PostgREST.Config (AppConfig (..)) +import PostgREST.OpenTelemetry (withTracer) +import PostgREST.SchemaCache (querySchemaCache) +import PostgREST.Version (prettyVersion) import qualified PostgREST.App as App import qualified PostgREST.AppState as AppState @@ -29,9 +30,8 @@ import qualified PostgREST.Logger as Logger import Protolude hiding (hPutStrLn) - main :: CLI -> IO () -main CLI{cliCommand, cliPath} = do +main CLI{cliCommand, cliPath} = withTracer "PostgREST" $ \tracer -> do conf@AppConfig{..} <- either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty @@ -40,7 +40,7 @@ main CLI{cliCommand, cliPath} = do -- explicitly close the connections to PostgreSQL on shutdown. -- 'AppState.destroy' takes care of that. bracket - (AppState.init conf $ Logger.logObservation loggerState) + (AppState.init conf tracer $ Logger.logObservation loggerState) AppState.destroy (\appState -> case cliCommand of CmdDumpConfig -> do diff --git a/src/PostgREST/OpenTelemetry.hs b/src/PostgREST/OpenTelemetry.hs new file mode 100644 index 00000000000..9e60c5d44c5 --- /dev/null +++ b/src/PostgREST/OpenTelemetry.hs @@ -0,0 +1,16 @@ +module PostgREST.OpenTelemetry (withTracer) where + +import OpenTelemetry.Trace (InstrumentationLibrary (..), Tracer, + initializeGlobalTracerProvider, + makeTracer, shutdownTracerProvider, + tracerOptions) +import PostgREST.Version (prettyVersion) +import Protolude + +withTracer :: Text -> (Tracer -> IO c) -> IO c +withTracer label f = bracket + initializeGlobalTracerProvider + shutdownTracerProvider + (\tracerProvider -> f $ makeTracer tracerProvider instrumentationLibrary tracerOptions) + where + instrumentationLibrary = InstrumentationLibrary {libraryName = label, libraryVersion = decodeUtf8 prettyVersion} diff --git a/stack.yaml b/stack.yaml index 32a0c70aefe..1a2a1c3642e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,3 +16,13 @@ extra-deps: - hasql-pool-0.10 - megaparsec-9.2.2 - postgresql-libpq-0.10.0.0 + - hs-opentelemetry-sdk-0.0.3.6@sha256:6776705a4e0c06c6a4bfa16a9bed3ba353901f52d214ac737f57ea7f8e1ed465,3746 + - hs-opentelemetry-api-0.1.0.0@sha256:8af01d0c81dd1af6d3293b105178fd9bfa0057c9eb88ac24d3c440bff660abe3,3705 + - hs-opentelemetry-propagator-b3-0.0.1.1@sha256:f0e9da77a888b89f81e5f5186788d5ace2a665e8914f6b446712a1c2edf17743,1854 + - hs-opentelemetry-propagator-w3c-0.0.1.3@sha256:5dc2dbdd6b0a4e434ca5fd949e9ebe5611a5d513ef58009b935e9e810cc85d1b,1852 + - hs-opentelemetry-exporter-otlp-0.0.1.5@sha256:89b0a6481096a338fa6383fbdf08ccaa0eb7bb009c4cbb340894eac33e55c5de,2214 + - hs-opentelemetry-utils-exceptions-0.2.0.0@sha256:b0fe38a18034a2e264719104e288d648eba5e27d5e0e1dd8df6583024f1e3b8c,1579 + - hs-opentelemetry-instrumentation-wai-0.1.0.0@sha256:6019cf031b3edec6ff0ace0df4c2e41358b9e5d939e6c326e4e1df50726348ee,1852 + - hs-opentelemetry-otlp-0.0.1.0@sha256:88bb6b68f172a336f78018b0823f47363fb7408eb19f7301489f81ad4d5c0f33,2307 + - thread-utils-context-0.3.0.4@sha256:e763da1c6cab3b6d378fb670ca74aa9bf03c9b61b6fcf7628c56363fb0e3e71e,1671 + - thread-utils-finalizers-0.1.1.0@sha256:24944b71d9f1d01695a5908b4a3b44838fab870883114a323336d537995e0a5b,1381 diff --git a/stack.yaml.lock b/stack.yaml.lock index 03afb8b0186..3c09781202e 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -46,6 +46,76 @@ packages: size: 1019 original: hackage: postgresql-libpq-0.10.0.0 +- completed: + hackage: hs-opentelemetry-sdk-0.0.3.6@sha256:6776705a4e0c06c6a4bfa16a9bed3ba353901f52d214ac737f57ea7f8e1ed465,3746 + pantry-tree: + sha256: 154663d933a44c350db6c98d2c14db192c14fd04a10c17d0ebb8090707bd359b + size: 1430 + original: + hackage: hs-opentelemetry-sdk-0.0.3.6@sha256:6776705a4e0c06c6a4bfa16a9bed3ba353901f52d214ac737f57ea7f8e1ed465,3746 +- completed: + hackage: hs-opentelemetry-api-0.1.0.0@sha256:8af01d0c81dd1af6d3293b105178fd9bfa0057c9eb88ac24d3c440bff660abe3,3705 + pantry-tree: + sha256: 7c332e7241636097fe199bd87f57db333830bed416296e7ebf944497557f46be + size: 3221 + original: + hackage: hs-opentelemetry-api-0.1.0.0@sha256:8af01d0c81dd1af6d3293b105178fd9bfa0057c9eb88ac24d3c440bff660abe3,3705 +- completed: + hackage: hs-opentelemetry-propagator-b3-0.0.1.1@sha256:f0e9da77a888b89f81e5f5186788d5ace2a665e8914f6b446712a1c2edf17743,1854 + pantry-tree: + sha256: 7ed0b0433837946d86f2ab364ef284dfc17fdcef9b4ea5fc48577a9441deeade + size: 482 + original: + hackage: hs-opentelemetry-propagator-b3-0.0.1.1@sha256:f0e9da77a888b89f81e5f5186788d5ace2a665e8914f6b446712a1c2edf17743,1854 +- completed: + hackage: hs-opentelemetry-propagator-w3c-0.0.1.3@sha256:5dc2dbdd6b0a4e434ca5fd949e9ebe5611a5d513ef58009b935e9e810cc85d1b,1852 + pantry-tree: + sha256: 84a8e40facf8df13084682a6e4852d940acc9d9abeaf2d716dbc9415258f4cc5 + size: 496 + original: + hackage: hs-opentelemetry-propagator-w3c-0.0.1.3@sha256:5dc2dbdd6b0a4e434ca5fd949e9ebe5611a5d513ef58009b935e9e810cc85d1b,1852 +- completed: + hackage: hs-opentelemetry-exporter-otlp-0.0.1.5@sha256:89b0a6481096a338fa6383fbdf08ccaa0eb7bb009c4cbb340894eac33e55c5de,2214 + pantry-tree: + sha256: 744146043f5818ad2b7577a32862affcbf6ed400b097723eae9f6941d739365e + size: 400 + original: + hackage: hs-opentelemetry-exporter-otlp-0.0.1.5@sha256:89b0a6481096a338fa6383fbdf08ccaa0eb7bb009c4cbb340894eac33e55c5de,2214 +- completed: + hackage: hs-opentelemetry-utils-exceptions-0.2.0.0@sha256:b0fe38a18034a2e264719104e288d648eba5e27d5e0e1dd8df6583024f1e3b8c,1579 + pantry-tree: + sha256: 12af6f97bf7c16cc081e69e581ed49929f9c3feed0a907425a64426929feede1 + size: 406 + original: + hackage: hs-opentelemetry-utils-exceptions-0.2.0.0@sha256:b0fe38a18034a2e264719104e288d648eba5e27d5e0e1dd8df6583024f1e3b8c,1579 +- completed: + hackage: hs-opentelemetry-instrumentation-wai-0.1.0.0@sha256:6019cf031b3edec6ff0ace0df4c2e41358b9e5d939e6c326e4e1df50726348ee,1852 + pantry-tree: + sha256: affe8d2c4c55181c84fc74abef68fde5c11a99581fd29a97e6a8a9fd1e016a43 + size: 411 + original: + hackage: hs-opentelemetry-instrumentation-wai-0.1.0.0@sha256:6019cf031b3edec6ff0ace0df4c2e41358b9e5d939e6c326e4e1df50726348ee,1852 +- completed: + hackage: hs-opentelemetry-otlp-0.0.1.0@sha256:88bb6b68f172a336f78018b0823f47363fb7408eb19f7301489f81ad4d5c0f33,2307 + pantry-tree: + sha256: e56292fc693805babed3c7ba7fc54e59d2e9adbc38de6bcc659009e8b10b9a1b + size: 2252 + original: + hackage: hs-opentelemetry-otlp-0.0.1.0@sha256:88bb6b68f172a336f78018b0823f47363fb7408eb19f7301489f81ad4d5c0f33,2307 +- completed: + hackage: thread-utils-context-0.3.0.4@sha256:e763da1c6cab3b6d378fb670ca74aa9bf03c9b61b6fcf7628c56363fb0e3e71e,1671 + pantry-tree: + sha256: 57d909a991b5e0b4c7a28121cb52ee9c2db6c09e0419b89af6c82fae52be88d4 + size: 397 + original: + hackage: thread-utils-context-0.3.0.4@sha256:e763da1c6cab3b6d378fb670ca74aa9bf03c9b61b6fcf7628c56363fb0e3e71e,1671 +- completed: + hackage: thread-utils-finalizers-0.1.1.0@sha256:24944b71d9f1d01695a5908b4a3b44838fab870883114a323336d537995e0a5b,1381 + pantry-tree: + sha256: 8c2c2e2e22c20bf3696ee6f30b50b3a9eeae187a22beb536441eefb0a3f9c549 + size: 400 + original: + hackage: thread-utils-finalizers-0.1.1.0@sha256:24944b71d9f1d01695a5908b4a3b44838fab870883114a323336d537995e0a5b,1381 snapshots: - completed: sha256: 23bb9bb355bfdb1635252e120a29b712f0d5e8a6c6a65c5ab5bd6692f46c438e diff --git a/test/spec/Main.hs b/test/spec/Main.hs index a6edf23670a..2e43c72e7d9 100644 --- a/test/spec/Main.hs +++ b/test/spec/Main.hs @@ -10,6 +10,7 @@ import Test.Hspec import PostgREST.App (postgrest) import PostgREST.Config (AppConfig (..)) import PostgREST.Config.Database (queryPgVersion) +import PostgREST.OpenTelemetry (withTracer) import PostgREST.SchemaCache (querySchemaCache) import Protolude hiding (toList, toS) import SpecHelper @@ -79,16 +80,16 @@ main = do let noObs = const $ pure () -- For tests that run with the same refSchemaCache - app config = do - appState <- AppState.initWithPool sockets pool config noObs + app config = withTracer "PostgREST.Spec" $ \tracer -> do + appState <- AppState.initWithPool sockets pool tracer config noObs AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just baseSchemaCache) return ((), postgrest config appState (pure ()) noObs) -- For tests that run with a different SchemaCache(depends on configSchemas) - appDbs config = do + appDbs config = withTracer "PostgREST.Spec" $ \tracer -> do customSchemaCache <- loadSCache pool config - appState <- AppState.initWithPool sockets pool config noObs + appState <- AppState.initWithPool sockets pool tracer config noObs AppState.putPgVersion appState actualPgVersion AppState.putSchemaCache appState (Just customSchemaCache) return ((), postgrest config appState (pure ()) noObs)