Improve mirror exception handling

1 files changed, 15 insertions, 8 deletions

diff --git a/nar-herder/mirror.scm b/nar-herder/mirror.scm
index 44ce320..dff0eab 100644
--- a/nar-herder/mirror.scm
+++ b/nar-herder/mirror.scm
@@ -20,6 +20,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-43)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 exceptions)
   #:use-module (rnrs bytevectors)
   #:use-module (web uri)
   #:use-module (web client)
@@ -38,15 +39,16 @@
     (define processed-recent-changes
       (database-select-recent-changes database latest-recent-change))
 
+    (define uri
+      (string->uri
+       (string-append mirror "/recent-changes"
+                      (if latest-recent-change
+                          (string-append "?since=" latest-recent-change)
+                          ""))))
+
     (call-with-values
         (lambda ()
-          (http-get
-           (string->uri
-            (string-append mirror "/recent-changes"
-                           (if latest-recent-change
-                               (string-append "?since=" latest-recent-change)
-                               "")))
-           #:decode-body? #f))
+          (http-get uri #:decode-body? #f))
       (lambda (response body)
         (if (= (response-code response) 200)
             (let ((json-body (json-string->scm
@@ -72,7 +74,12 @@
                       (else
                        (error "unimplemented"))))))
                (assoc-ref json-body "recent_changes")))
-            (error "unknown response code")))))
+            (raise-exception
+             (make-exception-with-message
+              (simple-format #f "unknown response: ~A\n  code: ~A response: ~A"
+                             (uri->string uri)
+                             (response-code response)
+                             (utf8->string body))))))))
 
   (call-with-new-thread
    (lambda ()