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.

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

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

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
+        (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)
+(define (load-new-guix-revision conn git-repository-id commit)
-  (if (guix-revision-exists? conn url 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"
+         (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n"
-                        id url commit source)
+                        id commit source)
-         (load-new-guix-revision conn url commit)
+         (load-new-guix-revision conn git-repository-id commit)
          (exec-query
           conn
           (string-append "DELETE FROM load_new_guix_revision_jobs WHERE id = '"

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

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 "
+                   "(git_repository_id, commit, store_path) VALUES "
-                   "('" url "', '"
+                   "(" 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 "')"
                    ";"))
 

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)
+                         (map
-                         (most-recent-n-load-new-guix-revision-jobs conn 1000))))
+                          (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)

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

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;

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;

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

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;

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)