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