Improve error handling for comparison pages

This commit is contained in:
Christopher Baines 2019-10-12 21:43:34 +01:00
parent af1ffc2393
commit 2b9c882e5a
2 changed files with 37 additions and 44 deletions

View file

@ -457,29 +457,6 @@
#:header-link header-link) #:header-link header-link)
#:extra-headers http-headers-for-unchanging-content)))))) #:extra-headers http-headers-for-unchanging-content))))))
(define (render-compare-unknown-commit mime-types
conn
base-commit
base-revision-id
target-commit
target-revision-id)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
'((unknown_commit . #t))))
(else
(render-html
#:sxml (compare-unknown-commit base-commit
target-commit
(if base-revision-id #t #f)
(if target-revision-id #t #f)
(select-job-for-commit conn
base-commit)
(select-job-for-commit conn
target-commit))))))
(define (render-compare mime-types (define (render-compare mime-types
conn conn
query-parameters) query-parameters)
@ -492,13 +469,17 @@
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(render-html (render-html
#:sxml (compare #:sxml (compare-invalid-parameters
query-parameters query-parameters
#f (match (assq-ref query-parameters 'base_commit)
#f (($ <invalid-query-parameter> value)
#f (select-job-for-commit conn value))
#f (_ #f))
#f)))) (match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))))))
(let ((base-revision-id (commit->revision-id (let ((base-revision-id (commit->revision-id
conn conn
(assq-ref query-parameters 'base_commit))) (assq-ref query-parameters 'base_commit)))
@ -641,10 +622,16 @@
'((error . "invalid query")))) '((error . "invalid query"))))
(else (else
(render-html (render-html
#:sxml (compare/packages #:sxml (compare-invalid-parameters
query-parameters query-parameters
#f (match (assq-ref query-parameters 'base_commit)
#f)))) (($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))
(match (assq-ref query-parameters 'target_commit)
(($ <invalid-query-parameter> value)
(select-job-for-commit conn value))
(_ #f))))))
(let ((base-commit (assq-ref query-parameters 'base_commit)) (let ((base-commit (assq-ref query-parameters 'base_commit))
(target-commit (assq-ref query-parameters 'target_commit))) (target-commit (assq-ref query-parameters 'target_commit)))

View file

@ -51,7 +51,7 @@
compare compare
compare/derivations compare/derivations
compare/packages compare/packages
compare-unknown-commit compare-invalid-parameters
error-page)) error-page))
(define* (header) (define* (header)
@ -2193,28 +2193,34 @@
(style "font-size: 2em; display: block;")) (style "font-size: 2em; display: block;"))
"Unknown")))))))))) "Unknown"))))))))))
(define (compare-unknown-commit base-commit target-commit (define (compare-invalid-parameters query-parameters
base-exists? target-exists? base-job
base-job target-job) target-job)
(define base-commit
(assq-ref query-parameters 'base_commit))
(define target-commit
(peek (assq-ref query-parameters 'target_commit)))
(layout (layout
#:body #:body
`(,(header) `(,(header)
(div (@ (class "container")) (div (@ (class "container"))
(h1 "Unknown commit") (h1 "Unknown commit")
,(if base-exists? ,(if (invalid-query-parameter? base-commit)
'()
`(p "No known revision with commit " `(p "No known revision with commit "
(strong (samp ,base-commit)) (strong (samp ,(invalid-query-parameter-value base-commit)))
,(if (null? base-job) ,(if (null? base-job)
" and it is not currently queued for processing" " and it is not currently queued for processing"
" but it is queued for processing"))) " but it is queued for processing"))
,(if target-exists? '())
'() ,(if (invalid-query-parameter? target-commit)
`(p "No known revision with commit " `(p "No known revision with commit "
(strong (samp ,target-commit)) (strong (samp ,(invalid-query-parameter-value target-commit)))
,(if (null? target-job) ,(if (null? target-job)
" and it is not currently queued for processing" " and it is not currently queued for processing"
" but it is queued for processing"))))))) " but it is queued for processing"))
'())))))
(define (error-page message) (define (error-page message)
(layout (layout