[nongnu] elpa/hyperdrive 849de77a47 04/42: Add: (he/api) New function, and use it

[ELPA Syncer]

branch: elpa/hyperdrive
commit 849de77a47ce2ab74c68b75e201dcdbd465dd891
Author: Adam Porter <adam@alphapapa.net>
Commit: Joseph Turner <joseph@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)