feat(users/Profpatsch/whatcd-resolver): add simple favourites

A simple favourite system that adds an artist to your favourites when
you go to their artist page for the first time.

Also, if you fetch something from an artist, they get automatically
added to the favourites.

This is pretty much just done by adding more crap to the main SQL
query, and has the disadvantage that the `artist_has_been_snatched`
CTE slows down the query a lot for the favourite filter (by 50% or
even sometimes 150% in a weird degenerate case). I think we can
optimize this somewhat, but that needs a small rewrite of the query
CTE stages.

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

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

@@ -624,7 +624,8 @@ data GetBestTorrentsFilter = GetBestTorrentsFilter
     onlyTheseTorrents :: Maybe ([Label "torrentId" Int]),
     disallowedReleaseTypes :: [ReleaseType],
     limitResults :: Maybe Natural,
-    ordering :: BestTorrentsOrdering
+    ordering :: BestTorrentsOrdering,
+    onlyFavourites :: Bool
   }
 
 data BestTorrentsOrdering = BySeedingWeight | ByLastReleases
@@ -676,6 +677,16 @@ getBestTorrents opts = do
         JOIN redacted.torrent_groups tg ON tg.id = t.torrent_group
         WHERE
           tg.full_json_result->>'releaseType' <> ALL (?::text[])
+      ),
+      prepare2 AS MATERIALIZED (
+        -- extract the json artist ids field into an array of ints
+        SELECT *, array(select id from jsonb_to_recordset(artists) as (id int)) as artist_ids
+        FROM prepare1
+      ),
+      artist_has_been_snatched AS MATERIALIZED (
+        SELECT DISTINCT artist_id
+        FROM (SELECT UNNEST(artist_ids) as artist_id, has_torrent_file from prepare2) as _
+        WHERE has_torrent_file
       )
       SELECT
         group_id,
@@ -688,7 +699,14 @@ getBestTorrents opts = do
         has_torrent_file,
         transmission_torrent_hash,
         torrent_format
-      FROM prepare1
+      FROM prepare2
+      JOIN LATERAL
+        (SELECT (
+          artist_ids && ARRAY(SELECT artist_id FROM artist_has_been_snatched)
+          OR artist_ids && ARRAY(SELECT artist_id FROM redacted.artist_favourites)
+        ) as is_favourite) as _
+        -- filter everything that’s not a favourite if requested
+        ON (NOT ?::bool OR is_favourite)
     |]
         <> case opts.ordering of
           BySeedingWeight -> [fmt|ORDER BY seeding_weight DESC|] <> "\n"
@@ -709,6 +727,7 @@ getBestTorrents opts = do
           onlyTheseTorrentsB :: Bool,
           onlyTheseTorrents,
           (opts.disallowedReleaseTypes & concatMap (\rt -> [rt.stringKey, rt.intKey & buildText intDecimalT]) & PGArray :: PGArray Text),
+          opts.onlyFavourites :: Bool,
           opts.limitResults <&> naturalToInteger :: Maybe Integer
           )
     )

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

@@ -28,7 +28,7 @@ import Data.Map.Strict qualified as Map
 import Data.Pool qualified as Pool
 import Data.Text qualified as Text
 import Database.PostgreSQL.Simple qualified as Postgres
-import Database.PostgreSQL.Simple.Types (PGArray (PGArray))
+import Database.PostgreSQL.Simple.Types (Only (..), PGArray (PGArray))
 import Database.Postgres.Temp qualified as TmpPg
 import FieldParser (FieldParser)
 import FieldParser qualified as Field
@@ -159,7 +159,7 @@ htmlUi = do
                                      ( do
                                          d <-
                                            getBestTorrentsData
-                                             (t3 #limitResults Nothing #ordering BySeedingWeight #disallowedReleaseTypes [])
+                                             bestTorrentsDataDefault
                                              ( Just
                                                  ( E21
                                                      (label @"onlyTheseTorrents" res.newTorrents)
@@ -305,13 +305,21 @@ htmlUi = do
                            )
                            $ \dat _span ->
                              ( do
-                                 runTransaction $ inSpan' "finding artist name" $ \span -> do
+                                 runTransaction $ do
+                                   (artistName, _) <-
+                                     concurrentlyTraced
+                                       ( inSpan' "finding artist name" $ \span -> do
                                            addAttribute span "artist-redacted-id" (dat.queryArgs.artistRedactedId, intDecimalT)
                                            mArtistName <- getArtistNameById (lbl #artistId dat.queryArgs.artistRedactedId)
                                            let pageTitle = case mArtistName of
                                                  Nothing -> "whatcd-resolver"
                                                  Just a -> [fmt|{a} - Artist Page - whatcd-resolver|]
-                                   pure $ htmlPageChrome ourHtmlIntegrities pageTitle,
+                                           pure $ htmlPageChrome ourHtmlIntegrities pageTitle
+                                       )
+                                       ( do
+                                           execute [sql|INSERT INTO redacted.artist_favourites (artist_id) VALUES (?) ON CONFLICT DO NOTHING|] (Only (dat.queryArgs.artistRedactedId :: Int))
+                                       )
+                                   pure artistName,
                                do
                                  artistPage (T2 dat.queryArgs (label @"uniqueRunId" uniqueRunId))
                              )
@@ -382,16 +390,17 @@ htmlUi = do
           ( do
               d <-
                 getBestTorrentsData
-                  ( t3
+                  ( BestTorrentsData
-                      #limitResults
+                      { limitResults = Just 100,
-                      (Just 100)
+                        ordering = ByLastReleases,
-                      #ordering
+                        onlyFavourites = True,
-                      ByLastReleases
+                        disallowedReleaseTypes =
-                      #disallowedReleaseTypes
                           [ releaseTypeBootleg,
                             releaseTypeGuestAppearance,
                             releaseTypeRemix
-                      ]
+                          ],
+                        ..
+                      }
                   )
                   Nothing
               pure $ case d & nonEmpty of
@@ -601,7 +610,7 @@ artistPage dat = runTransaction $ do
   (fresh, settings) <-
     concurrentlyTraced
       ( getBestTorrentsData
-          (t3 #limitResults Nothing #ordering BySeedingWeight #disallowedReleaseTypes [])
+          bestTorrentsDataDefault
           (Just $ E22 (getLabel @"artistRedactedId" dat))
       )
       (getSettings)
@@ -833,17 +842,30 @@ data ArtistFilter = ArtistFilter
 doIfJust :: (Applicative f) => (a -> f ()) -> Maybe a -> f ()
 doIfJust = traverse_
 
+data BestTorrentsData = BestTorrentsData
+  { limitResults :: Maybe Natural,
+    ordering :: BestTorrentsOrdering,
+    disallowedReleaseTypes :: [ReleaseType],
+    onlyFavourites :: Bool
+  }
+
+bestTorrentsDataDefault :: BestTorrentsData
+bestTorrentsDataDefault =
+  BestTorrentsData
+    { limitResults = Nothing,
+      ordering = BySeedingWeight,
+      disallowedReleaseTypes = [],
+      onlyFavourites = False
+    }
+
 getBestTorrentsData ::
   ( MonadTransmission m,
     MonadThrow m,
     MonadLogger m,
     MonadPostgres m,
-    MonadOtel m,
+    MonadOtel m
-    HasField "limitResults" opts (Maybe Natural),
-    HasField "ordering" opts BestTorrentsOrdering,
-    HasField "disallowedReleaseTypes" opts [ReleaseType]
   ) =>
-  opts ->
+  BestTorrentsData ->
   Maybe (E2 "onlyTheseTorrents" [Label "torrentId" Int] "artistRedactedId" Int) ->
   Transaction m [TorrentData (Label "percentDone" Percentage)]
 getBestTorrentsData opts filters = inSpan' "get torrents table data" $ \span -> do
@@ -855,7 +877,9 @@ getBestTorrentsData opts filters = inSpan' "get torrents table data" $ \span ->
 
   let ordering = opts.ordering
   let disallowedReleaseTypes = opts.disallowedReleaseTypes
+  let onlyFavourites = opts.onlyFavourites
   let getBest = getBestTorrents GetBestTorrentsFilter {..}
+
   bestStale :: [TorrentData ()] <- getBest
   (statusInfo, transmissionStatus) <-
     getAndUpdateTransmissionTorrentsStatus
@@ -1139,6 +1163,12 @@ migrate = inSpan "Database Migration" $ do
 
     CREATE INDEX IF NOT EXISTS torrents_json_seeding ON redacted.torrents_json(((full_json_result->'seeding')::integer));
     CREATE INDEX IF NOT EXISTS torrents_json_snatches ON redacted.torrents_json(((full_json_result->'snatches')::integer));
+
+    CREATE TABLE IF NOT EXISTS redacted.artist_favourites (
+      id SERIAL PRIMARY KEY,
+      artist_id INTEGER NOT NULL,
+      UNIQUE(artist_id)
+    );
   |]
     ()