Initial commit

This is a service designed to provide information about Guix. At the
moment, this initial prototype gathers up information about packages,
the associated metadata and derivations.

The initial primary use case is to compare two different revisions of
Guix, detecting which packages are new, no longer present, updated or
otherwise different.

It's based on the Mumi project.

[1]: https://git.elephly.net/software/mumi.git

16 files changed, 1529 insertions, 0 deletions

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
new file mode 100644
index 0000000..4dfd96e
--- /dev/null
+++ b/guix-data-service/comparison.scm
@@ -0,0 +1,122 @@
+(define-module (guix-data-service comparison)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:export (package-data->package-data-vhashes
+            package-differences-data
+            package-data-vhashes->new-packages
+            package-data-vhashes->removed-packages
+            package-data-version-changes
+            package-data-other-changes))
+
+(define (package-differences-data conn base_guix_revision_id target_guix_revision_id)
+  (define query
+    "WITH base_packages AS (
+  SELECT packages.* FROM packages INNER JOIN guix_revision_packages ON packages.id = guix_revision_packages.package_id WHERE revision_id = $1
+), target_packages AS (
+  SELECT packages.* FROM packages INNER JOIN guix_revision_packages ON packages.id = guix_revision_packages.package_id WHERE revision_id = $2
+)
+SELECT base_packages.name, base_packages.version, base_packages.package_metadata_id, base_packages.derivation_id, target_packages.name, target_packages.version, target_packages.package_metadata_id, target_packages.derivation_id
+FROM base_packages
+FULL OUTER JOIN target_packages ON base_packages.name = target_packages.name AND base_packages.version = target_packages.version
+WHERE (base_packages.id IS NULL OR target_packages.id IS NULL OR base_packages.id != target_packages.id)
+ORDER BY base_packages.name, base_packages.version, target_packages.name, target_packages.version")
+
+  (exec-query conn query (list base_guix_revision_id target_guix_revision_id)))
+
+(define (package-data->package-data-vhashes package-data)
+  (define (add-data-to-vhash data vhash)
+    (let ((key (first data)))
+      (if (string-null? key)
+          vhash
+          (vhash-cons key
+                      (drop data 1)
+                      vhash))))
+
+  (apply values
+         (fold (lambda (row result)
+                 (let-values (((base-row-part target-row-part) (split-at row 4)))
+                   (match result
+                     ((base-package-data target-package-data)
+                      (list (add-data-to-vhash base-row-part base-package-data)
+                            (add-data-to-vhash target-row-part target-package-data))))))
+               (list vlist-null vlist-null)
+               package-data)))
+
+(define (package-data-vhash->package-name-and-version-vhash vhash)
+  (vhash-fold (lambda (name details result)
+                (vhash-cons (cons name (first details))
+                            (cdr details)
+                            result))
+              vlist-null
+              vhash))
+
+(define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash)
+  (vlist->list
+   (vlist-filter (match-lambda
+                   ((name . details)
+                    (not (vhash-assoc name base-packages-vhash))))
+                 target-packages-vhash)))
+
+(define (package-data-vhashes->removed-packages base-packages-vhash target-packages-vhash)
+  (vlist->list
+   (vlist-filter (match-lambda
+                   ((name . details)
+                    (not (vhash-assoc name target-packages-vhash))))
+                 base-packages-vhash)))
+
+(define (package-data-vhash->package-versions-vhash package-data-vhash)
+  (vhash-fold (lambda (name details result)
+                (let ((version (first details))
+                      (known-versions (vhash-assoc name result)))
+                  (if known-versions
+                      (vhash-cons name
+                                  (cons version known-versions)
+                                  (vhash-delete name result))
+                      (vhash-cons name
+                                  (list version)
+                                  result))))
+              vlist-null
+              package-data-vhash))
+
+(define (package-data-version-changes base-packages-vhash target-packages-vhash)
+  (let ((base-versions (package-data-vhash->package-versions-vhash
+                        base-packages-vhash))
+        (target-versions (package-data-vhash->package-versions-vhash
+                          target-packages-vhash)))
+    (vhash-fold (lambda (name target-versions result)
+                  (let ((base-versions (and=> (vhash-assoc name base-versions)
+                                              cdr)))
+                    (if base-versions
+                        (begin
+                          (if (equal? base-versions target-versions)
+                              result
+                              `((,name . ((base . ,base-versions)
+                                          (target . ,target-versions)))
+                                ,@result)))
+                        result)))
+                '()
+                target-versions)))
+
+(define (package-data-other-changes base-packages-vhash target-packages-vhash)
+  (define base-package-details-by-name-and-version
+    (package-data-vhash->package-name-and-version-vhash base-packages-vhash))
+
+  (define target-package-details-by-name-and-version
+    (package-data-vhash->package-name-and-version-vhash target-packages-vhash))
+
+  (vhash-fold (lambda (name-and-version target-details result)
+                (let ((base-packages-entry
+                       (vhash-assoc name-and-version base-package-details-by-name-and-version)))
+                  (if base-packages-entry
+                      (let ((base-details (cdr base-packages-entry)))
+                        (if (equal? base-details target-details)
+                            result
+                            `((,name-and-version . ((base . ,base-details)
+                                                    (target . ,target-details)))
+                              ,@result)))
+                      result)))
+              '()
+              target-package-details-by-name-and-version))
diff --git a/guix-data-service/config.scm.in b/guix-data-service/config.scm.in
new file mode 100644
index 0000000..d2e699b
--- /dev/null
+++ b/guix-data-service/config.scm.in
@@ -0,0 +1,35 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service config)
+  #:export (%config))
+
+(define %config
+  (let ((config
+         ;; Try to find the "assets" directory relative to the executable
+         ;; first.  This is useful when using "pre-inst-env".
+         `((assets-dir  . ,(let ((maybe-dir
+                                  (string-append (getcwd) "/assets")))
+                             (if (file-exists? maybe-dir)
+                                 maybe-dir
+                                 ;; TODO: use @assetsdir@ variable here
+                                 "@prefix@/share/guix-data-service/assets")))
+           (host        . "localhost")
+           (port        . 8765))))
+    (lambda (key)
+      (assoc-ref config key))))
diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
new file mode 100644
index 0000000..0d5c266
--- /dev/null
+++ b/guix-data-service/jobs.scm
@@ -0,0 +1,11 @@
+(define-module (guix-data-service jobs)
+  #:use-module (ice-9 match)
+  #:use-module (guix-data-service jobs load-new-guix-revision)
+  #:export (process-jobs))
+
+(define (process-jobs conn)
+  (match (process-next-load-new-guix-revision-job conn)
+    (#f (begin (simple-format #t "Waiting for new jobs...")
+               (sleep 60)
+               (process-jobs conn)))
+    (_ (process-jobs conn))))
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
new file mode 100644
index 0000000..8aeef51
--- /dev/null
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -0,0 +1,90 @@
+(define-module (guix-data-service jobs load-new-guix-revision)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:use-module (guix monads)
+  #:use-module (guix store)
+  #:use-module (guix channels)
+  #:use-module (guix inferior)
+  #:use-module (guix profiles)
+  #:use-module (guix derivations)
+  #:use-module (guix-data-service model package)
+  #:use-module (guix-data-service model guix-revision)
+  #:use-module (guix-data-service model guix-revision-package)
+  #:use-module (guix-data-service model package-metadata)
+  #:use-module (guix-data-service model derivation)
+  #:export (process-next-load-new-guix-revision-job))
+
+(define (inferior-guix->package-ids store conn inf)
+  (let* ((packages (inferior-packages inf))
+         (packages-metadata-ids
+          (inferior-packages->package-metadata-ids conn packages))
+         (packages-derivation-ids
+          (inferior-packages->derivation-ids store conn packages)))
+
+    (inferior-packages->package-ids
+     conn packages packages-metadata-ids packages-derivation-ids)))
+
+(define (channel->manifest-store-item store channel)
+  (define (build-and-get-output-path store profile-derv)
+    (run-with-store store
+      (mbegin %store-monad
+        (built-derivations (list profile-derv))
+        (return (derivation->output-path profile-derv)))))
+
+  (let ((instances (latest-channel-instances store (list channel))))
+    (run-with-store store
+      (mlet* %store-monad ((manifest (channel-instances->manifest instances))
+                           (derv (profile-derivation manifest)))
+        ((store-lift build-and-get-output-path) derv)))))
+
+(define (channel->guix-store-item store channel)
+  (dirname
+   (readlink
+    (string-append (channel->manifest-store-item store channel)
+                   "/bin"))))
+
+(define (extract-information-from store conn url commit store_path)
+  (let ((inf (open-inferior store_path)))
+    (inferior-eval '(use-modules (guix grafts)) inf)
+    (inferior-eval '(%graft? #f) inf)
+
+    (let ((package-ids (inferior-guix->package-ids store conn inf)))
+      (exec-query conn "BEGIN")
+
+      (let ((guix-revision-id
+             (insert-guix-revision conn url commit store_path)))
+        (insert-guix-revision-packages conn guix-revision-id package-ids)))
+
+    (exec-query conn "COMMIT")
+
+    (close-inferior inf)))
+
+(define (load-new-guix-revision conn url commit)
+  (if (guix-revision-exists? conn url commit)
+      #t
+      (with-store store
+        (let ((store-item (channel->guix-store-item
+                           store
+                           (channel (name 'guix)
+                                    (url url)
+                                    (commit commit)))))
+          (extract-information-from store conn url commit store-item)))))
+
+(define (process-next-load-new-guix-revision-job conn)
+  (let ((next
+         (exec-query
+          conn
+          "SELECT * FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT 1")))
+    (match next
+      (((id url commit))
+       (begin
+         (simple-format #t "Processing job ~A (url: ~A, commit: ~A)\n\n"
+                        id url commit)
+         (load-new-guix-revision conn url commit)
+         (exec-query
+          conn
+          (string-append "DELETE FROM load_new_guix_revision_jobs WHERE id = '"
+                         id
+                         "'"))))
+      (_ #f))))
+
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
new file mode 100644
index 0000000..0dfa2af
--- /dev/null
+++ b/guix-data-service/model/derivation.scm
@@ -0,0 +1,70 @@
+(define-module (guix-data-service model derivation)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
+  #:use-module (squee)
+  #:use-module (guix inferior)
+  #:use-module (guix derivations)
+  #:use-module (guix-data-service model utils)
+  #:export (select-existing-derivations
+            insert-into-derivations
+            inferior-packages->derivation-ids))
+
+(define (select-existing-derivations file-names)
+  (string-append "SELECT id, file_name "
+                 "FROM derivations "
+                 "WHERE file_name IN "
+                 "(" (string-join (map (lambda (file-name)
+                                         (simple-format #f "'~A'" file-name))
+                                       file-names)
+                                  ",")
+                 ");"))
+
+(define (insert-into-derivations file-names)
+  (string-append "INSERT INTO derivations (file_name) VALUES "
+                 (string-join
+                  (map
+                   (lambda (file-name)
+                     (simple-format #f "('~A')" file-name))
+                   file-names)
+                  ",")
+                 " RETURNING id"
+                 ";"))
+
+(define (inferior-packages->derivation-ids store conn inferior-packages)
+  (let* ((package-derivation-file-names (map (lambda (package)
+                                               (derivation-file-name
+                                                (inferior-package-derivation
+                                                 store package)))
+                                             inferior-packages))
+
+         (existing-derivation-entries (exec-query->vhash
+                                       conn
+                                       (select-existing-derivations
+                                        package-derivation-file-names)
+                                       second ;; file_name
+                                       first)) ;; id
+
+         (missing-derivation-file-names
+          (filter (lambda (file-name)
+                    (not (vhash-assoc file-name
+                                      existing-derivation-entries)))
+                  package-derivation-file-names))
+         (new-derivation-entries
+          (if (null? missing-derivation-file-names)
+              '()
+              (map car
+                   (exec-query
+                    conn
+                    (insert-into-derivations
+                     missing-derivation-file-names)))))
+         (new-entries-id-lookup-vhash
+          (two-lists->vhash missing-derivation-file-names
+                            new-derivation-entries)))
+    (map (lambda (derivation-file-name)
+           (cdr
+            (or (vhash-assoc derivation-file-name
+                             existing-derivation-entries)
+                (vhash-assoc derivation-file-name
+                             new-entries-id-lookup-vhash)
+                (error "missing derivation id"))))
+         package-derivation-file-names)))
diff --git a/guix-data-service/model/guix-revision-package.scm b/guix-data-service/model/guix-revision-package.scm
new file mode 100644
index 0000000..2f710a4
--- /dev/null
+++ b/guix-data-service/model/guix-revision-package.scm
@@ -0,0 +1,19 @@
+(define-module (guix-data-service model guix-revision-package)
+  #:use-module (squee)
+  #:export (insert-guix-revision-packages))
+
+(define (insert-guix-revision-packages conn guix-revision-id package-ids)
+  (define insert
+    (string-append "INSERT INTO guix_revision_packages "
+                   "(revision_id, package_id) "
+                   "VALUES "
+                   (string-join (map (lambda (package-id)
+                                       (simple-format
+                                        #f "(~A, ~A)"
+                                        guix-revision-id
+                                        package-id))
+                                     package-ids)
+                                ", ")
+                   ";"))
+
+  (exec-query conn insert))
diff --git a/guix-data-service/model/guix-revision.scm b/guix-data-service/model/guix-revision.scm
new file mode 100644
index 0000000..d9a8976
--- /dev/null
+++ b/guix-data-service/model/guix-revision.scm
@@ -0,0 +1,39 @@
+(define-module (guix-data-service model guix-revision)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:export (most-recent-n-guix-revisions
+            commit->revision-id
+            insert-guix-revision
+            guix-revision-exists?))
+
+(define (most-recent-n-guix-revisions conn n)
+  (exec-query conn "SELECT * FROM guix_revisions ORDER BY id DESC LIMIT 10"))
+
+(define (commit->revision-id conn commit)
+  (match (exec-query
+          conn "SELECT id FROM guix_revisions WHERE commit = $1 LIMIT 1"
+          (list commit))
+    (((id))
+     id)))
+
+(define (insert-guix-revision conn url commit store_path)
+  (define insert
+    (string-append "INSERT INTO guix_revisions "
+                   "(url, commit, store_path) VALUES "
+                   "('" url "', '"
+                   commit "', '"
+                   store_path "') "
+                   "RETURNING id;"))
+
+  (map car (exec-query conn insert)))
+
+(define (guix-revision-exists? conn url commit)
+  (define query
+    (string-append "SELECT EXISTS("
+                   "SELECT 1 FROM guix_revisions WHERE url = '" url "' "
+                   "AND commit = '" commit "')"
+                   ";"))
+
+  (let ((result (caar
+                 (exec-query conn query))))
+    (string=? result "t")))
diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm
new file mode 100644
index 0000000..429538b
--- /dev/null
+++ b/guix-data-service/model/package-metadata.scm
@@ -0,0 +1,96 @@
+(define-module (guix-data-service model package-metadata)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:use-module (gcrypt hash)
+  #:use-module (rnrs bytevectors)
+  #:use-module (guix base16)
+  #:use-module (guix inferior)
+  #:use-module (guix-data-service model utils)
+  #:export (select-package-metadata
+            insert-package-metadata
+            inferior-packages->package-metadata-ids))
+
+(define (select-package-metadata hashes)
+  (string-append "SELECT id, sha1_hash "
+                 "FROM package_metadata "
+                 "WHERE sha1_hash IN ("
+                 (string-join (map (lambda (hash)
+                                     (simple-format #f "'~A'" hash))
+                                   hashes)
+                              ",")
+                 ");"))
+
+(define (insert-package-metadata metadata-rows)
+  (string-append "INSERT INTO package_metadata "
+                 "(sha1_hash, synopsis, description, home_page) "
+                 "VALUES "
+                 (string-join
+                  (map (match-lambda
+                         ((sha1_hash synopsis description home_page)
+                          (string-append
+                           "('" sha1_hash "',"
+                           (value->quoted-string-or-null synopsis) ","
+                           (value->quoted-string-or-null description) ","
+                           (value->quoted-string-or-null home_page) ")")))
+                       metadata-rows)
+                  ",")
+                 " RETURNING id"
+                 ";"))
+
+
+(define (inferior-packages->package-metadata-ids conn packages)
+  (define package-metadata
+    (map (lambda (package)
+           (let ((data (list (inferior-package-synopsis package)
+                             (inferior-package-description package)
+                             (inferior-package-home-page package))))
+             `(,(bytevector->base16-string
+                 (sha1 (string->utf8
+                        (string-join
+                         (map (lambda (d)
+                                (cond
+                                 ((string? d) d)
+                                 ((boolean? d) (simple-format #f "~A" d))
+                                 (else d)))
+                              data)
+                         ":"))))
+               ,@data)))
+         packages))
+
+  (define package-metadata-hashes
+    (map first package-metadata))
+
+  (let* ((existing-package-metadata-entries
+          (exec-query->vhash conn
+                             (select-package-metadata
+                              package-metadata-hashes)
+                             second ;; sha1_hash
+                             first)) ;; id))
+         (missing-package-metadata-entries
+          (delete-duplicates
+           (filter (lambda (metadata)
+                     (not (vhash-assoc (first metadata)
+                                       existing-package-metadata-entries)))
+                   package-metadata)))
+         (new-package-metadata-entries
+          (if (null? missing-package-metadata-entries)
+              '()
+              (map car (exec-query conn
+                                   (insert-package-metadata
+                                    missing-package-metadata-entries)))))
+         (new-entries-id-lookup-vhash
+          (two-lists->vhash (map first missing-package-metadata-entries)
+                            new-package-metadata-entries)))
+
+    (map (lambda (sha1-hash)
+           (cdr
+            (or (vhash-assoc sha1-hash
+                             existing-package-metadata-entries)
+                (vhash-assoc sha1-hash
+                             new-entries-id-lookup-vhash)
+                (begin
+                  sha1-hash
+                  (error "missing package-metadata entry")))))
+         package-metadata-hashes)))
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
new file mode 100644
index 0000000..c90fb04
--- /dev/null
+++ b/guix-data-service/model/package.scm
@@ -0,0 +1,90 @@
+(define-module (guix-data-service model package)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:use-module (guix inferior)
+  #:use-module (guix-data-service model utils)
+  #:export (select-existing-package-entries
+            insert-into-package-entries
+            inferior-packages->package-ids))
+
+(define (select-existing-package-entries package-entries)
+  (string-append "SELECT id, packages.name, packages.version, "
+                 "packages.package_metadata_id, packages.derivation_id "
+                 "FROM packages "
+                 "JOIN (VALUES "
+                 (string-join (map (lambda (package-entry)
+                                     (apply
+                                      simple-format
+                                      #f "('~A', '~A', ~A, ~A)"
+                                      package-entry))
+                                   package-entries)
+                              ", ")
+                 ") AS vals (name, version, package_metadata_id, derivation_id) "
+                 "ON packages.name = vals.name AND "
+                 "packages.version = vals.version AND "
+                 "packages.package_metadata_id = vals.package_metadata_id AND "
+                 "packages.derivation_id = vals.derivation_id"
+                 ";"))
+
+(define (insert-into-package-entries package-entries)
+  (string-append "INSERT INTO packages "
+                 "(name, version, package_metadata_id, derivation_id) VALUES "
+                 (string-join
+                  (map
+                   (match-lambda
+                     ((name version package_metadata_id derivation_id)
+                      (simple-format #f "('~A', '~A', ~A, ~A)"
+                                     name
+                                     version
+                                     package_metadata_id
+                                     derivation_id)))
+                   package-entries)
+                  ",")
+                 " RETURNING id"
+                 ";"))
+
+(define (inferior-packages->package-ids conn packages metadata-ids derivation-ids)
+  (define package-entries
+    (map (lambda (package metadata-id derivation-id)
+           (list (inferior-package-name package)
+                 (inferior-package-version package)
+                 metadata-id
+                 derivation-id))
+         packages
+         metadata-ids
+         derivation-ids))
+
+  (let* ((existing-package-entry-ids
+          (exec-query->vhash conn
+                             (select-existing-package-entries package-entries)
+                             ;; name, version, package_metadata_id and
+                             ;; derivation_id
+                             cdr
+                             first)) ;;id
+         (missing-package-entries
+          (filter (lambda (package-entry)
+                    (not (vhash-assoc package-entry
+                                      existing-package-entry-ids)))
+                  package-entries))
+         (new-package-entry-ids
+          (if (null? missing-package-entries)
+              '()
+              (map car
+                   (exec-query
+                    conn
+                    (insert-into-package-entries
+                     missing-package-entries)))))
+         (new-entries-id-lookup-vhash
+          (two-lists->vhash missing-package-entries
+                            new-package-entry-ids)))
+
+    (map (lambda (package-entry)
+           (cdr
+            (or (vhash-assoc package-entry
+                             existing-package-entry-ids)
+                (vhash-assoc package-entry
+                             new-entries-id-lookup-vhash)
+                (error "missing package entry"))))
+         package-entries)))
diff --git a/guix-data-service/model/utils.scm b/guix-data-service/model/utils.scm
new file mode 100644
index 0000000..df2acd9
--- /dev/null
+++ b/guix-data-service/model/utils.scm
@@ -0,0 +1,27 @@
+(define-module (guix-data-service model utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 vlist)
+  #:use-module (squee)
+  #:export (value->quoted-string-or-null
+            exec-query->vhash
+            two-lists->vhash))
+
+(define (value->quoted-string-or-null value)
+  (if (string? value)
+      (string-append "$STR$" value "$STR$")
+      "NULL"))
+
+(define (exec-query->vhash conn query field-function value-function)
+  (fold (lambda (row result)
+          (vhash-cons (field-function row)
+                      (value-function row)
+                      result))
+        vlist-null
+        (exec-query conn query)))
+
+(define (two-lists->vhash l1 l2)
+  (fold (lambda (key value result)
+          (vhash-cons key value result))
+        vlist-null
+        l1
+        l2))
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
new file mode 100644
index 0000000..1d7bd72
--- /dev/null
+++ b/guix-data-service/web/controller.scm
@@ -0,0 +1,96 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web controller)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (web request)
+  #:use-module (web uri)
+  #:use-module (squee)
+  #:use-module (guix-data-service comparison)
+  #:use-module (guix-data-service model guix-revision)
+  #:use-module (guix-data-service web render)
+  #:use-module (guix-data-service web util)
+  #:use-module (guix-data-service web view html)
+  #:export (controller))
+
+(define-syntax-rule (-> target functions ...)
+  (fold (lambda (f val) (and=> val f))
+        target
+        (list functions ...)))
+
+(define (render-with-error-handling page message)
+  (apply render-html (page))
+  ;; (catch #t
+  ;;   (lambda ()
+  ;;     (receive (sxml headers)
+  ;;         (pretty-print (page))
+  ;;       (render-html sxml headers)))
+  ;;   (lambda (key . args)
+  ;;     (format #t "ERROR: ~a ~a\n"
+  ;;             key args)
+  ;;     (render-html (error-page message))))
+  )
+
+(define (controller request body)
+  (define conn (connect-to-postgres-paramstring "dbname=guix_data_service"))
+
+  (match-lambda
+    ((GET)
+     (apply render-html (index (most-recent-n-guix-revisions conn 10))))
+    ((GET "compare")
+     (let ((base-commit (-> request
+                            request-uri
+                            uri-query
+                            parse-query-string
+                            (cut assoc-ref <> "base_commit")))
+           (target-commit (-> request
+                              request-uri
+                              uri-query
+                              parse-query-string
+                              (cut assoc-ref <> "target_commit"))))
+       (let-values
+           (((base-packages-vhash target-packages-vhash)
+             (package-data->package-data-vhashes
+              (package-differences-data conn
+                                        (commit->revision-id conn base-commit)
+                                        (commit->revision-id conn target-commit)))))
+         (let* ((new-packages
+                 (package-data-vhashes->new-packages base-packages-vhash
+                                                     target-packages-vhash))
+                (removed-packages
+                 (package-data-vhashes->removed-packages base-packages-vhash
+                                                         target-packages-vhash))
+                (version-changes
+                 (package-data-version-changes base-packages-vhash
+                                               target-packages-vhash))
+                (other-changes
+                 (package-data-other-changes base-packages-vhash
+                                             target-packages-vhash)))
+           (apply render-html
+                  (compare base-commit
+                           target-commit
+                           new-packages
+                           removed-packages
+                           version-changes
+                           other-changes))))))
+    ((GET path ...)
+     (render-static-asset request))))
diff --git a/guix-data-service/web/render.scm b/guix-data-service/web/render.scm
new file mode 100644
index 0000000..94cbf55
--- /dev/null
+++ b/guix-data-service/web/render.scm
@@ -0,0 +1,127 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;; This code was snarfed from David Thompson's guix-web.
+
+(define-module (guix-data-service web render)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:use-module (json)
+  #:use-module (guix-data-service config)
+  #:use-module (guix-data-service web sxml)
+  #:use-module (guix-data-service web util)
+  #:export (render-static-asset
+            render-html
+            render-json
+            not-found
+            unprocessable-entity
+            created
+            redirect))
+
+(define file-mime-types
+  '(("css" . (text/css))
+    ("js"  . (text/javascript))
+    ("svg" . (image/svg+xml))
+    ("png" . (image/png))
+    ("gif" . (image/gif))
+    ("woff" . (application/font-woff))
+    ("ttf"  . (application/octet-stream))
+    ("html" . (text/html))))
+
+(define (render-static-asset request)
+  (render-static-file (%config 'assets-dir) request))
+
+(define %not-slash
+  (char-set-complement (char-set #\/)))
+
+(define (render-static-file root request)
+  (define path
+    (uri-path (request-uri request)))
+
+  (define failure
+    (not-found (build-uri 'http
+                          #:host (%config 'host)
+                          #:port (%config 'port)
+                          #:path path)))
+
+  (let ((file-name (string-append root "/" path)))
+    (if (not (any (cut string-contains <> "..")
+                  (string-tokenize path %not-slash)))
+        (let* ((stat (stat file-name #f))
+               (modified (and stat
+                              (make-time time-utc 0 (stat:mtime stat)))))
+          (define (send-file)
+            (list `((content-type
+                     . ,(assoc-ref file-mime-types
+                                   (file-extension file-name)))
+                    (last-modified . ,(time-utc->date modified)))
+                  (call-with-input-file file-name get-bytevector-all)))
+
+          (if (and stat (not (eq? 'directory (stat:type stat))))
+              (cond ((assoc-ref (request-headers request) 'if-modified-since)
+                     =>
+                     (lambda (client-date)
+                       (if (time>? modified (date->time-utc client-date))
+                           (send-file)
+                           (list (build-response #:code 304) ;"Not Modified"
+                                 #f))))
+                    (else
+                     (send-file)))
+              failure))
+        failure)))
+
+(define* (render-html #:key sxml (extra-headers '()))
+  (list (append extra-headers
+                '((content-type . (text/html))))
+        (lambda (port)
+          (sxml->html sxml port))))
+
+(define (render-json json)
+  (list '((content-type . (application/json)))
+        (lambda (port)
+          (scm->json json port))))
+
+(define (not-found uri)
+  (list (build-response #:code 404)
+        (string-append "Resource not found: " (uri->string uri))))
+
+(define (unprocessable-entity)
+  (list (build-response #:code 422)
+        ""))
+
+(define (created)
+  (list (build-response #:code 201)
+        ""))
+
+(define (redirect path)
+  (let ((uri (build-uri 'http
+                        #:host (%config 'host)
+                        #:port (%config 'port)
+                        #:path (string-append
+                                "/" (encode-and-join-uri-path path)))))
+    (list (build-response
+           #:code 301
+           #:headers `((content-type . (text/html))
+                       (location . ,uri)))
+          (format #f "Redirect to ~a" (uri->string uri)))))
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
new file mode 100644
index 0000000..2077629
--- /dev/null
+++ b/guix-data-service/web/server.scm
@@ -0,0 +1,45 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web server)
+  #:use-module (srfi srfi-1)
+  #:use-module (web http)
+  #:use-module (web request)
+  #:use-module (web uri)
+  #:use-module (fibers web server)
+  #:use-module (guix-data-service web controller)
+  #:use-module (guix-data-service web util)
+  #:export (start-guix-data-service-web-server))
+
+(define (run-controller controller request body)
+  ((controller request body)
+   (cons (request-method request)
+         (request-path-components request))))
+
+(define (handler request body controller)
+  (format #t "~a ~a\n"
+          (request-method request)
+          (uri-path (request-uri request)))
+  (apply values
+         (run-controller controller request body)))
+
+(define (start-guix-data-service-web-server port)
+  (run-server (lambda (request body)
+                (handler request body controller))
+              #:addr INADDR_ANY
+              #:port port))
diff --git a/guix-data-service/web/sxml.scm b/guix-data-service/web/sxml.scm
new file mode 100644
index 0000000..468b81f
--- /dev/null
+++ b/guix-data-service/web/sxml.scm
@@ -0,0 +1,371 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2016, 2017  Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2015  David Thompson <davet@gnu.org>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; SXML to HTML conversion.
+;;
+;;; Code:
+
+(define-module (guix-data-service web sxml)
+  #:use-module (sxml simple)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 hash-table)
+  #:export (sxml->html))
+
+(define %self-closing-tags
+  '(area
+    base
+    br
+    col
+    command
+    embed
+    hr
+    img
+    input
+    keygen
+    link
+    meta
+    param
+    source
+    track
+    wbr))
+
+(define (self-closing-tag? tag)
+  "Return #t if TAG is self-closing."
+  (pair? (memq tag %self-closing-tags)))
+
+(define %escape-chars
+  (alist->hash-table
+   '((#\" . "quot")
+     (#\& . "amp")
+     (#\' . "apos")
+     (#\< . "lt")
+     (#\> . "gt")
+     (#\¡ . "iexcl")
+     (#\¢ . "cent")
+     (#\£ . "pound")
+     (#\¤ . "curren")
+     (#\¥ . "yen")
+     (#\¦ . "brvbar")
+     (#\§ . "sect")
+     (#\¨ . "uml")
+     (#\© . "copy")
+     (#\ª . "ordf")
+     (#\« . "laquo")
+     (#\¬ . "not")
+     (#\® . "reg")
+     (#\¯ . "macr")
+     (#\° . "deg")
+     (#\± . "plusmn")
+     (#\² . "sup2")
+     (#\³ . "sup3")
+     (#\´ . "acute")
+     (#\µ . "micro")
+     (#\¶ . "para")
+     (#\· . "middot")
+     (#\¸ . "cedil")
+     (#\¹ . "sup1")
+     (#\º . "ordm")
+     (#\» . "raquo")
+     (#\¼ . "frac14")
+     (#\½ . "frac12")
+     (#\¾ . "frac34")
+     (#\¿ . "iquest")
+     (#\À . "Agrave")
+     (#\Á . "Aacute")
+     (#\Â . "Acirc")
+     (#\Ã . "Atilde")
+     (#\Ä . "Auml")
+     (#\Å . "Aring")
+     (#\Æ . "AElig")
+     (#\Ç . "Ccedil")
+     (#\È . "Egrave")
+     (#\É . "Eacute")
+     (#\Ê . "Ecirc")
+     (#\Ë . "Euml")
+     (#\Ì . "Igrave")
+     (#\Í . "Iacute")
+     (#\Î . "Icirc")
+     (#\Ï . "Iuml")
+     (#\Ð . "ETH")
+     (#\Ñ . "Ntilde")
+     (#\Ò . "Ograve")
+     (#\Ó . "Oacute")
+     (#\Ô . "Ocirc")
+     (#\Õ . "Otilde")
+     (#\Ö . "Ouml")
+     (#\× . "times")
+     (#\Ø . "Oslash")
+     (#\Ù . "Ugrave")
+     (#\Ú . "Uacute")
+     (#\Û . "Ucirc")
+     (#\Ü . "Uuml")
+     (#\Ý . "Yacute")
+     (#\Þ . "THORN")
+     (#\ß . "szlig")
+     (#\à . "agrave")
+     (#\á . "aacute")
+     (#\â . "acirc")
+     (#\ã . "atilde")
+     (#\ä . "auml")
+     (#\å . "aring")
+     (#\æ . "aelig")
+     (#\ç . "ccedil")
+     (#\è . "egrave")
+     (#\é . "eacute")
+     (#\ê . "ecirc")
+     (#\ë . "euml")
+     (#\ì . "igrave")
+     (#\í . "iacute")
+     (#\î . "icirc")
+     (#\ï . "iuml")
+     (#\ð . "eth")
+     (#\ñ . "ntilde")
+     (#\ò . "ograve")
+     (#\ó . "oacute")
+     (#\ô . "ocirc")
+     (#\õ . "otilde")
+     (#\ö . "ouml")
+     (#\÷ . "divide")
+     (#\ø . "oslash")
+     (#\ù . "ugrave")
+     (#\ú . "uacute")
+     (#\û . "ucirc")
+     (#\ü . "uuml")
+     (#\ý . "yacute")
+     (#\þ . "thorn")
+     (#\ÿ . "yuml")
+     (#\Π. "OElig")
+     (#\œ . "oelig")
+     (#\Š . "Scaron")
+     (#\š . "scaron")
+     (#\Ÿ . "Yuml")
+     (#\ƒ . "fnof")
+     (#\ˆ . "circ")
+     (#\˜ . "tilde")
+     (#\Α . "Alpha")
+     (#\Β . "Beta")
+     (#\Γ . "Gamma")
+     (#\Δ . "Delta")
+     (#\Ε . "Epsilon")
+     (#\Ζ . "Zeta")
+     (#\Η . "Eta")
+     (#\Θ . "Theta")
+     (#\Ι . "Iota")
+     (#\Κ . "Kappa")
+     (#\Λ . "Lambda")
+     (#\Μ . "Mu")
+     (#\Ν . "Nu")
+     (#\Ξ . "Xi")
+     (#\Ο . "Omicron")
+     (#\Π . "Pi")
+     (#\Ρ . "Rho")
+     (#\Σ . "Sigma")
+     (#\Τ . "Tau")
+     (#\Υ . "Upsilon")
+     (#\Φ . "Phi")
+     (#\Χ . "Chi")
+     (#\Ψ . "Psi")
+     (#\Ω . "Omega")
+     (#\α . "alpha")
+     (#\β . "beta")
+     (#\γ . "gamma")
+     (#\δ . "delta")
+     (#\ε . "epsilon")
+     (#\ζ . "zeta")
+     (#\η . "eta")
+     (#\θ . "theta")
+     (#\ι . "iota")
+     (#\κ . "kappa")
+     (#\λ . "lambda")
+     (#\μ . "mu")
+     (#\ν . "nu")
+     (#\ξ . "xi")
+     (#\ο . "omicron")
+     (#\π . "pi")
+     (#\ρ . "rho")
+     (#\ς . "sigmaf")
+     (#\σ . "sigma")
+     (#\τ . "tau")
+     (#\υ . "upsilon")
+     (#\φ . "phi")
+     (#\χ . "chi")
+     (#\ψ . "psi")
+     (#\ω . "omega")
+     (#\ϑ . "thetasym")
+     (#\ϒ . "upsih")
+     (#\ϖ . "piv")
+     (#\  . "ensp")
+     (#\  . "emsp")
+     (#\  . "thinsp")
+     (#\– . "ndash")
+     (#\— . "mdash")
+     (#\‘ . "lsquo")
+     (#\’ . "rsquo")
+     (#\‚ . "sbquo")
+     (#\“ . "ldquo")
+     (#\” . "rdquo")
+     (#\„ . "bdquo")
+     (#\† . "dagger")
+     (#\‡ . "Dagger")
+     (#\• . "bull")
+     (#\… . "hellip")
+     (#\‰ . "permil")
+     (#\′ . "prime")
+     (#\″ . "Prime")
+     (#\‹ . "lsaquo")
+     (#\› . "rsaquo")
+     (#\‾ . "oline")
+     (#\⁄ . "frasl")
+     (#\€ . "euro")
+     (#\ℑ . "image")
+     (#\℘ . "weierp")
+     (#\ℜ . "real")
+     (#\™ . "trade")
+     (#\ℵ . "alefsym")
+     (#\← . "larr")
+     (#\↑ . "uarr")
+     (#\→ . "rarr")
+     (#\↓ . "darr")
+     (#\↔ . "harr")
+     (#\↵ . "crarr")
+     (#\⇐ . "lArr")
+     (#\⇑ . "uArr")
+     (#\⇒ . "rArr")
+     (#\⇓ . "dArr")
+     (#\⇔ . "hArr")
+     (#\∀ . "forall")
+     (#\∂ . "part")
+     (#\∃ . "exist")
+     (#\∅ . "empty")
+     (#\∇ . "nabla")
+     (#\∈ . "isin")
+     (#\∉ . "notin")
+     (#\∋ . "ni")
+     (#\∏ . "prod")
+     (#\∑ . "sum")
+     (#\− . "minus")
+     (#\∗ . "lowast")
+     (#\√ . "radic")
+     (#\∝ . "prop")
+     (#\∞ . "infin")
+     (#\∠ . "ang")
+     (#\∧ . "and")
+     (#\∨ . "or")
+     (#\∩ . "cap")
+     (#\∪ . "cup")
+     (#\∫ . "int")
+     (#\∴ . "there4")
+     (#\∼ . "sim")
+     (#\≅ . "cong")
+     (#\≈ . "asymp")
+     (#\≠ . "ne")
+     (#\≡ . "equiv")
+     (#\≤ . "le")
+     (#\≥ . "ge")
+     (#\⊂ . "sub")
+     (#\⊃ . "sup")
+     (#\⊄ . "nsub")
+     (#\⊆ . "sube")
+     (#\⊇ . "supe")
+     (#\⊕ . "oplus")
+     (#\⊗ . "otimes")
+     (#\⊥ . "perp")
+     (#\⋅ . "sdot")
+     (#\⋮ . "vellip")
+     (#\⌈ . "lceil")
+     (#\⌉ . "rceil")
+     (#\⌊ . "lfloor")
+     (#\⌋ . "rfloor")
+     (#\〈 . "lang")
+     (#\〉 . "rang")
+     (#\◊ . "loz")
+     (#\♠ . "spades")
+     (#\♣ . "clubs")
+     (#\♥ . "hearts")
+     (#\♦ . "diams"))))
+
+(define (string->escaped-html s port)
+  "Write the HTML escaped form of S to PORT."
+  (define (escape c)
+    (let ((escaped (hash-ref %escape-chars c)))
+      (if escaped
+          (format port "&~a;" escaped)
+          (display c port))))
+  (string-for-each escape s))
+
+(define (object->escaped-html obj port)
+  "Write the HTML escaped form of OBJ to PORT."
+  (string->escaped-html
+   (call-with-output-string (cut display obj <>))
+   port))
+
+(define (attribute-value->html value port)
+  "Write the HTML escaped form of VALUE to PORT."
+  (if (string? value)
+      (string->escaped-html value port)
+      (object->escaped-html value port)))
+
+(define (attribute->html attr value port)
+  "Write ATTR and VALUE to PORT."
+  (format port "~a=\"" attr)
+  (attribute-value->html value port)
+  (display #\" port))
+
+(define (element->html tag attrs body port)
+  "Write the HTML TAG to PORT, where TAG has the attributes in the
+list ATTRS and the child nodes in BODY."
+  (format port "<~a" tag)
+  (for-each (match-lambda
+             ((attr value)
+              (display #\space port)
+              (attribute->html attr value port)))
+            attrs)
+  (if (and (null? body) (self-closing-tag? tag))
+      (display " />" port)
+      (begin
+        (display #\> port)
+        (for-each (cut sxml->html <> port) body)
+        (format port "</~a>" tag))))
+
+(define (doctype->html doctype port)
+  (format port "<!DOCTYPE ~a>" doctype))
+
+(define* (sxml->html tree #:optional (port (current-output-port)))
+  "Write the serialized HTML form of TREE to PORT."
+  (match tree
+    (() *unspecified*)
+    (('doctype type)
+     (doctype->html type port))
+    ;; Unescaped, raw HTML output
+    (('raw html)
+     (display html port))
+    (((? symbol? tag) ('@ attrs ...) body ...)
+     (element->html tag attrs body port))
+    (((? symbol? tag) body ...)
+     (element->html tag '() body port))
+    ((nodes ...)
+     (for-each (cut sxml->html <> port) nodes))
+    ((? string? text)
+     (string->escaped-html text port))
+    ;; Render arbitrary Scheme objects, too.
+    (obj (object->escaped-html obj port))))
diff --git a/guix-data-service/web/util.scm b/guix-data-service/web/util.scm
new file mode 100644
index 0000000..1938890
--- /dev/null
+++ b/guix-data-service/web/util.scm
@@ -0,0 +1,45 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2016, 2017  Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2014  David Thompson <davet@gnu.org>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web util)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (web request)
+  #:use-module (web uri)
+  #:export (parse-query-string
+            request-path-components
+            file-extension
+            directory?))
+
+(define (parse-query-string query)
+  "Parse and decode the URI query string QUERY and return an alist."
+  (let lp ((lst (map uri-decode (string-split query (char-set #\& #\=)))))
+    (match lst
+      ((key value . rest)
+       (cons (cons key value) (lp rest)))
+      (() '()))))
+
+(define (request-path-components request)
+  (split-and-decode-uri-path (uri-path (request-uri request))))
+
+(define (file-extension file-name)
+  (last (string-split file-name #\.)))
+
+(define (directory? filename)
+  (string=? filename (dirname filename)))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
new file mode 100644
index 0000000..9699ef6
--- /dev/null
+++ b/guix-data-service/web/view/html.scm
@@ -0,0 +1,246 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service web view html)
+  #:use-module (guix-data-service config)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:export (index
+            compare
+            unknown
+            error-page))
+
+(define* (header)
+  `(nav
+    (@ (id "header") (class "navbar navbar-default"))
+    (div
+     (@ (class "container-fluid"))
+     (div
+      (@ (class "navbar-header"))
+      (div (@ (class "navbar-brand"))
+           (a (@ (href "/") (class "logo"))))))))
+
+(define* (layout #:key
+                 (head '())
+                 (body '())
+                 (title "Guix Data Service")
+                 (extra-headers '()))
+  `(#:sxml ((doctype "html")
+            (html
+             (head
+              (title ,title)
+              (meta (@ (http-equiv "Content-Type")
+                       (content "text/html; charset=UTF-8")))
+              (meta (@ (http-equiv "Content-Language") (content "en")))
+              (meta (@ (name "author") (content "Christopher Baines")))
+              (meta (@ (name "viewport")
+                       (content "width=device-width, initial-scale=1")))
+              (link
+               (@ (rel "stylesheet")
+                  (media "screen")
+                  (type "text/css")
+                  (href "/css/reset.css")))
+              (link
+               (@ (rel "stylesheet")
+                  (media "screen")
+                  (type "text/css")
+                  (href "/css/bootstrap.css")))
+              ,@head
+              (link
+               (@ (rel "stylesheet")
+                  (media "screen")
+                  (type "text/css")
+                  (href "/css/screen.css"))))
+             (body ,@body
+                   (footer
+                    (p "Copyright © 2016—2019 by the GNU Guix community."
+                       (br)
+                       "Now with even more " (span (@ (class "lambda")) "λ") "! ")
+                    (p "This is free software.  Download the "
+                       (a (@ (href "https://git.cbaines.net/guix/data-service/"))
+                          "source code here") ".")))))
+    #:extra-headers ,extra-headers))
+
+(define (index guix-revisions)
+  (layout
+   #:extra-headers
+   '((cache-control . ((max-age . 60))))
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (h1 "Guix Data Service")
+      (form (@ (id "compare")
+               (action "/compare"))
+            (div
+             (@ (class "form-group"))
+             (label (@ (for "base_commit"))
+                    "Base commit")
+             (input (@ (type "text")
+                       (class "form-control")
+                       (id   "base_commit")
+                       (name "base_commit")
+                       (placeholder "base commit"))))
+            (div
+             (@ (class "form-group"))
+             (label (@ (for "target_commit"))
+                    "Target commit")
+             (input (@ (type "text")
+                       (class "form-control")
+                       (id   "target_commit")
+                       (name "target_commit")
+                       (placeholder "target commit"))))
+            (button
+             (@ (type "submit")
+                (class "btn btn-lg btn-primary"))
+             "Compare"))
+      (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 (samp ,commit)))))
+                 guix-revisions))))))))
+
+(define (compare base-commit
+                 target-commit
+                 new-packages
+                 removed-packages
+                 version-changes
+                 other-changes)
+  (layout
+   #:extra-headers
+   '((cache-control . ((max-age . 60))))
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (h1 "Comparing "
+          (samp ,(string-take base-commit 8) "…")
+          " and "
+          (samp ,(string-take target-commit 8) "…"))
+      (h3 "New packages")
+      ,(if (null? new-packages)
+           '(p "No new packages")
+           `(table
+             (@ (class "table"))
+             (thead
+              (tr
+               (th (@ (class "col-md-3")) "Name")
+               (th (@ (class "col-md-9")) "Version")))
+             (tbody
+              ,@(map
+                 (match-lambda
+                   ((name . version)
+                    `(tr
+                      (td ,name)
+                      (td ,version))))
+                 new-packages))))
+      (h3 "Removed packages")
+      ,(if (null? removed-packages)
+           '(p "No removed packages")
+           `(table
+             (@ (class "table"))
+             (thead
+              (tr
+               (th (@ (class "col-md-3")) "Name")
+               (th (@ (class "col-md-9")) "Version")))
+             (tbody
+              ,@(map
+                 (match-lambda
+                   ((name . version)
+                    `(tr
+                      (td ,name)
+                      (td ,version))))
+                 removed-packages))))
+      (h3 "Version changes")
+      ,(if (null? version-changes)
+           '(p "No version changes")
+           `(table
+             (@ (class "table"))
+             (thead
+              (tr
+               (th (@ (class "col-md-3")) "Name")
+               (th (@ (class "col-md-9")) "Versions")))
+             (tbody
+              ,@(map
+                 (match-lambda
+                   ((name . versions)
+                    `(tr
+                      (td ,name)
+                      (td (ul
+                           ,@(map (match-lambda
+                                    ((type . version)
+                                     `(li (@ (class ,(if (eq? type 'base)
+                                                         "text-danger"
+                                                         "text-success")))
+                                          ,version
+                                          ,(if (eq? type 'base)
+                                               " (old)"
+                                               " (new)"))))
+                                  versions))))))
+                 version-changes))))
+      (h3 "Other changed packages")
+      ,@(if (null? other-changes)
+           '((p "No other changes"))
+           `((p "The metadata or derivation for these packages has changed.")
+             (table
+              (@ (class "table"))
+              (thead
+               (tr
+                (th (@ (class "col-md-3")) "Name")
+                (th (@ (class "col-md-9")) "Version")))
+              (tbody
+               ,@(map
+                  (match-lambda
+                    (((name . version) . (metadata-id derivation-id))
+                     `(tr
+                       (td ,name)
+                       (td ,version))))
+                  other-changes)))))))))
+
+(define (unknown id)
+  (layout
+   #:body
+   `(,(header)
+     (div (@ (class "container"))
+          (h1 "Patch not found")
+          (p "There is no submission with id " (strong ,id))
+          (p (a (@ (href "/")) "Try another one?"))))))
+
+(define (error-page message)
+  (layout
+   #:body
+   `(,(header)
+     (div (@ (class "container"))
+          (h1 "Error")
+          (p "An error occurred.  Sorry about that!")
+          ,message
+          (p (a (@ (href "/")) "Try something else?"))))))