>From e3619f840c69ea75669cf302fa3054ddc53aefb5 Mon Sep 17 00:00:00 2001 From: Caleb Ristvedt Date: Mon, 5 Jun 2017 21:31:24 -0500 Subject: [PATCH 4/7] guix: sql.scm: split into generic and store-specific parts. * guix/sql.scm (path-id-sql, path-id, update-sql, insert-sql, update-or-insert, add-reference-sql, add-references, sqlite-register): removed. (sqlite-parameter-index): new procedure. (sqlite-parameters): use sqlite-parameter-index, works with parameter names instead of indexes now. Updated callers. * guix/store/database.scm: new file. (path-id-sql, path-id, update-sql, insert-sql, update-or-insert, add-reference-sql, add-references, sqlite-register): added. * guix/store.scm: use (guix store database) instead of (guix sql). --- guix/sql.scm | 134 ++++++++++++------------------------------------ guix/store.scm | 2 +- guix/store/database.scm | 104 +++++++++++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+), 102 deletions(-) create mode 100644 guix/store/database.scm diff --git a/guix/sql.scm b/guix/sql.scm index d5c72105b..6b6f7867d 100644 --- a/guix/sql.scm +++ b/guix/sql.scm @@ -21,7 +21,20 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-9) - #:export (sqlite-register)) + #:export (sqlite-last-insert-rowid + sql-parameters + with-sql-statement + with-sql-database + run-sql + run-statement + single-result) + #:re-export (sqlite-step + sqlite-fold + sqlite-fold-right + sqlite-map + sqlite-prepare + sqlite-reset + sqlite-finalize)) ;; Miscellaneous SQL stuff, currently just setup for sqlite-register. Mostly ;; macros. @@ -37,16 +50,31 @@ "Gives the row id of the last inserted row in DB." (last-rowid ((@@ (sqlite3) db-pointer) db))))) +(define sqlite-parameter-index + (let ((param-index (pointer->procedure + int + (dynamic-func "sqlite3_bind_parameter_index" + (@@ (sqlite3) libsqlite3)) + (list '* '*)))) + (lambda (statement key) + "Gives the index of an sqlite parameter for a certain statement with a +certain (string) name." + (param-index ((@@ (sqlite3) stmt-pointer) statement) + (string->pointer key "utf-8"))))) + -;; Should I go from key->index here or try to change that in guile-sqlite3? (define-syntax sql-parameters (syntax-rules () "Converts key-value pairs into sqlite bindings for a specific statement." ((sql-parameters statement (name1 val1) (name2 val2) (name3 val3) ...) - (begin (sqlite-bind statement name1 val1) + (begin (sqlite-bind statement + (sqlite-parameter-index statement name1) + val1) (sql-parameters statement (name2 val2) (name3 val3) ...))) ((sql-parameters statement (name value)) - (sqlite-bind statement name value)))) + (sqlite-bind statement + (sqlite-parameter-index statement name) + value)))) (define* (step-all statement #:optional (callback noop)) "Step until statement is completed. Return number of rows." @@ -141,8 +169,7 @@ placeholder name and the value to use. Returns the number of rows." (lambda () (sqlite-reset statement)))))) -(define path-id-sql - "SELECT id FROM ValidPaths WHERE path = $path") + (define (single-result statement) "Gives the first element of the first row returned by statement." @@ -150,98 +177,3 @@ placeholder name and the value to use. Returns the number of rows." (if row (vector-ref row 0) #f))) - -(define* (path-id db path) - "If the path \"path\" exists in the ValidPaths table, return its -id. Otherwise, return #f. If you already have a compiled statement for this -purpose, you can give it as statement." - (with-sql-statement - db path-id-sql statement - (;("$path" path) - (1 path)) - (single-result statement))) - - -(define update-sql - "UPDATE ValidPaths SET hash = $hash, registrationTime = $time, deriver = -$deriver, narSize = $size WHERE id = $id") - -(define insert-sql - "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) -VALUES ($path, $hash, $time, $deriver, $size)") - -(define* (update-or-insert #:key db path deriver hash nar-size time) - "The classic update-if-exists and insert-if-doesn't feature that sqlite -doesn't exactly have... they've got something close, but it involves deleting -and re-inserting instead of updating, which causes problems with foreign keys, -of course. Returns the row id of the row that was modified or inserted." - (let ((id (path-id db path))) - (if id - (begin - (run-sql - db update-sql - ;; As you may have noticed, sqlite-bind doesn't behave - ;; exactly how I was expecting... - ;; ("$id" id) - ;; ("$deriver" deriver) - ;; ("$hash" hash) - ;; ("$size" nar-size) - ;; ("$time" time) - (5 id) - (3 deriver) - (1 hash) - (4 nar-size) - (2 time)) - id) - (begin - (run-sql - db insert-sql - ;; ("$path" path) - ;; ("$deriver" deriver) - ;; ("$hash" hash) - ;; ("$size" nar-size) - ;; ("$time" time) - (1 path) - (4 deriver) - (2 hash) - (5 nar-size) - (3 time)) - (sqlite-last-insert-rowid db))))) - -(define add-reference-sql - "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT $referrer, id -FROM ValidPaths WHERE path = $reference") - -(define (add-references db referrer references) - "referrer is the id of the referring store item, references is a list -containing store item paths being referred to. Note that all of the store -items in \"references\" should already be registered." - (with-sql-statement - db add-reference-sql add-reference-statement () - (for-each (lambda (reference) - (run-statement - db add-reference-statement - ;("$referrer" referrer) - ;("$reference" reference) - (1 referrer) - (2 reference))) - references))) - -;; XXX figure out caching of statement and database objects... later -(define* (sqlite-register #:key dbpath path references deriver hash nar-size) - "Registers this stuff in a database specified by DBPATH. PATH is the string -path of some store item, REFERENCES is a list of string paths which the store -item PATH refers to (they need to be already registered!), DERIVER is a string -path of the derivation that created the store item PATH, HASH is the -base16-encoded sha256 hash of the store item denoted by PATH (prefixed with -\"sha256:\") after being converted to nar form, and nar-size is the size in -bytes of the store item denoted by PATH after being converted to nar form." - (with-sql-database - dbpath db - (let ((id (update-or-insert #:db db - #:path path - #:deriver deriver - #:hash hash - #:nar-size nar-size - #:time (current-time)))) - (add-references db id references)))) diff --git a/guix/store.scm b/guix/store.scm index 2f16ec2b1..f32cdc6aa 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -44,7 +44,7 @@ #:use-module (ice-9 popen) #:use-module (web uri) #:use-module (sqlite3) - #:use-module (guix sql) + #:use-module (guix store database) #:export (%daemon-socket-uri %gc-roots-directory %default-substitute-urls diff --git a/guix/store/database.scm b/guix/store/database.scm new file mode 100644 index 000000000..ecf7ba4aa --- /dev/null +++ b/guix/store/database.scm @@ -0,0 +1,104 @@ +;;; Copyright © 2017 Caleb Ristvedt +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (guix store database) + #:use-module (guix sql) + #:export (sqlite-register)) + +;;; Code for working with the store database directly. + +(define path-id-sql + "SELECT id FROM ValidPaths WHERE path = $path") + +(define* (path-id db path) + "If the path \"path\" exists in the ValidPaths table, return its +id. Otherwise, return #f." + (with-sql-statement + db path-id-sql statement + (("$path" path)) + (single-result statement))) + + +(define update-sql + "UPDATE ValidPaths SET hash = $hash, registrationTime = $time, deriver = +$deriver, narSize = $size WHERE id = $id") + +(define insert-sql + "INSERT INTO ValidPaths (path, hash, registrationTime, deriver, narSize) +VALUES ($path, $hash, $time, $deriver, $size)") + +(define* (update-or-insert #:key db path deriver hash nar-size time) + "The classic update-if-exists and insert-if-doesn't feature that sqlite +doesn't exactly have... they've got something close, but it involves deleting +and re-inserting instead of updating, which causes problems with foreign keys, +of course. Returns the row id of the row that was modified or inserted." + (let ((id (path-id db path))) + (if id + (begin + (run-sql + db update-sql + ("$id" id) + ("$deriver" deriver) + ("$hash" hash) + ("$size" nar-size) + ("$time" time)) + id) + (begin + (run-sql + db insert-sql + ("$path" path) + ("$deriver" deriver) + ("$hash" hash) + ("$size" nar-size) + ("$time" time)) + (sqlite-last-insert-rowid db))))) + +(define add-reference-sql + "INSERT OR IGNORE INTO Refs (referrer, reference) SELECT $referrer, id +FROM ValidPaths WHERE path = $reference") + +(define (add-references db referrer references) + "referrer is the id of the referring store item, references is a list +containing store item paths being referred to. Note that all of the store +items in \"references\" should already be registered." + (with-sql-statement + db add-reference-sql add-reference-statement () + (for-each (lambda (reference) + (run-statement + db add-reference-statement + ("$referrer" referrer) + ("$reference" reference))) + references))) + +;; XXX figure out caching of statement and database objects... later +(define* (sqlite-register #:key dbpath path references deriver hash nar-size) + "Registers this stuff in a database specified by DBPATH. PATH is the string +path of some store item, REFERENCES is a list of string paths which the store +item PATH refers to (they need to be already registered!), DERIVER is a string +path of the derivation that created the store item PATH, HASH is the +base16-encoded sha256 hash of the store item denoted by PATH (prefixed with +\"sha256:\") after being converted to nar form, and nar-size is the size in +bytes of the store item denoted by PATH after being converted to nar form." + (with-sql-database + dbpath db + (let ((id (update-or-insert #:db db + #:path path + #:deriver deriver + #:hash hash + #:nar-size nar-size + #:time (current-time)))) + (add-references db id references)))) -- 2.13.0