Don't use the reserved pool for HTML/JSON responses

Just use it for providing substitutes.
This commit is contained in:
Christopher Baines 2024-09-08 12:58:39 +01:00
parent 395d0b2bd0
commit 53ddb26300

View file

@ -457,22 +457,22 @@
(define (render-derivation derivation-file-name) (define (render-derivation derivation-file-name)
(letpar& ((derivation (letpar& ((derivation
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-by-file-name conn derivation-file-name)))) (select-derivation-by-file-name conn derivation-file-name))))
(if derivation (if derivation
(letpar& ((derivation-inputs (letpar& ((derivation-inputs
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-inputs-by-derivation-id (select-derivation-inputs-by-derivation-id
conn conn
(first derivation)))) (first derivation))))
(derivation-outputs (derivation-outputs
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-outputs-by-derivation-id (select-derivation-outputs-by-derivation-id
conn conn
(first derivation)))) (first derivation))))
(builds (builds
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-builds-with-context-by-derivation-file-name (select-builds-with-context-by-derivation-file-name
conn conn
(second derivation))))) (second derivation)))))
@ -491,7 +491,7 @@
(define (render-json-derivation derivation-file-name) (define (render-json-derivation derivation-file-name)
(let ((derivation (let ((derivation
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-by-file-name conn (select-derivation-by-file-name conn
derivation-file-name)))) derivation-file-name))))
(if derivation (if derivation
@ -597,11 +597,11 @@
(define (render-store-item filename) (define (render-store-item filename)
(letpar& ((derivation (letpar& ((derivation
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-by-output-filename conn filename)))) (select-derivation-by-output-filename conn filename))))
(match derivation (match derivation
(() (()
(match (with-resource-from-pool (reserved-connection-pool) conn (match (with-resource-from-pool (connection-pool) conn
(select-derivation-source-file-by-store-path conn filename)) (select-derivation-source-file-by-store-path conn filename))
(() (()
(render-html (render-html
@ -613,17 +613,17 @@
(render-html (render-html
#:sxml (view-derivation-source-file #:sxml (view-derivation-source-file
filename filename
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-derivation-source-file-nar-details-by-file-name (select-derivation-source-file-nar-details-by-file-name
conn conn
filename))) filename)))
#:extra-headers http-headers-for-unchanging-content)))) #:extra-headers http-headers-for-unchanging-content))))
(derivations (derivations
(letpar& ((nars (letpar& ((nars
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-nars-for-output conn filename))) (select-nars-for-output conn filename)))
(builds (builds
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(select-builds-with-context-by-derivation-output (select-builds-with-context-by-derivation-output
conn conn
filename)))) filename))))
@ -840,7 +840,7 @@
(('GET) (('GET)
(render-html (render-html
#:sxml (index #:sxml (index
(with-resource-from-pool (reserved-connection-pool) conn (with-resource-from-pool (connection-pool) conn
(map (map
(lambda (git-repository-details) (lambda (git-repository-details)
(cons (cons