{-# 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