branch: elpa/hyperdrive
commit 79541d4aab9f165c861ea32f3f2890be0d7cb31f
Merge: 2ad91d4c68 f044f39bf8
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Merge: (he/api) Consolidate hyperdrive filling logic into callback
---
hyperdrive-describe.el | 2 +-
hyperdrive-diff.el | 14 +--
hyperdrive-dir.el | 10 +--
hyperdrive-history.el | 4 +-
hyperdrive-lib.el | 238 +++++++++++++++++++++----------------------------
hyperdrive-mirror.el | 2 +-
hyperdrive-vars.el | 2 +-
hyperdrive.el | 85 ++++++++----------
8 files changed, 154 insertions(+), 203 deletions(-)
diff --git a/hyperdrive-describe.el b/hyperdrive-describe.el
index 8eb6c6e428..c7cf1baeb9 100644
--- a/hyperdrive-describe.el
+++ b/hyperdrive-describe.el
@@ -48,7 +48,7 @@ Universal prefix argument \\[universal-argument] forces
`hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
(interactive (list (h/complete-hyperdrive :force-prompt current-prefix-arg)))
;; TODO: Do we want to asynchronously fill the hyperdrive's latest version?
- (h/fill-latest-version hyperdrive)
+ (h/fill hyperdrive)
(with-current-buffer
(get-buffer-create (h//format hyperdrive "*Hyperdrive: %k"))
(with-silent-modifications
diff --git a/hyperdrive-diff.el b/hyperdrive-diff.el
index 9885d00aa5..3f633da749 100644
--- a/hyperdrive-diff.el
+++ b/hyperdrive-diff.el
@@ -103,16 +103,10 @@ 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)
- :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)
- :queue queue :as 'response :else #'ignore
- :then (lambda (response)
- (h//fill new-entry (plz-response-headers response))
- (setf new-response response)))))
+ (he/api 'get old-entry :queue queue :else #'ignore
+ :then (lambda (response) (setf old-response response)))
+ (he/api 'get new-entry :queue queue :else #'ignore
+ :then (lambda (response) (setf new-response response)))))
;;;; Mode
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index b379422f6b..2dd6b622d8 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 :noquery t
;; Get "full" listing with metadata
:headers `(("Accept" . "application/json; metadata=full"))
:then (lambda (response)
@@ -73,7 +72,7 @@ If THEN, call it in the directory buffer with no arguments."
(json-read-from-string body)
hyperdrive version))
(parent-entry (h/parent directory-entry)))
- (setf directory-entry (h//fill directory-entry headers))
+ (setf directory-entry (he//fill directory-entry headers))
(when parent-entry
(setf (alist-get 'display-name (he/etc parent-entry))
"../")
(push parent-entry entries))
@@ -205,6 +204,7 @@ With point on header, returns directory entry."
;; `h/menu' is defined with `transient-define-prefix', which
;; `check-declare' doesn't recognize.
(declare-function h/menu "hyperdrive-menu" nil t)
+(declare-function h/forget-file "hyperdrive")
(defvar-keymap h/dir-mode-map
:parent h/ewoc-mode-map
@@ -350,10 +350,8 @@ see Info node `(elisp)Yanking Media'."
hyperdrive)
:predicate #'h/writablep
:default-path path :latest-version t)))
- (h/api 'put (he/url entry)
- :body-type 'binary
+ (he/api 'put entry :body image :body-type 'binary
;; TODO: Pass MIME type in a header? hyper-gateway detects it for us.
- :body image :as 'response
:then (lambda (_res) (h/open entry))
:else (lambda (plz-error)
(h/message "Unable to yank media: %S" plz-error)))))
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index 928011a246..744ea88e86 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -202,7 +202,7 @@ prefix argument \\[universal-argument], prompt for ENTRY."
(with-silent-modifications
(h/history-mode)
(setq-local h/history-current-entry entry)
- (setf ewoc h/ewoc) ; Bind this for the h/fill lambda.
+ (setf ewoc h/ewoc) ; Bind this for the he/fill lambda.
(ewoc-filter h/ewoc #'ignore)
(erase-buffer)
(ewoc-set-hf h/ewoc header "")
@@ -234,7 +234,7 @@ prefix argument \\[universal-argument], prompt for ENTRY."
(mapc (lambda (range-entry)
(when (eq t (h/range-entry-exists-p range-entry))
;; TODO: Handle failures?
- (h/fill (cdr range-entry) :queue queue :then #'ignore)))
+ (he/fill (cdr range-entry) :queue queue :then #'ignore)))
range-entries)
(set-buffer-modified-p nil)
(goto-char (point-min)))))
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 21e24b382a..907991b3d0 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -71,6 +71,7 @@ Passes ARGS to `format-message'."
(size nil :documentation "Size of file.")
(version nil :documentation "Hyperdrive version specified in entry's URL.")
(type nil :documentation "MIME type of the entry.")
+ ;; TODO: Consider adding gv-setters for etc slot keys
(etc nil :documentation "Alist for extra data about the entry.
- display-name :: Displayed in directory view instead of name.
- target :: Link fragment to jump to."))
@@ -86,6 +87,7 @@ Passes ARGS to `format-message'."
(domains nil :documentation "List of DNSLink domains which resolve to the
drive's public-key.")
(metadata nil :documentation "Public metadata alist.")
(latest-version nil :documentation "Latest known version of hyperdrive.")
+ ;; TODO: Consider adding gv-setters for etc slot keys
(etc nil :documentation "Alist of extra data.
- disk-usage :: Number of bytes occupied locally by the drive.
- safep :: Whether or not to treat this hyperdrive as safe."))
@@ -151,8 +153,6 @@ See `hyperdrive-directory-sort' for the type of DIRECTION."
;;;; API
-;; These functions take a URL argument, not a hyperdrive-entry struct.
-
(cl-defun h/api (method url &rest rest)
"Make hyperdrive API request by METHOD to URL.
Calls `hyperdrive--httpify-url' to convert HYPER-URL starting
@@ -163,16 +163,12 @@ with `hyperdrive--hyper-prefix' to a URL starting with
REST is passed to `plz', which see.
REST may include the argument `:queue', a `plz-queue' in which to
-make the request."
+make the request.
+
+This low-level function should only be used when sending requests
+to the gateway which do not involve an entry. Otherwise, use
+`hyperdrive-entry-api', which automatically fills metadata."
;; TODO: Document that the request/queue is returned.
- ;; TODO: Should we create a wrapper for `h/api' which calls
- ;; `h//fill-latest-version' for requests to directories/requests which modify
- ;; the drive (and therefore always return the latest version number). If we
- ;; did this, we could remove redundant calls to `h//fill-latest-version'
- ;; everywhere else. X-Drive-Size is returned by many types of requests, and
it
- ;; would simplify the code to handle updating the hyperdrive disk-usage in
one
- ;; place. Once implemented, go through each call to `h/api' to verify that
- ;; disk-usage is updated correctly.
(declare (indent defun))
(pcase method
((and (or 'get 'head)
@@ -204,6 +200,68 @@ 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 `hyperdrive-api', which see. AS keyword should
+be nil, because it is always set to `response'. Automatically
+calls `hyperdrive-entry--api-then' to update metadata from the
+response."
+ (declare (indent defun))
+ ;; Always use :as 'response
+ (cl-assert (null (plist-get rest :as)))
+ (setf (plist-get rest :as) 'response)
+ (pcase-let* (((map :then) rest))
+ (when then
+ (setf (plist-get rest :then)
+ (lambda (response)
+ (he//api-then entry response)
+ (funcall then response))))
+ (let ((response (apply #'h/api method (he/url entry) rest)))
+ (unless then (funcall 'he//api-then entry response))
+ response)))
+
+(defun he//api-then (entry response)
+ "Update ENTRY's metadata according to RESPONSE.
+Sets ENTRY's hyperdrive to the persisted version of the drive if
+it exists. Updates ENTRY's hyperdrive's disk usage and latest
+version. Finally, persists ENTRY's hyperdrive."
+ (pcase-let*
+ (((cl-struct plz-response
+ (headers (map link allow x-drive-size x-drive-version)))
+ response)
+ ;; RESPONSE is guaranteed to have a "Link" header with the public key,
+ ;; while ENTRY may have a DNSLink domain but no public key yet.
+ (public-key (progn (string-match h//public-key-re link)
+ (match-string 1 link)))
+ ;; NOTE: Don't destructure `persisted-hyperdrive' with `pcase' here
since it may be nil.
+ (persisted-hyperdrive (gethash public-key h/hyperdrives)))
+
+ (when persisted-hyperdrive
+ ;; ENTRY's hyperdrive already persisted: merge domains into persisted
+ ;; hyperdrive and set ENTRY's hyperdrive slot to the persisted copy.
+ (setf (h/domains persisted-hyperdrive)
+ (delete-dups (append (h/domains persisted-hyperdrive)
+ (h/domains (he/hyperdrive entry)))))
+ (setf (he/hyperdrive entry) persisted-hyperdrive))
+
+ ;; Ensure that ENTRY's hyperdrive has a public key.
+ (setf (h/public-key (he/hyperdrive entry)) public-key)
+
+ ;; Fill hyperdrive.
+ (when allow
+ ;; NOTE: "Allow" header is only present on HEAD requests. We can change
+ ;; this, but it's fine as-is since we only need to check writability
once.
+ (setf (h/writablep (he/hyperdrive entry)) (string-match-p "PUT" allow)))
+ (when x-drive-size
+ (setf (map-elt (h/etc (he/hyperdrive entry)) 'disk-usage)
+ (cl-parse-integer x-drive-size)))
+ (when x-drive-version
+ (setf (h/latest-version (he/hyperdrive entry))
+ (string-to-number x-drive-version)))
+ ;; TODO: Update buffers like h/describe-hyperdrive after updating drive.
+ ;; TODO: Consider debouncing or something for hyperdrive-persist to
minimize I/O.
+ (h/persist (he/hyperdrive entry))))
+
(defun h/gateway-needs-upgrade-p ()
"Return non-nil if the gateway is responsive and needs upgraded."
(and (h//gateway-ready-p)
@@ -254,16 +312,6 @@ PLZ-ERR should be a `plz-error' struct."
h/gateway-port
(substring url (length h//hyper-prefix))))
-(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."
- (declare (indent defun))
- (h/api 'put url
- ;; 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))
-
(defun h/parent (entry)
"Return parent entry for ENTRY.
If already at top-level directory, return nil."
@@ -468,7 +516,7 @@ When VERSION is nil, return latest version of ENTRY."
(setf (he/version entry) version)
(condition-case err
;; FIXME: Requests to out of range version currently hang.
- (h/fill entry)
+ (he/fill entry)
(plz-error
(pcase (plz-response-status (plz-error-response (caddr err)))
;; FIXME: If plz-error is a curl-error, this block will fail.
@@ -489,7 +537,7 @@ Sends a request to the gateway for hyperdrive's latest
version."
;; ENTRY's version is not nil.
(let ((next-entry (h/copy-tree entry t))
- (latest-version (h/fill-latest-version (he/hyperdrive entry))))
+ (latest-version (h/fill (he/hyperdrive entry))))
;; ENTRY version is the latest version: return ENTRY with nil version.
(when (eq latest-version (he/version entry))
@@ -554,16 +602,11 @@ echo area when the request for the file is made."
;; FIXME: Some of the synchronous filling functions we've added now cause
this to be blocking,
;; which is very noticeable when a file can't be loaded from the gateway and
eventually times out.
(let ((hyperdrive (he/hyperdrive entry)))
- (h/fill entry
+ (he/fill entry
:then (lambda (entry)
(pcase-let* (((cl-struct hyperdrive-entry type) entry)
(handler (alist-get type h/type-handlers
nil nil #'string-match-p)))
- (unless (h//entry-directory-p entry)
- ;; No need to fill latest version for directories,
- ;; since we do it in `h//fill' already.
- (h/fill-latest-version hyperdrive))
- (h/persist hyperdrive)
(funcall (or handler #'h/handler-default) entry :then then)))
:else (lambda (err)
(cl-labels ((not-found-action ()
@@ -622,7 +665,7 @@ echo area when the request for the file is made."
(when messagep
(h/message "Opening <%s>..." (he/url entry)))))
-(cl-defun h/fill (entry &key queue (then 'sync) else)
+(cl-defun he/fill (entry &key queue (then 'sync) else)
"Fill ENTRY's metadata and call THEN.
If THEN is `sync', return the filled entry and ignore ELSE.
Otherwise, make request asynchronously and call THEN with the
@@ -642,15 +685,11 @@ the given `plz-queue'"
;; (e.g. if the user reverted too quickly).
nil)
(_
- (h/message "hyperdrive-fill: error: %S" plz-error))))))
+ (h/message "hyperdrive-entry-fill: error: %S"
plz-error))))))
(pcase then
('sync (condition-case err
- (h//fill entry
- (plz-response-headers
- (h/api 'head (he/url entry)
- :as 'response
- :then 'sync
- :noquery t)))
+ (he//fill entry (plz-response-headers
+ (he/api 'head entry :then 'sync :noquery t)))
(plz-error
(pcase (plz-response-status (plz-error-response (caddr err)))
;; FIXME: If plz-error is a curl-error, this block will fail.
@@ -658,11 +697,10 @@ 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)
- (funcall then (h//fill entry (plz-response-headers
response))))
+ (funcall then (he//fill entry (plz-response-headers
response))))
:else (lambda (&rest args)
(when (he/version entry)
;; If request is canceled, the entry may not have a version.
@@ -671,72 +709,28 @@ the given `plz-queue'"
(apply else args))
:noquery t))))
-(defun h//fill (entry headers)
- "Fill ENTRY and its hyperdrive from HEADERS.
+(defun he//fill (entry headers)
+ "Fill ENTRY slots from HEADERS.
-The following ENTRY slots are filled:
- \\+`type'
- \\+`mtime'
- \\+`size'
-- \\+`hyperdrive' (from persisted value if it exists)
-The following ENTRY hyperdrive slots are filled:
-- \\+`public-key'
-- \\+`writablep' (when headers include Allow)
-- \\+`domains' (merged with current persisted value)
-- \\+`etc' (disk-usage)
+Also fills existent range in `hyperdrive-version-ranges'.
Returns filled ENTRY."
(pcase-let*
- (((cl-struct hyperdrive-entry hyperdrive) entry)
- ((cl-struct hyperdrive writablep domains etc) hyperdrive)
- ((map link content-length content-type etag
- last-modified allow x-drive-size)
- headers)
- ;; If URL hostname was a DNSLink domain,
- ;; entry doesn't yet have a public-key slot.
- (public-key (progn (string-match h//public-key-re link)
- (match-string 1 link)))
- (persisted-hyperdrive (gethash public-key h/hyperdrives))
- (domain (car domains)))
+ (((map content-length content-type etag last-modified) headers))
(when last-modified
(setf last-modified (encode-time (parse-time-string last-modified))))
- (when (and allow (eq 'unknown writablep))
- (setf (h/writablep hyperdrive) (string-match-p "PUT" allow)))
(setf (he/size entry) (and content-length
(ignore-errors
(cl-parse-integer content-length))))
(setf (he/type entry) content-type)
(setf (he/mtime entry) last-modified)
- (when x-drive-size
- (setf (map-elt etc 'disk-usage) (cl-parse-integer x-drive-size)))
- (setf (h/etc hyperdrive) etc)
- (if persisted-hyperdrive
- (progn
- ;; Ensure that entry's hyperdrive is the persisted
- ;; hyperdrive, since it may be used later as part of a
- ;; `h/version-ranges' key and compared using `eq'.
- ;; Also, we want the call to `h//fill-latest-version'
- ;; below to update the persisted hyperdrive.
- (setf (he/hyperdrive entry) persisted-hyperdrive)
- (when domain
- ;; The previous call to he/url may not have retrieved
- ;; the persisted hyperdrive if we had only a domain
- ;; but no public-key.
- (cl-pushnew domain (h/domains (he/hyperdrive entry)) :test
#'equal)))
- (setf (h/public-key hyperdrive) public-key))
- (when etag
- (if (and (h//entry-directory-p entry)
- (null (he/version entry)))
- ;; Version-less directory HEAD/GET request ETag header always have
the
- ;; hyperdrive's latest version. We don't currently store
- ;; version ranges for directories (since they don't
- ;; technically have versions in hyperdrive).
- (h//fill-latest-version hyperdrive headers)
- ;; File HEAD/GET request ETag header does not retrieve the
- ;; hyperdrive's latest version, so `h/update-existent-version-range'
- ;; will not necessarily fill in the entry's last range.
- (h/update-existent-version-range entry (string-to-number etag))))
+ (when (and etag (not (h//entry-directory-p entry)))
+ ;; Directory version ranges are not supported.
+ (h/update-existent-version-range entry (string-to-number etag)))
entry))
(defun h//fill-listing-entries (listing hyperdrive version)
@@ -761,30 +755,9 @@ entry as a side-effect."
entry))
listing))
-(defun h/fill-latest-version (hyperdrive)
- "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 "/"))
- :as 'response)))
- (h//fill-latest-version hyperdrive headers)))
-
-(defun h//fill-latest-version (hyperdrive headers)
- "Fill the latest version slot in HYPERDRIVE from HEADERS.
-HEADERS must from a HEAD/GET request to a directory or a
-PUT/DELETE request to a file or directory, as only those requests
-return the correct ETag header. Returns latest version number."
- ;; TODO: Update relevant buffers when hyperdrive latest version
- ;; updates, at the least describe-hyperdrive buffers.
- ;; TODO: Consider updating version range here. First check all the
- ;; places where this function is called. Better yet, update
- ;; `h/version-ranges' (and `h/hyperdrives'?) in a
- ;; lower-level function, perhaps a wrapper for `h/api'?
- (setf (h/latest-version hyperdrive)
- (string-to-number (map-elt headers 'etag))))
+(defun h/fill (hyperdrive)
+ "Synchronously fill the latest version slot in HYPERDRIVE."
+ (he/api 'head (he/create :hyperdrive hyperdrive :path "/")))
;; TODO: Consider using symbol-macrolet to simplify place access.
@@ -909,9 +882,8 @@ 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))))
(pcase-let* ((range-start (string-to-number etag))
((map :existsp) (map-elt
copy-entry-version-ranges range-start)))
@@ -933,9 +905,8 @@ 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))))
(pcase-let* ((range-start (string-to-number etag))
((map :existsp)
@@ -969,11 +940,10 @@ HYPERDRIVE's public metadata file."
;; NOTE: Don't attempt to fill hyperdrive struct with old
metadata
:version nil))
(metadata (condition-case err
- ;; TODO: Refactor to use :as 'response-with-buffer and
call h/fill
+ ;; TODO: Refactor to use :as 'response-with-buffer and
call he/fill
(pcase-let
- (((cl-struct plz-response headers body)
- (h/api 'get (he/url entry) :as 'response :noquery
t)))
- (h//fill entry headers)
+ (((cl-struct plz-response body)
+ (he/api 'get entry :noquery t)))
(with-temp-buffer
(insert body)
(goto-char (point-min))
@@ -999,8 +969,7 @@ HYPERDRIVE's public metadata file."
Call ELSE if request fails."
(declare (indent defun))
- (h/api 'delete (he/url (he/create :hyperdrive hyperdrive))
- :as 'response
+ (he/api 'delete (he/create :hyperdrive hyperdrive)
:then (lambda (response)
(h/persist hyperdrive :purge t)
(h/purge-version-ranges hyperdrive)
@@ -1008,9 +977,14 @@ Call ELSE if request fails."
:else else))
(cl-defun h/write (entry &key body then else queue)
- "Write BODY to hyperdrive ENTRY's URL."
+ "Write BODY to hyperdrive ENTRY's URL.
+THEN and ELSE are passed to `hyperdrive-entry-api', which see."
(declare (indent defun))
- (h//write (he/url entry)
+ (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 :then then :else else :queue queue))
(cl-defun h//format-entry-url
@@ -1329,9 +1303,7 @@ hyperdrive."
(h/api 'get (format "hyper://localhost/?key=%s"
(url-hexify-string seed))
:as 'response :noquery t)))
- ;; TODO: Update hyperdrive disk-usage. The following doesn't work
- ;; because the response doesn't have the proper ETag header:
- ;; (h//fill (h/url-entry url) headers)
+ (h/fill (h/url-entry url))
url)
(plz-error (if (= 400 (plz-response-status (plz-error-response (caddr
err))))
;; FIXME: If plz-error is a curl-error, this block will
fail.
@@ -1361,12 +1333,10 @@ Otherwise, return nil. SLOT may be one of
"Load ENTRY's file into an Emacs buffer.
If then, then call THEN with no arguments. Default handler."
(pcase-let*
- (((cl-struct plz-response headers body)
+ (((cl-struct plz-response body)
;; TODO: Handle errors
;; TODO: When plz adds :as 'response-with-buffer, use that.
- (h/api 'get (he/url entry) :noquery t :as 'response))
- ;; Filling entry is necessary in order to update hyperdrive disk-usage.
- (_ (h//fill entry headers))
+ (he/api 'get entry :noquery t))
((cl-struct hyperdrive-entry hyperdrive version etc) entry)
((map target) etc))
(with-current-buffer (h//get-buffer-create entry)
diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 324db6b5a0..1dbd3ae93c 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -157,7 +157,7 @@ been checked."
(let ((entry (he/create
:hyperdrive hyperdrive
:path (expand-file-name (file-relative-name file source)
target-dir))))
- (h/fill entry :queue metadata-queue
+ (he/fill entry :queue metadata-queue
:then (lambda (entry)
(let* ((drive-mtime (floor (float-time (he/mtime entry))))
(local-mtime (floor (float-time
(file-attribute-modification-time (file-attributes file)))))
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 2c9c26ebef..05ff6ce914 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -380,7 +380,7 @@ values are alists mapping version range starts to plists
with
;;;;; Internals
(defvar h/gateway-version-expected
- '(:name "hyper-gateway-ushin" :version "3.9.2"))
+ '(:name "hyper-gateway-ushin" :version "3.10.1"))
(defvar h/gateway-version-checked-p nil
"Non-nil if the gateway's version has been checked.
diff --git a/hyperdrive.el b/hyperdrive.el
index 19bae3470e..ef0c40192a 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -138,7 +138,7 @@ hyperdrive, the new hyperdrive's petname will be set to
SEED."
(pcase-let* (((cl-struct plz-response (body url))
(h/api 'post (concat "hyper://localhost/?key="
(url-hexify-string seed))
- :as 'response))
+ :as 'response))
(hyperdrive (he/hyperdrive (h/url-entry url))))
(setf (h/seed hyperdrive) seed)
(setf (h/writablep hyperdrive) t)
@@ -194,20 +194,17 @@ modified; file blobs may be recoverable from other peers."
(interactive (list (h//context-entry)))
(when (yes-or-no-p
(format-message
- "Clear local copy of entry (data may not be recoverable—see
manual):`%s'? "
+ "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"))
+ :else (lambda (err)
+ (h/error "Unable to clear cache for `%s': %S" (he/url entry)
err))
+ :then (lambda (_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)
@@ -279,16 +276,10 @@ Universal prefix argument \\[universal-argument] forces
(progn
(cl-callf map-delete (h/metadata hyperdrive) 'name)
(h/put-metadata hyperdrive
- :then (pcase-lambda ((cl-struct plz-response headers))
- (h//fill-latest-version hyperdrive headers)
- (h/persist hyperdrive)
- (funcall then hyperdrive))))
+ :then (lambda (_response) (funcall then hyperdrive))))
(setf (alist-get 'name (h/metadata hyperdrive)) nickname)
(h/put-metadata hyperdrive
- :then (pcase-lambda ((cl-struct plz-response headers))
- (h//fill-latest-version hyperdrive headers)
- (h/persist hyperdrive)
- (funcall then hyperdrive))))
+ :then (lambda (_response) (funcall then hyperdrive))))
;; TODO: Consider refreshing buffer names, directory headers, etc,
especially host-meta.json entry buffer.
)
hyperdrive)
@@ -429,14 +420,12 @@ 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)
- :as 'response
+ (he/api 'delete entry
:then (lambda (response)
(pcase-let* (((cl-struct plz-response headers) response)
((map etag) headers)
(nonexistent-entry (h/copy-tree entry t)))
(setf (he/version nonexistent-entry) (string-to-number etag))
- (h//fill-latest-version (he/hyperdrive entry) headers)
(h/update-nonexistent-version-range nonexistent-entry)
;; Since there's no way for `h//write-contents' to run when
;; `buffer-modified-p' returns nil, this is a workaround to
ensure that
@@ -462,6 +451,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"))
@@ -475,9 +465,9 @@ in a directory. Otherwise, or with universal prefix
argument
(delete-file filename))
(h/api 'get url :as `(file ,filename))
;; TODO: If plz adds support for getting response headers when downloading
- ;; as a file, use it here.
+ ;; as a file (<https://github.com/alphapapa/plz.el/issues/61>), use it
here.
;; Filling entry is necessary in order to update hyperdrive disk-usage.
- (h/fill (h/url-entry url))))
+ (he/fill (h/url-entry url))))
;;;###autoload
(defun hyperdrive-write-buffer (entry &optional overwritep)
@@ -520,11 +510,7 @@ use, see `hyperdrive-write'."
(let ((buffer-file-name (he/name entry)))
(set-auto-mode)))
(h/mode))
- ;; NOTE: `h/fill-latest-version' must come before
- ;; `h//fill' because the latter calls
- ;; `h/update-existent-version-range' internally.
- (h/fill-latest-version hyperdrive)
- (h//fill entry (plz-response-headers response))
+ (he//fill entry (plz-response-headers response))
;; PUT responses only include ETag and Last-Modified
;; headers, so we need to set other entry metadata manually.
;; FIXME: For large buffers, `buffer-size' returns a
different
@@ -714,19 +700,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."
@@ -818,12 +803,16 @@ The return value of this function is the retrieval
buffer."
;; TODO: When `plz.el' adds :as 'response-with-buffer, use that.
;; response-buffer will contain the loaded HTML, and will be
deleted at the end of `eww-render'.
((cl-struct plz-response headers body)
- (h/api 'get url :as 'response)))
- ;; Filling entry is necessary in order to update hyperdrive disk-usage.
- (h//fill (h/url-entry url) headers)
+ (he/api 'get (h/url-entry url))))
(with-current-buffer (generate-new-buffer " *hyperdrive-eww*")
(widen)
(goto-char (point-min))
+ ;; TODO: When `plz' gains `:as '(response :with buffer)' or whatever,
use it instead of this hack.
+ ;; HACK: Insert headers because `eww-render' expects them to be in the
buffer.
+ (map-do (lambda (header value)
+ (insert (format "%s: %s\n" header value)))
+ headers)
+ (insert "\n\n")
(insert body)
(while (search-forward (string ?\C-m) nil t)
;; Strip CRLF from headers so that `eww-parse-headers' works correctly.
@@ -1400,21 +1389,21 @@ Intended for relative (i.e. non-full) URLs."
;; TODO: sr.ht build (<https://builds.sr.ht/~ushin/job/1247130#task-setup>)
;; fail due to a kernel issue: https://github.com/nodejs/node/issues/53051
'((gnu/linux
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.9.2/hyper-gateway-ushin-linux";
- :sha256
"f0cb3e793b3d27ce159e8e034e03b5a14cbdc53d47bd8f0761310792d5b6a7aa")
- ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.9.2/hyper-gateway-linux-v3.9.2";
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.1/hyper-gateway-ushin-linux";
+ :sha256
"6a93dd6f5b023cc2cc2e99aba728cbcccd4c9ed426b506da0a4b24d8c0ea5afa")
+ ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.1/hyper-gateway-linux-v3.10.1";
;; :sha256
"331dbc0048decd42d197667f96aabdaf25306ba4e7ba0451dd9a2f31868fa86c")
)
(darwin
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.9.2/hyper-gateway-ushin-macos";
- :sha256
"bb472bf7a536eb30bc2443ce90cfca1bf2aa71177afdc1377f4fc9b61414c24c")
- ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.9.2/hyper-gateway-macos-v3.9.2";
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.1/hyper-gateway-ushin-macos";
+ :sha256
"7072e7fd52626affe5a17380845b50ec5116210d70f409c23bcb5415142a4053")
+ ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.1/hyper-gateway-macos-v3.10.1";
;; :sha256
"e78d3c1394774fc49212d86827eb615d46ae1a04c82fc0328ac31bbbdb201aa0")
)
(windows-nt
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.9.2/hyper-gateway-ushin-windows.exe";
- :sha256
"7a72010cd7bc1b0357673838f5ccb069e58bf3c229bc873bedd0ee9faa805188")
- ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.9.2/hyper-gateway-windows-v3.9.2.exe";
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.1/hyper-gateway-ushin-windows.exe";
+ :sha256
"b87aa17bc92c6f5a1c388f5e352a47b228d33c5f177ab6a11aad0312e891df0d")
+ ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.1/hyper-gateway-windows-v3.10.1.exe";
;; :sha256
"d4fa29aca473148e2d13215d042e4be40657080035caa2d3a699b741b6a45845")
))
"Alist mapping `system-type' to URLs where the gateway can be downloaded.")
