diff options
Diffstat (limited to 'nar-herder/database.scm')
| -rw-r--r-- | nar-herder/database.scm | 246 |
1 files changed, 235 insertions, 11 deletions
diff --git a/nar-herder/database.scm b/nar-herder/database.scm index d945786..028fb50 100644 --- a/nar-herder/database.scm +++ b/nar-herder/database.scm @@ -51,8 +51,15 @@ database-select-narinfo-for-file database-select-narinfo-files + database-select-narinfo-files-by-narinfo-id - database-map-all-narinfo-files)) + database-map-all-narinfo-files + + database-insert-cached-narinfo-file + database-select-cached-narinfo-file-by-hash + database-select-cached-narinfo-files-by-narinfo-id + database-fold-cached-narinfo-files + database-remove-cached-narinfo-file)) (define-record-type <database> (make-database database-file reader-thread-channel writer-thread-channel @@ -122,7 +129,17 @@ CREATE TABLE recent_changes ( datetime TEXT NOT NULL, change TEXT NOT NULl, data TEXT NOT NULL -);") +); + +CREATE TABLE cached_narinfo_files ( + id INTEGER PRIMARY KEY ASC, + narinfo_id INTEGER NOT NULL REFERENCES narinfos (id), + size INTEGER NOT NULL, + compression TEXT, +); + +CREATE INDEX cached_narinfo_files_narinfo_id + ON cached_narinfo_files (narinfo_id);") (sqlite-exec db schema)) @@ -149,6 +166,20 @@ SELECT 1 FROM sqlite_master WHERE type = 'table' AND name = :name"))) (unless (table-exists? db "narinfos") (perform-initial-database-setup db)) + (unless (table-exists? db "cached_narinfo_files") + (sqlite-exec + db + " +CREATE TABLE cached_narinfo_files ( + id INTEGER PRIMARY KEY ASC, + narinfo_id INTEGER NOT NULL REFERENCES narinfos (id), + size INTEGER NOT NULL, + compression TEXT NOT NULL +); + +CREATE INDEX cached_narinfo_files_narinfo_id + ON cached_narinfo_files (narinfo_id);")) + (sqlite-exec db "CREATE INDEX IF NOT EXISTS narinfo_files_narinfo_id @@ -285,11 +316,13 @@ PRAGMA optimize;"))) (make-histogram-metric registry metric-name))) (start-time (get-internal-real-time))) - (let ((result (thunk))) - (metric-observe metric - (/ (- (get-internal-real-time) start-time) - internal-time-units-per-second)) - result)) + (call-with-values + thunk + (lambda vals + (metric-observe metric + (/ (- (get-internal-real-time) start-time) + internal-time-units-per-second)) + (apply values vals)))) (thunk))) (define %current-transaction-proc @@ -715,7 +748,7 @@ DELETE FROM narinfo_tags WHERE narinfo_id = :narinfo_id" (sqlite-prepare db " -SELECT contents FROM narinfos WHERE substr(store_path, 12, 32) = :hash" +SELECT id, contents FROM narinfos WHERE substr(store_path, 12, 32) = :hash" #:cache? #t))) (sqlite-bind-arguments statement @@ -724,8 +757,10 @@ SELECT contents FROM narinfos WHERE substr(store_path, 12, 32) = :hash" (match (let ((result (sqlite-step statement))) (sqlite-reset statement) result) - (#(contents) contents) - (_ #f)))))))) + (#(id contents) + (values contents id)) + (_ + (values #f #f))))))))) (define* (database-select-recent-changes database after-date #:key (limit 8192)) (call-with-worker-thread @@ -859,7 +894,7 @@ WHERE narinfo_files.url = :url" (sqlite-prepare db " -SELECT narinfo_files.size, narinfo_files.compression, narinfo_files.url +SELECT narinfo_files.size, narinfo_files.compression, narinfo_files.url, narinfos.id FROM narinfos INNER JOIN narinfo_files ON narinfos.id = narinfo_files.narinfo_id @@ -873,6 +908,42 @@ WHERE substr(narinfos.store_path, 12, 32) = :hash" (let ((result (sqlite-map (match-lambda + (#(size compression url narinfo-id) + `((size . ,size) + (compression . ,compression) + (url . ,url) + (narinfo-id . ,narinfo-id)))) + statement))) + (sqlite-reset statement) + + result))))))) + +(define (database-select-narinfo-files-by-narinfo-id database narinfo-id) + (call-with-time-tracking + database + "select_narinfo_files_by_narinfo_id" + (lambda () + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT narinfo_files.size, narinfo_files.compression, narinfo_files.url +FROM narinfos +INNER JOIN narinfo_files + ON narinfos.id = narinfo_files.narinfo_id +WHERE narinfos.id = :narinfo_id" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:narinfo_id narinfo-id) + + (let ((result + (sqlite-map + (match-lambda (#(size compression url) `((size . ,size) (compression . ,compression) @@ -907,3 +978,156 @@ FROM narinfo_files" (sqlite-reset statement) result-list))))) + +(define (database-insert-cached-narinfo-file database + narinfo-id + size + compression) + (call-with-worker-thread + (database-writer-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +INSERT INTO cached_narinfo_files ( + narinfo_id, size, compression +) VALUES ( + :narinfo_id, :size, :compression +)" + #:cache? #t))) + (sqlite-bind-arguments + statement + #:narinfo_id narinfo-id + #:size size + #:compression compression) + + (sqlite-step statement) + (sqlite-reset statement) + + (last-insert-rowid db))))) + +(define (database-select-cached-narinfo-file-by-hash database + hash + compression) + (call-with-time-tracking + database + "select_cached_narinfo_file_by_hash" + (lambda () + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT cached_narinfo_files.size +FROM narinfos +INNER JOIN cached_narinfo_files + ON cached_narinfo_files.narinfo_id = narinfos.id +WHERE substr(narinfos.store_path, 12, 32) = :hash + AND cached_narinfo_files.compression = :compression" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:hash hash + #:compression compression) + + (let ((result + (match (sqlite-step statement) + (#(size) + `((size . ,size))) + (#f #f)))) + (sqlite-reset statement) + + result))))))) + +(define (database-select-cached-narinfo-files-by-narinfo-id + database + narinfo-id) + (call-with-time-tracking + database + "select_cached_narinfo_file_by_narinfo_id" + (lambda () + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT store_path, size, compression +FROM cached_narinfo_files +INNER JOIN narinfos + ON cached_narinfo_files.narinfo_id = narinfos.id +WHERE narinfo_id = :narinfo_id" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:narinfo_id narinfo-id) + + (let ((result + (sqlite-map + (match-lambda + (#(store_path size compression) + `((store-path . ,store_path) + (size . ,size) + (compression . ,(string->symbol compression))))) + statement))) + (sqlite-reset statement) + + result))))))) + +(define (database-fold-cached-narinfo-files database + proc + init) + (call-with-worker-thread + (database-reader-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +SELECT store_path, size, compression, narinfo_id +FROM cached_narinfo_files +INNER JOIN narinfos + ON cached_narinfo_files.narinfo_id = narinfos.id" + #:cache? #t))) + (let ((result-list + (sqlite-fold + (lambda (row result) + (match row + (#(store_path size compression narinfo_id) + (proc `((size . ,size) + (compression . ,(string->symbol compression)) + (store-path . ,store_path) + (narinfo-id . ,narinfo_id)) + result)))) + init + statement))) + (sqlite-reset statement) + + result-list))))) + +(define (database-remove-cached-narinfo-file database narinfo-id compression) + (call-with-worker-thread + (database-writer-thread-channel database) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +DELETE FROM cached_narinfo_files +WHERE narinfo_id = :narinfo_id + AND compression = :compression" + #:cache? #t))) + + (sqlite-bind-arguments + statement + #:narinfo_id narinfo-id + #:compression compression) + + (sqlite-step statement) + (sqlite-reset statement))))) |