diff options
Diffstat (limited to 'guix-qa-frontpage/database.scm')
| -rw-r--r-- | guix-qa-frontpage/database.scm | 70 |
1 files changed, 41 insertions, 29 deletions
diff --git a/guix-qa-frontpage/database.scm b/guix-qa-frontpage/database.scm index c44d83a..3bab909 100644 --- a/guix-qa-frontpage/database.scm +++ b/guix-qa-frontpage/database.scm @@ -28,16 +28,15 @@ #:use-module (sqlite3) #:use-module (fibers) #:use-module (prometheus) + #:use-module (knots queue) + #:use-module (knots worker-threads) #:use-module (guix narinfo) #:use-module (guix derivations) #:use-module ((guix-build-coordinator utils) #:select (log-delay call-with-delay-logging)) #:use-module ((guix-build-coordinator utils fibers) - #:select (retry-on-error - make-worker-thread-channel - call-with-worker-thread - make-queueing-channel)) + #:select (retry-on-error)) #:use-module (guix-qa-frontpage guix-data-service) #:export (setup-database @@ -58,14 +57,16 @@ delete-create-branch-for-issue-log)) (define-record-type <database> - (make-database database-file reader-thread-channel writer-thread-channel + (make-database database-file reader-thread-set writer-thread-set + writer-thread-set-channel metrics-registry) database? (database-file database-file) - (reader-thread-channel database-reader-thread-channel) - (writer-thread-channel database-writer-thread-channel - set-database-writer-thread-channel!) - (metrics-registry database-metrics-registry)) + (reader-thread-set database-reader-thread-set) + (writer-thread-set database-writer-thread-set) + (writer-thread-set-channel database-writer-thread-set-channel + set-database-writer-thread-set-channel!) + (metrics-registry database-metrics-registry)) (define* (db-open database #:key (write? #t)) @@ -145,8 +146,8 @@ CREATE TABLE IF NOT EXISTS create_branch_for_issue_logs ( (sqlite-close db)) - (let ((reader-thread-channel - (make-worker-thread-channel + (let ((reader-thread-set + (make-worker-thread-set (lambda () (let ((db (db-open database-file #:write? #f))) @@ -182,8 +183,8 @@ CREATE TABLE IF NOT EXISTS create_branch_for_issue_logs ( #:log-exception? (lambda (exn) (not (guix-data-service-error? exn))))) - (writer-thread-channel - (make-worker-thread-channel + (writer-thread-set + (make-worker-thread-set (lambda () (let ((db (db-open database-file))) @@ -220,8 +221,9 @@ CREATE TABLE IF NOT EXISTS create_branch_for_issue_logs ( seconds-delayed))))))) (make-database database-file - reader-thread-channel - writer-thread-channel + reader-thread-set + writer-thread-set + (worker-thread-set-channel writer-thread-set) metrics-registry))) (define (db-optimize db db-filename) @@ -247,7 +249,7 @@ PRAGMA optimize;"))) (retry-on-error (lambda () (call-with-worker-thread - (database-writer-thread-channel database) + (database-writer-thread-set database) (lambda (db) (db-optimize db @@ -258,10 +260,11 @@ PRAGMA optimize;"))) (define (database-spawn-fibers database) ;; Queue messages to the writer thread, so that they're handled in a first ;; come first served manor - (set-database-writer-thread-channel! + (set-database-writer-thread-set-channel! database - (make-queueing-channel - (database-writer-thread-channel database))) + (spawn-queueing-fiber + (worker-thread-set-channel + (database-writer-thread-set database)))) (spawn-fiber (lambda () @@ -324,8 +327,8 @@ PRAGMA optimize;"))) (match (call-with-worker-thread ((if readonly? - database-reader-thread-channel - database-writer-thread-channel) + database-reader-thread-set + database-writer-thread-set) database) (lambda (db) (let ((start-time (get-internal-real-time))) @@ -346,7 +349,11 @@ PRAGMA optimize;"))) duration-seconds) (current-error-port))) - (cons duration-seconds vals))))))) + (cons duration-seconds vals)))))) + #:channel + (if readonly? + #f + (database-writer-thread-set-channel database))) ((duration vals ...) (apply values vals)))) @@ -431,7 +438,7 @@ DELETE FROM cache WHERE key = :key" (let ((cached-values (call-with-worker-thread - (database-reader-thread-channel database) + (database-reader-thread-set database) (lambda (db) (let ((statement (sqlite-prepare @@ -465,11 +472,16 @@ SELECT data, timestamp FROM cache WHERE key = :key" (call-with-values (lambda () (call-with-worker-thread - (database-reader-thread-channel database) + (database-reader-thread-set database) (lambda (db) - (call-with-delay-logging - proc - #:args args)))) + (with-throw-handler #t + (lambda () + (call-with-delay-logging + proc + #:args args)) + (lambda args + (display (backtrace) (current-error-port)) + (newline (current-error-port))))))) (lambda vals (when (if (procedure? store-computed-value?) (apply store-computed-value? vals) @@ -558,7 +570,7 @@ WHERE category_name = :name AND category_value = :value" (define (select-from-builds-to-cancel-later database category-name) (call-with-worker-thread - (database-reader-thread-channel database) + (database-reader-thread-set database) (lambda (db) (let ((statement (sqlite-prepare @@ -614,7 +626,7 @@ VALUES (:issue, :log)" (define (select-create-branch-for-issue-log database issue) (call-with-worker-thread - (database-reader-thread-channel database) + (database-reader-thread-set database) (lambda (db) (let ((statement (sqlite-prepare |