;;; gptel-curl.el --- Curl support for GPTel -*- lexical-binding: t; -*- ;; Copyright (C) 2023 Karthik Chikmagalur ;; Author: Karthik Chikmagalur;; ;; Keywords: convenience ;; SPDX-License-Identifier: GPL-3.0-or-later ;; 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 . ;;; Commentary: ;; Curl support for GPTel. Utility functions. ;;; Code: (require 'gptel) (eval-when-compile (require 'subr-x)) (require 'map) (require 'json) (defvar gptel-curl--process-alist nil "Alist of active GPTel curl requests.") (defun gptel-curl--get-args (prompts token) "Produce list of arguments for calling Curl. PROMPTS is the data to send, TOKEN is a unique identifier." (let* ((args (list "--location" "--silent" "--compressed" "--disable")) (url "https://api.openai.com/v1/chat/completions") (data (encode-coding-string (json-encode (gptel--request-data prompts)) 'utf-8)) (headers `(("Content-Type" . "application/json") ("Authorization" . ,(concat "Bearer " (gptel--api-key)))))) (push (format "-X%s" "POST") args) (push (format "-w(%s . %%{size_header})" token) args) ;; (push (format "--keepalive-time %s" 240) args) (push (format "-m%s" 60) args) (push "-D-" args) (pcase-dolist (`(,key . ,val) headers) (push (format "-H%s: %s" key val) args)) (push (format "-d%s" data) args) (nreverse (cons url args)))) ;;TODO: The :transformer argument here is an alternate implementation of ;;`gptel-response-filter-functions'. The two need to be unified. ;;;###autoload (defun gptel-curl-get-response (info &optional callback) "Retrieve response to prompt in INFO. INFO is a plist with the following keys: - :prompt (the prompt being sent) - :buffer (the gptel buffer) - :position (marker at which to insert the response). Call CALLBACK with the response and INFO afterwards. If omitted the response is inserted into the current buffer after point." (let* ((token (md5 (format "%s%s%s%s" (random) (emacs-pid) (user-full-name) (recent-keys)))) (args (gptel-curl--get-args (plist-get info :prompt) token)) (process (apply #'start-process "gptel-curl" (generate-new-buffer "*gptel-curl*") "curl" args))) (with-current-buffer (process-buffer process) (set-process-query-on-exit-flag process nil) (setf (alist-get process gptel-curl--process-alist) (nconc (list :token token :callback (or callback (if gptel-stream #'gptel-curl--stream-insert-response #'gptel--insert-response)) :transformer (when (or (eq gptel-default-mode 'org-mode) (eq (buffer-local-value 'major-mode (plist-get info :buffer)) 'org-mode)) (gptel--stream-convert-markdown->org))) info)) (if gptel-stream (progn (set-process-sentinel process #'gptel-curl--stream-cleanup) (set-process-filter process #'gptel-curl--stream-filter)) (set-process-sentinel process #'gptel-curl--sentinel))))) ;; TODO: Separate user-messaging from this function (defun gptel-curl--stream-cleanup (process status) "Process sentinel for GPTel curl requests. PROCESS and STATUS are process parameters." (let ((proc-buf (process-buffer process))) (when gptel--debug (with-current-buffer proc-buf (clone-buffer "*gptel-error*" 'show))) (let* ((info (alist-get process gptel-curl--process-alist)) (gptel-buffer (plist-get info :buffer)) (tracking-marker (plist-get info :tracking-marker)) (start-marker (plist-get info :position)) (http-status (plist-get info :http-status)) (http-msg (plist-get info :status))) (if (equal http-status "200") ;; Finish handling response (with-current-buffer gptel-buffer (pulse-momentary-highlight-region (+ start-marker 2) tracking-marker) (when gptel-mode (gptel--update-header-line " Ready" 'success) (save-excursion (goto-char tracking-marker) (insert "\n\n" (gptel-prompt-string))))) ;; Or Capture error message (with-current-buffer proc-buf (goto-char (point-max)) (search-backward (plist-get info :token)) (backward-char) (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))) (json-object-type 'plist) (response (progn (goto-char header-size) (condition-case nil (json-read) (json-readtable-error 'json-read-error))))) (cond ((plist-get response :error) (let* ((error-plist (plist-get response :error)) (error-msg (plist-get error-plist :message)) (error-type (plist-get error-plist :type))) (message "ChatGPT error: (%s) %s" http-msg error-msg) (setq http-msg (concat "(" http-msg ") " (string-trim error-type))))) ((eq response 'json-read-error) (message "ChatGPT error (%s): Malformed JSON in response." http-msg)) (t (message "ChatGPT error (%s): Could not parse HTTP response." http-msg))))) (with-current-buffer gptel-buffer (when gptel-mode (gptel--update-header-line (format " Response Error: %s" http-msg) 'error))))) (run-hooks 'gptel-post-response-hook) (setf (alist-get process gptel-curl--process-alist nil 'remove) nil) (kill-buffer proc-buf))) (defun gptel-curl--stream-insert-response (response info) "Insert streaming RESPONSE from ChatGPT into the gptel buffer. INFO is a mutable plist containing information relevant to this buffer. See `gptel--url-get-response' for details." (let ((status-str (plist-get response :status)) (gptel-buffer (plist-get info :buffer)) (start-marker (plist-get info :position)) (tracking-marker (plist-get info :tracking-marker)) (transformer (plist-get info :transformer))) (when response (with-current-buffer gptel-buffer (save-excursion (unless tracking-marker (gptel--update-header-line " Typing..." 'success) (goto-char start-marker) (unless (plist-get info :in-place) (insert "\n\n")) (setq tracking-marker (set-marker (make-marker) (point))) (set-marker-insertion-type tracking-marker t) (plist-put info :tracking-marker tracking-marker)) (when transformer (setq response (funcall transformer response))) (put-text-property 0 (length response) 'gptel 'response response) (goto-char tracking-marker) (insert response)))))) (defun gptel-curl--stream-filter (process output) (let* ((content-strs) (proc-info (alist-get process gptel-curl--process-alist))) (with-current-buffer (process-buffer process) ;; Insert output (save-excursion (goto-char (process-mark process)) (insert output) (set-marker (process-mark process) (point))) ;; Find HTTP status (unless (plist-get proc-info :http-status) (save-excursion (goto-char (point-min)) (when-let* (((not (= (line-end-position) (point-max)))) (http-msg (buffer-substring (line-beginning-position) (line-end-position))) (http-status (save-match-data (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) (match-string 1 http-msg))))) (plist-put proc-info :http-status http-status) (plist-put proc-info :status (string-trim http-msg))))) (when-let ((http-msg (plist-get proc-info :status)) (http-status (plist-get proc-info :http-status))) ;; Find data chunk(s) and run callback (when (equal http-status "200") (funcall (or (plist-get proc-info :callback) #'gptel-curl--stream-insert-response) (let* ((json-object-type 'plist) (response) (content-str)) (condition-case nil (while (re-search-forward "^data:" nil t) (save-match-data (unless (looking-at " *\\[DONE\\]") (when-let* ((response (json-read)) (delta (map-nested-elt response '(:choices 0 :delta))) (content (plist-get delta :content))) (push content content-strs))))) (error (goto-char (match-beginning 0)))) (apply #'concat (nreverse content-strs))) proc-info)))))) (defun gptel-curl--sentinel (process status) "Process sentinel for GPTel curl requests. PROCESS and STATUS are process parameters." (let ((proc-buf (process-buffer process))) (when gptel--debug (with-current-buffer proc-buf (clone-buffer "*gptel-error*" 'show))) (when-let* (((eq (process-status process) 'exit)) (proc-info (alist-get process gptel-curl--process-alist)) (proc-token (plist-get proc-info :token)) (proc-callback (plist-get proc-info :callback))) (pcase-let ((`(,response ,http-msg ,error) (gptel-curl--parse-response proc-buf proc-token))) (plist-put proc-info :status http-msg) (when error (plist-put proc-info :error error)) (funcall proc-callback response proc-info))) (setf (alist-get process gptel-curl--process-alist nil 'remove) nil) (kill-buffer proc-buf))) (defun gptel-curl--parse-response (buf token) "Parse the buffer BUF with curl's response. TOKEN is used to disambiguate multiple requests in a single buffer." (with-current-buffer buf (progn (goto-char (point-max)) (search-backward token) (backward-char) (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))) ;; (if (search-backward token nil t) ;; (search-forward ")" nil t) ;; (goto-char (point-min))) (goto-char (point-min)) (if-let* ((http-msg (string-trim (buffer-substring (line-beginning-position) (line-end-position)))) (http-status (save-match-data (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) (match-string 1 http-msg)))) (json-object-type 'plist) (response (progn (goto-char header-size) (condition-case nil (json-read) (json-readtable-error 'json-read-error))))) (cond ((equal http-status "200") (list (string-trim (map-nested-elt response '(:choices 0 :message :content))) http-msg)) ((plist-get response :error) (let* ((error-plist (plist-get response :error)) (error-msg (plist-get error-plist :message)) (error-type (plist-get error-plist :type))) (list nil (concat "(" http-msg ") " (string-trim error-type)) error-msg))) ((eq response 'json-read-error) (list nil (concat "(" http-msg ") Malformed JSON in response.") "Malformed JSON in response")) (t (list nil (concat "(" http-msg ") Could not parse HTTP response.") "Could not parse HTTP response."))) (list nil (concat "(" http-msg ") Could not parse HTTP response.") "Could not parse HTTP response.")))))) (provide 'gptel-curl) ;;; gptel-curl.el ends here