diff options
Diffstat (limited to 'guix-build-coordinator/client-communication.scm')
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 46 |
1 files changed, 30 insertions, 16 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index 98e73e6..16fa529 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -22,6 +22,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-43) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 exceptions) @@ -176,7 +177,13 @@ (lambda (time) (strftime "%F %T" time))) 'null)) - (tags . ,tags) + (tags . ,(vector-map + (lambda (_ tag) + (match tag + ((key . value) + `((key . ,key) + (value . ,value))))) + tags)) (derivation-inputs . ,(list->vector derivation-inputs)) (setup-failures . ,(list->vector setup-failures)))))))) (('POST "build" uuid "cancel") @@ -210,9 +217,15 @@ (render-json `((id . ,agent-id) ,@agent-details - (tags . ,(datastore-fetch-agent-tags - datastore - agent-id)) + (tags . ,(vector-map + (lambda (_ tag) + (match tag + ((key . value) + `((key . ,key) + (value . ,value))))) + (datastore-fetch-agent-tags + datastore + agent-id))) (allocated_builds . ,(list->vector (datastore-list-agent-builds datastore @@ -232,9 +245,14 @@ (let ((agent-details (datastore-find-agent datastore agent-id))) (if agent-details (begin - (datastore-replace-agent-tags datastore - agent-id - (assoc-ref body "tags")) + (datastore-replace-agent-tags + datastore + agent-id + (vector-map + (lambda (_ tag) + `((key . ,(assoc-ref tag "key")) + (value . ,(assoc-ref tag "value")))) + (assoc-ref body "tags"))) (render-json `((result . success)))) (render-json @@ -452,17 +470,11 @@ '()) ,@(if (null? tags) '() - `((tags . ,(list->vector - (map (match-lambda - ((key . value) - `((key . ,key) - (value . ,value)))) - tags))))) + `((tags . ,(list->vector tags)))) ,@(if defer-until `((defer-until . ,(date->string defer-until "~1 ~3"))) '())))) - (define (send-cancel-build-request coordinator-uri build-id) @@ -488,7 +500,8 @@ `(,@(if (null? tags) '() (map (match-lambda - ((key . value) + ((('key . key) + ('value . value)) (simple-format #f "tag=~A:~A" key value)) (key (simple-format #f "tag=~A" key))) @@ -496,7 +509,8 @@ ,@(if (null? not-tags) '() (map (match-lambda - ((key . value) + ((('key . key) + ('value . value)) (simple-format #f "not_tag=~A:~A" key value)) (key (simple-format #f "not_tag=~A" key))) |