Store channel instance derivations in a separate transaction

This means that these derivations are stored, even if a later part of the
process fails. Having the channel instance derivations stored might help work
out why the failure occurred, or better display information about it.

8 files changed, 130 insertions, 67 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index e6660af..423043b 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -68,6 +68,7 @@
             select-recent-job-events
             select-unprocessed-jobs-and-events
             select-jobs-and-events-for-commit
+            guix-revision-loaded-successfully?
             record-job-event
             enqueue-load-new-guix-revision-job
             most-recent-n-load-new-guix-revision-jobs))
@@ -1314,50 +1315,60 @@ WHERE job_id = $1"
           (channel->derivations-by-system conn
                                           store
                                           channel-for-commit
-                                          fetch-with-authentication?))
-         (store-item
-          (channel-derivations-by-system->guix-store-item
-           store
-           channel-derivations-by-system)))
-    (if store-item
-        (let ((guix-revision-id
-               (insert-guix-revision conn git-repository-id
-                                     commit store-item)))
-          (and
-           guix-revision-id
-           (extract-information-from conn store
-                                     guix-revision-id
-                                     commit store-item)
-           (insert-channel-instances conn
-                                     guix-revision-id
-                                     (filter-map
-                                      (match-lambda
-                                        ((system . derivations)
-                                         (and=>
-                                          (assoc-ref derivations
-                                                     'manifest-entry-item)
-                                          (lambda (drv)
-                                            (cons system drv)))))
-                                      channel-derivations-by-system))
-           (if (defined? 'channel-news-for-commit
-                 (resolve-module '(guix channels)))
-               (with-time-logging "inserting channel news entries"
-                 (insert-channel-news-entries-for-guix-revision
-                  conn
-                  guix-revision-id
-                  (channel-news-for-commit channel-for-commit commit)))
-               (begin
-                 (simple-format #t "debug: importing channel news not supported\n")
-                 #t))
-
-           (update-package-derivations-table conn
-                                             git-repository-id
-                                             guix-revision-id
-                                             commit)))
-        (begin
-          (simple-format #t "Failed to generate store item for ~A\n"
-                         commit)
-          #f))))
+                                          fetch-with-authentication?)))
+    (let ((guix-revision-id
+           (insert-guix-revision conn git-repository-id commit)))
+      (insert-channel-instances conn
+                                guix-revision-id
+                                (filter-map
+                                 (match-lambda
+                                   ((system . derivations)
+                                    (and=>
+                                     (assoc-ref derivations
+                                                'manifest-entry-item)
+                                     (lambda (drv)
+                                       (cons system drv)))))
+                                 channel-derivations-by-system))
+
+      (simple-format
+       (current-error-port)
+       "guix-data-service: saving the channel instance derivations to the database\n")
+
+      ;; COMMIT so that the channel instances are saved to the database, then
+      ;; start a new transaction for the rest of the processing.
+      (exec-query conn "COMMIT")
+      (exec-query conn "BEGIN")
+
+      (let ((store-item
+             (channel-derivations-by-system->guix-store-item
+              store
+              channel-derivations-by-system)))
+        (if store-item
+            (begin
+              (extract-information-from conn store
+                                        guix-revision-id
+                                        commit store-item)
+
+              (if (defined? 'channel-news-for-commit
+                    (resolve-module '(guix channels)))
+                  (with-time-logging "inserting channel news entries"
+                    (insert-channel-news-entries-for-guix-revision
+                     conn
+                     guix-revision-id
+                     (channel-news-for-commit channel-for-commit commit)))
+                  (begin
+                    (simple-format
+                     #t "debug: importing channel news not supported\n")
+                    #t))
+
+              (update-package-derivations-table conn
+                                                git-repository-id
+                                                guix-revision-id
+                                                commit))
+            (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
@@ -1606,6 +1617,23 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
             (string=? log-exists? "t"))))
    (exec-query conn query (list commit))))
 
+(define (guix-revision-loaded-successfully? conn commit)
+  (define query
+    "
+SELECT EXISTS(
+  SELECT 1
+  FROM load_new_guix_revision_jobs
+  INNER JOIN load_new_guix_revision_job_events
+    ON job_id = load_new_guix_revision_jobs.id
+  WHERE commit = $1
+    AND event = 'success'
+)")
+
+  (let ((result (caar
+                 (exec-query conn query (list commit)))))
+    (string=? result "t")))
+
+
 (define (most-recent-n-load-new-guix-revision-jobs conn n)
   (let ((result
          (exec-query
diff --git a/guix-data-service/model/channel-instance.scm b/guix-data-service/model/channel-instance.scm
index 35a4879..956018e 100644
--- a/guix-data-service/model/channel-instance.scm
+++ b/guix-data-service/model/channel-instance.scm
@@ -24,6 +24,7 @@
   #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service model derivation)
   #:export (insert-channel-instances
+            channel-instances-exist-for-guix-revision?
             select-channel-instances-for-guix-revision))
 
 (define (insert-channel-instances conn
@@ -52,6 +53,21 @@ VALUES "
        ", "))))
   #t)
 
+(define (channel-instances-exist-for-guix-revision? conn commit-hash)
+  (define query
+    "
+SELECT EXISTS(
+  SELECT 1
+  FROM channel_instances
+  INNER JOIN guix_revisions
+    ON guix_revisions.id = channel_instances.guix_revision_id
+  WHERE guix_revisions.commit = $1
+)")
+
+  (let ((result (caar
+                 (exec-query conn query (list commit-hash)))))
+    (string=? result "t")))
+
 (define (select-channel-instances-for-guix-revision conn
                                                     commit-hash)
   (define query
diff --git a/guix-data-service/model/guix-revision.scm b/guix-data-service/model/guix-revision.scm
index ecc3cf0..4f5ed6d 100644
--- a/guix-data-service/model/guix-revision.scm
+++ b/guix-data-service/model/guix-revision.scm
@@ -46,16 +46,13 @@
      id)
     (() #f)))
 
-(define (insert-guix-revision conn git-repository-id commit store_path)
+(define (insert-guix-revision conn git-repository-id commit)
   (define insert
-    (string-append "INSERT INTO guix_revisions "
-                   "(git_repository_id, commit, store_path) VALUES "
-                   "(" git-repository-id ", '"
-                   commit "', '"
-                   store_path "') "
-                   "RETURNING id;"))
+    "
+INSERT INTO guix_revisions (git_repository_id, commit)
+  VALUES ($1, $2) RETURNING id")
 
-  (match (exec-query conn insert)
+  (match (exec-query conn insert (list git-repository-id commit))
     (((id)) id)))
 
 (define (guix-commit-exists? conn commit)
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index f9fd2db..5a48701 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -105,7 +105,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (render-view-revision mime-types
                                commit-hash
                                #:path-base path)
@@ -115,7 +115,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (parse-query-parameters
                  request
@@ -129,7 +129,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (guard-against-mutually-exclusive-query-parameters
                  (parse-query-parameters
@@ -158,7 +158,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (render-revision-packages-translation-availability mime-types
                                                             commit-hash
                                                             #:path-base path)
@@ -168,7 +168,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (render-revision-package mime-types
                                   commit-hash
                                   name)
@@ -178,7 +178,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (parse-query-parameters
                  request
@@ -194,7 +194,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (guard-against-mutually-exclusive-query-parameters
                  (parse-query-parameters
@@ -224,7 +224,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (guard-against-mutually-exclusive-query-parameters
                  (parse-query-parameters
@@ -250,7 +250,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (guard-against-mutually-exclusive-query-parameters
                  (parse-query-parameters
@@ -281,7 +281,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (parse-query-parameters
                  request
@@ -296,7 +296,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (channel-instances-exist-for-guix-revision? conn commit-hash))))
          (render-revision-channel-instances mime-types
                                             commit-hash
                                             #:path-base path)
@@ -306,7 +306,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (render-revision-package-substitute-availability mime-types
                                                           commit-hash
                                                           #:path-base path)
@@ -316,7 +316,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (render-revision-package-reproduciblity mime-types
                                                  commit-hash
                                                  #:path-base path)
@@ -326,7 +326,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (guard-against-mutually-exclusive-query-parameters
                  (parse-query-parameters
@@ -351,7 +351,7 @@
      (if (parallel-via-thread-pool-channel
           (with-thread-postgresql-connection
            (lambda (conn)
-             (guix-commit-exists? conn commit-hash))))
+             (guix-revision-loaded-successfully? conn commit-hash))))
          (let ((parsed-query-parameters
                 (parse-query-parameters
                  request
diff --git a/sqitch/deploy/remove_guix_revisions_store_path.sql b/sqitch/deploy/remove_guix_revisions_store_path.sql
new file mode 100644
index 0000000..aaec02b
--- /dev/null
+++ b/sqitch/deploy/remove_guix_revisions_store_path.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-data-service:remove_guix_revisions_store_path to pg
+
+BEGIN;
+
+ALTER TABLE guix_revisions DROP COLUMN store_path;
+
+COMMIT;
diff --git a/sqitch/revert/remove_guix_revisions_store_path.sql b/sqitch/revert/remove_guix_revisions_store_path.sql
new file mode 100644
index 0000000..1165227
--- /dev/null
+++ b/sqitch/revert/remove_guix_revisions_store_path.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:remove_guix_revisions_store_path from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index fc3b998..b5af91d 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -77,3 +77,4 @@ create_latest_build_status 2020-10-13T17:22:39Z Christopher Baines <mail@cbaines
 regenerate_latest_build_status 2020-10-21T18:39:03Z Christopher Baines <mail@cbaines.net> # Regenerate the latest_build_status table
 guix_revision_package_derivations_add_package_derivation_index 2020-10-27T16:58:08Z Christopher Baines <mail@cbaines.net> # Add index for guix_revision_package_derivations.package_derivation_id
 increase_derivation_inputs_statistics_targets 2020-12-27T10:34:58Z Christopher Baines <mail@cbaines.net> # Increase stats targets on derivation_inputs fields
+remove_guix_revisions_store_path 2021-02-02T20:06:18Z Christopher Baines <mail@cbaines.net> # Drop guix_revisions.store_path
diff --git a/sqitch/verify/remove_guix_revisions_store_path.sql b/sqitch/verify/remove_guix_revisions_store_path.sql
new file mode 100644
index 0000000..87deee3
--- /dev/null
+++ b/sqitch/verify/remove_guix_revisions_store_path.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:remove_guix_revisions_store_path on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;