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
(lambda (resource) exp ...)))
(define (resource-pool-stats pool)
(let ((reply (make-channel)))
(put-message pool `(stats ,reply))
(get-message reply)))
(define* (resource-pool-stats pool #:key (timeout 5))
(let ((reply (make-channel))
(start-time (get-internal-real-time)))
(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)
(let ((reply (make-channel)))

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

@ -208,29 +208,83 @@
(lambda ()
(letpar& ((metric-values
(with-exception-handler
(lambda (exn)
(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
(with-exception-handler
(lambda (exn)
(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
(with-exception-handler
(lambda (exn)
(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
(with-exception-handler
(lambda (exn)
(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
(with-exception-handler
(lambda (exn)
(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
(with-exception-handler
(lambda (exn)
(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)))
select-load-new-guix-revision-job-metrics))
#:unwind? #t)))
(for-each
(match-lambda
@ -243,7 +297,16 @@
value
#:label-values
`((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)
(for-each (match-lambda
@ -261,12 +324,14 @@
toast-bytes
#:label-values `((name . ,name)
(tablespace . ,tablespace)))))
metric-values)
(or metric-values '()))
(when guix-revisions-count
(metric-set revisions-count-metric
guix-revisions-count)
guix-revisions-count))
(map (lambda (field-values)
(for-each
(lambda (field-values)
(let ((name (assq-ref field-values 'name)))
(for-each
(match-lambda
@ -278,9 +343,10 @@
value
#:label-values `((name . ,name))))))
field-values)))
pg-stat-user-tables-metrics)
(or pg-stat-user-tables-metrics '()))
(map (lambda (field-values)
(for-each
(lambda (field-values)
(let ((name (assq-ref field-values 'name))
(table-name (assq-ref field-values 'table-name))
(tablespace (assq-ref field-values 'tablespace)))
@ -301,9 +367,10 @@
`((tablespace . ,tablespace))
'()))))))
field-values)))
pg-stat-user-indexes-metrics)
(or pg-stat-user-indexes-metrics '()))
(map (lambda (field-values)
(for-each
(lambda (field-values)
(let ((table (assq-ref field-values 'table-name))
(column (assq-ref field-values 'column-name)))
(for-each
@ -319,7 +386,7 @@
#:label-values `((table . ,table)
(column . ,column))))))
field-values)))
pg-stats-metric-values)
(or pg-stats-metric-values '()))
(for-each (match-lambda
((repository-label state count)
@ -329,7 +396,7 @@
#:label-values
`((repository_label . ,repository-label)
(state . ,state)))))
load-new-guix-revision-job-metrics)
(or load-new-guix-revision-job-metrics '()))
(gc-metrics-updater)
(guile-time-metrics-updater)