cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch to storing Git repositories in a table

Browse source 
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.
This commit is contained in:
Christopher Baines 2019-05-05 13:35:48 +01:00
parent 051962b54d
commit ce4c3c6ed3
12 changed files with 246 additions and 77 deletions
Download patch file Download diff file Expand all files Collapse all files

4
Makefile.am
View file

@ -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)"

5
guix-data-service/branch-updated-emails.scm
View file

@ -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))
@ -35,8 +36,10 @@
(string=? x-git-repo "guix"))
(string? x-git-newrev))
(enqueue-load-new-guix-revision-job
conn
(git-repository-url->git-repository-id
conn
(assoc-ref %repository-url-for-repo
x-git-repo)
x-git-repo))
x-git-newrev
(string-append x-git-repo " " x-git-refname " updated")))))

44
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -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
(let* ((package-derivation-ids
(inferior-guix->package-derivation-ids store conn inf))
(guix-revision-id
(insert-guix-revision conn url commit store-path)))
(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 = '"

58
guix-data-service/model/git-repository.scm Normal file
View file

@ -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)))

11
guix-data-service/model/guix-revision.scm
View file

@ -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 "')"
";"))

10
guix-data-service/web/controller.scm
View file

@ -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)

48
guix-data-service/web/view/html.scm
View file

@ -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
,@(map
(match-lambda
(((id label url) . revisions)
`(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 "Recent fetched revisions")
,(if (null? guix-revisions)
(h3 ,url)
,(if (null? 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)
((id job-id commit source)
`(tr
(td ,url)
(td (a (@ (href ,(string-append
(td ,(if (string-null? id)
`(samp ,commit)
`(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))))))))))
(samp ,commit)))))))
revisions))))))))
git-repositories-and-revisions)))))
(define (view-statistics guix-revisions-count derivations-count)
(layout

41
sqitch/deploy/git_repositories.sql Normal file
View file

@ -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;

27
sqitch/revert/git_repositories.sql Normal file
View file

@ -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;

1
sqitch/sqitch.plan
View file

@ -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

8
sqitch/verify/git_repositories.sql Normal file
View file

@ -0,0 +1,8 @@
-- Verify guix-data-service:git_repositories on pg
BEGIN;
SELECT id, label, url
FROM git_repositories WHERE FALSE;
ROLLBACK;

32
tests/model-git-repository.scm Normal file
View file

@ -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)