Improve error handling for comparison pages

2 files changed, 37 insertions, 44 deletions

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index cee34f1..cad1db5 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -457,29 +457,6 @@
                                                 #:header-link header-link)
             #: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
                         conn
                         query-parameters)
@@ -492,13 +469,17 @@
           '((error . "invalid query"))))
         (else
          (render-html
-          #:sxml (compare
+          #:sxml (compare-invalid-parameters
                   query-parameters
-                  #f
-                  #f
-                  #f
-                  #f
-                  #f))))
+                  (match (assq-ref query-parameters 'base_commit)
+                    (($ <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-revision-id (commit->revision-id
                                conn
                                (assq-ref query-parameters 'base_commit)))
@@ -641,10 +622,16 @@
           '((error . "invalid query"))))
         (else
          (render-html
-          #:sxml (compare/packages
+          #:sxml (compare-invalid-parameters
                   query-parameters
-                  #f
-                  #f))))
+                  (match (assq-ref query-parameters 'base_commit)
+                    (($ <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))
             (target-commit  (assq-ref query-parameters 'target_commit)))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index d915a51..b0857d1 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -51,7 +51,7 @@
             compare
             compare/derivations
             compare/packages
-            compare-unknown-commit
+            compare-invalid-parameters
             error-page))
 
 (define* (header)
@@ -2193,28 +2193,34 @@
                           (style "font-size: 2em; display: block;"))
                        "Unknown"))))))))))
 
-(define (compare-unknown-commit base-commit target-commit
-                                base-exists? target-exists?
-                                base-job target-job)
+(define (compare-invalid-parameters query-parameters
+                                    base-job
+                                    target-job)
+  (define base-commit
+    (assq-ref query-parameters 'base_commit))
+
+  (define target-commit
+    (peek (assq-ref query-parameters 'target_commit)))
+
   (layout
    #:body
    `(,(header)
      (div (@ (class "container"))
           (h1 "Unknown commit")
-          ,(if base-exists?
-               '()
+          ,(if (invalid-query-parameter? base-commit)
                `(p "No known revision with commit "
-                   (strong (samp ,base-commit))
+                   (strong (samp ,(invalid-query-parameter-value base-commit)))
                    ,(if (null? base-job)
                         " and it is not currently queued for processing"
-                        " but it is queued for processing")))
-          ,(if target-exists?
-               '()
+                        " but it is queued for processing"))
+               '())
+          ,(if (invalid-query-parameter? target-commit)
                `(p "No known revision with commit "
-                   (strong (samp ,target-commit))
+                   (strong (samp ,(invalid-query-parameter-value target-commit)))
                    ,(if (null? target-job)
                         " and it is not currently queued for processing"
-                        " but it is queued for processing")))))))
+                        " but it is queued for processing"))
+               '())))))
 
 (define (error-page message)
   (layout