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.

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,20 +1315,9 @@ 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
+                                          fetch-with-authentication?)))
     (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-guix-revision conn git-repository-id commit)))
       (insert-channel-instances conn
                                 guix-revision-id
                                 (filter-map
@@ -1339,6 +1329,26 @@ WHERE job_id = $1"
                                      (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"
@@ -1347,17 +1357,18 @@ WHERE job_id = $1"
                      guix-revision-id
                      (channel-news-for-commit channel-for-commit commit)))
                   (begin
-                 (simple-format #t "debug: importing channel news not supported\n")
+                    (simple-format
+                     #t "debug: importing channel news not supported\n")
                     #t))
 
               (update-package-derivations-table conn
                                                 git-repository-id
                                                 guix-revision-id
-                                             commit)))
+                                                commit))
             (begin
               (simple-format #t "Failed to generate store item for ~A\n"
                              commit)
-          #f))))
+              #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

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

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)

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

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;

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;

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

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;