fix(users/Profpatsch/whatcd-resolver): reduce json data from db

We’d transfer the full json data for each torrent from the db instead
of just the 2 or 3 fields we need.

Adds some more helpers for parsing database values.

Adds some better logging events & traces.

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

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

@@ -74,6 +74,16 @@ addAttribute span key a = Otel.addAttribute span ("_." <> key) a
 addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m ()
 addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>)
 
+addEventSimple :: (MonadIO m) => Otel.Span -> Text -> m ()
+addEventSimple span name =
+  Otel.addEvent
+    span
+    Otel.NewEvent
+      { Otel.newEventName = name,
+        Otel.newEventTimestamp = Nothing,
+        Otel.newEventAttributes = mempty
+      }
+
 -- | Create an otel attribute from a json encoder
 jsonAttribute :: Enc -> Otel.Attribute
 jsonAttribute e = e & Enc.encToTextPretty & Otel.toAttribute

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

@@ -364,14 +364,13 @@ data TorrentData transmissionInfo = TorrentData
     torrentId :: Int,
     seedingWeight :: Int,
     artists :: [T2 "artistId" Int "artistName" Text],
-    torrentJson :: Json.Value,
     torrentGroupJson :: TorrentGroupJson,
     torrentStatus :: TorrentStatus transmissionInfo
   }
 
 data TorrentGroupJson = TorrentGroupJson
   { groupName :: Text,
-    groupYear :: Int
+    groupYear :: Natural
   }
 
 data TorrentStatus transmissionInfo
@@ -420,8 +419,9 @@ getBestTorrents opts = do
         tg.group_id,
         t.torrent_id,
         t.seeding_weight,
-        t.full_json_result AS torrent_json,
-        tg.full_json_result AS torrent_group_json,
+        t.full_json_result->'artists' AS artists,
+        tg.full_json_result->>'groupName' AS group_name,
+        tg.full_json_result->>'groupYear' AS group_year,
         t.torrent_file IS NOT NULL AS has_torrent_file,
         t.transmission_torrent_hash
       FROM filtered_torrents f
@@ -442,19 +442,15 @@ getBestTorrents opts = do
         groupId <- Dec.fromField @Int
         torrentId <- Dec.fromField @Int
         seedingWeight <- Dec.fromField @Int
-        (torrentJson, artists) <- Dec.json $ do
-          val <- Json.asValue
-          artists <- Json.keyOrDefault "artists" [] $ Json.eachInArray $ do
+        artists <- Dec.json $
+          Json.eachInArray $ do
             id_ <- Json.keyLabel @"artistId" "id" (Json.asIntegral @_ @Int)
             name <- Json.keyLabel @"artistName" "name" Json.asText
             pure $ T2 id_ name
-          pure (val, artists)
-        torrentGroupJson <-
-          ( Dec.json $ do
-              groupName <- Json.key "groupName" Json.asText
-              groupYear <- Json.key "groupYear" (Json.asIntegral @_ @Int)
-              pure $ TorrentGroupJson {..}
-            )
+        torrentGroupJson <- do
+          groupName <- Dec.text
+          groupYear <- Dec.textParse Field.decimalNatural
+          pure $ TorrentGroupJson {..}
         hasTorrentFile <- Dec.fromField @Bool
         transmissionTorrentHash <-
           Dec.fromField @(Maybe Text)

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

@@ -388,6 +388,7 @@ runHandlers defaultHandler handlers req respond = withRunInIO $ \runInIO -> do
           )
           ( \span -> do
               res <- act span <&> (\h -> T2 (label @"html" h) (label @"extraHeaders" []))
+              addEventSimple span "Got Html result, rendering…"
               liftIO $ respond (resp res)
           )
   let htmlResp res = Wai.responseLBS Http.ok200 ([("Content-Type", "text/html")] <> res.extraHeaders) . Html.renderHtml $ res.html
@@ -444,6 +445,24 @@ singleQueryArgument field inner =
     )
     >>> Parse.fieldParser inner
 
+singleQueryArgumentMay :: Text -> FieldParser ByteString to -> Parse Http.Query (Maybe to)
+singleQueryArgumentMay field inner =
+  Parse.mkParsePushContext
+    field
+    ( \(ctx, qry) -> case qry
+        & mapMaybe
+          ( \(k, v) ->
+              if k == (field & textToBytesUtf8)
+                then Just v
+                else Nothing
+          ) of
+        [] -> Right Nothing
+        [Nothing] -> Left [fmt|Expected one query argument with a value, but "{field}" was a query flag|]
+        [Just one] -> Right (Just one)
+        more -> Left [fmt|More than one value for query argument "{field}": {show more}, at {ctx & Parse.showContext}|]
+    )
+    >>> Parse.maybe (Parse.fieldParser inner)
+
 -- | Make sure we can parse the given Text into an URI.
 textToURI :: Parse Text URI
 textToURI =
@@ -518,6 +537,9 @@ getBestTorrentsTable dat = do
   fresh <- getBestTorrentsData dat
   pure $ mkBestTorrentsTable fresh
 
+doIfJust :: (Applicative f) => (a -> f ()) -> Maybe a -> f ()
+doIfJust = traverse_
+
 getBestTorrentsData ::
   ( MonadTransmission m,
     MonadThrow m,
@@ -527,7 +549,8 @@ getBestTorrentsData ::
   ) =>
   Maybe (Label "artistRedactedId" Natural) ->
   Transaction m [TorrentData (Label "percentDone" Percentage)]
-getBestTorrentsData artistFilter = do
+getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span -> do
+  artistFilter & doIfJust (\a -> addAttribute span "artist-filter.redacted-id" (a.artistRedactedId & showToText & Otel.toAttribute))
   bestStale :: [TorrentData ()] <- getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
   actual <-
     getAndUpdateTransmissionTorrentsStatus
@@ -596,7 +619,7 @@ mkBestTorrentsTable fresh = do
                       {Html.toHtml @Text b.torrentGroupJson.groupName}
                     </a>
                   </td>
-                  <td>{Html.toHtml @Int b.torrentGroupJson.groupYear}</td>
+                  <td>{Html.toHtml @Natural b.torrentGroupJson.groupYear}</td>
                   <td>{Html.toHtml @Int b.seedingWeight}</td>
                   <td><details hx-trigger="toggle once" hx-post="snips/redacted/torrentDataJson" hx-vals={Enc.encToBytesUtf8 $ Enc.object [("torrent-id", Enc.int b.torrentId)]}></details></td>
                   </tr>