Stop using a pool of threads for database operations
Now that squee cooperates with suspendable ports, this is unnecessary. Use a connection pool to still support running queries in parallel using multiple connections.
This commit is contained in:
parent
672ee6216e
commit
7251c7d653
15 changed files with 1292 additions and 1310 deletions
|
|
@ -30,6 +30,7 @@
|
|||
#:use-module (guix-data-service web util)
|
||||
#:use-module (guix-data-service web render)
|
||||
#:use-module (guix-data-service web query-parameters)
|
||||
#:use-module (guix-data-service web controller)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:use-module (guix-data-service comparison)
|
||||
#:use-module (guix-data-service jobs load-new-guix-revision)
|
||||
|
|
@ -55,42 +56,38 @@
|
|||
s)
|
||||
|
||||
(define (parse-commit s)
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(let* ((job-details
|
||||
(select-job-for-commit conn s))
|
||||
(job-state
|
||||
(assq-ref job-details 'state)))
|
||||
(if job-details
|
||||
(cond
|
||||
((string=? job-state "succeeded")
|
||||
s)
|
||||
((string=? job-state "queued")
|
||||
(make-invalid-query-parameter
|
||||
s
|
||||
`("data unavailable, "
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" s)))
|
||||
"yet to process revision"))))
|
||||
((string=? job-state "failed")
|
||||
(make-invalid-query-parameter
|
||||
s
|
||||
`("data unavailable, "
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" s)))
|
||||
"failed to process revision"))))
|
||||
(else
|
||||
(make-invalid-query-parameter
|
||||
s "unknown job state")))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(let* ((job-details
|
||||
(select-job-for-commit conn s))
|
||||
(job-state
|
||||
(assq-ref job-details 'state)))
|
||||
(if job-details
|
||||
(cond
|
||||
((string=? job-state "succeeded")
|
||||
s)
|
||||
((string=? job-state "queued")
|
||||
(make-invalid-query-parameter
|
||||
s "unknown commit")))))))
|
||||
s
|
||||
`("data unavailable, "
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" s)))
|
||||
"yet to process revision"))))
|
||||
((string=? job-state "failed")
|
||||
(make-invalid-query-parameter
|
||||
s
|
||||
`("data unavailable, "
|
||||
(a (@ (href ,(string-append
|
||||
"/revision/" s)))
|
||||
"failed to process revision"))))
|
||||
(else
|
||||
(make-invalid-query-parameter
|
||||
s "unknown job state")))
|
||||
(make-invalid-query-parameter
|
||||
s "unknown commit")))))
|
||||
|
||||
(define (parse-derivation file-name)
|
||||
(if (parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-derivation-by-file-name conn file-name))))
|
||||
(if (with-resource-from-pool (connection-pool) conn
|
||||
(select-derivation-by-file-name conn file-name))
|
||||
file-name
|
||||
(make-invalid-query-parameter
|
||||
file-name "unknown derivation")))
|
||||
|
|
@ -235,18 +232,16 @@
|
|||
(letpar& ((base-job
|
||||
(match (assq-ref query-parameters 'base_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(and (string? value)
|
||||
(select-job-for-commit conn value)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(and (string? value)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f)))
|
||||
(target-job
|
||||
(match (assq-ref query-parameters 'target_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(and (string? value)
|
||||
(select-job-for-commit conn value)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(and (string? value)
|
||||
(select-job-for-commit conn value))))
|
||||
(_ #f))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
|
|
@ -281,28 +276,24 @@
|
|||
#f
|
||||
#f)))))
|
||||
(letpar& ((base-revision-id
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(commit->revision-id
|
||||
conn
|
||||
(assq-ref query-parameters 'base_commit)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(commit->revision-id
|
||||
conn
|
||||
(assq-ref query-parameters 'base_commit))))
|
||||
(target-revision-id
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(commit->revision-id
|
||||
conn
|
||||
(assq-ref query-parameters 'target_commit)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(commit->revision-id
|
||||
conn
|
||||
(assq-ref query-parameters 'target_commit))))
|
||||
(locale
|
||||
(assq-ref query-parameters 'locale)))
|
||||
(let-values
|
||||
(((base-packages-vhash target-packages-vhash)
|
||||
(package-data->package-data-vhashes
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))
|
||||
(let ((new-packages
|
||||
(package-data-vhashes->new-packages base-packages-vhash
|
||||
target-packages-vhash))
|
||||
|
|
@ -313,20 +304,18 @@
|
|||
(package-data-version-changes base-packages-vhash
|
||||
target-packages-vhash)))
|
||||
(letpar& ((lint-warnings-data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(group-list-by-first-n-fields
|
||||
2
|
||||
(lint-warning-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id
|
||||
locale)))))
|
||||
(channel-news-data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(channel-news-differences-data conn
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(group-list-by-first-n-fields
|
||||
2
|
||||
(lint-warning-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))
|
||||
target-revision-id
|
||||
locale))))
|
||||
(channel-news-data
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(channel-news-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
|
|
@ -412,18 +401,16 @@
|
|||
(match-lambda
|
||||
((locale)
|
||||
locale))
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(lint-warning-message-locales-for-revision
|
||||
conn
|
||||
(assq-ref query-parameters 'target_commit))))))
|
||||
(cgit-url-bases
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(guix-revisions-cgit-url-bases
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(lint-warning-message-locales-for-revision
|
||||
conn
|
||||
(list base-revision-id
|
||||
target-revision-id))))))
|
||||
(assq-ref query-parameters 'target_commit)))))
|
||||
(cgit-url-bases
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(guix-revisions-cgit-url-bases
|
||||
conn
|
||||
(list base-revision-id
|
||||
target-revision-id)))))
|
||||
(render-html
|
||||
#:sxml (compare query-parameters
|
||||
'revision
|
||||
|
|
@ -463,29 +450,26 @@
|
|||
(target-datetime (assq-ref query-parameters 'target_datetime))
|
||||
(locale (assq-ref query-parameters 'locale)))
|
||||
(letpar& ((base-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime
|
||||
conn
|
||||
base-branch
|
||||
base-datetime))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime
|
||||
conn
|
||||
base-branch
|
||||
base-datetime)))
|
||||
(target-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime
|
||||
conn
|
||||
target-branch
|
||||
target-datetime)))))
|
||||
(letpar& ((lint-warnings-locale-options
|
||||
(map
|
||||
(match-lambda
|
||||
((locale)
|
||||
locale))
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(lint-warning-message-locales-for-revision
|
||||
conn
|
||||
(second base-revision-details)))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime
|
||||
conn
|
||||
target-branch
|
||||
target-datetime))))
|
||||
(let ((lint-warnings-locale-options
|
||||
(map
|
||||
(match-lambda
|
||||
((locale)
|
||||
locale))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(lint-warning-message-locales-for-revision
|
||||
conn
|
||||
(second base-revision-details))))))
|
||||
(let ((base-revision-id
|
||||
(first base-revision-details))
|
||||
(target-revision-id
|
||||
|
|
@ -493,12 +477,10 @@
|
|||
(let-values
|
||||
(((base-packages-vhash target-packages-vhash)
|
||||
(package-data->package-data-vhashes
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))
|
||||
(let* ((new-packages
|
||||
(package-data-vhashes->new-packages base-packages-vhash
|
||||
target-packages-vhash))
|
||||
|
|
@ -509,12 +491,10 @@
|
|||
(package-data-version-changes base-packages-vhash
|
||||
target-packages-vhash))
|
||||
(channel-news-data
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(channel-news-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(channel-news-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
|
|
@ -567,32 +547,29 @@
|
|||
#:extra-headers http-headers-for-unchanging-content))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (compare `(,@query-parameters
|
||||
(base_commit . ,(second base-revision-details))
|
||||
(target_commit . ,(second target-revision-details)))
|
||||
'datetime
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(guix-revisions-cgit-url-bases
|
||||
conn
|
||||
(list base-revision-id
|
||||
target-revision-id)))))
|
||||
new-packages
|
||||
removed-packages
|
||||
version-changes
|
||||
(parallel-via-thread-pool-channel
|
||||
(group-list-by-first-n-fields
|
||||
2
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(lint-warning-differences-data
|
||||
conn
|
||||
base-revision-id
|
||||
target-revision-id
|
||||
locale)))))
|
||||
lint-warnings-locale-options
|
||||
channel-news-data)
|
||||
#:sxml (compare
|
||||
`(,@query-parameters
|
||||
(base_commit . ,(second base-revision-details))
|
||||
(target_commit . ,(second target-revision-details)))
|
||||
'datetime
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(guix-revisions-cgit-url-bases
|
||||
conn
|
||||
(list base-revision-id
|
||||
target-revision-id)))
|
||||
new-packages
|
||||
removed-packages
|
||||
version-changes
|
||||
(group-list-by-first-n-fields
|
||||
2
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(lint-warning-differences-data
|
||||
conn
|
||||
base-revision-id
|
||||
target-revision-id
|
||||
locale)))
|
||||
lint-warnings-locale-options
|
||||
channel-news-data)
|
||||
#:extra-headers http-headers-for-unchanging-content)))))))))))
|
||||
|
||||
(define (render-compare/derivation mime-types
|
||||
|
|
@ -612,12 +589,11 @@
|
|||
|
||||
(let ((base-derivation (assq-ref query-parameters 'base_derivation))
|
||||
(target-derivation (assq-ref query-parameters 'target_derivation)))
|
||||
(letpar& ((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(derivation-differences-data conn
|
||||
base-derivation
|
||||
target-derivation)))))
|
||||
(let ((data
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(derivation-differences-data conn
|
||||
base-derivation
|
||||
target-derivation))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
|
|
@ -655,9 +631,8 @@
|
|||
((? string? value) value)
|
||||
(_ #f))
|
||||
(lambda (commit)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn commit))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-job-for-commit conn commit)))))
|
||||
(target-job
|
||||
(and=> (match (assq-ref query-parameters 'target_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
|
|
@ -665,9 +640,8 @@
|
|||
((? string? value) value)
|
||||
(_ #f))
|
||||
(lambda (commit)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn commit)))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-job-for-commit conn commit))))))
|
||||
(render-json
|
||||
`((error . "invalid query")
|
||||
(query_parameters
|
||||
|
|
@ -690,14 +664,14 @@
|
|||
(target_job . ,target-job)))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection
|
||||
list-systems))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
list-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection
|
||||
valid-targets))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
valid-targets))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
select-build-server-urls-by-id)))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
select-build-server-urls-by-id)))
|
||||
(render-html
|
||||
#:sxml (compare/package-derivations
|
||||
query-parameters
|
||||
|
|
@ -718,19 +692,18 @@
|
|||
(after-name (assq-ref query-parameters 'after_name))
|
||||
(limit-results (assq-ref query-parameters 'limit_results)))
|
||||
(letpar& ((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(package-derivation-differences-data
|
||||
conn
|
||||
(commit->revision-id conn base-commit)
|
||||
(commit->revision-id conn target-commit)
|
||||
#:systems systems
|
||||
#:targets targets
|
||||
#:build-change build-change
|
||||
#:after-name after-name
|
||||
#:limit-results limit-results))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(package-derivation-differences-data
|
||||
conn
|
||||
(commit->revision-id conn base-commit)
|
||||
(commit->revision-id conn target-commit)
|
||||
#:systems systems
|
||||
#:targets targets
|
||||
#:build-change build-change
|
||||
#:after-name after-name
|
||||
#:limit-results limit-results)))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
select-build-server-urls-by-id)))
|
||||
(let ((names-and-versions
|
||||
(package-derivation-data->names-and-versions data)))
|
||||
|
|
@ -755,11 +728,11 @@
|
|||
. ,derivation-changes))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection
|
||||
list-systems))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
list-systems))
|
||||
(targets
|
||||
(with-thread-postgresql-connection
|
||||
valid-targets)))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
valid-targets)))
|
||||
(render-html
|
||||
#:sxml (compare/package-derivations
|
||||
query-parameters
|
||||
|
|
@ -784,11 +757,11 @@
|
|||
#:sxml (compare/package-derivations
|
||||
query-parameters
|
||||
'datetime
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection list-systems))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
list-systems)
|
||||
(valid-targets->options
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection valid-targets)))
|
||||
(call-with-resource-from-pool (connection-pool)
|
||||
valid-targets))
|
||||
build-status-strings
|
||||
'()
|
||||
'()
|
||||
|
|
@ -807,30 +780,27 @@
|
|||
(limit-results (assq-ref query-parameters 'limit_results)))
|
||||
(letpar&
|
||||
((base-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
base-branch
|
||||
base-datetime))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
base-branch
|
||||
base-datetime)))
|
||||
(target-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
target-branch
|
||||
target-datetime)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
target-branch
|
||||
target-datetime))))
|
||||
(letpar&
|
||||
((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(package-derivation-differences-data
|
||||
conn
|
||||
(first base-revision-details)
|
||||
(first target-revision-details)
|
||||
#:systems systems
|
||||
#:targets targets
|
||||
#:build-change build-change
|
||||
#:after-name after-name
|
||||
#:limit-results limit-results)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(package-derivation-differences-data
|
||||
conn
|
||||
(first base-revision-details)
|
||||
(first target-revision-details)
|
||||
#:systems systems
|
||||
#:targets targets
|
||||
#:build-change build-change
|
||||
#:after-name after-name
|
||||
#:limit-results limit-results))))
|
||||
(let ((names-and-versions
|
||||
(package-derivation-data->names-and-versions data)))
|
||||
(let-values
|
||||
|
|
@ -859,15 +829,17 @@
|
|||
#:sxml (compare/package-derivations
|
||||
query-parameters
|
||||
'datetime
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection list-systems))
|
||||
(call-with-resource-from-pool
|
||||
(connection-pool)
|
||||
list-systems)
|
||||
(valid-targets->options
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection valid-targets)))
|
||||
(call-with-resource-from-pool
|
||||
(connection-pool)
|
||||
valid-targets))
|
||||
build-status-strings
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
select-build-server-urls-by-id))
|
||||
(call-with-resource-from-pool
|
||||
(connection-pool)
|
||||
select-build-server-urls-by-id)
|
||||
derivation-changes
|
||||
base-revision-details
|
||||
target-revision-details))))))))))))
|
||||
|
|
@ -894,16 +866,14 @@
|
|||
(letpar& ((base-job
|
||||
(match (assq-ref query-parameters 'base_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-job-for-commit conn value)))
|
||||
(_ #f)))
|
||||
(target-job
|
||||
(match (assq-ref query-parameters 'target_commit)
|
||||
(($ <invalid-query-parameter> value)
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-job-for-commit conn value))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-job-for-commit conn value)))
|
||||
(_ #f))))
|
||||
(render-html
|
||||
#:sxml (compare-invalid-parameters
|
||||
|
|
@ -914,26 +884,22 @@
|
|||
(let ((base-commit (assq-ref query-parameters 'base_commit))
|
||||
(target-commit (assq-ref query-parameters 'target_commit)))
|
||||
(letpar& ((base-revision-id
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(commit->revision-id
|
||||
conn
|
||||
base-commit))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(commit->revision-id
|
||||
conn
|
||||
base-commit)))
|
||||
(target-revision-id
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(commit->revision-id
|
||||
conn
|
||||
target-commit)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(commit->revision-id
|
||||
conn
|
||||
target-commit))))
|
||||
(let-values
|
||||
(((base-packages-vhash target-packages-vhash)
|
||||
(package-data->package-data-vhashes
|
||||
(parallel-via-thread-pool-channel
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(package-differences-data conn
|
||||
base-revision-id
|
||||
target-revision-id)))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
|
|
@ -967,10 +933,10 @@
|
|||
'((error . "invalid query"))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
list-systems))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
select-build-server-urls-by-id)))
|
||||
(render-html
|
||||
#:sxml (compare/system-test-derivations
|
||||
|
|
@ -986,26 +952,23 @@
|
|||
(target-commit (assq-ref query-parameters 'target_commit))
|
||||
(system (assq-ref query-parameters 'system)))
|
||||
(letpar& ((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(system-test-derivations-differences-data
|
||||
conn
|
||||
(commit->revision-id conn base-commit)
|
||||
(commit->revision-id conn target-commit)
|
||||
system))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(system-test-derivations-differences-data
|
||||
conn
|
||||
(commit->revision-id conn base-commit)
|
||||
(commit->revision-id conn target-commit)
|
||||
system)))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
select-build-server-urls-by-id))
|
||||
(base-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit conn base-commit))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(git-repositories-containing-commit conn base-commit)))
|
||||
(target-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit conn target-commit))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(git-repositories-containing-commit conn target-commit)))
|
||||
(systems
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
list-systems)))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
|
|
@ -1040,10 +1003,10 @@
|
|||
'((error . "invalid query"))))
|
||||
(else
|
||||
(letpar& ((systems
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
list-systems))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
select-build-server-urls-by-id)))
|
||||
(render-html
|
||||
#:sxml (compare/system-test-derivations
|
||||
|
|
@ -1062,42 +1025,37 @@
|
|||
(system (assq-ref query-parameters 'system)))
|
||||
(letpar&
|
||||
((base-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
base-branch
|
||||
base-datetime))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
base-branch
|
||||
base-datetime)))
|
||||
(target-revision-details
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
target-branch
|
||||
target-datetime)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(select-guix-revision-for-branch-and-datetime conn
|
||||
target-branch
|
||||
target-datetime))))
|
||||
(letpar& ((data
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(system-test-derivations-differences-data
|
||||
conn
|
||||
(first base-revision-details)
|
||||
(first target-revision-details)
|
||||
system))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(system-test-derivations-differences-data
|
||||
conn
|
||||
(first base-revision-details)
|
||||
(first target-revision-details)
|
||||
system)))
|
||||
(build-server-urls
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
select-build-server-urls-by-id))
|
||||
(base-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit
|
||||
conn
|
||||
(second base-revision-details)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(git-repositories-containing-commit
|
||||
conn
|
||||
(second base-revision-details))))
|
||||
(target-git-repositories
|
||||
(with-thread-postgresql-connection
|
||||
(lambda (conn)
|
||||
(git-repositories-containing-commit
|
||||
conn
|
||||
(second target-revision-details)))))
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
(git-repositories-containing-commit
|
||||
conn
|
||||
(second target-revision-details))))
|
||||
(systems
|
||||
(with-thread-postgresql-connection
|
||||
(with-resource-from-pool (connection-pool) conn
|
||||
list-systems)))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue