aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/datastore/sqlite.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix-build-coordinator/datastore/sqlite.scm')
-rw-r--r--guix-build-coordinator/datastore/sqlite.scm62
1 files changed, 61 insertions, 1 deletions
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 1415af9..749ddcc 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -16,7 +16,9 @@
datastore-list-agents
datastore-find-agent
datastore-new-agent-password
- datastore-agent-password-exists?))
+ datastore-agent-password-exists?
+ datastore-list-unprocessed-builds
+ datastore-replace-build-allocation-plan))
(define-class <sqlite-datastore> (<abstract-datastore>)
database-file
@@ -171,6 +173,64 @@ WHERE agent_id = :agent_id AND password = :password")))
#t)
+(define-method (datastore-list-unprocessed-builds
+ (datastore <sqlite-datastore>))
+ (call-with-worker-thread
+ (slot-ref datastore 'worker-thread-channel)
+ (lambda (db)
+ (let ((statement
+ (sqlite-prepare
+ db
+ "
+SELECT uuid, derivation_name, priority FROM builds WHERE processed = 0")))
+
+ (let ((builds (sqlite-map
+ (match-lambda
+ (#(uuid derivation_name priority)
+ `((uuid . ,uuid)
+ (derivation-name . ,derivation_name)
+ (priority . ,priority))))
+ statement)))
+ (sqlite-reset statement)
+
+ builds)))))
+
+(define-method (datastore-replace-build-allocation-plan
+ (datastore <sqlite-datastore>)
+ planned-builds)
+ (define (clear-current-plan db)
+ (sqlite-exec
+ db
+ "DELETE FROM build_allocation_plan"))
+
+ (define (insert-new-plan db planned-builds)
+ (sqlite-exec
+ db
+ (string-append
+ "
+INSERT INTO build_allocation_plan (build_id, agent_id, ordering) VALUES "
+ (string-join
+ (map (match-lambda
+ ((build-id agent-id ordering)
+ (simple-format
+ #f
+ "('~A', '~A', ~A)"
+ build-id
+ agent-id
+ ordering)))
+ planned-builds)
+ ", ")
+ ";")))
+
+ (call-with-worker-thread
+ (slot-ref datastore 'worker-thread-channel)
+ (lambda (db)
+ (sqlite-exec db "BEGIN TRANSACTION;")
+ (clear-current-plan db)
+ (insert-new-plan db planned-builds)
+ (sqlite-exec db "COMMIT TRANSACTION;")))
+ #t)
+
(define (db-open database)
(define flags
(list SQLITE_OPEN_READWRITE