Add datastore-list-builds

1 files changed, 136 insertions, 0 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index e5705f8..7c9b4d0 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -28,6 +28,7 @@
             datastore-count-builds
             datastore-for-each-build
             datastore-find-build
+            datastore-list-builds
             datastore-insert-build-tags
             datastore-fetch-build-tags
             datastore-find-build-result
@@ -1177,6 +1178,141 @@ WHERE uuid = :uuid"
 
          result)))))
 
+(define-method (datastore-list-builds
+                (datastore <sqlite-datastore>)
+                .
+                rest)
+  (define* (list-builds #:key
+                        (tags '())
+                        (not-tags '())
+                        (processed 'unset)
+                        (canceled 'unset)
+                        (limit 1000))
+    (call-with-worker-thread
+     (slot-ref datastore 'worker-reader-thread-channel)
+     (lambda (db)
+       (define tag->expression
+         (let ((statement
+                (sqlite-prepare
+                 db
+                 "
+SELECT id FROM tags WHERE key = :key AND value = :value"
+                 #:cache? #t)))
+           (lambda (tag not?)
+             (match tag
+               ((key . value)
+                (sqlite-bind-arguments statement
+                                       #:key key
+                                       #:value value)
+
+                (let ((result (match (sqlite-step statement)
+                                (#(id)
+                                 (simple-format
+                                  #f "tag_string ~A '%,~A,%'"
+                                  (if not?
+                                      "NOT LIKE"
+                                      "LIKE")
+                                  id))
+                                (#f #f))))
+                  (sqlite-reset statement)
+
+                  result))))))
+
+       (let ((tag-expressions
+              (map (lambda (tag)
+                     (tag->expression tag #f))
+                   tags))
+             (not-tag-expressions
+              (map (lambda (tag)
+                     (tag->expression tag #t))
+                   not-tags)))
+
+         ;; If one of the requested tags doesn't exist, nothing can be tagged to
+         ;; it, so just return nothing
+         (if (memq #f tag-expressions)
+             '()
+             (let* ((where-needed?
+                     (or (not (null? tag-expressions))
+                         (not (null? not-tag-expressions))
+                         (not (eq? processed 'unset))
+                         (not (eq? canceled 'unset))))
+                    (statement
+                     (sqlite-prepare
+                      db
+                      (string-append
+                       "
+SELECT uuid, derivation_name, priority, processed, canceled, created_at, end_time
+FROM builds
+INNER JOIN (
+  SELECT build_id, (',' || group_concat(tag_id) || ',') AS tag_string
+  FROM build_tags
+  GROUP BY build_id
+) AS all_build_tags
+  ON builds.uuid = all_build_tags.build_id
+"
+                       (if where-needed?
+                           (string-append
+                            "WHERE\n"
+                            (string-join
+                             (append
+                              (let ((all-tag-expressions
+                                     (append tag-expressions
+                                             not-tag-expressions)))
+                                (if (null? all-tag-expressions)
+                                    '()
+                                    all-tag-expressions))
+                              (cond
+                               ((eq? processed #t) '("processed = 1"))
+                               ((eq? processed #f) '("processed = 0"))
+                               (else '()))
+                              (cond
+                               ((eq? canceled #t) '("canceled = 1"))
+                               ((eq? canceled #f) '("canceled = 0"))
+                               (else '())))
+                             " AND ")
+                            "\n")
+                           "")
+                       (if limit
+                           (string-append "LIMIT " (number->string limit) "\n")
+                           ""))
+                      #:cache? #f)))
+
+               (let ((result
+                      (sqlite-map
+                       (match-lambda
+                         (#(uuid derivation_name priority processed canceled
+                                 created_at end_time)
+                          `((uuid            . ,uuid)
+                            (derivation-name . ,derivation_name)
+                            (priority        . ,priority)
+                            (processed       . ,(cond
+                                                 ((= 0 processed) #f)
+                                                 ((= 1 processed) #t)
+                                                 (else
+                                                  (error
+                                                   "unknown processed value"))))
+                            (canceled        . ,(cond
+                                                 ((= 0 canceled) #f)
+                                                 ((= 1 canceled) #t)
+                                                 (else
+                                                  (error "unknown canceled value"))))
+                            (created-at      . ,(if (string? created_at)
+                                                    (match (strptime "%F %T"
+                                                                     created_at)
+                                                      ((parts . _) parts))
+                                                    #f))
+                            (end-time        . ,(if (string? end_time)
+                                                    (match (strptime "%F %T"
+                                                                     end_time)
+                                                      ((parts . _) parts))
+                                                    #f)))))
+                       statement)))
+                 (sqlite-finalize statement)
+
+                 result)))))))
+
+  (apply list-builds rest))
+
 (define-method (datastore-fetch-build-tags
                 (datastore <sqlite-datastore>)
                 build-id)