nassella/app
1
0
Fork 0
Code Issues 26 Pull Requests Packages Projects 1 Releases Wiki Activity

Reworking backblaze bucket delete to handle all key types

Browse Source
This commit is contained in:
Thomas Hintz
2026-07-24 20:54:14 -07:00
parent 420a7756af
commit a64247de4e
1 changed files with 29 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
src/nassella.scm
View File

@@ -670,14 +670,31 @@ h1, h2, h3, h4, h5, h6 {
#f #f
read-json)) read-json))
(define (b2-authorization-details key-id key) (define (b2-list-buckets api-url account-token account-id)
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference (string-append api-url "/b2api/v4/b2_list_buckets"))
headers: (headers `((authorization #(,account-token raw))
(content-type application/json))))
(lambda ()
(write-json
`((accountId . ,account-id))))
read-json))
(define (b2-authorization-details key-id key bucket-name)
(let* ((auth (b2-authorize-account key-id key)) (let* ((auth (b2-authorize-account key-id key))
(buckets (alist-ref 'buckets (alist-ref 'allowed (alist-ref 'storageApi (alist-ref 'apiInfo auth)))))) (authorization-token (alist-ref 'authorizationToken auth))
(values (alist-ref 'authorizationToken auth) (account-id (alist-ref 'accountId auth))
(alist-ref 'accountId auth) (api-url (alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo auth))))
(alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo auth))) (buckets (alist-ref 'buckets (alist-ref 'allowed (alist-ref 'storageApi (alist-ref 'apiInfo auth)))))
(alist-ref 'id (car buckets)) ;; assume at least one bucket and the one we want for now (listed-bucket-id (and (eq? buckets 'null) ;; if the key does not contain a bucket restriction it should be able to use the api to list buckets
(alist-ref 'name (car buckets)) (alist-ref 'bucketId ;; TODO handle the bucket not being found
(find (lambda (x) (string=? (alist-ref 'bucketName x) bucket-name))
(alist-ref 'buckets (b2-list-buckets api-url authorization-token account-id)))))))
(values authorization-token
account-id
api-url
(or listed-bucket-id (alist-ref 'id (car buckets))) ;; assume at least one bucket and the one we want for now, TODO handle better
buckets))) buckets)))
(define (b2-list-file-versions api-url account-token bucket-id) (define (b2-list-file-versions api-url account-token bucket-id)
@@ -707,9 +724,9 @@ h1, h2, h3, h4, h5, h6 {
(fileId . ,file-id)))) (fileId . ,file-id))))
read-json)) read-json))
(define (b2-delete-bucket-files key-id app-key) (define (b2-delete-bucket-files key-id app-key bucket-name)
(receive (token account-id api-url bucket-id _ _) (receive (token account-id api-url bucket-id _)
(b2-authorization-details key-id app-key) (b2-authorization-details key-id app-key bucket-name)
(let loop ((files (b2-list-file-versions-only-name-id api-url token bucket-id))) (let loop ((files (b2-list-file-versions-only-name-id api-url token bucket-id)))
(when (not (null? files)) (when (not (null? files))
(for-each (lambda (file) (for-each (lambda (file)
@@ -2290,7 +2307,8 @@ chmod -R 777 /opt/keys")))
(if (eof-object? tf-state-backup) "" tf-state-backup)))) (if (eof-object? tf-state-backup) "" tf-state-backup))))
;; todo handle errors here ;; todo handle errors here
(when delete-backups (when delete-backups
(b2-delete-bucket-files (alist-ref 'backblaze-key-id service-config) (alist-ref 'backblaze-application-key service-config))) (b2-delete-bucket-files (alist-ref 'backblaze-key-id service-config) (alist-ref 'backblaze-application-key service-config)
(last (uri-path (uri-reference (alist-ref 'backblaze-bucket-url service-config))))))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-status (update-deployment-status