refactor(users/Profpatsch/whatcd-resolver): prepare to split IO
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
clbot
parent
053e41f4e5
commit
7157e2baed
1 changed files with 74 additions and 53 deletions
|
|
@ -224,7 +224,14 @@ snipsRedactedSearch dat = do
|
|||
t
|
||||
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
|
||||
bestStale :: [TorrentData ()] <- getBestTorrents
|
||||
actual <-
|
||||
|
|
@ -309,7 +316,12 @@ scientificPercentage =
|
|||
-- | Fetch the current status from transmission, and remove the tranmission hash from our database
|
||||
-- iff it does not exist in transmission anymore
|
||||
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) () ->
|
||||
(Transaction m (Map (Label "torrentHash" Text) (Label "percentDone" Percentage)))
|
||||
getAndUpdateTransmissionTorrentsStatus knownTorrents = do
|
||||
|
|
@ -659,9 +671,12 @@ redactedSearchAndInsert ::
|
|||
[(ByteString, ByteString)] ->
|
||||
m (Transaction m ())
|
||||
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.
|
||||
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)
|
||||
pure $ (firstPage : otherPages) & traverse_ (.transaction)
|
||||
where
|
||||
|
|
@ -682,21 +697,24 @@ redactedSearchAndInsert extraArguments = do
|
|||
transaction <-
|
||||
sequence_
|
||||
<$> ( Json.eachInArray $ do
|
||||
groupId <- Json.key "groupId" (Json.asIntegral @_ @Int)
|
||||
groupName <- Json.key "groupName" Json.asText
|
||||
groupId <- Json.keyLabel @"groupId" "groupId" (Json.asIntegral @_ @Int)
|
||||
groupName <- Json.keyLabel @"groupName" "groupName" Json.asText
|
||||
fullJsonResult <-
|
||||
Json.asObject
|
||||
label @"fullJsonResult"
|
||||
<$> ( Json.asObject
|
||||
-- remove torrents cause they are inserted separately below
|
||||
<&> KeyMap.filterWithKey (\k _ -> k /= "torrents")
|
||||
<&> Json.Object
|
||||
let insertTourGroup = do
|
||||
)
|
||||
let tourGroup = T3 groupId groupName fullJsonResult
|
||||
let insertTourGroup dat = do
|
||||
_ <-
|
||||
execute
|
||||
[fmt|
|
||||
DELETE FROM redacted.torrent_groups
|
||||
WHERE group_id = ?::integer
|
||||
|]
|
||||
(Only groupId)
|
||||
(Only dat.groupId)
|
||||
executeManyReturningWith
|
||||
[fmt|
|
||||
INSERT INTO redacted.torrent_groups (
|
||||
|
|
@ -709,26 +727,26 @@ redactedSearchAndInsert extraArguments = do
|
|||
full_json_result = excluded.full_json_result
|
||||
RETURNING (id)
|
||||
|]
|
||||
[ ( groupId,
|
||||
groupName,
|
||||
fullJsonResult
|
||||
[ ( dat.groupId,
|
||||
dat.groupName,
|
||||
dat.fullJsonResult
|
||||
)
|
||||
]
|
||||
(label @"tourGroupIdPg" <$> Dec.fromField @Int)
|
||||
>>= ensureSingleRow
|
||||
insertTorrents <- Json.key "torrents" $ do
|
||||
torrents <- Json.eachInArray $ do
|
||||
torrents <- Json.key "torrents" $
|
||||
Json.eachInArray $ do
|
||||
torrentId <- Json.keyLabel @"torrentId" "torrentId" (Json.asIntegral @_ @Int)
|
||||
fullJsonResultT <- label @"fullJsonResult" <$> Json.asValue
|
||||
pure $ T2 torrentId fullJsonResultT
|
||||
pure $ \dat -> do
|
||||
let insertTorrents dat = do
|
||||
_ <-
|
||||
execute
|
||||
[sql|
|
||||
DELETE FROM redacted.torrents_json
|
||||
WHERE torrent_id = ANY (?::integer[])
|
||||
|]
|
||||
(Only $ torrents & unzipT2 & (.torrentId) & PGArray)
|
||||
(Only $ dat.torrents & unzipT2 & (.torrentId) & PGArray)
|
||||
execute
|
||||
[sql|
|
||||
INSERT INTO redacted.torrents_json
|
||||
|
|
@ -737,7 +755,7 @@ redactedSearchAndInsert extraArguments = do
|
|||
(SELECT * FROM UNNEST(?::integer[], ?::jsonb[])) AS inputs(torrent_id, full_json_result)
|
||||
CROSS JOIN (VALUES(?::integer)) as static(torrent_group)
|
||||
|]
|
||||
( torrents
|
||||
( dat.torrents
|
||||
& unzipT2
|
||||
& \t ->
|
||||
( t.torrentId & PGArray,
|
||||
|
|
@ -746,7 +764,10 @@ redactedSearchAndInsert extraArguments = do
|
|||
)
|
||||
)
|
||||
pure ()
|
||||
pure (insertTourGroup >>= insertTorrents)
|
||||
pure
|
||||
( insertTourGroup tourGroup
|
||||
>>= (\tg -> insertTorrents (T2 (getLabel @"tourGroupIdPg" tg) (label @"torrents" torrents)))
|
||||
)
|
||||
)
|
||||
pure
|
||||
( T2
|
||||
|
|
|
|||
Loading…
Reference in a new issue