From 9adeb00830a0619e68e9e2cc261fa0b4aeb15ebe Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 10 Apr 2020 21:28:09 +0100
Subject: Add sqlite datastore methods for allocating builds

---
 guix-build-coordinator/datastore.scm          |  4 +-
 guix-build-coordinator/datastore/abstract.scm |  2 +
 guix-build-coordinator/datastore/sqlite.scm   | 62 ++++++++++++++++++++++++++-
 3 files changed, 66 insertions(+), 2 deletions(-)

diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 417cd41..83fe0cc 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -10,7 +10,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)
   #:export (database-uri->datastore))
 
 (define (database-uri->datastore database)
diff --git a/guix-build-coordinator/datastore/abstract.scm b/guix-build-coordinator/datastore/abstract.scm
index 24b677d..53a2c7f 100644
--- a/guix-build-coordinator/datastore/abstract.scm
+++ b/guix-build-coordinator/datastore/abstract.scm
@@ -20,3 +20,5 @@
 (define-generic datastore-new-agent-password)
 (define-generic datastore-update)
 (define-generic datastore-agent-password-exists?)
+(define-generic datastore-agent-list-unprocessed-builds)
+(define-generic datastore-agent-replace-build-allocation-plan)
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
-- 
cgit v1.2.3