aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile.am5
-rw-r--r--guix-data-service/branch-updated-emails.scm33
-rw-r--r--guix-data-service/model/git-branch.scm57
-rw-r--r--guix-data-service/web/controller.scm38
-rw-r--r--guix-data-service/web/view/html.scm95
-rw-r--r--sqitch/deploy/git_branches.sql13
-rw-r--r--sqitch/revert/git_branches.sql7
-rw-r--r--sqitch/sqitch.plan1
-rw-r--r--sqitch/verify/git_branches.sql8
-rw-r--r--tests/branch-updated-emails.scm119
-rw-r--r--tests/model-git-branch.scm25
11 files changed, 382 insertions, 19 deletions
diff --git a/Makefile.am b/Makefile.am
index f61284a..1730c2f 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-branch.scm \
guix-data-service/model/git-repository.scm \
guix-data-service/model/guix-revision-package-derivation.scm \
guix-data-service/model/guix-revision.scm \
@@ -60,7 +61,9 @@ TEST_EXTENSIONS = .scm
TESTS = \
tests/model-derivation.scm \
- tests/model-git-repository.scm
+ tests/model-git-branch.scm \
+ tests/model-git-repository.scm \
+ tests/branch-updated-emails.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 16dced4..3c36f36 100644
--- a/guix-data-service/branch-updated-emails.scm
+++ b/guix-data-service/branch-updated-emails.scm
@@ -16,8 +16,10 @@
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service branch-updated-emails)
+ #:use-module (srfi srfi-19)
#:use-module (email email)
#:use-module (guix-data-service model git-repository)
+ #:use-module (guix-data-service model git-branch)
#:use-module (guix-data-service jobs load-new-guix-revision)
#:export (enqueue-job-for-email))
@@ -26,6 +28,7 @@
(define (enqueue-job-for-email conn email)
(let* ((headers (email-headers email))
+ (date (assq-ref headers 'date))
(x-git-repo (assq-ref headers 'x-git-repo))
(x-git-reftype (assq-ref headers 'x-git-reftype))
(x-git-refname (assq-ref headers 'x-git-refname))
@@ -35,11 +38,25 @@
(and (string? x-git-repo)
(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-newrev
- (string-append x-git-repo " " x-git-refname " updated")))))
+
+ (let ((branch-name
+ (string-drop x-git-refname 11))
+ (git-repository-id
+ (git-repository-url->git-repository-id
+ conn
+ (assoc-ref %repository-url-for-repo x-git-repo))))
+
+ (insert-git-branch-entry conn
+ branch-name
+ (if (string=? "0000000000000000000000000000000000000000"
+ x-git-newrev)
+ "NULL"
+ x-git-newrev)
+ git-repository-id
+ (date->string date "~4"))
+
+ (enqueue-load-new-guix-revision-job
+ conn
+ git-repository-id
+ x-git-newrev
+ (string-append x-git-repo " " x-git-refname " updated"))))))
diff --git a/guix-data-service/model/git-branch.scm b/guix-data-service/model/git-branch.scm
new file mode 100644
index 0000000..896e551
--- /dev/null
+++ b/guix-data-service/model/git-branch.scm
@@ -0,0 +1,57 @@
+(define-module (guix-data-service model git-branch)
+ #:use-module (squee)
+ #:export (insert-git-branch-entry
+ git-branches-for-commit
+ most-recent-100-commits-for-branch
+ all-branches-with-most-recent-commit))
+
+(define (insert-git-branch-entry conn
+ name commit
+ git-repository-id datetime)
+ (exec-query
+ conn
+ (string-append
+ "INSERT INTO git_branches (name, commit, git_repository_id, datetime) "
+ "VALUES ($1, $2, $3, $4) "
+ "ON CONFLICT DO NOTHING")
+ (list name
+ commit
+ git-repository-id
+ datetime)))
+
+(define (git-branches-for-commit conn commit)
+ (define query
+ "
+SELECT name, datetime FROM git_branches WHERE commit = $1
+ORDER BY datetime DESC")
+
+ (exec-query conn query (list commit)))
+
+(define (most-recent-100-commits-for-branch conn branch-name)
+ (define query
+ (string-append
+ "SELECT git_branches.commit, datetime, "
+ "(guix_revisions.id IS NOT NULL) as guix_revision_exists "
+ "FROM git_branches "
+ "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit "
+ "WHERE name = $1 ORDER BY datetime DESC LIMIT 100;"))
+
+ (exec-query
+ conn
+ query
+ (list branch-name)))
+
+(define (all-branches-with-most-recent-commit conn)
+ (define query
+ (string-append
+ "SELECT DISTINCT ON (name) name, git_branches.commit, "
+ "datetime, (guix_revisions.id IS NOT NULL) guix_revision_exists "
+ "FROM git_branches "
+ "LEFT OUTER JOIN guix_revisions ON git_branches.commit = guix_revisions.commit "
+ "WHERE git_branches.commit IS NOT NULL "
+ "ORDER BY name, datetime DESC;"))
+
+ (exec-query
+ conn
+ query))
+
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 6dda0da..26acfd4 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-branch)
#:use-module (guix-data-service model git-repository)
#:use-module (guix-data-service model guix-revision)
#:use-module (guix-data-service model package)
@@ -287,14 +288,24 @@
(match-lambda
((GET)
- (apply render-html (index
- (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)))))
+ (apply render-html
+ (index
+ (map
+ (lambda (git-repository-details)
+ (cons
+ git-repository-details
+ (map
+ (match-lambda
+ ((id job-id commit source)
+ (list id
+ job-id
+ commit
+ source
+ (git-branches-for-commit conn commit))))
+ (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)
@@ -331,6 +342,17 @@
commit-hash
name
version))))
+ ((GET "branches")
+ (apply render-html
+ (view-branches
+ (all-branches-with-most-recent-commit conn))))
+ ((GET "branch" branch-name)
+ (apply render-html
+ (view-branch
+ branch-name
+ (most-recent-100-commits-for-branch
+ conn
+ branch-name))))
((GET "gnu" "store" filename)
(if (string-suffix? ".drv" filename)
(render-derivation conn (string-append "/gnu/store/" filename))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 8c74c18..3593402 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -30,6 +30,8 @@
view-revision-package-and-version
view-revision
view-revision-packages
+ view-branches
+ view-branch
view-builds
view-derivation
view-store-item
@@ -160,13 +162,21 @@
(tbody
,@(map
(match-lambda
- ((id job-id commit source)
+ ((id job-id commit source branches)
`(tr
(td ,(if (string-null? id)
`(samp ,commit)
`(a (@ (href ,(string-append
"/revision/" commit)))
- (samp ,commit)))))))
+ (samp ,commit))))
+ (td
+ ,@(map
+ (match-lambda
+ ((name date)
+ `(a (@ (href ,(string-append
+ "/branch/" name)))
+ ,name)))
+ branches)))))
revisions))))))))
git-repositories-and-revisions)))))
@@ -348,6 +358,87 @@
"More information")))))
packages)))))))))
+(define (view-branches branches-with-most-recent-commits)
+ (layout
+ #:extra-headers
+ '((cache-control . ((max-age . 60))))
+ #:body
+ `(,(header)
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-md-12"))
+ (h1 "Branches")))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-md-12"))
+ (table
+ (@ (class "table table-responsive"))
+ (thead
+ (tr
+ (th (@ (class "col-md-3")) "Name")
+ (th (@ (class "col-md-3")) "Commit")
+ (th (@ (class "col-md-3")) "Date")))
+ (tbody
+ ,@(map
+ (match-lambda
+ ((name commit date revision-exists)
+ `(tr
+ (td
+ (a (@ (href ,(string-append "/branch/" name)))
+ ,name))
+ (td ,date)
+ (td ,(if (string=? revision-exists "t")
+ `(a (@ (href ,(string-append
+ "/revision/" commit)))
+ (samp ,commit))
+ `(samp ,(if (string=? commit "NULL")
+ "branch deleted"
+ commit)))))))
+ branches-with-most-recent-commits)))))))))
+
+(define (view-branch branch-name branch-commits)
+ (layout
+ #:extra-headers
+ '((cache-control . ((max-age . 60))))
+ #:body
+ `(,(header)
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-md-12"))
+ (h1 (@ (style "white-space: nowrap;"))
+ (samp ,branch-name) " branch")))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-md-12"))
+ (table
+ (@ (class "table table-responsive"))
+ (thead
+ (tr
+ (th (@ (class "col-md-3")) "Date")
+ (th (@ (class "col-md-3")) "Commit")))
+ (tbody
+ ,@(map
+ (match-lambda
+ ((commit date revision-exists)
+ `(tr
+ (td ,date)
+ (td ,(if (string=? revision-exists "t")
+ `(a (@ (href ,(string-append
+ "/revision/" commit)))
+ (samp ,commit))
+ `(samp ,(if (string=? commit "NULL")
+ "branch deleted"
+ commit)))))))
+ branch-commits)))))))))
+
(define (view-builds stats builds)
(layout
#:extra-headers
diff --git a/sqitch/deploy/git_branches.sql b/sqitch/deploy/git_branches.sql
new file mode 100644
index 0000000..4b926b5
--- /dev/null
+++ b/sqitch/deploy/git_branches.sql
@@ -0,0 +1,13 @@
+-- Deploy guix-data-service:git_branches to pg
+
+BEGIN;
+
+CREATE TABLE git_branches (
+ name character varying NOT NULL,
+ commit character varying,
+ git_repository_id integer NOT NULL,
+ datetime timestamp without time zone NOT NULL,
+ CONSTRAINT name_commit PRIMARY KEY(name, commit)
+);
+
+COMMIT;
diff --git a/sqitch/revert/git_branches.sql b/sqitch/revert/git_branches.sql
new file mode 100644
index 0000000..f04a167
--- /dev/null
+++ b/sqitch/revert/git_branches.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:git_branches from pg
+
+BEGIN;
+
+DROP TABLE git_branches;
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 97c152b..9e1c540 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -6,3 +6,4 @@ appschema 2019-04-13T11:43:59Z Christopher Baines <mail@cbaines.net> # Add schem
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
+git_branches 2019-05-05T14:53:12Z Christopher Baines <mail@cbaines.net> # Add a git_branches table
diff --git a/sqitch/verify/git_branches.sql b/sqitch/verify/git_branches.sql
new file mode 100644
index 0000000..2fec6f0
--- /dev/null
+++ b/sqitch/verify/git_branches.sql
@@ -0,0 +1,8 @@
+-- Verify guix-data-service:git_branches on pg
+
+BEGIN;
+
+SELECT name, commit, git_repository_id, datetime
+ FROM git_branches WHERE FALSE;
+
+ROLLBACK;
diff --git a/tests/branch-updated-emails.scm b/tests/branch-updated-emails.scm
new file mode 100644
index 0000000..0265ba4
--- /dev/null
+++ b/tests/branch-updated-emails.scm
@@ -0,0 +1,119 @@
+(define-module (test-branch-updated-emails)
+ #:use-module (srfi srfi-64)
+ #:use-module (email email)
+ #:use-module (guix-data-service database)
+ #:use-module (guix-data-service model git-repository)
+ #:use-module (guix-data-service branch-updated-emails))
+
+(define master-branch-updated-email
+ "Return-Path: <guix-commits-bounces+patchwork=mira.cbaines.net@gnu.org>
+X-Original-To: patchwork@mira.cbaines.net
+Delivered-To: patchwork@mira.cbaines.net
+Received: by mira.cbaines.net (Postfix, from userid 113)
+ id 893C316F50; Fri, 26 Apr 2019 13:19:54 +0100 (BST)
+X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net
+X-Spam-Level:
+X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED
+ autolearn=ham autolearn_force=no version=3.4.0
+Received: from lists.gnu.org (lists.gnu.org [209.51.188.17])
+ by mira.cbaines.net (Postfix) with ESMTP id 0169916F46
+ for <patchwork@mira.cbaines.net>; Fri, 26 Apr 2019 13:19:51 +0100 (BST)
+Received: from localhost ([127.0.0.1]:46383 helo=lists.gnu.org)
+ by lists.gnu.org with esmtp (Exim 4.71)
+ (envelope-from <guix-commits-bounces+patchwork=mira.cbaines.net@gnu.org>)
+ id 1hJzpX-0004ZG-5K
+ for patchwork@mira.cbaines.net; Fri, 26 Apr 2019 08:19:51 -0400
+Received: from eggs.gnu.org ([209.51.188.92]:41385)
+ by lists.gnu.org with esmtp (Exim 4.71)
+ (envelope-from <ludo@gnu.org>) id 1hJzpT-0004WT-2H
+ for guix-commits@gnu.org; Fri, 26 Apr 2019 08:19:47 -0400
+Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71)
+ (envelope-from <ludo@gnu.org>) id 1hJzpS-00037m-84
+ for guix-commits@gnu.org; Fri, 26 Apr 2019 08:19:47 -0400
+Received: from vcs0.savannah.gnu.org ([209.51.188.201]:48450)
+ by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from <ludo@gnu.org>)
+ id 1hJzpS-00037O-4X
+ for guix-commits@gnu.org; Fri, 26 Apr 2019 08:19:46 -0400
+Received: by vcs0.savannah.gnu.org (Postfix, from userid 68006)
+ id BD977209B1; Fri, 26 Apr 2019 08:19:45 -0400 (EDT)
+To: guix-commits@gnu.org
+Subject: branch master updated (9ca5ff8 -> 272db5b)
+MIME-Version: 1.0
+Content-Type: text/plain; charset=utf-8
+Message-ID: <20190426121944.32203.70977@vcs0.savannah.gnu.org>
+From: guix-commits@gnu.org
+Mail-Followup-To: guix-devel@gnu.org
+X-Git-Repo: guix
+X-Git-Refname: refs/heads/master
+X-Git-Reftype: branch
+X-Git-Oldrev: 9ca5ff882e2ac4eaab02eb0fde545bd784af478b
+X-Git-Newrev: 272db5bcf53d9d05d5c4b2df021d9e74f78866cd
+Auto-Submitted: auto-generated
+Date: Fri, 26 Apr 2019 08:19:45 -0400 (EDT)
+Content-Transfer-Encoding: quoted-printable
+X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic]
+X-Received-From: 209.51.188.201
+X-BeenThere: guix-commits@gnu.org
+X-Mailman-Version: 2.1.21
+Precedence: list
+List-Id: <guix-commits.gnu.org>
+List-Unsubscribe: <https://lists.gnu.org/mailman/options/guix-commits>,
+ <mailto:guix-commits-request@gnu.org?subject=unsubscribe>
+List-Archive: <http://lists.gnu.org/archive/html/guix-commits/>
+List-Post: <mailto:guix-commits@gnu.org>
+List-Help: <mailto:guix-commits-request@gnu.org?subject=help>
+List-Subscribe: <https://lists.gnu.org/mailman/listinfo/guix-commits>,
+ <mailto:guix-commits-request@gnu.org?subject=subscribe>
+Errors-To: guix-commits-bounces+patchwork=mira.cbaines.net@gnu.org
+Sender: \"Guix-commits\"
+ <guix-commits-bounces+patchwork=mira.cbaines.net@gnu.org>
+
+civodul pushed a change to branch master
+in repository guix.
+
+ from 9ca5ff8 bootstrap: Break automake dependency on generated f=
+iles.
+ new 504a0fc accounts: Always honor the configured user account =
+shell.
+ new 538b99f system: Provide a new VM image configuration.
+ new 6c849cd installer: Run wrapped program with 'execl', not 's=
+ystem'.
+ new 9529f78 installer: Take 'guix system init' exit code into a=
+ccount.
+ new 98f0354 installer: Actually reboot when the user presses \"R=
+eboot.\"
+ new b57dd20 doc: Add 'BASE-URL' variable.
+ new 272db5b doc: Use ftp.gnu.org for downloads.
+
+The 7 revisions listed above as \"new\" are entirely new to this
+repository and will be described in separate emails. The revisions
+listed as \"adds\" were already present in the repository and have only
+been added to this reference.
+
+
+Summary of changes:
+ doc/guix.texi | 39 ++++++++++-----
+ gnu/build/accounts.scm | 9 ++--
+ gnu/installer.scm | 22 +++++++--
+ gnu/installer/final.scm | 5 +-
+ gnu/installer/newt/final.scm | 5 +-
+ gnu/installer/utils.scm | 26 ++++++++--
+ gnu/system/examples/vm-image.tmpl | 99 +++++++++++++++++++++++++--------=
+------
+ 7 files changed, 140 insertions(+), 65 deletions(-)
+
+")
+
+(test-begin "test-branch-updated-emails")
+
+(with-postgresql-connection
+ (lambda (conn)
+ (test-assert "enqueue-job-for-email works"
+ (with-postgresql-transaction
+ conn
+ (lambda (conn)
+ (enqueue-job-for-email conn
+ (parse-email master-branch-updated-email)))
+ #:always-rollback? #t))))
+
+(test-end)
diff --git a/tests/model-git-branch.scm b/tests/model-git-branch.scm
new file mode 100644
index 0000000..f9b6206
--- /dev/null
+++ b/tests/model-git-branch.scm
@@ -0,0 +1,25 @@
+(define-module (test-model-git-branch)
+ #:use-module (srfi srfi-64)
+ #:use-module (guix-data-service database)
+ #:use-module (guix-data-service model git-repository)
+ #:use-module (guix-data-service model git-branch))
+
+(test-begin "test-model-git-branch")
+
+(with-postgresql-connection
+ (lambda (conn)
+ (test-assert "insert-git-branch-entry works"
+ (with-postgresql-transaction
+ conn
+ (lambda (conn)
+ (let* ((url "test-url")
+ (id (git-repository-url->git-repository-id conn url)))
+ (insert-git-branch-entry conn
+ "master"
+ "test-commit"
+ id
+ (strftime "%c" (gmtime (current-time)))))
+ #t)
+ #:always-rollback? #t))))
+
+(test-end)
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-01 19:28:14 +0000