[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/05: Instrument handling build events
|
From: |
Christopher Baines |
|
Subject: |
01/05: Instrument handling build events |
|
Date: |
Tue, 5 Dec 2023 16:11:11 -0500 (EST) |
cbaines pushed a commit to branch master
in repository data-service.
commit 241a704db15d36153b21d43742290bf308d05869
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Nov 24 16:11:42 2023 +0000
Instrument handling build events
---
guix-data-service/web/build-server/controller.scm | 106 ++++++++++++----------
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 ()