aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-05-08 17:16:26 +0100
committerChristopher Baines <mail@cbaines.net>2020-05-08 17:16:26 +0100
commit6315b898754c3a5fbbc0e752743b33c9175489b1 (patch)
treeb8ed5375d110441e30d4c7ad48a486cd517587ef /guix-build-coordinator
parentc595d561896b3aa29106fb18e45fd737ab0de702 (diff)
downloadbuild-coordinator-6315b898754c3a5fbbc0e752743b33c9175489b1.tar
build-coordinator-6315b898754c3a5fbbc0e752743b33c9175489b1.tar.gz
Make a record type for the build coordinator
This is already useful to pass around the datastore, hooks and metrics registry, and will become more useful to pass around the allocator to use.
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/agent-messaging/http.scm32
-rw-r--r--guix-build-coordinator/coordinator.scm52
2 files changed, 59 insertions, 25 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 103e962..676651c 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -76,9 +76,9 @@ if there was no request body."
fixed/read-request-body)
(define (http-agent-messaging-start-server port host secret-key-base
- datastore hooks)
+ build-coordinator)
(define trigger-build-allocation
- (make-build-allocator-thread datastore))
+ (make-build-allocator-thread build-coordinator))
(define chunked-request-channel
;; There are fibers issues when trying to read the chunked requests
@@ -86,10 +86,9 @@ if there was no request body."
#:parallelism 4))
(define update-base-datastore-metrics!
- (base-datastore-metrics-updater datastore
- coordinator-metrics-registry))
+ (base-datastore-metrics-updater build-coordinator))
- (start-hook-processing-thread datastore hooks)
+ (start-hook-processing-thread build-coordinator)
(trigger-build-allocation)
(call-with-error-handling
(lambda ()
@@ -106,7 +105,7 @@ if there was no request body."
(uri-path (request-uri request))))
body
secret-key-base
- datastore
+ build-coordinator
trigger-build-allocation
chunked-request-channel
update-base-datastore-metrics!)))
@@ -150,10 +149,16 @@ port. Also, the port used can be changed by passing the --port option.\n"
(list (build-response #:code 204)
""))
-(define (base-datastore-metrics-updater datastore registry)
+(define (base-datastore-metrics-updater build-coordinator)
(define namespace
"guixbuildcoordinator")
+ (define datastore
+ (build-coordinator-datastore build-coordinator))
+
+ (define registry
+ (build-coordinator-metrics-registry build-coordinator))
+
(let ((builds-total
(make-gauge-metric registry
(string-append namespace
@@ -216,7 +221,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
method-and-path-components
body
secret-key-base
- datastore
+ build-coordinator
trigger-build-allocation
chunked-request-channel
update-base-datastore-metrics!)
@@ -238,6 +243,9 @@ port. Also, the port used can be changed by passing the --port option.\n"
auth-password)))
(_ #f))))
+ (define datastore
+ (build-coordinator-datastore build-coordinator))
+
(define (controller-thunk)
(match method-and-path-components
(('GET "agent" uuid)
@@ -261,7 +269,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
#:code 403)))
(('POST "agent" uuid "fetch-builds")
(if (authenticated? uuid request)
- (let ((builds (fetch-builds datastore uuid)))
+ (let ((builds (fetch-builds build-coordinator uuid)))
(render-json
`((builds . ,(list->vector builds)))))
(render-json
@@ -285,7 +293,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
(backtrace)
(raise-exception exn))
(lambda ()
- (handle-build-result datastore agent-id-for-build uuid
+ (handle-build-result build-coordinator
+ agent-id-for-build uuid
(json-string->scm (utf8->string body)))
;; Trigger build allocation, as the result of this build
;; could change the allocation
@@ -371,7 +380,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
#:headers '((content-type . (text/plain))
(vary . (accept))))
(lambda (port)
- (write-metrics coordinator-metrics-registry
+ (write-metrics (build-coordinator-metrics-registry
+ build-coordinator)
port))))
(_
(render-json
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index ce67cfd..0cc41d0 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -20,6 +20,7 @@
(define-module (guix-build-coordinator coordinator)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
@@ -33,7 +34,10 @@
#:use-module (guix-build-coordinator metrics)
#:use-module (guix-build-coordinator datastore)
#:use-module (guix-build-coordinator build-allocator)
- #:export (coordinator-metrics-registry
+ #:export (make-build-coordinator
+ build-coordinator-datastore
+ build-coordinator-hooks
+ build-coordinator-metrics-registry
submit-build
new-agent
@@ -48,8 +52,19 @@
handle-build-result
handle-setup-failure-report))
-(define coordinator-metrics-registry
- (make-metrics-registry))
+(define-record-type <build-coordinator>
+ (make-build-coordinator-record datastore hooks metrics-registry)
+ build-coordinator?
+ (datastore build-coordinator-datastore)
+ (hooks build-coordinator-hooks)
+ (metrics-registry build-coordinator-metrics-registry))
+
+(define* (make-build-coordinator #:key datastore hooks
+ (metrics-registry (make-metrics-registry)))
+ (make-build-coordinator-record
+ datastore
+ hooks
+ metrics-registry))
(define* (submit-build datastore derivation
#:key
@@ -118,7 +133,7 @@
(basic-build-allocation-strategy datastore))
#t)
-(define (make-build-allocator-thread datastore)
+(define (make-build-allocator-thread build-coordinator)
(define mtx (make-mutex))
(define v (make-condition-variable))
@@ -131,7 +146,7 @@
(with-mutex mtx
(wait-condition-variable v mtx)
(call-with-duration-metric
- coordinator-metrics-registry
+ (build-coordinator-metrics-registry build-coordinator)
"guixbuildcoordinator_allocate_builds_duration_seconds"
(lambda ()
(with-exception-handler
@@ -146,12 +161,16 @@
(backtrace)
(raise-exception exn))
(lambda ()
- (allocate-builds datastore))))
+ (allocate-builds
+ (build-coordinator-datastore build-coordinator)))))
#:unwind? #t)))))))
trigger-build-allocation)
-(define (start-hook-processing-thread datastore hooks)
+(define (start-hook-processing-thread build-coordinator)
+ (define datastore
+ (build-coordinator-datastore build-coordinator))
+
(call-with-new-thread
(lambda ()
(while #t
@@ -161,7 +180,9 @@
(catch
#t
(lambda ()
- (apply (assq-ref hooks event) datastore arguments)
+ (apply (assq-ref (build-coordinator-hooks build-coordinator)
+ event)
+ datastore arguments)
(datastore-delete-unprocessed-hook-event datastore id))
(lambda (key . args)
(simple-format #t "error: running ~A hook: ~A ~A\n"
@@ -169,18 +190,18 @@
#f)))))))
#t)
-(define (fetch-builds datastore agent)
+(define (fetch-builds build-coordinator agent)
(call-with-duration-metric
- coordinator-metrics-registry
+ (build-coordinator-metrics-registry build-coordinator)
"guixbuildcoordinator_coordinator_fetch_builds_duration_seconds"
(lambda ()
(let ((builds (datastore-list-allocation-plan-builds
- datastore
+ (build-coordinator-datastore build-coordinator)
agent
1)))
(unless (null? builds)
(datastore-allocate-builds-to-agent
- datastore
+ (build-coordinator-datastore build-coordinator)
agent
(map (lambda (build)
(assq-ref build 'uuid))
@@ -225,10 +246,13 @@
(simple-format #f "found multiple files for ~A: ~A"
build-id files))))))
-(define (handle-build-result datastore
+(define (handle-build-result build-coordinator
agent-id build-id result-json)
+ (define datastore
+ (build-coordinator-datastore build-coordinator))
+
(call-with-duration-metric
- coordinator-metrics-registry
+ (build-coordinator-metrics-registry build-coordinator)
"guixbuildcoordinator_coordinator_handle_build_result_duration_seconds"
(lambda ()
(let* ((result (assoc-ref result-json "result"))