branch master updated: Save evaluations and checkouts timestamps.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 154232b  Save evaluations and checkouts timestamps.
154232b is described below

commit 154232bc767d002f69aa6bb1cdddfd108b98584b
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Sun Sep 6 13:03:08 2020 +0200

    Save evaluations and checkouts timestamps.
    
    src/cuirass/base.scm (fetch-input): Add the commit timestamp to the returned
    association list,
    (process-specs): Pass a timestamp taken at procedure start and another one
    taken after inputs are fetched to "db-add-evaluation" procedure. Once the
    evaluation is over, call "db-set-evaluation-time" to save the evaluation
    completion time.
    src/cuirass/database.scm (db-set-evaluation-time): New procedure,
    (db-add-checkout): Handle the "timestamp" field,
    (db-add-evaluation): add "checkouttime" and "evaltime" arguments. Modify the
    associated SQL query accordingly.
    (db-get-builds): Use "Builds.timestamp" instead of "timestamp" as this field
    is also part of the Evaluations table.
    src/schema.sql (Checkouts): Add "timestamp" field,
    (Evaluations): add "timestamp", "checkouttime" and "evaltime" fields.
    src/sql/upgrade-9.sql: New file.
    tests/database.scm (sqlite-exec): Adapt Evaluations table insertions to 
include
    "timestamp", "checkouttime" and "evaltime" required fields.
---
 src/cuirass/base.scm     | 25 ++++++++++++++++++++-----
 src/cuirass/database.scm | 33 ++++++++++++++++++++++++++-------
 src/schema.sql           |  4 ++++
 src/sql/upgrade-9.sql    |  9 +++++++++
 tests/database.scm       |  9 ++++++---
 5 files changed, 65 insertions(+), 15 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 7a566d3..9b81b3c 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -198,6 +198,10 @@ read-only directory."
         branch
         (string-append "origin/" branch)))
 
+  (define (commit-timestamp directory commit)
+    (with-repository directory repository
+      (commit-time (commit-lookup repository (string->oid commit)))))
+
   (let ((name   (assq-ref input #:name))
         (url    (assq-ref input #:url))
         (branch (and=> (assq-ref input #:branch)
@@ -209,10 +213,15 @@ read-only directory."
         (tag    (and=> (assq-ref input #:tag)
                        (lambda (t)
                          `(tag . ,t)))))
-    (let-values (((directory commit)
-                  (latest-repository-commit store url
-                                            #:cache-directory 
(%package-cachedir)
-                                            #:ref (or branch commit tag))))
+    (let*-values (((directory commit)
+                   (latest-repository-commit store url
+                                             #:cache-directory
+                                             (%package-cachedir)
+                                             #:ref (or branch commit tag)))
+                  ((timestamp)
+                   (commit-timestamp
+                    (url-cache-directory url (%package-cachedir))
+                    commit)))
       ;; TODO: When WRITABLE-COPY? is true, we could directly copy the
       ;; checkout directly in a writable location instead of copying it to the
       ;; store first.
@@ -224,6 +233,7 @@ read-only directory."
         `((#:input . ,name)
           (#:directory . ,directory)
           (#:commit . ,commit)
+          (#:timestamp . ,timestamp)
           (#:load-path . ,(assq-ref input #:load-path))
           (#:no-compile? . ,(assq-ref input #:no-compile?)))))))
 
@@ -809,8 +819,12 @@ by PRODUCT-SPECS."
   (define (process spec)
     (with-store store
       (let* ((name (assoc-ref spec #:name))
+             (timestamp (time-second (current-time time-utc)))
              (checkouts (fetch-inputs spec))
-             (eval-id (db-add-evaluation name checkouts)))
+             (checkouttime (time-second (current-time time-utc)))
+             (eval-id (db-add-evaluation name checkouts
+                                         #:timestamp timestamp
+                                         #:checkouttime checkouttime)))
         (when eval-id
           (compile-checkouts spec (filter compile? checkouts))
           (spawn-fiber
@@ -824,6 +838,7 @@ by PRODUCT-SPECS."
                (log-message "evaluating spec '~a'" name)
                (with-store store
                  (let ((jobs (evaluate store spec eval-id checkouts)))
+                   (db-set-evaluation-time eval-id)
                    (log-message "building ~a jobs for '~a'"
                                 (length jobs) name)
                    (build-packages store jobs eval-id))))))
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 7bb5bd2..fb22bcd 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -47,6 +47,7 @@
             db-add-evaluation
             db-set-evaluations-done
             db-set-evaluation-done
+            db-set-evaluation-time
             db-get-pending-derivations
             build-status
             db-add-build
@@ -336,12 +337,13 @@ the same revision already exists for SPEC-NAME, return 
#f."
     (catch-sqlite-error
      (sqlite-exec db "\
 INSERT INTO Checkouts (specification, revision, evaluation, input,
-directory) VALUES ("
+directory, timestamp) VALUES ("
                   spec-name ", "
                   (assq-ref checkout #:commit) ", "
                   eval-id ", "
                   (assq-ref checkout #:input) ", "
-                  (assq-ref checkout #:directory) ");")
+                  (assq-ref checkout #:directory) ", "
+                  (or (assq-ref checkout #:timestamp) 0) ");")
      (last-insert-rowid db)
 
      ;; If we get a unique-constraint-failed error, that means we have
@@ -436,13 +438,21 @@ SELECT * FROM Specifications ORDER BY name DESC;")))
                            ,(with-input-from-string build-outputs read)))
                         specs)))))))
 
-(define (db-add-evaluation spec-name checkouts)
+(define* (db-add-evaluation spec-name checkouts
+                            #:key
+                            (checkouttime 0)
+                            (evaltime 0)
+                            timestamp)
   "Add a new evaluation for SPEC-NAME only if one of the CHECKOUTS is new.
 Otherwise, return #f."
+  (define now
+    (or timestamp (time-second (current-time time-utc))))
+
   (with-db-worker-thread db
     (sqlite-exec db "BEGIN TRANSACTION;")
-    (sqlite-exec db "INSERT INTO Evaluations (specification, in_progress)
-VALUES (" spec-name ", true);")
+    (sqlite-exec db "INSERT INTO Evaluations (specification, in_progress,
+timestamp, checkouttime, evaltime)
+VALUES (" spec-name ", true, " now "," checkouttime "," evaltime ");")
     (let* ((eval-id (last-insert-rowid db))
            (new-checkouts (filter-map
                            (cut db-add-checkout spec-name eval-id <>)
@@ -471,6 +481,15 @@ WHERE id = " eval-id ";")
                   `((#:evaluation  . ,eval-id)
                     (#:in_progress . #f)))))
 
+(define (db-set-evaluation-time eval-id)
+  (define now
+    (time-second (current-time time-utc)))
+
+  (with-db-worker-thread
+   db
+   (sqlite-exec db "UPDATE Evaluations SET evaltime = " now
+                "WHERE id = " eval-id ";")))
+
 (define-syntax-rule (with-database body ...)
   "Run BODY with %DB-CHANNEL being dynamically bound to a channel providing a
 worker thread that allows database operations to run without intefering with
@@ -772,11 +791,11 @@ FILTERS is an assoc list whose possible keys are 
'derivation | 'id | 'jobset |
       (('order . 'finish-time) "stoptime DESC")
       (('order . 'finish-time+build-id) "stoptime DESC, Builds.id DESC")
       (('order . 'start-time) "starttime DESC")
-      (('order . 'submission-time) "timestamp DESC")
+      (('order . 'submission-time) "Builds.timestamp DESC")
       ;; With this order, builds in 'running' state (-1) appear
       ;; before those in 'scheduled' state (-2).
       (('order . 'status+submission-time)
-       "status DESC, timestamp DESC, Builds.id ASC")
+       "status DESC, Builds.timestamp DESC, Builds.id ASC")
       (_ "Builds.id DESC")))
 
   (define (where-conditions filters)
diff --git a/src/schema.sql b/src/schema.sql
index 5ea1ff7..d1b38ae 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -31,6 +31,7 @@ CREATE TABLE Checkouts (
   evaluation    INTEGER NOT NULL,
   input         TEXT NOT NULL,
   directory     TEXT NOT NULL,
+  timestamp     INTEGER NOT NULL,
   PRIMARY KEY (specification, revision),
   FOREIGN KEY (evaluation) REFERENCES Evaluations (id),
   FOREIGN KEY (specification) REFERENCES Specifications (name),
@@ -41,6 +42,9 @@ CREATE TABLE Evaluations (
   id            INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
   specification TEXT NOT NULL,
   in_progress   INTEGER NOT NULL,
+  timestamp     INTEGER NOT NULL,
+  checkouttime  INTEGER NOT NULL,
+  evaltime      INTEGER NOT NULL,
   FOREIGN KEY (specification) REFERENCES Specifications (name)
 );
 
diff --git a/src/sql/upgrade-9.sql b/src/sql/upgrade-9.sql
new file mode 100644
index 0000000..4de411a
--- /dev/null
+++ b/src/sql/upgrade-9.sql
@@ -0,0 +1,9 @@
+BEGIN TRANSACTION;
+
+ALTER TABLE Evaluations ADD timestamp INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE Evaluations ADD checkouttime INTEGER NOT NULL DEFAULT 0;
+ALTER TABLE Evaluations ADD evaltime INTEGER NOT NULL DEFAULT 0;
+
+ALTER TABLE Checkouts ADD timestamp INTEGER NOT NULL DEFAULT 0;
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index 944e4bf..8fd663d 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -97,11 +97,14 @@
   (test-assert "sqlite-exec"
     (begin
       (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, in_progress) VALUES (1, false);")
+INSERT INTO Evaluations (specification, in_progress,
+timestamp, checkouttime, evaltime) VALUES (1, false, 0, 0, 0);")
       (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, in_progress) VALUES (2, false);")
+INSERT INTO Evaluations (specification, in_progress,
+timestamp, checkouttime, evaltime) VALUES (2, false, 0, 0, 0);")
       (sqlite-exec (%db) "\
-INSERT INTO Evaluations (specification, in_progress) VALUES (3, false);")
+INSERT INTO Evaluations (specification, in_progress,
+timestamp, checkouttime, evaltime) VALUES (3, false, 0, 0, 0);")
       (sqlite-exec (%db) "SELECT * FROM Evaluations;")))
 
   (test-equal "db-add-specification"