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

6 files changed, 341 insertions, 0 deletions

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