diff --git a/Makefile.am b/Makefile.am index 4c68c04..8035d90 100644 --- a/Makefile.am +++ b/Makefile.am @@ -20,9 +20,10 @@ include guile.am -bin_SCRIPTS = \ - scripts/guix-data-service \ - scripts/guix-data-service-process-jobs \ +bin_SCRIPTS = \ + scripts/guix-data-service \ + scripts/guix-data-service-process-jobs \ + scripts/guix-data-service-process-branch-updated-email \ scripts/guix-data-service-query-build-servers moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) @@ -30,6 +31,7 @@ godir = $(moddir) assetsdir = $(datadir)/@PACKAGE@ SOURCES = \ + guix-data-service/branch-updated-emails.scm \ guix-data-service/builds.scm \ guix-data-service/comparison.scm \ guix-data-service/config.scm \ diff --git a/configure.ac b/configure.ac index e471696..138a31d 100644 --- a/configure.ac +++ b/configure.ac @@ -26,6 +26,11 @@ if test "x$have_fibers" != "xyes"; then AC_MSG_ERROR([Guile fibers is missing; please install it.]) fi +GUILE_MODULE_AVAILABLE([have_email], [(email email)]) +if test "x$have_email" != "xyes"; then + AC_MSG_ERROR([Guile email is missing; please install it.]) +fi + guilemoduledir="${datarootdir}/guile/site/${GUILE_EFFECTIVE_VERSION}" AC_SUBST([guilemoduledir]) AC_SUBST([GUILE_EFFECTIVE_VERSION]) @@ -35,6 +40,7 @@ AC_CONFIG_FILES([Makefile]) AC_CONFIG_FILES([guix-data-service/config.scm]) AC_CONFIG_FILES([scripts/guix-data-service], [chmod +x scripts/guix-data-service]) AC_CONFIG_FILES([scripts/guix-data-service-process-jobs], [chmod +x scripts/guix-data-service-process-jobs]) +AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-email], [chmod +x scripts/guix-data-service-process-branch-updated-email]) AC_CONFIG_FILES([scripts/guix-data-service-query-build-servers], [chmod +x scripts/guix-data-service-query-build-servers]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) diff --git a/guix-data-service/branch-updated-emails.scm b/guix-data-service/branch-updated-emails.scm new file mode 100644 index 0000000..739af8a --- /dev/null +++ b/guix-data-service/branch-updated-emails.scm @@ -0,0 +1,40 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service branch-updated-emails) + #:use-module (email email) + #: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)) + (x-git-repo (assq-ref headers 'x-git-repo)) + (x-git-reftype (assq-ref headers 'x-git-reftype)) + (x-git-refname (assq-ref headers 'x-git-refname)) + (x-git-newrev (assq-ref headers 'x-git-newrev))) + (when (and (string=? x-git-reftype "branch") + (string=? x-git-repo "guix") + (string? x-git-newrev)) + (enqueue-load-new-guix-revision-job + conn + (assoc-ref %repository-url-for-repo + x-git-repo) + x-git-newrev + (string-append x-git-repo " " x-git-refname " updated"))))) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index d7af63f..ca38b06 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -20,6 +20,7 @@ #:use-module (guix-data-service model derivation) #:export (process-next-load-new-guix-revision-job select-job-for-commit + enqueue-load-new-guix-revision-job most-recent-n-load-new-guix-revision-jobs)) (define inferior-package-id @@ -314,6 +315,18 @@ (and store-item (extract-information-from store conn url commit store-item)))))) +(define (enqueue-load-new-guix-revision-job conn url commit source) + (define query + " +INSERT INTO load_new_guix_revision_jobs (url, commit, source) +VALUES ($1, $2, $3) +RETURNING id;") + + (first + (exec-query conn + query + (list url commit source)))) + (define (select-job-for-commit conn commit) (let ((result (exec-query diff --git a/guix-dev.scm b/guix-dev.scm index fdc9b53..dd65c51 100644 --- a/guix-dev.scm +++ b/guix-dev.scm @@ -43,7 +43,8 @@ (source #f) (build-system gnu-build-system) (inputs - `(("guile-json" ,guile-json-3) + `(("guile-email" ,guile-email) + ("guile-json" ,guile-json-3) ("guile-squee" ,guile-squee) ("guile-fibers" ,guile-fibers) ("guile-syntax-highlight" ,guile-syntax-highlight) diff --git a/scripts/guix-data-service-process-branch-updated-email b/scripts/guix-data-service-process-branch-updated-email new file mode 100755 index 0000000..1762a4a --- /dev/null +++ b/scripts/guix-data-service-process-branch-updated-email @@ -0,0 +1,34 @@ +#!/gnu/store/njwvn85rrkplkxk6gy5d7v1n0358a91i-profile/bin/guile --no-auto-compile +-*- scheme -*- +-*- geiser-scheme-implementation: guile -*- +!# +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This file is part of guix-data-service. +;;; +;;; guix-data-service is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; guix-data-service is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with the guix-data-service. If not, see . + +(use-modules (srfi srfi-1) + (srfi srfi-37) + (ice-9 textual-ports) + (squee) + (email email) + (guix-data-service branch-updated-emails)) + +(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service"))) + (enqueue-job-for-email + conn + (parse-email + (get-string-all (current-input-port))))) diff --git a/scripts/guix-data-service-process-branch-updated-email.in b/scripts/guix-data-service-process-branch-updated-email.in new file mode 100644 index 0000000..de87dcc --- /dev/null +++ b/scripts/guix-data-service-process-branch-updated-email.in @@ -0,0 +1,34 @@ +#!@GUILE@ --no-auto-compile +-*- scheme -*- +-*- geiser-scheme-implementation: guile -*- +!# +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This file is part of guix-data-service. +;;; +;;; guix-data-service is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or +;;; (at your option) any later version. +;;; +;;; guix-data-service is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with the guix-data-service. If not, see . + +(use-modules (srfi srfi-1) + (srfi srfi-37) + (ice-9 textual-ports) + (squee) + (email email) + (guix-data-service branch-updated-emails)) + +(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service"))) + (enqueue-job-for-email + conn + (parse-email + (get-string-all (current-input-port)))))