diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-11-24 16:11:42 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-11-24 16:11:42 +0000 |
| commit | 241a704db15d36153b21d43742290bf308d05869 (patch) | |
| tree | 01ff132bc68cd79b589b25c199eb6831c23454c2 /guix-data-service/web | |
| parent | e13febc81706fbfb7f073bc4e9ce73fbc80d5180 (diff) | |
| download | data-service-241a704db15d36153b21d43742290bf308d05869.tar data-service-241a704db15d36153b21d43742290bf308d05869.tar.gz | |
Instrument handling build events
Diffstat (limited to 'guix-data-service/web')
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 106 | ||||
| -rw-r--r-- | guix-data-service/web/server.scm | 9 |
2 files changed, 64 insertions, 51 deletions
diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index 911e41d..df3f3d7 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -21,9 +21,11 @@ #:use-module (rnrs bytevectors) #:use-module (json) #:use-module (fibers) + #:use-module (prometheus) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service substitutes) + #:use-module (guix-data-service web server) #:use-module (guix-data-service web render) #:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web controller) @@ -255,56 +257,60 @@ (render-json '((error . "no token provided")) #:code 400) - (let ((provided-token (assq-ref parsed-query-parameters 'token)) - (permitted-tokens - (with-resource-from-pool (reserved-connection-pool) conn - (compute-tokens-for-build-server conn - secret-key-base - build-server-id)))) - (if (member provided-token - (map cdr permitted-tokens) - string=?) - (catch - 'json-invalid - (lambda () - (let ((body-string (utf8->string body))) - (let* ((body-json (json-string->scm body-string)) - (items (and=> (assoc-ref body-json "items") - vector->list))) - (cond - ((eq? items #f) - (render-json - '((error . "missing items key")) - #:code 400)) - ((null? items) - (render-json - '((error . "no items to process")) - #:code 400)) - (else - (catch - #t - (lambda () - (process-items items) - (no-content)) - (lambda (key . args) - (simple-format (current-error-port) - "error processing events: ~A: ~A\n" - key - args) - (for-each (lambda (item) - (simple-format (current-error-port) - " ~A\n" item)) - items) - (render-json - '((error . "could not process events")) - #:code 500)))))))) - (lambda (key . args) - (render-json - '((error . "could not parse body as JSON")) - #:code 400))) - (render-json - '((error . "error")) - #:code 403))))) + (call-with-duration-metric + (%guix-data-service-metrics-registry) + "build_server_handle_events_submission_duration_seconds" + (lambda () + (let ((provided-token (assq-ref parsed-query-parameters 'token)) + (permitted-tokens + (with-resource-from-pool (reserved-connection-pool) conn + (compute-tokens-for-build-server conn + secret-key-base + build-server-id)))) + (if (member provided-token + (map cdr permitted-tokens) + string=?) + (catch + 'json-invalid + (lambda () + (let ((body-string (utf8->string body))) + (let* ((body-json (json-string->scm body-string)) + (items (and=> (assoc-ref body-json "items") + vector->list))) + (cond + ((eq? items #f) + (render-json + '((error . "missing items key")) + #:code 400)) + ((null? items) + (render-json + '((error . "no items to process")) + #:code 400)) + (else + (catch + #t + (lambda () + (process-items items) + (no-content)) + (lambda (key . args) + (simple-format (current-error-port) + "error processing events: ~A: ~A\n" + key + args) + (for-each (lambda (item) + (simple-format (current-error-port) + " ~A\n" item)) + items) + (render-json + '((error . "could not process events")) + #:code 500)))))))) + (lambda (key . args) + (render-json + '((error . "could not parse body as JSON")) + #:code 400))) + (render-json + '((error . "error")) + #:code 403))))))) (define (handle-signing-key-request id) (render-html diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index 7acfb2b..ea14825 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -35,7 +35,9 @@ #:use-module (guix-data-service database) #:use-module (guix-data-service web controller) #:use-module (guix-data-service web util) - #:export (start-guix-data-service-web-server)) + #:export (%guix-data-service-metrics-registry + + start-guix-data-service-web-server)) (define (check-startup-completed startup-completed) (if (atomic-box-ref startup-completed) @@ -64,6 +66,9 @@ (check-startup-completed startup-completed) render-metrics)))) +(define %guix-data-service-metrics-registry + (make-parameter #f)) + (define* (start-guix-data-service-web-server port host secret-key-base startup-completed #:key postgresql-statement-timeout @@ -73,6 +78,8 @@ (%database-metrics-registry registry) + (%guix-data-service-metrics-registry registry) + (let ((finished? (make-condition))) (call-with-sigint (lambda () |