diff options
Diffstat (limited to 'guix-data-service/model')
| -rw-r--r-- | guix-data-service/model/derivation.scm | 70 | ||||
| -rw-r--r-- | guix-data-service/model/guix-revision-package.scm | 19 | ||||
| -rw-r--r-- | guix-data-service/model/guix-revision.scm | 39 | ||||
| -rw-r--r-- | guix-data-service/model/package-metadata.scm | 96 | ||||
| -rw-r--r-- | guix-data-service/model/package.scm | 90 | ||||
| -rw-r--r-- | guix-data-service/model/utils.scm | 27 |
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)) |