339 lines
13 KiB
EmacsLisp
339 lines
13 KiB
EmacsLisp
|
;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2014 Sean Allred
|
|||
|
|
|
|||
|
|
;; Author: Sean Allred <code@seanallred.com>
|
|||
|
|
|
|||
|
|
;; This program is free software; you can redistribute it and/or modify
|
|||
|
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|||
|
|
;; (at your option) any later version.
|
|||
|
|
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; API requests are handled on three separate tiers:
|
|||
|
|
;;
|
|||
|
|
;; `sx-method-call':
|
|||
|
|
;;
|
|||
|
|
;; This is the function that should be used most often, since it
|
|||
|
|
;; runs necessary checks (authentication) and provides basic
|
|||
|
|
;; processing of the result for consistency.
|
|||
|
|
;;
|
|||
|
|
;; `sx-request-make':
|
|||
|
|
;;
|
|||
|
|
;; This is the fundamental function for interacting with the API.
|
|||
|
|
;; It makes no provisions for 'common' usage, but it does ensure
|
|||
|
|
;; data is retrieved successfully or an appropriate signal is
|
|||
|
|
;; thrown.
|
|||
|
|
;;
|
|||
|
|
;; `url.el' and `json.el':
|
|||
|
|
;;
|
|||
|
|
;; The whole solution is built upon `url-retrieve-synchronously'
|
|||
|
|
;; for making the request and `json-read-from-string' for parsing
|
|||
|
|
;; it into a properly symbolic data structure.
|
|||
|
|
;;
|
|||
|
|
;; When at all possible, use `sx-method-call'. There are specialized
|
|||
|
|
;; cases for the use of `sx-request-make' outside of sx-method.el, but
|
|||
|
|
;; these must be well-documented inline with the code.
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'url)
|
|||
|
|
(require 'json)
|
|||
|
|
|
|||
|
|
(require 'sx)
|
|||
|
|
(require 'sx-encoding)
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Variables
|
|||
|
|
|
|||
|
|
(defconst sx-request-api-key
|
|||
|
|
"0TE6s1tveCpP9K5r5JNDNQ(("
|
|||
|
|
"When passed, this key provides a higher request quota.")
|
|||
|
|
|
|||
|
|
(defconst sx-request-api-version
|
|||
|
|
"2.2"
|
|||
|
|
"The current version of the API.")
|
|||
|
|
|
|||
|
|
(defconst sx-request-api-root
|
|||
|
|
(format "https://api.stackexchange.com/%s/" sx-request-api-version)
|
|||
|
|
"The base URL to make requests from.")
|
|||
|
|
|
|||
|
|
(defcustom sx-request-unzip-program
|
|||
|
|
"gunzip"
|
|||
|
|
"Program used to unzip the response if it is compressed.
|
|||
|
|
This program must accept compressed data on standard input.
|
|||
|
|
|
|||
|
|
This is only used (and necessary) if the function
|
|||
|
|
`zlib-decompress-region' is not defined, which is the case for
|
|||
|
|
Emacs versions < 24.4."
|
|||
|
|
:group 'sx
|
|||
|
|
:type 'string)
|
|||
|
|
|
|||
|
|
(defvar sx-request-remaining-api-requests
|
|||
|
|
nil
|
|||
|
|
"The number of API requests remaining.
|
|||
|
|
Set by `sx-request-make'.")
|
|||
|
|
|
|||
|
|
(defcustom sx-request-remaining-api-requests-message-threshold
|
|||
|
|
50
|
|||
|
|
"Lower bound for printed warnings of API usage limits.
|
|||
|
|
After `sx-request-remaining-api-requests' drops below this
|
|||
|
|
number, `sx-request-make' will begin printing out the
|
|||
|
|
number of requests left every time it finishes a call."
|
|||
|
|
:group 'sx
|
|||
|
|
:type 'integer)
|
|||
|
|
|
|||
|
|
(defvar sx-request-all-items-delay 0
|
|||
|
|
"Delay in seconds with each `sx-request-all-items' iteration.
|
|||
|
|
It is good to use a reasonable delay to avoid rate-limiting.")
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Making Requests
|
|||
|
|
(defvar sx--backoff-time nil)
|
|||
|
|
|
|||
|
|
(defun sx-request--wait-while-backoff ()
|
|||
|
|
(when sx--backoff-time
|
|||
|
|
(message "Waiting for backoff time: %s" sx--backoff-time)
|
|||
|
|
(let ((time (cadr (current-time))))
|
|||
|
|
(if (> (- sx--backoff-time time) 1000)
|
|||
|
|
;; If backoff-time is more than 1000 seconds in the future,
|
|||
|
|
;; we've likely just looped around the "least significant"
|
|||
|
|
;; bits of `current-time'.
|
|||
|
|
(setq sx--backoff-time time)
|
|||
|
|
(when (< time sx--backoff-time)
|
|||
|
|
(message "Backoff detected, waiting %s seconds" (- sx--backoff-time time))
|
|||
|
|
(sleep-for (+ 0.3 (- sx--backoff-time time))))))))
|
|||
|
|
|
|||
|
|
(defun sx-request-all-items (method &optional args request-method
|
|||
|
|
stop-when)
|
|||
|
|
"Call METHOD with ARGS until there are no more items.
|
|||
|
|
STOP-WHEN is a function that takes the entire response and
|
|||
|
|
returns non-nil if the process should stop.
|
|||
|
|
|
|||
|
|
All other arguments are identical to `sx-request-make', but
|
|||
|
|
PROCESS-FUNCTION is given the default value of `identity' (rather
|
|||
|
|
than `sx-request-response-get-items') to allow STOP-WHEN to
|
|||
|
|
access the response wrapper."
|
|||
|
|
;; @TODO: Refactor. This is the product of a late-night jam
|
|||
|
|
;; session... it is not intended to be model code.
|
|||
|
|
(declare (indent 1))
|
|||
|
|
(let* ((return-value nil)
|
|||
|
|
(current-page 1)
|
|||
|
|
(stop-when (or stop-when #'sx-request-all-stop-when-no-more))
|
|||
|
|
(process-function #'identity)
|
|||
|
|
(response
|
|||
|
|
(sx-request-make method `((page . ,current-page) ,@args)
|
|||
|
|
request-method process-function)))
|
|||
|
|
(while (not (funcall stop-when response))
|
|||
|
|
(let-alist response
|
|||
|
|
(setq current-page (1+ current-page)
|
|||
|
|
return-value
|
|||
|
|
(nconc return-value .items)))
|
|||
|
|
(sleep-for sx-request-all-items-delay)
|
|||
|
|
(setq response
|
|||
|
|
(sx-request-make method `((page . ,current-page) ,@args)
|
|||
|
|
request-method process-function)))
|
|||
|
|
(nconc return-value
|
|||
|
|
(cdr (assoc 'items response)))))
|
|||
|
|
|
|||
|
|
;;; NOTE: Whenever this is arglist changes, `sx-request-fallback' must
|
|||
|
|
;;; also change.
|
|||
|
|
(defun sx-request-make (method &optional args request-method process-function)
|
|||
|
|
"Make a request to the API, executing METHOD with ARGS.
|
|||
|
|
You should almost certainly be using `sx-method-call' instead of
|
|||
|
|
this function. REQUEST-METHOD is one of `get' (default) or `post'.
|
|||
|
|
|
|||
|
|
Returns the entire response as processed by PROCESS-FUNCTION.
|
|||
|
|
This defaults to `sx-request-response-get-items'.
|
|||
|
|
|
|||
|
|
The full set of arguments is built with
|
|||
|
|
`sx-request--build-keyword-arguments', prepending
|
|||
|
|
`sx-request-api-key' to receive a higher quota. It will also
|
|||
|
|
include user's `access_token` if it is avaialble. This call is
|
|||
|
|
then resolved with `url-retrieve-synchronously' to a temporary
|
|||
|
|
buffer that it returns. The headers are then stripped using a
|
|||
|
|
search a blank line (\"\\n\\n\"). The main body of the response
|
|||
|
|
is then tested with `sx-encoding-gzipped-buffer-p' for
|
|||
|
|
compression. If it is compressed, `sx-request-unzip-program' is
|
|||
|
|
called to uncompress the response. The uncompressed respons is
|
|||
|
|
then read with `json-read-from-string'.
|
|||
|
|
|
|||
|
|
`sx-request-remaining-api-requests' is updated appropriately and
|
|||
|
|
the main content of the response is returned."
|
|||
|
|
(declare (indent 1))
|
|||
|
|
(sx-request--wait-while-backoff)
|
|||
|
|
(let* ((url-automatic-caching t)
|
|||
|
|
(url-inhibit-uncompression t)
|
|||
|
|
(url-request-data (sx-request--build-keyword-arguments args nil))
|
|||
|
|
(request-url (concat sx-request-api-root method))
|
|||
|
|
(url-request-method (and request-method (upcase (symbol-name request-method))))
|
|||
|
|
(url-request-extra-headers
|
|||
|
|
'(("Content-Type" . "application/x-www-form-urlencoded")))
|
|||
|
|
(response-buffer (url-retrieve-synchronously request-url)))
|
|||
|
|
(if (not response-buffer)
|
|||
|
|
(error "Something went wrong in `url-retrieve-synchronously'")
|
|||
|
|
(with-current-buffer response-buffer
|
|||
|
|
(let* ((data (progn
|
|||
|
|
;; @TODO use url-http-end-of-headers
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(if (not (search-forward "\n\n" nil t))
|
|||
|
|
(error "Headers missing; response corrupt")
|
|||
|
|
(delete-region (point-min) (point))
|
|||
|
|
(buffer-string))))
|
|||
|
|
(response-zipped-p (sx-encoding-gzipped-p data))
|
|||
|
|
(data
|
|||
|
|
;; Turn string of bytes into string of characters. See
|
|||
|
|
;; http://emacs.stackexchange.com/q/4100/50
|
|||
|
|
(decode-coding-string
|
|||
|
|
(if (not response-zipped-p) data
|
|||
|
|
(if (fboundp 'zlib-decompress-region)
|
|||
|
|
(zlib-decompress-region (point-min) (point-max))
|
|||
|
|
(shell-command-on-region
|
|||
|
|
(point-min) (point-max)
|
|||
|
|
sx-request-unzip-program nil t))
|
|||
|
|
(buffer-string))
|
|||
|
|
'utf-8 'nocopy))
|
|||
|
|
;; @TODO should use `condition-case' here -- set
|
|||
|
|
;; RESPONSE to 'corrupt or something
|
|||
|
|
(response (with-demoted-errors "`json' error: %S"
|
|||
|
|
(let ((json-false nil)
|
|||
|
|
(json-array-type 'list)
|
|||
|
|
(json-null :null))
|
|||
|
|
(json-read-from-string data)))))
|
|||
|
|
(kill-buffer response-buffer)
|
|||
|
|
(when (not response)
|
|||
|
|
(error "Invalid response to the url request: %s" data))
|
|||
|
|
;; If we get here, the response is a valid data structure
|
|||
|
|
(sx-assoc-let response
|
|||
|
|
(when .error_id
|
|||
|
|
(error "Request failed: (%s) [%i %s] %S"
|
|||
|
|
.method .error_id .error_name .error_message))
|
|||
|
|
(when .backoff
|
|||
|
|
(message "Backoff received %s" .backoff)
|
|||
|
|
(setq sx--backoff-time (+ (cadr (current-time)) .backoff)))
|
|||
|
|
(when (< (setq sx-request-remaining-api-requests .quota_remaining)
|
|||
|
|
sx-request-remaining-api-requests-message-threshold)
|
|||
|
|
(sx-message "%d API requests remaining"
|
|||
|
|
sx-request-remaining-api-requests))
|
|||
|
|
(funcall (or process-function #'sx-request-response-get-items)
|
|||
|
|
response)))))))
|
|||
|
|
|
|||
|
|
(defun sx-request-fallback (_method &optional _args _request-method _process-function)
|
|||
|
|
"Fallback method when authentication is not available.
|
|||
|
|
This is for UI generation when the associated API call would
|
|||
|
|
require authentication.
|
|||
|
|
|
|||
|
|
Currently returns nil."
|
|||
|
|
'(()))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Our own generated data
|
|||
|
|
(defconst sx-request--data-url-format
|
|||
|
|
"https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el"
|
|||
|
|
"Url of the \"data\" directory inside the SX `data' branch.")
|
|||
|
|
|
|||
|
|
(defun sx-request--read-buffer-data ()
|
|||
|
|
"Return the buffer contents after any url headers.
|
|||
|
|
Error if url headers are absent or if they indicate something
|
|||
|
|
went wrong."
|
|||
|
|
(goto-char (point-min))
|
|||
|
|
(unless (string-match "200" (thing-at-point 'line))
|
|||
|
|
(error "Page not found."))
|
|||
|
|
(if (not (search-forward "\n\n" nil t))
|
|||
|
|
(error "Headers missing; response corrupt")
|
|||
|
|
(prog1 (buffer-substring (point) (point-max))
|
|||
|
|
(kill-buffer (current-buffer)))))
|
|||
|
|
|
|||
|
|
(defun sx-request-get-url (url &optional callback)
|
|||
|
|
"Fetch and return data stored online at URL.
|
|||
|
|
If CALLBACK is nil, fetching is done synchronously and the
|
|||
|
|
data (buffer contents sans headers) is returned as a string.
|
|||
|
|
|
|||
|
|
Otherwise CALLBACK must be a function of a single argument. Then
|
|||
|
|
`url-retrieve' is called asynchronously and CALLBACK is passed
|
|||
|
|
the retrieved data."
|
|||
|
|
(let* ((url-automatic-caching t)
|
|||
|
|
(url-inhibit-uncompression t)
|
|||
|
|
(url-request-method "GET")
|
|||
|
|
(url-request-extra-headers
|
|||
|
|
'(("Content-Type" . "application/x-www-form-urlencoded")))
|
|||
|
|
(callback-internal
|
|||
|
|
(when callback
|
|||
|
|
;; @TODO: Error check in STATUS.
|
|||
|
|
(lambda (_status)
|
|||
|
|
(funcall callback (sx-request--read-buffer-data)))))
|
|||
|
|
(response-buffer
|
|||
|
|
(if callback (url-retrieve url callback-internal nil 'silent)
|
|||
|
|
(url-retrieve-synchronously url))))
|
|||
|
|
(unless callback
|
|||
|
|
(if (not response-buffer)
|
|||
|
|
(error "Something went wrong in `url-retrieve-synchronously'")
|
|||
|
|
(with-current-buffer response-buffer
|
|||
|
|
(sx-request--read-buffer-data))))))
|
|||
|
|
|
|||
|
|
(defun sx-request-get-data (file)
|
|||
|
|
"Fetch and return data stored online by SX.
|
|||
|
|
FILE is a string or symbol, the name of the file which holds the
|
|||
|
|
desired data, relative to `sx-request--data-url-format'. For
|
|||
|
|
instance, `tags/emacs' returns the list of tags on Emacs.SE."
|
|||
|
|
(read (sx-request-get-url
|
|||
|
|
(format sx-request--data-url-format file))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Support Functions
|
|||
|
|
(defun sx-request--build-keyword-arguments (alist &optional kv-sep)
|
|||
|
|
"Format ALIST as a key-value list joined with KV-SEP.
|
|||
|
|
If authentication is needed, include it also or error if it is
|
|||
|
|
not available.
|
|||
|
|
|
|||
|
|
Build a \"key=value&key=value&...\"-style string with the elements
|
|||
|
|
of ALIST. If any value in the alist is nil, that pair will not
|
|||
|
|
be included in the return. If you wish to pass a notion of
|
|||
|
|
false, use the symbol `false'. Each element is processed with
|
|||
|
|
`sx--thing-as-string'."
|
|||
|
|
;; Add API key to list of arguments, this allows for increased quota
|
|||
|
|
;; automatically.
|
|||
|
|
(let ((api-key (cons "key" sx-request-api-key))
|
|||
|
|
(auth (car (sx-cache-get 'auth))))
|
|||
|
|
(push api-key alist)
|
|||
|
|
(when auth
|
|||
|
|
(push auth alist))
|
|||
|
|
(mapconcat
|
|||
|
|
(lambda (pair)
|
|||
|
|
(concat
|
|||
|
|
(sx--thing-as-string (car pair))
|
|||
|
|
"="
|
|||
|
|
(sx--thing-as-string (cdr pair) kv-sep t)))
|
|||
|
|
(delq nil (mapcar
|
|||
|
|
(lambda (pair)
|
|||
|
|
(when (cdr pair) pair))
|
|||
|
|
alist))
|
|||
|
|
"&")))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Response Processors
|
|||
|
|
(defun sx-request-response-get-items (response)
|
|||
|
|
"Returns the items from RESPONSE."
|
|||
|
|
(sx-assoc-let response
|
|||
|
|
(sx-encoding-clean-content-deep .items)))
|
|||
|
|
|
|||
|
|
(defun sx-request-all-stop-when-no-more (response)
|
|||
|
|
(or (not response)
|
|||
|
|
(not (cdr (assoc 'has_more response)))))
|
|||
|
|
|
|||
|
|
(provide 'sx-request)
|
|||
|
|
;;; sx-request.el ends here
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; indent-tabs-mode: nil
|
|||
|
|
;; End:
|