feat(users/Profpatsch/whatcd-resolver): log json+ld fetching r/7709

This traces the target of a json+ld fetch.

We also simplify the telemetry stuff by using a pseudo-class
`MonadOtel` everywhere.

I wonder if we can get rid of passing the span to `assertM`, because
it’s kind of an antipattern to be honest.

Change-Id: I1448d643c909a29684fa1ae54037177ba2c20639
Reviewed-on: https://cl.tvl.fyi/c/depot/+/11166
Tested-by: BuildkiteCI
Autosubmit: Profpatsch <mail@profpatsch.de>
Reviewed-by: Profpatsch <mail@profpatsch.de>

1 files changed, 17 insertions, 2 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/AppT.hs b/users/Profpatsch/whatcd-resolver/src/AppT.hs
index bc94fc4ed583..9c6180c9aaed 100644
--- a/users/Profpatsch/whatcd-resolver/src/AppT.hs
+++ b/users/Profpatsch/whatcd-resolver/src/AppT.hs
@@ -6,6 +6,7 @@ import Control.Monad.Logger qualified as Logger
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
 import Data.Error.Tree
+import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
 import Data.Pool (Pool)
 import Data.Text qualified as Text
@@ -45,12 +46,26 @@ instance (MonadIO m) => MonadLogger (AppT m) where
 instance (Monad m) => Otel.MonadTracer (AppT m) where
   getTracer = AppT $ asks (.tracer)
 
-inSpan :: (MonadUnliftIO m, Otel.MonadTracer m) => Text -> m a -> m a
+class (MonadUnliftIO m, Otel.MonadTracer m) => MonadOtel m
+
+instance (MonadUnliftIO m) => MonadOtel (AppT m)
+
+instance (MonadOtel m) => MonadOtel (Transaction m)
+
+inSpan :: (MonadOtel m) => Text -> m a -> m a
 inSpan name = Otel.inSpan name Otel.defaultSpanArguments
 
-inSpan' :: (MonadUnliftIO m, Otel.MonadTracer m) => Text -> (Otel.Span -> m a) -> m a
+inSpan' :: (MonadOtel m) => Text -> (Otel.Span -> m a) -> m a
 inSpan' name = Otel.inSpan' name Otel.defaultSpanArguments
 
+-- | Add the attribute to the span, prefixing it with the `_` namespace (to easier distinguish our application’s tags from standard tags)
+addAttribute :: (MonadIO m, Otel.ToAttribute a) => Otel.Span -> Text -> a -> m ()
+addAttribute span key a = Otel.addAttribute span ("_." <> key) a
+
+-- | Add the attributes to the span, prefixing each key with the `_` namespace (to easier distinguish our application’s tags from standard tags)
+addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m ()
+addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>)
+
 appThrowTree :: (MonadThrow m, MonadIO m) => Otel.Span -> ErrorTree -> m a
 appThrowTree span exc = do
   let msg = prettyErrorTree exc