From bc09c01dfdb1f33c5884f1c9858bc7f8a9a3fc6b Mon Sep 17 00:00:00 2001 From: Profpatsch Date: Mon, 10 Mar 2025 13:45:42 +0100 Subject: [PATCH] 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 Tested-by: BuildkiteCI --- .../whatcd-resolver/src/Redacted.hs | 23 +++++- .../whatcd-resolver/src/WhatcdResolver.hs | 80 +++++++++++++------ 2 files changed, 76 insertions(+), 27 deletions(-) diff --git a/users/Profpatsch/whatcd-resolver/src/Redacted.hs b/users/Profpatsch/whatcd-resolver/src/Redacted.hs index 2b91862f7..4caa81e36 100644 --- a/users/Profpatsch/whatcd-resolver/src/Redacted.hs +++ b/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 ) ) diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs index d49b4438e..a2af7f6bf 100644 --- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs +++ b/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 - 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, + 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 + ) + ( 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 - #limitResults - (Just 100) - #ordering - ByLastReleases - #disallowedReleaseTypes - [ releaseTypeBootleg, - releaseTypeGuestAppearance, - releaseTypeRemix - ] + ( BestTorrentsData + { limitResults = Just 100, + ordering = ByLastReleases, + onlyFavourites = True, + 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, - HasField "limitResults" opts (Maybe Natural), - HasField "ordering" opts BestTorrentsOrdering, - HasField "disallowedReleaseTypes" opts [ReleaseType] + MonadOtel m ) => - 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) + ); |] ()