From af209170f7b3ea3e1d6539573cc5fc0255239ec5 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 11 Jul 2021 10:44:59 +0100 Subject: [PATCH] Track package replacements Start at least looking for package replacements, and storing the details (particularly the derivation). I'm looking at doing this so that build servers using the Guix Data Service can build these derivations. --- .../jobs/load-new-guix-revision.scm | 55 +++++++++++++++++-- guix-data-service/model/package-metadata.scm | 20 +++++-- guix-data-service/model/package.scm | 8 ++- sqitch/deploy/packages_replacement.sql | 16 ++++++ sqitch/revert/packages_replacement.sql | 7 +++ sqitch/sqitch.plan | 1 + sqitch/verify/packages_replacement.sql | 7 +++ tests/model-package.scm | 22 ++++++-- 8 files changed, 118 insertions(+), 18 deletions(-) create mode 100644 sqitch/deploy/packages_replacement.sql create mode 100644 sqitch/revert/packages_replacement.sql create mode 100644 sqitch/verify/packages_replacement.sql diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index a25e3f9..15ca098 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -39,6 +39,7 @@ #:use-module (guix-data-service config) #:use-module (guix-data-service database) #:use-module (guix-data-service utils) + #:use-module (guix-data-service model utils) #:use-module (guix-data-service model build) #:use-module (guix-data-service model channel-instance) #:use-module (guix-data-service model channel-news) @@ -765,7 +766,34 @@ WHERE job_id = $1") (stringlicense-set-ids @@ -777,7 +805,24 @@ WHERE job_id = $1") (((all-package-metadata-ids new-package-metadata-ids) (with-time-logging "fetching inferior package metadata" (inferior-packages->package-metadata-ids - conn inf packages package-license-set-ids)))) + conn inf packages package-license-set-ids))) + ((package-replacement-package-ids) + (map (lambda (package) + (let ((replacement (inferior-package-replacement package))) + (if (and process-replacements? replacement) + ;; I'm not sure if replacements can themselves be + ;; replaced, but I do know for sure that there are + ;; infinite chains of replacements (python(2)-urllib3 + ;; in 7c4c781aa40c42d4cd10b8d9482199f3db345e1b for + ;; example). + ;; + ;; This code currently just capures the first level of + ;; replacements + (car + (insert-packages conn inf (list replacement) + #:process-replacements? #f)) + (cons "integer" NULL)))) + packages))) (unless (null? new-package-metadata-ids) (with-time-logging "fetching package metadata tsvector entries" @@ -789,7 +834,8 @@ WHERE job_id = $1") conn (zip (map inferior-package-name packages) (map inferior-package-version packages) - all-package-metadata-ids)))))) + all-package-metadata-ids + package-replacement-package-ids)))))) (define (insert-lint-warnings conn inferior-package-id->package-database-id lint-checker-ids @@ -1201,8 +1247,7 @@ WHERE job_id = $1") (lambda () (let* ((packages (with-time-logging "fetching inferior packages" - (deduplicate-inferior-packages - (inferior-packages inf)))) + (inferior-packages-plus-replacements inf))) (inferior-lint-warnings (with-time-logging "fetching inferior lint warnings" (all-inferior-lint-warnings inf store packages))) diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm index d7de893..912d0c2 100644 --- a/guix-data-service/model/package-metadata.scm +++ b/guix-data-service/model/package-metadata.scm @@ -109,9 +109,16 @@ fields) " AND "))) -(define (select-package-metadata-by-revision-name-and-version - conn revision-commit-hash name version locale) - (define query " +(define* (select-package-metadata-by-revision-name-and-version + conn + revision-commit-hash + name + version + locale + #:key replacement?) + (define query + (string-append + " SELECT translated_package_synopsis.synopsis, translated_package_synopsis.locale, translated_package_descriptions.description, translated_package_descriptions.locale, package_metadata.home_page, @@ -179,7 +186,12 @@ WHERE packages.id IN ( WHERE guix_revisions.commit = $1 ) AND packages.name = $2 - AND packages.version = $3") + AND packages.version = $3" + (if replacement? + " + AND packages.replacement_package_id IS NOT NULL" + " + AND packages.replacement_package_id IS NULL"))) (map (match-lambda diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 813d820..97deefc 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -162,7 +162,9 @@ WITH revision_packages AS ( WHERE guix_revisions.commit = $1 ) ), search_results AS ( - SELECT DISTINCT ON (packages.name) packages.name, + SELECT DISTINCT ON + (packages.name, packages.version, packages.replacement_package_id) + packages.name, packages.version, package_synopsis.synopsis, package_synopsis.locale AS synopsis_locale, package_descriptions.description, @@ -195,7 +197,7 @@ WITH revision_packages AS ( OR package_metadata_tsvectors.synopsis_and_description @@ plainto_tsquery($2) ) - ORDER BY name, + ORDER BY name, packages.version, packages.replacement_package_id, CASE WHEN package_metadata_tsvectors.locale = 'en_US.UTF-8' THEN 2 WHEN package_metadata_tsvectors.locale = $3 THEN 1 ELSE 0 @@ -265,7 +267,7 @@ RETURNING id")) (insert-missing-data-and-return-all-ids conn "packages" - '(name version package_metadata_id) + '(name version package_metadata_id replacement_package_id) package-entries)) (define (select-package-versions-for-revision conn diff --git a/sqitch/deploy/packages_replacement.sql b/sqitch/deploy/packages_replacement.sql new file mode 100644 index 0000000..95df32a --- /dev/null +++ b/sqitch/deploy/packages_replacement.sql @@ -0,0 +1,16 @@ +-- Deploy guix-data-service:packages_replacement to pg + +BEGIN; + +ALTER TABLE packages + ADD COLUMN replacement_package_id integer REFERENCES packages (id); + +ALTER TABLE packages DROP CONSTRAINT packages_pkey; +ALTER TABLE packages ADD PRIMARY KEY (id); + +CREATE UNIQUE INDEX packages_not_null_replacement_package_id_idx + ON packages (name, version, package_metadata_id, replacement_package_id); +CREATE UNIQUE INDEX packages_null_replacement_package_id_idx + ON packages (name, version, package_metadata_id) WHERE replacement_package_id IS NULL; + +COMMIT; diff --git a/sqitch/revert/packages_replacement.sql b/sqitch/revert/packages_replacement.sql new file mode 100644 index 0000000..e3216e2 --- /dev/null +++ b/sqitch/revert/packages_replacement.sql @@ -0,0 +1,7 @@ +-- Revert guix-data-service:packages_replacement from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index db4bac9..10a3fe1 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -81,3 +81,4 @@ remove_guix_revisions_store_path 2021-02-02T20:06:18Z Christopher Baines # Add a systems table some_indexes 2021-05-17T17:36:38Z Christopher Baines # Add some indexes package_metadata_location_id_index 2021-05-27T19:51:13Z Canan Talayhan # Add index for location id +packages_replacement 2021-04-24T04:52:57Z Christopher Baines # Add packages.replacement_package_id diff --git a/sqitch/verify/packages_replacement.sql b/sqitch/verify/packages_replacement.sql new file mode 100644 index 0000000..a0deb6d --- /dev/null +++ b/sqitch/verify/packages_replacement.sql @@ -0,0 +1,7 @@ +-- Verify guix-data-service:packages_replacement on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK; diff --git a/tests/model-package.scm b/tests/model-package.scm index e953645..a0fdc45 100644 --- a/tests/model-package.scm +++ b/tests/model-package.scm @@ -53,7 +53,8 @@ `(("en_US.UTF-8" . "Fake description"))))) (with-mock-inferior-packages (lambda () - (use-modules (guix-data-service model package) + (use-modules (guix-data-service model utils) + (guix-data-service model package) (guix-data-service model git-repository) (guix-data-service model guix-revision) (guix-data-service model package-metadata)) @@ -71,12 +72,16 @@ conn "" mock-inferior-packages - (test-license-set-ids conn)))) + (test-license-set-ids conn))) + (package-replacement-package-ids + (make-list (length mock-inferior-packages) + (cons "integer" NULL)))) (match (inferior-packages->package-ids conn (zip (map mock-inferior-package-name mock-inferior-packages) (map mock-inferior-package-version mock-inferior-packages) - package-metadata-ids)) + package-metadata-ids + package-replacement-package-ids)) ((x) (number? x)))))) #:always-rollback? #t) @@ -87,18 +92,23 @@ conn "" mock-inferior-packages - (test-license-set-ids conn)))) + (test-license-set-ids conn))) + (package-replacement-package-ids + (make-list (length mock-inferior-packages) + (cons "integer" NULL)))) (test-equal (inferior-packages->package-ids conn (zip (map mock-inferior-package-name mock-inferior-packages) (map mock-inferior-package-version mock-inferior-packages) - package-metadata-ids)) + package-metadata-ids + package-replacement-package-ids)) (inferior-packages->package-ids conn (zip (map mock-inferior-package-name mock-inferior-packages) (map mock-inferior-package-version mock-inferior-packages) - package-metadata-ids))))) + package-metadata-ids + package-replacement-package-ids))))) #:always-rollback? #t)))))) (test-end)