branch: elpa/hyperdrive
commit 849de77a47ce2ab74c68b75e201dcdbd465dd891
Author: Adam Porter <a...@alphapapa.net>
Commit: Joseph Turner <jos...@ushin.org>
Add: (he/api) New function, and use it
---
hyperdrive-diff.el | 4 ++--
hyperdrive-dir.el | 5 ++---
hyperdrive-lib.el | 35 ++++++++++++++++++++++++-----------
hyperdrive.el | 34 +++++++++++++++++-----------------
4 files changed, 45 insertions(+), 33 deletions(-)
diff --git a/hyperdrive-diff.el b/hyperdrive-diff.el
index 9885d00aa5..2e8361337b 100644
--- a/hyperdrive-diff.el
+++ b/hyperdrive-diff.el
@@ -103,12 +103,12 @@ This function is intended to diff files, not directories."
(kill-buffer old-buffer))
(when (buffer-live-p new-buffer)
(kill-buffer new-buffer))))))))
- (h/api 'get (he/url old-entry)
+ (he/api 'get old-entry
:queue queue :as 'response :else #'ignore
:then (lambda (response)
(h//fill old-entry (plz-response-headers response))
(setf old-response response)))
- (h/api 'get (he/url new-entry)
+ (he/api 'get new-entry
:queue queue :as 'response :else #'ignore
:then (lambda (response)
(h//fill new-entry (plz-response-headers response))
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index b379422f6b..afbdb957a0 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -40,7 +40,6 @@ If THEN, call it in the directory buffer with no arguments."
;; NOTE: ENTRY is not necessarily "filled" yet.
(pcase-let*
(((cl-struct hyperdrive-entry hyperdrive version) directory-entry)
- (url (he/url directory-entry))
(header (progn
;; Fill metadata first to get the current nickname.
;; TODO: Consider filling metadata earlier, outside
@@ -63,7 +62,7 @@ If THEN, call it in the directory buffer with no arguments."
(when-let ((node (h/ewoc-find-node ewoc entry
:predicate #'he/equal-p)))
(goto-char (ewoc-location node)))))
- (h/api 'get url :as 'response :noquery t
+ (he/api 'get directory-entry :as 'response :noquery t
;; Get "full" listing with metadata
:headers `(("Accept" . "application/json; metadata=full"))
:then (lambda (response)
@@ -350,7 +349,7 @@ see Info node `(elisp)Yanking Media'."
hyperdrive)
:predicate #'h/writablep
:default-path path :latest-version t)))
- (h/api 'put (he/url entry)
+ (he/api 'put entry
:body-type 'binary
;; TODO: Pass MIME type in a header? hyper-gateway detects it for us.
:body image :as 'response
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 21e24b382a..24e9592b72 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -204,6 +204,12 @@ make the request."
;; We pass only the `plz-error' struct to the ELSE* function.
(funcall else* (caddr err))))))
+(defun he/api (method entry &rest rest)
+ "Make hyperdrive API request by METHOD for ENTRY.
+REST is passed to `h/api', which see."
+ (declare (indent defun))
+ (apply #'h/api method (he/url entry) rest))
+
(defun h/gateway-needs-upgrade-p ()
"Return non-nil if the gateway is responsive and needs upgraded."
(and (h//gateway-ready-p)
@@ -254,6 +260,16 @@ PLZ-ERR should be a `plz-error' struct."
h/gateway-port
(substring url (length h//hyper-prefix))))
+(cl-defun he//write (entry &key body then else queue)
+ "Save BODY (a string) to hyperdrive ENTRY.
+THEN and ELSE are passed to `hyperdrive-api', which see."
+ (declare (indent defun))
+ (he/api 'put entry
+ ;; TODO: Investigate whether we should use 'text body type for text
buffers.
+ :body-type 'binary
+ ;; TODO: plz accepts buffer as a body, we should refactor calls to
h//write to pass in a buffer instead of a buffer-string.
+ :body body :as 'response :then then :else else :queue queue))
+
(cl-defun h//write (url &key body then else queue)
"Save BODY (a string) to hyperdrive URL.
THEN and ELSE are passed to `hyperdrive-api', which see."
@@ -647,7 +663,7 @@ the given `plz-queue'"
('sync (condition-case err
(h//fill entry
(plz-response-headers
- (h/api 'head (he/url entry)
+ (he/api 'head entry
:as 'response
:then 'sync
:noquery t)))
@@ -658,7 +674,7 @@ the given `plz-queue'"
(h/update-nonexistent-version-range entry)))
;; Re-signal error for, e.g. `he/at'.
(signal (car err) (cdr err)))))
- (_ (h/api 'head (he/url entry)
+ (_ (he/api 'head entry
:queue queue
:as 'response
:then (lambda (response)
@@ -765,10 +781,7 @@ entry as a side-effect."
"Synchronously fill the latest version slot in HYPERDRIVE.
Returns the latest version number."
(pcase-let (((cl-struct plz-response headers)
- (h/api
- 'head (he/url
- (he/create
- :hyperdrive hyperdrive :path "/"))
+ (he/api 'head (he/create :hyperdrive hyperdrive :path "/")
:as 'response)))
(h//fill-latest-version hyperdrive headers)))
@@ -909,7 +922,7 @@ Once all requests return, call FINALLY with no arguments."
;; existent/nonexistent entry, or at the limit.
(setf finishedp t)
(cl-return))
- (h/api 'head (he/url prev-entry)
+ (he/api 'head prev-entry
:queue nonexistent-queue
:as 'response
:then (pcase-lambda ((cl-struct plz-response (headers (map
etag))))
@@ -933,7 +946,7 @@ Once all requests return, call FINALLY with no arguments."
(let ((copy-entry (h/copy-tree entry t)))
(setf (he/version copy-entry) version)
(cl-decf total-requests-limit)
- (h/api 'head (he/url copy-entry)
+ (he/api 'head copy-entry
:queue fill-entry-queue
:as 'response
:then (pcase-lambda ((cl-struct plz-response (headers (map
etag))))
@@ -972,7 +985,7 @@ HYPERDRIVE's public metadata file."
;; TODO: Refactor to use :as 'response-with-buffer and
call h/fill
(pcase-let
(((cl-struct plz-response headers body)
- (h/api 'get (he/url entry) :as 'response :noquery
t)))
+ (he/api 'get entry :as 'response :noquery t)))
(h//fill entry headers)
(with-temp-buffer
(insert body)
@@ -999,7 +1012,7 @@ HYPERDRIVE's public metadata file."
Call ELSE if request fails."
(declare (indent defun))
- (h/api 'delete (he/url (he/create :hyperdrive hyperdrive))
+ (he/api 'delete (he/create :hyperdrive hyperdrive)
:as 'response
:then (lambda (response)
(h/persist hyperdrive :purge t)
@@ -1364,7 +1377,7 @@ If then, then call THEN with no arguments. Default
handler."
(((cl-struct plz-response headers body)
;; TODO: Handle errors
;; TODO: When plz adds :as 'response-with-buffer, use that.
- (h/api 'get (he/url entry) :noquery t :as 'response))
+ (he/api 'get entry :noquery t :as 'response))
;; Filling entry is necessary in order to update hyperdrive disk-usage.
(_ (h//fill entry headers))
((cl-struct hyperdrive-entry hyperdrive version etc) entry)
diff --git a/hyperdrive.el b/hyperdrive.el
index 54edf5c31d..f12ce5c820 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -196,18 +196,17 @@ modified; file blobs may be recoverable from other peers."
(format-message
"Clear local copy of entry (data may not be recoverable—see
manual):`%s'? "
(h//format-entry entry)))
- (let ((url (he/url entry)))
- (h/api 'post url
- :headers '(("Cache-Control" . "no-store"))
- :as 'response
- :else (lambda (err)
- (h/error "Unable to clear cache for `%s': %S" url err))
- :then (lambda (response)
- (h//fill entry (plz-response-headers response))
- (h/message "Cleared `%s'" (h//format-entry entry))
- ;; TODO: When file sizes in hyperdrive-dir-mode are colorized
- ;; based locally downloaded sizes, refresh ewoc entry here.
- )))))
+ (he/api 'post entry
+ :headers '(("Cache-Control" . "no-store"))
+ :as 'response
+ :else (lambda (err)
+ (h/error "Unable to clear cache for `%s': %S" (he/url entry)
err))
+ :then (lambda (response)
+ (h//fill entry (plz-response-headers response))
+ (h/message "Cleared `%s'" (h//format-entry entry))
+ ;; TODO: When file sizes in hyperdrive-dir-mode are colorized
+ ;; based locally downloaded sizes, refresh ewoc entry here.
+ ))))
;;;###autoload
(defun hyperdrive-purge (hyperdrive)
@@ -429,7 +428,7 @@ directory. Otherwise, or with universal prefix argument
(h/message "Deleted: `%s' (Deleted files can be accessed
from prior versions of the hyperdrive.)" description))
:else (lambda (plz-error)
(h/message "Unable to delete `%s': %S" description
plz-error))))))
- (h/api 'delete (he/url entry)
+ (he/api 'delete entry
:as 'response
:then (lambda (response)
(pcase-let* (((cl-struct plz-response headers) response)
@@ -462,6 +461,7 @@ in a directory. Otherwise, or with universal prefix
argument
;;;###autoload
(defun hyperdrive-download-url (url filename)
"Load contents at URL as a file to store on disk at FILENAME."
+ ;; TODO: Implement entry-based version of this function, or change callers
to use entries.
;; TODO: Handle directory URLs (recursively download contents?)
(interactive
(let* ((read-url (h/read-url :prompt "Download hyperdrive URL"))
@@ -714,19 +714,18 @@ After successful upload, call THEN. When QUEUE, use it."
(h/read-entry :predicate #'h/writablep
:default-path (file-name-nondirectory
filename)
:latest-version t))))
- (let ((url (he/url entry))
- (last-modified (let ((system-time-locale "C"))
+ (let ((last-modified (let ((system-time-locale "C"))
(format-time-string "%Y-%m-%dT%T.%3NZ"
;; "%a, %-d %b %Y %T %Z"
(file-attribute-modification-time
(file-attributes filename)) t))))
- (h/api 'put url :queue queue
+ (he/api 'put entry :queue queue
:body `(file ,filename)
:headers `(("Last-Modified" . ,last-modified))
:then then)
;; TODO: Hyperdrive disk usage should be set here.
(unless queue
- (h/message "Uploading to \"%s\"..." url))))
+ (h/message "Uploading to \"%s\"..." (he/url entry)))))
(defun h/read-files ()
"Return list of files read from the user."
@@ -820,6 +819,7 @@ The return value of this function is the retrieval buffer."
((cl-struct plz-response headers body)
(h/api 'get url :as 'response)))
;; Filling entry is necessary in order to update hyperdrive disk-usage.
+ ;; TODO: Use he/api and update disk usage automatically.
(h//fill (h/url-entry url) headers)
(with-current-buffer (generate-new-buffer " *hyperdrive-eww*")
(widen)
