01/08: gnu: tests: Fix guix-data-service test.

[guix-commits]

cbaines pushed a commit to branch master
in repository guix.

commit 6a2a8ca1f5560c37cdf20cbbac972db64a9dbac9
Author: Timotej Lazar <timotej.lazar@araneo.si>
AuthorDate: Fri Jul 15 07:56:06 2022 +0200

    gnu: tests: Fix guix-data-service test.
    
    Since revision 32, guix-data-service starts immediately but returns an HTTP
    error code until initialization is complete. Adjust the test accordingly, 
and
    remove the increased startup time limit.
    
    * gnu/services/guix.scm (guix-data-service): Use default #:pid-file-timeout.
    * gnu/tests/guix.scm (guix-data-service): Retry the http-get test several
    times to give the service time to initialize.
    
    Signed-off-by: Christopher Baines <mail@cbaines.net>
---
 gnu/services/guix.scm |  2 --
 gnu/tests/guix.scm    | 21 +++++++++++++++------
 2 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 338e027245..dac1e5841a 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -652,8 +652,6 @@ ca-certificates.crt file in the system profile."
                 #:user #$user
                 #:group #$group
                 #:pid-file "/var/run/guix-data-service/pid"
-                ;; Allow time for migrations to run
-                #:pid-file-timeout 120
                 #:environment-variables
                 `(,(string-append
                     "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale")
diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm
index a4c3e35e5d..ad0980a10c 100644
--- a/gnu/tests/guix.scm
+++ b/gnu/tests/guix.scm
@@ -222,14 +222,23 @@ host      all     all     ::1/128         trust"))))))
                      ((pid) (number? pid))))))
              marionette))
 
+          ;; The service starts immediately but replies with status 500 until
+          ;; initialization is complete, so keep trying for a while.
+          (define (try-http-get attempts)
+            (let ((status
+                   (let-values (((response text)
+                                 (http-get #$(simple-format
+                                              #f 
"http://localhost:~A/healthcheck";
+                                              forwarded-port))))
+                     (response-code response))))
+              (if (or (= status 200) (<= attempts 1))
+                  status
+                  (begin (sleep 5)
+                         (try-http-get (- attempts 1))))))
+
           (test-equal "http-get"
             200
-            (let-values
-                (((response text)
-                  (http-get #$(simple-format
-                               #f "http://localhost:~A/healthcheck"; 
forwarded-port)
-                            #:decode-body? #t)))
-              (response-code response)))
+            (try-http-get 12))
 
           (test-end))))