diff options
Diffstat (limited to 'guix-build-coordinator/client-communication.scm')
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 61 |
1 files changed, 34 insertions, 27 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 7e84199..e5ab41c 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -500,33 +500,40 @@ (datastore-call-with-transaction datastore (lambda (_) - `((state_id . ,(build-coordinator-get-state-id build-coordinator)) - (agents . ,(list->vector - (map - (lambda (agent-details) - (let ((agent-id - (assq-ref agent-details 'uuid))) - `(,@agent-details - (last_status_update - . ,(datastore-find-agent-status datastore - agent-id)) - (requested_systems - . ,(list->vector - (datastore-agent-requested-systems - datastore - agent-id))) - (builds - . ,(list->vector - (map - (lambda (build) - `(,@build - (tags . ,(datastore-fetch-build-tags - datastore - (assq-ref build 'uuid))))) - (datastore-list-agent-builds - datastore - (assq-ref agent-details 'uuid)))))))) - (datastore-list-agents datastore))))))))) + (let ((allocation-plan-counts + (datastore-count-build-allocation-plan-entries + datastore))) + `((state_id . ,(build-coordinator-get-state-id build-coordinator)) + (agents . ,(list->vector + (map + (lambda (agent-details) + (let ((agent-id + (assq-ref agent-details 'uuid))) + `(,@agent-details + (last_status_update + . ,(datastore-find-agent-status datastore + agent-id)) + (requested_systems + . ,(list->vector + (datastore-agent-requested-systems + datastore + agent-id))) + (allocation_plan + . ((count . ,(or (assoc-ref allocation-plan-counts + agent-id) + 0)))) + (builds + . ,(list->vector + (map + (lambda (build) + `(,@build + (tags . ,(datastore-fetch-build-tags + datastore + (assq-ref build 'uuid))))) + (datastore-list-agent-builds + datastore + (assq-ref agent-details 'uuid)))))))) + (datastore-list-agents datastore)))))))))) (('GET "events") (list (build-response #:code 200 |