diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index e6ea566..8d7583f 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -236,19 +236,19 @@ query-parameters) (if (any-invalid-query-parameters? query-parameters) (fibers-let ((base-job - (match (assq-ref query-parameters 'base_commit) - (($ 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) - (($ value) - (with-resource-from-pool (connection-pool) conn - (and (string? value) - (select-job-for-commit conn value)))) - (_ #f)))) + (match (assq-ref query-parameters 'base_commit) + (($ 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) + (($ 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) mime-types) @@ -282,17 +282,17 @@ #f #f))))) (fibers-let ((base-revision-id - (with-resource-from-pool (connection-pool) conn - (commit->revision-id - conn - (assq-ref query-parameters 'base_commit)))) - (target-revision-id - (with-resource-from-pool (connection-pool) conn - (commit->revision-id - conn - (assq-ref query-parameters 'target_commit)))) - (locale - (assq-ref query-parameters 'locale))) + (with-resource-from-pool (connection-pool) conn + (commit->revision-id + conn + (assq-ref query-parameters 'base_commit)))) + (target-revision-id + (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 @@ -493,17 +493,17 @@ (target-datetime (assq-ref query-parameters 'target_datetime)) (locale (assq-ref query-parameters 'locale))) (fibers-let ((base-revision-details - (with-resource-from-pool (connection-pool) conn - (select-guix-revision-for-branch-and-datetime - conn - base-branch - base-datetime))) - (target-revision-details - (with-resource-from-pool (connection-pool) 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 + base-branch + base-datetime))) + (target-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 @@ -668,23 +668,23 @@ mime-types) ((application/json) (fibers-let ((base-job - (and=> (match (assq-ref query-parameters 'base_commit) - (($ value) - (and (string? value) value)) - ((? string? value) value) - (_ #f)) - (lambda (commit) - (with-resource-from-pool (connection-pool) conn - (select-job-for-commit conn commit))))) - (target-job - (and=> (match (assq-ref query-parameters 'target_commit) - (($ value) - (and (string? value) value)) - ((? string? value) value) - (_ #f)) - (lambda (commit) - (with-resource-from-pool (connection-pool) conn - (select-job-for-commit conn commit)))))) + (and=> (match (assq-ref query-parameters 'base_commit) + (($ value) + (and (string? value) value)) + ((? string? value) value) + (_ #f)) + (lambda (commit) + (with-resource-from-pool (connection-pool) conn + (select-job-for-commit conn commit))))) + (target-job + (and=> (match (assq-ref query-parameters 'target_commit) + (($ value) + (and (string? value) value)) + ((? string? value) value) + (_ #f)) + (lambda (commit) + (with-resource-from-pool (connection-pool) conn + (select-job-for-commit conn commit)))))) (render-json `((error . "invalid query") (query_parameters @@ -707,14 +707,14 @@ (target_job . ,target-job))))) (else (fibers-let ((systems - (call-with-resource-from-pool (connection-pool) - list-systems)) - (targets - (call-with-resource-from-pool (connection-pool) - valid-targets)) - (build-server-urls - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id))) + (call-with-resource-from-pool (connection-pool) + list-systems)) + (targets + (call-with-resource-from-pool (connection-pool) + valid-targets)) + (build-server-urls + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id))) (render-html #:sxml (compare/package-derivations query-parameters @@ -933,17 +933,17 @@ '((error . "invalid query")))) (else (fibers-let ((base-job - (match (assq-ref query-parameters 'base_commit) - (($ value) - (with-resource-from-pool (connection-pool) conn - (select-job-for-commit conn value))) - (_ #f))) - (target-job - (match (assq-ref query-parameters 'target_commit) - (($ value) - (with-resource-from-pool (connection-pool) conn - (select-job-for-commit conn value))) - (_ #f)))) + (match (assq-ref query-parameters 'base_commit) + (($ value) + (with-resource-from-pool (connection-pool) conn + (select-job-for-commit conn value))) + (_ #f))) + (target-job + (match (assq-ref query-parameters 'target_commit) + (($ value) + (with-resource-from-pool (connection-pool) conn + (select-job-for-commit conn value))) + (_ #f)))) (render-html #:sxml (compare-invalid-parameters query-parameters @@ -953,15 +953,15 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit))) (fibers-let ((base-revision-id - (with-resource-from-pool (connection-pool) conn - (commit->revision-id - conn - base-commit))) - (target-revision-id - (with-resource-from-pool (connection-pool) conn - (commit->revision-id - conn - target-commit)))) + (with-resource-from-pool (connection-pool) conn + (commit->revision-id + conn + base-commit))) + (target-revision-id + (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 @@ -1002,11 +1002,11 @@ '((error . "invalid query")))) (else (fibers-let ((systems - (with-resource-from-pool (connection-pool) conn - list-systems)) - (build-server-urls - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id))) + (with-resource-from-pool (connection-pool) conn + list-systems)) + (build-server-urls + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id))) (render-html #:sxml (compare/system-test-derivations query-parameters @@ -1021,24 +1021,24 @@ (target-commit (assq-ref query-parameters 'target_commit)) (system (assq-ref query-parameters 'system))) (fibers-let ((data - (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 - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id)) - (base-git-repositories - (with-resource-from-pool (connection-pool) conn - (git-repositories-containing-commit conn base-commit))) - (target-git-repositories - (with-resource-from-pool (connection-pool) conn - (git-repositories-containing-commit conn target-commit))) - (systems - (with-resource-from-pool (connection-pool) conn - list-systems))) + (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 + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id)) + (base-git-repositories + (with-resource-from-pool (connection-pool) conn + (git-repositories-containing-commit conn base-commit))) + (target-git-repositories + (with-resource-from-pool (connection-pool) conn + (git-repositories-containing-commit conn target-commit))) + (systems + (with-resource-from-pool (connection-pool) conn + list-systems))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) @@ -1072,11 +1072,11 @@ '((error . "invalid query")))) (else (fibers-let ((systems - (with-resource-from-pool (connection-pool) conn - list-systems)) - (build-server-urls - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id))) + (with-resource-from-pool (connection-pool) conn + list-systems)) + (build-server-urls + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id))) (render-html #:sxml (compare/system-test-derivations query-parameters @@ -1104,28 +1104,28 @@ target-branch target-datetime)))) (fibers-let ((data - (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 - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id)) - (base-git-repositories - (with-resource-from-pool (connection-pool) conn - (git-repositories-containing-commit - conn - (second base-revision-details)))) - (target-git-repositories - (with-resource-from-pool (connection-pool) conn - (git-repositories-containing-commit - conn - (second target-revision-details)))) - (systems - (with-resource-from-pool (connection-pool) conn - list-systems))) + (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 + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id)) + (base-git-repositories + (with-resource-from-pool (connection-pool) conn + (git-repositories-containing-commit + conn + (second base-revision-details)))) + (target-git-repositories + (with-resource-from-pool (connection-pool) conn + (git-repositories-containing-commit + conn + (second target-revision-details)))) + (systems + (with-resource-from-pool (connection-pool) conn + list-systems))) (case (most-appropriate-mime-type '(application/json text/html) mime-types)