[no subject]

[Ludovic Courtès]

branch: master
commit 797b26a4ef80dce278481b1cc3391791ef2cbbaf
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Oct 1 16:11:59 2023 +0200

    http: Fix “/api/jobs/history” endpoint.
    
    Fixes a bug introduced in c445d2d642765f9589313e9ccdd826ef9bf71432 where
    <checkout> records would end up being passed to ‘scm->json’.
    
    * src/cuirass/http.scm (jobs-history->json-object): Pass checkouts
    through ‘checkout->json-object’.
    * tests/http.scm ("/api/jobs/history"): New test.
---
 src/cuirass/http.scm |  3 ++-
 tests/http.scm       | 20 +++++++++++++++++++-
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 831ef4a..7e4fd3b 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -221,7 +221,8 @@ a <checkout> record."
     (map (lambda (eval)
            `((evaluation . ,(assq-ref eval 'evaluation))
              (checkouts . ,(list->vector
-                            (assq-ref eval 'checkouts)))
+                            (map checkout->json-object
+                                 (assq-ref eval 'checkouts))))
              (jobs . ,(list->vector
                        (assq-ref eval 'jobs)))))
          history))))
diff --git a/tests/http.scm b/tests/http.scm
index 83e05de..6073bae 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -123,7 +123,7 @@
                    (completion-time 1501347493)))
            (build2
             (build (derivation "/gnu/store/fake2.drv")
-                   (evaluation-id 1)
+                   (evaluation-id 2)
                    (specification-name "guix")
                    (job-name "fake-job")
                    (system "x86_64-linux")
@@ -265,6 +265,24 @@
      (utf8->string
       (http-get-body (test-cuirass-uri "/api/evaluations?nr=1")))))
 
+  (test-equal "/api/jobs/history"
+    '#((("jobs" . #((("status" . 0) ("build" . 1) ("name" . "fake-job"))))
+        ("checkouts" . #((("directory" . "dir1") ("channel" . "guix")
+                          ("commit" . "fakesha1"))
+                         (("directory" . "dir2") ("channel" . "packages")
+                          ("commit" . "fakesha3"))))
+        ("evaluation" . 1)))
+    (begin
+      (db-register-builds (list (db-get-build "/gnu/store/fake.drv"))
+                          (db-get-specification "guix"))
+      (db-set-evaluation-status 1 (evaluation-status succeeded))
+      (db-update-build-status! "/gnu/store/fake.drv"
+                               (build-status succeeded))
+      (json-string->scm
+       (utf8->string
+        (http-get-body
+         (test-cuirass-uri 
"/api/jobs/history?spec=guix&names=fake-job&nr=10"))))))
+
   (test-assert "db-close"
     (begin
       (db-close (%db))