branch master updated: Provide more information about revision processing errors

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 044a905  Provide more information about revision processing errors
044a905 is described below

commit 044a905c1d75e9a989b457c203c4d6a65d29fbe6
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Jun 15 11:36:46 2023 +0100

    Provide more information about revision processing errors
    
    In the compare package derivations response.
---
 guix-data-service/web/compare/controller.scm | 62 ++++++++++++++++++----------
 1 file changed, 40 insertions(+), 22 deletions(-)

diff --git a/guix-data-service/web/compare/controller.scm 
b/guix-data-service/web/compare/controller.scm
index 366a0bd..3d96aa4 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -648,28 +648,46 @@
              '(application/json text/html)
              mime-types)
         ((application/json)
-         (render-json
-          `((error . "invalid query")
-            (query_parameters
-             .
-             ,(map
-               (match-lambda
-                 ((name . val)
-                  (cons
-                   name
-                   (cond
-                    ((invalid-query-parameter? val)
-                     `((invalid
-                        . ,(with-output-to-string
-                             (lambda ()
-                               (sxml->html
-                                (invalid-query-parameter-message
-                                 val)))))
-                       (value . ,(invalid-query-parameter-value val))))
-                    ((list? val)
-                     (list->vector val))
-                    (else val)))))
-               query-parameters)))))
+         (letpar& ((base-job
+                    (and=> (match (assq-ref query-parameters 'base_commit)
+                             (($ <invalid-query-parameter> value)
+                              (and (string? value) value))
+                             ((? string? value) value)
+                             (_ #f))
+                           (lambda (commit)
+                             (with-thread-postgresql-connection
+                              (lambda (conn)
+                                (select-job-for-commit conn commit))))))
+                   (target-job
+                    (and=> (match (assq-ref query-parameters 'target_commit)
+                             (($ <invalid-query-parameter> value)
+                              (and (string? value) value))
+                             ((? string? value) value)
+                             (_ #f))
+                           (lambda (commit)
+                             (with-thread-postgresql-connection
+                              (lambda (conn)
+                                (select-job-for-commit conn commit)))))))
+           (render-json
+            `((error . "invalid query")
+              (query_parameters
+               .
+               ,(map
+                 (match-lambda
+                   ((key . val)
+                    (cons key
+                          (match val
+                            (($ <invalid-query-parameter> value message)
+                             `((invalid_value . ,value)
+                               (message       . ,(call-with-output-string
+                                                   (lambda (port)
+                                                     (sxml->html message 
port))))))
+                            ((? list? val)
+                             (list->vector val))
+                            (val val)))))
+                 query-parameters))
+              (base_job   . ,base-job)
+              (target_job . ,target-job)))))
         (else
          (letpar& ((systems
                     (with-thread-postgresql-connection