hs-opentelemetry-instrumentation-http-client 0.0.2.0 → 0.1.0.0

raw patch · 7 files changed

+245/−182 lines, 7 filesdep +unordered-containersdep ~hs-opentelemetry-apidep ~hs-opentelemetry-instrumentation-conduitsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: unordered-containers

Dependency ranges changed: hs-opentelemetry-api, hs-opentelemetry-instrumentation-conduit

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• Setup.hs +2/−0
• hs-opentelemetry-instrumentation-http-client.cabal +18/−16
• src/OpenTelemetry/Instrumentation/HttpClient.hs +102/−85
• src/OpenTelemetry/Instrumentation/HttpClient/Raw.hs +64/−45
• src/OpenTelemetry/Instrumentation/HttpClient/Simple.hs +48/−36
• test/Spec.hs +1/−0

@@ -1,3 +1,13 @@ # Changelog for hs-opentelemetry-instrumentation-http-client  ## Unreleased changes++## 0.1.0.0++### Breaking changes++- Use `HashMap Text Attribute` instead of `[(Text, Attribute)]` as attributes++## 0.0.2.0++- Added option to name an http request, falling back to the URL as the name of the span if left unnamed

@@ -1,2 +1,4 @@ import Distribution.Simple++ main = defaultMain

@@ -1,20 +1,20 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack -name:           hs-opentelemetry-instrumentation-http-client-version:        0.0.2.0-description:    Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/http-client#readme>-homepage:       https://github.com/iand675/hs-opentelemetry#readme-bug-reports:    https://github.com/iand675/hs-opentelemetry/issues-author:         Ian Duncan-maintainer:     ian@iankduncan.com-copyright:      2021 Ian Duncan-license:        BSD3-license-file:   LICENSE-build-type:     Simple+name:               hs-opentelemetry-instrumentation-http-client+version:            0.1.0.0+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/http-client#readme>+homepage:           https://github.com/iand675/hs-opentelemetry#readme+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues+author:             Ian Duncan, Jade Lovelace+maintainer:         ian@iankduncan.com+copyright:          2023 Ian Duncan, Mercury Technologies+license:            BSD3+license-file:       LICENSE+build-type:         Simple extra-source-files:     README.md     ChangeLog.md@@ -39,14 +39,15 @@     , bytestring     , case-insensitive     , conduit-    , hs-opentelemetry-api ==0.0.3.*-    , hs-opentelemetry-instrumentation-conduit ==0.0.1.*+    , hs-opentelemetry-api ==0.1.*+    , hs-opentelemetry-instrumentation-conduit >=0.0.1 && <0.2     , http-client     , http-client-tls     , http-conduit     , http-types     , text     , unliftio+    , unordered-containers   default-language: Haskell2010  test-suite hs-opentelemetry-instrumentation-http-client-test@@ -63,8 +64,8 @@     , bytestring     , case-insensitive     , conduit-    , hs-opentelemetry-api ==0.0.3.*-    , hs-opentelemetry-instrumentation-conduit ==0.0.1.*+    , hs-opentelemetry-api ==0.1.*+    , hs-opentelemetry-instrumentation-conduit >=0.0.1 && <0.2     , hs-opentelemetry-instrumentation-http-client     , http-client     , http-client-tls@@ -72,4 +73,5 @@     , http-types     , text     , unliftio+    , unordered-containers   default-language: Haskell2010

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ {- | Offer a few options for HTTP instrumentation  - Add attributes via 'Request' and 'Response' to an existing span (Best)@@ -6,58 +7,69 @@ - Provide a middleware to pull from the thread-local state (okay) - Modify the global manager to pull from the thread-local state (least good, can't be helped sometimes) -}-module OpenTelemetry.Instrumentation.HttpClient -  ( withResponse-  , httpLbs-  , httpNoBody-  , responseOpen-  , httpClientInstrumentationConfig-  , HttpClientInstrumentationConfig(..)-  , module X-  ) where+module OpenTelemetry.Instrumentation.HttpClient (+  withResponse,+  httpLbs,+  httpNoBody,+  responseOpen,+  httpClientInstrumentationConfig,+  HttpClientInstrumentationConfig (..),+  module X,+) where++import Control.Monad.IO.Class (MonadIO (..)) import qualified Data.ByteString.Lazy as L-import Control.Monad.IO.Class ( MonadIO(..) )+import GHC.Stack+import Network.HTTP.Client as X hiding (httpLbs, httpNoBody, responseOpen, withResponse)+import qualified Network.HTTP.Client as Client import OpenTelemetry.Context.ThreadLocal-import OpenTelemetry.Trace.Core-    ( defaultSpanArguments,-      SpanArguments(kind),-      SpanKind(Client),-      inSpan',-    )+import OpenTelemetry.Instrumentation.HttpClient.Raw (+  HttpClientInstrumentationConfig (..),+  httpClientInstrumentationConfig,+  httpTracerProvider,+  instrumentRequest,+  instrumentResponse,+ )+import OpenTelemetry.Trace.Core (+  SpanArguments (kind),+  SpanKind (Client),+  addAttributesToSpanArguments,+  callerAttributes,+  defaultSpanArguments,+  inSpan'',+ )+import UnliftIO (MonadUnliftIO, askRunInIO) -import Network.HTTP.Client as X hiding (withResponse, httpLbs, httpNoBody, responseOpen)-import qualified Network.HTTP.Client as Client-import OpenTelemetry.Instrumentation.HttpClient.Raw-    ( HttpClientInstrumentationConfig(..),-      instrumentRequest,-      instrumentResponse, httpClientInstrumentationConfig, httpTracerProvider )-import UnliftIO ( MonadUnliftIO, askRunInIO )  spanArgs :: SpanArguments-spanArgs = defaultSpanArguments { kind = Client }+spanArgs = defaultSpanArguments {kind = Client} --- | Instrumented variant of @Network.HTTP.Client.withResponse@------ Perform a @Request@ using a connection acquired from the given @Manager@,--- and then provide the @Response@ to the given function. This function is--- fully exception safe, guaranteeing that the response will be closed when the--- inner function exits. It is defined as:------ > withResponse req man f = bracket (responseOpen req man) responseClose f------ It is recommended that you use this function in place of explicit calls to--- 'responseOpen' and 'responseClose'.------ You will need to use functions such as 'brRead' to consume the response--- body.-withResponse :: (MonadUnliftIO m) => HttpClientInstrumentationConfig-             -> Client.Request-             -> Client.Manager-             -> (Client.Response Client.BodyReader -> m a)-             -> m a++{- | Instrumented variant of @Network.HTTP.Client.withResponse@++ Perform a @Request@ using a connection acquired from the given @Manager@,+ and then provide the @Response@ to the given function. This function is+ fully exception safe, guaranteeing that the response will be closed when the+ inner function exits. It is defined as:++ > withResponse req man f = bracket (responseOpen req man) responseClose f++ It is recommended that you use this function in place of explicit calls to+ 'responseOpen' and 'responseClose'.++ You will need to use functions such as 'brRead' to consume the response+ body.+-}+withResponse+  :: (MonadUnliftIO m, HasCallStack)+  => HttpClientInstrumentationConfig+  -> Client.Request+  -> Client.Manager+  -> (Client.Response Client.BodyReader -> m a)+  -> m a withResponse httpConf req man f = do   t <- httpTracerProvider-  inSpan' t "withResponse" spanArgs $ \_wrSpan -> do+  inSpan'' t "withResponse" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_wrSpan -> do     ctxt <- getContext     -- TODO would like to capture the req/resp time specifically     -- inSpan "http.request" (defaultSpanArguments { startingKind = Client }) $ \httpReqSpan -> do@@ -67,15 +79,17 @@       _ <- instrumentResponse httpConf ctxt resp       runInIO $ f resp --- | A convenience wrapper around 'withResponse' which reads in the entire--- response body and immediately closes the connection. Note that this function--- performs fully strict I\/O, and only uses a lazy ByteString in its response--- for memory efficiency. If you are anticipating a large response body, you--- are encouraged to use 'withResponse' and 'brRead' instead.-httpLbs :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response L.ByteString)++{- | A convenience wrapper around 'withResponse' which reads in the entire+ response body and immediately closes the connection. Note that this function+ performs fully strict I\/O, and only uses a lazy ByteString in its response+ for memory efficiency. If you are anticipating a large response body, you+ are encouraged to use 'withResponse' and 'brRead' instead.+-}+httpLbs :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response L.ByteString) httpLbs httpConf req man = do   t <- httpTracerProvider-  inSpan' t "httpLbs" spanArgs $ \_ -> do+  inSpan'' t "httpLbs" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_ -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- liftIO $ Client.httpLbs req' man@@ -83,51 +97,54 @@     pure resp  --- | A convenient wrapper around 'withResponse' which ignores the response--- body. This is useful, for example, when performing a HEAD request.-httpNoBody :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response ())+{- | A convenient wrapper around 'withResponse' which ignores the response+ body. This is useful, for example, when performing a HEAD request.+-}+httpNoBody :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response ()) httpNoBody httpConf req man = do   t <- httpTracerProvider-  inSpan' t "httpNoBody" spanArgs $ \_ -> do+  inSpan'' t "httpNoBody" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_ -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- liftIO $ Client.httpNoBody req' man     _ <- instrumentResponse httpConf ctxt resp     pure resp --- | The most low-level function for initiating an HTTP request.------ The first argument to this function gives a full specification--- on the request: the host to connect to, whether to use SSL,--- headers, etc. Please see 'Request' for full details.  The--- second argument specifies which 'Manager' should be used.------ This function then returns a 'Response' with a--- 'BodyReader'.  The 'Response' contains the status code--- and headers that were sent back to us, and the--- 'BodyReader' contains the body of the request.  Note--- that this 'BodyReader' allows you to have fully--- interleaved IO actions during your HTTP download, making it--- possible to download very large responses in constant memory.------ An important note: the response body returned by this function represents a--- live HTTP connection. As such, if you do not use the response body, an open--- socket will be retained indefinitely. You must be certain to call--- 'responseClose' on this response to free up resources.------ This function automatically performs any necessary redirects, as specified--- by the 'redirectCount' setting.------ When implementing a (reverse) proxy using this function or relating--- functions, it's wise to remove Transfer-Encoding:, Content-Length:,--- Content-Encoding: and Accept-Encoding: from request and response--- headers to be relayed.-responseOpen :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response Client.BodyReader)++{- | The most low-level function for initiating an HTTP request.++ The first argument to this function gives a full specification+ on the request: the host to connect to, whether to use SSL,+ headers, etc. Please see 'Request' for full details.  The+ second argument specifies which 'Manager' should be used.++ This function then returns a 'Response' with a+ 'BodyReader'.  The 'Response' contains the status code+ and headers that were sent back to us, and the+ 'BodyReader' contains the body of the request.  Note+ that this 'BodyReader' allows you to have fully+ interleaved IO actions during your HTTP download, making it+ possible to download very large responses in constant memory.++ An important note: the response body returned by this function represents a+ live HTTP connection. As such, if you do not use the response body, an open+ socket will be retained indefinitely. You must be certain to call+ 'responseClose' on this response to free up resources.++ This function automatically performs any necessary redirects, as specified+ by the 'redirectCount' setting.++ When implementing a (reverse) proxy using this function or relating+ functions, it's wise to remove Transfer-Encoding:, Content-Length:,+ Content-Encoding: and Accept-Encoding: from request and response+ headers to be relayed.+-}+responseOpen :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response Client.BodyReader) responseOpen httpConf req man = do   t <- httpTracerProvider-  inSpan' t "responseOpen" spanArgs $ \_ -> do+  inSpan'' t "responseOpen" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_ -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- liftIO $ Client.responseOpen req' man-    _ <-instrumentResponse httpConf ctxt resp+    _ <- instrumentResponse httpConf ctxt resp     pure resp

@@ -1,52 +1,64 @@+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}+ module OpenTelemetry.Instrumentation.HttpClient.Raw where+ import Control.Applicative ((<|>))-import Control.Monad.IO.Class-import OpenTelemetry.Context (Context, lookupSpan)-import OpenTelemetry.Context.ThreadLocal-import OpenTelemetry.Trace.Core-import OpenTelemetry.Propagator-import Network.HTTP.Client-import Network.HTTP.Types import Control.Monad (forM_, when)+import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import Data.Foldable (Foldable(toList)) import Data.CaseInsensitive (foldedCase)+import qualified Data.HashMap.Strict as H+import Data.Maybe (mapMaybe) import qualified Data.Maybe+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.HTTP.Client+import Network.HTTP.Types+import OpenTelemetry.Context (Context, lookupSpan)+import OpenTelemetry.Context.ThreadLocal+import OpenTelemetry.Propagator+import OpenTelemetry.Trace.Core + data HttpClientInstrumentationConfig = HttpClientInstrumentationConfig   { requestName :: Maybe T.Text   , requestHeadersToRecord :: [HeaderName]   , responseHeadersToRecord :: [HeaderName]   } + instance Semigroup HttpClientInstrumentationConfig where-  l <> r = HttpClientInstrumentationConfig-    { requestName = requestName r <|> requestName l -- flipped on purpose: last writer wins-    , requestHeadersToRecord = requestHeadersToRecord l <> requestHeadersToRecord r-    , responseHeadersToRecord = responseHeadersToRecord l <> responseHeadersToRecord r-    }+  l <> r =+    HttpClientInstrumentationConfig+      { requestName = requestName r <|> requestName l -- flipped on purpose: last writer wins+      , requestHeadersToRecord = requestHeadersToRecord l <> requestHeadersToRecord r+      , responseHeadersToRecord = responseHeadersToRecord l <> responseHeadersToRecord r+      } + instance Monoid HttpClientInstrumentationConfig where-  mempty = HttpClientInstrumentationConfig-    { requestName = Nothing-    , requestHeadersToRecord = mempty-    , responseHeadersToRecord = mempty-    }+  mempty =+    HttpClientInstrumentationConfig+      { requestName = Nothing+      , requestHeadersToRecord = mempty+      , responseHeadersToRecord = mempty+      } + httpClientInstrumentationConfig :: HttpClientInstrumentationConfig httpClientInstrumentationConfig = mempty -  -- TODO see if we can avoid recreating this on each request without being more invasive with the interface-httpTracerProvider :: MonadIO m => m Tracer++-- TODO see if we can avoid recreating this on each request without being more invasive with the interface+httpTracerProvider :: (MonadIO m) => m Tracer httpTracerProvider = do   tp <- getGlobalTracerProvider   pure $ makeTracer tp "hs-opentelemetry-instrumentation-http-client" tracerOptions + instrumentRequest-  :: MonadIO m+  :: (MonadIO m)   => HttpClientInstrumentationConfig   -> Context   -> Request@@ -56,35 +68,40 @@   forM_ (lookupSpan ctxt) $ \s -> do     let url =           T.decodeUtf8-          ((if secure req then "https://" else "http://") <> host req <> ":" <> B.pack (show $ port req) <> path req <> queryString req)+            ((if secure req then "https://" else "http://") <> host req <> ":" <> B.pack (show $ port req) <> path req <> queryString req)     updateName s $ Data.Maybe.fromMaybe url $ requestName conf-    addAttributes s-      [ ( "http.method", toAttribute $ T.decodeUtf8 $ method req)-      , ( "http.url", toAttribute url)-      , ( "http.target", toAttribute $ T.decodeUtf8 (path req <> queryString req))-      , ( "http.host", toAttribute $ T.decodeUtf8 $ host req)-      , ( "http.scheme", toAttribute $ TextAttribute $ if secure req then "https" else "http")-      , ( "http.flavor"+    addAttributes+      s+      [ ("http.method", toAttribute $ T.decodeUtf8 $ method req)+      , ("http.url", toAttribute url)+      , ("http.target", toAttribute $ T.decodeUtf8 (path req <> queryString req))+      , ("http.host", toAttribute $ T.decodeUtf8 $ host req)+      , ("http.scheme", toAttribute $ TextAttribute $ if secure req then "https" else "http")+      ,+        ( "http.flavor"         , toAttribute $ case requestVersion req of             (HttpVersion major minor) -> T.pack (show major <> "." <> show minor)         )-      , ( "http.user_agent"+      ,+        ( "http.user_agent"         , toAttribute $ maybe "" T.decodeUtf8 (lookup hUserAgent $ requestHeaders req)         )       ]-    addAttributes s $-      concatMap-        (\h -> toList $ (\v -> ("http.request.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (requestHeaders req)) $-        requestHeadersToRecord conf+    addAttributes s+      $ H.fromList+      $ mapMaybe+        (\h -> (\v -> ("http.request.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (requestHeaders req))+      $ requestHeadersToRecord conf    hdrs <- inject (getTracerProviderPropagators $ getTracerTracerProvider tp) ctxt $ requestHeaders req-  pure $ req-    { requestHeaders = hdrs-    }+  pure $+    req+      { requestHeaders = hdrs+      }   instrumentResponse-  :: MonadIO m+  :: (MonadIO m)   => HttpClientInstrumentationConfig   -> Context   -> Response a@@ -96,7 +113,8 @@   forM_ (lookupSpan ctxt') $ \s -> do     when (statusCode (responseStatus resp) >= 400) $ do       setStatus s (Error "")-    addAttributes s+    addAttributes+      s       [ ("http.status_code", toAttribute $ statusCode $ responseStatus resp)       -- TODO       -- , ("http.request_content_length",	_)@@ -108,7 +126,8 @@       -- , ("net.peer.ip")       -- , ("net.peer.port")       ]-    addAttributes s $-      concatMap-        (\h -> toList $ (\v -> ("http.response.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (responseHeaders resp)) $-        responseHeadersToRecord conf+    addAttributes s+      $ H.fromList+      $ mapMaybe+        (\h -> (\v -> ("http.response.header." <> T.decodeUtf8 (foldedCase h), toAttribute (T.decodeUtf8 v))) <$> lookup h (responseHeaders resp))+      $ responseHeadersToRecord conf

@@ -1,107 +1,119 @@ {-# LANGUAGE OverloadedStrings #-}-module OpenTelemetry.Instrumentation.HttpClient.Simple -  ( httpBS-  , httpLBS-  , httpNoBody-  , httpJSON-  , httpJSONEither-  , httpSink-  , httpSource-  , withResponse-  , httpClientInstrumentationConfig-  , HttpClientInstrumentationConfig(..)-  , module X-  ) where-import qualified Network.HTTP.Simple as Simple-import Network.HTTP.Simple as X hiding (httpBS, httpLBS, httpNoBody, httpJSON, httpJSONEither, httpSink, httpSource, withResponse)++module OpenTelemetry.Instrumentation.HttpClient.Simple (+  httpBS,+  httpLBS,+  httpNoBody,+  httpJSON,+  httpJSONEither,+  httpSink,+  httpSource,+  withResponse,+  httpClientInstrumentationConfig,+  HttpClientInstrumentationConfig (..),+  module X,+) where++import Conduit (MonadResource, lift)+import Data.Aeson (FromJSON) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Conduit (ConduitM, Void)+import GHC.Stack+import Network.HTTP.Simple as X hiding (httpBS, httpJSON, httpJSONEither, httpLBS, httpNoBody, httpSink, httpSource, withResponse)+import qualified Network.HTTP.Simple as Simple import OpenTelemetry.Context.ThreadLocal-import OpenTelemetry.Trace.Core-import OpenTelemetry.Instrumentation.HttpClient.Raw import qualified OpenTelemetry.Instrumentation.Conduit as Conduit+import OpenTelemetry.Instrumentation.HttpClient.Raw+import OpenTelemetry.Trace.Core import UnliftIO-import Data.Aeson (FromJSON)-import Conduit (MonadResource, lift) + spanArgs :: SpanArguments-spanArgs = defaultSpanArguments { kind = Client }+spanArgs = defaultSpanArguments {kind = Client} -httpBS :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response B.ByteString)++httpBS :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response B.ByteString) httpBS httpConf req = do   t <- httpTracerProvider-  inSpan' t "httpBS" spanArgs $ \_s -> do+  inSpan' t "httpBS" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- Simple.httpBS req'     _ <- instrumentResponse httpConf ctxt resp     pure resp -httpLBS :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response L.ByteString)++httpLBS :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response L.ByteString) httpLBS httpConf req = do   t <- httpTracerProvider-  inSpan' t "httpLBS" spanArgs $ \_s -> do+  inSpan' t "httpLBS" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- Simple.httpLBS req'     _ <- instrumentResponse httpConf ctxt resp     pure resp -httpNoBody :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response ())++httpNoBody :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response ()) httpNoBody httpConf req = do   t <- httpTracerProvider-  inSpan' t "httpNoBody" spanArgs $ \_s -> do+  inSpan' t "httpNoBody" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- Simple.httpNoBody req'     _ <- instrumentResponse httpConf ctxt resp     pure resp -httpJSON :: (MonadUnliftIO m, FromJSON a) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response a)++httpJSON :: (MonadUnliftIO m, FromJSON a, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response a) httpJSON httpConf req = do   t <- httpTracerProvider-  inSpan' t "httpJSON" spanArgs $ \_s -> do+  inSpan' t "httpJSON" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- Simple.httpJSON req'     _ <- instrumentResponse httpConf ctxt resp     pure resp -httpJSONEither :: (FromJSON a, MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response (Either Simple.JSONException a))++httpJSONEither :: (FromJSON a, MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response (Either Simple.JSONException a)) httpJSONEither httpConf req = do   t <- httpTracerProvider-  inSpan' t "httpJSONEither" spanArgs $ \_s -> do+  inSpan' t "httpJSONEither" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     resp <- Simple.httpJSONEither req'     _ <- instrumentResponse httpConf ctxt resp     pure resp -httpSink :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response () -> ConduitM B.ByteString Void m a) -> m a++httpSink :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response () -> ConduitM B.ByteString Void m a) -> m a httpSink httpConf req f = do   t <- httpTracerProvider-  inSpan' t "httpSink" spanArgs $ \_s -> do +  inSpan' t "httpSink" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     Simple.httpSink req' $ \resp -> do       _ <- instrumentResponse httpConf ctxt resp       f resp -httpSource :: (MonadUnliftIO m, MonadResource m) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response (ConduitM i B.ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r++httpSource :: (MonadUnliftIO m, MonadResource m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response (ConduitM i B.ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r httpSource httpConf req f = do   t <- httpTracerProvider-  Conduit.inSpan t "httpSource" spanArgs $ \_s -> do+  Conduit.inSpan t "httpSource" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- lift getContext     req' <- instrumentRequest httpConf ctxt req     Simple.httpSource req' $ \resp -> do       _ <- instrumentResponse httpConf ctxt resp       f resp -withResponse :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response (ConduitM i B.ByteString m ()) -> m a) -> m a++withResponse :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response (ConduitM i B.ByteString m ()) -> m a) -> m a withResponse httpConf req f = do   t <- httpTracerProvider-  inSpan' t "withResponse" spanArgs $ \_s -> do+  inSpan' t "withResponse" (addAttributesToSpanArguments callerAttributes spanArgs) $ \_s -> do     ctxt <- getContext     req' <- instrumentRequest httpConf ctxt req     Simple.withResponse req' $ \resp -> do

@@ -1,2 +1,3 @@+ main :: IO () main = putStrLn "Test suite not yet implemented"