Implement and extend the agent status functionality

Previously, updating the status was used by the agent just to get back the
list of builds it was already allocated.

Now the status sent is actually stored, along with the 1min load average.

4 files changed, 58 insertions, 1 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 4741c31..75b1d77 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -249,7 +249,15 @@ port. Also, the port used can be changed by passing the --port option.\n"
       (('PUT "agent" uuid)
        (if (authenticated? uuid request)
            (begin
-             ;; TODO Update status
+             (let* ((json-body (json-string->scm (utf8->string body)))
+                    (status (assoc-ref json-body "status"))
+                    (1min-load-average (and=> (assoc-ref json-body "load_average")
+                                              (lambda (load-average)
+                                                (assoc-ref load-average 1)))))
+
+               (update-agent-status build-coordinator uuid
+                                    status 1min-load-average))
+
              (render-json
               (agent-details datastore uuid)))
            (render-json
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 2808426..22d97f8 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -79,6 +79,7 @@
             new-agent
             new-agent-password
             set-agent-active
+            update-agent-status
             fetch-builds
             agent-details
             trigger-build-allocation
@@ -803,6 +804,14 @@
                               active?)
   (trigger-build-allocation coordinator))
 
+(define (update-agent-status coordinator agent-uuid
+                             status 1min-load-average)
+  (datastore-update-agent-status
+   (build-coordinator-datastore coordinator)
+   agent-uuid
+   status
+   1min-load-average))
+
 (define (trigger-build-allocation build-coordinator)
   ((build-coordinator-allocator-thread build-coordinator)))
 
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 68c3339..5caa8e0 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -23,6 +23,7 @@
 (re-export datastore-new-agent)
 (re-export datastore-list-agents)
 (re-export datastore-set-agent-active)
+(re-export datastore-update-agent-status)
 (re-export datastore-find-agent)
 (re-export datastore-find-agent-by-name)
 (re-export datastore-insert-dynamic-auth-token)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 07b7aed..c7c4617 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -56,6 +56,7 @@
             datastore-new-agent
             datastore-list-agents
             datastore-set-agent-active
+            datastore-update-agent-status
             datastore-find-agent
             datastore-find-agent-by-name
             datastore-insert-dynamic-auth-token
@@ -675,6 +676,44 @@ UPDATE agents SET active = :active WHERE id = :uuid"
        (sqlite-finalize statement))))
   active?)
 
+(define-method (datastore-update-agent-status
+                (datastore <sqlite-datastore>)
+                agent-uuid
+                status
+                1min-load-average)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-writer-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+DELETE FROM agent_status WHERE agent_id = :uuid"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments statement
+                              #:uuid agent-uuid)
+       (sqlite-step statement)
+       (sqlite-reset statement))
+
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+INSERT INTO agent_status (agent_id, status, load_average_1min)
+  VALUES (:uuid, :status, :load)"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments statement
+                              #:uuid agent-uuid
+                              #:status status
+                              #:load 1min-load-average)
+
+       (sqlite-step statement)
+       (sqlite-reset statement))))
+
+  #t)
+
 (define-method (datastore-new-agent-password
                 (datastore <sqlite-datastore>)
                 agent-uuid