Record the output from loading new revisions to the database

So that it can easily be shown through the web interface. There's two tables
being used. One which temporarily stores the output as it's output while the
job is running, and other which stores the whole log once the job has
finished.

5 files changed, 132 insertions, 7 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index d5c1be7..64ca38e 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -14,6 +14,7 @@
   #:use-module (guix derivations)
   #:use-module (guix build utils)
   #:use-module (guix-data-service config)
+  #:use-module (guix-data-service database)
   #:use-module (guix-data-service model package)
   #:use-module (guix-data-service model git-repository)
   #:use-module (guix-data-service model guix-revision)
@@ -22,12 +23,85 @@
   #:use-module (guix-data-service model license-set)
   #:use-module (guix-data-service model package-metadata)
   #:use-module (guix-data-service model derivation)
-  #:export (process-next-load-new-guix-revision-job
+  #:export (log-for-job
+            process-next-load-new-guix-revision-job
             select-job-for-commit
             select-jobs-and-events
             enqueue-load-new-guix-revision-job
             most-recent-n-load-new-guix-revision-jobs))
 
+(define (log-port job-id conn)
+  (define output-port
+    (current-output-port))
+
+  (define id 0)
+
+  (define (insert job_id s)
+    (exec-query
+     conn
+     (string-append
+      "INSERT INTO load_new_guix_revision_job_log_parts (id, job_id, contents) "
+      "VALUES ($1, $2, $3)")
+     (list (number->string id) job_id s)))
+
+  (define (log-string s)
+    (set! id (+ 1 id)) ; increment id
+    (insert job-id s)
+    (display s output-port))
+
+  ;; TODO, this is useful when re-running jobs, but I'm not sure that should
+  ;; be a thing, jobs should probably be only attempted once.
+  (exec-query
+   conn
+   "DELETE FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"
+   (list job-id))
+
+  (make-soft-port
+   (vector (lambda (c)
+             (log-string (string c)))
+           log-string
+           (lambda ()
+             (force-output output-port))
+           #f ; fetch one character
+           (lambda ()
+             (close-port output-port))
+           #f) ; number of characters that can be read
+   "w"))
+
+(define (log-for-job conn job-id)
+  (define log-query
+    "SELECT contents FROM load_new_guix_revision_job_logs WHERE job_id = $1")
+
+  (define parts-query
+    (string-append
+     "SELECT STRING_AGG(contents, '' ORDER BY id ASC) "
+     "FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"))
+
+  (match (exec-query conn log-query (list job-id))
+    (((contents))
+     contents)
+    (()
+     (match (exec-query conn parts-query (list job-id))
+       (((contents))
+        contents)))))
+
+(define (combine-log-parts! conn job-id)
+  (with-postgresql-transaction
+   conn
+   (lambda (conn)
+     (exec-query
+      conn
+      (string-append
+       "INSERT INTO load_new_guix_revision_job_logs (job_id, contents) "
+       "SELECT job_id, STRING_AGG(contents, '' ORDER BY id ASC) FROM "
+       "load_new_guix_revision_job_log_parts WHERE job_id = $1 "
+       "GROUP BY job_id")
+      (list job-id))
+     (exec-query
+      conn
+      "DELETE FROM load_new_guix_revision_job_log_parts WHERE job_id = $1"
+      (list job-id)))))
+
 (define inferior-package-id
   (@@ (guix inferior) inferior-package-id))
 
@@ -508,18 +582,24 @@ SELECT
     )
     FROM load_new_guix_revision_job_events
     WHERE job_id = load_new_guix_revision_jobs.id
-  )
-  FROM load_new_guix_revision_jobs
+  ),
+  EXISTS (
+    SELECT 1 FROM load_new_guix_revision_job_logs WHERE job_id = load_new_guix_revision_jobs.id
+    UNION ALL
+    SELECT 1 FROM load_new_guix_revision_job_log_parts WHERE job_id = load_new_guix_revision_jobs.id
+  ) AS log_exists
+FROM load_new_guix_revision_jobs
 ORDER BY load_new_guix_revision_jobs.id DESC")
 
   (map
    (match-lambda
      ((id commit source git-repository-id created-at succeeded-at
-          events-json)
+          events-json log-exists?)
       (list id commit source git-repository-id created-at succeeded-at
             (if (string-null? events-json)
                 #()
-                (json-string->scm events-json)))))
+                (json-string->scm events-json))
+            (string=? log-exists? "t"))))
    (exec-query conn query)))
 
 (define (most-recent-n-load-new-guix-revision-jobs conn n)
@@ -565,7 +645,8 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
 (define (process-next-load-new-guix-revision-job conn)
   (match (select-next-job-to-process conn)
     (((id commit source git-repository-id))
-     (begin
+     (let ((previous-output-port (current-output-port))
+           (previous-error-port (current-error-port)))
        (record-job-event conn id "start")
        (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
                       id commit source)
@@ -574,7 +655,19 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
                (eq? (log-time
                      (string-append "loading revision " commit)
                      (lambda ()
-                       (load-new-guix-revision conn git-repository-id commit)))
+                       (let ((result
+                              (with-postgresql-connection
+                               (lambda (logging-conn)
+                                 (let ((logging-port (log-port id logging-conn)))
+                                   (set-current-output-port logging-port)
+                                   (set-current-error-port logging-port))
+                                 (let ((result
+                                        (load-new-guix-revision conn git-repository-id commit)))
+                                   (combine-log-parts! logging-conn id)
+                                   result)))))
+                         (set-current-output-port previous-output-port)
+                         (set-current-error-port previous-error-port)
+                         result)))
                     #t))
            (begin
              (record-job-succeeded conn id)
diff --git a/sqitch/deploy/load_new_guix_revision_job_logs.sql b/sqitch/deploy/load_new_guix_revision_job_logs.sql
new file mode 100644
index 0000000..9eb804e
--- /dev/null
+++ b/sqitch/deploy/load_new_guix_revision_job_logs.sql
@@ -0,0 +1,16 @@
+-- Deploy guix-data-service:load_new_guix_revision_job_logs to pg
+
+BEGIN;
+
+CREATE TABLE load_new_guix_revision_job_log_parts (
+    id integer NOT NULL,
+    job_id integer NOT NULL,
+    contents text NOT NULL
+);
+
+CREATE TABLE load_new_guix_revision_job_logs (
+    job_id integer PRIMARY KEY REFERENCES load_new_guix_revision_jobs (id),
+    contents text NOT NULL
+);
+
+COMMIT;
diff --git a/sqitch/revert/load_new_guix_revision_job_logs.sql b/sqitch/revert/load_new_guix_revision_job_logs.sql
new file mode 100644
index 0000000..90c0413
--- /dev/null
+++ b/sqitch/revert/load_new_guix_revision_job_logs.sql
@@ -0,0 +1,8 @@
+-- Revert guix-data-service:load_new_guix_revision_job_logs from pg
+
+BEGIN;
+
+DROP TABLE load_new_guix_revision_job_log_parts;
+DROP TABLE load_new_guix_revision_job_logs;
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 56619b9..a03da58 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -13,3 +13,4 @@ add_git_repositories_cgit_url_base 2019-05-13T18:45:14Z Christopher Baines <mail
 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
+load_new_guix_revision_job_logs 2019-06-21T14:33:09Z chris <chris@phact> # Add load_new_guix_revision_job_logs
diff --git a/sqitch/verify/load_new_guix_revision_job_logs.sql b/sqitch/verify/load_new_guix_revision_job_logs.sql
new file mode 100644
index 0000000..aa33fbb
--- /dev/null
+++ b/sqitch/verify/load_new_guix_revision_job_logs.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:load_new_guix_revision_job_logs on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;