Fix histogram metrics

Properly write a _sum and _count line, and sort the lines correctly.
This commit is contained in:
Christopher Baines 2020-12-10 09:21:07 +00:00
parent 2549c482fb
commit 875d9994b0

View file

@ -153,6 +153,13 @@ list of label names to be permitted for this metric and
histogram-metric-type? histogram-metric-type?
(buckets histogram-metric-type-buckets)) (buckets histogram-metric-type-buckets))
(define-record-type <histogram-values>
(make-histogram-values buckets sum count)
histogram-values?
(buckets histogram-values-buckets)
(sum histogram-values-sum set-histogram-values-sum!)
(count histogram-values-count set-histogram-values-count!))
(define %default-histogram-buckets (define %default-histogram-buckets
;; The default buckets used in other client libraries ;; The default buckets used in other client libraries
(list 0.005 0.01 0.025 0.05 0.1 0.25 0.5 1 2.5 5 10 (inf))) (list 0.005 0.01 0.025 0.05 0.1 0.25 0.5 1 2.5 5 10 (inf)))
@ -316,31 +323,38 @@ values are the values."
(metric-values metric))) (metric-values metric)))
(with-mutex (metric-mutex metric) (with-mutex (metric-mutex metric)
(let ((sum-labels (let* ((buckets
`(,@canonical-labels (histogram-metric-type-buckets (metric-type metric)))
(le . "sum")))) (histogram-values-record
(or (hash-ref hash canonical-labels)
(let ((new-record (make-histogram-values (make-vector
(length buckets)
0)
0
0)))
(hash-set! hash canonical-labels new-record)
new-record))))
(hash-set! hash (set-histogram-values-sum! histogram-values-record
sum-labels (+ value
(+ value (histogram-values-sum
(or (hash-ref hash sum-labels) histogram-values-record)))
0)))) (set-histogram-values-count! histogram-values-record
(+ 1
(let ((buckets (histogram-metric-type-buckets (metric-type metric)))) (histogram-values-count
(for-each histogram-values-record)))
(lambda (bucket-upper-limit) (let ((bucket-values-vector (histogram-values-buckets
(when (<= value bucket-upper-limit) histogram-values-record)))
(let ((bucket-labels (for-each
`(,@canonical-labels (lambda (index bucket-upper-limit)
(le . ,(if (inf? bucket-upper-limit) (when (<= value bucket-upper-limit)
"+Inf" (vector-set! bucket-values-vector
(number->string bucket-upper-limit)))))) index
(hash-set! hash (+ 1
bucket-labels (vector-ref bucket-values-vector
(+ 1 index)))))
(or (hash-ref hash bucket-labels) (iota (length buckets))
0)))))) buckets))))))
buckets)))))
(define* (call-with-duration-metric registry metric-name thunk (define* (call-with-duration-metric registry metric-name thunk
#:key #:key
@ -379,6 +393,32 @@ the standard text based exposition format.
Usually, this would be in response to a HTTP request from Prometheus Usually, this would be in response to a HTTP request from Prometheus
so that it can receive and store the metric values." so that it can receive and store the metric values."
(define (write-line name label-values value)
(format
port
"~a~a ~f\n"
name
(if (null? label-values)
""
(string-append
"{"
(string-join (map
(match-lambda
((label . (? number? value))
(format
#f
"~a=\"~f\""
label value))
((label . value)
(format
#f
"~a=\"~a\""
label value)))
label-values)
",")
"}"))
value))
(hash-for-each (hash-for-each
(lambda (name metric) (lambda (name metric)
(let ((full-name (let ((full-name
@ -387,7 +427,8 @@ so that it can receive and store the metric values."
(lambda (namespace) (lambda (namespace)
(string-append namespace "_"))) (string-append namespace "_")))
"") "")
name))) name))
(type (metric-type metric)))
(and=> (metric-docstring metric) (and=> (metric-docstring metric)
(lambda (docstring) (lambda (docstring)
@ -399,37 +440,37 @@ so that it can receive and store the metric values."
(simple-format port "# TYPE ~A ~A\n" (simple-format port "# TYPE ~A ~A\n"
full-name full-name
(match (metric-type metric) (match type
((? histogram-metric-type? type) 'histogram) ((? histogram-metric-type? type) 'histogram)
(type type))) (type type)))
(hash-for-each (cond
(lambda (label-values value) ((histogram-metric-type? type)
(format (let ((buckets (histogram-metric-type-buckets type)))
port (hash-for-each
"~a~a ~f\n" (lambda (label-values value)
full-name (for-each (lambda (index bucket)
(if (null? label-values) (write-line full-name
"" `(,@label-values
(string-append (le . ,(if (inf? bucket)
"{" "+Inf"
(string-join (map (format #f "~f" bucket))))
(match-lambda (vector-ref (histogram-values-buckets value)
((label . (? number? value)) index)))
(format (iota (length buckets))
#f buckets)
"~a=\"~f\"" (write-line (string-append full-name "_sum")
label value)) label-values
((label . value) (histogram-values-sum value))
(format (write-line (string-append full-name "_count")
#f label-values
"~a=\"~a\"" (histogram-values-count value)))
label value))) (metric-values metric))))
label-values) (else
",") (hash-for-each
"}")) (lambda (label-values value)
value)) (write-line full-name label-values value))
(metric-values metric)))) (metric-values metric))))))
(metrics-registry-metrics-hash registry))) (metrics-registry-metrics-hash registry)))
(define (write-textfile registry filename) (define (write-textfile registry filename)