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. --- 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 +++++++++-------------- 6 files changed, 134 insertions(+), 76 deletions(-) create mode 100644 guix-data-service/model/git-repository.scm (limited to 'guix-data-service') 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 -- cgit v1.2.3