From ce4c3c6ed3979e54a8d5db6514bf4ed87de8b707 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 5 May 2019 13:35:48 +0100 Subject: Switch to storing Git repositories in a table Rather than just storing the URL in the guix_revisions and load_new_guix_revision_jobs tables. This will help when storing more information like tags and branches in the future. --- Makefile.am | 4 +- guix-data-service/branch-updated-emails.scm | 7 ++- guix-data-service/jobs/load-new-guix-revision.scm | 48 ++++++++------ guix-data-service/model/git-repository.scm | 58 +++++++++++++++++ guix-data-service/model/guix-revision.scm | 11 ++-- guix-data-service/web/controller.scm | 10 ++- guix-data-service/web/view/html.scm | 76 +++++++++-------------- sqitch/deploy/git_repositories.sql | 41 ++++++++++++ sqitch/revert/git_repositories.sql | 27 ++++++++ sqitch/sqitch.plan | 1 + sqitch/verify/git_repositories.sql | 8 +++ tests/model-git-repository.scm | 32 ++++++++++ 12 files changed, 246 insertions(+), 77 deletions(-) create mode 100644 guix-data-service/model/git-repository.scm create mode 100644 sqitch/deploy/git_repositories.sql create mode 100644 sqitch/revert/git_repositories.sql create mode 100644 sqitch/verify/git_repositories.sql create mode 100644 tests/model-git-repository.scm diff --git a/Makefile.am b/Makefile.am index ca95abe..f61284a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -42,6 +42,7 @@ SOURCES = \ guix-data-service/model/build-status.scm \ guix-data-service/model/build.scm \ guix-data-service/model/derivation.scm \ + guix-data-service/model/git-repository.scm \ guix-data-service/model/guix-revision-package-derivation.scm \ guix-data-service/model/guix-revision.scm \ guix-data-service/model/package-derivation.scm \ @@ -58,7 +59,8 @@ SOURCES = \ TEST_EXTENSIONS = .scm TESTS = \ - tests/model-derivation.scm + tests/model-derivation.scm \ + tests/model-git-repository.scm AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" diff --git a/guix-data-service/branch-updated-emails.scm b/guix-data-service/branch-updated-emails.scm index 284fe49..16dced4 100644 --- a/guix-data-service/branch-updated-emails.scm +++ b/guix-data-service/branch-updated-emails.scm @@ -17,6 +17,7 @@ (define-module (guix-data-service branch-updated-emails) #:use-module (email email) + #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service jobs load-new-guix-revision) #:export (enqueue-job-for-email)) @@ -36,7 +37,9 @@ (string? x-git-newrev)) (enqueue-load-new-guix-revision-job conn - (assoc-ref %repository-url-for-repo - x-git-repo) + (git-repository-url->git-repository-id + conn + (assoc-ref %repository-url-for-repo + x-git-repo)) x-git-newrev (string-append x-git-repo " " x-git-refname " updated"))))) diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 95c2554..5549d27 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -13,6 +13,7 @@ #:use-module (guix derivations) #:use-module (guix build utils) #:use-module (guix-data-service model package) + #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model guix-revision) #:use-module (guix-data-service model package-derivation) #:use-module (guix-data-service model guix-revision-package-derivation) @@ -347,7 +348,7 @@ (simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args) #f))) -(define (extract-information-from store conn url commit store-path) +(define (extract-information-from store conn git-repository-id commit store-path) (simple-format #t "debug: extract-information-from: ~A\n" store-path) (let ((inf (open-inferior/container store store-path @@ -364,10 +365,10 @@ (catch #t (lambda () - (let ((package-derivation-ids - (inferior-guix->package-derivation-ids store conn inf)) - (guix-revision-id - (insert-guix-revision conn url commit store-path))) + (let* ((package-derivation-ids + (inferior-guix->package-derivation-ids store conn inf)) + (guix-revision-id + (insert-guix-revision conn git-repository-id commit store-path))) (insert-guix-revision-package-derivations conn guix-revision-id @@ -385,35 +386,40 @@ (force-output) (exec-query conn "ROLLBACK"))))) -(define (load-new-guix-revision conn url commit) - (if (guix-revision-exists? conn url commit) +(define (load-new-guix-revision conn git-repository-id commit) + (if (guix-revision-exists? conn git-repository-id commit) #t (with-store store (let ((store-item (channel->guix-store-item store (channel (name 'guix) - (url url) + (url (git-repository-id->url + conn + git-repository-id)) (commit commit))))) (and store-item - (extract-information-from store conn url commit store-item)))))) + (extract-information-from store conn git-repository-id + commit store-item)))))) -(define (enqueue-load-new-guix-revision-job conn url commit source) +(define (enqueue-load-new-guix-revision-job conn git-repository-id commit source) (define query " -INSERT INTO load_new_guix_revision_jobs (url, commit, source) +INSERT INTO load_new_guix_revision_jobs (git_repository_id, commit, source) VALUES ($1, $2, $3) RETURNING id;") (first (exec-query conn query - (list url commit source)))) + (list git-repository-id commit source)))) (define (select-job-for-commit conn commit) (let ((result (exec-query conn - "SELECT * FROM load_new_guix_revision_jobs WHERE commit = $1" + (string-append + "SELECT id, commit, source, git_repository_id " + "FROM load_new_guix_revision_jobs WHERE commit = $1") (list commit)))) result)) @@ -421,7 +427,9 @@ RETURNING id;") (let ((result (exec-query conn - "SELECT * FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT $1" + (string-append + "SELECT id, commit, source, git_repository_id " + "FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT $1") (list (number->string n))))) result)) @@ -429,13 +437,15 @@ RETURNING id;") (let ((next (exec-query conn - "SELECT * FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT 1"))) + (string-append + "SELECT id, commit, source, git_repository_id " + "FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT 1")))) (match next - (((id url commit source)) + (((id commit source git-repository-id)) (begin - (simple-format #t "Processing job ~A (url: ~A, commit: ~A, source: ~A)\n\n" - id url commit source) - (load-new-guix-revision conn url commit) + (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n" + id commit source) + (load-new-guix-revision conn git-repository-id commit) (exec-query conn (string-append "DELETE FROM load_new_guix_revision_jobs WHERE id = '" diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm new file mode 100644 index 0000000..5f35cd3 --- /dev/null +++ b/guix-data-service/model/git-repository.scm @@ -0,0 +1,58 @@ +(define-module (guix-data-service model git-repository) + #:use-module (ice-9 match) + #:use-module (squee) + #:export (all-git-repositories + git-repository-id->url + git-repository-url->git-repository-id + + guix-revisions-and-jobs-for-git-repository)) + +(define (all-git-repositories conn) + (exec-query + conn + (string-append + "SELECT id, label, url FROM git_repositories"))) + +(define (git-repository-id->url conn id) + (match + (exec-query + conn + (string-append + "SELECT url FROM git_repositories WHERE id = $1;") + (list id)) + (((url)) url))) + +(define (git-repository-url->git-repository-id conn url) + (let ((existing-id + (exec-query + conn + (string-append + "SELECT id FROM git_repositories WHERE url = '" url "'")))) + (match existing-id + (((id)) id) + (() + (caar + (exec-query conn + (string-append + "INSERT INTO git_repositories " + "(url) " + "VALUES " + "('" url "') " + "RETURNING id"))))))) + +(define (guix-revisions-and-jobs-for-git-repository conn git-repository-id) + (define query + " +SELECT NULL AS id, load_new_guix_revision_jobs.id AS job_id, commit, source +FROM load_new_guix_revision_jobs +WHERE git_repository_id = $1 +UNION +SELECT id, NULL, commit, NULL +FROM guix_revisions +WHERE git_repository_id = $1 +ORDER BY 1 DESC NULLS FIRST, 2 DESC LIMIT 10;") + + (exec-query + conn + query + (list git-repository-id))) diff --git a/guix-data-service/model/guix-revision.scm b/guix-data-service/model/guix-revision.scm index f03aa6d..6ae7693 100644 --- a/guix-data-service/model/guix-revision.scm +++ b/guix-data-service/model/guix-revision.scm @@ -25,21 +25,22 @@ id) (() #f))) -(define (insert-guix-revision conn url commit store_path) +(define (insert-guix-revision conn git-repository-id commit store_path) (define insert (string-append "INSERT INTO guix_revisions " - "(url, commit, store_path) VALUES " - "('" url "', '" + "(git_repository_id, commit, store_path) VALUES " + "(" git-repository-id ", '" commit "', '" store_path "') " "RETURNING id;")) (map car (exec-query conn insert))) -(define (guix-revision-exists? conn url commit) +(define (guix-revision-exists? conn git-repository-id commit) (define query (string-append "SELECT EXISTS(" - "SELECT 1 FROM guix_revisions WHERE url = '" url "' " + "SELECT 1 FROM guix_revisions WHERE " + "git_repository_id = '" git-repository-id "' " "AND commit = '" commit "')" ";")) diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 2aa516d..6dda0da 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -27,6 +27,7 @@ #:use-module (web uri) #:use-module (squee) #:use-module (guix-data-service comparison) + #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model guix-revision) #:use-module (guix-data-service model package) #:use-module (guix-data-service model package-derivation) @@ -287,8 +288,13 @@ (match-lambda ((GET) (apply render-html (index - (most-recent-n-guix-revisions conn 10) - (most-recent-n-load-new-guix-revision-jobs conn 1000)))) + (map + (lambda (git-repository-details) + (cons git-repository-details + (guix-revisions-and-jobs-for-git-repository + conn + (car git-repository-details)))) + (all-git-repositories conn))))) ((GET "builds") (apply render-html (view-builds (select-build-stats conn) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 3a039bd..8c74c18 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -90,7 +90,7 @@ "source code here") "."))))) #:extra-headers ,extra-headers)) -(define (index guix-revisions queued-guix-revisions) +(define (index git-repositories-and-revisions) (layout #:extra-headers '((cache-control . ((max-age . 60)))) @@ -142,53 +142,33 @@ (@ (type "submit") (class "btn btn-lg btn-primary")) "Compare"))))) - (div - (@ (class "row")) - (div - (@ (class "col-sm-12")) - (h3 "Recent fetched revisions") - ,(if (null? guix-revisions) - '(p "No revisions") - `(table - (@ (class "table")) - (thead - (tr - (th (@ (class "col-md-6")) "Source Repository URL") - (th (@ (class "col-md-6")) "Commit"))) - (tbody - ,@(map - (match-lambda - ((id url commit store_path) - `(tr - (td ,url) - (td (a (@ (href ,(string-append - "/revision/" commit))) - (samp ,commit)))))) - guix-revisions)))))) - (div - (@ (class "row")) - (div - (@ (class "col-sm-12")) - (h3 "Queued revisions") - ,(if (null? queued-guix-revisions) - '(p "No queued revisions") - `(table - (@ (class "table")) - (thead - (tr - (th (@ (class "col-md-4")) "Source Repository URL") - (th (@ (class "col-md-4")) "Commit") - (th (@ (class "col-md-4")) "Source"))) - (tbody - ,@(map - (match-lambda - ((id url commit source) - `(tr - (td ,url) - (td (samp ,commit)) - (td ,source)))) - queued-guix-revisions)))))))))) - + ,@(map + (match-lambda + (((id label url) . revisions) + `(div + (@ (class "row")) + (div + (@ (class "col-sm-12")) + (h3 ,url) + ,(if (null? revisions) + '(p "No revisions") + `(table + (@ (class "table")) + (thead + (tr + (th (@ (class "col-md-6")) "Commit"))) + (tbody + ,@(map + (match-lambda + ((id job-id commit source) + `(tr + (td ,(if (string-null? id) + `(samp ,commit) + `(a (@ (href ,(string-append + "/revision/" commit))) + (samp ,commit))))))) + revisions)))))))) + git-repositories-and-revisions))))) (define (view-statistics guix-revisions-count derivations-count) (layout diff --git a/sqitch/deploy/git_repositories.sql b/sqitch/deploy/git_repositories.sql new file mode 100644 index 0000000..e61c25b --- /dev/null +++ b/sqitch/deploy/git_repositories.sql @@ -0,0 +1,41 @@ +-- Deploy guix-data-service:git_repositories to pg +-- requires: initial_import + +BEGIN; + +CREATE TABLE git_repositories ( + id integer PRIMARY KEY GENERATED BY DEFAULT AS IDENTITY, + label character varying, + url character varying NOT NULL UNIQUE +); + +INSERT INTO git_repositories (url) +SELECT DISTINCT url FROM guix_revisions; + +-- Change the guix_revisions table + +ALTER TABLE guix_revisions ADD COLUMN git_repository_id integer +REFERENCES git_repositories (id); + +UPDATE guix_revisions SET git_repository_id = ( + SELECT id FROM git_repositories WHERE guix_revisions.url = git_repositories.url +); + +ALTER TABLE guix_revisions ALTER COLUMN git_repository_id SET NOT NULL; + +ALTER TABLE guix_revisions DROP COLUMN url; + +-- Change the load_new_guix_revision_jobs table + +ALTER TABLE load_new_guix_revision_jobs ADD COLUMN git_repository_id integer +REFERENCES git_repositories (id); + +UPDATE load_new_guix_revision_jobs SET git_repository_id = ( + SELECT id FROM git_repositories WHERE load_new_guix_revision_jobs.url = git_repositories.url +); + +ALTER TABLE load_new_guix_revision_jobs ALTER COLUMN git_repository_id SET NOT NULL; + +ALTER TABLE load_new_guix_revision_jobs DROP COLUMN url; + +COMMIT; diff --git a/sqitch/revert/git_repositories.sql b/sqitch/revert/git_repositories.sql new file mode 100644 index 0000000..25fca13 --- /dev/null +++ b/sqitch/revert/git_repositories.sql @@ -0,0 +1,27 @@ +-- Revert guix-data-service:git_repositories from pg + +BEGIN; + +ALTER TABLE guix_revisions ADD COLUMN url character varying; + +UPDATE guix_revisions SET url = ( + SELECT url FROM git_repositories WHERE guix_revisions.git_repository_id = git_repositories.id +); + +ALTER TABLE guix_revisions ALTER COLUMN url SET NOT NULL; + +ALTER TABLE guix_revisions DROP COLUMN git_repository_id; + +ALTER TABLE load_new_guix_revision_jobs ADD COLUMN url character varying; + +UPDATE load_new_guix_revision_jobs SET url = ( + SELECT url FROM git_repositories WHERE load_new_guix_revision_jobs.git_repository_id = git_repositories.id +); + +ALTER TABLE load_new_guix_revision_jobs ALTER COLUMN url SET NOT NULL; + +ALTER TABLE load_new_guix_revision_jobs DROP COLUMN git_repository_id; + +DROP TABLE git_repositories; + +COMMIT; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index 61fd9a9..97c152b 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -5,3 +5,4 @@ appschema 2019-04-13T11:43:59Z Christopher Baines # Add schema for the Guix Data Service buildstatus_enum [appschema] 2019-04-13T11:56:37Z Christopher Baines # Creates the buildstatus enum initial_import 2019-04-13T13:06:28Z Christopher Baines # Import the manually managed database schema +git_repositories 2019-05-04T19:03:38Z Christopher Baines # Add a git_repositories table diff --git a/sqitch/verify/git_repositories.sql b/sqitch/verify/git_repositories.sql new file mode 100644 index 0000000..b01ef94 --- /dev/null +++ b/sqitch/verify/git_repositories.sql @@ -0,0 +1,8 @@ +-- Verify guix-data-service:git_repositories on pg + +BEGIN; + +SELECT id, label, url + FROM git_repositories WHERE FALSE; + +ROLLBACK; diff --git a/tests/model-git-repository.scm b/tests/model-git-repository.scm new file mode 100644 index 0000000..3129203 --- /dev/null +++ b/tests/model-git-repository.scm @@ -0,0 +1,32 @@ +(define-module (test-model-git-repository) + #:use-module (srfi srfi-64) + #:use-module (guix-data-service database) + #:use-module (guix-data-service model git-repository)) + +(test-begin "test-model-git-repository") + +(with-postgresql-connection + (lambda (conn) + (test-assert "returns an id for a non existent URL" + (with-postgresql-transaction + conn + (lambda (conn) + (number? + (string->number + (git-repository-url->git-repository-id + conn + "test-non-existent-url")))) + #:always-rollback? #t)) + + (test-assert "returns the right id for an existing URL" + (with-postgresql-transaction + conn + (lambda (conn) + (let* ((url "test-url") + (id (git-repository-url->git-repository-id conn url))) + (string=? + id + (git-repository-url->git-repository-id conn url)))) + #:always-rollback? #t)))) + +(test-end) -- cgit v1.2.3