From 70b1fa1d7be0a48341e9e0bc74c0957adb35c7b9 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 10 Apr 2023 10:07:54 +0100
Subject: Prioritise post build actions

By the priority of the build, and then by the bytes that need uploading. This
should help ensure that priority builds get handled first when there's
congestion getting data back to the coordinator. Prioritising builds with less
data to upload should also keep things moving when uploads are slow as well.
---
 guix-build-coordinator/agent.scm | 78 +++++++++++++++++++++++++++-------------
 1 file changed, 54 insertions(+), 24 deletions(-)

(limited to 'guix-build-coordinator')

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index c7440c9..3baa368 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -325,30 +325,43 @@
                              (get-compressed-outputs store))))
 
                   (perform-post-build-actions
-                   build
-                   (lambda ()
-                     (agent-submit-log-file lgr
-                                            coordinator-interface
-                                            build-id derivation-name)
-
-                     (if result
-                         (post-build-success lgr
-                                             coordinator-interface
-                                             build-id
-                                             derivation
-                                             end-time
-                                             submit-outputs?
-                                             output-details
-                                             compressed-outputs
-                                             with-upload-monitoring)
-                         (post-build-failure lgr
+                   (list
+                    build
+                    (lambda ()
+                      (agent-submit-log-file lgr
                                              coordinator-interface
-                                             build-id
-                                             end-time))
-                     (log-msg lgr 'INFO
-                              build-id
-                              ": finished processing: "
-                              derivation-name)))))
+                                             build-id derivation-name)
+
+                      (if result
+                          (post-build-success lgr
+                                              coordinator-interface
+                                              build-id
+                                              derivation
+                                              end-time
+                                              submit-outputs?
+                                              output-details
+                                              compressed-outputs
+                                              with-upload-monitoring)
+                          (post-build-failure lgr
+                                              coordinator-interface
+                                              build-id
+                                              end-time))
+                      (log-msg lgr 'INFO
+                               build-id
+                               ": finished processing: "
+                               derivation-name)))
+                   #:priority
+                   (list (assoc-ref build "derived_priority")
+                         (if (and result submit-outputs?)
+                             (fold
+                              (lambda (output result)
+                                (let ((file (cdr output)))
+                                  (+ (stat:size (stat file))
+                                     result)))
+                              0
+                              compressed-outputs)
+                             0)))))
+
               (begin
                 (log-msg lgr 'INFO
                          build-id
@@ -393,7 +406,24 @@
                  (create-work-queue max-parallel-uploads
                                     (lambda (build thunk)
                                       (thunk))
-                                    #:name "upload"))
+                                    #:name "upload"
+
+                                    ;; The priority here is a list where the
+                                    ;; first element is the build priority,
+                                    ;; and the second is the number of bytes
+                                    ;; to upload
+                                    #:priority<?
+                                    (lambda (a b)
+                                      (let ((a-priority (first a))
+                                            (b-priority (first b)))
+                                        (if (= a-priority b-priority)
+                                            (> (second a)
+                                               (second b))
+
+                                            ;; Prioritise uploading smaller
+                                            ;; files first
+                                            (< a-priority
+                                               b-priority))))))
 
                 ((process-job-with-queue count-jobs count-threads list-jobs)
                  (create-work-queue current-max-builds
-- 
cgit v1.2.3