refactor(users/Profpatsch/whatcd-resolver): use builder for otel

This makes `addAttribute` a little nicer to handle, because we can now
just put a `(builder, value)` tuple (yay, orphan instances!)

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

users/Profpatsch/whatcd-resolver/src/AppT.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module AppT where
 
+import Builder
 import Control.Monad.Logger qualified as Logger
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
@@ -98,6 +100,9 @@ addEventSimple span name =
 jsonAttribute :: Enc -> Otel.Attribute
 jsonAttribute e = e & Enc.encToTextPretty & Otel.toAttribute
 
+instance Otel.ToAttribute (a, TextBuilder a) where
+  toAttribute (a, b) = buildText b a & Otel.toAttribute
+
 parseOrThrow :: (MonadThrow m, MonadIO m) => Otel.Span -> FieldParser from to -> from -> m to
 parseOrThrow span fp f =
   f & Field.runFieldParser fp & \case
@@ -208,6 +213,7 @@ runPGTransaction (Transaction transaction) = do
     withPGTransaction pool $ \conn -> do
       unliftIO $ runReaderT transaction conn
 
+-- | Best effort to convert a value to a JSON string that can be put in an Otel attribute.
 toOtelJsonAttr :: (ToOtelJsonAttr a) => a -> Otel.Attribute
 toOtelJsonAttr = toOtelJsonAttrImpl >>> Enc.encToTextPretty >>> Otel.toAttribute
 
@@ -215,6 +221,9 @@ toOtelJsonAttr = toOtelJsonAttrImpl >>> Enc.encToTextPretty >>> Otel.toAttribute
 class ToOtelJsonAttr a where
   toOtelJsonAttrImpl :: a -> Enc
 
+instance ToOtelJsonAttr Enc where
+  toOtelJsonAttrImpl = id
+
 -- | Bytes are leniently converted to Text, because they are often used as UTF-8 encoded strings.
 instance ToOtelJsonAttr ByteString where
   toOtelJsonAttrImpl = Enc.text . bytesToTextUtf8Lenient

users/Profpatsch/whatcd-resolver/src/Html.hs

@@ -2,6 +2,7 @@
 
 module Html where
 
+import Builder
 import Data.Aeson qualified as Json
 import Data.Aeson.KeyMap qualified as KeyMap
 import Data.List.NonEmpty qualified as NonEmpty
@@ -15,7 +16,7 @@ import Prelude hiding (span)
 -- | Render an arbitrary json value to HTML in a more-or-less reasonable fashion.
 mkVal :: Json.Value -> Html
 mkVal = \case
-  Json.Number n -> Html.toHtml @Text $ showToText n
+  Json.Number n -> Html.lazyText $ buildTextLazy scientificDecimalT n
   Json.String s -> Html.toHtml @Text s
   Json.Bool True -> [hsx|<em>true</em>|]
   Json.Bool False -> [hsx|<em>false</em>|]

users/Profpatsch/whatcd-resolver/src/Redacted.hs

@@ -4,6 +4,7 @@ module Redacted where
 
 import AppT
 import Arg
+import Builder
 import Comparison
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
@@ -65,7 +66,7 @@ redactedGetTorrentFile dat = inSpan' "Redacted Get Torrent File" $ \span -> do
       ( T2
           (label @"action" "download")
           ( label @"actionArgs"
-              [ ("id", Just (dat.torrentId & showToText @Int & textToBytesUtf8))
+              [ ("id", Just (buildBytes intDecimalB dat.torrentId))
               -- try using tokens as long as we have them (TODO: what if there’s no tokens left?
               -- ANSWER: it breaks:
               -- responseBody = "{\"status\":\"failure\",\"error\":\"You do not have any freeleech tokens left. Please use the regular DL link.\"}",
@@ -139,7 +140,7 @@ redactedSearchAndInsert extraArguments = do
       redactedSearch
         ( extraArguments
             -- pass the page (for every search but the first one)
-            <> (mpage & ifExists (\page -> ("page", (page :: Natural) & showToText & textToBytesUtf8)))
+            <> (mpage & ifExists (\page -> ("page", buildBytes naturalDecimalB page)))
         )
         ( do
             status <- Json.key "status" Json.asText

users/Profpatsch/whatcd-resolver/src/Transmission.hs

@@ -3,6 +3,7 @@
 module Transmission where
 
 import AppT
+import Builder
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
 import Data.Aeson qualified as Json
@@ -25,7 +26,6 @@ import Json.Enc qualified as Enc
 import Label
 import MyPrelude
 import Network.HTTP.Types
-import OpenTelemetry.Attributes (ToAttribute (toAttribute))
 import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
 import Optional
 import Postgres.MonadPostgres
@@ -253,7 +253,7 @@ doTransmissionRequest ::
 doTransmissionRequest span dat (req, parser) = do
   sessionId <- getCurrentTransmissionSessionId
   let textArg t = (Enc.text t, Otel.toAttribute @Text t)
-  let encArg enc = (enc, Otel.toAttribute @Text $ enc & Enc.encToTextPretty)
+  let encArg enc = (enc, enc & toOtelJsonAttr)
   let intArg i = (Enc.int i, Otel.toAttribute @Int i)
 
   let body :: [(Text, (Enc, Otel.Attribute))] =
@@ -292,20 +292,14 @@ doTransmissionRequest span dat (req, parser) = do
           & liftIO
           <&> NonEmpty.head
 
-      addAttributes span' $
-        HashMap.fromList
-          [ ("transmission.new_session_id", tid & bytesToTextUtf8Lenient & toAttribute),
-            ("transmission.old_session_id", sessionId <&> bytesToTextUtf8Lenient & fromMaybe "<none yet>" & toAttribute)
-          ]
+      addAttribute span' "transmission.new_session_id" (tid, utf8LenientT)
+      addAttribute span' "transmission.old_session_id" (sessionId, utf8LenientT >&< fromMaybe "<none yet>")
 
       updateTransmissionSessionId tid
 
       doTransmissionRequest span dat (req, parser)
     200 -> do
-      addAttributes span $
-        HashMap.fromList
-          [ ("transmission.valid_session_id", sessionId <&> bytesToTextUtf8Lenient & fromMaybe "<none yet>" & toAttribute)
-          ]
+      addAttribute span "transmission.valid_session_id" (sessionId, utf8LenientT >&< fromMaybe "<none yet>")
       resp
         & Http.getResponseBody
         & Json.parseStrict

users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs

@@ -5,6 +5,7 @@ module WhatcdResolver where
 
 import AppT
 import Arg
+import Builder
 import Comparison
 import Control.Category qualified as Cat
 import Control.Monad.Catch.Pure (runCatch)
@@ -562,7 +563,7 @@ getBestTorrentsData ::
   Maybe (Label "artistRedactedId" Natural) ->
   Transaction m [TorrentData (Label "percentDone" Percentage)]
 getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span -> do
-  artistFilter & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId & showToText & Otel.toAttribute))
+  artistFilter & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId, naturalDecimalT))
   let getBest = getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
   bestStale :: [TorrentData ()] <- getBest
   (statusInfo, transmissionStatus) <-