{-# LANGUAGE OverloadedStrings #-}
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 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.Instrumentation.HttpClient.Raw (
HttpClientInstrumentationConfig (..),
httpClientInstrumentationConfig,
httpTracerProvider,
instrumentRequest,
instrumentResponse,
)
import OpenTelemetry.Trace.Core (
SpanArguments (kind),
SpanKind (Client),
addAttributesToSpanArguments,
callerAttributes,
defaultSpanArguments,
inSpan'',
)
import UnliftIO (MonadUnliftIO, askRunInIO)
spanArgs :: SpanArguments
spanArgs :: SpanArguments
spanArgs = SpanArguments
defaultSpanArguments {kind :: SpanKind
kind = SpanKind
Client}
withResponse
:: (MonadUnliftIO m, HasCallStack)
=> HttpClientInstrumentationConfig
-> Client.Request
-> Client.Manager
-> (Client.Response Client.BodyReader -> m a)
-> m a
withResponse :: forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
HttpClientInstrumentationConfig
-> Request -> Manager -> (Response BodyReader -> m a) -> m a
withResponse HttpClientInstrumentationConfig
httpConf Request
req Manager
man Response BodyReader -> m a
f = do
Tracer
t <- forall (m :: * -> *). MonadIO m => m Tracer
httpTracerProvider
forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan'' Tracer
t Text
"withResponse" (HashMap Text Attribute -> SpanArguments -> SpanArguments
addAttributesToSpanArguments HasCallStack => HashMap Text Attribute
callerAttributes SpanArguments
spanArgs) forall a b. (a -> b) -> a -> b
$ \Span
_wrSpan -> do
Context
ctxt <- forall (m :: * -> *). MonadIO m => m Context
getContext
Request
req' <- forall (m :: * -> *).
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Request -> m Request
instrumentRequest HttpClientInstrumentationConfig
httpConf Context
ctxt Request
req
m a -> IO a
runInIO <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
Client.withResponse Request
req' Manager
man forall a b. (a -> b) -> a -> b
$ \Response BodyReader
resp -> do
()
_ <- forall (m :: * -> *) a.
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Response a -> m ()
instrumentResponse HttpClientInstrumentationConfig
httpConf Context
ctxt Response BodyReader
resp
m a -> IO a
runInIO forall a b. (a -> b) -> a -> b
$ Response BodyReader -> m a
f Response BodyReader
resp
httpLbs :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response L.ByteString)
httpLbs :: forall (m :: * -> *).
(MonadUnliftIO m, HasCallStack) =>
HttpClientInstrumentationConfig
-> Request -> Manager -> m (Response ByteString)
httpLbs HttpClientInstrumentationConfig
httpConf Request
req Manager
man = do
Tracer
t <- forall (m :: * -> *). MonadIO m => m Tracer
httpTracerProvider
forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan'' Tracer
t Text
"httpLbs" (HashMap Text Attribute -> SpanArguments -> SpanArguments
addAttributesToSpanArguments HasCallStack => HashMap Text Attribute
callerAttributes SpanArguments
spanArgs) forall a b. (a -> b) -> a -> b
$ \Span
_ -> do
Context
ctxt <- forall (m :: * -> *). MonadIO m => m Context
getContext
Request
req' <- forall (m :: * -> *).
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Request -> m Request
instrumentRequest HttpClientInstrumentationConfig
httpConf Context
ctxt Request
req
Response ByteString
resp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
req' Manager
man
()
_ <- forall (m :: * -> *) a.
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Response a -> m ()
instrumentResponse HttpClientInstrumentationConfig
httpConf Context
ctxt Response ByteString
resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response ByteString
resp
httpNoBody :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response ())
httpNoBody :: forall (m :: * -> *).
(MonadUnliftIO m, HasCallStack) =>
HttpClientInstrumentationConfig
-> Request -> Manager -> m (Response ())
httpNoBody HttpClientInstrumentationConfig
httpConf Request
req Manager
man = do
Tracer
t <- forall (m :: * -> *). MonadIO m => m Tracer
httpTracerProvider
forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan'' Tracer
t Text
"httpNoBody" (HashMap Text Attribute -> SpanArguments -> SpanArguments
addAttributesToSpanArguments HasCallStack => HashMap Text Attribute
callerAttributes SpanArguments
spanArgs) forall a b. (a -> b) -> a -> b
$ \Span
_ -> do
Context
ctxt <- forall (m :: * -> *). MonadIO m => m Context
getContext
Request
req' <- forall (m :: * -> *).
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Request -> m Request
instrumentRequest HttpClientInstrumentationConfig
httpConf Context
ctxt Request
req
Response ()
resp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ())
Client.httpNoBody Request
req' Manager
man
()
_ <- forall (m :: * -> *) a.
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Response a -> m ()
instrumentResponse HttpClientInstrumentationConfig
httpConf Context
ctxt Response ()
resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response ()
resp
responseOpen :: (MonadUnliftIO m, HasCallStack) => HttpClientInstrumentationConfig -> Client.Request -> Client.Manager -> m (Client.Response Client.BodyReader)
responseOpen :: forall (m :: * -> *).
(MonadUnliftIO m, HasCallStack) =>
HttpClientInstrumentationConfig
-> Request -> Manager -> m (Response BodyReader)
responseOpen HttpClientInstrumentationConfig
httpConf Request
req Manager
man = do
Tracer
t <- forall (m :: * -> *). MonadIO m => m Tracer
httpTracerProvider
forall (m :: * -> *) a.
(MonadUnliftIO m, HasCallStack) =>
Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a
inSpan'' Tracer
t Text
"responseOpen" (HashMap Text Attribute -> SpanArguments -> SpanArguments
addAttributesToSpanArguments HasCallStack => HashMap Text Attribute
callerAttributes SpanArguments
spanArgs) forall a b. (a -> b) -> a -> b
$ \Span
_ -> do
Context
ctxt <- forall (m :: * -> *). MonadIO m => m Context
getContext
Request
req' <- forall (m :: * -> *).
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Request -> m Request
instrumentRequest HttpClientInstrumentationConfig
httpConf Context
ctxt Request
req
Response BodyReader
resp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response BodyReader)
Client.responseOpen Request
req' Manager
man
()
_ <- forall (m :: * -> *) a.
MonadIO m =>
HttpClientInstrumentationConfig -> Context -> Response a -> m ()
instrumentResponse HttpClientInstrumentationConfig
httpConf Context
ctxt Response BodyReader
resp
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response BodyReader
resp