From db8682b513077059b368b1a2d067fe0641c356c6 Mon Sep 17 00:00:00 2001 From: "bnmcgn@gmail.com" Date: Sat, 15 May 2021 17:36:23 -0700 Subject: [PATCH 1/3] Debugged ipfs-files-write. - Adjusted some supporting code for flexibility. - Ipfs-files-write will take a pathname or a string as input. --- main.lisp | 59 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 24 deletions(-) diff --git a/main.lisp b/main.lisp index 0a0c80a..cfacdd4 100644 --- a/main.lisp +++ b/main.lisp @@ -31,26 +31,30 @@ recieved, two values are returned: NIL and the string-error-message." (let ((result (drakma:http-request - (make-call-url *api-host* *api-root* call arguments) + (make-call-url call arguments) :method method :url-encoder #'ipfs::url-encode :parameters parameters :want-stream want-stream))) + (if want-stream + result + (process-result result)))) - (cond (want-stream result) - ((stringp result) (values nil result)) - ((vectorp result) - (let* ((string (flexi-streams:octets-to-string result)) - (alist - (with-input-from-string (stream string) - (loop while (peek-char t stream nil) - collect (yason:parse stream :object-as :alist))))) - (if (ignore-errors (equal (cdr (s-assoc "Type" (simplify alist))) "error")) - (values NIL (cdr (s-assoc "Message" (simplify alist)))) - (simplify alist))))))) +(defun process-result (result) + (cond + ((stringp result) (values nil result)) + ((vectorp result) + (let* ((string (flexi-streams:octets-to-string result)) + (alist + (with-input-from-string (stream string) + (loop while (peek-char t stream nil) + collect (yason:parse stream :object-as :alist))))) + (if (ignore-errors (equal (cdr (s-assoc "Type" (simplify alist))) "error")) + (values NIL (cdr (s-assoc "Message" (simplify alist)))) + (simplify alist)))))) -;; STRING STRING LIST → STRING -(defun make-call-url (host root call arguments) +;; STRING LIST &key STRING STRING → STRING +(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. Symbols are assumed to be something like 'T (so boolean), nil likewise. Arguments should look like this: @@ -497,20 +501,27 @@ ;; PATHNAME STRING [:NUMBER :BOOLEAN :BOOLEAN :BOOLEAN :NUMBER :BOOLEAN ;; :NUMBER :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) (truncate nil) (count nil) (raw-leaves 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" - (ipfs-call "files/write" - `(("arg" ,dest-path) ("create" ,create) ("parents" ,parents) - ("truncate" ,truncate) ("raw-leaves" ,raw-leaves) - ,(if offset (list "offset" offset)) - ,(if count (list "count" count)) - ,(if cid-version `("cid-version" ,cid-version)) - ,(if hash (list "hash" hash))) - :parameters `(("file" . ,pathname)))) + (let ((result + (drakma:http-request + (make-call-url + "files/write" + `(("arg" ,dest-path) ("create", create) ("parents" ,parents) + ("truncate" ,truncate) ("raw-leaves" ,raw-leaves) + ,@(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))) + (process-result result))) -- 2.46.0 From d5e641c3eafb20dea4a196be0e18b480cd5c4764 Mon Sep 17 00:00:00 2001 From: "bnmcgn@gmail.com" Date: Mon, 17 May 2021 07:42:10 -0700 Subject: [PATCH 2/3] Adjusted conversion of JSON response - IPFS sometimes returns the JSON response as a string, confusing the existing code. Switched to a check of :content-type in the response header. - While we are at it, detect errors by testing the response code. --- main.lisp | 60 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/main.lisp b/main.lisp index cfacdd4..8c8a898 100644 --- a/main.lisp +++ b/main.lisp @@ -30,28 +30,29 @@ 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." (let ((result - (drakma:http-request + (multiple-value-list + (drakma:http-request (make-call-url call arguments) :method method :url-encoder #'ipfs::url-encode :parameters parameters - :want-stream want-stream))) + :want-stream want-stream)))) (if want-stream - result - (process-result result)))) + (car result) + (apply #'process-result result)))) -(defun process-result (result) - (cond - ((stringp result) (values nil result)) - ((vectorp result) - (let* ((string (flexi-streams:octets-to-string result)) - (alist - (with-input-from-string (stream string) - (loop while (peek-char t stream nil) - collect (yason:parse stream :object-as :alist))))) - (if (ignore-errors (equal (cdr (s-assoc "Type" (simplify alist))) "error")) - (values NIL (cdr (s-assoc "Message" (simplify alist)))) - (simplify alist)))))) +(defun process-result (body status-code headers uri http-stream must-close status-text) + (declare (ignore uri http-stream must-close status-text)) + (let* ((result (cond ((stringp body) body) + ((vectorp body) (flexi-streams:octets-to-string body)))) + (result (if (search "application/json" (cdr (assoc :content-type headers))) + (simplify (yason:parse result :object-as :alist)) + result))) + (if (eql 200 status-code) + result + (values nil (if (stringp result) + result + (ignore-errors (cdr (s-assoc "Message" result)))))))) ;; STRING LIST &key STRING STRING → STRING (defun make-call-url (call arguments &key (host *api-host*) (root *api-root*)) @@ -509,19 +510,20 @@ a local file. /ipns/docs.ipfs.io/reference/api/http/#api-v0-files-rm" (let ((result - (drakma:http-request - (make-call-url - "files/write" - `(("arg" ,dest-path) ("create", create) ("parents" ,parents) - ("truncate" ,truncate) ("raw-leaves" ,raw-leaves) - ,@(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))) - (process-result result))) + (multiple-value-list + (drakma:http-request + (make-call-url + "files/write" + `(("arg" ,dest-path) ("create", create) ("parents" ,parents) + ("truncate" ,truncate) ("raw-leaves" ,raw-leaves) + ,@(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))) -- 2.46.0 From fc5cc5a256f21eefbd6816b9e1a6ec7e24759f54 Mon Sep 17 00:00:00 2001 From: "bnmcgn@gmail.com" Date: Thu, 24 Jun 2021 16:24:14 -0700 Subject: [PATCH 3/3] Implemented with-files-write macro - Bugfix: pin/ls didn't handle empty result correctly - Bugfix: Fixed edge case in simplify --- main.lisp | 20 ++++++++++++++++---- package.lisp | 3 ++- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/main.lisp b/main.lisp index 8c8a898..2ea88c7 100644 --- a/main.lisp +++ b/main.lisp @@ -46,7 +46,8 @@ (let* ((result (cond ((stringp body) body) ((vectorp body) (flexi-streams:octets-to-string body)))) (result (if (search "application/json" (cdr (assoc :content-type headers))) - (simplify (yason:parse result :object-as :alist)) + (unless (empty-string-p result) + (simplify (yason:parse result :object-as :alist))) result))) (if (eql 200 status-code) result @@ -525,7 +526,17 @@ a local file. :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 @@ -783,7 +794,8 @@ a local file. (defun pin-ls (&key (path nil) (type "all")) "List objects pinned to local storage. /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) (defun pin-rm (path &key (recursive 'T)) @@ -1059,7 +1071,7 @@ a local file. (stringp (cdr list))) (cdr list)) ((and (eq 1 (length list)) - (consp list)) + (consp (car list))) (simplify (car list))) ((and (consp list) (stringp (car list)) diff --git a/package.lisp b/package.lisp index 6a2cf63..cad7346 100644 --- a/package.lisp +++ b/package.lisp @@ -168,4 +168,5 @@ ;; version calls :version - :version-deps)) + :version-deps + #:with-files-write)) -- 2.46.0