mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

refactor(users/Profpatsch/whatcd-resolver): prepare to split IO

Browse source 
Returning an I/O action was a good first approximation, but leads to a
n+1 query problem, making the whole shebang pretty slow after doing a
search.

Thus we need to split data & I/O, so we can be more clever in the next
commit.

Change-Id: Ieb2f8d5445f1258047da9b121b977c0b8d2dd7f8
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9483
Reviewed-by: Profpatsch <mail@profpatsch.de>
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
This commit is contained in:
Profpatsch 2023-09-27 23:17:23 +02:00 committed by clbot
parent 053e41f4e5
commit 7157e2baed
1 changed files with 74 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
View file

@ -224,7 +224,14 @@ snipsRedactedSearch dat = do
t t
getBestTorrentsTable getBestTorrentsTable
getBestTorrentsTable :: (MonadIO m, MonadTransmission m, MonadThrow m, MonadLogger m, MonadPostgres m) => Transaction m Html getBestTorrentsTable ::
( MonadIO m,
MonadTransmission m,
MonadThrow m,
MonadLogger m,
MonadPostgres m
) =>
Transaction m Html
getBestTorrentsTable = do getBestTorrentsTable = do
bestStale :: [TorrentData ()] <- getBestTorrents bestStale :: [TorrentData ()] <- getBestTorrents
actual <- actual <-
@ -309,7 +316,12 @@ scientificPercentage =
-- | Fetch the current status from transmission, and remove the tranmission hash from our database -- | Fetch the current status from transmission, and remove the tranmission hash from our database
-- iff it does not exist in transmission anymore -- iff it does not exist in transmission anymore
getAndUpdateTransmissionTorrentsStatus :: getAndUpdateTransmissionTorrentsStatus ::
(MonadIO m, MonadTransmission m, MonadThrow m, MonadLogger m, MonadPostgres m) => ( MonadIO m,
MonadTransmission m,
MonadThrow m,
MonadLogger m,
MonadPostgres m
) =>
Map (Label "torrentHash" Text) () -> Map (Label "torrentHash" Text) () ->
(Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage))) (Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage)))
getAndUpdateTransmissionTorrentsStatus knownTorrents = do getAndUpdateTransmissionTorrentsStatus knownTorrents = do
@ -659,9 +671,12 @@ redactedSearchAndInsert ::
[(ByteString, ByteString)] -> [(ByteString, ByteString)] ->
m (Transaction m ()) m (Transaction m ())
redactedSearchAndInsert extraArguments = do redactedSearchAndInsert extraArguments = do
logInfo [fmt|Doing redacted search with arguments: {showPretty extraArguments}|]
-- The first search returns the amount of pages, so we use that to query all results piece by piece. -- The first search returns the amount of pages, so we use that to query all results piece by piece.
firstPage <- go Nothing firstPage <- go Nothing
let otherPagesNum = [(2 :: Natural) .. (firstPage.pages - 1)] let remainingPages = firstPage.pages - 1
logInfo [fmt|Got the first page, found {remainingPages} more pages|]
let otherPagesNum = [(2 :: Natural) .. remainingPages]
otherPages <- traverse go (Just <$> otherPagesNum) otherPages <- traverse go (Just <$> otherPagesNum)
pure $ (firstPage : otherPages) & traverse_ (.transaction) pure $ (firstPage : otherPages) & traverse_ (.transaction)
where where
@ -682,21 +697,24 @@ redactedSearchAndInsert extraArguments = do
transaction <- transaction <-
sequence_ sequence_
<$> ( Json.eachInArray $ do <$> ( Json.eachInArray $ do
groupId <- Json.key "groupId" (Json.asIntegral @_ @Int) groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
groupName <- Json.key "groupName" Json.asText groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
fullJsonResult <- fullJsonResult <-
Json.asObject label @"fullJsonResult"
<$> ( Json.asObject
-- remove torrents cause they are inserted separately below -- remove torrents cause they are inserted separately below
<&> KeyMap.filterWithKey (\k _ -> k /= "torrents") <&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
<&> Json.Object <&> Json.Object
let insertTourGroup = do )
let tourGroup = T3 groupId groupName fullJsonResult
let insertTourGroup dat = do
_ <- _ <-
execute execute
[fmt| [fmt|
DELETE FROM redacted.torrent_groups DELETE FROM redacted.torrent_groups
WHERE group_id = ?::integer WHERE group_id = ?::integer
|] |]
(Only groupId) (Only dat.groupId)
executeManyReturningWith executeManyReturningWith
[fmt| [fmt|
INSERT INTO redacted.torrent_groups ( INSERT INTO redacted.torrent_groups (
@ -709,26 +727,26 @@ redactedSearchAndInsert extraArguments = do
full_json_result = excluded.full_json_result full_json_result = excluded.full_json_result
RETURNING (id) RETURNING (id)
|] |]
[ ( groupId, [ ( dat.groupId,
groupName, dat.groupName,
fullJsonResult dat.fullJsonResult
) )
] ]
(label @"tourGroupIdPg" <$> Dec.fromField @Int) (label @"tourGroupIdPg" <$> Dec.fromField @Int)
>>= ensureSingleRow >>= ensureSingleRow
insertTorrents <- Json.key "torrents" $ do torrents <- Json.key "torrents" $
torrents <- Json.eachInArray $ do Json.eachInArray $ do
torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int) torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
pure $ T2 torrentId fullJsonResultT pure $ T2 torrentId fullJsonResultT
pure $ \dat -> do let insertTorrents dat = do
_ <- _ <-
execute execute
[sql| [sql|
DELETE FROM redacted.torrents_json DELETE FROM redacted.torrents_json
WHERE torrent_id = ANY (?::integer[]) WHERE torrent_id = ANY (?::integer[])
|] |]
(Only $ torrents & unzipT2 & (.torrentId) & PGArray) (Only $ dat.torrents & unzipT2 & (.torrentId) & PGArray)
execute execute
[sql| [sql|
INSERT INTO redacted.torrents_json INSERT INTO redacted.torrents_json
@ -737,7 +755,7 @@ redactedSearchAndInsert extraArguments = do
(SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result) (SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result)
CROSS JOIN (VALUES(?::integer)) as static(torrent_group) CROSS JOIN (VALUES(?::integer)) as static(torrent_group)
|] |]
( torrents ( dat.torrents
& unzipT2 & unzipT2
& \t -> & \t ->
( t.torrentId & PGArray, ( t.torrentId & PGArray,
@ -746,7 +764,10 @@ redactedSearchAndInsert extraArguments = do
) )
) )
pure () pure ()
pure (insertTourGroup >>= insertTorrents) pure
( insertTourGroup tourGroup
>>= (\tg -> insertTorrents (T2 (getLabel @"tourGroupIdPg" tg) (label @"torrents" torrents)))
)
) )
pure pure
( T2 ( T2