fix(users/Profpatsch/whatcd-resolver): also delete db torrent file r/8680

If transmission does not know about a torrent file anymore, we should
not only delete our local transmission torrent hash, but also the
torrent file.

Before, it would always display the old weighted torrent, even after
removing it from transmission. Now, it will automatically clear and
switch to the new top-weighted mp3 version.

Small bug: since we only clean the torrents after already fetching the
table data, we get a stale result right after clean-up. Maybe we
should re-do the fetch instead.

Also logs what gets deleted and only ever deletes if there is
something to delete, leading to more obvious traces.

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

2 files changed, 38 insertions, 15 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/Transmission.hs b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
index b36c14d74378..0f62487a6c28 100644
--- a/users/Profpatsch/whatcd-resolver/src/Transmission.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
@@ -49,18 +49,20 @@ scientificPercentage =
               | otherwise -> Right $ Percentage $ ceiling (f * 100)
         )
 
--- | Fetch the current status from transmission, and remove the tranmission hash from our database
--- iff it does not exist in transmission anymore
+-- | Fetch the current status from transmission,
+--  and remove the transmission hash and torrent file from our database iff it does not exist in transmission anymore
 getAndUpdateTransmissionTorrentsStatus ::
   ( MonadTransmission m,
     MonadThrow m,
     MonadLogger m,
     MonadPostgres m,
-    MonadOtel m
+    MonadOtel m,
+    HasField "groupId" info Int,
+    HasField "torrentId" info Int
   ) =>
-  Map (Label "torrentHash" Text) () ->
+  Map (Label "torrentHash" Text) info ->
   (Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage)))
-getAndUpdateTransmissionTorrentsStatus knownTorrents = do
+getAndUpdateTransmissionTorrentsStatus knownTorrents = inSpan' "getAndUpdateTransmissionTorrentsStatus" $ \span -> do
   let fields = ["hashString", "percentDone"]
   actualTorrents <-
     lift @Transaction $
@@ -77,14 +79,36 @@ getAndUpdateTransmissionTorrentsStatus knownTorrents = do
         )
         <&> Map.fromList
   let toDelete = Map.difference knownTorrents actualTorrents
-  execute
-    [fmt|
-    UPDATE redacted.torrents_json
-    SET transmission_torrent_hash = NULL
-    WHERE transmission_torrent_hash = ANY (?::text[])
-  |]
-    $ Only (toDelete & Map.keys <&> (.torrentHash) & PGArray :: PGArray Text)
-  pure actualTorrents
+  if
+    | Map.null toDelete -> do
+        addEventSimple span "We know about all transmission hashes."
+        pure actualTorrents
+    | otherwise -> inSpan' "Delete outdated transmission hashes" $ \span' -> do
+        addAttribute
+          span'
+          "db.delete-transmission-hashes"
+          ( toDelete
+              & Map.toList
+              & Enc.list
+                ( \(k, v) ->
+                    Enc.object
+                      [ ("torrentHash", Enc.text k.torrentHash),
+                        ("groupId", Enc.int v.groupId),
+                        ("torrentId", Enc.int v.torrentId)
+                      ]
+                )
+              & jsonAttribute
+          )
+        _ <-
+          execute
+            [fmt|
+          UPDATE redacted.torrents_json
+          SET transmission_torrent_hash = NULL,
+              torrent_file = NULL
+          WHERE transmission_torrent_hash = ANY (?::text[])
+        |]
+            $ Only (toDelete & Map.keys <&> (.torrentHash) & PGArray :: PGArray Text)
+        pure actualTorrents
 
 getTransmissionTorrentsTable ::
   (MonadTransmission m, MonadThrow m, MonadLogger m, MonadOtel m) => m Html
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index 04c34c7859d6..f4b1bc1f44ec 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -566,10 +566,9 @@ getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span ->
       ( bestStale
           & mapMaybe
             ( \td -> case td.torrentStatus of
-                InTransmission h -> Just h
+                InTransmission h -> Just (getLabel @"torrentHash" h, td)
                 _ -> Nothing
             )
-          <&> (\t -> (getLabel @"torrentHash" t, t.transmissionInfo))
           & Map.fromList
       )
   pure $