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

Start to handle information about Git branches

Browse source 
Add some new pages /branches and /branch/... as well as a new git_branches
table. Also extend the email processing to enter the branch information in to
the database.
This commit is contained in:
Christopher Baines 2019-05-05 20:06:28 +01:00
parent ce4c3c6ed3
commit 5028dfe706
11 changed files with 382 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

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

@ -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
(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))
(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")))))
(string-append x-git-repo " " x-git-refname " updated"))))))

57
guix-data-service/model/git-branch.scm Normal file
View file

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

28
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-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,13 +288,23 @@
(match-lambda
((GET)
(apply render-html (index
(apply render-html
(index
(map
(lambda (git-repository-details)
(cons 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))))
(car git-repository-details)))))
(all-git-repositories conn)))))
((GET "builds")
(apply render-html
@ -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))

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

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

13
sqitch/deploy/git_branches.sql Normal file
View file

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

7
sqitch/revert/git_branches.sql Normal file
View file

@ -0,0 +1,7 @@
-- Revert guix-data-service:git_branches from pg
BEGIN;
DROP TABLE git_branches;
COMMIT;

1
sqitch/sqitch.plan
View file

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

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

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

119
tests/branch-updated-emails.scm Normal file
View file

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

25
tests/model-git-branch.scm Normal file
View file

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