With-files-write macro #6

Merged
BnMcGn merged 3 commits from master into master 2021-06-26 21:50:21 -05:00
2 changed files with 56 additions and 30 deletions

View File

@ -30,27 +30,33 @@
If the JSON is 'error JSON', I.E., it signals that an error has been If the JSON is 'error JSON', I.E., it signals that an error has been
recieved, two values are returned: NIL and the string-error-message." recieved, two values are returned: NIL and the string-error-message."
(let ((result (let ((result
(drakma:http-request (multiple-value-list
(make-call-url *api-host* *api-root* call arguments) (drakma:http-request
(make-call-url call arguments)
:method method :method method
:url-encoder #'ipfs::url-encode :url-encoder #'ipfs::url-encode
:parameters parameters :parameters parameters
:want-stream want-stream))) :want-stream want-stream))))
(if want-stream
(car result)
(apply #'process-result result))))
(cond (want-stream result) (defun process-result (body status-code headers uri http-stream must-close status-text)
((stringp result) (values nil result)) (declare (ignore uri http-stream must-close status-text))
((vectorp result) (let* ((result (cond ((stringp body) body)
(let* ((string (flexi-streams:octets-to-string result)) ((vectorp body) (flexi-streams:octets-to-string body))))
(alist (result (if (search "application/json" (cdr (assoc :content-type headers)))
(with-input-from-string (stream string) (unless (empty-string-p result)
(loop while (peek-char t stream nil) (simplify (yason:parse result :object-as :alist)))
collect (yason:parse stream :object-as :alist))))) result)))
(if (ignore-errors (equal (cdr (s-assoc "Type" (simplify alist))) "error")) (if (eql 200 status-code)
(values NIL (cdr (s-assoc "Message" (simplify alist)))) result
(simplify alist))))))) (values nil (if (stringp result)
result
(ignore-errors (cdr (s-assoc "Message" result))))))))
;; STRING STRING LIST → STRING ;; STRING LIST &key STRING STRING → STRING
(defun make-call-url (host root call arguments) (defun make-call-url (call arguments &key (host *api-host*) (root *api-root*))
"Create the URL of an API call, as per the given arguments. "Create the URL of an API call, as per the given arguments.
Symbols are assumed to be something like 'T (so boolean), nil likewise. Symbols are assumed to be something like 'T (so boolean), nil likewise.
Arguments should look like this: Arguments should look like this:
@ -497,22 +503,40 @@
;; PATHNAME STRING [:NUMBER :BOOLEAN :BOOLEAN :BOOLEAN :NUMBER :BOOLEAN ;; PATHNAME STRING [:NUMBER :BOOLEAN :BOOLEAN :BOOLEAN :NUMBER :BOOLEAN
;; :NUMBER :STRING] ;; :NUMBER :STRING]
;; → NIL || (NIL STRING) ;; → NIL || (NIL STRING)
(defun files-write (pathname dest-path (defun files-write (path-or-string dest-path
&key (offset nil) (create nil) (parents nil) &key (offset nil) (create nil) (parents nil)
(truncate nil) (count nil) (raw-leaves nil) (truncate nil) (count nil) (raw-leaves nil)
(cid-version nil) (hash nil)) (cid-version nil) (hash nil))
"Write to a given file. "Write to a given file. First parameter can be a string or a path to
a local file.
/ipns/docs.ipfs.io/reference/api/http/#api-v0-files-rm" /ipns/docs.ipfs.io/reference/api/http/#api-v0-files-rm"
(ipfs-call "files/write" (let ((result
`(("arg" ,dest-path) ("create" ,create) ("parents" ,parents) (multiple-value-list
("truncate" ,truncate) ("raw-leaves" ,raw-leaves) (drakma:http-request
,(if offset (list "offset" offset)) (make-call-url
,(if count (list "count" count)) "files/write"
,(if cid-version `("cid-version" ,cid-version)) `(("arg" ,dest-path) ("create", create) ("parents" ,parents)
,(if hash (list "hash" hash))) ("truncate" ,truncate) ("raw-leaves" ,raw-leaves)
:parameters `(("file" . ,pathname)))) ,@(when offset (list "offset" offset))
,@(when count (list "count" count))
,@(when cid-version `("cid-version" ,cid-version))
,@(when hash (list "hash" hash))))
:method :post
:parameters `(("data" . ,path-or-string))
:form-data t))))
(apply #'process-result result)))
(defmacro with-files-write ((stream dest-path &rest params) &body body)
"A convenience macro for files-write. In the body of the macro, any writes
to the stream named by STREAM will be sent to the mfs file at DEST-PATH. PARAMS
will be passed directly to the files-write function."
(let ((fn (gensym "FN")))
;;FIXME: Would be nice to write the stream directly to files-write.
;; This feels a little less efficient.
`(uiop:with-temporary-file (:stream ,stream :pathname ,fn)
,@body
:close-stream
(files-write ,fn ,dest-path ,@params))))
;; ————————————————————————————————————— ;; —————————————————————————————————————
;; FILESTORE CALLS ;; FILESTORE CALLS
@ -770,7 +794,8 @@
(defun pin-ls (&key (path nil) (type "all")) (defun pin-ls (&key (path nil) (type "all"))
"List objects pinned to local storage. "List objects pinned to local storage.
/ipns/docs.ipfs.io/reference/api/http/#api-v0-pin-ls" /ipns/docs.ipfs.io/reference/api/http/#api-v0-pin-ls"
(ipfs-call "pin/ls" `(,(when path `("arg" ,path)) ("type" ,type)))) (let ((res (ipfs-call "pin/ls" `(,(when path `("arg" ,path)) ("type" ,type)))))
(if (equal res '("Keys")) nil res)))
;; STRING [:BOOLEAN] → ALIAS || (NIL STRING) ;; STRING [:BOOLEAN] → ALIAS || (NIL STRING)
(defun pin-rm (path &key (recursive 'T)) (defun pin-rm (path &key (recursive 'T))
@ -1046,7 +1071,7 @@
(stringp (cdr list))) (stringp (cdr list)))
(cdr list)) (cdr list))
((and (eq 1 (length list)) ((and (eq 1 (length list))
(consp list)) (consp (car list)))
(simplify (car list))) (simplify (car list)))
((and (consp list) ((and (consp list)
(stringp (car list)) (stringp (car list))

View File

@ -168,4 +168,5 @@
;; version calls ;; version calls
:version :version
:version-deps)) :version-deps
#:with-files-write))