diff options
-rw-r--r-- | sx-auth.el | 89 | ||||
-rw-r--r-- | sx-favorites.el | 8 | ||||
-rw-r--r-- | sx-method.el | 70 | ||||
-rw-r--r-- | sx-networks.el | 9 | ||||
-rw-r--r-- | sx-question.el | 21 | ||||
-rw-r--r-- | sx-request.el | 71 | ||||
-rw-r--r-- | sx-site.el | 6 | ||||
-rw-r--r-- | test/tests.el | 1 |
8 files changed, 197 insertions, 78 deletions
@@ -38,6 +38,45 @@ This is needed to use your account to write questions, make comments, and read your inbox. Do not alter this unless you know what you are doing!") +(defvar sx-auth-method-auth '((me . t) + (inbox . t) + (notifications . t) + (events . t) + (posts (comments add)) + (comments delete + edit + flags + upvote) + (answers accept + delete + downvote + edit + flags + upvote) + (questions answers + add + close + delete + downvote + edit + favorite + flags + render + upvote + (unanswered my-tags))) + "List of methods that require auth. +Methods are of form (METHOD SUBMETHODS) where SUBMETHODS + is (METHOD METHOD METHOD ...). + +If all SUBMETHODS require auth or there are no submethods, form +will be (METHOD . t)") + +(defvar sx-auth-filter-auth '(question.upvoted + question.downvoted) + "List of filter types that require auth. +Keywords are of form (OBJECT TYPES) where TYPES is (FILTER FILTER +FILTER).") + (defun sx-auth-authenticate () "Authenticate this application. Authentication is required to read your personal data (such as @@ -85,6 +124,56 @@ parsed and displayed prominently on the page)." (defalias 'sx-authenticate #'sx-auth-authenticate) +(defun sx-auth--method-p (method &optional submethod) + "Check if METHOD is one that may require authentication. +If it has `auth-required' SUBMETHODs, or no submethod, return t." + (let ((method-auth (cdr (assoc method sx-auth-method-auth))) + ;; If the submethod has additional options, they may all be + ;; eligible, in which case we only need to check the `car'. + (sub-head (if (listp submethod) + (car submethod)))) + (lwarn " sx-auth method" :debug "Method %s requires auth" method-auth) + (and method-auth + (or + ;; All submethods require auth. + (eq t method-auth) + ;; All sub-submethods require auth. + (member sub-head method-auth) + ;; Specific submethod requires auth. + (member submethod method-auth))))) + +;; Temporary solution. When we switch to pre-defined filters we will +;; have to change the logic to match against specific filters. +(defun sx-auth--filter-p (filter) + "Check if FILTER contains properties that require authentication. +If it has `auth-required' properties, return a filter that has +removed those properties." + (let* ((incl-filter (if (listp filter) (car filter))) + (rest-filter (if incl-filter (cdr filter))) + (auth-filters (cl-remove-if #'nil + ;; Only retrieve the elements that + ;; are issues. + (mapcar (lambda (prop) + (car + (member prop + sx-auth-filter-auth))) + (or incl-filter filter)))) + clean-filter out-filter) + (lwarn "sx-auth filter" :debug "Filter: %S" filter) + ;; Auth-filters is the filters that are issues + (when auth-filters + (setq clean-filter + (cl-remove-if (lambda (prop) + (member prop auth-filters)) + (or incl-filter filter)))) + (if (and incl-filter clean-filter) + (setq out-filter + (cons clean-filter rest-filter)) + (setq out-filter clean-filter)) + (lwarn "sx-auth filter2" :debug "Filter property %s requires auth. %S" + auth-filters out-filter) + out-filter)) + (provide 'sx-auth) ;;; sx-auth.el ends here diff --git a/sx-favorites.el b/sx-favorites.el index 71079fb..c00d262 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -51,10 +51,10 @@ Added as hook to initialization." (defun sx-favorites--retrieve-favorites (site) "Obtain list of starred QUESTION_IDs for SITE." - (sx-method-call (format "me/favorites?site=%s" site) - nil - sx-favorite-list-filter - 'warn)) + (sx-method-call 'me + :submethod (format "favorites?site=%s" site) + :filter sx-favorite-list-filter + :auth t)) (defun sx-favorites--update-site-favorites (site) "Update list of starred QUESTION_IDs for SITE. diff --git a/sx-method.el b/sx-method.el index 8909a2b..c5764cd 100644 --- a/sx-method.el +++ b/sx-method.el @@ -28,26 +28,66 @@ (require 'json) (require 'url) (require 'sx) +(require 'sx-auth) (require 'sx-request) (require 'sx-filter) -(defun sx-method-call - (method &optional keyword-arguments filter need-auth use-post) - "Call METHOD with KEYWORD-ARGUMENTS using FILTER. -This is a high-level wrapper for `sx-request-make'. +(cl-defun sx-method-call (method &key id + submethod + keywords + (filter 'none) + auth + (url-method "GET") + site) + "Call METHOD with additional keys. -If NEED-AUTH is non-nil, an auth-token is required. If 'WARN, -warn the user `(user-error ...)' if they do not have an AUTH -token set. +:ID is the id associated with a question, answer, comment, post or +user. +:SUBMETHOD is the additional segments of the method. +:KEYWORDS are the api parameters. +:FILTER is the set of filters to control the returned information +:AUTH defines how to act if the method or filters require +authentication. +:URL-METHOD is either \"POST\" or \"GET\" +:SITE is the api parameter specifying the site. -If USE-POST is non-nil, use `POST' rather than `GET' for passing -arguments. - -Return the response content as a complex alist." - (sx-request-make method - (cons (cons 'filter (sx-filter-get-var filter)) - keyword-arguments) - need-auth use-post)) +Return the entire response as a complex alist." + (let ((access-token (sx-cache-get 'auth)) + (method-auth (sx-auth--method-p method submethod)) + (filter-auth (sx-auth--filter-p filter)) + (full-method (concat (format "%s" method) + (when id + (format "/%s" id)) + (when submethod + (format "/%s" submethod)))) + (call 'sx-request-make)) + (lwarn "sx-call-method" :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth) + access-token method-auth full-method filter-auth) + (unless access-token + (cond + ;; 1. Need auth and warn user (interactive use) + ((and method-auth (equal 'warn auth)) + (user-error + "This request requires authentication. Please run `M-x sx-auth-authenticate' and try again.")) + ;; 2. Need auth to populate UI, cannot provide subset + ((and method-auth auth) + (setq call 'sx-request-fallback)) + ;; 3. Need auth for type. Use auth-less filter. + ((and filter-auth auth) + (setq filter filter-auth)) + ;; 4. Requires auth but no value set for auth + ((and (or filter-auth method-auth) (not auth)) + (error "This request requires authentication.")))) + ;; Concatenate all parameters now that filter is ensured. + (setq parameters + (cons `(site . ,site) + (cons (cons 'filter + (sx-filter-get-var filter)) + keywords))) + (funcall call + full-method + parameters + url-method))) (provide 'sx-method) ;;; sx-method.el ends here diff --git a/sx-networks.el b/sx-networks.el index 6820e11..f5aa9f5 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -63,10 +63,11 @@ If cache is not available, retrieve current data." Sets cache and then uses `sx-network--get-associated' to update the variables." (sx-cache-set 'network-user - (sx-method-call "me/associated" - '((types . (main_site meta_site))) - sx-network--user-filter - 'warn)) + (sx-method-call 'me + :submethod 'associated + :keywords '((types . (main_site meta_site))) + :filter sx-network--user-filter + :auth t)) (sx-network--get-associated)) (defun sx-network--initialize () diff --git a/sx-question.el b/sx-question.el index f6b7beb..c02cf62 100644 --- a/sx-question.el +++ b/sx-question.el @@ -33,6 +33,8 @@ question.last_editor question.accepted_answer_id question.link + question.upvoted + question.downvoted user.display_name comment.owner comment.body_markdown @@ -55,19 +57,20 @@ property. `sx-method-call' is used with `sx-question-browse-filter'." (mapcar (lambda (question) (cons (cons 'site site) question)) - (sx-method-call - "questions" - `((site . ,site) - (page . ,page)) - sx-question-browse-filter))) + (sx-method-call 'questions + :keywords `((page . ,page)) + :site site + :auth t + :filter sx-question-browse-filter))) (defun sx-question-get-question (site question-id) "Query SITE for a QUESTION-ID and return it. If QUESTION-ID doesn't exist on SITE, raise an error." - (let ((res (sx-method-call - (format "questions/%s" question-id) - `((site . ,site)) - sx-question-browse-filter))) + (let ((res (sx-method-call 'questions + :id id + :site site + :auth t + :filter sx-question-browse-filter))) (if (vectorp res) (elt res 0) (error "Couldn't find question %S in %S" diff --git a/sx-request.el b/sx-request.el index 906785b..c667978 100644 --- a/sx-request.el +++ b/sx-request.el @@ -92,19 +92,17 @@ number of requests left every time it finishes a call." ;;; Making Requests (defun sx-request-make - (method &optional args need-auth use-post) "Make a request to the API, executing METHOD with ARGS. You should almost certainly be using `sx-method-call' instead of -this function. - -If NEED-AUTH is non-nil, authentication will be provided. If -USE-POST is non-nil, the request will use POST instead of GET. +this function. REQUEST-METHOD is one of `GET' (default) or `POST'. Returns cleaned response content. See (`sx-encoding-clean-content-deep'). -The full call is built with `sx-request-build', prepending -`sx-request-api-key' to receive a higher quota. This call is +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 @@ -115,16 +113,16 @@ then read with `json-read-from-string'. `sx-request-remaining-api-requests' is updated appropriately and the main content of the response is returned." - (let ((url-automatic-caching t) - (url-inhibit-uncompression t) - (request-method (if use-post "POST" "GET")) - (request-args - (sx-request--build-keyword-arguments args nil need-auth)) - (request-url (concat sx-request-api-root method))) - (sx-message "Request: %S" request-url) - (let ((response-buffer (sx-request--request request-url - request-args - request-method))) + (method &optional args request-method) + (let* ((url-automatic-caching sx-request-cache-p) + (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 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 @@ -158,19 +156,18 @@ the main content of the response is returned." sx-request-remaining-api-requests-message-threshold) (sx-message "%d API requests reamining" sx-request-remaining-api-requests)) - (sx-encoding-clean-content-deep .items)))))))) + (sx-encoding-clean-content-deep .items))))))) - -;;; Support Functions +(defun sx-request-fallback (method &optional args request-method) + "Fallback method when authentication is not available. +This is for UI generation when the associated API call would +require authentication. -(defun sx-request--request (url args method) - "Return the response buffer for URL with ARGS using METHOD." - (let ((url-request-method method) - (url-request-extra-headers - '(("Content-Type" . "application/x-www-form-urlencoded"))) - (url-request-data args)) - (url-retrieve-synchronously url))) +Currently returns nil." + '(())) + +;;; Support Functions (defun sx-request--build-keyword-arguments (alist &optional kv-sep need-auth) @@ -187,23 +184,11 @@ 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* ((warn (equal need-auth 'warn)) - (api-key (cons "key" sx-request-api-key)) - (auth - (let ((auth (car (sx-cache-get 'auth)))) - (cond - (auth) - ;; Pass user error when asking to warn - (warn - (user-error - "This query requires authentication; run `M-x sx-auth-authenticate' and try again")) - ((not auth) - (lwarn "stack-mode" :debug - "This query requires authentication") - nil))))) + (let ((api-key (cons "key" sx-request-api-key)) + (auth (car (sx-cache-get 'auth)))) (push api-key alist) - (if (and need-auth auth) - (push auth alist)) + (when auth + (push auth alist)) (mapconcat (lambda (pair) (concat @@ -48,9 +48,9 @@ "Return all sites with `sx-site-browse-filter'." (sx-cache-get 'site-list - '(sx-method-call - "sites" '((pagesize . 999)) - sx-site-browse-filter))) + '(sx-method-call 'sites + :keywords '((pagesize . 999)) + :filter sx-site-browse-filter))) (defcustom sx-site-favorites nil diff --git a/test/tests.el b/test/tests.el index bb23310..c76e137 100644 --- a/test/tests.el +++ b/test/tests.el @@ -29,6 +29,7 @@ (should (string-match ,regexp line)))) (setq + sx-initialized t sx-request-remaining-api-requests-message-threshold 50000 debug-on-error t user-emacs-directory "." |