database: Add 'db-update-build-status!'.

* src/cuirass/database.scm (build-status): Add 'scheduled' and
'started'.
(db-add-build): Make sure #:timestamp, #:starttime, #:stoptime, and
 #:status are integers.
(db-update-build-status!): New procedure.
* tests/database.scm ("database")["db-update-build-status!"]: New test.

2 files changed, 50 insertions, 5 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index f50d746..c5d3f22 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -24,6 +24,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (sqlite3)
   #:export (;; Procedures.
             assq-refs
@@ -39,6 +40,7 @@
             db-get-derivation
             build-status
             db-add-build
+            db-update-build-status!
             db-get-build
             db-get-builds
             read-sql-file
@@ -199,7 +201,10 @@ string."
   (logior SQLITE_CONSTRAINT (ash 6 8)))
 
 (define-enumeration build-status
-  ;; Build status as expected by Hydra's API.
+  ;; Build status as expected by Hydra's API.  Note: the negative values are
+  ;; Cuirass' own extensions.
+  (scheduled        -2)
+  (started          -1)
   (succeeded         0)
   (failed            1)
   (failed-dependency 2)
@@ -216,10 +221,11 @@ INSERT INTO Builds (derivation, evaluation, log, status, timestamp, starttime, s
                        (assq-ref build #:derivation)
                        (assq-ref build #:eval-id)
                        (assq-ref build #:log)
-                       (assq-ref build #:status)
-                       (assq-ref build #:timestamp)
-                       (assq-ref build #:starttime)
-                       (assq-ref build #:stoptime)))
+                       (or (assq-ref build #:status)
+                           (build-status scheduled))
+                       (or (assq-ref build #:timestamp) 0)
+                       (or (assq-ref build #:starttime) 0)
+                       (or (assq-ref build #:stoptime) 0)))
          (build-id (last-insert-rowid db)))
     (for-each (lambda (output)
                 (match output
@@ -230,6 +236,20 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');"
               (assq-ref build #:outputs))
     build-id))
 
+(define (db-update-build-status! db drv status)
+  "Update DB so that DRV's status is STATUS.  This also updates the
+'starttime' or 'stoptime' fields."
+  (define now
+    (time-second (current-time time-utc)))
+
+  (if (= status (build-status started))
+      (sqlite-exec db "UPDATE Builds SET starttime='~A', status='~A' \
+WHERE derivation='~A';"
+                   now status drv)
+      (sqlite-exec db "UPDATE Builds SET stoptime='~A', status='~A' \
+WHERE derivation='~A';"
+                   now status drv)))
+
 (define (db-get-outputs db build-id)
   "Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
   (let loop ((rows
diff --git a/tests/database.scm b/tests/database.scm
index d0838eb..28a7e46 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -143,6 +143,31 @@ INSERT INTO Evaluations (specification, revision) VALUES (3, 3);")
                 (map summarize (db-get-builds db '()))
                 (map summarize (db-get-builds db '((nr 1))))))))
 
+  (test-equal "db-update-build-status!"
+    (list (build-status scheduled)
+          (build-status started)
+          (build-status succeeded))
+    (with-temporary-database db
+      (let* ((id (db-add-build
+                  db
+                  (make-dummy-build 1 #:drv "/foo.drv"
+                                    #:outputs '(("out" . "/foo")))))
+             (get-status (lambda* (#:optional (key #:status))
+                           (assq-ref (db-get-build db id) key))))
+        (db-add-derivation db (make-dummy-derivation "/foo.drv" 1))
+        (db-add-evaluation db (make-dummy-eval))
+        (db-add-specification db example-spec)
+
+        (let ((status0 (get-status)))
+          (db-update-build-status! db "/foo.drv" (build-status started))
+          (let ((status1 (get-status)))
+            (db-update-build-status! db "/foo.drv" (build-status succeeded))
+            (let ((status2 (get-status))
+                  (start   (get-status #:starttime))
+                  (end     (get-status #:stoptime)))
+              (and (> start 0) (>= end start)
+                   (list status0 status1 status2))))))))
+
   (test-assert "db-close"
     (db-close (%db)))