From 7d2f4d7b5cf994f5025aeb44b8ebba9385bc0c15 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(-)

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 1242383..97b45ef 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