diff options
Diffstat (limited to 'guix-data-service/web/server.scm')
| -rw-r--r-- | guix-data-service/web/server.scm | 66 |
1 files changed, 57 insertions, 9 deletions
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index 1c0bce1..6e91809 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -35,6 +35,7 @@ #:use-module (guix-data-service database) #:use-module (guix-data-service web controller) #:use-module (guix-data-service web util) + #:use-module (guix-data-service model guix-revision-package-derivation) #:export (%guix-data-service-metrics-registry start-guix-data-service-web-server)) @@ -48,12 +49,25 @@ #t) #f)) -(define (handler request body controller secret-key-base startup-completed +(define (handler request finished? + body controller secret-key-base startup-completed render-metrics) - (display - (format #f "~a ~a\n" - (request-method request) - (uri-path (request-uri request)))) + (with-exception-handler + (lambda (exn) + (with-exception-handler + (lambda _ #f) + (lambda () + (simple-format (current-error-port) + "exception when logging: ~A\n" exn)) + #:unwind? #t) + ;; If we can't log, exit + (signal-condition! finished?)) + (lambda () + (display + (format #f "~a ~a\n" + (request-method request) + (uri-path (request-uri request))))) + #:unwind? #t) (apply values (let-values (((request-components mime-types) (request->path-components-and-mime-type request))) @@ -108,7 +122,11 @@ (open-postgresql-connection "web" postgresql-statement-timeout)) - (floor (/ postgresql-connections 2)))) + (floor (/ postgresql-connections 2)) + #:idle-seconds 30 + #:destructor + (lambda (conn) + (close-postgresql-connection conn "web")))) (reserved-connection-pool (make-resource-pool @@ -116,12 +134,40 @@ (open-postgresql-connection "web-reserved" postgresql-statement-timeout)) - (floor (/ postgresql-connections 2)))) + (floor (/ postgresql-connections 2)) + #:idle-seconds 600 + #:destructor + (lambda (conn) + (close-postgresql-connection conn "web-reserved")))) (resource-pool-default-timeout 5)) + (let ((resource-pool-checkout-failures-metric + (make-counter-metric registry + "resource_pool_checkout_timeouts_total" + #:labels '(pool_name)))) + (%resource-pool-timeout-handler + (lambda (pool proc timeout) + (let ((pool-name + (cond + ((eq? pool (connection-pool)) "normal") + ((eq? pool (reserved-connection-pool)) "reserved") + (else #f)))) + (when pool-name + (metric-increment + resource-pool-checkout-failures-metric + #:label-values `((pool_name . ,pool-name)))))))) + + (spawn-fiber + (lambda () + (with-resource-from-pool (connection-pool) conn + (backfill-guix-revision-package-derivation-distribution-counts + conn)))) + (let ((render-metrics - (make-render-metrics registry))) + (make-render-metrics registry)) + (requests-metric + (make-counter-metric registry "requests_total"))) (with-exception-handler (lambda (exn) @@ -137,7 +183,9 @@ port. Also, the port used can be changed by passing the --port option.\n" (lambda () (run-server/patched (lambda (request body) - (handler request body controller + (metric-increment requests-metric) + + (handler request finished? body controller secret-key-base startup-completed render-metrics)) |