fix(users/Profpatsch/whatcd-resolver): refresh table on delete r/8681

Instead of serving a stale table when a torrent gets deleted, fetch
the whole view again. This is a little wasteful, but torrents
shouldn’t get deleted very often, so it’s fine.

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

2 files changed, 19 insertions, 7 deletions

diff --git a/users/Profpatsch/whatcd-resolver/src/Transmission.hs b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
index 0f62487a6c28..3238780af70f 100644
--- a/users/Profpatsch/whatcd-resolver/src/Transmission.hs
+++ b/users/Profpatsch/whatcd-resolver/src/Transmission.hs
@@ -61,7 +61,7 @@ getAndUpdateTransmissionTorrentsStatus ::
     HasField "torrentId" info Int
   ) =>
   Map (Label "torrentHash" Text) info ->
-  (Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage)))
+  (Transaction m (Label "knownTorrentsStale" Bool, (Map (Label "torrentHash" Text) (Label "percentDone" Percentage))))
 getAndUpdateTransmissionTorrentsStatus knownTorrents = inSpan' "getAndUpdateTransmissionTorrentsStatus" $ \span -> do
   let fields = ["hashString", "percentDone"]
   actualTorrents <-
@@ -82,7 +82,7 @@ getAndUpdateTransmissionTorrentsStatus knownTorrents = inSpan' "getAndUpdateTran
   if
     | Map.null toDelete -> do
         addEventSimple span "We know about all transmission hashes."
-        pure actualTorrents
+        pure (label @"knownTorrentsStale" False, actualTorrents)
     | otherwise -> inSpan' "Delete outdated transmission hashes" $ \span' -> do
         addAttribute
           span'
@@ -108,7 +108,7 @@ getAndUpdateTransmissionTorrentsStatus knownTorrents = inSpan' "getAndUpdateTran
           WHERE transmission_torrent_hash = ANY (?::text[])
         |]
             $ Only (toDelete & Map.keys <&> (.torrentHash) & PGArray :: PGArray Text)
-        pure actualTorrents
+        pure (label @"knownTorrentsStale" True, 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 f4b1bc1f44ec..c8850e70a121 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -560,8 +560,9 @@ getBestTorrentsData ::
   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))
-  bestStale :: [TorrentData ()] <- getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
-  actual <-
+  let getBest = getBestTorrents GetBestTorrentsFilter {onlyArtist = artistFilter, onlyDownloaded = False}
+  bestStale :: [TorrentData ()] <- getBest
+  (statusInfo, transmissionStatus) <-
     getAndUpdateTransmissionTorrentsStatus
       ( bestStale
           & mapMaybe
@@ -571,13 +572,24 @@ getBestTorrentsData artistFilter = inSpan' "get torrents table data" $ \span ->
             )
           & Map.fromList
       )
+  bestBest <-
+    -- Instead of serving a stale table when a torrent gets deleted, fetch
+    -- the whole view again. This is a little wasteful, but torrents
+    -- shouldn’t get deleted very often, so it’s fine.
+    -- Re-evaluate invariant if this happens too often.
+    if statusInfo.knownTorrentsStale
+      then inSpan' "Fetch torrents table data again" $
+        \span' -> do
+          addEventSimple span' "The transmission torrent list was out of date, refetching torrent list."
+          getBest
+      else pure bestStale
   pure $
-    bestStale
+    bestBest
       --  we have to update the status of every torrent that’s not in tranmission anymore
       -- TODO I feel like it’s easier (& more correct?) to just do the database request again …
       <&> ( \td -> case td.torrentStatus of
               InTransmission info ->
-                case actual & Map.lookup (getLabel @"torrentHash" info) of
+                case transmissionStatus & Map.lookup (getLabel @"torrentHash" info) of
                   -- TODO this is also pretty dumb, cause it assumes that we have the torrent file if it was in transmission before,
                   -- which is an internal factum that is established in getBestTorrents (and might change later)
                   Nothing -> td {torrentStatus = NotInTransmissionYet}