From 91b7c1b55475bf5705f40068d4c509d43422a9a2 Mon Sep 17 00:00:00 2001
From: Ray Miller <ray@metail.co.uk>
Date: Sun, 15 Jun 2025 15:03:13 +0100
Subject: [PATCH] Bug fixes, improvements, parallel download

---
 guile/b2-pitr.scm | 78 ++++++++++++++++++++++++++---------------------
 1 file changed, 43 insertions(+), 35 deletions(-)
 mode change 100644 => 100755 guile/b2-pitr.scm

diff --git a/guile/b2-pitr.scm b/guile/b2-pitr.scm
old mode 100644
new mode 100755
index 9cf5447..7833e5d
--- a/guile/b2-pitr.scm
+++ b/guile/b2-pitr.scm
@@ -8,12 +8,13 @@
              (ice-9 exceptions)
              ((ice-9 iconv) #:select (string->bytevector))
              (ice-9 match)
+             (ice-9 threads)
              (json)
              (oop goops)
-             (srfi srfi-1)
-             (srfi srfi-19)
-             (srfi srfi-26)
-             (srfi srfi-71)
+             (srfi srfi-1)  ;; lists
+             (srfi srfi-19) ;; date/time
+             (srfi srfi-26) ;; cut
+             (srfi srfi-71) ;; extended let
              (web client)
              (web http)
              (web response)
@@ -115,12 +116,25 @@
           (close-port body-port)
           body))))
 
-(define (list-buckets cli)
-  (assoc-ref (api-call cli
-                       http-post
-                       "/b2api/v4/b2_list_buckets"
-                       #:payload `(("accountId" . ,(account-id cli))))
-             "buckets"))
+(define* (list-buckets cli #:key bucket-id bucket-name bucket-types)
+  (let ((params `(("accountId" . ,(account-id cli)))))
+    (when bucket-id (set! params (assoc-set! params "bucketId" bucket-id)))
+    (when bucket-name (set! params (assoc-set! params "bucketName" bucket-name)))
+    (when bucket-types (set! params (assoc-set! params "bucketTypes" bucket-types)))
+    (assoc-ref (api-call cli
+                         http-post
+                         "/b2api/v4/b2_list_buckets"
+                         #:payload params)
+               "buckets")))
+
+(define (get-bucket-id cli bucket-name)
+  (let ((buckets (list-buckets cli #:bucket-name bucket-name)))
+    (when (zero? (vector-length buckets))
+      (raise-exception (make-exception
+                        (make-external-error)
+                        (make-exception-with-message "Bucket not found")
+                        (make-exception-with-irritants bucket-name))))
+    (assoc-ref (vector-ref buckets 0) "bucketId")))
 
 (define* (list-file-versions cli bucket-id #:key prefix delimiter start-file-name start-file-id max-file-count)
   (api-call cli http-get "/b2api/v4/b2_list_file_versions"
@@ -148,13 +162,6 @@
                                            #:start-file-id next-file-id
                                            #:max-file-count 10000))))))
 
-(define (resolve-bucket-id cli bucket-name)
-  (let ((bucket (find (lambda (b) (string=? bucket-name (assoc-ref b "bucketName")))
-                      (vector->list (list-buckets cli)))))
-    (if bucket
-        (assoc-ref bucket "bucketId")
-        #f)))
-
 ;; Borrowed from guix/build/utils.scm
 (define (mkdir-p dir)
   "Create directory DIR and all its ancestors."
@@ -211,9 +218,9 @@ been deleted. The 'start' and 'folder' actions are not of interest here.
 Backblaze creates a file called .bzEmpty in every directory. We never want to
 resore these empty files."
   (define (latest-before-cutoff files)
-    (find (lambda (f)
-            (< (assoc-ref f "uploadTimestamp") cutoff))
-          files))
+    (find (lambda (f) (< (assoc-ref f "uploadTimestamp") cutoff)) files))
+  (define (bz-empty? f)
+    (string=? ".bzEmpty" (basename (assoc-ref f "fileName"))))
   (define (select-by-filename files result)
     (if (null? files)
         result
@@ -224,24 +231,25 @@ resore these empty files."
           (if (and batch-latest (string=? "upload" (assoc-ref batch-latest "action")))
               (select-by-filename remainder (cons batch-latest result))
               (select-by-filename remainder result)))))
-  (select-by-filename (remove (lambda (f) (string=? ".bzEmpty" (assoc-ref f "fileName")))  files) '()))
+  (select-by-filename (remove bz-empty? files) '()))
 
 (define (restore cli files target-dir)
-  (for-each (lambda (f)
-              (download-file-by-id cli
-                                   (assoc-ref f "fileId")
-                                   (string-append target-dir "/" (assoc-ref f "fileName"))))
-            files))
+  (n-par-for-each 4 (lambda (f)
+                      (download-file-by-id cli
+                                           (assoc-ref f "fileId")
+                                           (string-append target-dir "/" (assoc-ref f "fileName"))))
+                  files))
+
+(define* (recover-at-point-in-time cli #:key bucket-name cutoff-time target-dir prefix)
+  (let* ((bucket-id (get-bucket-id cli bucket-name))
+         (file-versions (list-all-file-versions cli bucket-id #:prefix prefix))
+         (to-recover (select-for-recovery file-versions cutoff-time)))
+    (restore cli to-recover target-dir)))
 
 (define (main args)
+  ;; TODO: parse command-line args for bucket name, prefix, cutoff, and target dir.
   (define cli (make <b2-client> #:key-id (getenv "BB_KEY_ID") #:app-key (getenv "BB_APP_KEY")))
-
-  (define bucket-id (resolve-bucket-id cli "uk-org-1729-server-backups"))
+  (define bucket-name "uk-org-1729-backups")
   (define cutoff (* 1000 (time-second (date->time-utc (string->date "2025-06-01 00:00:00+0000" "~Y-~m-~d ~H:~M:~S~z")))))
-
-  (define file-versions (list-all-file-versions cli bucket-id))
-  (define to-recover (select-for-recovery file-versions cutoff))
-  (define target-dir "/home/ray/Downloads/uk-org-1729-server-backups")
-
-  #f
-  )
+  (define target-dir "/home/ray/Downloads/uk-org-1729-backups")
+  (recover-at-point-in-time cli #:bucket-name bucket-name #:cutoff-time cutoff #:target-dir target-dir))