about summary refs log tree commit diff
path: root/users
diff options
context:
space:
mode:
Diffstat (limited to 'users')
-rw-r--r--users/Profpatsch/whatcd-resolver/src/Transmission.hs50
-rw-r--r--users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs3
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 $