Support activating and deactivating agents

Not sure these are the best terms to use, but I want a way to pause agents,
effectively removing them from the build allocation plan.

This is mostly motivated by the lack of disk space on bayfront, as
deactivating agents provides a way to stop the system from filling up with
builds, but I think there's more general uses as well.

5 files changed, 85 insertions, 0 deletions

diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index bf27f93..fec53e3 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -52,6 +52,7 @@
             request-agents-list
             request-failed-builds-with-blocking-count-list
             send-create-agent-request
+            send-agent-set-active-request
             send-create-agent-password-request
             send-create-dynamic-auth-token-request
             send-replace-agent-tags-request))
@@ -272,6 +273,24 @@
              (render-json
               `((error . 404))
               #:code 404))))
+      (('POST "agent" agent-id "active")
+       (let ((agent-details (datastore-find-agent datastore agent-id)))
+         (if agent-details
+             (let ((active? (match (assoc "active" body)
+                              (("active" . active?) active?))))
+               (if (boolean? active?)
+                   (begin
+                     (set-agent-active build-coordinator
+                                       agent-id
+                                       active?)
+                     (render-json
+                      `((result . success))))
+                   (render-json
+                    `((error . "active must be a boolean"))
+                    #:code 400)))
+             (render-json
+              `((error . 404))
+              #:code 404))))
       (('GET "builds")
        (let ((query-parameters (request-query-parameters request)))
          (render-json
@@ -649,6 +668,12 @@
                         `((description . ,description))
                         '()))))
 
+(define* (send-agent-set-active-request coordinator-uri agent-uuid active?)
+  (send-request coordinator-uri
+                'POST
+                (simple-format #f "/agent/~A/active" agent-uuid)
+                `((active . ,active?))))
+
 (define (send-create-agent-password-request coordinator-uri
                                             agent-id)
   (send-request coordinator-uri
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 5f65c07..cbf760c 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -69,6 +69,7 @@
             cancel-build
             new-agent
             new-agent-password
+            set-agent-active
             fetch-builds
             agent-details
             trigger-build-allocation
@@ -432,6 +433,12 @@
                                   password)
     password))
 
+(define (set-agent-active coordinator agent-uuid active?)
+  (datastore-set-agent-active (build-coordinator-datastore coordinator)
+                              agent-uuid
+                              active?)
+  (trigger-build-allocation coordinator))
+
 (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 0afaea0..1718c31 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -19,6 +19,7 @@
 (re-export datastore-cancel-build)
 (re-export datastore-new-agent)
 (re-export datastore-list-agents)
+(re-export datastore-set-agent-active)
 (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 89fea58..94a3154 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -47,6 +47,7 @@
             datastore-list-build-outputs
             datastore-new-agent
             datastore-list-agents
+            datastore-set-agent-active
             datastore-find-agent
             datastore-find-agent-by-name
             datastore-insert-dynamic-auth-token
@@ -593,6 +594,31 @@ SELECT id, name, description, active FROM agents ORDER BY id"
 
          agents)))))
 
+(define-method (datastore-set-agent-active
+                (datastore <sqlite-datastore>)
+                agent-uuid
+                active?)
+  (unless (boolean? active?)
+    (error "datastore-set-agent-active called with non-boolean"))
+
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-writer-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+UPDATE agents SET active = :active WHERE id = :uuid"
+             #:cache? #f)))
+
+       (sqlite-bind-arguments statement
+                              #:uuid agent-uuid
+                              #:active (if active? 1 0))
+
+       (sqlite-step statement)
+       (sqlite-finalize statement))))
+  active?)
+
 (define-method (datastore-new-agent-password
                 (datastore <sqlite-datastore>)
                 agent-uuid
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index b3b20f4..1fbcad3 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -656,6 +656,32 @@ tags:
                       #:description (assq-ref opts 'description))))
        (simple-format #t "agent created as as ~A\n"
                       (assoc-ref response "agent-id")))))
+  (("agent" agent-id "activate" rest ...)
+   (let ((opts (parse-options %base-options
+                              (append %client-option-defaults
+                                      %base-option-defaults)
+                              rest)))
+     (let ((response (send-agent-set-active-request
+                      (assq-ref opts 'coordinator)
+                      agent-id
+                      #true)))
+       (if (string=? (assoc-ref response "result")
+                     "success")
+           (display "successfully activated agent\n")
+           (display "error activating agent\n")))))
+  (("agent" agent-id "deactivate" rest ...)
+   (let ((opts (parse-options %base-options
+                              (append %client-option-defaults
+                                      %base-option-defaults)
+                              rest)))
+     (let ((response (send-agent-set-active-request
+                      (assq-ref opts 'coordinator)
+                      agent-id
+                      #false)))
+       (if (string=? (assoc-ref response "result")
+                     "success")
+           (display "successfully deactivated agent\n")
+           (display "error activating agent\n")))))
   (("agent" agent-id "password" "new" rest ...)
    (let ((opts (parse-options %base-options
                               (append %client-option-defaults