cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Instrument handling build events

Browse source
This commit is contained in:
Christopher Baines 2023-11-24 16:11:42 +00:00
parent e13febc817
commit 241a704db1
2 changed files with 64 additions and 51 deletions
Download patch file Download diff file Expand all files Collapse all files

106
guix-data-service/web/build-server/controller.scm
View file

@ -21,9 +21,11 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (json) #:use-module (json)
#:use-module (fibers) #:use-module (fibers)
#:use-module (prometheus)
#:use-module (guix-data-service utils) #:use-module (guix-data-service utils)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service substitutes) #: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 render)
#:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web controller) #:use-module (guix-data-service web controller)
@ -255,56 +257,60 @@
(render-json (render-json
'((error . "no token provided")) '((error . "no token provided"))
#:code 400) #:code 400)
(let ((provided-token (assq-ref parsed-query-parameters 'token)) (call-with-duration-metric
(permitted-tokens (%guix-data-service-metrics-registry)
(with-resource-from-pool (reserved-connection-pool) conn "build_server_handle_events_submission_duration_seconds"
(compute-tokens-for-build-server conn (lambda ()
secret-key-base (let ((provided-token (assq-ref parsed-query-parameters 'token))
build-server-id)))) (permitted-tokens
(if (member provided-token (with-resource-from-pool (reserved-connection-pool) conn
(map cdr permitted-tokens) (compute-tokens-for-build-server conn
string=?) secret-key-base
(catch build-server-id))))
'json-invalid (if (member provided-token
(lambda () (map cdr permitted-tokens)
(let ((body-string (utf8->string body))) string=?)
(let* ((body-json (json-string->scm body-string)) (catch
(items (and=> (assoc-ref body-json "items") 'json-invalid
vector->list))) (lambda ()
(cond (let ((body-string (utf8->string body)))
((eq? items #f) (let* ((body-json (json-string->scm body-string))
(render-json (items (and=> (assoc-ref body-json "items")
'((error . "missing items key")) vector->list)))
#:code 400)) (cond
((null? items) ((eq? items #f)
(render-json (render-json
'((error . "no items to process")) '((error . "missing items key"))
#:code 400)) #:code 400))
(else ((null? items)
(catch (render-json
#t '((error . "no items to process"))
(lambda () #:code 400))
(process-items items) (else
(no-content)) (catch
(lambda (key . args) #t
(simple-format (current-error-port) (lambda ()
"error processing events: ~A: ~A\n" (process-items items)
key (no-content))
args) (lambda (key . args)
(for-each (lambda (item) (simple-format (current-error-port)
(simple-format (current-error-port) "error processing events: ~A: ~A\n"
" ~A\n" item)) key
items) args)
(render-json (for-each (lambda (item)
'((error . "could not process events")) (simple-format (current-error-port)
#:code 500)))))))) " ~A\n" item))
(lambda (key . args) items)
(render-json (render-json
'((error . "could not parse body as JSON")) '((error . "could not process events"))
#:code 400))) #:code 500))))))))
(render-json (lambda (key . args)
'((error . "error")) (render-json
#:code 403))))) '((error . "could not parse body as JSON"))
#:code 400)))
(render-json
'((error . "error"))
#:code 403)))))))
(define (handle-signing-key-request id) (define (handle-signing-key-request id)
(render-html (render-html

9
guix-data-service/web/server.scm
View file

@ -35,7 +35,9 @@
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service web controller) #:use-module (guix-data-service web controller)
#:use-module (guix-data-service web util) #: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) (define (check-startup-completed startup-completed)
(if (atomic-box-ref startup-completed) (if (atomic-box-ref startup-completed)
@ -64,6 +66,9 @@
(check-startup-completed startup-completed) (check-startup-completed startup-completed)
render-metrics)))) render-metrics))))
(define %guix-data-service-metrics-registry
(make-parameter #f))
(define* (start-guix-data-service-web-server port host secret-key-base (define* (start-guix-data-service-web-server port host secret-key-base
startup-completed startup-completed
#:key postgresql-statement-timeout #:key postgresql-statement-timeout
@ -73,6 +78,8 @@
(%database-metrics-registry registry) (%database-metrics-registry registry)
(%guix-data-service-metrics-registry registry)
(let ((finished? (make-condition))) (let ((finished? (make-condition)))
(call-with-sigint (call-with-sigint
(lambda () (lambda ()