{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} module OpenTelemetry.Instrumentation.Conduit where import Conduit import Control.Exception (SomeException, throwIO) import Data.Text (Text) import GHC.Stack (HasCallStack) import OpenTelemetry.Context.ThreadLocal import OpenTelemetry.Trace.Core hiding (getTracer) inSpan :: (MonadResource m, MonadUnliftIO m, HasCallStack) => Tracer -> Text -> SpanArguments -> (Span -> ConduitM i o m a) -> ConduitM i o m a inSpan :: forall (m :: * -> *) i o a. (MonadResource m, MonadUnliftIO m, HasCallStack) => Tracer -> Text -> SpanArguments -> (Span -> ConduitM i o m a) -> ConduitM i o m a inSpan Tracer t Text n SpanArguments args Span -> ConduitM i o m a f = do Context ctx <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall (m :: * -> *). MonadIO m => m Context getContext forall (m :: * -> *) a i o r. MonadResource m => IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r bracketP (forall (m :: * -> *). MonadIO m => Tracer -> Context -> Text -> SpanArguments -> m Span createSpanWithoutCallStack Tracer t Context ctx Text n forall a b. (a -> b) -> a -> b $ HashMap Text Attribute -> SpanArguments -> SpanArguments addAttributesToSpanArguments HasCallStack => HashMap Text Attribute callerAttributes SpanArguments args) (forall (m :: * -> *). MonadIO m => Span -> Maybe Timestamp -> m () `endSpan` forall a. Maybe a Nothing) forall a b. (a -> b) -> a -> b $ \Span span_ -> do forall (m :: * -> *) e i o r. (MonadUnliftIO m, Exception e) => ConduitT i o m r -> (e -> ConduitT i o m r) -> ConduitT i o m r catchC (Span -> ConduitM i o m a f Span span_) forall a b. (a -> b) -> a -> b $ \SomeException e -> do forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO forall a b. (a -> b) -> a -> b $ do forall (m :: * -> *) e. (MonadIO m, Exception e) => Span -> HashMap Text Attribute -> Maybe Timestamp -> e -> m () recordException Span span_ [(Text "exception.escaped", forall a. ToAttribute a => a -> Attribute toAttribute Bool True)] forall a. Maybe a Nothing (SomeException e :: SomeException) forall e a. Exception e => e -> IO a throwIO SomeException e