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

Make fetching metrics work even when having database problems

Browse source
This commit is contained in:
Christopher Baines 2023-07-14 10:36:02 +01:00
parent f9bb60ab4a
commit 9dec45d2eb
2 changed files with 168 additions and 79 deletions
Download patch file Download diff file Expand all files Collapse all files

30
guix-data-service/utils.scm
View file

@ -273,10 +273,32 @@ available. Return the resource once PROC has returned."
pool pool
(lambda (resource) exp ...))) (lambda (resource) exp ...)))
(define (resource-pool-stats pool) (define* (resource-pool-stats pool #:key (timeout 5))
(let ((reply (make-channel))) (let ((reply (make-channel))
(put-message pool `(stats ,reply)) (start-time (get-internal-real-time)))
(get-message reply))) (perform-operation
(choice-operation
(wrap-operation
(put-operation pool `(stats ,reply))
(const #t))
(wrap-operation (sleep-operation timeout)
(const #f))))
(let ((time-remaining
(- timeout
(/ (- (get-internal-real-time)
start-time)
internal-time-units-per-second))))
(if (> time-remaining 0)
(let ((response
(perform-operation
(choice-operation
(get-operation reply)
(wrap-operation (sleep-operation time-remaining)
(const #f))))))
response)
(raise-exception
(make-resource-pool-timeout-error))))))
(define (defer-to-parallel-fiber thunk) (define (defer-to-parallel-fiber thunk)
(let ((reply (make-channel))) (let ((reply (make-channel)))

217
guix-data-service/web/controller.scm
View file

@ -208,29 +208,83 @@
(lambda () (lambda ()
(letpar& ((metric-values (letpar& ((metric-values
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
fetch-high-level-table-size-metrics)) (simple-format
(current-error-port)
"exception fetching table size metrics: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
fetch-high-level-table-size-metrics))
#:unwind? #t))
(guix-revisions-count (guix-revisions-count
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
count-guix-revisions)) (simple-format
(current-error-port)
"exception counting guix revisions: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
count-guix-revisions))
#:unwind? #t))
(pg-stat-user-tables-metrics (pg-stat-user-tables-metrics
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
fetch-pg-stat-user-tables-metrics)) (simple-format
(current-error-port)
"exception fetching pg_stat user table metrics: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
fetch-pg-stat-user-tables-metrics))
#:unwind? #t))
(pg-stat-user-indexes-metrics (pg-stat-user-indexes-metrics
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
fetch-pg-stat-user-indexes-metrics)) (simple-format
(current-error-port)
"exception fetching pg_stat user indexes metrics: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
fetch-pg-stat-user-indexes-metrics))
#:unwind? #t))
(pg-stats-metric-values (pg-stats-metric-values
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
fetch-pg-stats-metrics)) (simple-format
(current-error-port)
"exception fetching pg_stats metrics: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
fetch-pg-stats-metrics))
#:unwind? #t))
(load-new-guix-revision-job-metrics (load-new-guix-revision-job-metrics
(call-with-resource-from-pool (with-exception-handler
(reserved-connection-pool) (lambda (exn)
select-load-new-guix-revision-job-metrics))) (simple-format
(current-error-port)
"exception fetching load_new_guix_revision_job metrics: ~A\n"
exn)
#f)
(lambda ()
(call-with-resource-from-pool
(reserved-connection-pool)
select-load-new-guix-revision-job-metrics))
#:unwind? #t)))
(for-each (for-each
(match-lambda (match-lambda
@ -243,7 +297,16 @@
value value
#:label-values #:label-values
`((pool_name . ,name))))) `((pool_name . ,name)))))
(resource-pool-stats pool)))) (with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"exception fetching resource pool stats: ~A\n"
exn)
'())
(lambda ()
(resource-pool-stats pool))
#:unwind? #t))))
resource-pools) resource-pools)
(for-each (match-lambda (for-each (match-lambda
@ -261,65 +324,69 @@
toast-bytes toast-bytes
#:label-values `((name . ,name) #:label-values `((name . ,name)
(tablespace . ,tablespace))))) (tablespace . ,tablespace)))))
metric-values) (or metric-values '()))
(metric-set revisions-count-metric (when guix-revisions-count
guix-revisions-count) (metric-set revisions-count-metric
guix-revisions-count))
(map (lambda (field-values) (for-each
(let ((name (assq-ref field-values 'name))) (lambda (field-values)
(for-each (let ((name (assq-ref field-values 'name)))
(match-lambda (for-each
(('name . _) #f) (match-lambda
((field . value) (('name . _) #f)
(let ((metric (or (assq-ref pg-stat-metrics field) ((field . value)
(error field)))) (let ((metric (or (assq-ref pg-stat-metrics field)
(metric-set metric (error field))))
value (metric-set metric
#:label-values `((name . ,name)))))) value
field-values))) #:label-values `((name . ,name))))))
pg-stat-user-tables-metrics) field-values)))
(or pg-stat-user-tables-metrics '()))
(map (lambda (field-values) (for-each
(let ((name (assq-ref field-values 'name)) (lambda (field-values)
(table-name (assq-ref field-values 'table-name)) (let ((name (assq-ref field-values 'name))
(tablespace (assq-ref field-values 'tablespace))) (table-name (assq-ref field-values 'table-name))
(for-each (tablespace (assq-ref field-values 'tablespace)))
(match-lambda (for-each
(('name . _) #f) (match-lambda
(('table-name . _) #f) (('name . _) #f)
(('tablespace . _) #f) (('table-name . _) #f)
((field . value) (('tablespace . _) #f)
(let ((metric (or (assq-ref pg-stat-indexes-metrics field) ((field . value)
(error field)))) (let ((metric (or (assq-ref pg-stat-indexes-metrics field)
(metric-set metric (error field))))
value (metric-set metric
#:label-values value
`((name . ,name) #:label-values
(table . ,table-name) `((name . ,name)
,@(if (eq? field 'bytes) (table . ,table-name)
`((tablespace . ,tablespace)) ,@(if (eq? field 'bytes)
'())))))) `((tablespace . ,tablespace))
field-values))) '()))))))
pg-stat-user-indexes-metrics) field-values)))
(or pg-stat-user-indexes-metrics '()))
(map (lambda (field-values) (for-each
(let ((table (assq-ref field-values 'table-name)) (lambda (field-values)
(column (assq-ref field-values 'column-name))) (let ((table (assq-ref field-values 'table-name))
(for-each (column (assq-ref field-values 'column-name)))
(match-lambda (for-each
(('table-name . _) #f) (match-lambda
(('column-name . _) #f) (('table-name . _) #f)
((_ . #f) #f) (('column-name . _) #f)
((field . value) ((_ . #f) #f)
(let ((metric (or (assq-ref pg-stats-metrics field) ((field . value)
(error field)))) (let ((metric (or (assq-ref pg-stats-metrics field)
(metric-set metric (error field))))
value (metric-set metric
#:label-values `((table . ,table) value
(column . ,column)))))) #:label-values `((table . ,table)
field-values))) (column . ,column))))))
pg-stats-metric-values) field-values)))
(or pg-stats-metric-values '()))
(for-each (match-lambda (for-each (match-lambda
((repository-label state count) ((repository-label state count)
@ -329,7 +396,7 @@
#:label-values #:label-values
`((repository_label . ,repository-label) `((repository_label . ,repository-label)
(state . ,state))))) (state . ,state)))))
load-new-guix-revision-job-metrics) (or load-new-guix-revision-job-metrics '()))
(gc-metrics-updater) (gc-metrics-updater)
(guile-time-metrics-updater) (guile-time-metrics-updater)