mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 12:31:25 +00:00
* lisp/emacs-lisp/rest.el: Finish renaming
This commit is contained in:
Artur Malabarba
parent
ea333933f2
commit
be74f6a7cf
1 changed files with 115 additions and 129 deletions
|
|
@ -1,6 +1,6 @@
|
|||
;;; api.el --- library for interacting with restful web APIs -*- lexical-binding: t; -*-
|
||||
;;; rest.el --- library for interacting with restful web APIs -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015 Artur Malabarba
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
|
||||
;; Keywords: comm
|
||||
|
|
@ -28,7 +28,7 @@
|
|||
|
||||
|
||||
;;; Error reporting
|
||||
(defun api-report-buffer ()
|
||||
(defun rest-report-buffer ()
|
||||
"Write TEXT to the *Api Server* buffer."
|
||||
(let ((text (buffer-string)))
|
||||
(with-current-buffer (get-buffer-create "*Api Report*")
|
||||
|
|
@ -37,42 +37,42 @@
|
|||
(insert text))
|
||||
(goto-char (point-min)))))
|
||||
|
||||
(define-error 'api-error "Unkown api error, see \"*Api Report*\" buffer")
|
||||
(define-error 'api-page-does-not-exist
|
||||
(define-error 'rest-error "Unkown REST error, see \"*Api Report*\" buffer")
|
||||
(define-error 'rest-page-does-not-exist
|
||||
"This page doesn't seem to exist (see \"*Api Report*\" buffer), replied said"
|
||||
'api-error)
|
||||
(define-error 'api-empty-redirect
|
||||
'rest-error)
|
||||
(define-error 'rest-empty-redirect
|
||||
"Redirect received, but Location header not found! (see \"*Api Report*\" buffer)"
|
||||
'api-error)
|
||||
(define-error 'api-unintelligible-result
|
||||
'rest-error)
|
||||
(define-error 'rest-unintelligible-result
|
||||
"Tried contacting server, but I can't understand the reply. See \"*Api Report*\" buffer"
|
||||
'api-error)
|
||||
(define-error 'api-bad-request
|
||||
'rest-error)
|
||||
(define-error 'rest-bad-request
|
||||
"Server didn't understand my request, please you should probably file a bug report"
|
||||
'api-error)
|
||||
(define-error 'api-unauthorized
|
||||
'rest-error)
|
||||
(define-error 'rest-unauthorized
|
||||
"Server says you're not authenticated"
|
||||
'api-error)
|
||||
(define-error 'api-infinite-redirection-loop
|
||||
'rest-error)
|
||||
(define-error 'rest-infinite-redirection-loop
|
||||
"Server is sending us in a redirection loop"
|
||||
'api-error)
|
||||
(define-error 'api-server-error
|
||||
'rest-error)
|
||||
(define-error 'rest-server-error
|
||||
"Something bad happened on the server side, see \"*Api Report*\" buffer"
|
||||
'api-error)
|
||||
'rest-error)
|
||||
|
||||
(defun api-error (signal &rest args)
|
||||
(defun rest-error (signal &rest args)
|
||||
"Throw an error SIGNAL with ARGS.
|
||||
Also print contents of current buffer to *Api Report*."
|
||||
(declare (indent 1))
|
||||
(api-report-buffer)
|
||||
(rest-report-buffer)
|
||||
(signal signal args))
|
||||
|
||||
(defun api-parse-response-code (&optional is-auth)
|
||||
(defun rest-parse-response-code (&optional is-auth)
|
||||
"Non-nil if this reponse buffer looks ok.
|
||||
Leave point at the return code on the first line."
|
||||
(goto-char (point-min))
|
||||
(unless (search-forward-regexp "^HTTP/[.0-9]+ +" nil t)
|
||||
(api-error 'api-unintelligible-result))
|
||||
(rest-error 'rest-unintelligible-result))
|
||||
(pcase (thing-at-point 'number)
|
||||
((or 100 204) nil) ;; OK, but no content.
|
||||
((or 200 202 201 203) t) ;; OK, with content.
|
||||
|
|
@ -80,40 +80,31 @@ Leave point at the return code on the first line."
|
|||
((or 301 302 303 304 305 307)
|
||||
(if (search-forward-regexp "^Location: *\\([^\s\n\r\t]+\\)" nil 'noerror)
|
||||
(match-string 1)
|
||||
(api-error 'api-empty-redirect)))
|
||||
(rest-error 'rest-empty-redirect)))
|
||||
;; Client errors
|
||||
((or 403 404 405 410) (api-error 'api-page-does-not-exist
|
||||
(substring-no-properties (thing-at-point 'line) 0 -1)))
|
||||
((or 400 422 408 409 411 412 413 414 415 416 417) (api-error 'api-bad-request))
|
||||
((or 401 407) (api-error 'api-unauthorized
|
||||
(if is-auth "try creating a new token"
|
||||
"you probably need to configure a token")))
|
||||
((pred (<= 500)) (api-error 'api-server-error))
|
||||
(_ (api-error 'api-error
|
||||
(substring (thing-at-point 'line) 0 -1)))))
|
||||
((or 403 404 405 410) (rest-error 'rest-page-does-not-exist
|
||||
(substring-no-properties (thing-at-point 'line) 0 -1)))
|
||||
((or 400 422 408 409 411 412 413 414 415 416 417) (rest-error 'rest-bad-request))
|
||||
((or 401 407) (rest-error 'rest-unauthorized
|
||||
(if is-auth "try creating a new token"
|
||||
"you probably need to configure a token")))
|
||||
((pred (<= 500)) (rest-error 'rest-server-error))
|
||||
(_ (rest-error 'rest-error
|
||||
(substring (thing-at-point 'line) 0 -1)))))
|
||||
|
||||
|
||||
;;; Requests
|
||||
(autoload 'auth-source-search "auth-source")
|
||||
(cl-defmacro api--with-server-buffer (method url &rest body &key async unwind-form
|
||||
extra-headers &allow-other-keys)
|
||||
(cl-defmacro rest--with-response-buffer (method url &rest body &key async unwind-form
|
||||
extra-headers &allow-other-keys)
|
||||
"Run BODY in a Server request buffer.
|
||||
UNWIND-FORM is run no matter what, and doesn't affect the return
|
||||
value."
|
||||
(declare (indent 2)
|
||||
(debug t))
|
||||
(let ((call-name (make-symbol "callback"))
|
||||
(secret (make-symbol "secret")))
|
||||
(let ((call-name (make-symbol "callback")))
|
||||
(while (keywordp (car body))
|
||||
(setq body (cdr (cdr body))))
|
||||
`(let ((,secret (when ,auth
|
||||
(if (listp ,auth)
|
||||
(or (car-safe (apply #'auth-source-search
|
||||
:require '(:secret) :max 1
|
||||
,auth))
|
||||
(user-error "This request requires authentication"))
|
||||
(lambda () ,auth))))
|
||||
(,call-name (lambda (status)
|
||||
`(let ((,call-name (lambda (status)
|
||||
(unwind-protect
|
||||
(progn (when-let ((er (plist-get status :error)))
|
||||
(error "Error retrieving: %s %S" ,url er))
|
||||
|
|
@ -138,10 +129,10 @@ value."
|
|||
(with-current-buffer buffer
|
||||
(funcall ,call-name nil))))))))
|
||||
|
||||
(defvar-local api-root nil
|
||||
"Prepended to api method when a full url is not given.")
|
||||
(defvar-local rest-url-root nil
|
||||
"Prepended to REST url when a full url is not given.")
|
||||
|
||||
(defun api--headers-alist ()
|
||||
(defun rest--headers-alist ()
|
||||
"Return an alist of all headers above point."
|
||||
(let ((ac))
|
||||
(while (search-backward-regexp "^\\(X-[^ ]+\\): *\\(.*?\\)\r?$" nil 'noerror)
|
||||
|
|
@ -149,64 +140,59 @@ value."
|
|||
ac))
|
||||
ac))
|
||||
|
||||
(autoload 'json-read "json")
|
||||
|
||||
(defvar api--url-depth nil
|
||||
"Used to detect infinite redirection loops.")
|
||||
|
||||
|
||||
;;; Authentication
|
||||
(defun api--auth-source-search (url-obj)
|
||||
(autoload 'auth-source-search "auth-source")
|
||||
(defun rest--auth-source-search (url-obj)
|
||||
"Return authentication information for URL-OBJ.
|
||||
URL-OBJ is a value returned by `url-generic-parse-url'.
|
||||
Information is found by running `auth-source-search' with the
|
||||
properties of URL-OBJ."
|
||||
(let ((type (url-type url-obj))
|
||||
(port (url-port url-obj))
|
||||
(let ((port (url-port url-obj))
|
||||
(args (list :require '(:secret) :host (url-host url-obj)
|
||||
:max 1 :user (url-user url-obj))))
|
||||
(car (or (apply #'auth-source-search :port port :type type args)
|
||||
(apply #'auth-source-search :port port args)
|
||||
(car (or (apply #'auth-source-search :port port args)
|
||||
;; If URL does not specify a port, try again without the default.
|
||||
(unless (url-portspec url-obj)
|
||||
(or (apply #'auth-source-search :type type args)
|
||||
(apply #'auth-source-search args)))))))
|
||||
(or (apply #'auth-source-search args)))))))
|
||||
|
||||
(defun api--get-auth-info (info)
|
||||
(defun rest--get-auth-info (info)
|
||||
"Return a function that returns (USER . PASSWORD).
|
||||
INFO is a plist returned by `auth-source-search'."
|
||||
(let ((user (plist-get info :user))
|
||||
(pass (plist-get info :secret)))
|
||||
(lambda () (cons user (funcall pass)))))
|
||||
|
||||
(defun api--make-authorization-header (_plist user password)
|
||||
(defun rest--make-authorization-header (_plist user password)
|
||||
"Return an alist containing an \"Authorization\" header.
|
||||
The car of the list is nil, so this function can be used as the
|
||||
AUTH-METHOD in `api-action'."
|
||||
AUTH-METHOD in `rest-action'."
|
||||
`(nil . (("Authorization" . ,(concat "Basic "
|
||||
(base64-encode-string
|
||||
(concat user ":" password)))))))
|
||||
|
||||
|
||||
;;; The function
|
||||
(autoload 'json-read "json")
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun api-action (url &rest all-options
|
||||
&key auth
|
||||
(method :get)
|
||||
(reader #'json-read)
|
||||
(callback #'identity)
|
||||
async
|
||||
(max-pages 1)
|
||||
(next-page-rule '(header "Link"))
|
||||
extra-headers
|
||||
(auth-method (if auth #'api--make-authorization-header))
|
||||
(return :simple)
|
||||
-url-history)
|
||||
(cl-defun rest-action (url &rest all-options
|
||||
&key auth
|
||||
(method :get)
|
||||
(reader #'json-read)
|
||||
(callback #'identity)
|
||||
async
|
||||
(max-pages 1)
|
||||
(next-page-rule '(header "Link"))
|
||||
extra-headers
|
||||
(auth-method (if auth #'rest--make-authorization-header))
|
||||
(return :simple)
|
||||
-url-history)
|
||||
"Contact URL with METHOD.
|
||||
METHOD is a keyword of an http method, defaulting to :get.
|
||||
|
||||
URL can be a string such as \"user/starred?per_page=100\" to
|
||||
be appended at the end of `api-root'. It can also be a full url
|
||||
be appended at the end of `rest-url-root'. It can also be a full url
|
||||
string, in which case it is used verbatim.
|
||||
|
||||
READER is called as a function with no arguments, with point
|
||||
|
|
@ -245,7 +231,7 @@ replaces URL and the cdr is appended to EXTRA-HEADERS. It is
|
|||
called with a plist, the user string and the password string.
|
||||
The plist contais at least :url, :method, and :extra-headers.
|
||||
|
||||
`api-action' can also handle the pagination used in server
|
||||
`rest-action' can also handle the pagination used in server
|
||||
results by appending together the contents of each page. Use
|
||||
MAX-PAGES to increase the number of pages that are
|
||||
fetched (default 1).
|
||||
|
|
@ -263,25 +249,25 @@ values (string), as per `url-request-extra-headers'.
|
|||
|
||||
If the http request is unsuccessful, an error is signaled
|
||||
according to the reply. The possible errors are:
|
||||
`api-bad-request', `api-server-error', `api-unauthorized',
|
||||
`api-unintelligible-result', `api-empty-redirect',
|
||||
`api-page-does-not-exist', and `api-infinite-redirection-loop',
|
||||
all of which inherit from `api-error'.
|
||||
`rest-bad-request', `rest-server-error', `rest-unauthorized',
|
||||
`rest-unintelligible-result', `rest-empty-redirect',
|
||||
`rest-page-does-not-exist', and `rest-infinite-redirection-loop',
|
||||
all of which inherit from `rest-error'.
|
||||
|
||||
\(fn URL &key AUTH (METHOD :get) (READER #'json-read) CALLBACK ASYNC AUTH-METHOD (MAX-PAGES 1) NEXT-PAGE-RULE EXTRA-HEADERS RETURN)"
|
||||
(declare (indent 1))
|
||||
(unless (string-match "\\`https?://" url)
|
||||
(setq url (concat api-root url)))
|
||||
(setq url (concat rest-url-root url)))
|
||||
(when (member url -url-history)
|
||||
(signal 'api-infinite-redirection-loop (cons url api--url-depth)))
|
||||
(signal 'rest-infinite-redirection-loop (cons url -url-history)))
|
||||
(when auth
|
||||
(let ((href (url-generic-parse-url url)))
|
||||
(when (url-password href)
|
||||
(error "AUTH requested, but URL already contains a password"))
|
||||
(unless (functionp auth)
|
||||
(setq auth (api--get-auth-info (if (listp auth)
|
||||
(apply #'auth-source-search auth)
|
||||
(api--auth-source-search href)))))
|
||||
(setq auth (rest--get-auth-info (if (listp auth)
|
||||
(apply #'auth-source-search auth)
|
||||
(rest--auth-source-search href)))))
|
||||
(pcase-let* ((`(,user . ,pass) (funcall auth))
|
||||
(`(,new-url . ,headers)
|
||||
(funcall auth-method (list :url url :method method
|
||||
|
|
@ -289,47 +275,47 @@ all of which inherit from `api-error'.
|
|||
user pass)))
|
||||
(when new-url (setq url new-url))
|
||||
(setq extra-headers (append headers extra-headers)))))
|
||||
(api--with-server-buffer method url
|
||||
:extra-headers extra-headers
|
||||
:-url-depth (cons url -url-history)
|
||||
:async async
|
||||
(pcase (api-parse-response-code auth)
|
||||
(`nil nil)
|
||||
((and (pred stringp) link)
|
||||
(message "Redirected to %s" link)
|
||||
(apply #'api-action all-options))
|
||||
(`t
|
||||
(let ((next-page
|
||||
(when (pcase next-page-rule
|
||||
(`(header ,name) (search-forward-regexp
|
||||
(format "^%s: .*<\\([^>]+\\)>;" (regexp-quote name))
|
||||
nil t))
|
||||
(`(regexp ,rx) (search-forward-regexp rx nil t))
|
||||
(_ nil))
|
||||
(match-string-no-properties 1))))
|
||||
(goto-char (point-min))
|
||||
(search-forward-regexp "^\r?$")
|
||||
(let* ((data (unless (eobp) (funcall reader))))
|
||||
(if (or (not next-page)
|
||||
(< max-pages 2))
|
||||
(pcase return
|
||||
(:simple (funcall callback data))
|
||||
(:rich `(,(funcall callback data)
|
||||
(next-page . ,next-page)
|
||||
,@(api--headers-alist))))
|
||||
(api-action next-page
|
||||
:auth auth
|
||||
:method method
|
||||
:reader reader
|
||||
:next-page-rule next-page-rule
|
||||
:return return
|
||||
:async async
|
||||
:max-pages (1- max-pages)
|
||||
:callback (lambda (res)
|
||||
(funcall callback
|
||||
(if (listp res)
|
||||
(append data res)
|
||||
(vconcat data res))))))))))))
|
||||
(rest--with-response-buffer method url
|
||||
:extra-headers extra-headers
|
||||
:-url-depth (cons url -url-history)
|
||||
:async async
|
||||
(pcase (rest-parse-response-code auth)
|
||||
(`nil nil)
|
||||
((and (pred stringp) link)
|
||||
(message "Redirected to %s" link)
|
||||
(apply #'rest-action all-options))
|
||||
(`t
|
||||
(let ((next-page
|
||||
(when (pcase next-page-rule
|
||||
(`(header ,name) (search-forward-regexp
|
||||
(format "^%s: .*<\\([^>]+\\)>;" (regexp-quote name))
|
||||
nil t))
|
||||
(`(regexp ,rx) (search-forward-regexp rx nil t))
|
||||
(_ nil))
|
||||
(match-string-no-properties 1))))
|
||||
(goto-char (point-min))
|
||||
(search-forward-regexp "^\r?$")
|
||||
(let* ((data (unless (eobp) (funcall reader))))
|
||||
(if (or (not next-page)
|
||||
(< max-pages 2))
|
||||
(pcase return
|
||||
(:simple (funcall callback data))
|
||||
(:rich `(,(funcall callback data)
|
||||
(next-page . ,next-page)
|
||||
,@(rest--headers-alist))))
|
||||
(rest-action next-page
|
||||
:auth auth
|
||||
:method method
|
||||
:reader reader
|
||||
:next-page-rule next-page-rule
|
||||
:return return
|
||||
:async async
|
||||
:max-pages (1- max-pages)
|
||||
:callback (lambda (res)
|
||||
(funcall callback
|
||||
(if (listp res)
|
||||
(append data res)
|
||||
(vconcat data res))))))))))))
|
||||
|
||||
(provide 'api)
|
||||
;;; api.el ends here
|
||||
(provide 'rest)
|
||||
;;; rest.el ends here
|
||||
|
|
|
|||
Loading…
Reference in a new issue