diff options
Diffstat (limited to 'guix-data-service/branch-updated-emails.scm')
| -rw-r--r-- | guix-data-service/branch-updated-emails.scm | 91 |
1 files changed, 71 insertions, 20 deletions
diff --git a/guix-data-service/branch-updated-emails.scm b/guix-data-service/branch-updated-emails.scm index 38432e6..b36eced 100644 --- a/guix-data-service/branch-updated-emails.scm +++ b/guix-data-service/branch-updated-emails.scm @@ -20,6 +20,10 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) #:use-module (email email) + #:use-module (squee) + #:use-module (guix store) + #:use-module (guix channels) + #:use-module (guix-data-service database) #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-commit) @@ -60,25 +64,72 @@ (when (and (not excluded-branch?) (or (null? included-branches) included-branch?)) - (insert-git-commit-entry conn - (or (git-branch-for-repository-and-name - conn - git-repository-id - branch-name) - (insert-git-branch-entry - conn - git-repository-id - branch-name)) - (if (string=? commit-all-zeros - x-git-newrev) + (if (string=? commit-all-zeros x-git-newrev) + (insert-git-commit-entry conn + (or (git-branch-for-repository-and-name + conn + git-repository-id + branch-name) + (insert-git-branch-entry + conn + git-repository-id + branch-name)) "" - x-git-newrev) - date) + date) - (unless (string=? commit-all-zeros x-git-newrev) - (enqueue-load-new-guix-revision-job - conn - git-repository-id - x-git-newrev - (string-append x-git-repo " " - x-git-refname " updated"))))))))))) + ;; Fetch the latest channel instance to check if this + ;; email matches up with the current state of the Git + ;; repository, and ignore it if it doesn't. + (let* ((git-repository-details + (select-git-repository conn git-repository-id)) + (channel-for-commit + (channel (name 'guix) + (url (second git-repository-details)) + (commit x-git-repo))) + (channel-instance + ;; Obtain a session level lock here, to avoid conflicts with + ;; other jobs over the Git repository. + (with-advisory-session-lock/log-time + conn + 'latest-channel-instances + (lambda () + (with-store store + (first + (latest-channel-instances store + (list channel-for-commit) + #:authenticate? + (fourth git-repository-details)))))))) + + (if (string=? (channel-instance-commit channel-instance) + x-git-newrev) + (with-postgresql-transaction + conn + (lambda (conn) + (exec-query conn "LOCK TABLE git_commits IN EXCLUSIVE MODE") + + (if (git-commit-exists? conn x-git-newrev) + (simple-format #t "commit already exists for revision ~A (date: ~A)\n" + x-git-newrev + date) + (begin + (insert-git-commit-entry conn + (or (git-branch-for-repository-and-name + conn + git-repository-id + branch-name) + (insert-git-branch-entry + conn + git-repository-id + branch-name)) + x-git-newrev + date) + + (enqueue-load-new-guix-revision-job + conn + git-repository-id + x-git-newrev + (string-append x-git-repo " " + x-git-refname " updated")))))) + (simple-format #t "email newrev ~A doesn't match latest channel instance commit ~A\n" + x-git-newrev + (channel-instance-commit channel-instance))))))))))))) |