Merge branch 'headers' into develop

1 files changed, 58 insertions, 15 deletions

diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el
index e3efabe..66707b7 100644
--- a/lisp/mastodon-http.el
+++ b/lisp/mastodon-http.el
@@ -148,25 +148,60 @@ SILENT means don't message."
    "GET"
    (mastodon-http--url-retrieve-synchronously url silent)))
 
-(defun mastodon-http--get-json (url &optional silent)
-  "Make synchronous GET request to URL. Return JSON response.
-SILENT means don't message."
+(defun mastodon-http--get-response (url &optional no-headers silent vector)
+  "Make synchronous GET request to URL. Return JSON and response headers.
+SILENT means don't message.
+NO-HEADERS means don't collect http response headers.
+VECTOR means return json arrays as vectors."
   (with-current-buffer (mastodon-http--get url silent)
-    (mastodon-http--process-json)))
+    (mastodon-http--process-response no-headers vector)))
+
+(defun mastodon-http--get-json (url &optional silent vector)
+  "Return only JSON data from URL request.
+SILENT means don't message.
+VECTOR means return json arrays as vectors."
+  (car (mastodon-http--get-response url :no-headers silent vector)))
 
 (defun mastodon-http--process-json ()
-  "Process JSON response."
+  "Return only JSON data from async URL request.
+Callback to `mastodon-http--get-json-async', usually
+`mastodon-tl--init*', is run on the result."
+  (car (mastodon-http--process-response :no-headers)))
+
+(defun mastodon-http--process-response (&optional no-headers vector)
+  "Process http response.
+Return a cons of JSON list and http response headers.
+If NO-HEADERS is non-nil, just return the JSON.
+VECTOR means return json arrays as vectors.
+Callback to `mastodon-http--get-response-async', usually
+`mastodon-tl--init*', is run on the result."
   ;; view raw response:
   ;; (switch-to-buffer (current-buffer))
+  (let ((headers (unless no-headers
+                   (mastodon-http--process-headers))))
+    (goto-char (point-min))
+    (re-search-forward "^$" nil 'move)
+    (let ((json-array-type (if vector 'vector 'list))
+          (json-string
+           (decode-coding-string
+            (buffer-substring-no-properties (point) (point-max))
+            'utf-8)))
+      (kill-buffer)
+      (unless (or (string-empty-p json-string) (null json-string))
+        `(,(json-read-from-string json-string) . ,headers)))))
+
+(defun mastodon-http--process-headers ()
+  "Return an alist of http response headers."
+  (switch-to-buffer (current-buffer))
   (goto-char (point-min))
-  (re-search-forward "^$" nil 'move)
-  (let ((json-string
-         (decode-coding-string
-          (buffer-substring-no-properties (point) (point-max))
-          'utf-8)))
-    (kill-buffer)
-    (unless (or (string-empty-p json-string) (null json-string))
-      (json-read-from-string json-string))))
+  (let* ((head-str (buffer-substring-no-properties
+                    (point-min)
+                    (re-search-forward "^$" nil 'move)))
+         (head-list (split-string head-str "\n")))
+    (mapcar (lambda (x)
+              (let ((list (split-string x ": ")))
+                (cons (car list) (cadr list))))
+            head-list)))
 
 (defun mastodon-http--delete (url)
   "Make DELETE request to URL."
@@ -241,8 +276,16 @@ Pass response buffer to CALLBACK function with args CBARGS."
    "GET"
    (url-retrieve url callback cbargs)))
 
-(defun mastodon-http--get-json-async (url &optional callback &rest args)
-  "Make GET request to URL. Call CALLBACK with json-vector and ARGS."
+(defun mastodon-http--get-response-async (url callback &rest args)
+  "Make GET request to URL. Call CALLBACK with http response and ARGS."
+  (mastodon-http--get-async
+   url
+   (lambda (status)
+     (when status ;; only when we actually get sth?
+       (apply callback (mastodon-http--process-response) args)))))
+
+(defun mastodon-http--get-json-async (url callback &rest args)
+  "Make GET request to URL. Call CALLBACK with json-list and ARGS."
   (mastodon-http--get-async
    url
    (lambda (status)