diff options
| -rw-r--r-- | guix-qa-frontpage/issue.scm | 99 | ||||
| -rw-r--r-- | guix-qa-frontpage/view/issue.scm | 81 |
2 files changed, 124 insertions, 56 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index f7d3d2a..abcf96e 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -123,12 +123,39 @@ (if base-and-target-refs (with-exception-handler (lambda (exn) - (simple-format - (current-error-port) - "exception fetching derivation changes: ~A\n" - exn) - - (values #f #f)) + (values + (if (guix-data-service-error? exn) + `((exception . guix-data-service-invalid-parameters) + (invalid_query_parameters + . + ,(filter-map + (match-lambda + ((param . val) + (and=> + (assoc-ref val "invalid_value") + (lambda (value) + (let ((message + (assoc-ref val "message"))) + (cons + param + `((value . ,value) + (error + ;; Convert the HTML error messages + ;; to something easier to handle + . ,(cond + ((string-contains message + "failed to process revision") + 'failed-to-process-revision) + ((string-contains message + "yet to process revision") + 'yet-to-process-revision) + (else + 'unknown)))))))))) + (assoc-ref + (guix-data-service-error-response-body exn) + "query_parameters")))) + `((exception . ,(simple-format #f "~A" exn)))) + #f)) (lambda () (revision-derivation-changes (revision-derivation-changes-url @@ -137,13 +164,13 @@ #:unwind? #t) (values #f #f))) (derivation-changes-counts - (if derivation-changes-data + (if change-details (derivation-changes-counts derivation-changes-data %systems-to-submit-builds-for) #f)) (builds-missing? - (if derivation-changes-data + (if change-details (builds-missing-for-derivation-changes? derivation-changes-data) #t)) @@ -153,10 +180,36 @@ (with-exception-handler (lambda (exn) (if (guix-data-service-error? exn) - ;; TODO Return some description this error that can be - ;; cached - #f - (raise-exception exn))) + `((exception . guix-data-service-invalid-parameters) + (invalid_query_parameters + . + ,(filter-map + (match-lambda + ((param . val) + (and=> + (assoc-ref val "invalid_value") + (lambda (value) + (let ((message + (assoc-ref val "message"))) + (cons + param + `((value . ,value) + (error + ;; Convert the HTML error messages + ;; to something easier to handle + . ,(cond + ((string-contains message + "failed to process revision") + 'failed-to-process-revision) + ((string-contains message + "yet to process revision") + 'yet-to-process-revision) + (else + 'unknown)))))))))) + (assoc-ref + (guix-data-service-error-response-body exn) + "query_parameters")))) + `((exception . ,(simple-format #f "~A" exn))))) (lambda () (revision-comparison (revision-comparison-url @@ -199,23 +252,11 @@ (lambda (series) (with-exception-handler (lambda (exn) - (unless - (and (guix-data-service-error? exn) - ;; This probably just means the target - ;; revision hasn't been processed yet. The - ;; Guix Data Service should send a more - ;; informative response though. - (and=> (assoc-ref - (guix-data-service-error-response-body exn) - "error") - (lambda (error) - (string=? error - "invalid query")))) - (simple-format - (current-error-port) - "failed fetching derivation changes for issue ~A: ~A\n" - (car series) - exn)) + (simple-format + (current-error-port) + "failed fetching derivation changes for issue ~A: ~A\n" + (car series) + exn) #f) (lambda () diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm index 47737be..09e6bb5 100644 --- a/guix-qa-frontpage/view/issue.scm +++ b/guix-qa-frontpage/view/issue.scm @@ -139,7 +139,7 @@ td.bad { (th "Message"))) (tbody ,@(if (and comparison-details - (not (guix-data-service-error? comparison-details))) + (not (assq-ref comparison-details 'exception))) (if (eq? (vector-length (assoc-ref comparison-details "lint_warnings")) 0) `((tr @@ -181,19 +181,32 @@ td.bad { (td (@ (colspan 3) (class "bad")) "Comparison unavailable" - ,@(or (and=> (and (guix-data-service-error? comparison-details) - (assoc-ref (guix-data-service-error-response-body - comparison-details) - "target_job")) - (lambda (target-job) - `((p - "Yet to process " - (a (@ (href ,(string-append - "https://data.qa.guix.gnu.org/revision/" - (assoc-ref target-job "commit")))) - "revision") - ", job " - ,(assoc-ref target-job "state"))))) + ,@(or (and=> + (assq-ref comparison-details 'exception) + (lambda (exception) + (and=> + (assq-ref comparison-details 'invalid_query_parameters) + (lambda (invalid-params) + (let ((target-commit + (assoc-ref invalid-params "target_commit"))) + (cond + (target-commit + (let ((error (assq-ref target-commit 'error)) + (value (assq-ref target-commit 'value))) + `((p + ,(cond + ((eq? error 'yet-to-process-revision) + "Yet to process ") + ((eq? error 'failed-to-process-revision) + "Failed to process ") + (else + "Unknown issue with ")) + (a (@ (href ,(string-append + "https://data.qa.guix.gnu.org/revision/" + value))) + "revision"))))) + (else + #f))))))) '())))))))) (div @@ -325,19 +338,33 @@ td.bad { (td (@ (colspan 10) (class "bad")) "Comparison unavailable" - ,@(or (and=> (and (guix-data-service-error? comparison-details) - (assoc-ref (guix-data-service-error-response-body - comparison-details) - "target_job")) - (lambda (target-job) - `((p - "Yet to process " - (a (@ (href ,(string-append - "https://data.qa.guix.gnu.org/revision/" - (assoc-ref target-job "commit")))) - "revision") - ", job " - ,(assoc-ref target-job "state"))))) + + ,@(or (and=> + (assq-ref comparison-details 'exception) + (lambda (exception) + (and=> + (assq-ref comparison-details 'invalid_query_parameters) + (lambda (invalid-params) + (let ((target-commit + (assoc-ref invalid-params "target_commit"))) + (cond + (target-commit + (let ((error (assq-ref target-commit 'error)) + (value (assq-ref target-commit 'value))) + `((p + ,(cond + ((eq? error 'yet-to-process-revision) + "Yet to process ") + ((eq? error 'failed-to-process-revision) + "Failed to process ") + (else + "Unknown issue with ")) + (a (@ (href ,(string-append + "https://data.qa.guix.gnu.org/revision/" + value))) + "revision"))))) + (else + #f))))))) '())))))))) (div |