diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index a7ed02c..de7ba7c 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -209,6 +209,17 @@ (metric-set internal-run-time (get-internal-run-time))))) + (define (with-statement-timeout conn proc) + (with-postgresql-transaction + conn + (lambda (conn) + (exec-query + conn + (simple-format #f "SET statement_timeout = ~A" 6000)) + + (proc conn)) + #:always-rollback? #t)) + (lambda () (letpar& ((metric-values (with-exception-handler @@ -221,7 +232,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - fetch-high-level-table-size-metrics)) + (lambda (conn) + (with-statement-timeout + conn + fetch-high-level-table-size-metrics)))) #:unwind? #t)) (guix-revisions-count (with-exception-handler @@ -234,7 +248,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - count-guix-revisions)) + (lambda (conn) + (with-statement-timeout + conn + count-guix-revisions)))) #:unwind? #t)) (pg-stat-user-tables-metrics (with-exception-handler @@ -247,7 +264,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - fetch-pg-stat-user-tables-metrics)) + (lambda (conn) + (with-statement-timeout + conn + fetch-pg-stat-user-tables-metrics)))) #:unwind? #t)) (pg-stat-user-indexes-metrics (with-exception-handler @@ -260,7 +280,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - fetch-pg-stat-user-indexes-metrics)) + (lambda (conn) + (with-statement-timeout + conn + fetch-pg-stat-user-indexes-metrics)))) #:unwind? #t)) (pg-stats-metric-values (with-exception-handler @@ -273,7 +296,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - fetch-pg-stats-metrics)) + (lambda (conn) + (with-statement-timeout + conn + fetch-pg-stats-metrics)))) #:unwind? #t)) (load-new-guix-revision-job-metrics (with-exception-handler @@ -286,7 +312,10 @@ (lambda () (call-with-resource-from-pool (reserved-connection-pool) - select-load-new-guix-revision-job-metrics)) + (lambda (conn) + (with-statement-timeout + conn + select-load-new-guix-revision-job-metrics)))) #:unwind? #t))) (for-each @@ -785,7 +814,9 @@ #:sxml (view-statistics guix-revisions-count count-derivations)))) (('GET "metrics") - (render-metrics)) + (parameterize + ((resource-pool-default-timeout 6)) + (render-metrics))) (('GET "revision" args ...) (delegate-to revision-controller)) (('GET "repositories")