aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service/web
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-11-24 16:11:42 +0000
committerChristopher Baines <mail@cbaines.net>2023-11-24 16:11:42 +0000
commit241a704db15d36153b21d43742290bf308d05869 (patch)
tree01ff132bc68cd79b589b25c199eb6831c23454c2 /guix-data-service/web
parente13febc81706fbfb7f073bc4e9ce73fbc80d5180 (diff)
downloaddata-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.scm106
-rw-r--r--guix-data-service/web/server.scm9
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 ()