Add support for processing branch updated emails

7 files changed, 134 insertions, 4 deletions

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 <mail@cbaines.net>
+;;;
+;;; 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
+;;; <http://www.gnu.org/licenses/>.
+
+(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 <mail@cbaines.net>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 <mail@cbaines.net>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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)))))