diff options
Diffstat (limited to 'guix-data-service/web')
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 1 | ||||
| -rw-r--r-- | guix-data-service/web/build/controller.scm | 6 | ||||
| -rw-r--r-- | guix-data-service/web/compare/controller.scm | 38 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 18 | ||||
| -rw-r--r-- | guix-data-service/web/jobs/controller.scm | 4 | ||||
| -rw-r--r-- | guix-data-service/web/nar/controller.scm | 4 | ||||
| -rw-r--r-- | guix-data-service/web/package/controller.scm | 4 | ||||
| -rw-r--r-- | guix-data-service/web/repository/controller.scm | 36 | ||||
| -rw-r--r-- | guix-data-service/web/revision/controller.scm | 62 | ||||
| -rw-r--r-- | guix-data-service/web/server.scm | 11 |
10 files changed, 102 insertions, 82 deletions
diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index 22088b1..7d2bd24 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -22,6 +22,7 @@ #:use-module (json) #:use-module (squee) #:use-module (fibers) + #:use-module (knots resource-pool) #:use-module (prometheus) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) diff --git a/guix-data-service/web/build/controller.scm b/guix-data-service/web/build/controller.scm index bf77e03..7924dbb 100644 --- a/guix-data-service/web/build/controller.scm +++ b/guix-data-service/web/build/controller.scm @@ -18,6 +18,8 @@ (define-module (guix-data-service web build controller) #:use-module (srfi srfi-1) #:use-module (ice-9 match) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web render) @@ -41,7 +43,7 @@ (define parse-build-server (lambda (v) - (letpar& ((build-servers + (fibers-let ((build-servers (call-with-resource-from-pool (connection-pool) select-build-servers))) (or (any (match-lambda @@ -88,7 +90,7 @@ '())) (let ((system (assq-ref parsed-query-parameters 'system)) (target (assq-ref parsed-query-parameters 'target))) - (letpar& ((build-server-options + (fibers-let ((build-server-options (with-resource-from-pool (connection-pool) conn (map (match-lambda ((id url lookup-all-derivations diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index e1fab78..dbb4975 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -24,6 +24,8 @@ #:use-module (texinfo) #:use-module (texinfo html) #:use-module (texinfo plain-text) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web sxml) @@ -229,7 +231,7 @@ (define (render-compare mime-types query-parameters) (if (any-invalid-query-parameters? query-parameters) - (letpar& ((base-job + (fibers-let ((base-job (match (assq-ref query-parameters 'base_commit) (($ <invalid-query-parameter> value) (with-resource-from-pool (connection-pool) conn @@ -275,7 +277,7 @@ #f #f #f))))) - (letpar& ((base-revision-id + (fibers-let ((base-revision-id (with-resource-from-pool (connection-pool) conn (commit->revision-id conn @@ -303,7 +305,7 @@ (version-changes (package-data-version-changes base-packages-vhash target-packages-vhash))) - (letpar& ((lint-warnings-data + (fibers-let ((lint-warnings-data (with-resource-from-pool (connection-pool) conn (group-list-by-first-n-fields 2 @@ -396,7 +398,7 @@ lint-warnings-data)))) #:extra-headers http-headers-for-unchanging-content)) (else - (letpar& ((lint-warnings-locale-options + (fibers-let ((lint-warnings-locale-options (map (match-lambda ((locale) @@ -449,7 +451,7 @@ (target-branch (assq-ref query-parameters 'target_branch)) (target-datetime (assq-ref query-parameters 'target_datetime)) (locale (assq-ref query-parameters 'locale))) - (letpar& ((base-revision-details + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -624,7 +626,7 @@ '(application/json text/html) mime-types) ((application/json) - (letpar& ((base-job + (fibers-let ((base-job (and=> (match (assq-ref query-parameters 'base_commit) (($ <invalid-query-parameter> value) (and (string? value) value)) @@ -663,7 +665,7 @@ (base_job . ,base-job) (target_job . ,target-job))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -695,7 +697,7 @@ (limit-results (assq-ref query-parameters 'limit_results))) (let ((data (concatenate! - (par-map& + (fibers-map (lambda (system) (with-resource-from-pool (connection-pool) conn (package-derivation-differences-data @@ -734,7 +736,7 @@ . ,derivation-changes)) #:stream? #t)) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -788,7 +790,7 @@ string->symbol)) (after-name (assq-ref query-parameters 'after_name)) (limit-results (assq-ref query-parameters 'limit_results))) - (letpar& + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -800,7 +802,7 @@ target-branch target-datetime)))) (let ((data - (par-map& + (fibers-map (lambda (system) (with-resource-from-pool (connection-pool) conn (package-derivation-differences-data @@ -875,7 +877,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((base-job + (fibers-let ((base-job (match (assq-ref query-parameters 'base_commit) (($ <invalid-query-parameter> value) (with-resource-from-pool (connection-pool) conn @@ -895,7 +897,7 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit))) - (letpar& ((base-revision-id + (fibers-let ((base-revision-id (with-resource-from-pool (connection-pool) conn (commit->revision-id conn @@ -944,7 +946,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (with-resource-from-pool (connection-pool) conn list-systems)) (build-server-urls @@ -963,7 +965,7 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit)) (system (assq-ref query-parameters 'system))) - (letpar& ((data + (fibers-let ((data (with-resource-from-pool (connection-pool) conn (system-test-derivations-differences-data conn @@ -1014,7 +1016,7 @@ (render-json '((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (with-resource-from-pool (connection-pool) conn list-systems)) (build-server-urls @@ -1035,7 +1037,7 @@ (target-branch (assq-ref query-parameters 'target_branch)) (target-datetime (assq-ref query-parameters 'target_datetime)) (system (assq-ref query-parameters 'system))) - (letpar& + (fibers-let ((base-revision-details (with-resource-from-pool (connection-pool) conn (select-guix-revision-for-branch-and-datetime conn @@ -1046,7 +1048,7 @@ (select-guix-revision-for-branch-and-datetime conn target-branch target-datetime)))) - (letpar& ((data + (fibers-let ((data (with-resource-from-pool (connection-pool) conn (system-test-derivations-differences-data conn diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index d23c2f3..cdf2318 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -35,6 +35,8 @@ #:use-module (texinfo html) #:use-module (squee) #:use-module (json) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (prometheus) #:use-module (guix-data-service utils) #:use-module (guix-data-service config) @@ -234,7 +236,7 @@ #:always-rollback? #t)) (lambda () - (letpar& ((metric-values + (fibers-let ((metric-values (with-exception-handler (lambda (exn) (simple-format @@ -456,12 +458,12 @@ (write-metrics registry port)))))))) (define (render-derivation derivation-file-name) - (letpar& ((derivation + (fibers-let ((derivation (with-resource-from-pool (connection-pool) conn (select-derivation-by-file-name conn derivation-file-name)))) (if derivation - (letpar& ((derivation-inputs + (fibers-let ((derivation-inputs (with-resource-from-pool (connection-pool) conn (select-derivation-inputs-by-derivation-id conn @@ -495,7 +497,7 @@ (select-derivation-by-file-name conn derivation-file-name)))) (if derivation - (letpar& ((derivation-inputs + (fibers-let ((derivation-inputs (with-resource-from-pool (connection-pool) conn (select-derivation-inputs-by-derivation-id conn @@ -551,7 +553,7 @@ (select-derivation-by-file-name conn derivation-file-name)))) (if derivation - (letpar& ((derivation-inputs + (fibers-let ((derivation-inputs (with-resource-from-pool (connection-pool) conn (select-derivation-inputs-by-derivation-id conn @@ -596,7 +598,7 @@ #:sxml (view-narinfos narinfos))))) (define (render-store-item filename) - (letpar& ((derivation + (fibers-let ((derivation (with-resource-from-pool (connection-pool) conn (select-derivation-by-output-filename conn filename)))) (match derivation @@ -619,7 +621,7 @@ filename))) #:extra-headers http-headers-for-unchanging-content)))) (derivations - (letpar& ((nars + (fibers-let ((nars (with-resource-from-pool (connection-pool) conn (select-nars-for-output conn filename))) (builds @@ -656,7 +658,7 @@ conn filename)))))))))) (derivations - (letpar& ((nars + (fibers-let ((nars (with-resource-from-pool (connection-pool) conn (select-nars-for-output conn filename)))) (render-json diff --git a/guix-data-service/web/jobs/controller.scm b/guix-data-service/web/jobs/controller.scm index 7e5084f..96621f9 100644 --- a/guix-data-service/web/jobs/controller.scm +++ b/guix-data-service/web/jobs/controller.scm @@ -17,6 +17,8 @@ (define-module (guix-data-service web jobs controller) #:use-module (ice-9 match) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web render) @@ -74,7 +76,7 @@ (define (render-jobs mime-types query-parameters) (define limit-results (assq-ref query-parameters 'limit_results)) - (letpar& ((jobs + (fibers-let ((jobs (with-resource-from-pool (connection-pool) conn (select-jobs-and-events conn diff --git a/guix-data-service/web/nar/controller.scm b/guix-data-service/web/nar/controller.scm index e2ace7a..f7edac6 100644 --- a/guix-data-service/web/nar/controller.scm +++ b/guix-data-service/web/nar/controller.scm @@ -27,6 +27,8 @@ #:use-module (web uri) #:use-module (web request) #:use-module (web response) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix pki) #:use-module (guix base32) #:use-module (guix base64) @@ -155,7 +157,7 @@ #:code 200 #:headers '((content-type . (application/x-narinfo)))) (let ((derivation-file-name (second derivation))) - (letpar& + (fibers-let ((derivation-text (with-resource-from-pool (reserved-connection-pool) conn (select-serialized-derivation-by-file-name diff --git a/guix-data-service/web/package/controller.scm b/guix-data-service/web/package/controller.scm index 8dc6b0f..792394c 100644 --- a/guix-data-service/web/package/controller.scm +++ b/guix-data-service/web/package/controller.scm @@ -19,6 +19,8 @@ #:use-module (ice-9 match) #:use-module (web uri) #:use-module (web request) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web render) @@ -40,7 +42,7 @@ request `((system ,parse-system #:default "x86_64-linux") (target ,parse-target #:default ""))))) - (letpar& ((package-versions-with-branches + (fibers-let ((package-versions-with-branches (with-resource-from-pool (connection-pool) conn (branches-by-package-version conn name (assq-ref parsed-query-parameters diff --git a/guix-data-service/web/repository/controller.scm b/guix-data-service/web/repository/controller.scm index 0d9434c..101687c 100644 --- a/guix-data-service/web/repository/controller.scm +++ b/guix-data-service/web/repository/controller.scm @@ -19,6 +19,8 @@ #:use-module (ice-9 match) #:use-module (web uri) #:use-module (web request) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web render) @@ -47,7 +49,7 @@ (match method-and-path-components (('GET "repositories") - (letpar& ((git-repositories + (fibers-let ((git-repositories (call-with-resource-from-pool (connection-pool) all-git-repositories))) (case (most-appropriate-mime-type @@ -71,7 +73,7 @@ (match (with-resource-from-pool (connection-pool) conn (select-git-repository conn id)) ((label url cgit-url-base fetch-with-authentication? poll-interval) - (letpar& ((branches + (fibers-let ((branches (with-resource-from-pool (connection-pool) conn (all-branches-with-most-recent-commit conn @@ -119,7 +121,7 @@ `((after_date ,parse-datetime) (before_date ,parse-datetime) (limit_results ,parse-result-limit #:default 100))))) - (letpar& ((revisions + (fibers-let ((revisions (with-resource-from-pool (connection-pool) conn (most-recent-commits-for-branch conn @@ -160,7 +162,7 @@ parsed-query-parameters revisions))))))))) (('GET "repository" repository-id "branch" branch-name "package" package-name) - (letpar& ((package-versions + (fibers-let ((package-versions (with-resource-from-pool (connection-pool) conn (package-versions-for-branch conn (string->number repository-id) @@ -211,7 +213,7 @@ (parse-query-parameters request `((system ,parse-system #:default "x86_64-linux"))))) - (letpar& ((system-test-history + (fibers-let ((system-test-history (with-resource-from-pool (connection-pool) conn (system-test-derivations-for-branch conn @@ -256,7 +258,7 @@ valid-systems system-test-history))))))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -273,7 +275,7 @@ repository-id branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "packages") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -313,7 +315,7 @@ repository-id branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-derivations") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -422,7 +424,7 @@ branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "system-tests") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -440,7 +442,7 @@ repository-id branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-reproducibility") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -462,7 +464,7 @@ repository-id branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-substitute-availability") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -476,7 +478,7 @@ branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "lint-warnings") - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -510,7 +512,7 @@ repository-id branch-name)))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package" name version) - (letpar& ((commit-hash + (fibers-let ((commit-hash (with-resource-from-pool (connection-pool) conn (latest-processed-commit-for-branch conn repository-id @@ -583,7 +585,7 @@ (assq-ref parsed-query-parameters 'system)) (target (assq-ref parsed-query-parameters 'target))) - (letpar& + (fibers-let ((package-derivations (with-resource-from-pool (connection-pool) conn (package-derivations-for-branch conn @@ -620,7 +622,7 @@ . ,(list->vector builds))))) package-derivations)))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -657,7 +659,7 @@ (assq-ref parsed-query-parameters 'target)) (output-name (assq-ref parsed-query-parameters 'output))) - (letpar& + (fibers-let ((package-outputs (with-resource-from-pool (connection-pool) conn (package-outputs-for-branch conn @@ -695,7 +697,7 @@ . ,(list->vector builds))))) package-outputs)))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 14a721a..c4a25f7 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -24,6 +24,8 @@ #:use-module (texinfo html) #:use-module (texinfo plain-text) #:use-module (json) + #:use-module (knots parallelism) + #:use-module (knots resource-pool) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) #:use-module (guix-data-service web render) @@ -84,7 +86,7 @@ status)))) (define (parse-build-server v) - (letpar& ((build-servers + (fibers-let ((build-servers (call-with-resource-from-pool (connection-pool) select-build-servers))) (or (any (match-lambda @@ -395,7 +397,7 @@ `((unknown_commit . ,commit-hash)) #:code 404)) (else - (letpar& ((job + (fibers-let ((job (with-resource-from-pool (connection-pool) conn (select-job-for-commit conn commit-hash))) (git-repositories-and-branches @@ -423,7 +425,7 @@ `((unknown_commit . ,commit-hash)) #:code 404)) (else - (letpar& ((job + (fibers-let ((job (with-resource-from-pool (connection-pool) conn (select-job-for-commit conn commit-hash))) (git-repositories-and-branches @@ -448,7 +450,7 @@ (header-text `("Revision " (samp ,commit-hash))) (max-age cache-control-default-max-age)) - (letpar& ((packages-count + (fibers-let ((packages-count (with-resource-from-pool (connection-pool) conn (count-packages-in-revision conn commit-hash))) (git-repositories-and-branches @@ -514,7 +516,7 @@ `("Revision " (samp ,commit-hash))) (header-link (string-append "/revision/" commit-hash))) - (letpar& ((system-tests + (fibers-let ((system-tests (with-resource-from-pool (connection-pool) conn (select-system-tests-for-guix-revision conn @@ -542,7 +544,7 @@ (builds . ,(list->vector builds))))) system-tests)))))) (else - (letpar& ((git-repositories + (fibers-let ((git-repositories (with-resource-from-pool (connection-pool) conn (git-repositories-containing-commit conn commit-hash))) @@ -568,7 +570,7 @@ (header-link (string-append "/revision/" commit-hash))) - (letpar& ((channel-instances + (fibers-let ((channel-instances (with-resource-from-pool (connection-pool) conn (select-channel-instances-for-guix-revision conn commit-hash)))) (case (most-appropriate-mime-type @@ -596,7 +598,7 @@ (define* (render-revision-package-substitute-availability mime-types commit-hash #:key path-base) - (letpar& ((substitute-availability + (fibers-let ((substitute-availability (with-resource-from-pool (connection-pool) conn (select-package-output-availability-for-revision conn commit-hash))) @@ -610,7 +612,7 @@ ((application/json) (render-json `((commit . ,commit-hash) - (substitute_servers + (xsubstitute_servers . ,(list->vector (map (match-lambda ((build-server-id . data) @@ -642,7 +644,7 @@ (header-link (string-append "/revision/" commit-hash))) - (letpar& ((output-consistency + (fibers-let ((output-consistency (with-resource-from-pool (connection-pool) conn (select-output-consistency-for-revision conn commit-hash)))) (case (most-appropriate-mime-type @@ -676,7 +678,7 @@ #:sxml (view-revision-news commit-hash query-parameters '())))) - (letpar& ((news-entries + (fibers-let ((news-entries (with-resource-from-pool (connection-pool) conn (select-channel-news-entries-contained-in-guix-revision conn @@ -735,7 +737,7 @@ 99999)) ; TODO There shouldn't be a limit (fields (assq-ref query-parameters 'field)) (locale (assq-ref query-parameters 'locale))) - (letpar& + (fibers-let ((packages (with-resource-from-pool (connection-pool) conn (if search-query @@ -832,7 +834,7 @@ "/revision/" commit-hash)) (header-text `("Revision " (samp ,commit-hash)))) - (letpar& ((package-synopsis-counts + (fibers-let ((package-synopsis-counts (with-resource-from-pool (connection-pool) conn (synopsis-counts-by-locale conn (commit->revision-id @@ -872,7 +874,7 @@ (header-link (string-append "/revision/" commit-hash))) - (letpar& ((package-versions + (fibers-let ((package-versions (with-resource-from-pool (connection-pool) conn (select-package-versions-for-revision conn commit-hash @@ -929,7 +931,7 @@ (define has-replacement? (assq-ref query-parameters 'has_replacement)) - (letpar& ((metadata + (fibers-let ((metadata (with-resource-from-pool (connection-pool) conn (select-package-metadata-by-revision-name-and-version conn @@ -1041,7 +1043,7 @@ (render-json `((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1067,7 +1069,7 @@ (assq-ref query-parameters 'search_query)) (fields (assq-ref query-parameters 'field))) - (letpar& + (fibers-let ((derivations (if search-query (with-resource-from-pool (connection-pool) conn @@ -1090,7 +1092,7 @@ #:after-name (assq-ref query-parameters 'after_name) #:include-builds? (member "builds" fields))) (concatenate! - (par-map& + (fibers-map (lambda (system) (with-resource-from-pool (connection-pool) conn (select-package-derivations-in-revision @@ -1149,7 +1151,7 @@ derivations)))) #:stream? #t)) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1187,7 +1189,7 @@ (render-json `((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1213,7 +1215,7 @@ (assq-ref query-parameters 'search_query)) (fields (assq-ref query-parameters 'field))) - (letpar& + (fibers-let ((derivations (with-resource-from-pool (connection-pool) conn (select-fixed-output-package-derivations-in-revision @@ -1242,7 +1244,7 @@ (render-json `((derivations . ,(list->vector derivations))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1284,7 +1286,7 @@ (render-json `((error . "invalid query")))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1308,7 +1310,7 @@ (assq-ref query-parameters 'all_results)) (fields (assq-ref query-parameters 'field))) - (letpar& + (fibers-let ((derivation-outputs (with-resource-from-pool (connection-pool) conn (select-derivation-outputs-in-revision @@ -1390,7 +1392,7 @@ "not-matching"))))))) derivation-outputs)))))) (else - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1419,7 +1421,7 @@ (header-link (string-append "/revision/" commit-hash))) (if (any-invalid-query-parameters? query-parameters) - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1437,7 +1439,7 @@ '()))) (let ((system (assq-ref query-parameters 'system)) (target (assq-ref query-parameters 'target))) - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1492,7 +1494,7 @@ (header-link (string-append "/revision/" commit-hash))) (if (any-invalid-query-parameters? query-parameters) - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1509,7 +1511,7 @@ '()))) (let ((system (assq-ref query-parameters 'system)) (target (assq-ref query-parameters 'target))) - (letpar& ((systems + (fibers-let ((systems (call-with-resource-from-pool (connection-pool) list-systems)) (targets @@ -1592,7 +1594,7 @@ (linters (assq-ref query-parameters 'linter)) (message-query (assq-ref query-parameters 'message_query)) (fields (assq-ref query-parameters 'field))) - (letpar& + (fibers-let ((git-repositories (with-resource-from-pool (connection-pool) conn (git-repositories-containing-commit conn diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index 4e08161..a1a888b 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -30,6 +30,8 @@ #:use-module (fibers channels) #:use-module (fibers scheduler) #:use-module (fibers conditions) + #:use-module (knots web-server) + #:use-module (knots resource-pool) #:use-module ((guix build syscalls) #:select (set-thread-name)) #:use-module (prometheus) @@ -246,7 +248,7 @@ port. Also, the port used can be changed by passing the --port option.\n" (make-counter-metric registry "resource_pool_checkout_timeouts_total" #:labels '(pool_name)))) - (%resource-pool-timeout-handler + (resource-pool-default-timeout-handler (lambda (pool proc timeout) (let ((pool-name (cond @@ -269,11 +271,12 @@ port. Also, the port used can be changed by passing the --port option.\n" request-scheduler) (let ((render-metrics (make-render-metrics registry))) - (run-server/patched - (lambda (request body) + (run-knots-web-server + (lambda (request) (metric-increment requests-metric) - (let ((reply (make-channel))) + (let ((body (read-request-body request)) + (reply (make-channel))) (spawn-fiber (lambda () (call-with-values |