aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am4
-rw-r--r--guix-data-service/branch-updated-emails.scm7
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm48
-rw-r--r--guix-data-service/model/git-repository.scm58
-rw-r--r--guix-data-service/model/guix-revision.scm11
-rw-r--r--guix-data-service/web/controller.scm10
-rw-r--r--guix-data-service/web/view/html.scm76
-rw-r--r--sqitch/deploy/git_repositories.sql41
-rw-r--r--sqitch/revert/git_repositories.sql27
-rw-r--r--sqitch/sqitch.plan1
-rw-r--r--sqitch/verify/git_repositories.sql8
-rw-r--r--tests/model-git-repository.scm32
12 files changed, 246 insertions, 77 deletions
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 <mail@cbaines.net> # Add schema for the Guix Data Service
buildstatus_enum [appschema] 2019-04-13T11:56:37Z Christopher Baines <mail@cbaines.net> # Creates the buildstatus enum
initial_import 2019-04-13T13:06:28Z Christopher Baines <mail@cbaines.net> # Import the manually managed database schema
+git_repositories 2019-05-04T19:03:38Z Christopher Baines <mail@cbaines.net> # 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)
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-29 18:47:31 +0000