From 1c608ffee23a662bcd1197c598e1f8dde00001d3 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 16 Oct 2024 10:57:02 +0100
Subject: Wrap more of check-removal-criteria in retry-on-error

As this wasn't catching exceptions in json->scm.
---
 nar-herder/storage.scm | 38 +++++++++++++++++++-------------------
 1 file changed, 19 insertions(+), 19 deletions(-)

diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm
index b57ccd8..57f35fb 100644
--- a/nar-herder/storage.scm
+++ b/nar-herder/storage.scm
@@ -422,26 +422,26 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
                                   ".narinfo/info"))))
          (with-port-timeouts
           (lambda ()
-            (call-with-values
-                (lambda ()
-                  (retry-on-error
+            (retry-on-error
+             (lambda ()
+               (call-with-values
                    (lambda ()
-                     (call-with-cached-connection uri
-                       (lambda (port)
-                         (http-get uri
-                                   #:port port
-                                   #:decode-body? #f
-                                   #:keep-alive? #t
-                                   #:streaming? #t))))
-                   #:times 3
-                   #:delay 5))
-              (lambda (response body)
-                (and (= (response-code response)
-                        200)
-
-                     (let ((json-body (json->scm body)))
-                       (eq? (assoc-ref json-body "stored")
-                            #t))))))
+                     (call-with-cached-connection
+                      uri
+                      (lambda (port)
+                        (http-get uri
+                                  #:port port
+                                  #:decode-body? #f
+                                  #:keep-alive? #t
+                                  #:streaming? #t))))
+                 (lambda (response body)
+                   (and (= (response-code response)
+                           200)
+                        (let ((json-body (json->scm body)))
+                          (eq? (assoc-ref json-body "stored")
+                               #t))))))
+             #:times 3
+             #:delay 5))
           #:timeout 30)))))
 
   (define (nar-can-be-removed? nar)
-- 
cgit v1.2.3