{-# 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) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Conduit (ConduitM, Void) import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Trace.Core import OpenTelemetry.Instrumentation.HttpClient.Raw import qualified OpenTelemetry.Instrumentation.Conduit as Conduit import UnliftIO import Data.Aeson (FromJSON) import Conduit (MonadResource, lift) spanArgs :: SpanArguments spanArgs :: SpanArguments spanArgs = SpanArguments defaultSpanArguments { kind :: SpanKind kind = SpanKind Client } httpBS :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response B.ByteString) httpBS :: HttpClientInstrumentationConfig -> Request -> m (Response ByteString) httpBS HttpClientInstrumentationConfig httpConf Request req = 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 "httpBS" SpanArguments spanArgs ((Span -> m (Response ByteString)) -> m (Response ByteString)) -> (Span -> m (Response ByteString)) -> m (Response ByteString) forall a b. (a -> b) -> a -> b $ \Span _s -> 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 <- Request -> m (Response ByteString) forall (m :: * -> *). MonadIO m => Request -> m (Response ByteString) Simple.httpBS Request req' () _ <- 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 httpLBS :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response L.ByteString) httpLBS :: HttpClientInstrumentationConfig -> Request -> m (Response ByteString) httpLBS HttpClientInstrumentationConfig httpConf Request req = 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 _s -> 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 <- Request -> m (Response ByteString) forall (m :: * -> *). MonadIO m => Request -> m (Response ByteString) Simple.httpLBS Request req' () _ <- 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 -> Simple.Request -> m (Simple.Response ()) httpNoBody :: HttpClientInstrumentationConfig -> Request -> m (Response ()) httpNoBody HttpClientInstrumentationConfig httpConf Request req = 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 _s -> 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 <- Request -> m (Response ()) forall (m :: * -> *). MonadIO m => Request -> m (Response ()) Simple.httpNoBody Request req' () _ <- 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 httpJSON :: (MonadUnliftIO m, FromJSON a) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response a) httpJSON :: HttpClientInstrumentationConfig -> Request -> m (Response a) httpJSON HttpClientInstrumentationConfig httpConf Request req = do Tracer t <- m Tracer forall (m :: * -> *). MonadIO m => m Tracer httpTracerProvider Tracer -> Text -> SpanArguments -> (Span -> m (Response a)) -> m (Response a) forall (m :: * -> *) a. (MonadUnliftIO m, HasCallStack) => Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a inSpan' Tracer t Text "httpJSON" SpanArguments spanArgs ((Span -> m (Response a)) -> m (Response a)) -> (Span -> m (Response a)) -> m (Response a) forall a b. (a -> b) -> a -> b $ \Span _s -> 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 a resp <- Request -> m (Response a) forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Request -> m (Response a) Simple.httpJSON Request req' () _ <- HttpClientInstrumentationConfig -> Context -> Response a -> m () forall (m :: * -> *) a. MonadIO m => HttpClientInstrumentationConfig -> Context -> Response a -> m () instrumentResponse HttpClientInstrumentationConfig httpConf Context ctxt Response a resp Response a -> m (Response a) forall (f :: * -> *) a. Applicative f => a -> f a pure Response a resp httpJSONEither :: (FromJSON a, MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> m (Simple.Response (Either Simple.JSONException a)) httpJSONEither :: HttpClientInstrumentationConfig -> Request -> m (Response (Either JSONException a)) httpJSONEither HttpClientInstrumentationConfig httpConf Request req = do Tracer t <- m Tracer forall (m :: * -> *). MonadIO m => m Tracer httpTracerProvider Tracer -> Text -> SpanArguments -> (Span -> m (Response (Either JSONException a))) -> m (Response (Either JSONException a)) forall (m :: * -> *) a. (MonadUnliftIO m, HasCallStack) => Tracer -> Text -> SpanArguments -> (Span -> m a) -> m a inSpan' Tracer t Text "httpJSONEither" SpanArguments spanArgs ((Span -> m (Response (Either JSONException a))) -> m (Response (Either JSONException a))) -> (Span -> m (Response (Either JSONException a))) -> m (Response (Either JSONException a)) forall a b. (a -> b) -> a -> b $ \Span _s -> 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 (Either JSONException a) resp <- Request -> m (Response (Either JSONException a)) forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Request -> m (Response (Either JSONException a)) Simple.httpJSONEither Request req' () _ <- HttpClientInstrumentationConfig -> Context -> Response (Either JSONException a) -> m () forall (m :: * -> *) a. MonadIO m => HttpClientInstrumentationConfig -> Context -> Response a -> m () instrumentResponse HttpClientInstrumentationConfig httpConf Context ctxt Response (Either JSONException a) resp Response (Either JSONException a) -> m (Response (Either JSONException a)) forall (f :: * -> *) a. Applicative f => a -> f a pure Response (Either JSONException a) resp httpSink :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response () -> ConduitM B.ByteString Void m a) -> m a httpSink :: HttpClientInstrumentationConfig -> Request -> (Response () -> ConduitM ByteString Void m a) -> m a httpSink HttpClientInstrumentationConfig httpConf Request req Response () -> ConduitM ByteString Void 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 "httpSink" SpanArguments spanArgs ((Span -> m a) -> m a) -> (Span -> m a) -> m a forall a b. (a -> b) -> a -> b $ \Span _s -> 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 Request -> (Response () -> ConduitM ByteString Void m a) -> m a forall (m :: * -> *) a. MonadUnliftIO m => Request -> (Response () -> ConduitM ByteString Void m a) -> m a Simple.httpSink Request req' ((Response () -> ConduitM ByteString Void m a) -> m a) -> (Response () -> ConduitM ByteString Void m a) -> m a forall a b. (a -> b) -> a -> b $ \Response () resp -> do () _ <- HttpClientInstrumentationConfig -> Context -> Response () -> ConduitT ByteString Void m () forall (m :: * -> *) a. MonadIO m => HttpClientInstrumentationConfig -> Context -> Response a -> m () instrumentResponse HttpClientInstrumentationConfig httpConf Context ctxt Response () resp Response () -> ConduitM ByteString Void m a f Response () 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 :: HttpClientInstrumentationConfig -> Request -> (Response (ConduitM i ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r httpSource HttpClientInstrumentationConfig httpConf Request req Response (ConduitM i ByteString m ()) -> ConduitM i o m r f = do Tracer t <- ConduitT i o m Tracer forall (m :: * -> *). MonadIO m => m Tracer httpTracerProvider Tracer -> Text -> SpanArguments -> (Span -> ConduitM i o m r) -> ConduitM i o m r forall (m :: * -> *) i o a. (MonadResource m, MonadUnliftIO m) => Tracer -> Text -> SpanArguments -> (Span -> ConduitM i o m a) -> ConduitM i o m a Conduit.inSpan Tracer t Text "httpSource" SpanArguments spanArgs ((Span -> ConduitM i o m r) -> ConduitM i o m r) -> (Span -> ConduitM i o m r) -> ConduitM i o m r forall a b. (a -> b) -> a -> b $ \Span _s -> do Context ctxt <- m Context -> ConduitT i o m Context forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift m Context forall (m :: * -> *). MonadIO m => m Context getContext Request req' <- HttpClientInstrumentationConfig -> Context -> Request -> ConduitT i o m Request forall (m :: * -> *). MonadIO m => HttpClientInstrumentationConfig -> Context -> Request -> m Request instrumentRequest HttpClientInstrumentationConfig httpConf Context ctxt Request req Request -> (Response (ConduitM i ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r forall (m :: * -> *) (n :: * -> *) i o r. (MonadResource m, MonadIO n) => Request -> (Response (ConduitM i ByteString n ()) -> ConduitM i o m r) -> ConduitM i o m r Simple.httpSource Request req' ((Response (ConduitM i ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r) -> (Response (ConduitM i ByteString m ()) -> ConduitM i o m r) -> ConduitM i o m r forall a b. (a -> b) -> a -> b $ \Response (ConduitM i ByteString m ()) resp -> do () _ <- HttpClientInstrumentationConfig -> Context -> Response (ConduitM i ByteString m ()) -> ConduitT i o m () forall (m :: * -> *) a. MonadIO m => HttpClientInstrumentationConfig -> Context -> Response a -> m () instrumentResponse HttpClientInstrumentationConfig httpConf Context ctxt Response (ConduitM i ByteString m ()) resp Response (ConduitM i ByteString m ()) -> ConduitM i o m r f Response (ConduitM i ByteString m ()) resp withResponse :: (MonadUnliftIO m) => HttpClientInstrumentationConfig -> Simple.Request -> (Simple.Response (ConduitM i B.ByteString m ()) -> m a) -> m a withResponse :: HttpClientInstrumentationConfig -> Request -> (Response (ConduitM i ByteString m ()) -> m a) -> m a withResponse HttpClientInstrumentationConfig httpConf Request req Response (ConduitM i ByteString m ()) -> 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 _s -> 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 Request -> (Response (ConduitM i ByteString m ()) -> m a) -> m a forall (m :: * -> *) (n :: * -> *) i a. (MonadUnliftIO m, MonadIO n) => Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a Simple.withResponse Request req' ((Response (ConduitM i ByteString m ()) -> m a) -> m a) -> (Response (ConduitM i ByteString m ()) -> m a) -> m a forall a b. (a -> b) -> a -> b $ \Response (ConduitM i ByteString m ()) resp -> do () _ <- HttpClientInstrumentationConfig -> Context -> Response (ConduitM i ByteString m ()) -> m () forall (m :: * -> *) a. MonadIO m => HttpClientInstrumentationConfig -> Context -> Response a -> m () instrumentResponse HttpClientInstrumentationConfig httpConf Context ctxt Response (ConduitM i ByteString m ()) resp Response (ConduitM i ByteString m ()) -> m a f Response (ConduitM i ByteString m ()) resp