diff --git a/postgrest.cabal b/postgrest.cabal index ebef807f229..0b3715ae7f9 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -102,6 +102,7 @@ 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 , insert-ordered-containers >= 0.2.2 && < 0.3 , interpolatedstring-perl6 >= 1 && < 1.1 , jose >= 0.8.5.1 && < 0.12 diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 3c3b187707e..a7e560734f4 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -49,7 +49,7 @@ import PostgREST.AppState (AppState) import PostgREST.Auth (AuthResult (..)) import PostgREST.Config (AppConfig (..)) import PostgREST.Config.PgVersion (PgVersion (..)) -import PostgREST.Error (Error) +import PostgREST.Error (Error (..)) import PostgREST.Query (DbHandler) import PostgREST.Response.Performance (ServerTiming (..), serverTimingHeader) @@ -63,6 +63,7 @@ import qualified Network.HTTP.Types as HTTP import qualified Network.Socket as NS import Protolude hiding (Handler) import System.TimeIt (timeItT) +import OpenTelemetry.Trace (getGlobalTracerProvider, defaultSpanArguments, makeTracer, InstrumentationLibrary (..), TracerOptions (..), Tracer, SpanKind (..), SpanArguments(..), inSpan', addEvent, NewEvent (NewEvent, newEventAttributes, newEventTimestamp, newEventName), setStatus, SpanStatus(..), Span, ToAttribute (toAttribute)) type Handler = ExceptT Error @@ -136,6 +137,7 @@ postgrestResponse -> Wai.Request -> Handler IO Wai.Response postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@AuthResult{..} req = do + t <- liftIO getTracer sCache <- case maybeSchemaCache of Just sCache -> @@ -146,12 +148,20 @@ postgrestResponse appState conf@AppConfig{..} maybeSchemaCache pgVer authResult@ body <- lift $ Wai.strictRequestBody req (parseTime, apiRequest) <- - calcTiming configServerTimingEnabled $ + calcTiming' configServerTimingEnabled $ liftEither . mapLeft Error.ApiRequestError $ ApiRequest.userApiRequest conf req body sCache let jwtTime = if configServerTimingEnabled then Auth.getJwtDur req else Nothing - handleRequest authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime + liftIO $ inSpan' t "handleRequest" defaultSpanArguments {kind = Server} $ \span -> do + result <- runExceptT $ handleRequest span authResult conf appState (Just authRole /= configDbAnonRole) configDbPreparedStatements pgVer apiRequest sCache jwtTime parseTime + case result of + Left err -> do + setStatus span (Error "Boo!") + inSpan' t "errorResponseFor" defaultSpanArguments {kind = Server} $ \span' -> do + _ <- addEvent span' $ NewEvent { newEventName = "error", newEventAttributes = HM.fromList [], newEventTimestamp = Nothing } + return $ Error.errorResponseFor err + Right resp -> return resp runDbHandler :: AppState.AppState -> AppConfig -> SQL.IsolationLevel -> SQL.Mode -> Bool -> Bool -> DbHandler b -> Handler IO b runDbHandler appState config isoLvl mode authenticated prepared handler = do @@ -165,62 +175,62 @@ runDbHandler appState config isoLvl mode authenticated prepared handler = do liftEither resp -handleRequest :: AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe Double -> Maybe Double -> Handler IO Wai.Response -handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime = +handleRequest :: Span -> AuthResult -> AppConfig -> AppState.AppState -> Bool -> Bool -> PgVersion -> ApiRequest -> SchemaCache -> Maybe Double -> Maybe Double -> Handler IO Wai.Response +handleRequest span AuthResult{..} conf appState authenticated prepared pgVer apiReq@ApiRequest{..} sCache jwtTime parseTime = case (iAction, iTarget) of (ActionRead headersOnly, TargetIdent identifier) -> do - (planTime', wrPlan) <- withTiming $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq - (txTime', resultSet) <- withTiming $ runQuery roleIsoLvl Nothing (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq - (respTime', pgrst) <- withTiming $ liftEither $ Response.readResponse wrPlan headersOnly identifier apiReq resultSet + (planTime', wrPlan) <- withTiming "queryTime" $ liftEither $ Plan.wrappedReadPlan identifier conf sCache apiReq + (txTime', resultSet) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.wrTxMode wrPlan) $ Query.readQuery wrPlan conf apiReq + (respTime', pgrst) <- withTiming "responseTime" $ 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 Nothing (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.createResponse identifier mrPlan apiReq resultSet + (planTime', mrPlan) <- withTiming "queryTime" $ liftEither $ Plan.mutateReadPlan MutationCreate apiReq identifier conf sCache + (txTime', resultSet) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.createQuery mrPlan apiReq conf + (respTime', pgrst) <- withTiming "responseTime" $ 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 Nothing (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.updateResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withTiming "queryTime" $ liftEither $ Plan.mutateReadPlan MutationUpdate apiReq identifier conf sCache + (txTime', resultSet) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.updateQuery mrPlan apiReq conf + (respTime', pgrst) <- withTiming "responseTime" $ 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 Nothing (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.singleUpsertResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withTiming "queryTime" $ liftEither $ Plan.mutateReadPlan MutationSingleUpsert apiReq identifier conf sCache + (txTime', resultSet) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.singleUpsertQuery mrPlan apiReq conf + (respTime', pgrst) <- withTiming "responseTime" $ 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 Nothing (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf - (respTime', pgrst) <- withTiming $ liftEither $ Response.deleteResponse mrPlan apiReq resultSet + (planTime', mrPlan) <- withTiming "queryTime" $ liftEither $ Plan.mutateReadPlan MutationDelete apiReq identifier conf sCache + (txTime', resultSet) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.mrTxMode mrPlan) $ Query.deleteQuery mrPlan apiReq conf + (respTime', pgrst) <- withTiming "responseTime" $ 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)) (pdTimeout $ 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) <- withTiming "queryTime" $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq invMethod + (txTime', resultSet) <- withTiming "planTime" $ runQuery (fromMaybe roleIsoLvl $ pdIsoLvl (Plan.crProc cPlan)) (pdTimeout $ Plan.crProc cPlan) (Plan.crTxMode cPlan) $ Query.invokeQuery (Plan.crProc cPlan) cPlan apiReq conf pgVer + (respTime', pgrst) <- withTiming "responseTime" $ 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 Nothing (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) <- withTiming "queryTime" $ liftEither $ Plan.inspectPlan apiReq + (txTime', oaiResult) <- withTiming "planTime" $ runQuery roleIsoLvl Nothing (Plan.ipTxmode iPlan) $ Query.openApiQuery sCache pgVer conf tSchema + (respTime', pgrst) <- withTiming "responseTime" $ 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) <- withTiming "responseTime" $ 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) <- withTiming "planTime" $ liftEither $ Plan.callReadPlan identifier conf sCache apiReq ApiRequest.InvHead + (respTime', pgrst) <- withTiming "responseTime" $ liftEither $ Response.infoProcResponse (Plan.crProc cPlan) return $ pgrstResponse (ServerTiming jwtTime parseTime planTime' Nothing respTime') pgrst (ActionInfo, TargetDefaultSpec _) -> do - (respTime', pgrst) <- withTiming $ liftEither Response.infoRootResponse + (respTime', pgrst) <- withTiming "responseTime" $ liftEither Response.infoRootResponse return $ pgrstResponse (ServerTiming jwtTime parseTime Nothing Nothing respTime') pgrst _ -> @@ -239,10 +249,20 @@ handleRequest AuthResult{..} conf appState authenticated prepared pgVer apiReq@A pgrstResponse :: ServerTiming -> Response.PgrstResponse -> Wai.Response pgrstResponse timing (Response.PgrstResponse st hdrs bod) = Wai.responseLBS st (hdrs ++ ([serverTimingHeader timing | configServerTimingEnabled conf])) bod - withTiming = calcTiming $ configServerTimingEnabled conf + withTiming label = calcTiming span label $ configServerTimingEnabled conf -calcTiming :: Bool -> Handler IO a -> Handler IO (Maybe Double, a) -calcTiming timingEnabled f = if timingEnabled +calcTiming :: Span -> Text -> Bool -> Handler IO a -> Handler IO (Maybe Double, a) +calcTiming span label timingEnabled f = do + (t, r) <- timeItT f + _ <- addEvent span $ NewEvent { newEventName = label, newEventAttributes = HM.fromList [("time", toAttribute t)], newEventTimestamp = Nothing } + if timingEnabled + then do + pure (Just t, r) + else do + pure (Nothing, r) + +calcTiming' :: Bool -> Handler IO a -> Handler IO (Maybe Double, a) +calcTiming' timingEnabled f = if timingEnabled then do (t, r) <- timeItT f pure (Just t, r) @@ -265,3 +285,11 @@ addRetryHint delay response = do isServiceUnavailable :: Wai.Response -> Bool isServiceUnavailable response = Wai.responseStatus response == HTTP.status503 + +getTracer :: IO Tracer +getTracer = do + tp <- getGlobalTracerProvider + return $ + makeTracer tp + InstrumentationLibrary { libraryVersion = decodeUtf8 prettyVersion, libraryName = "postgrest"} + TracerOptions {tracerSchema=Nothing} diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 363f1cb05bb..31749ca8c48 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -28,9 +28,10 @@ import qualified PostgREST.Config as Config import Protolude hiding (hPutStrLn) +import OpenTelemetry.Trace main :: CLI -> IO () -main CLI{cliCommand, cliPath} = do +main CLI{cliCommand, cliPath} = withTracer $ \_tracer -> do conf@AppConfig{..} <- either panic identity <$> Config.readAppConfig mempty cliPath Nothing mempty mempty @@ -46,6 +47,12 @@ main CLI{cliCommand, cliPath} = do putStr . Config.toText =<< AppState.getConfig appState CmdDumpSchema -> putStrLn =<< dumpSchema appState CmdRun -> App.run appState) + where + withTracer :: ((TracerOptions -> Tracer) -> IO c) -> IO c + withTracer f = bracket + initializeGlobalTracerProvider + shutdownTracerProvider + (\tracerProvider -> f $ makeTracer tracerProvider "PostgREST") -- | Dump SchemaCache schema to JSON dumpSchema :: AppState -> IO LBS.ByteString diff --git a/stack.yaml b/stack.yaml index 32a0c70aefe..7e53e590c48 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,3 +16,20 @@ extra-deps: - hasql-pool-0.10 - megaparsec-9.2.2 - postgresql-libpq-0.10.0.0 + # - hs-opentelemetry-sdk-0.0.3.6 + # - hs-opentelemetry-api-0.1.0.0@sha256:8af01d0c81dd1af6d3293b105178fd9bfa0057c9eb88ac24d3c440bff660abe3,3705 + # - hs-opentelemetry-exporter-otlp-0.0.1.5@sha256:89b0a6481096a338fa6383fbdf08ccaa0eb7bb009c4cbb340894eac33e55c5de,2214 + # - hs-opentelemetry-propagator-b3-0.0.1.1@sha256:f0e9da77a888b89f81e5f5186788d5ace2a665e8914f6b446712a1c2edf17743,1854 + # - hs-opentelemetry-propagator-w3c-0.0.1.3@sha256:5dc2dbdd6b0a4e434ca5fd949e9ebe5611a5d513ef58009b935e9e810cc85d1b,1852 + # - hs-opentelemetry-otlp-0.0.1.0@sha256:88bb6b68f172a336f78018b0823f47363fb7408eb19f7301489f81ad4d5c0f33,2307 + - github: 'iand675/hs-opentelemetry' + commit: '54251bd15565e3a07cda0cecfa544d209ae63df6' + subdirs: + - sdk + - api + - 'exporters/otlp' + - 'propagators/b3' + - 'propagators/w3c' + - otlp + - 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 4b8f686c99a..8ae282d0574 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -12,16 +12,12 @@ packages: original: hackage: configurator-pg-0.2.7 - completed: - commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc - git: https://github.com/PostgREST/postgresql-libpq.git - name: postgresql-libpq + hackage: fuzzyset-0.3.1@sha256:344e16deedb43da5cabae558450e5710843cff7ac2f3073be9db453c6f3a3fb7,2373 pantry-tree: - sha256: 074668b9669b9c49f3c522c8af5c608799a1965e203c463b188b2632995beac2 - size: 1414 - version: 0.9.4.3 + sha256: 89e22c2ce70a7c7c4b599ffe2546cda5699e4f8f15410eac49f39af8c4c381c8 + size: 643 original: - commit: 890a0a16cf57dd401420fdc6c7d576fb696003bc - git: https://github.com/PostgREST/postgresql-libpq.git + hackage: fuzzyset-0.3.1 - completed: hackage: hasql-notifications-0.2.0.6@sha256:16d783f5cd1660fad924fd3769380889de5804e057f09b304dcdc3a3ff11eb3c,2028 pantry-tree: @@ -36,13 +32,6 @@ packages: size: 346 original: hackage: hasql-pool-0.10 -- completed: - hackage: fuzzyset-0.3.1@sha256:344e16deedb43da5cabae558450e5710843cff7ac2f3073be9db453c6f3a3fb7,2373 - pantry-tree: - sha256: 89e22c2ce70a7c7c4b599ffe2546cda5699e4f8f15410eac49f39af8c4c381c8 - size: 643 - original: - hackage: fuzzyset-0.3.1 - completed: hackage: megaparsec-9.2.2@sha256:c306a135ec25d91d252032c6128f03598a00e87ea12fcf5fc4878fdffc75c768,3219 pantry-tree: @@ -50,6 +39,105 @@ packages: size: 1518 original: hackage: megaparsec-9.2.2 +- completed: + hackage: postgresql-libpq-0.10.0.0@sha256:5c1cafdc2e3e5c0036b6801b10b6f14ae95b98428d6c88bc8ae560bd700d0ef7,3089 + pantry-tree: + sha256: a7790b5283fc1510bde9e7c70772cdbf1ad6a3bad32ea966c6fc95e1b3c524c7 + size: 1019 + original: + hackage: postgresql-libpq-0.10.0.0 +- completed: + name: hs-opentelemetry-sdk + pantry-tree: + sha256: 42a125d2c00a00055157f8aee729ad5de147170673dea87ae7287e62297ec167 + size: 1532 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: sdk + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.0.3.6 + original: + subdir: sdk + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- completed: + name: hs-opentelemetry-api + pantry-tree: + sha256: 0d0c5c22b3a4d4162e8ced0b0df66def2ddc692cc10eddb80ae6bd0edfc37552 + size: 3323 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: api + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.1.0.0 + original: + subdir: api + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- completed: + name: hs-opentelemetry-exporter-otlp + pantry-tree: + sha256: b3698194a249ca7156da48ae9e518baa4173dbfb1c1ae07eb144183a308fc095 + size: 502 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: exporters/otlp + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.0.1.5 + original: + subdir: exporters/otlp + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- completed: + name: hs-opentelemetry-propagator-b3 + pantry-tree: + sha256: 5fe5479ce227168904921716f468fb7ba76f43a370c6de52e72eff42bc101967 + size: 584 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: propagators/b3 + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.0.1.1 + original: + subdir: propagators/b3 + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- completed: + name: hs-opentelemetry-propagator-w3c + pantry-tree: + sha256: 5e01af30d8c1702608dcfc4b8c3a56549a2e33359b3fa9ea3fd1abc63215ced5 + size: 598 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: propagators/w3c + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.0.1.3 + original: + subdir: propagators/w3c + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- completed: + name: hs-opentelemetry-otlp + pantry-tree: + sha256: 66d9865e4b811a5d60f6ff07f8407d9f72ea4796c03e6c20a4fcca49018b60bb + size: 2355 + sha256: eba9c66b5e90e4b4f4a90119053a75b68c0901454a992b463f17192600d034a9 + size: 357729 + subdir: otlp + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz + version: 0.0.1.0 + original: + subdir: otlp + url: https://github.com/iand675/hs-opentelemetry/archive/54251bd15565e3a07cda0cecfa544d209ae63df6.tar.gz +- 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