drakma -> dexador

chatikbot.asd

@@ -6,20 +6,19 @@
   :depends-on (#:alexandria
                #:adw-charting-vecto
                #:bordeaux-threads
+               #:cl-cookie
                #:cl-date-time-parser
                #:cl-ppcre
                #:cl-base64
                #:clon
                #:clss
-               #:drakma
-               #:flexi-streams
+               #:dexador
                #:hunchentoot
                #:ironclad
                #:local-time
                #:log4cl
                #:plump
                #:sqlite
-               #:trivial-utf-8
                #:uuid
                #:quri
                #:yason)

plugins/forecast.lisp

@@ -4,13 +4,11 @@
 (defparameter +forecast-api-url+ "https://api.darksky.net/forecast" "forecast.io API endpoint")
 
 (defun forecast (lat lon &key time (currently t) minutely hourly daily alerts)
-  (handler-case
-      (bordeaux-threads:with-timeout (5)
-        (json-request (format nil
-                              "~A/~A/~A,~A~@[,~A~]?units=si&exclude=~:[currently,~;~]~:[minutely,~;~]~:[hourly,~;~]~:[daily,~;~]~:[alerts,~;~]flags&lang=ru"
-                              +forecast-api-url+ *forecast-api-key* lat lon time
-                              currently minutely hourly daily alerts)))
-    (bordeaux-threads:timeout () (error "Timeout"))))
+  (json-request (format nil
+                        "~A/~A/~A,~A~@[,~A~]?units=si&exclude=~:[currently,~;~]~:[minutely,~;~]~:[hourly,~;~]~:[daily,~;~]~:[alerts,~;~]flags&lang=ru"
+                        +forecast-api-url+ *forecast-api-key* lat lon time
+                        currently minutely hourly daily alerts)
+                :timeout 5))
 
 (defvar *forecast-point-formats*
   '((:current . (:year "-" (:month 2) "-" (:day 2) " " (:hour 2) ":" (:min 2)))

plugins/foursquare.lisp

@@ -7,14 +7,12 @@
 
 (defun %fsq-api-call (access-token method &optional params)
   (let* ((resp
-          (handler-case
-              (bordeaux-threads:with-timeout (5)
-                (json-request (format nil *fsq-api-url* method)
-                              :parameters (list*
-                                           (cons "oauth_token" access-token)
-                                           (cons "v" "20150811")
-                                           params)))
-            (bordeaux-threads:timeout () (error "Timeout"))))
+           (json-request (format nil *fsq-api-url* method)
+                         :parameters (list*
+                                      (cons "oauth_token" access-token)
+                                      (cons "v" "20150811")
+                                      params)
+                         :timeout 5))
          (meta (aget "meta" resp)))
     (when (not (= 200 (aget "code" meta)))
       (error (format nil "Foursquare API error, code ~A, errorType '~A', errorDetail '~A'"

plugins/gsheets.lisp

@@ -43,11 +43,11 @@
     (declare (ignore old-access-token))
     (when refresh-token
       (let* ((resp (json-request +google-token-endpoint+ :method :post
-                                 :parameters (list
-                                              (cons "refresh_token" refresh-token)
-                                              (cons "client_id" *gsheets-client-id*)
-                                              (cons "client_secret" *gsheets-client-secret*)
-                                              (cons "grant_type" "refresh_token"))))
+                                 :content (list
+                                           (cons "refresh_token" refresh-token)
+                                           (cons "client_id" *gsheets-client-id*)
+                                           (cons "client_secret" *gsheets-client-secret*)
+                                           (cons "grant_type" "refresh_token"))))
              (access-token (aget "access_token" resp)))
         (log:info resp)
         (when access-token
@@ -59,14 +59,14 @@
       (progn
         (log:info code state)
         (let* ((resp (json-request +google-token-endpoint+ :method :post
-                                   :parameters (list
-                                                (cons "code" code)
-                                                (cons "client_id" *gsheets-client-id*)
-                                                (cons "client_secret" *gsheets-client-secret*)
-                                                (cons "redirect_uri" (quri:render-uri
-                                                                      (quri:merge-uris (quri:uri "/oauth")
-                                                                                       (quri:uri *web-path*))))
-                                                (cons "grant_type" "authorization_code"))))
+                                   :content (list
+                                             (cons "code" code)
+                                             (cons "client_id" *gsheets-client-id*)
+                                             (cons "client_secret" *gsheets-client-secret*)
+                                             (cons "redirect_uri" (quri:render-uri
+                                                                   (quri:merge-uris (quri:uri "/oauth")
+                                                                                    (quri:uri *web-path*))))
+                                             (cons "grant_type" "authorization_code"))))
                (access-token (aget "access_token" resp))
                (refresh-token (aget "refresh_token" resp))
                (token-id (parse-integer state)))

plugins/nalunch.lisp

@@ -8,10 +8,9 @@
 (defparameter +nalunch/login-uri+ "https://www.nalunch.ru/Mobile/Account/Login")
 (defparameter +nalunch/basicdata-calend+ "http://basicdata.ru/api/json/calend/")
 
-(defun nalunch/auth (login pass cookies &optional body)
-  (let* ((body (or body
-                   (drakma:http-request +nalunch/login-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)))
-         (dom (plump:parse body))
+(defun nalunch/auth (login pass cookies &optional dom)
+  (let* ((dom (or dom
+                  (xml-request +nalunch/login-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)))
          (form (plump:get-element-by-id dom "LoginForm"))
          (parameters
           (loop for input in (get-by-tag form "input")
@@ -19,27 +18,34 @@
              for value = (plump:get-attribute input "value")
              when (and name value) collect (cons name value)
              when (string= name "UserName") collect (cons name login)
-             when (string= name "Password") collect (cons name pass)))
-         (response (drakma:http-request +nalunch/login-uri+
-                                        :method :post
-                                        :parameters parameters
-                                        :cookie-jar cookies
-                                        :user-agent +nalunch/mobile-ua+)))
-    (when (search "id=\"LoginForm\"" response)
-      (error "Bad username or password"))
-    (if (search "<title>Чек</title>" response) ;; Reload feed page on 'Cheque'
-      (drakma:http-request +nalunch/mobile-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)
-      response)))
+             when (string= name "Password") collect (cons name pass))))
+    (multiple-value-bind (response status response-headers)
+        (http-request +nalunch/login-uri+
+                      :method :post
+                      :content parameters
+                      :cookie-jar cookies
+                      :user-agent +nalunch/mobile-ua+)
+      (when (and (member status '(301 302 303 307) :test #'=)
+                 (gethash "location" response-headers))
+        (setf response (http-request (quri:merge-uris
+                                      (quri:uri (gethash "location" response-headers))
+                                      (quri:uri +nalunch/login-uri+))
+                                     :cookie-jar cookies
+                                     :user-agent +nalunch/mobile-ua+)))
+      (when (search "id=\"LoginForm\"" response)
+        (error "Bad username or password"))
+      (if (search "<title>Чек</title>" response) ;; Reload feed page on 'Cheque'
+          (xml-request +nalunch/mobile-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)
+          (plump:parse response)))))
 
 (defun nalunch/recent (login pass &optional cookies)
-  (let ((cookies (or cookies (make-instance 'drakma:cookie-jar))))
-    (multiple-value-bind (body status headers uri)
-        (drakma:http-request +nalunch/mobile-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)
+  (let ((cookies (or cookies (cl-cookie:make-cookie-jar))))
+    (multiple-value-bind (dom status headers uri)
+        (xml-request +nalunch/mobile-uri+ :cookie-jar cookies :user-agent +nalunch/mobile-ua+)
       (declare (ignore status headers))
-      (let* ((body (if (puri:uri= uri (puri:uri +nalunch/mobile-uri+))
-                       body
-                       (nalunch/auth login pass cookies body)))
-             (dom (plump:parse body))
+      (let* ((dom (if (quri:uri= uri (quri:uri +nalunch/mobile-uri+))
+                       dom
+                       (nalunch/auth login pass cookies dom)))
              (balance (parse-integer (plump:text (elt (clss:select ".newswire-header_balance" dom) 0))))
              (recent (loop for day across (clss:select ".day-feed" dom)
                         append (loop for el across (clss:select ".media" day)
@@ -96,7 +102,7 @@
     (secret/with (login-pass (list :nalunch chat-id))
       (if login-pass
           (let* ((cookie-jar (or (gethash chat-id *nalunch/jars*)
-                                 (make-instance 'drakma:cookie-jar)))
+                                 (cl-cookie:make-cookie-jar)))
                  (old (gethash chat-id *nalunch/last-results*))
                  (new (nalunch/recent (car login-pass) (cdr login-pass) cookie-jar)))
             (when new
@@ -126,7 +132,7 @@
                         "Без рассылки. '/nalunch on' - включить, /nalunch - последние.")))
 
 (defun nalunch/handle-auth (chat-id login pass)
-  (let ((cookies (make-instance 'drakma:cookie-jar)))
+  (let ((cookies (cl-cookie:make-cookie-jar)))
     (handler-case
         (progn
           (nalunch/auth login pass cookies)
@@ -139,7 +145,7 @@
     (bot-send-message chat-id
                       (if login-pass
                           (let* ((cookies (or (gethash chat-id *nalunch/jars*)
-                                              (make-instance 'drakma:cookie-jar)))
+                                              (cl-cookie:make-cookie-jar)))
                                  (data (nalunch/recent (car login-pass) (cdr login-pass) cookies)))
                             (if data
                                 (progn

plugins/rss.lisp

@@ -9,14 +9,14 @@
 
 (defun find-rss-links (url)
   (handler-case
-      (multiple-value-bind (root uri encoding) (xml-request url)
-        (declare (ignore encoding))
+      (multiple-value-bind (root status headers uri) (xml-request url)
+        (declare (ignore status headers))
         (loop for link in (get-by-tag root "link")
            when (string= "application/rss+xml" (plump:attribute link "type"))
            collect (list (plump:attribute link "title")
-                         (puri:render-uri
-                          (puri:merge-uris
-                           (puri:uri (plump:attribute link "href"))
+                         (quri:render-uri
+                          (quri:merge-uris
+                           (quri:uri (plump:attribute link "href"))
                            uri) nil))))
     (error (e) (log:error e))))
 

plugins/transmission.lisp

@@ -7,10 +7,11 @@
 (defvar *transmission-sessions* nil "ALIST of (url . x-transmission-session-id)")
 
 (defun transmission-get-session (url)
-  (multiple-value-bind (body status headers uri stream)
-      (drakma:http-request url :force-binary t :decode-content t)
-    (declare (ignore body status uri stream))
-    (aget :x-transmission-session-id headers)))
+  (multiple-value-bind (body status headers)
+      (handler-bind ((dex:http-request-conflict #'dex:ignore-and-continue))
+        (http-request url))
+    (declare (ignore body status))
+    (gethash "x-transmission-session-id" headers)))
 
 (defun transmission-set-session (url session-id)
   (set-setting '*transmission-sessions*
@@ -28,23 +29,16 @@
                                                 when value
                                                 appending (list (dekeyify key) value)))))
                          stream))))
-    (multiple-value-bind (stream status headers uri http-stream)
-        (drakma:http-request url :method :post :content content :content-type "application/json"
-                             :force-binary t :want-stream t :decode-content t
-                             :additional-headers (list (cons :x-transmission-session-id session-id)))
-      (declare (ignore uri))
-      (ecase status
-        (200 (unwind-protect
-                  (progn
-                    (setf (flex:flexi-stream-external-format stream) :utf-8)
-                    (let* ((response (yason:parse stream :object-as :alist))
-                           (result (aget "result" response)))
-                      (unless (equal "success" result)
-                        (error result))
-                      (aget "arguments" response)))
-               (ignore-errors (close http-stream))))
-        (409 (transmission-set-session url (aget :x-transmission-session-id headers))
-             (apply #'transmission-request url method arguments))))))
+    (handler-case
+        (let* ((response (json-request url :method :post :content content
+                                       :headers (list (cons :x-transmission-session-id session-id))))
+               (result (aget "result" response)))
+          (unless (equal "success" result)
+            (error result))
+          (aget "arguments" response))
+      (dex:http-request-conflict (e)
+        (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
+        (apply #'transmission-request url method arguments)))))
 
 (defun transmission-get-torrents (url &optional ids (fields '("id" "name" "status" "percentDone" "eta" "totalSize")))
   (aget "torrents" (transmission-request url :torrent-get :ids ids :fields fields)))

plugins/tumblr.lisp

@@ -4,8 +4,7 @@
 (defparameter *read-timeout* 5 "API request timeout")
 
 (defparameter *boobs-roll*
-  '("http://bbt12.tumblr.com"
-    "http://boobsarethegreatest.tumblr.com"
+  '("http://boobsarethegreatest.tumblr.com"
     "http://perfectbreasts.tumblr.com")
   "Tumblr roll with boobs")
 
@@ -30,19 +29,15 @@
   (string-downcase (princ-to-string val)))
 
 (defun tumblr-read (domain &rest args)
-  (handler-case
-      (let ((params (loop for (k v) on args by #'cddr
-                       when v collect (cons (lo-string k) (lo-string v)))))
-        (yason:parse
-         (subseq (flexi-streams:octets-to-string
-                  (bordeaux-threads:with-timeout (*read-timeout*)
-                    (drakma:http-request
-                     (format nil "~A/api/read/json" domain)
-                     :parameters params
-                     :force-binary t))
-                  :external-format :utf-8) 22)
-         :object-as :alist))
-    (bordeaux-threads:timeout (e) (error e))))
+  (let ((params (loop for (k v) on args by #'cddr
+                   when v collect (cons (lo-string k) (lo-string v)))))
+    (yason:parse
+     (subseq (http-request
+              (format nil "~A/api/read/json" domain)
+              :parameters params
+              :timeout *read-timeout*)
+             22)
+     :object-as :alist)))
 
 (defun tumblr-random-post (&key (roll *tumblr-roll*) type (num 1))
   (when roll

plugins/twitter.lisp

@@ -7,22 +7,22 @@
 (defun get-tweets (user-id &key since-id (count 5))
   (loop for status in
        (yason:parse
-                 (flexi-streams:octets-to-string
-                  (cl-oauth:access-protected-resource
-                   (format nil "~A?~A"
-                           *timeline-url*
-                           (cl-oauth::alist->query-string
-                            (remove-if
-                             (complement #'cdr)
-                             (list
-                              (cons "user_id" user-id)
-                              (cons "count" count)
-                              (cons "since_id" since-id)
-                              (cons "trim_user" 1)
-                              (cons "exclude_replies" 1)))
-                            :include-leading-ampersand nil))
-                   *twitter-access-token*))
-                 :object-as :alist)
+        (babel:octets-to-string
+         (cl-oauth:access-protected-resource
+          (format nil "~A?~A"
+                  *timeline-url*
+                  (cl-oauth::alist->query-string
+                   (remove-if
+                    (complement #'cdr)
+                    (list
+                     (cons "user_id" user-id)
+                     (cons "count" count)
+                     (cons "since_id" since-id)
+                     (cons "trim_user" 1)
+                     (cons "exclude_replies" 1)))
+                   :include-leading-ampersand nil))
+          *twitter-access-token*))
+        :object-as :alist)
      collect (cons
               (aget "id" status)
               (aget "text" status))))

plugins/vk.lisp

@@ -18,22 +18,18 @@
             +vk-oauth-authorize+ +vk-api-ver+ *vk-app-client-id* *web-path* (unless (zerop scope) scope) state)))
 
 (defun %vk-api-call (method &optional args)
-  (handler-case
-      (bordeaux-threads:with-timeout (5)
-        (let* ((params (loop for (k . v) in args
-                          when v
-                          collect (cons
-                                   (princ-to-string k)
-                                   (princ-to-string v))))
-               (response (json-request (format nil +vk-api-url+ method +vk-api-ver+)
-                                       :method :post
-                                       :parameters params)))
-          (when (aget "error" response)
-            (error (aget "error_msg" (aget "error" response))))
-          (aget "response" response)))
-    (bordeaux-threads:timeout (e)
-      (declare (ignore e))
-      (error "Timeout"))))
+  (let* ((params (loop for (k . v) in args
+                    when v
+                    collect (cons
+                             (princ-to-string k)
+                             (princ-to-string v))))
+         (response (json-request (format nil +vk-api-url+ method +vk-api-ver+)
+                                 :method :post
+                                 :content params
+                                 :timeout 5)))
+    (when (aget "error" response)
+      (error (aget "error_msg" (aget "error" response))))
+    (aget "response" response)))
 
 (defun vk-wall-get (&key owner-id domain offset count filter extended fields)
   (%vk-api-call "wall.get"
@@ -45,6 +41,14 @@
                   ("extended" . ,extended)
                   ("fields" . ,fields))))
 
+(defun vk-wall-get-by-id (post-ids &key extended fields copy-history-depth)
+  (%vk-api-call "wall.getById"
+                `(("posts" . ,(if (consp post-ids)
+                                  (format nil "~{~A~^,~}" post-ids) post-ids))
+                  ("extended" . ,extended)
+                  ("copy_history_depth" . ,copy-history-depth)
+                  ("fields" . ,fields))))
+
 (defun vk-get-user-name (id)
   (let ((r (first (%vk-api-call "users.get" `(("user_ids" . ,id))))))
     (format nil "~A ~A" (aget "first_name" r) (aget "last_name" r))))
@@ -71,7 +75,7 @@
    :disable-web-preview 1))
 
 (defun %find-vk-domain (url)
-  (let ((path (puri:uri-path (puri:parse-uri url))))
+  (let ((path (quri:uri-path (quri:uri url))))
     (if (equal #\/ (elt path 0))
         (subseq path 1)
         path)))

telegram.lisp

@@ -15,13 +15,11 @@
          (timeout (+ 5 (or (aget "timeout" args)
                            *telegram-timeout*)))
          (response
-          (handler-case
-              (bordeaux-threads:with-timeout (timeout)
-                (json-request (format nil +telegram-api-format+
-                                      *telegram-token* method)
-                              :method :post
-                              :parameters params))
-            (bordeaux-threads:timeout () (error "Timeout")))))
+           (json-request (format nil +telegram-api-format+
+                                 *telegram-token* method)
+                         :method :post
+                         :parameters params
+                         :timeout timeout)))
     (unless (aget "ok" response)
       (error (aget "description" response)))
     (aget "result" response)))
@@ -187,7 +185,7 @@
   (let* ((file (telegram-get-file file-id))
          (file-path (aget "file_path" file))
          (file-url (format nil +telegram-file-format+ *telegram-token* file-path)))
-    (drakma:http-request file-url :force-binary t :decode-content t)))
+    (http-request file-url :force-binary t)))
 
 (defun telegram-inline-keyboard-markup (inline-keyboard)
   (when inline-keyboard

utils.lisp

@@ -52,7 +52,7 @@
              (sleep backoff)
              (setf backoff (min *backoff-max*
                                 (* 2 backoff))))
-           (bordeaux-threads:timeout (e)
+           (usocket:timeout-error (e)
              (log:error e)
              (log:info "Backing off for" backoff)
              (sleep backoff)
@@ -145,33 +145,54 @@ is replaced with replacement."
 (defun spaced (list)
   (format nil "~{~A~^ ~}" list))
 
-(defun http-default (url)
-  (let ((uri (quri:uri url)))
-    (quri:render-uri
-     (if (null (quri:uri-scheme uri))
-         (quri:uri (format nil "http://~A" url))
-         uri))))
+(defun http-default (url &optional parameters)
+  (let* ((uri (quri:uri url))
+         (userinfo (quri:uri-userinfo uri)))
+    (when parameters
+      (let ((query (quri:url-encode-params parameters :encoding :utf-8)))
+        (setf (quri:uri-query uri)
+              (if (and (quri:uri-query uri)
+                       (string-not-equal (quri:uri-query uri) ""))
+                  (concatenate 'string (quri:uri-query uri) "&" query)
+                  query))))
+    (when userinfo
+      (setf (quri:uri-userinfo uri) nil))
+    (unless (quri:uri-scheme uri)
+      (setf (quri:uri-scheme uri) "http"))
+    (values uri userinfo)))
+
+(defun http-request (url &rest args &key method version parameters content headers basic-auth cookie-jar keep-alive use-connection-pool (max-redirects 5) timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent)
+  (declare (ignore method version content basic-auth cookie-jar keep-alive use-connection-pool max-redirects timeout force-binary want-stream ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path))
+  (multiple-value-bind (uri userinfo)
+      (http-default url parameters)
+    (when userinfo
+      (push (cons :authorization (concatenate 'string "Basic "
+                                              (base64:string-to-base64-string userinfo)))
+            headers))
+    (when user-agent
+      (push (cons :user-agent user-agent) headers)
+      (remf args :user-agent))
+    (remf args :parameters)
+    (apply #'dex:request uri :headers headers args)))
 
 ;; XML processing
-(defun xml-request (url &key encoding parameters)
-  (multiple-value-bind (raw-body status headers uri http-stream)
-      (drakma:http-request (http-default url)
-                           :parameters parameters
-                           :external-format-out :utf-8
-                           :force-binary t
-                           :decode-content t)
-    (declare (ignore status http-stream))
+(defun xml-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent encoding)
+  (declare (ignore method parameters headers content basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))
+  (remf args :encoding)
+  (multiple-value-bind (raw-body status headers uri)
+      (apply #'http-request url :force-binary t args)
     (let ((encoding
            (or
             ;; 1. Provided encoding
             encoding
             ;; 2. Content-type header
             (ignore-errors
-              (let ((ct (aget :content-type headers)))
+              (let ((ct (gethash "content-type" headers)))
                 (subseq ct (1+ (position #\= ct)))))
             ;; 3. Parse first 1000 bytes
             (ignore-errors
-              (let ((dom (plump:parse (flex:octets-to-string (subseq raw-body 0 1000)))))
+              (let ((dom (plump:parse (flex:octets-to-string
+                                       (subseq raw-body 0 (1+ (position (char-code #\>) raw-body :start 1000)))))))
                 (or
                  ;; 3.1 Content-type from http-equiv
                  (ignore-errors
@@ -190,7 +211,7 @@ is replaced with replacement."
                        (lambda (c) (use-value #\? c))))
          (plump:parse
           (flex:octets-to-string raw-body :external-format (intern encoding 'keyword))))
-       uri))))
+       status headers uri))))
 
 (defun get-by-tag (node tag)
   (nreverse (org.shirakumo.plump.dom::get-elements-by-tag-name node tag)))
@@ -200,20 +221,16 @@ is replaced with replacement."
     (string-trim '(#\Newline #\Space #\Return) (plump:text (elt (clss:select selector node) 0)))))
 
 ;; JSON processing
-(defun json-request (url &key (method :get) parameters content additional-headers (object-as :alist))
-  (multiple-value-bind (stream status headers uri http-stream)
-      (drakma:http-request (http-default url) :method method
-                           :parameters parameters
-                           :content content :content-type "application/json"
-                           :additional-headers additional-headers
-                           :external-format-out :utf-8
-                           :force-binary t :want-stream t :decode-content t)
-    (declare (ignore status headers))
-    (unwind-protect
-         (progn
-           (setf (flex:flexi-stream-external-format stream) :utf-8)
-           (values (yason:parse stream :object-as object-as) uri))
-      (ignore-errors (close http-stream)))))
+(defun json-request (url &rest args &key method parameters content headers basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent (object-as :alist))
+  (declare (ignore method parameters basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))
+  (remf args :object-as)
+  (when content
+    (push (cons :content-type "application/json") headers))
+  (multiple-value-bind (body status headers uri)
+      (apply #'http-request url args)
+    (unless (stringp body)
+      (setf body (babel:octets-to-string body :encoding :utf-8)))
+    (values (yason:parse body :object-as object-as) status headers uri)))
 
 (defun plist-hash (plist &optional skip-nil (format-key #'identity) &rest hash-table-initargs)
   (cond