cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Support more query parameters on the /builds page

Browse source
This commit is contained in:
Christopher Baines 2021-02-08 21:31:39 +00:00
parent 15d7756ef8
commit f2d98b626d
3 changed files with 146 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

100
guix-data-service/model/build.scm
View file

@ -16,6 +16,8 @@
;;; <http://www.gnu.org/licenses/>. ;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service model build) (define-module (guix-data-service model build)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (squee) #:use-module (squee)
#:use-module (json) #:use-module (json)
@ -46,13 +48,13 @@
")")) ")"))
'()) '())
,@(if revision-commit ,@(if revision-commit
'("guix_revisions.commit = $1") `(("guix_revisions.commit = $" . ,revision-commit))
'()) '())
,@(if system ,@(if system
'("package_derivations.system = $2") `(("package_derivations.system = $" . ,system))
'()) '())
,@(if target ,@(if target
'("package_derivations.target = $3") `(("package_derivations.target = $" . ,target))
'()))) '())))
(define query (define query
@ -60,15 +62,17 @@
" "
SELECT latest_build_status.status AS build_status, build_servers.id, COUNT(*) SELECT latest_build_status.status AS build_status, build_servers.id, COUNT(*)
FROM derivation_output_details_sets FROM derivation_output_details_sets
CROSS JOIN build_servers CROSS JOIN build_servers"
" (if (or revision-commit system target)
(if revision-commit
" "
INNER JOIN derivations_by_output_details_set INNER JOIN derivations_by_output_details_set
ON derivation_output_details_sets.id = ON derivation_output_details_sets.id =
derivations_by_output_details_set.derivation_output_details_set_id derivations_by_output_details_set.derivation_output_details_set_id
INNER JOIN package_derivations INNER JOIN package_derivations
ON derivations_by_output_details_set.derivation_id = package_derivations.derivation_id ON derivations_by_output_details_set.derivation_id = package_derivations.derivation_id"
"")
(if revision-commit
"
INNER JOIN guix_revision_package_derivations INNER JOIN guix_revision_package_derivations
ON guix_revision_package_derivations.package_derivation_id = package_derivations.id ON guix_revision_package_derivations.package_derivation_id = package_derivations.id
INNER JOIN guix_revisions INNER JOIN guix_revisions
@ -86,7 +90,14 @@ LEFT JOIN latest_build_status
"" ""
(string-append (string-append
"WHERE " "WHERE "
(string-join criteria " AND "))) (string-join (let-values (((with-parameters without-parameters)
(partition pair? criteria)))
(append (map (lambda (s index)
(string-append s (number->string index)))
(map car with-parameters)
(iota (length with-parameters) 1))
without-parameters))
" AND ")))
" "
GROUP BY latest_build_status.status, build_servers.id GROUP BY latest_build_status.status, build_servers.id
ORDER BY status")) ORDER BY status"))
@ -103,42 +114,40 @@ ORDER BY status"))
1 1
(exec-query conn (exec-query conn
query query
`(,@(if revision-commit (map (match-lambda
(list revision-commit) ((sql . value) value))
'()) (filter pair? criteria))))))
,@(if system
(list system)
'())
,@(if target
(list target)
'()))))))
(define* (select-builds-with-context conn build-statuses build-server-ids (define* (select-builds-with-context conn build-statuses build-server-ids
#:key revision-commit #:key revision-commit
system target system target
limit) limit)
(define where-conditions (define where-conditions
(filter `(,@(if (list? build-statuses)
string?
(list (list
(when (list? build-statuses)
(string-append (string-append
"latest_build_status.status IN (" "latest_build_status.status IN ("
(string-join (map quote-string build-statuses) (string-join (map quote-string build-statuses)
",") ",")
")")) ")"))
(when (list? build-server-ids) '())
,@(if (list? build-server-ids)
(list
(string-append (string-append
"builds.build_server_id IN (" "builds.build_server_id IN ("
(string-join (map number->string build-server-ids) (string-join (map number->string build-server-ids)
", ") ", ")
")")) ")"))
(when revision-commit '())
"guix_revisions.commit = $1") ,@(if revision-commit
(when system `(("guix_revisions.commit = $" . ,revision-commit))
"package_derivations.system = $2") '())
(when target ,@(if system
"package_derivations.target = $3")))) `(("package_derivations.system = $" . ,system))
'())
,@(if target
`(("package_derivations.target = $" . ,target))
'())))
(define query (define query
(string-append (string-append
@ -148,15 +157,17 @@ SELECT builds.id, build_servers.url,
latest_build_status.timestamp, latest_build_status.status latest_build_status.timestamp, latest_build_status.status
FROM builds FROM builds
INNER JOIN build_servers ON build_servers.id = builds.build_server_id INNER JOIN build_servers ON build_servers.id = builds.build_server_id
INNER JOIN derivations ON derivations.file_name = builds.derivation_file_name INNER JOIN derivations ON derivations.file_name = builds.derivation_file_name"
" (if (or revision-commit system target)
(if revision-commit
" "
INNER JOIN derivations_by_output_details_set INNER JOIN derivations_by_output_details_set
ON builds.derivation_output_details_set_id = ON builds.derivation_output_details_set_id =
derivations_by_output_details_set.derivation_output_details_set_id derivations_by_output_details_set.derivation_output_details_set_id
INNER JOIN package_derivations INNER JOIN package_derivations
ON derivations_by_output_details_set.derivation_id = package_derivations.derivation_id ON derivations_by_output_details_set.derivation_id = package_derivations.derivation_id"
"")
(if revision-commit
"
INNER JOIN guix_revision_package_derivations INNER JOIN guix_revision_package_derivations
ON guix_revision_package_derivations.package_derivation_id = package_derivations.id ON guix_revision_package_derivations.package_derivation_id = package_derivations.id
INNER JOIN guix_revisions INNER JOIN guix_revisions
@ -164,13 +175,20 @@ INNER JOIN guix_revisions
"") "")
" "
INNER JOIN latest_build_status INNER JOIN latest_build_status
ON latest_build_status.build_id = builds.id ON latest_build_status.build_id = builds.id"
"
(if (null? where-conditions) (if (null? where-conditions)
"" ""
(string-append (string-append
"WHERE " "
(string-join where-conditions " AND "))) WHERE "
(string-join (let-values (((with-parameters without-parameters)
(partition pair? where-conditions)))
(append (map (lambda (s index)
(string-append s (number->string index)))
(map car with-parameters)
(iota (length with-parameters) 1))
without-parameters))
" AND ")))
" "
ORDER BY latest_build_status.timestamp DESC NULLS LAST, derivations.file_name ORDER BY latest_build_status.timestamp DESC NULLS LAST, derivations.file_name
" "
@ -181,15 +199,9 @@ ORDER BY latest_build_status.timestamp DESC NULLS LAST, derivations.file_name
(exec-query-with-null-handling conn (exec-query-with-null-handling conn
query query
`(,@(if revision-commit (map (match-lambda
(list revision-commit) ((sql . value) value))
'()) (filter pair? where-conditions))))
,@(if system
(list system)
'())
,@(if target
(list target)
'()))))
(define (select-builds-with-context-by-derivation-file-name (define (select-builds-with-context-by-derivation-file-name
conn derivation-file-name) conn derivation-file-name)

30
guix-data-service/web/build/controller.scm
View file

@ -25,6 +25,7 @@
#:use-module (guix-data-service model build) #:use-module (guix-data-service model build)
#:use-module (guix-data-service model build-status) #:use-module (guix-data-service model build-status)
#:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-server)
#:use-module (guix-data-service model derivation)
#:use-module (guix-data-service web build html) #:use-module (guix-data-service web build html)
#:export (build-controller)) #:export (build-controller))
@ -67,14 +68,24 @@
(parse-query-parameters (parse-query-parameters
request request
`((build_status ,parse-build-status #:multi-value) `((build_status ,parse-build-status #:multi-value)
(build_server ,parse-build-server #:multi-value))))) (build_server ,parse-build-server #:multi-value)
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target #:default "")
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 50)
(all_results ,parse-checkbox-value)))))
(if (any-invalid-query-parameters? parsed-query-parameters) (if (any-invalid-query-parameters? parsed-query-parameters)
(render-html (render-html
#:sxml (view-builds parsed-query-parameters #:sxml (view-builds parsed-query-parameters
build-status-strings build-status-strings
'() '()
'() '()
'()
'()
'())) '()))
(let ((system (assq-ref parsed-query-parameters 'system))
(target (assq-ref parsed-query-parameters 'target)))
(letpar& ((build-server-options (letpar& ((build-server-options
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)
@ -89,7 +100,9 @@
(select-build-stats (select-build-stats
conn conn
(assq-ref parsed-query-parameters (assq-ref parsed-query-parameters
'build_server))))) 'build_server)
#:system system
#:target target))))
(builds-with-context (builds-with-context
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)
@ -99,11 +112,20 @@
'build_status) 'build_status)
(assq-ref parsed-query-parameters (assq-ref parsed-query-parameters
'build_server) 'build_server)
#:limit 50))))) #:system system
#:target target
#:limit (assq-ref parsed-query-parameters
'limit_results)))))
(systems
(with-thread-postgresql-connection valid-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html (render-html
#:sxml (view-builds parsed-query-parameters #:sxml (view-builds parsed-query-parameters
build-status-strings build-status-strings
build-server-options build-server-options
systems
(valid-targets->options targets)
build-stats build-stats
builds-with-context)))))) builds-with-context)))))))

21
guix-data-service/web/build/html.scm
View file

@ -25,6 +25,8 @@
(define (view-builds query-parameters (define (view-builds query-parameters
build-status-strings build-status-strings
build-server-options build-server-options
valid-systems
valid-targets
stats stats
builds) builds)
(layout (layout
@ -82,6 +84,25 @@
query-parameters query-parameters
#:options build-server-options #:options build-server-options
#:help-text "Return builds from these build servers.") #:help-text "Return builds from these build servers.")
,(form-horizontal-control
"System" query-parameters
#:options valid-systems
#:allow-selecting-multiple-options #f
#:help-text "Only include derivations for this system."
#:font-family "monospace")
,(form-horizontal-control
"Target" query-parameters
#:options valid-targets
#:allow-selecting-multiple-options #f
#:help-text "Only include derivations that are build for this system."
#:font-family "monospace")
,(form-horizontal-control
"Limit results" query-parameters
#:help-text "The maximum number of results to return.")
,(form-horizontal-control
"All results" query-parameters
#:type "checkbox"
#:help-text "Return all results")
(div (@ (class "form-group form-group-lg")) (div (@ (class "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10")) (div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit") (button (@ (type "submit")