Improve error reporting on the issue page

This regressed when more data started to be cached, since the exceptions
couldn't be stored in the db, but now some of the information makes it
through.

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