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

Don't hardcode the expected x-git-repo header value

Browse source 
Rather than expecting it always to be "guix", store the expected value in the
database, and use the value of the header to find the relevant repository.
This commit is contained in:
Christopher Baines 2020-01-11 17:25:08 +00:00
parent 57cbac891e
commit 2f36d47b1b
6 changed files with 52 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

40
guix-data-service/branch-updated-emails.scm
View file

@ -23,9 +23,6 @@
#:use-module (guix-data-service jobs load-new-guix-revision)
#:export (enqueue-job-for-email))
(define %repository-url-for-repo
'(("guix" . "https://git.savannah.gnu.org/git/guix.git")))
(define (enqueue-job-for-email conn email)
(let* ((headers (email-headers email))
(date (assq-ref headers 'date))
@ -35,30 +32,29 @@
(x-git-newrev (assq-ref headers 'x-git-newrev)))
(when (and (and (string? x-git-reftype)
(string=? x-git-reftype "branch"))
(and (string? x-git-repo)
(string=? x-git-repo "guix"))
(string? x-git-newrev))
(let ((branch-name
(string-drop x-git-refname 11))
(git-repository-id
(git-repository-url->git-repository-id
(git-repository-x-git-repo-header->git-repository-id
conn
(assoc-ref %repository-url-for-repo x-git-repo))))
x-git-repo)))
(insert-git-branch-entry conn
branch-name
(if (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
""
x-git-newrev)
git-repository-id
date)
(when git-repository-id
(insert-git-branch-entry conn
branch-name
(if (string=? "0000000000000000000000000000000000000000"
x-git-newrev)
""
x-git-newrev)
git-repository-id
date)
(unless (string=? "0000000000000000000000000000000000000000"
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")))))))
(unless (string=? "0000000000000000000000000000000000000000"
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"))))))))

12
guix-data-service/model/git-repository.scm
View file

@ -22,6 +22,7 @@
#:export (all-git-repositories
select-git-repository
git-repository-id->url
git-repository-x-git-repo-header->git-repository-id
git-repository-url->git-repository-id
git-repositories-containing-commit
@ -59,6 +60,17 @@
(list id))
(((url)) url)))
(define (git-repository-x-git-repo-header->git-repository-id conn header)
(match
(exec-query
conn
(string-append
"SELECT id FROM git_repositories WHERE x_git_repo_header = $1;")
(list header))
(() #f)
(((id))
(string->number id))))
(define (git-repository-url->git-repository-id conn url)
(let ((existing-id
(exec-query