;;; fedi-http.el --- HTTP request/response functions  -*- lexical-binding: t -*-

;; Copyright (C) 2020-2023 Marty Hiatt and mastodon.el authors
;; Author: Marty Hiatt <martianh@disroot.org>
;; Homepage: https://codeberg.org/martianh/fedi.el

;; This file is not part of GNU Emacs.

;; This file is part of fedi.el

;; fedi-http.el 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.

;; fedi.el 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 fedi.el.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; fed-http.el provides HTTP request/response convenience functions.

;; All request functions aim to have regular arguments: a URL, a parameters
;; alist, optional headers if appropriate, callback if async, etc.

;; There are also helpfer functions for constructing query parameters and
;; array parameter lists.

;; Code from mastodon-http.el, see its boilerplate for authorship, etc.

;;; Code:

(require 'json)
;; (require 'request) ; for attachments upload
(require 'url)
(require 'url-http)
(defvar url-http-response-status)
(defvar url-http-end-of-headers)

(autoload 'shr-render-buffer "shr")
(autoload 'fedi-auth--access-token "fedi-auth")
(autoload 'fedi-toot--update-status-fields "fedi-toot")

;; (defvar fedi-toot--media-attachment-ids)
;; (defvar fedi-toot--media-attachment-filenames)

(defvar fedi-instance-url)
(defvar fedi-http--api-version "v1")

(defconst fedi-http--timeout 15
  "HTTP request timeout, in seconds.  Has no effect on Emacs < 26.1.")

;; via https://github.com/SqrtMinusOne/reverso.el, thanks Korytov Pavel!
;; to set a user-agent var for your package:
;; (defvar lem-user-agent
;;   (nth (random (length fedi-user-agents))
;;        fedi-user-agents)
;;   "User-Agent to use for requests.")
(defconst fedi-user-agents
  '("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
    "Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
    "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:103.0) Gecko/20100101 Firefox/103.0"
    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
    "Mozilla/5.0 (Windows NT 10.0; rv:103.0) Gecko/20100101 Firefox/103.0"
    "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.6 Safari/605.1.15"
    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:103.0) Gecko/20100101 Firefox/103.0")
  "User-Agents to use for requests.
A random one is picked at package initialization.")

;;; UTILS

(defun fedi-http--api (endpoint &optional url ver-str no-slash)
  "Return Fedi API URL for ENDPOINT."
  ;; FIXME: maybe we check first char of ENDPOINT and only add a slash if
  ;; it doesn't have one? that way we are agnostic, and never add double
  ;; slashes:
  (concat (or url fedi-instance-url) "/api/"
          (or ver-str fedi-http--api-version)
          (unless no-slash "/") endpoint))

(defun fedi-http--render-html-err (string)
  "Render STRING as HTML in a temp buffer.
STRING should be HTML for a 404 or 429 etc. errror."
  (with-temp-buffer
    (insert string)
    (shr-render-buffer (current-buffer))
    (view-mode) ;; for 'q' to kill buffer and window
    (user-error "HTML response")))

(defun fedi-http--read-file-as-string (filename)
  "Read a file FILENAME as a string. Used to generate image preview."
  (with-temp-buffer
    (insert-file-contents filename)
    (string-to-unibyte (buffer-string))))

(defun fedi-http--url-retrieve-synchronously (url &optional silent)
  "Retrieve URL asynchronously.
This is a thin abstraction over the system
`url-retrieve-synchronously'.  Depending on which version of this
is available we will call it with or without a timeout.
SILENT means don't message."
  (if (< (cdr (func-arity 'url-retrieve-synchronously)) 4)
      (url-retrieve-synchronously url)
    (url-retrieve-synchronously url (or silent nil) nil fedi-http--timeout)))

;;; PARAMS

(defun fedi-http--build-params-string (params)
  "Build a request parameters string from parameters alist PARAMS."
  ;; (url-build-query-string args nil))
  ;; url-build-query-string adds 'nil' for empty params so lets stick with our
  ;; own:
  (mapconcat (lambda (p)
               (concat (url-hexify-string (car p))
                       "=" (url-hexify-string (cdr p))))
             params "&"))

(defun fedi-http--build-array-params-alist (param-str array)
  "Return parameters alist using PARAM-STR and ARRAY param values.
Used for API form data parameters that take an array."
  (cl-loop for x in array
           collect (cons param-str x)))

(defun fedi-http--concat-params-to-url (url params)
  "Build a query string with PARAMS and concat to URL."
  (if params
      (concat url "?"
              (fedi-http--build-params-string params))
    url))

;;; BASIC REQUESTS

(defun fedi-http--get (url &optional params silent)
  "Make synchronous GET request to URL.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message."
  (let ((url (fedi-http--concat-params-to-url url params)))
    (condition-case err
        (fedi-http--url-retrieve-synchronously url silent)
      (t (error "I am Error. Request borked. %s"
                (error-message-string err))))))

(defun fedi-http--get-json (url &optional params silent vector)
  "Return only JSON data from URL request.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message.
VECTOR means return json arrays as vectors."
  (car (fedi-http--get-response url params :no-headers silent vector)))

(defun fedi-http--post (url &optional params headers json silent)
  "POST synchronously to URL, optionally with PARAMS and HEADERS.
JSON means we are posting a JSON payload, so we add headers and
json-string PARAMS."
  (let* ((url-request-method "POST")
         (url-request-data
          (when params
            (if json
                (encode-coding-string
                 (json-encode params) 'utf-8)
              (fedi-http--build-params-string params))))
         ;; TODO: perhaps leave these headers to the package now that
         ;; `fedi-request' takes header args?
         (headers (if json
                      (append headers
                              '(("Content-Type" . "application/json")
                                ("Accept" . "application/json")))
                    '(("Content-Type" . "application/x-www-form-urlencoded"))))
         (url-request-extra-headers
          (if (not url-request-extra-headers)
              headers ;; no need to add anything
            (append headers  url-request-extra-headers))))
    (with-temp-buffer
      (fedi-http--url-retrieve-synchronously url silent))))

(defun fedi-http--delete (url &optional params json)
  "Make DELETE request to URL.
PARAMS is an alist of any extra parameters to send with the request.
If JSON, encode PARAMS as JSON."
  ;; url-request-data only works with POST requests?
  (let ((url-request-method "DELETE")
        (url-request-data
         (when params
           (if json
               (encode-coding-string
                (json-encode params) 'utf-8)
             (fedi-http--build-params-string params)))))
    ;; (url (fedi-http--concat-params-to-url url params)))
    (with-temp-buffer
      (fedi-http--url-retrieve-synchronously url))))

(defun fedi-http--put (url &optional params headers json)
  "Make PUT request to URL.
PARAMS is an alist of any extra parameters to send with the request.
HEADERS is an alist of any extra headers to send with the request.
If JSON, encode params as JSON."
  (let* ((url-request-method "PUT")
         (url-request-data
          (when params
            (if json
                (encode-coding-string
                 (json-encode params) 'utf-8)
              (fedi-http--build-params-string params))))
         (headers (when json
                    (append headers
                            '(("Content-Type" . "application/json")
                              ("Accept" . "application/json")))))
         (url-request-extra-headers
          (append url-request-extra-headers ; auth set in macro
                  headers)))
    (with-temp-buffer
      (fedi-http--url-retrieve-synchronously url))))

(defun fedi-http--patch-json (url &optional params json)
  "Make synchronous PATCH request to URL. Return JSON response.
Optionally specify the PARAMS to send."
  (with-current-buffer (fedi-http--patch url params json)
    (fedi-http--process-json)))

(defun fedi-http--patch (url &optional params json)
  "Make synchronous PATCH request to URL.
Optionally specify the PARAMS to send.
If JSON, encode request data as JSON."
  ;; NB: unless JSON arg, we use query params and do not set
  ;; `url-request-data'.
  (let* ((url-request-method "PATCH")
         (url-request-data
          (when (and params json)
            (encode-coding-string
             (json-encode params) 'utf-8)))
         (url (if (not json)
                  (fedi-http--concat-params-to-url url params)
                url))
         (headers (when json
                    '(("Content-Type" . "application/json")
                      ("Accept" . "application/json"))))
         (url-request-extra-headers
          (append url-request-extra-headers headers)))
    (fedi-http--url-retrieve-synchronously url)))

;;; RESPONSES

(defun fedi-http--triage (response success &optional error-fun)
  "Determine if RESPONSE was successful.
If successful, call SUCCESS with single arg RESPONSE.
If unsuccessful, message status and JSON error from RESPONSE.
Optionally, provide an ERROR-FUN, called on the process JSON response,
to returnany error message needed."
  (let ((status (condition-case _err
                    (with-current-buffer response
                      (url-http-parse-response))
                  (wrong-type-argument
                   (user-error "Failed to check http response code")))))
    (cond ((and (>= status 200)
                (<= status 299))
           (funcall success response))
          ((= 404 status)
           (message "Error %s: page not found" status))
          (t
           (let ((json-response (with-current-buffer response
                                  (fedi-http--process-json))))
             (user-error "Error %s: %s" status
                         (or (when error-fun
                               (funcall error-fun json-response))
                             (alist-get 'error json-response)
                             (alist-get 'message json-response))))))))

(defun fedi-http--get-response (url &optional params no-headers silent vector)
  "Make synchronous GET request to URL.
Return JSON and response headers.
PARAMS is an alist of any extra parameters to send with the request.
SILENT means don't message.
NO-HEADERS means don't collect http response headers.
VECTOR means return json arrays as vectors."
  ;; some APIs return nil if no data, so we can't just error
  ;; Really? but then the `with-current-buffer' call would error!
  ;; (condition-case err
  (let ((buf (fedi-http--get url params silent)))
    (if (not buf)
        (user-error "No response. Server borked?"))
    (with-current-buffer buf
      (fedi-http--process-response no-headers vector))))
;; (t (error "I am Error. Looks like server borked"))))

(defun fedi-http--process-json ()
  "Return only JSON data from async URL request.
Callback to `fedi-http--get-json-async', usually
`fedi-tl--init*', is run on the result."
  (car (fedi-http--process-response :no-headers)))

(defun fedi-http--process-response (&optional no-headers vector)
  "Process http response.
Return a cons of JSON list and http response headers.
If response is HTML, it's likely an error so render it with shr.
If NO-HEADERS is non-nil, just return the JSON.
VECTOR means return json arrays as vectors.
Callback to `fedi-http--get-response-async'."
  ;; view raw response:
  ;; (switch-to-buffer (current-buffer))
  (let ((headers (unless no-headers
                   (fedi-http--process-headers)))
        (status url-http-response-status))
    (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)
      (cond ((or (eq status 204)
                 (string-empty-p json-string) (null json-string)
                 (string= "\nnull\n" json-string))
             nil)
            ;; if we get html, just render it and error:
            ;; ideally we should handle the status code in here rather than
            ;; this crappy hack?
            ((string-prefix-p "\n<" json-string) ; html hack
             (fedi-http--render-html-err json-string))
            ;; if no json or html, maybe we have a plain string error message
            ;; (misskey does this, but there are probably better ways to do
            ;; this):
            ((not (or (string-prefix-p "\n{" json-string)
                      (string-prefix-p "\n[" json-string)))
             (error "%s" json-string))
            (t
             `(,(json-read-from-string json-string) . ,headers))))))

(defun fedi-http--process-headers ()
  "Return an alist of http response headers."
  ;; (switch-to-buffer (current-buffer))
  (goto-char (point-min))
  (let* ((head-str (buffer-substring-no-properties
                    (point-min)
                    (- url-http-end-of-headers 1)))
         (head-list (split-string head-str "\n")))
    (cons
     (cons 'status url-http-response-status)
     (mapcar (lambda (x)
               (let ((sep (string-search ": " x)))
                 (cons (substring x 0 sep) (substring x (+ 2 sep)))))
             (cdr head-list)))))


;;; ASYNCHRONOUS FUNCTIONS

(defun fedi-http--get-async (url &optional params callback &rest cbargs)
  "Make GET request to URL.
Pass response buffer to CALLBACK function with args CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
  (let ((url (fedi-http--concat-params-to-url url params)))
    (url-retrieve url callback cbargs)))

(defun fedi-http--get-response-async (url &optional params callback &rest cbargs)
  "Make GET request to URL. Call CALLBACK with http response and CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
  (fedi-http--get-async
   url
   params
   (lambda (status)
     (when status ; for flakey servers
       (apply callback (fedi-http--process-response) cbargs)))))

(defun fedi-http--get-json-async (url &optional params callback &rest cbargs)
  "Make GET request to URL. Call CALLBACK with json-list and CBARGS.
PARAMS is an alist of any extra parameters to send with the request."
  (fedi-http--get-async
   url
   params
   (lambda (status)
     (when status ;; only when we actually get sth?
       (apply callback (fedi-http--process-json) cbargs)))))

(defun fedi-http--post-async (url params _headers
                                  &optional callback &rest cbargs)
  "POST asynchronously to URL with PARAMS and HEADERS.
Then run function CALLBACK with arguements CBARGS."
  (let (;(request-timeout 5)
        (url-request-method "POST")
        (url-request-data (when params
                            (fedi-http--build-params-string params))))
    (with-temp-buffer
      (url-retrieve url callback cbargs))))

;;; BASIC AUTH REQUEST

(defun fedi-http--basic-auth-request (req-fun url user
                                              &optional pwd &rest args)
  "Do a BasicAuth request.
Call REQ-FUN, a request function, on URL, providing USER and password
PWD.
ARGS is any addition arguments for REQ-FUN, after the URL.
REQ-FUN can be a fedi.el request function such as `fedi-http--post'."
  (let* ((pwd (or pwd (read-passwd (format "Password: "))))
         (auth (base64-encode-string
                (format "%s:%s" user pwd)))
         (url-request-extra-headers
          (list (cons "Authorization"
                      (format "Basic %s" auth)))))
    (apply req-fun url args)))

;; ;; TODO: test for curl first?
;; (defun fedi-http--post-media-attachment (url filename caption)
;;   "Make POST request to upload FILENAME with CAPTION to the server's media URL.
;; The upload is asynchronous. On succeeding,
;; `fedi-toot--media-attachment-ids' is set to the id(s) of the
;; item uploaded, and `fedi-toot--update-status-fields' is run."
;;   (let* ((file (file-name-nondirectory filename))
;;          (request-backend 'curl))
;;     (request
;;       url
;;       :type "POST"
;;       :params `(("description" . ,caption))
;;       :files `(("file" . (,file :file ,filename
;;                                 :mime-type "multipart/form-data")))
;;       :parser 'json-read
;;       :headers `(("Authorization" . ,(concat "Bearer "
;;                                              (fedi-auth--access-token))))
;;       :sync nil
;;       :success (cl-function
;;                 (lambda (&key data &allow-other-keys)
;;                   (when data
;;                     (push (alist-get 'id data)
;;                           fedi-toot--media-attachment-ids) ; add ID to list
;;                     (message "%s file %s with id %S and caption '%s' uploaded!"
;;                              (capitalize (alist-get 'type data))
;;                              file
;;                              (alist-get 'id data)
;;                              (alist-get 'description data))
;;                     (fedi-toot--update-status-fields))))
;;       :error (cl-function
;;               (lambda (&key error-thrown &allow-other-keys)
;;                 (cond
;;                  ;; handle curl errors first (eg 26, can't read file/path)
;;                  ;; because the '=' test below fails for them
;;                  ;; they have the form (error . error message 24)
;;                  ((not (proper-list-p error-thrown)) ; not dotted list
;; 		  (message "Got error: %s. Shit went south." (cdr error-thrown)))
;;                  ;; handle fedi api errors
;;                  ;; they have the form (error http 401)
;; 		 ((= (car (last error-thrown)) 401)
;;                   (message "Got error: %s Unauthorized: The access token is invalid"
;;                            error-thrown))
;;                  ((= (car (last error-thrown)) 422)
;;                   (message "Got error: %s Unprocessable entity: file or file\
;;  type is unsupported or invalid"
;;                            error-thrown))
;;                  (t
;;                   (message "Got error: %s Shit went south"
;;                            error-thrown))))))))

(provide 'fedi-http)
;;; fedi-http.el ends here
