cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve data deletion

Browse source
This commit is contained in:
Christopher Baines 2023-07-01 12:01:13 +01:00
parent 044a905c1d
commit 742949cc97
1 changed files with 66 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

112
guix-data-service/data-deletion.scm
View file

@ -205,30 +205,39 @@ WHERE id IN (
commits) commits)
", ")))) ", "))))
(with-postgresql-transaction (catch 'psql-query-error
conn (lambda ()
(lambda (conn) (with-postgresql-transaction
(obtain-advisory-transaction-lock conn
conn (lambda (conn)
'delete-revisions-from-branch) (obtain-advisory-transaction-lock
conn
'delete-revisions-from-branch)
(exec-query conn "SET LOCAL lock_timeout = '5s';") (exec-query conn "SET LOCAL lock_timeout = '5s';")
(delete-from-git-commits conn) (delete-from-git-commits conn)
(delete-jobs conn) (delete-jobs conn)
(let ((git-branch-id (let ((git-branch-id
(git-branch-for-repository-and-name conn (git-branch-for-repository-and-name conn
git-repository-id git-repository-id
branch-name))) branch-name)))
(exec-query (exec-query
conn conn
(string-append (string-append
" "
DROP TABLE IF EXISTS package_derivations_by_guix_revision_range_git_branch_" DROP TABLE IF EXISTS package_derivations_by_guix_revision_range_git_branch_"
(number->string git-branch-id) ";"))) (number->string git-branch-id) ";")))
(delete-guix-revisions conn git-repository-id commits)))) (delete-guix-revisions conn git-repository-id commits))))
(lambda (key . args)
(simple-format
(current-error-port)
"error when attempting to delete revisions from branch: ~A ~A\n"
key args)
(apply throw key args))))
(define (delete-data-for-branch conn git-repository-id branch-name) (define (delete-data-for-branch conn git-repository-id branch-name)
(define commits (define commits
@ -557,37 +566,48 @@ WHERE NOT EXISTS (
) LIMIT $1" ) LIMIT $1"
(list (number->string batch-size)))))) (list (number->string batch-size))))))
(derivations-count (length derivations))) (derivations-count (length derivations)))
(let ((deleted-count (let ((deleted-count 0))
(with-time-logging (with-time-logging
(simple-format #f (simple-format #f
"Looking at ~A derivations" "Looking at ~A derivations"
derivations-count) derivations-count)
(fold (n-par-for-each
(lambda (count result) 8
(+ result count)) (lambda (derivation-id)
0 (unless (string->number derivation-id)
(map (error
(lambda (derivation-id) (simple-format #f "derivation-id: ~A is not a number"
(unless (string->number derivation-id) derivation-id)))
(error
(simple-format #f "derivation-id: ~A is not a number"
derivation-id)))
(with-thread-postgresql-connection (let ((val
(lambda (conn) (with-thread-postgresql-connection
(with-postgresql-transaction (lambda (conn)
conn (catch 'psql-query-error
(lambda (conn) (lambda ()
(exec-query (with-postgresql-transaction
conn conn
" (lambda (conn)
(exec-query
conn
"
SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
(exec-query conn "SET LOCAL lock_timeout = '5s';") (exec-query conn "SET LOCAL lock_timeout = '5s';")
(maybe-delete-derivation conn
derivation-id))))
(lambda (key . args)
(simple-format
(current-error-port)
"error when attempting to delete derivation: ~A ~A\n"
key args)
0))))))
(monitor
(set! deleted-count
(+ val deleted-count)))))
derivations))
(maybe-delete-derivation conn
derivation-id))))))
derivations)))))
(simple-format (current-error-port) (simple-format (current-error-port)
"Deleted ~A derivations\n" "Deleted ~A derivations\n"
deleted-count) deleted-count)