database: Add ‘properties’ field for specifications.

* src/schema.sql (Specifications): Add ‘properties’ field.
* src/sql/upgrade-16.sql: New file.
* Makefile.am (dist_sql_DATA): Add it.
* src/cuirass/database.scm (db-get-specifications): Read ‘properties’.
(db-add-or-update-specification): Write it.
* src/cuirass/specification.scm (<specification>)[properties]: New field.
* tests/database.scm (example-spec)[properties]: New field.
("db-get-specifications"): Check it.
* doc/cuirass.texi (Specifications, Database): Document it.

Makefile.am

@@ -117,7 +117,8 @@ dist_sql_DATA = 				\
   src/sql/upgrade-12.sql			\
   src/sql/upgrade-13.sql			\
   src/sql/upgrade-14.sql			\
-  src/sql/upgrade-15.sql
+  src/sql/upgrade-15.sql			\
+  src/sql/upgrade-16.sql
 
 dist_css_DATA =					\
   src/static/css/choices.min.css		\

doc/cuirass.texi

@@ -239,6 +239,15 @@ the lowest.
 Build every job for each system in this list.  By default only the
 current system is selected.
 
+@item @code{properties} (default: @code{'()})
+Arbitrary properties written as an association list (or ``alist''),
+which can be used to convey additional information about the
+specification.
+
+You can store any information you like in properties, but you must make
+sure that this is serializable.  For example, the properties alist
+cannot contain records.
+
 @end table
 @end deftp
 
@@ -1417,6 +1426,9 @@ the lowest.
 The systems for which build jobs must be evaluated, as a comma
 separated list.
 
+@item properties
+Arbitrary properties written as a Scheme association alist.
+
 @end table
 
 @section Checkouts

src/cuirass/database.scm

@@ -575,7 +575,7 @@ RETURNING (specification, revision);"))
       (match (expect-one-row
               (exec-query/bind db "\
 INSERT INTO Specifications (name, build, channels, \
-build_outputs, notifications, period, priority, systems, is_active) \
+build_outputs, notifications, period, priority, systems, is_active, properties) \
   VALUES ("
                                (specification-name spec) ", "
                                (specification-build spec) ", "
@@ -586,7 +586,9 @@ build_outputs, notifications, period, priority, systems, is_active) \
                                (specification-priority spec) ", "
                                (specification-systems spec) ", "
                                (bool->int
-                                (specification-is-active? spec)) ")
+                                (specification-is-active? spec)) ", "
+                               (object->string
+                                (specification-properties spec)) ")
 ON CONFLICT(name) DO UPDATE
 SET build = " (specification-build spec) ",
 channels = " channels ",
@@ -594,7 +596,8 @@ build_outputs = " build-outputs ",
 notifications = " notifications ",
 period = " (specification-period spec) ",
 priority = " (specification-priority spec) ",
-systems = " (specification-systems spec)
+systems = " (specification-systems spec) ",
+properties = " (object->string (specification-properties spec))
 "RETURNING name;"))
         ((name) name)
         (else #f)))))
@@ -629,17 +632,17 @@ DELETE FROM Specifications WHERE name=" name ";")))
         ((rows  (if name
                     (exec-query/bind db "
 SELECT name, build, channels, build_outputs, notifications,\
-period, priority, systems, is_active \
+period, priority, systems, is_active, properties \
 FROM Specifications WHERE name =" name ";")
                     (exec-query db "
 SELECT name, build, channels, build_outputs, notifications,\
-period, priority, systems, is_active \
+period, priority, systems, is_active, properties \
 FROM Specifications ORDER BY name ASC;")))
          (specs '()))
       (match rows
         (() (reverse specs))
         (((name build channels build-outputs notifications
-                period priority systems is-active?)
+                period priority systems is-active? properties-text)
           . rest)
          (loop rest
                (let ((is-active?
@@ -663,7 +666,9 @@ FROM Specifications ORDER BY name ASC;")))
                        (period (string->number period))
                        (priority (string->number priority))
                        (systems (with-input-from-string systems read))
-                       (is-active? is-active?))
+                       (is-active? is-active?)
+                       (properties (call-with-input-string properties-text
+                                     read)))
                       specs)))))))))
 
 (define-enumeration evaluation-status

src/cuirass/specification.scm

@@ -50,6 +50,7 @@
             specification-notifications
             specification-systems
             specification-is-active?
+            specification-properties
 
             specification->sexp
             sexp->specification
@@ -166,7 +167,9 @@
   (systems            specification-systems ;list of strings
                       (default (list (%current-system))))
   (is-active?         specification-is-active? ;boolean
-                      (default #t)))
+                      (default #t))
+  (properties         specification-properties
+                      (default '())))
 
 (define (specification->sexp spec)
   "Return an sexp describing SPEC."

src/schema.sql

@@ -13,7 +13,8 @@ CREATE TABLE Specifications (
   period        INTEGER NOT NULL DEFAULT 0,
   priority      INTEGER NOT NULL DEFAULT 0,
   systems       TEXT NOT NULL,
-  is_active     INTEGER NOT NULL DEFAULT 1
+  is_active     INTEGER NOT NULL DEFAULT 1,
+  properties    TEXT NOT NULL DEFAULT '()'
 );
 
 CREATE TABLE Evaluations (

src/sql/upgrade-16.sql

@@ -0,0 +1,5 @@
+BEGIN TRANSACTION;
+
+ALTER TABLE Specifications ADD COLUMN properties TEXT NOT NULL DEFAULT '()';
+
+COMMIT;

tests/database.scm

@@ -76,7 +76,8 @@
     (list (email
            (from "from")
            (to "to")
-           (server (mailer)))))))
+           (server (mailer)))))
+   (properties '((test-spec? . #t)))))
 
 (define (make-dummy-instances fakesha1 fakesha2)
   (list
@@ -201,7 +202,9 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 0);")
              (build-outputs (specification-build-outputs spec)))
         (and (eq? (specification-name spec) 'guix)
              (equal? (map channel-name channels) '(guix my-channel))
-             (equal? (map build-output-job build-outputs) '("job"))))))
+             (equal? (map build-output-job build-outputs) '("job"))
+             (equal? (specification-properties spec)
+                     (specification-properties example-spec))))))
 
   (test-equal "db-add-evaluation"
     '(2 3)