Support storing when builds start

This isn't particularly accurate, what's actually being stored is the current
time when the record is inserted in to the coordinator database, but that
should happen just before the agent starts the build, so hopefully that's good
enough.

12 files changed, 134 insertions, 0 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 9448201..cdb0451 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -52,6 +52,7 @@
             submit-status
             submit-log-file
             submit-build-result
+            report-build-start
             report-setup-failure
             submit-output
             fetch-builds-for-agent))
@@ -323,6 +324,19 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (render-json
               '(("error" . "access denied"))
               #:code 403))))
+      (('POST "build" uuid "report-build-start")
+       (let ((agent-id-for-build
+              (datastore-agent-for-build datastore uuid)))
+         (if (authenticated? agent-id-for-build request)
+             (begin
+               (handle-build-start-report datastore
+                                          agent-id-for-build
+                                          uuid)
+               (render-json
+                "message received"))
+             (render-json
+              '(("error" . "access denied"))
+              #:code 403))))
       (('POST "build" uuid "report-setup-failure")
        (let ((agent-id-for-build
               (datastore-agent-for-build datastore uuid)))
@@ -695,6 +709,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
    #:method 'PUT                        ; TODO Should be PATCH
    #:body result))
 
+(define (report-build-start coordinator-uri agent-uuid password
+                            build-id)
+  (coordinator-http-request
+   coordinator-uri agent-uuid password
+   (string-append "/build/" build-id "/report-build-start")
+   #:method 'POST))
+
 (define (report-setup-failure coordinator-uri agent-uuid password
                               build-id report)
   (coordinator-http-request
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index a5a3f7a..0f9eaff 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -62,6 +62,8 @@
             (begin
               (simple-format #t "~A: setup successful, building: ~A\n"
                              build-id derivation-name)
+              (report-build-start coordinator-uri uuid password
+                                  build-id)
               (let ((result (perform-build derivation-name)))
                 (retry-on-error
                  (lambda ()
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 9677e74..f5be80d 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -52,6 +52,7 @@
 
             build-output-file-location
             build-log-file-location
+            handle-build-start-report
             handle-build-result
             handle-setup-failure-report))
 
@@ -422,6 +423,13 @@
                                          #f))
        #t))))
 
+(define (handle-build-start-report datastore
+                                   agent-id
+                                   build-id)
+  (datastore-store-build-start datastore
+                               build-id
+                               agent-id))
+
 (define (handle-setup-failure-report datastore
                                      agent-id build-id report-json)
   (let ((failure-reason (assoc-ref report-json "failure_reason")))
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 06334cb..e888387 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -17,6 +17,8 @@
 (re-export datastore-find-agent)
 (re-export datastore-count-build-results)
 (re-export datastore-store-build-result)
+(re-export datastore-store-build-start)
+(re-export datastore-find-build-starts)
 (re-export datastore-count-setup-failures)
 (re-export datastore-list-setup-failures-for-build)
 (re-export datastore-fetch-setup-failures)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 88db088..db9f807 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -27,6 +27,8 @@
             datastore-new-agent
             datastore-list-agents
             datastore-find-agent
+            datastore-store-build-start
+            datastore-find-build-starts
             datastore-count-setup-failures
             datastore-list-setup-failures-for-build
             datastore-fetch-setup-failures
@@ -592,6 +594,57 @@ VALUES "
        (store-output-metadata db build-id output-metadata))))
   #t)
 
+(define-method (datastore-store-build-start
+                (datastore <sqlite-datastore>)
+                build-id
+                agent-id)
+
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-writer-thread-channel)
+   (lambda (db)
+     (sqlite-exec
+      db
+      (string-append
+       "
+INSERT INTO build_starts (
+  build_id, agent_id, start_time
+) VALUES ('"
+       build-id "', '"
+       agent-id "', "
+       "datetime('now')"
+       ")")))))
+
+(define-method (datastore-find-build-starts
+                (datastore <sqlite-datastore>)
+                build-id)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT start_time, agent_id
+FROM build_starts
+WHERE build_id = :build_id
+ORDER BY start_time DESC")))
+
+       (sqlite-bind-arguments
+        statement
+        #:build_id build-id)
+
+       (let ((result
+              (sqlite-map
+               (match-lambda
+                 (#(start_time agent_id)
+                  `((start-time . ,(match (strptime "%F %T" start_time)
+                                             ((parts . _) parts)))
+                    (agent-id   . ,agent_id))))
+               statement)))
+         (sqlite-reset statement)
+
+         result)))))
+
 (define (insert-setup-failure-and-remove-allocation
          db
          build-id
diff --git a/sqitch/pg/deploy/build_starts.sql b/sqitch/pg/deploy/build_starts.sql
new file mode 100644
index 0000000..77c0f85
--- /dev/null
+++ b/sqitch/pg/deploy/build_starts.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:build_starts to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/build_starts.sql b/sqitch/pg/revert/build_starts.sql
new file mode 100644
index 0000000..d71c169
--- /dev/null
+++ b/sqitch/pg/revert/build_starts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_starts from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/verify/build_starts.sql b/sqitch/pg/verify/build_starts.sql
new file mode 100644
index 0000000..248f602
--- /dev/null
+++ b/sqitch/pg/verify/build_starts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_starts on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 5623d5b..e0712ce 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -17,3 +17,4 @@ build_results_result_index 2020-05-10T17:27:00Z Christopher Baines <mail@cbaines
 more_indexes_on_builds_and_derivation_inputs 2020-05-11T08:38:28Z Christopher Baines <mail@cbaines.net> # Add a couple more indexes
 build_tags 2020-05-31T13:54:41Z Christopher Baines <mail@cbaines.net> # Support tagging builds
 builds_created_at 2020-06-27T18:30:32Z Christopher Baines <mail@cbaines.net> # Add builds.created_at
+build_starts 2020-06-27T20:23:38Z Christopher Baines <mail@cbaines.net> # Add build_starts table
diff --git a/sqitch/sqlite/deploy/build_starts.sql b/sqitch/sqlite/deploy/build_starts.sql
new file mode 100644
index 0000000..fbf8e8c
--- /dev/null
+++ b/sqitch/sqlite/deploy/build_starts.sql
@@ -0,0 +1,12 @@
+-- Deploy guix-build-coordinator:build_starts to sqlite
+
+BEGIN;
+
+CREATE TABLE build_starts (
+       id INTEGER PRIMARY KEY ASC,
+       build_id TEXT NOT NULL REFERENCES builds (uuid),
+       agent_id TEXT NOT NULL REFERENCES agents (id),
+       start_time TEXT NOT NULL
+);
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/build_starts.sql b/sqitch/sqlite/revert/build_starts.sql
new file mode 100644
index 0000000..49d8eea
--- /dev/null
+++ b/sqitch/sqlite/revert/build_starts.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:build_starts from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/verify/build_starts.sql b/sqitch/sqlite/verify/build_starts.sql
new file mode 100644
index 0000000..e4d9460
--- /dev/null
+++ b/sqitch/sqlite/verify/build_starts.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:build_starts on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;