Add a combined variant of the post-publish-hook

To the build-success-publish-hook.

This should make it possible to pass all nars and narinfo's to the nar-herder
in one go, which in turn should make it possible to have the nar-herder
validate referential integrity, even in the case where one build has multiple
outputs which have circular references.

1 files changed, 180 insertions, 145 deletions

diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index 9917a98..4845f6d 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -92,6 +92,7 @@
              (file-exists? (string-append
                             narinfo-directory "/" narinfo-filename))))
           post-publish-hook
+          combined-post-publish-hook
           (publish-referenced-derivation-source-files? #t)
           derivation-substitute-urls)
   (mkdir-p (string-append publish-directory "/nar/lzip"))
@@ -100,154 +101,188 @@
     (define datastore
       (build-coordinator-datastore build-coordinator))
 
+    (define (process-referenced-derivation-source-files)
+      (with-store store
+        (unless (valid-path? store derivation-name)
+          (substitute-derivation derivation-name
+                                 #:substitute-urls
+                                 derivation-substitute-urls))
+
+        (let* ((drv (read-derivation-from-file derivation-name))
+               (drv-sources
+                (derivation-sources drv))
+               (referenced-source-files
+                (delete-duplicates
+                 (append-map
+                  (lambda (output)
+                    (let ((refs
+                           (or (and=> (assq-ref output 'references)
+                                      vector->list)
+                               '())))
+
+                      (filter
+                       (lambda (source)
+                         (member (basename source) refs))
+                       drv-sources)))
+                  (datastore-list-build-outputs datastore build-id)))))
+
+          (filter-map
+           (lambda (source-filename)
+             (let* ((nar-filename
+                     (string-append "nar/lzip/"
+                                    (basename source-filename)))
+                    (nar-destination
+                     (string-append publish-directory "/"
+                                    nar-filename))
+                    (tmp-nar-destination
+                     (string-append publish-directory "/"
+                                    nar-filename
+                                    ".tmp"))
+                    (narinfo-filename
+                     (string-append (string-take (basename source-filename) 32)
+                                    ".narinfo"))
+
+                    (narinfo-location
+                     (string-append narinfo-directory "/"
+                                    narinfo-filename))
+                    (path-info
+                     (query-path-info store source-filename)))
+
+               (if (skip-publishing-proc narinfo-filename narinfo-directory)
+                   #f
+                   (begin
+                     (call-with-output-file tmp-nar-destination
+                       (lambda (out)
+                         (call-with-lzip-output-port out
+                           (lambda (port)
+                             (write-file source-filename port))
+                           #:level 9)))
+
+                     (rename-file tmp-nar-destination nar-destination)
+
+                     (call-with-output-file narinfo-location
+                       (lambda (port)
+                         (display (narinfo-string
+                                   source-filename
+                                   (bytevector->nix-base32-string
+                                    (path-info-hash path-info))
+                                   (path-info-nar-size path-info)
+                                   (map basename
+                                        (path-info-references
+                                         path-info))
+                                   `((lzip ,(stat:size (stat nar-destination #f))))
+                                   #:public-key public-key
+                                   #:private-key private-key)
+                                  port)))
+
+                     (when post-publish-hook
+                       (with-exception-handler
+                           (lambda (exn)
+                             ;; Rollback narinfo creation, to make this more
+                             ;; transactional
+                             (delete-file narinfo-location)
+
+                             (raise-exception exn))
+                         (lambda ()
+                           (post-publish-hook publish-directory
+                                              narinfo-filename
+                                              nar-filename))
+                         #:unwind? #t))
+
+                     (cons narinfo-filename
+                           nar-filename)))))
+           referenced-source-files))))
+
+    (define (process-output output)
+      (lambda (output)
+        (let* ((output-name
+                (assq-ref output 'name))
+               (output-filename
+                (assq-ref output 'output))
+               (nar-location
+                (build-output-file-location datastore build-id
+                                            output-name))
+               (nar-filename
+                (string-append "nar/lzip/"
+                               (basename output-filename)))
+               (nar-destination
+                (string-append publish-directory "/"
+                               nar-filename))
+               (narinfo-filename
+                (string-append (string-take (basename output-filename) 32)
+                               ".narinfo"))
+
+               (narinfo-location
+                (string-append narinfo-directory "/"
+                               narinfo-filename)))
+
+          (if (skip-publishing-proc narinfo-filename narinfo-directory)
+              #f
+              (begin
+                (copy-file nar-location nar-destination)
+
+                (call-with-output-file narinfo-location
+                  (lambda (port)
+                    (display (narinfo-string
+                              output-filename
+                              (assq-ref output 'hash)
+                              (assq-ref output 'size)
+                              (vector->list
+                               (assq-ref output 'references))
+                              `((lzip ,(stat:size (stat nar-location #f))))
+                              #:system (datastore-find-derivation-system
+                                        datastore
+                                        derivation-name)
+                              #:derivation derivation-name
+                              #:public-key public-key
+                              #:private-key private-key)
+                             port)))
+
+                (when post-publish-hook
+                  (with-exception-handler
+                      (lambda (exn)
+                        ;; Rollback narinfo creation, to make this more
+                        ;; transactional
+                        (delete-file narinfo-location)
+
+                        (raise-exception exn))
+                    (lambda ()
+                      (post-publish-hook publish-directory
+                                         narinfo-filename
+                                         nar-filename))
+                    #:unwind? #t))
+
+                (cons narinfo-filename
+                      nar-filename))))))
+
     (let* ((build-details
             (datastore-find-build datastore build-id))
            (derivation-name
-            (assq-ref build-details 'derivation-name)))
-      (when publish-referenced-derivation-source-files?
-        (with-store store
-          (unless (valid-path? store derivation-name)
-            (substitute-derivation derivation-name
-                                   #:substitute-urls
-                                   derivation-substitute-urls))
-
-          (let* ((drv (read-derivation-from-file derivation-name))
-                 (drv-sources
-                  (derivation-sources drv))
-                 (referenced-source-files
-                  (delete-duplicates
-                   (append-map
-                    (lambda (output)
-                      (let ((refs
-                             (or (and=> (assq-ref output 'references)
-                                        vector->list)
-                                 '())))
-
-                        (filter
-                         (lambda (source)
-                           (member (basename source) refs))
-                         drv-sources)))
-                    (datastore-list-build-outputs datastore build-id)))))
-
-            (for-each
-             (lambda (source-filename)
-               (let* ((nar-filename
-                       (string-append "nar/lzip/"
-                                      (basename source-filename)))
-                      (nar-destination
-                       (string-append publish-directory "/"
-                                      nar-filename))
-                      (tmp-nar-destination
-                       (string-append publish-directory "/"
-                                      nar-filename
-                                      ".tmp"))
-                      (narinfo-filename
-                       (string-append (string-take (basename source-filename) 32)
-                                      ".narinfo"))
-
-                      (narinfo-location
-                       (string-append narinfo-directory "/"
-                                      narinfo-filename))
-                      (path-info
-                       (query-path-info store source-filename)))
-
-                 (unless (skip-publishing-proc narinfo-filename narinfo-directory)
-                   (call-with-output-file tmp-nar-destination
-                     (lambda (out)
-                       (call-with-lzip-output-port out
-                         (lambda (port)
-                           (write-file source-filename port))
-                         #:level 9)))
-
-                   (rename-file tmp-nar-destination nar-destination)
-
-                   (call-with-output-file narinfo-location
-                     (lambda (port)
-                       (display (narinfo-string
-                                 source-filename
-                                 (bytevector->nix-base32-string
-                                  (path-info-hash path-info))
-                                 (path-info-nar-size path-info)
-                                 (map basename
-                                      (path-info-references
-                                       path-info))
-                                 `((lzip ,(stat:size (stat nar-destination #f))))
-                                 #:public-key public-key
-                                 #:private-key private-key)
-                                port)))
-
-                   (when post-publish-hook
-                     (with-exception-handler
-                         (lambda (exn)
-                           ;; Rollback narinfo creation, to make this more
-                           ;; transactional
-                           (delete-file narinfo-location)
-
-                           (raise-exception exn))
-                       (lambda ()
-                         (post-publish-hook publish-directory
-                                            narinfo-filename
-                                            nar-filename))
-                       #:unwind? #t)))))
-             referenced-source-files))))
-
-      (for-each
-       (lambda (output)
-         (let* ((output-name
-                 (assq-ref output 'name))
-                (output-filename
-                 (assq-ref output 'output))
-                (nar-location
-                 (build-output-file-location datastore build-id
-                                             output-name))
-                (nar-filename
-                 (string-append "nar/lzip/"
-                                (basename output-filename)))
-                (nar-destination
-                 (string-append publish-directory "/"
-                                nar-filename))
-                (narinfo-filename
-                 (string-append (string-take (basename output-filename) 32)
-                                ".narinfo"))
-
-                (narinfo-location
-                 (string-append narinfo-directory "/"
-                                narinfo-filename)))
-
-           (unless (skip-publishing-proc narinfo-filename narinfo-directory)
-             (copy-file nar-location nar-destination)
-
-             (call-with-output-file narinfo-location
-               (lambda (port)
-                 (display (narinfo-string
-                           output-filename
-                           (assq-ref output 'hash)
-                           (assq-ref output 'size)
-                           (vector->list
-                            (assq-ref output 'references))
-                           `((lzip ,(stat:size (stat nar-location #f))))
-                           #:system (datastore-find-derivation-system
-                                     datastore
-                                     derivation-name)
-                           #:derivation derivation-name
-                           #:public-key public-key
-                           #:private-key private-key)
-                          port)))
-
-             (when post-publish-hook
-               (with-exception-handler
-                   (lambda (exn)
-                     ;; Rollback narinfo creation, to make this more
-                     ;; transactional
-                     (delete-file narinfo-location)
-
-                     (raise-exception exn))
-                 (lambda ()
-                   (post-publish-hook publish-directory
-                                      narinfo-filename
-                                      nar-filename))
-                 #:unwind? #t)))))
-       (datastore-list-build-outputs datastore build-id)))))
+            (assq-ref build-details 'derivation-name))
+           (narinfos-and-nars
+            (append
+             (if publish-referenced-derivation-source-files?
+                 (process-referenced-derivation-source-files)
+                 '())
+             (filter-map
+              process-output
+              (datastore-list-build-outputs datastore build-id)))))
+      (when combined-post-publish-hook
+        (with-exception-handler
+            (lambda (exn)
+              ;; Rollback narinfo creation, to make this more
+              ;; transactional
+              (for-each
+               (match-lambda
+                 ((narinfo-filename . _)
+                  (delete-file narinfo-filename)))
+               narinfos-and-nars)
+
+              (raise-exception exn))
+          (lambda ()
+            (combined-post-publish-hook publish-directory
+                                        narinfos-and-nars))
+          #:unwind? #t)))))
 
 (define* (build-success-s3-publish-hook
           s3-bucket