aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-build-coordinator/client-communication.scm20
-rw-r--r--guix-build-coordinator/datastore/sqlite.scm71
-rw-r--r--scripts/guix-build-coordinator.in38
3 files changed, 101 insertions, 28 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index 094ab4e..5a66cdd 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -55,6 +55,7 @@
request-agent-build-allocation-plan
request-agents-list
request-failed-builds-with-blocking-count-list
+ request-setup-failures
send-create-agent-request
send-agent-set-active-request
send-create-agent-password-request
@@ -334,6 +335,16 @@
(render-json
`((error . 404))
#:code 404))))
+ (('GET "setup-failures")
+ (let ((query-parameters (request-query-parameters request)))
+ (render-json
+ `((setup_failures
+ . ,(hash-map->list
+ (lambda (k v)
+ (cons k (list->vector v)))
+ (datastore-fetch-setup-failures
+ datastore
+ #:agent-id (assq-ref query-parameters 'agent-id))))))))
(('GET "builds")
(let* ((query-parameters (request-query-parameters request))
(fold-builds-args
@@ -944,6 +955,15 @@
"false"))
""))))
+(define* (request-setup-failures coordinator-uri #:key agent-id)
+ (send-request coordinator-uri
+ 'GET
+ (string-append
+ "/setup-failures"
+ (if agent-id
+ (simple-format #f "?agent-id=~A" agent-id)
+ ""))))
+
(define* (send-create-agent-request coordinator-uri
#:key
requested-uuid
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index e5ae519..5e39849 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -2893,14 +2893,19 @@ WHERE build_id = :build_id"
result)))))
(define-method (datastore-fetch-setup-failures
- (datastore <sqlite-datastore>))
- (call-with-worker-thread
- (slot-ref datastore 'worker-reader-thread-channel)
- (lambda (db)
- (let ((statement
- (sqlite-prepare
- db
- "
+ (datastore <sqlite-datastore>)
+ .
+ args)
+ (apply
+ (lambda* (#:key agent-id)
+ (call-with-worker-thread
+ (slot-ref datastore 'worker-reader-thread-channel)
+ (lambda (db)
+ (let ((statement
+ (sqlite-prepare
+ db
+ (string-append
+ "
SELECT setup_failures.id, builds.uuid, agent_id, failure_reason
FROM setup_failures
INNER JOIN builds
@@ -2910,28 +2915,38 @@ WHERE builds.processed = 0
AND builds.id NOT IN (
SELECT build_id FROM allocated_builds
)"
- #:cache? #t)))
+ (if agent-id
+ "
+ AND agent_id = :agent_id"
+ ""))
+ #:cache? #t)))
- (let ((result (sqlite-fold
- (lambda (row result)
- (match row
- (#(id build-id agent-id failure-reason)
- (let ((failures-for-build-id
- (or (hash-ref result build-id)
- '())))
- (hash-set!
- result
- build-id
- (cons `((id . ,id)
- (agent-id . ,agent-id)
- (failure-reason . ,failure-reason))
- failures-for-build-id)))))
- result)
- (make-hash-table)
- statement)))
- (sqlite-reset statement)
+ (when agent-id
+ (sqlite-bind-arguments
+ statement
+ #:agent_id agent-id))
+
+ (let ((result (sqlite-fold
+ (lambda (row result)
+ (match row
+ (#(id build-id agent-id failure-reason)
+ (let ((failures-for-build-id
+ (or (hash-ref result build-id)
+ '())))
+ (hash-set!
+ result
+ build-id
+ (cons `((id . ,id)
+ (agent-id . ,agent-id)
+ (failure-reason . ,failure-reason))
+ failures-for-build-id)))))
+ result)
+ (make-hash-table)
+ statement)))
+ (sqlite-reset statement)
- result)))))
+ result)))))
+ args))
(define-method (datastore-list-processed-builds
(datastore <sqlite-datastore>))
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 62b48e2..10970d7 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -156,6 +156,17 @@
(ensure-all-related-derivation-outputs-have-builds . #f)
(tags . ())))
+(define %setup-failure-options
+ (list
+ (option '("agent-id") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'agent-id
+ arg
+ (alist-delete 'agent-id result))))))
+
+(define %setup-failure-option-defaults
+ `((agent-id . #f)))
+
(define %common-build-filtering-options
(list
(option '("tag") #t #f
@@ -988,6 +999,33 @@ tags:
(assoc-ref
(request-agents-list (assq-ref opts 'coordinator))
"agents")))))
+ (("setup-failures" "list" rest ...)
+ (let ((opts (parse-options (append %client-options
+ %base-options
+ %setup-failure-options)
+ (append %client-option-defaults
+ %base-option-defaults
+ %setup-failure-option-defaults)
+ rest)))
+ (for-each
+ (match-lambda
+ ((build-id . setup-failures)
+ (for-each
+ (lambda (setup-failure)
+ (simple-format #t "~A:\n"
+ (assoc-ref setup-failure "id"))
+ (simple-format #t " build-id: ~A\n"
+ build-id)
+ (simple-format #t " agent-id: ~A\n"
+ (assoc-ref setup-failure "agent-id"))
+ (simple-format #t " failure-reason: ~A\n"
+ (assoc-ref setup-failure "failure-reason"))
+ (newline))
+ (vector->list setup-failures))))
+ (assoc-ref
+ (request-setup-failures (assq-ref opts 'coordinator)
+ #:agent-id (assq-ref opts 'agent-id))
+ "setup_failures"))))
(("dynamic-auth" "create-token")
(let ((opts (parse-options (append %client-options
%base-options)