From eb75964e76bb1b90c4239a912d2241849d2440d8 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 5 Nov 2025 08:42:39 +0000 Subject: [PATCH 01/10] Handle query parameter errors on the fix derivation page --- guix-data-service/web/compare/controller.scm | 2 +- guix-data-service/web/compare/html.scm | 361 ++++++++++--------- 2 files changed, 183 insertions(+), 180 deletions(-) diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 8d7583f..2c94904 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -628,7 +628,7 @@ (render-html #:sxml (compare/derivation query-parameters - '())))) + #f)))) (let ((base-derivation (assq-ref query-parameters 'base_derivation)) (target-derivation (assq-ref query-parameters 'target_derivation))) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 8711574..e92f74f 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -483,191 +483,194 @@ "View JSON"))))) (div (@ (class "row")) - (div - (@ (class "col-sm-12")) - (h2 "Outputs") - ,@(let ((outputs (assq-ref data 'outputs))) - `((table - (@ (class "table")) - (thead - (tr - (th "") - (th "Name") - (th "Path") - (th "Hash algorithm") - (th "Hash") - (th "Recursive"))) - (tbody - ,@(append-map - (lambda (label items) - (map - (lambda (alist) - `(tr - (td ,label) - (td ,(assq-ref alist 'output-name)) - (td (a (@ (href ,(assq-ref alist 'path))) - ,(display-store-item (assq-ref alist 'path)))) - (td ,(assq-ref alist 'hash-algorithm)) - (td ,(assq-ref alist 'hash)) - (td ,(assq-ref alist 'recursive)))) - (or (and=> items vector->list) '()))) - (list base target "Common") - (list (assq-ref outputs 'base) - (assq-ref outputs 'target) - (assq-ref outputs 'common))))))) - (h2 "Inputs") - ,@(let ((inputs (assq-ref data 'inputs))) - `((table - (@ (class "table")) - (thead - (tr - (th "") - (th "Derivation") - (th "Outputs"))) - (tbody - ,@(append-map - (lambda (label items) - (map - (lambda (alist) - `(tr - (td ,label) - (td (a (@ (href ,(assq-ref alist 'derivation_file_name))) - ,(display-store-item (assq-ref alist 'derivation_file_name)))) - (td ,(assq-ref alist 'derivation_output_name)))) - (or (and=> items vector->list) '()))) - (list base target) - (list (assq-ref inputs 'base) - (assq-ref inputs 'target))))))) - (p "Common inputs are omitted.") - (h2 "Sources") - ,@(let ((sources (assq-ref data 'sources))) - `((table - (@ (class "table")) - (thead - (tr - (th "") - (th "Derivation"))) - (tbody - ,@(append-map - (lambda (label items) - (map - (lambda (alist) - `(tr - (td ,label) - (td (a (@ (href ,(assq-ref alist 'store_path))) - ,(display-store-item (assq-ref alist 'store_path)))))) - (or (and=> items vector->list) '()))) - (list base target "Common") - (list (assq-ref sources 'base) - (assq-ref sources 'target) - (assq-ref sources 'common))))))) - (h2 "System") - ,@(let ((system (assq-ref data 'system))) - (let ((common-system (assq-ref system 'common))) - (if common-system - (list common-system) - `(table + ,@(if + data + `((div + (@ (class "col-sm-12")) + (h2 "Outputs") + ,@(let ((outputs (assq-ref data 'outputs))) + `((table (@ (class "table")) (thead (tr (th "") - (th "System"))) + (th "Name") + (th "Path") + (th "Hash algorithm") + (th "Hash") + (th "Recursive"))) (tbody - ,@(let ((base-system (assq-ref system 'base)) - (target-system (assq-ref system 'target))) - `((tr - (td ,base) - (td ,base-system)) - (tr - (td ,target) - (td ,target-system))))))))) - (h2 "Builder and arguments") - ,(let ((builder (assq-ref data 'builder)) - (arguments (assq-ref data 'arguments))) - (let ((common-builder (assq-ref builder 'common)) - (common-args (assq-ref arguments 'common))) - (if (and common-builder - common-args) - `(table - (@ (class "table")) - (thead - (th "Builder") - (th "Arguments")) - (tbody - (tr - (td ,(display-possible-store-item common-builder)) - (td (ol - ,@(map (lambda (arg) - `(li ,(display-possible-store-item arg))) - common-args)))))) - `(table - (@ (class "table")) - (thead - (tr - (th "") - (th "Builder") - (th "Arguments"))) - (tbody - ,@(let ((base-builder (assq-ref builder 'base)) - (target-builder (assq-ref builder 'target)) - (base-args (assq-ref arguments 'base)) - (target-args (assq-ref arguments 'target))) - `((tr - (td ,base) - (td ,(display-possible-store-item - (or base-builder - common-builder))) - (td (ol - ,@(map (lambda (arg) - `(li ,(display-possible-store-item arg))) - (or (and=> common-args vector->list) - (vector->list base-args)))))) + ,@(append-map + (lambda (label items) + (map + (lambda (alist) + `(tr + (td ,label) + (td ,(assq-ref alist 'output-name)) + (td (a (@ (href ,(assq-ref alist 'path))) + ,(display-store-item (assq-ref alist 'path)))) + (td ,(assq-ref alist 'hash-algorithm)) + (td ,(assq-ref alist 'hash)) + (td ,(assq-ref alist 'recursive)))) + (or (and=> items vector->list) '()))) + (list base target "Common") + (list (assq-ref outputs 'base) + (assq-ref outputs 'target) + (assq-ref outputs 'common))))))) + (h2 "Inputs") + ,@(let ((inputs (assq-ref data 'inputs))) + `((table + (@ (class "table")) + (thead + (tr + (th "") + (th "Derivation") + (th "Outputs"))) + (tbody + ,@(append-map + (lambda (label items) + (map + (lambda (alist) + `(tr + (td ,label) + (td (a (@ (href ,(assq-ref alist 'derivation_file_name))) + ,(display-store-item (assq-ref alist 'derivation_file_name)))) + (td ,(assq-ref alist 'derivation_output_name)))) + (or (and=> items vector->list) '()))) + (list base target) + (list (assq-ref inputs 'base) + (assq-ref inputs 'target))))))) + (p "Common inputs are omitted.") + (h2 "Sources") + ,@(let ((sources (assq-ref data 'sources))) + `((table + (@ (class "table")) + (thead + (tr + (th "") + (th "Derivation"))) + (tbody + ,@(append-map + (lambda (label items) + (map + (lambda (alist) + `(tr + (td ,label) + (td (a (@ (href ,(assq-ref alist 'store_path))) + ,(display-store-item (assq-ref alist 'store_path)))))) + (or (and=> items vector->list) '()))) + (list base target "Common") + (list (assq-ref sources 'base) + (assq-ref sources 'target) + (assq-ref sources 'common))))))) + (h2 "System") + ,@(let ((system (assq-ref data 'system))) + (let ((common-system (assq-ref system 'common))) + (if common-system + (list common-system) + `(table + (@ (class "table")) + (thead (tr - (td ,target) - (td ,(display-possible-store-item - (or target-builder - common-builder))) - (td (ol - ,@(map (lambda (arg) - `(li ,(display-possible-store-item arg))) - (or (and=> common-args vector->list) - (vector->list target-args))))))))))))) - (h2 "Environment variables") - ,(let ((environment-variables (assq-ref data 'environment-variables))) - `(table - (@ (class "table")) - (thead - (th "Name")) - (tbody - ,@(append-map - (match-lambda - ((name . values) - (let ((common-value (assq-ref values 'common))) - (if common-value - `((tr - (td ,name) - (td ,(display-possible-store-item common-value)))) - (let ((base-value (assq-ref values 'base)) - (target-value (assq-ref values 'target))) - (if (and base-value target-value) - `((tr - (td (@ (rowspan 2)) - ,name) - (td ,base ,(display-possible-store-item - base-value))) - (tr - (td ,target ,(display-possible-store-item - target-value)))) - `((tr - (td ,name) - (td ,@(if base-value - (list base - (display-possible-store-item - base-value)) - (list target - (display-possible-store-item - target-value)))))))))))) - environment-variables)))))))))) + (th "") + (th "System"))) + (tbody + ,@(let ((base-system (assq-ref system 'base)) + (target-system (assq-ref system 'target))) + `((tr + (td ,base) + (td ,base-system)) + (tr + (td ,target) + (td ,target-system))))))))) + (h2 "Builder and arguments") + ,(let ((builder (assq-ref data 'builder)) + (arguments (assq-ref data 'arguments))) + (let ((common-builder (assq-ref builder 'common)) + (common-args (assq-ref arguments 'common))) + (if (and common-builder + common-args) + `(table + (@ (class "table")) + (thead + (th "Builder") + (th "Arguments")) + (tbody + (tr + (td ,(display-possible-store-item common-builder)) + (td (ol + ,@(map (lambda (arg) + `(li ,(display-possible-store-item arg))) + common-args)))))) + `(table + (@ (class "table")) + (thead + (tr + (th "") + (th "Builder") + (th "Arguments"))) + (tbody + ,@(let ((base-builder (assq-ref builder 'base)) + (target-builder (assq-ref builder 'target)) + (base-args (assq-ref arguments 'base)) + (target-args (assq-ref arguments 'target))) + `((tr + (td ,base) + (td ,(display-possible-store-item + (or base-builder + common-builder))) + (td (ol + ,@(map (lambda (arg) + `(li ,(display-possible-store-item arg))) + (or (and=> common-args vector->list) + (vector->list base-args)))))) + (tr + (td ,target) + (td ,(display-possible-store-item + (or target-builder + common-builder))) + (td (ol + ,@(map (lambda (arg) + `(li ,(display-possible-store-item arg))) + (or (and=> common-args vector->list) + (vector->list target-args))))))))))))) + (h2 "Environment variables") + ,(let ((environment-variables (assq-ref data 'environment-variables))) + `(table + (@ (class "table")) + (thead + (th "Name")) + (tbody + ,@(append-map + (match-lambda + ((name . values) + (let ((common-value (assq-ref values 'common))) + (if common-value + `((tr + (td ,name) + (td ,(display-possible-store-item common-value)))) + (let ((base-value (assq-ref values 'base)) + (target-value (assq-ref values 'target))) + (if (and base-value target-value) + `((tr + (td (@ (rowspan 2)) + ,name) + (td ,base ,(display-possible-store-item + base-value))) + (tr + (td ,target ,(display-possible-store-item + target-value)))) + `((tr + (td ,name) + (td ,@(if base-value + (list base + (display-possible-store-item + base-value)) + (list target + (display-possible-store-item + target-value)))))))))))) + environment-variables)))))) + '())))))) (define* (compare/package-derivations query-parameters mode From b71214083d99bc8165f02f4254ff27b24893b9b4 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 13 Nov 2025 11:15:19 +0000 Subject: [PATCH 02/10] Avoid inserting duplicate nars The nar_urls table has a unique index, so drop the ON CONFLICT DO NOTHING bits. --- guix-data-service/model/nar.scm | 120 +++++++++++++++++--------------- 1 file changed, 63 insertions(+), 57 deletions(-) diff --git a/guix-data-service/model/nar.scm b/guix-data-service/model/nar.scm index 9f607be..41e08fc 100644 --- a/guix-data-service/model/nar.scm +++ b/guix-data-service/model/nar.scm @@ -18,6 +18,8 @@ (define-module (guix-data-service model nar) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-43) + #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (web uri) #:use-module (squee) @@ -56,26 +58,36 @@ (or (narinfo-deriver narinfo) NULL))))) narinfos)) - (let ((nar-ids - (vector->list + (let* ((nar-ids + new-ids (insert-missing-data-and-return-all-ids conn "nars" '(store_path hash_algorithm hash size system deriver) - (list->vector data))))) + (list->vector data))) + (new-narinfos + (filter-map + (lambda (nar-id narinfo) + (if (vector-any (lambda (x) + (= x nar-id)) + new-ids) + (cons nar-id narinfo) + #f)) + (vector->list nar-ids) + narinfos))) (let ((reference-data (concatenate - (map (lambda (nar-id narinfo) - (map (lambda (reference) - (simple-format - #f - "(~A, ~A)" - nar-id - (quote-string reference))) - (narinfo-references narinfo))) - nar-ids - narinfos)))) + (map (match-lambda + ((nar-id . narinfo) + (map (lambda (reference) + (simple-format + #f + "(~A, ~A)" + nar-id + (quote-string reference))) + (narinfo-references narinfo)))) + new-narinfos)))) (unless (null? reference-data) (exec-query conn @@ -83,9 +95,7 @@ " INSERT INTO nar_references (nar_id, reference) VALUES " - (string-join reference-data ", ") - " -ON CONFLICT DO NOTHING")))) + (string-join reference-data ", "))))) (exec-query conn @@ -95,55 +105,51 @@ INSERT INTO nar_urls (nar_id, url, compression, file_size) VALUES " (string-join (concatenate - (map (lambda (nar-id narinfo) - (map (lambda (uri compression file-size) - (simple-format - #f - "(~A, ~A, ~A, ~A)" - nar-id - (quote-string - (uri->string uri)) - (quote-string compression) - (or file-size "NULL"))) - (narinfo-uris narinfo) - (narinfo-compressions narinfo) - (narinfo-file-sizes narinfo))) - nar-ids - narinfos)) - ", ") - " -ON CONFLICT DO NOTHING")) + (map (match-lambda + ((nar-id . narinfo) + (map (lambda (uri compression file-size) + (simple-format + #f + "(~A, ~A, ~A, ~A)" + nar-id + (quote-string + (uri->string uri)) + (quote-string compression) + (or file-size "NULL"))) + (narinfo-uris narinfo) + (narinfo-compressions narinfo) + (narinfo-file-sizes narinfo)))) + new-narinfos)) + ", "))) - (for-each (lambda (nar-id narinfo) - (let ((narinfo-signature-data-id - (narinfo-signature->data-id conn narinfo))) + (for-each (match-lambda + ((nar-id . narinfo) + (let ((narinfo-signature-data-id + (narinfo-signature->data-id conn narinfo))) - (exec-query - conn - (string-append - " + (exec-query + conn + (string-append + " INSERT INTO narinfo_signatures (nar_id, narinfo_signature_data_id) VALUES " - (simple-format - #f - "(~A,~A)" - nar-id - narinfo-signature-data-id) - " -ON CONFLICT DO NOTHING")) + (simple-format + #f + "(~A,~A)" + nar-id + narinfo-signature-data-id))) - (exec-query - conn - (string-append - " + (exec-query + conn + (string-append + " INSERT INTO narinfo_fetch_records (narinfo_signature_data_id, build_server_id) VALUES ($1, $2)") - (list (number->string narinfo-signature-data-id) - (number->string build-server-id))))) - nar-ids - narinfos) + (list (number->string narinfo-signature-data-id) + (number->string build-server-id)))))) + new-narinfos) - nar-ids)) + (vector->list nar-ids))) (define (sexp->json-string sexp) (define (transform x) From 0611684b0d95405b70cfa8b1c3ac7779a872aa74 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 13 Nov 2025 11:39:12 +0000 Subject: [PATCH 03/10] Flip the most-appropriate-mime-type arguments As all the calls are wrong. --- guix-data-service/web/server.scm | 4 ++-- guix-data-service/web/util.scm | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index b1075a0..e453643 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -325,8 +325,8 @@ port. Also, the port used can be changed by passing the --port option.\n" (or (resource-pool-timeout-error? exn) (resource-pool-too-many-waiters-error? exn)))) (case (most-appropriate-mime-type - mime-types - '(text/html application/json)) + '(text/html application/json) + mime-types) ((application/json) (apply values diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm index 6c0caa7..79ca69a 100644 --- a/guix-data-service/web/util.scm +++ b/guix-data-service/web/util.scm @@ -33,8 +33,8 @@ uri-encode-filename)) -(define (most-appropriate-mime-type accepted-mime-types - supported-mime-types) +(define (most-appropriate-mime-type supported-mime-types + accepted-mime-types) (or ;; Pick the first supported mime-type (find (lambda (accepted-mime-type) From 571ed55c9f8bbe898384aa1cc9f8501bb8206107 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 13 Nov 2025 12:39:31 +0000 Subject: [PATCH 04/10] Fix indentation --- guix-data-service/web/revision/controller.scm | 107 +++++++++--------- 1 file changed, 54 insertions(+), 53 deletions(-) diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 9adb25f..0739b78 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -933,61 +933,62 @@ (define has-replacement? (assq-ref query-parameters 'has_replacement)) - (fibers-let ((metadata - (with-resource-from-pool (connection-pool) conn - (select-package-metadata-by-revision-name-and-version - conn - commit-hash - name - version - locale - #:replacement? has-replacement?))) - (derivations - (with-resource-from-pool (connection-pool) conn + (fibers-let + ((metadata + (with-resource-from-pool (connection-pool) conn + (select-package-metadata-by-revision-name-and-version + conn + commit-hash + name + version + locale + #:replacement? has-replacement?))) + (derivations + (with-resource-from-pool (connection-pool) conn + (map + (lambda (derivation-details) + (append + derivation-details + (list (map - (lambda (derivation-details) - (append - derivation-details - (list - (map - (match-lambda - ((name path hash-algorithm hash recursive?) - `((name . ,name) - (path . ,path) - (hash_algorithm . ,hash-algorithm) - (hash . ,hash) - (recursive? . ,recursive?) - (nars - . ,(list->vector - (map (match-lambda - ((hash-algorithm hash size - urls signatures) - `((hash . ((algorithm . ,hash-algorithm) - (value . ,hash))) - (size . ,size)))) - (select-nars-for-output - conn - path))))))) - (select-derivation-outputs-by-derivation-file-name - conn - (third derivation-details)))))) - (select-derivations-by-revision-name-and-version + (match-lambda + ((name path hash-algorithm hash recursive?) + `((name . ,name) + (path . ,path) + (hash_algorithm . ,hash-algorithm) + (hash . ,hash) + (recursive? . ,recursive?) + (nars + . ,(list->vector + (map (match-lambda + ((hash-algorithm hash size + urls signatures) + `((hash . ((algorithm . ,hash-algorithm) + (value . ,hash))) + (size . ,size)))) + (select-nars-for-output + conn + path))))))) + (select-derivation-outputs-by-derivation-file-name conn - commit-hash - name - version)))) - (git-repositories - (with-resource-from-pool (connection-pool) conn - (git-repositories-containing-commit conn - commit-hash))) - (lint-warnings - (with-resource-from-pool (connection-pool) conn - (select-lint-warnings-by-revision-package-name-and-version - conn - commit-hash - name - version - #:locale locale)))) + (third derivation-details)))))) + (select-derivations-by-revision-name-and-version + conn + commit-hash + name + version)))) + (git-repositories + (with-resource-from-pool (connection-pool) conn + (git-repositories-containing-commit conn + commit-hash))) + (lint-warnings + (with-resource-from-pool (connection-pool) conn + (select-lint-warnings-by-revision-package-name-and-version + conn + commit-hash + name + version + #:locale locale)))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) From 9a03cdff18c097a2987dfd12d55d0e3572969a98 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 13 Nov 2025 12:45:50 +0000 Subject: [PATCH 05/10] Handle package versions not being found --- guix-data-service/web/revision/controller.scm | 53 +++++++++++-------- guix-data-service/web/revision/html.scm | 2 + 2 files changed, 33 insertions(+), 22 deletions(-) diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm index 0739b78..a64d314 100644 --- a/guix-data-service/web/revision/controller.scm +++ b/guix-data-service/web/revision/controller.scm @@ -993,28 +993,34 @@ '(application/json text/html) mime-types) ((application/json) - (render-json - `((name . ,name) - (version . ,version) - ,@(match metadata - (((synopsis synopsis-locale description description-locale home-page file line column-number - licenses)) - `((synopsis . ,(texinfo->variants-alist synopsis synopsis-locale)) - (description . ,(texinfo->variants-alist description description-locale)) - (location - . ((file . ,file) - (line . ,line) - (column . ,column-number))) - (home-page . ,home-page)))) - (derivations . ,(list->vector - (map (match-lambda - ((system target file-name status outputs) - `((system . ,system) - (target . ,target) - (derivation . ,file-name) - (outputs . ,(list->vector outputs))))) - derivations)))) - #:extra-headers http-headers-for-unchanging-content)) + (if (null? metadata) + (render-json + `((name . ,name) + (version . ,version) + (error . "package not found")) + #:code 404) + (render-json + `((name . ,name) + (version . ,version) + ,@(match metadata + (((synopsis synopsis-locale description description-locale home-page file line column-number + licenses)) + `((synopsis . ,(texinfo->variants-alist synopsis synopsis-locale)) + (description . ,(texinfo->variants-alist description description-locale)) + (location + . ((file . ,file) + (line . ,line) + (column . ,column-number))) + (home-page . ,home-page)))) + (derivations . ,(list->vector + (map (match-lambda + ((system target file-name status outputs) + `((system . ,system) + (target . ,target) + (derivation . ,file-name) + (outputs . ,(list->vector outputs))))) + derivations)))) + #:extra-headers http-headers-for-unchanging-content))) (else (render-html #:sxml (view-revision-package-and-version commit-hash @@ -1030,6 +1036,9 @@ #:header-link header-link #:version-history-link version-history-link) + #:code (if (null? metadata) + 404 + 200) #:extra-headers http-headers-for-unchanging-content))))) (define* (render-revision-package-derivations mime-types diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm index 04133ad..45d1fc5 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -243,6 +243,8 @@ (div (@ (class "col-sm-12")) ,(match package-metadata + (() + "Package not found at this version") (((synopsis synopsis-locale description description-locale home-page file line column-number licenses)) `(dl From eb9ec4acd05752a970cf5395a3c78b35236e02da Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 20 Nov 2025 14:09:40 +0000 Subject: [PATCH 06/10] Handle unknown resource pool stats --- guix-data-service/web/controller.scm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 5fe9c1d..bfdbd18 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -347,11 +347,13 @@ (for-each (match-lambda ((stat . value) - (metric-set - (assq-ref resource-pool-metrics stat) - value - #:label-values - `((pool_name . ,name))))) + (and=> (assq-ref resource-pool-metrics stat) + (lambda (metric) + (metric-set + metric + value + #:label-values + `((pool_name . ,name))))))) (with-exception-handler (lambda (exn) (simple-format From 75f62f351ffcb6e7c6189886b7d1ddddda6b9ade Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Thu, 20 Nov 2025 15:43:16 +0000 Subject: [PATCH 07/10] Fix string metric values --- guix-data-service/metrics.scm | 46 +++++++++++++++++------------------ 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/guix-data-service/metrics.scm b/guix-data-service/metrics.scm index ca1d97a..143fa7e 100644 --- a/guix-data-service/metrics.scm +++ b/guix-data-service/metrics.scm @@ -107,25 +107,25 @@ WHERE relname NOT LIKE 'package_derivations_by_guix_revision_range_git_branch_%' last-vacuum last-autovacuum last-analyze last-autoanalyze vacuum-count autovacuum-count analyze-count autoanalyze-count) `((name . ,relname) - (seq-scan . ,seq-scan) - (seq-tup-read . ,seq-tup-read) - (idx-scan . ,idx-scan) - (idx-tup-fetch . ,idx-tup-fetch) - (n-tup-ins . ,n-tup-ins) - (n-tup-upd . ,n-tup-upd) - (n-tup-del . ,n-tup-del) - (n-tup-hot-upd . ,n-tup-hot-upd) - (n-live-tup . ,n-live-tup) - (n-dead-tup . ,n-dead-tup) - (n-mod-since-analyze . ,n-mod-since-analyze) - (last-vacuum . ,last-vacuum) - (last-autovacuum . ,last-autovacuum) - (last-analyze . ,last-analyze) - (last-autoanalyze . ,last-autoanalyze) - (vacuum-count . ,vacuum-count) - (autovacuum-count . ,autovacuum-count) - (analyze-count . ,analyze-count) - (autoanalyze-count . ,autoanalyze-count)))) + (seq-scan . ,(string->number seq-scan)) + (seq-tup-read . ,(string->number seq-tup-read)) + (idx-scan . ,(string->number idx-scan)) + (idx-tup-fetch . ,(string->number idx-tup-fetch)) + (n-tup-ins . ,(string->number n-tup-ins)) + (n-tup-upd . ,(string->number n-tup-upd)) + (n-tup-del . ,(string->number n-tup-del)) + (n-tup-hot-upd . ,(string->number n-tup-hot-upd)) + (n-live-tup . ,(string->number n-live-tup)) + (n-dead-tup . ,(string->number n-dead-tup)) + (n-mod-since-analyze . ,(string->number n-mod-since-analyze)) + (last-vacuum . ,(string->number last-vacuum)) + (last-autovacuum . ,(string->number last-autovacuum)) + (last-analyze . ,(string->number last-analyze)) + (last-autoanalyze . ,(string->number last-autoanalyze)) + (vacuum-count . ,(string->number vacuum-count)) + (autovacuum-count . ,(string->number autovacuum-count)) + (analyze-count . ,(string->number analyze-count)) + (autoanalyze-count . ,(string->number autoanalyze-count))))) (exec-query conn query))) (define (fetch-pg-stat-user-indexes-metrics conn) @@ -153,10 +153,10 @@ WHERE pg_stat_user_indexes.schemaname = 'guix_data_service' `((name . ,indexname) (table-name . ,tablename) (tablespace . ,tablespace) - (idx-scan . ,idx_scan) - (idx-tup-read . ,idx_tup_read) - (idx-tup-fetch . ,idx_tup_fetch) - (bytes . ,size_in_bytes)))) + (idx-scan . ,(string->number idx_scan)) + (idx-tup-read . ,(string->number idx_tup_read)) + (idx-tup-fetch . ,(string->number idx_tup_fetch)) + (bytes . ,(string->number size_in_bytes))))) (exec-query conn query))) (define (fetch-pg-stats-metrics conn) From 0a7873c0d5bbfbc8ff551bab807d8234073fb73e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 26 Nov 2025 09:46:16 +0000 Subject: [PATCH 08/10] Remove the guile-knots package definition from guix-dev.scm This is in Guix. --- guix-dev.scm | 33 --------------------------------- 1 file changed, 33 deletions(-) diff --git a/guix-dev.scm b/guix-dev.scm index 57c9c55..856706d 100644 --- a/guix-dev.scm +++ b/guix-dev.scm @@ -44,39 +44,6 @@ (gnu packages ruby) (srfi srfi-1)) -(define guile-knots - (let ((commit "d18b5b8d5de5beff3b9f84cfb359b73a4dcf2070") - (revision "1")) - (package - (name "guile-knots") - (version (git-version "0" revision commit)) - (source (origin - (method git-fetch) - (uri (git-reference - (url "https://git.cbaines.net/git/guile/knots") - (commit commit))) - (sha256 - (base32 - "0ygf0m6y6mf53pgq5i7agv4a54fkml2akg3ws55jj79v5ndy3lnb")) - (file-name (string-append name "-" version "-checkout")))) - (build-system gnu-build-system) - (native-inputs - (list pkg-config - autoconf - automake - guile-next - guile-lib - guile-fibers-next)) - (inputs - (list guile-next)) - (propagated-inputs - (list guile-fibers-next)) - (home-page "https://git.cbaines.net/guile/knots") - (synopsis "Patterns and functionality to use with Guile Fibers") - (description - "") - (license license:gpl3+)))) - (package (name "guix-data-service") (version "0.0.0") From f77b6bb318317c4c280bb87303d4e96abf4c408e Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Wed, 26 Nov 2025 09:47:30 +0000 Subject: [PATCH 09/10] Remove pg-conn-finish definition This is now exported. --- guix-data-service/database.scm | 4 ---- 1 file changed, 4 deletions(-) diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm index e68f3f1..f048c0d 100644 --- a/guix-data-service/database.scm +++ b/guix-data-service/database.scm @@ -48,10 +48,6 @@ NULL? exec-query-with-null-handling)) -;; TODO This isn't exported for some reason -(define pg-conn-finish - (@@ (squee) pg-conn-finish)) - (define %database-metrics-registry (make-parameter #f)) From 72fe3b4e473f07bddf2c268aa5886def8ca4b2de Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Mon, 29 Dec 2025 12:32:08 +0000 Subject: [PATCH 10/10] Suggest why derivations might not be found --- guix-data-service/web/controller.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index bfdbd18..0841ae1 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -498,7 +498,8 @@ (render-html #:sxml (general-not-found "Derivation not found" - "No derivation found with this file name.") + "Derivations can differ, but produce the same outputs, so try querying by +output, rather than derivation file name.") #:code 404)))) (define (render-json-derivation derivation-file-name)