aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/jobs/load-new-guix-revision.scm57
-rw-r--r--guix-data-service/web/controller.scm8
-rw-r--r--guix-data-service/web/view/html.scm73
3 files changed, 138 insertions, 0 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index 569ff62..d256f95 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -36,6 +36,7 @@
process-load-new-guix-revision-job
select-job-for-commit
select-jobs-and-events
+ select-unprocessed-jobs-and-events
select-jobs-and-events-for-commit
record-job-event
enqueue-load-new-guix-revision-job
@@ -1041,6 +1042,62 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
(string=? log-exists? "t"))))
(exec-query conn query)))
+(define (select-unprocessed-jobs-and-events conn)
+ (define query
+ "
+SELECT
+ load_new_guix_revision_jobs.id,
+ load_new_guix_revision_jobs.commit,
+ load_new_guix_revision_jobs.source,
+ load_new_guix_revision_jobs.git_repository_id,
+ load_new_guix_revision_jobs.created_at,
+ (
+ SELECT JSON_AGG(
+ json_build_object('event', event, 'occurred_at', occurred_at) ORDER BY occurred_at ASC
+ )
+ FROM load_new_guix_revision_job_events
+ WHERE job_id = load_new_guix_revision_jobs.id
+ ),
+ EXISTS (
+ SELECT 1 FROM load_new_guix_revision_job_logs WHERE job_id = load_new_guix_revision_jobs.id
+ ) AS log_exists,
+ commit IN (
+ SELECT commit FROM (
+ SELECT DISTINCT ON (name)
+ name, git_branches.commit
+ FROM git_branches
+ WHERE
+ git_branches.git_repository_id = load_new_guix_revision_jobs.git_repository_id AND
+ git_branches.commit IS NOT NULL
+ ORDER BY name, datetime DESC
+ ) branches_and_latest_commits
+ ) AS latest_branch_commit
+FROM load_new_guix_revision_jobs
+WHERE
+ succeeded_at IS NULL AND
+ (
+ SELECT COUNT(*)
+ FROM load_new_guix_revision_job_events
+ WHERE job_id = load_new_guix_revision_jobs.id AND event = 'retry'
+ ) >= (
+ SELECT COUNT(*)
+ FROM load_new_guix_revision_job_events
+ WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'
+ )
+ORDER BY latest_branch_commit DESC, id DESC")
+
+ (map
+ (match-lambda
+ ((id commit source git-repository-id created-at
+ events-json log-exists? latest-branch-commit)
+ (list id commit source git-repository-id created-at
+ (if (string-null? events-json)
+ #()
+ (json-string->scm events-json))
+ (string=? log-exists? "t")
+ (string=? latest-branch-commit "t"))))
+ (exec-query conn query)))
+
(define (select-jobs-and-events-for-commit conn commit)
(define query
"
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index b418b6b..cee34f1 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -731,6 +731,11 @@
#:sxml (view-jobs
(select-jobs-and-events conn))))
+(define (render-job-queue mime-types conn)
+ (render-html
+ #:sxml (view-job-queue
+ (select-unprocessed-jobs-and-events conn))))
+
(define (render-job mime-types conn job-id query-parameters)
(render-html
#:sxml (view-job
@@ -1132,6 +1137,9 @@
(('GET "jobs")
(render-jobs mime-types
conn))
+ (('GET "jobs" "queue")
+ (render-job-queue mime-types
+ conn))
(('GET "job" job-id)
(let ((parsed-query-parameters
(parse-query-parameters
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index e50b53a..d915a51 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -46,6 +46,7 @@
view-derivation
view-store-item
view-jobs
+ view-job-queue
view-job
compare
compare/derivations
@@ -1491,6 +1492,78 @@
'())))))
jobs-and-events)))))))))
+(define (view-job-queue jobs-and-events)
+ (layout
+ #:body
+ `(,(header)
+ (div
+ (@ (class "container"))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (h1 "Queued jobs ("
+ ,(length jobs-and-events)
+ ")")))
+ (div
+ (@ (class "row"))
+ (div
+ (@ (class "col-sm-12"))
+ (table
+ (@ (class "table"))
+ (thead
+ (tr
+ (th "Commit")
+ (th "Source")
+ (th "Events")
+ (th "")))
+ (tdata
+ ,@(map (match-lambda
+ ((id commit source git-repository-id created-at
+ events log-exists? latest-branch-commit?)
+ `(tr
+ (@ (class
+ ,(let ((event-names
+ (map (lambda (event)
+ (assoc-ref event "event"))
+ (vector->list events))))
+ (cond
+ ((member "success" event-names)
+ "success")
+ ((member "failure" event-names)
+ "danger")
+ ((member "start" event-names)
+ "info")
+ (else
+ "")))))
+ (td (a (@ (href
+ ,(string-append
+ "/revision/" commit)))
+ (samp ,commit)
+ ,@(if latest-branch-commit?
+ '((br)
+ (span (@ (class "text-danger"))
+ "(latest branch commit)"))
+ '())))
+ (td ,source)
+ (td
+ (dl
+ (@ (class "dl-horizontal"))
+ ,@(map
+ (lambda (event)
+ `((dt ,(assoc-ref event "event"))
+ (dd ,(assoc-ref event "occurred_at"))))
+ (cons
+ `(("event" . "created")
+ ("occurred_at" . ,created-at))
+ (vector->list events)))))
+ (td
+ ,@(if log-exists?
+ `((a (@ (href ,(string-append "/job/" id)))
+ "View log"))
+ '())))))
+ jobs-and-events)))))))))
+
(define (view-job job-id query-parameters log)
(layout
#:body