Add more detailed new revision job handling

Create a new events table for the new guix revision jobs, and update this when
processing a job starts, as well as finished with success or failure.

Additionally, remove the dependnency on open-inferior/container, as this
functionality isn't merged in to Guix master yet.

6 files changed, 164 insertions, 87 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 2ae372d..d27b2bf 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -267,29 +267,33 @@
 
 (define (channel->derivation-file-name store channel)
   (let ((inferior
-         (open-inferior/container
-          store
-          (guix-store-path store)
-          #:extra-shared-directories
-          '("/gnu/store")
-          #:extra-environment-variables
-          (list (string-append
-                 "SSL_CERT_DIR=" (nss-certs-store-path store))))))
+         (if (defined? 'open-inferior/container)
+             (open-inferior/container
+              store
+              (guix-store-path store)
+              #:extra-shared-directories
+              '("/gnu/store")
+              #:extra-environment-variables
+              (list (string-append
+                     "SSL_CERT_DIR=" (nss-certs-store-path store))))
+             (open-inferior (guix-store-path store)))))
 
     (catch
       #t
       (lambda ()
-        ;; Create /etc/pass, as %known-shorthand-profiles in (guix
-        ;; profiles) tries to read from this file. Because the environment
-        ;; is cleaned in build-self.scm, xdg-directory in (guix utils)
-        ;; falls back to accessing /etc/passwd.
-        (inferior-eval
-         '(begin
-            (mkdir "/etc")
-            (call-with-output-file "/etc/passwd"
-              (lambda (port)
-                (display "root:x:0:0::/root:/bin/bash" port))))
-         inferior)
+        ;; /etc is only missing if open-inferior/container has been used
+        (unless (file-exists? "/etc")
+          ;; Create /etc/pass, as %known-shorthand-profiles in (guix
+          ;; profiles) tries to read from this file. Because the environment
+          ;; is cleaned in build-self.scm, xdg-directory in (guix utils)
+          ;; falls back to accessing /etc/passwd.
+          (inferior-eval
+           '(begin
+              (mkdir "/etc")
+              (call-with-output-file "/etc/passwd"
+                (lambda (port)
+                  (display "root:x:0:0::/root:/bin/bash" port))))
+           inferior))
 
         (let ((channel-instance
                (first
@@ -355,60 +359,67 @@
       (simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args)
       #f)))
 
-(define (extract-information-from store conn git-repository-id commit store-path)
+(define (extract-information-from conn git-repository-id commit store-path)
   (simple-format
    #t "debug: extract-information-from: ~A\n" store-path)
-  (let ((inf (open-inferior/container store store-path
-                                      #:extra-shared-directories
-                                      '("/gnu/store"))))
-    (inferior-eval '(use-modules (srfi srfi-1)
-                                 (srfi srfi-34)
-                                 (guix grafts)
-                                 (guix derivations))
-                   inf)
-    (inferior-eval '(%graft? #f) inf)
-
-    (exec-query conn "BEGIN")
-    (catch
-      #t
-      (lambda ()
-        (let* ((package-derivation-ids
-                (inferior-guix->package-derivation-ids store conn inf))
-               (guix-revision-id
-                (insert-guix-revision conn git-repository-id commit store-path)))
-
-          (insert-guix-revision-package-derivations conn
-                                                    guix-revision-id
-                                                    package-derivation-ids)
-
-          (exec-query conn "COMMIT")
-
-          (simple-format
-           #t "Successfully loaded ~A package/derivation pairs\n"
-           (length package-derivation-ids)))
-        #t)
-      (lambda (key . args)
-        (simple-format (current-error-port)
-                       "Failed extracting information: ~A ~A\n"
-                       key args)
-        (force-output)
-        (exec-query conn "ROLLBACK")
-        #f))))
+  (with-store store
+    (let ((inf (if (defined? 'open-inferior/container)
+                   (open-inferior/container store store-path
+                                            #:extra-shared-directories
+                                            '("/gnu/store"))
+                   (open-inferior store-path))))
+      (inferior-eval '(use-modules (srfi srfi-1)
+                                   (srfi srfi-34)
+                                   (guix grafts)
+                                   (guix derivations))
+                     inf)
+      (inferior-eval '(%graft? #f) inf)
+
+      (catch
+        #t
+        (lambda ()
+          (let* ((package-derivation-ids
+                  (inferior-guix->package-derivation-ids store conn inf))
+                 (guix-revision-id
+                  (insert-guix-revision conn git-repository-id commit store-path)))
+
+            (insert-guix-revision-package-derivations conn
+                                                      guix-revision-id
+                                                      package-derivation-ids)
+
+            (simple-format
+             #t "Successfully loaded ~A package/derivation pairs\n"
+             (length package-derivation-ids)))
+          #t)
+        (lambda (key . args)
+          (simple-format (current-error-port)
+                         "Failed extracting information: ~A ~A\n"
+                         key args)
+          (force-output)
+          #f)))))
+
+(define (store-item-for-git-repository-id-and-commit
+         conn git-repository-id commit)
+  (with-store store
+    (channel->guix-store-item
+     store
+     (channel (name 'guix)
+              (url (git-repository-id->url
+                    conn
+                    git-repository-id))
+              (commit commit)))))
 
 (define (load-new-guix-revision conn git-repository-id commit)
-  (if (guix-revision-exists? conn git-repository-id commit)
-      #t
-      (with-store store
-        (let ((store-item (channel->guix-store-item
-                           store
-                           (channel (name 'guix)
-                                    (url (git-repository-id->url
-                                          conn
-                                          git-repository-id))
-                                    (commit commit)))))
-          (and store-item
-               (extract-information-from store conn git-repository-id
-                                         commit store-item))))))
+  (let ((store-item
+         (store-item-for-git-repository-id-and-commit
+          conn git-repository-id commit)))
+    (if store-item
+        (extract-information-from conn git-repository-id
+                                  commit store-item)
+        (begin
+          (simple-format #t "Failed to generate store item for ~A\n"
+                         commit)
+          #f))))
 
 (define (enqueue-load-new-guix-revision-job conn git-repository-id commit source)
   (define query
@@ -442,27 +453,54 @@ RETURNING id;")
           (list (number->string n)))))
     result))
 
+(define (select-next-job-to-process conn)
+  (exec-query
+   conn
+   (string-append
+    "SELECT id, commit, source, git_repository_id "
+    "FROM load_new_guix_revision_jobs "
+    "WHERE succeeded_at IS NULL AND NOT EXISTS ("
+    "SELECT 1 "
+    "FROM load_new_guix_revision_job_events "
+    ;; Skip jobs that have failed, to avoid trying them over and over again
+    "WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'"
+    ") ORDER BY id ASC LIMIT 1")))
+
+(define (record-job-event conn job-id event)
+  (exec-query
+   conn
+   (string-append
+    "INSERT INTO load_new_guix_revision_job_events (job_id, event) "
+    "VALUES ($1, $2)")
+   (list job-id event)))
+
 (define (record-job-succeeded conn id)
   (exec-query
    conn
    (string-append
-    "UPDATE load_new_guix_revision_jobs WHERE id = $1 "
-    "SET succeeded_at = current_time")
+    "UPDATE load_new_guix_revision_jobs "
+    "SET succeeded_at = clock_timestamp() "
+    "WHERE id = $1 ")
    (list id)))
 
 (define (process-next-load-new-guix-revision-job conn)
-  (let ((next
-         (exec-query
-          conn
-          (string-append
-           "SELECT id, commit, source, git_repository_id "
-           "FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT 1"))))
-    (match next
-      (((id commit source git-repository-id))
-       (begin
-         (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
-                        id commit source)
-         (when (eq? (load-new-guix-revision conn git-repository-id commit)
-                    #t)
-           (record-job-succeeded conn id))))
-      (_ #f))))
+  (match (select-next-job-to-process conn)
+    (((id commit source git-repository-id))
+     (begin
+       (record-job-event conn id "start")
+       (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
+                      id commit source)
+       (exec-query conn "BEGIN")
+       (if (or (guix-revision-exists? conn git-repository-id commit)
+               (eq? (load-new-guix-revision conn git-repository-id commit)
+                    #t))
+           (begin
+             (record-job-succeeded conn id)
+             (record-job-event conn id "success")
+             (exec-query conn "COMMIT")
+             #t)
+           (begin
+             (exec-query conn "ROLLBACK")
+             (record-job-event conn id "failure")
+             #f))))
+    (_ #f)))
diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm
index 2f96606..305b3ec 100644
--- a/guix-data-service/model/git-repository.scm
+++ b/guix-data-service/model/git-repository.scm
@@ -46,7 +46,7 @@
     "
 SELECT NULL AS id, load_new_guix_revision_jobs.id AS job_id, commit, source
 FROM load_new_guix_revision_jobs
-WHERE git_repository_id = $1
+WHERE git_repository_id = $1 AND succeeded_at IS NULL
 UNION
 SELECT id, NULL, commit, NULL
 FROM guix_revisions
diff --git a/sqitch/deploy/load_new_guix_revision_job_events.sql b/sqitch/deploy/load_new_guix_revision_job_events.sql
new file mode 100644
index 0000000..96731fb
--- /dev/null
+++ b/sqitch/deploy/load_new_guix_revision_job_events.sql
@@ -0,0 +1,18 @@
+-- Deploy guix-data-service:load_new_guix_revision_job_events to pg
+
+BEGIN;
+
+CREATE TYPE job_event AS ENUM ('start', 'failure', 'success');
+
+ALTER TABLE ONLY load_new_guix_revision_jobs
+    ADD CONSTRAINT load_new_guix_revision_jobs_id UNIQUE (id);
+
+CREATE TABLE load_new_guix_revision_job_events (
+    id integer GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY,
+    job_id integer NOT NULL,
+    event job_event NOT NULL,
+    occurred_at timestamp without time zone NOT NULL DEFAULT clock_timestamp(),
+    CONSTRAINT job_id FOREIGN KEY (job_id) REFERENCES load_new_guix_revision_jobs (id)
+);
+
+COMMIT;
diff --git a/sqitch/revert/load_new_guix_revision_job_events.sql b/sqitch/revert/load_new_guix_revision_job_events.sql
new file mode 100644
index 0000000..a0a1eec
--- /dev/null
+++ b/sqitch/revert/load_new_guix_revision_job_events.sql
@@ -0,0 +1,12 @@
+-- Revert guix-data-service:load_new_guix_revision_job_events from pg
+
+BEGIN;
+
+DROP TABLE load_new_guix_revision_job_events;
+
+ALTER TABLE load_new_guix_revision_jobs
+  DROP CONSTRAINT load_new_guix_revision_jobs_id;
+
+DROP TYPE IF EXISTS job_event;
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index b4c873d..56619b9 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -12,3 +12,4 @@ add_location_information 2019-05-12T20:27:48Z Christopher Baines <mail@cbaines.n
 add_git_repositories_cgit_url_base 2019-05-13T18:45:14Z Christopher Baines <mail@cbaines.net> # Add cgit_url_base to git_repositories
 license_support 2019-05-13T20:37:40Z Christopher Baines <mail@cbaines.net> # Add support for storing license information
 dates_to_load_new_guix_revision_jobs 2019-06-02T07:39:49Z Christopher Baines <mail@cbaines.net> # Add dates to the load_new_guix_revision_jobs table
+load_new_guix_revision_job_events 2019-06-02T15:44:41Z Christopher Baines <mail@cbaines.net> # Add new table for guix_revision_job_events
diff --git a/sqitch/verify/load_new_guix_revision_job_events.sql b/sqitch/verify/load_new_guix_revision_job_events.sql
new file mode 100644
index 0000000..9ea2196
--- /dev/null
+++ b/sqitch/verify/load_new_guix_revision_job_events.sql
@@ -0,0 +1,8 @@
+-- Verify guix-data-service:load_new_guix_revision_job_events on pg
+
+BEGIN;
+
+SELECT id, job_id, event, occurred_at
+  FROM load_new_guix_revision_job_events WHERE FALSE;
+
+ROLLBACK;