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

Improve system and target query parameter handling

Browse source
This commit is contained in:
Christopher Baines 2020-02-13 23:11:59 +00:00
parent dfccbf911c
commit 374dc25440
5 changed files with 50 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

3
guix-data-service/model/derivation.scm
View file

@ -68,8 +68,7 @@
"x86_64-linux")) "x86_64-linux"))
(define (valid-targets conn) (define (valid-targets conn)
'("" ;; no target '("arm-linux-gnueabihf"
"arm-linux-gnueabihf"
"aarch64-linux-gnu" "aarch64-linux-gnu"
"powerpc-linux-gnu" "powerpc-linux-gnu"
"riscv64-linux-gnu" "riscv64-linux-gnu"

7
guix-data-service/web/compare/controller.scm
View file

@ -44,9 +44,6 @@
. (public . (public
(max-age . ,cache-control-default-max-age))))) (max-age . ,cache-control-default-max-age)))))
(define (parse-system s)
s)
(define (parse-build-status s) (define (parse-build-status s)
s) s)
@ -106,7 +103,7 @@
`((base_commit ,(parse-commit conn) #:required) `((base_commit ,(parse-commit conn) #:required)
(target_commit ,(parse-commit conn) #:required) (target_commit ,(parse-commit conn) #:required)
(system ,parse-system #:multi-value) (system ,parse-system #:multi-value)
(target ,parse-system #:multi-value) (target ,parse-target #:multi-value)
(build_status ,parse-build-status #:multi-value))))) (build_status ,parse-build-status #:multi-value)))))
(render-compare/derivations mime-types (render-compare/derivations mime-types
conn conn
@ -121,7 +118,7 @@
(target_branch ,identity #:required) (target_branch ,identity #:required)
(target_datetime ,parse-datetime #:required) (target_datetime ,parse-datetime #:required)
(system ,parse-system #:multi-value) (system ,parse-system #:multi-value)
(target ,parse-system #:multi-value) (target ,parse-target #:multi-value)
(build_status ,parse-build-status #:multi-value))) (build_status ,parse-build-status #:multi-value)))
'((base_commit base_datetime) '((base_commit base_datetime)
(target_commit target_datetime))))) (target_commit target_datetime)))))

19
guix-data-service/web/query-parameters.scm
View file

@ -42,7 +42,11 @@
parse-datetime parse-datetime
parse-checkbox-value parse-checkbox-value
parse-number parse-number
parse-result-limit)) parse-result-limit
parse-system
parse-target
valid-targets->options))
(define (parse-query-string query) (define (parse-query-string query)
"Parse and decode the URI query string QUERY and return an alist." "Parse and decode the URI query string QUERY and return an alist."
@ -219,6 +223,19 @@
(define parse-result-limit parse-number) (define parse-result-limit parse-number)
(define parse-system identity)
(define (parse-target target)
(if (string=? target "none")
""
target))
(define (valid-targets->options targets)
`(("" . "none")
,@(map (lambda (target)
(cons target target))
targets)))
(define (any-invalid-query-parameters? query-parameters) (define (any-invalid-query-parameters? query-parameters)
(->bool (any (lambda (val) (->bool (any (lambda (val)
(if (list? val) (if (list? val)

24
guix-data-service/web/revision/controller.scm
View file

@ -64,9 +64,6 @@
. (public . (public
(max-age . ,cache-control-default-max-age))))) (max-age . ,cache-control-default-max-age)))))
(define (parse-system s)
s)
(define (parse-build-status status) (define (parse-build-status status)
(if (member status build-status-strings) (if (member status build-status-strings)
status status
@ -173,7 +170,7 @@
request request
`((search_query ,identity) `((search_query ,identity)
(system ,parse-system #:multi-value) (system ,parse-system #:multi-value)
(target ,identity #:multi-value) (target ,parse-target #:multi-value)
(maximum_builds ,parse-number) (maximum_builds ,parse-number)
(minimum_builds ,parse-number) (minimum_builds ,parse-number)
(after_name ,identity) (after_name ,identity)
@ -202,7 +199,7 @@
(output_consistency ,identity (output_consistency ,identity
#:default "any") #:default "any")
(system ,parse-system #:default "x86_64-linux") (system ,parse-system #:default "x86_64-linux")
(target ,identity) (target ,parse-target)
(limit_results ,parse-result-limit (limit_results ,parse-result-limit
#:no-default-when (all_results) #:no-default-when (all_results)
#:default 10) #:default 10)
@ -252,7 +249,7 @@
`((build_status ,parse-build-status #:multi-value) `((build_status ,parse-build-status #:multi-value)
(build_server ,(parse-build-server conn) #:multi-value) (build_server ,(parse-build-server conn) #:multi-value)
(system ,parse-system #:default "x86_64-linux") (system ,parse-system #:default "x86_64-linux")
(target ,identity))))) (target ,parse-target)))))
(render-revision-builds mime-types (render-revision-builds mime-types
conn conn
@ -698,7 +695,8 @@
#:sxml (view-revision-derivations commit-hash #:sxml (view-revision-derivations commit-hash
query-parameters query-parameters
(valid-systems conn) (valid-systems conn)
(valid-targets conn) (valid-targets->options
(valid-targets conn))
'() '()
'() '()
#f #f
@ -755,7 +753,8 @@
#:sxml (view-revision-derivations commit-hash #:sxml (view-revision-derivations commit-hash
query-parameters query-parameters
(valid-systems conn) (valid-systems conn)
(valid-targets conn) (valid-targets->options
(valid-targets conn))
derivations derivations
build-server-urls build-server-urls
show-next-page? show-next-page?
@ -830,7 +829,8 @@
derivation-outputs derivation-outputs
build-server-urls build-server-urls
(valid-systems conn) (valid-systems conn)
(valid-targets conn) (valid-targets->options
(valid-targets conn))
show-next-page? show-next-page?
#:path-base path-base #:path-base path-base
#:header-text header-text #:header-text header-text
@ -852,7 +852,8 @@
commit-hash commit-hash
build-status-strings build-status-strings
(valid-systems conn) (valid-systems conn)
(valid-targets conn) (valid-targets->options
(valid-targets conn))
'() '()
'() '()
'())) '()))
@ -863,7 +864,8 @@
commit-hash commit-hash
build-status-strings build-status-strings
(valid-systems conn) (valid-systems conn)
(valid-targets conn) (valid-targets->options
(valid-targets conn))
(map (match-lambda (map (match-lambda
((id url lookup-all-derivations) ((id url lookup-all-derivations)
(cons url id))) (cons url id)))

19
guix-data-service/web/view/html.scm
View file

@ -104,7 +104,8 @@
options options
(allow-selecting-multiple-options #t) (allow-selecting-multiple-options #t)
font-family font-family
(type "text")) (type "text")
(null-string-value "none"))
(define (value->text value) (define (value->text value)
(match value (match value
(#f "") (#f "")
@ -163,14 +164,26 @@
(map (match-lambda (map (match-lambda
((option-label . option-value) ((option-label . option-value)
`(option `(option
(@ ,@(if (member option-value selected-options) (@ ,@(if (member (if (and
(string? option-value)
(string=? option-value
null-string-value))
""
option-value)
selected-options)
'((selected "")) '((selected ""))
'()) '())
(value ,option-value)) (value ,option-value))
,(value->text option-label))) ,(value->text option-label)))
(option-value (option-value
`(option `(option
(@ ,@(if (member option-value selected-options) (@ ,@(if (member (if (and
(string? option-value)
(string=? option-value
null-string-value))
""
option-value)
selected-options)
'((selected "")) '((selected ""))
'())) '()))
,(value->text option-value)))) ,(value->text option-value))))