gptel-curl.el (20527B)
1 ;;; gptel-curl.el --- Curl support for GPTel -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2023 Karthik Chikmagalur 4 5 ;; Author: Karthik Chikmagalur;; <karthikchikmagalur@gmail.com> 6 ;; Keywords: convenience 7 8 ;; SPDX-License-Identifier: GPL-3.0-or-later 9 10 ;; This program is free software; you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; This program is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; Curl support for GPTel. Utility functions. 26 27 ;;; Code: 28 29 (require 'gptel) 30 31 (eval-when-compile 32 (require 'cl-lib) 33 (require 'subr-x)) 34 (require 'map) 35 36 (declare-function json-read "json" ()) 37 (defvar json-object-type) 38 39 (declare-function gptel--stream-convert-markdown->org "gptel-org") 40 41 (defconst gptel-curl--common-args 42 (if (memq system-type '(windows-nt ms-dos)) 43 '("--disable" "--location" "--silent" "-XPOST" 44 "-y300" "-Y1" "-D-") 45 '("--disable" "--location" "--silent" "--compressed" 46 "-XPOST" "-y300" "-Y1" "-D-")) 47 "Arguments always passed to Curl for gptel queries.") 48 49 (defvar gptel-curl--process-alist nil 50 "Alist of active GPTel curl requests.") 51 52 (defun gptel-curl--get-args (data token) 53 "Produce list of arguments for calling Curl. 54 55 REQUEST-DATA is the data to send, TOKEN is a unique identifier." 56 (let* ((url (let ((backend-url (gptel-backend-url gptel-backend))) 57 (if (functionp backend-url) 58 (funcall backend-url) backend-url))) 59 (data-json (encode-coding-string (gptel--json-encode data) 'utf-8)) 60 (headers 61 (append '(("Content-Type" . "application/json")) 62 (when-let ((header (gptel-backend-header gptel-backend))) 63 (if (functionp header) 64 (funcall header) header))))) 65 (when gptel-log-level 66 (when (eq gptel-log-level 'debug) 67 (gptel--log (gptel--json-encode 68 (mapcar (lambda (pair) (cons (intern (car pair)) (cdr pair))) 69 headers)) 70 "request headers")) 71 (gptel--log data-json "request body")) 72 (append 73 gptel-curl--common-args 74 (gptel-backend-curl-args gptel-backend) 75 (list (format "-w(%s . %%{size_header})" token)) 76 (if (length< data-json gptel-curl-file-size-threshold) 77 (list (format "-d%s" data-json)) 78 (letrec 79 ((temp-filename (make-temp-file "gptel-curl-data" nil ".json" data-json)) 80 (cleanup-fn (lambda (&rest _) 81 (when (file-exists-p temp-filename) 82 (delete-file temp-filename) 83 (remove-hook 'gptel-post-response-functions cleanup-fn))))) 84 (add-hook 'gptel-post-response-functions cleanup-fn) 85 (list "--data-binary" 86 (format "@%s" temp-filename)))) 87 (when (not (string-empty-p gptel-proxy)) 88 (list "--proxy" gptel-proxy 89 "--proxy-negotiate" 90 "--proxy-user" ":")) 91 (cl-loop for (key . val) in headers 92 collect (format "-H%s: %s" key val)) 93 (list url)))) 94 95 ;;TODO: The :transformer argument here is an alternate implementation of 96 ;;`gptel-response-filter-functions'. The two need to be unified. 97 ;;;###autoload 98 (defun gptel-curl-get-response (info &optional callback) 99 "Retrieve response to prompt in INFO. 100 101 INFO is a plist with the following keys: 102 - :data (the data being sent) 103 - :buffer (the gptel buffer) 104 - :position (marker at which to insert the response). 105 106 Call CALLBACK with the response and INFO afterwards. If omitted 107 the response is inserted into the current buffer after point." 108 (let* ((token (md5 (format "%s%s%s%s" 109 (random) (emacs-pid) (user-full-name) 110 (recent-keys)))) 111 (args (gptel-curl--get-args (plist-get info :data) token)) 112 (stream (and ;; Check model-specific request-params for streaming preference 113 (let* ((model-params (gptel--model-request-params gptel-model)) 114 (stream-spec (plist-get model-params :stream))) 115 ;; If not present, there is no model-specific preference 116 (or (not (memq :stream model-params)) 117 ;; If present, it must not be :json-false or nil 118 (and stream-spec (not (eq stream-spec :json-false))))) 119 ;; Check global and backend-specific streaming settings 120 gptel-stream 121 (gptel-backend-stream gptel-backend))) 122 (backend (buffer-local-value 'gptel-backend (plist-get info :buffer))) 123 (process (apply #'start-process "gptel-curl" 124 (generate-new-buffer "*gptel-curl*") "curl" args))) 125 (when (memq system-type '(windows-nt ms-dos)) 126 ;; Don't try to convert cr-lf to cr on Windows so that curl's "header size 127 ;; in bytes" stays correct 128 (set-process-coding-system process 'utf-8-unix 'utf-8-unix)) 129 (when (eq gptel-log-level 'debug) 130 (gptel--log (mapconcat #'shell-quote-argument (cons "curl" args) " \\\n") 131 "request Curl command" 'no-json)) 132 (with-current-buffer (process-buffer process) 133 (set-process-query-on-exit-flag process nil) 134 (setf (alist-get process gptel-curl--process-alist) 135 (nconc (list :token token 136 :backend backend 137 ;; FIXME `aref' breaks `cl-struct' abstraction boundary 138 ;; FIXME `cl--generic-method' is an internal `cl-struct' 139 :parser (cl--generic-method-function 140 (if stream 141 (cl-find-method 142 'gptel-curl--parse-stream nil 143 (list (aref backend 0) t)) 144 (cl-find-method 145 'gptel--parse-response nil 146 (list (aref backend 0) t t)))) 147 :callback (or callback 148 (if stream 149 #'gptel-curl--stream-insert-response 150 #'gptel--insert-response)) 151 :transformer (when (with-current-buffer (plist-get info :buffer) 152 (derived-mode-p 'org-mode)) 153 (gptel--stream-convert-markdown->org))) 154 info)) 155 (if stream 156 (progn (set-process-sentinel process #'gptel-curl--stream-cleanup) 157 (set-process-filter process #'gptel-curl--stream-filter)) 158 (set-process-sentinel process #'gptel-curl--sentinel))))) 159 160 (defun gptel-curl--log-response (proc-buf proc-info) 161 "Parse response buffer PROC-BUF and log response. 162 163 PROC-INFO is the plist containing process metadata." 164 (with-current-buffer proc-buf 165 (save-excursion 166 (goto-char (point-min)) 167 (when (re-search-forward "?\n?\n" nil t) 168 (when (eq gptel-log-level 'debug) 169 (gptel--log (gptel--json-encode 170 (buffer-substring-no-properties 171 (point-min) (1- (point)))) 172 "response headers")) 173 (let ((p (point))) 174 (when (search-forward (plist-get proc-info :token) nil t) 175 (goto-char (1- (match-beginning 0))) 176 (gptel--log (buffer-substring-no-properties p (point)) 177 "response body"))))))) 178 179 (defun gptel-abort (buf) 180 "Stop any active gptel process associated with buffer BUF." 181 (interactive (list (current-buffer))) 182 (unless gptel-use-curl 183 (user-error "Cannot stop a `url-retrieve' request!")) 184 (if-let* ((proc-attrs 185 (cl-find-if 186 (lambda (proc-list) 187 (eq (plist-get (cdr proc-list) :buffer) buf)) 188 gptel-curl--process-alist)) 189 (proc (car proc-attrs))) 190 (progn 191 (setf (alist-get proc gptel-curl--process-alist nil 'remove) nil) 192 (set-process-sentinel proc #'ignore) 193 (delete-process proc) 194 (kill-buffer (process-buffer proc)) 195 (with-current-buffer buf 196 (when gptel-mode (gptel--update-status " Ready" 'success))) 197 (message "Stopped gptel request in buffer %S" (buffer-name buf))) 198 (message "No gptel request associated with buffer %S" (buffer-name buf)))) 199 200 ;; TODO: Separate user-messaging from this function 201 (defun gptel-curl--stream-cleanup (process _status) 202 "Process sentinel for GPTel curl requests. 203 204 PROCESS and _STATUS are process parameters." 205 (let ((proc-buf (process-buffer process))) 206 (let* ((info (alist-get process gptel-curl--process-alist)) 207 (gptel-buffer (plist-get info :buffer)) 208 (backend-name 209 (gptel-backend-name 210 (buffer-local-value 'gptel-backend gptel-buffer))) 211 (tracking-marker (plist-get info :tracking-marker)) 212 (start-marker (plist-get info :position)) 213 (http-status (plist-get info :http-status)) 214 (http-msg (plist-get info :status))) 215 (when gptel-log-level (gptel-curl--log-response proc-buf info)) ;logging 216 (if (member http-status '("200" "100")) ;Finish handling response 217 (with-current-buffer gptel-buffer 218 (if (not tracking-marker) ;Empty response 219 (when gptel-mode (gptel--update-status " Empty response" 'success)) 220 (pulse-momentary-highlight-region start-marker tracking-marker) 221 (when gptel-mode 222 (save-excursion (goto-char tracking-marker) 223 (insert "\n\n" (gptel-prompt-prefix-string))) 224 (gptel--update-status " Ready" 'success)))) 225 ;; Or Capture error message 226 (with-current-buffer proc-buf 227 (goto-char (point-max)) 228 (search-backward (plist-get info :token)) 229 (backward-char) 230 (pcase-let* ((`(,_ . ,header-size) (read (current-buffer))) 231 (response (progn (goto-char header-size) 232 (condition-case nil (gptel--json-read) 233 (error 'json-read-error)))) 234 (error-data (plist-get response :error))) 235 (cond 236 (error-data 237 (if (stringp error-data) 238 (message "%s error: (%s) %s" backend-name http-msg error-data) 239 (when-let ((error-msg (plist-get error-data :message))) 240 (message "%s error: (%s) %s" backend-name http-msg error-msg)) 241 (when-let ((error-type (plist-get error-data :type))) 242 (setq http-msg (concat "(" http-msg ") " (string-trim error-type)))))) 243 ((eq response 'json-read-error) 244 (message "%s error (%s): Malformed JSON in response." backend-name http-msg)) 245 (t (message "%s error (%s): Could not parse HTTP response." backend-name http-msg))))) 246 (with-current-buffer gptel-buffer 247 (when gptel-mode 248 (gptel--update-status 249 (format " Response Error: %s" http-msg) 'error)))) 250 ;; Run hook in visible window to set window-point, BUG #269 251 (if-let ((gptel-window (get-buffer-window gptel-buffer 'visible))) 252 (with-selected-window gptel-window 253 (run-hook-with-args 'gptel-post-response-functions 254 (marker-position start-marker) 255 (marker-position (or tracking-marker start-marker)))) 256 (with-current-buffer gptel-buffer 257 (run-hook-with-args 'gptel-post-response-functions 258 (marker-position start-marker) 259 (marker-position (or tracking-marker start-marker)))))) 260 (setf (alist-get process gptel-curl--process-alist nil 'remove) nil) 261 (kill-buffer proc-buf))) 262 263 (defun gptel-curl--stream-insert-response (response info) 264 "Insert streaming RESPONSE from an LLM into the gptel buffer. 265 266 INFO is a mutable plist containing information relevant to this buffer. 267 See `gptel--url-get-response' for details." 268 (let ((start-marker (plist-get info :position)) 269 (tracking-marker (plist-get info :tracking-marker)) 270 (transformer (plist-get info :transformer))) 271 (when response 272 (with-current-buffer (marker-buffer start-marker) 273 (save-excursion 274 (unless tracking-marker 275 (gptel--update-status " Typing..." 'success) 276 (goto-char start-marker) 277 (unless (or (bobp) (plist-get info :in-place)) 278 (insert "\n\n") 279 (when gptel-mode 280 ;; Put prefix before AI response. 281 (insert (gptel-response-prefix-string))) 282 (move-marker start-marker (point))) 283 (setq tracking-marker (set-marker (make-marker) (point))) 284 (set-marker-insertion-type tracking-marker t) 285 (plist-put info :tracking-marker tracking-marker)) 286 287 (when transformer 288 (setq response (funcall transformer response))) 289 290 (put-text-property 291 0 (length response) 'gptel 'response response) 292 (goto-char tracking-marker) 293 ;; (run-hooks 'gptel-pre-stream-hook) 294 (insert response) 295 (run-hooks 'gptel-post-stream-hook)))))) 296 297 (defun gptel-curl--stream-filter (process output) 298 (let* ((proc-info (alist-get process gptel-curl--process-alist))) 299 (with-current-buffer (process-buffer process) 300 ;; Insert output 301 (save-excursion 302 (goto-char (process-mark process)) 303 (insert output) 304 (set-marker (process-mark process) (point))) 305 306 ;; Find HTTP status 307 (unless (plist-get proc-info :http-status) 308 (save-excursion 309 (goto-char (point-min)) 310 (when-let* (((not (= (line-end-position) (point-max)))) 311 (http-msg (buffer-substring (line-beginning-position) 312 (line-end-position))) 313 (http-status 314 (save-match-data 315 (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) 316 (match-string 1 http-msg))))) 317 (plist-put proc-info :http-status http-status) 318 (plist-put proc-info :status (string-trim http-msg)))) 319 ;; Handle read-only gptel buffer 320 (when (with-current-buffer (plist-get proc-info :buffer) 321 (or buffer-read-only 322 (get-char-property (plist-get proc-info :position) 'read-only))) 323 (message "Buffer is read only, displaying reply in buffer \"*LLM response*\"") 324 (display-buffer 325 (with-current-buffer (get-buffer-create "*LLM response*") 326 (visual-line-mode 1) 327 (goto-char (point-max)) 328 (move-marker (plist-get proc-info :position) (point) (current-buffer)) 329 (current-buffer)) 330 '((display-buffer-reuse-window 331 display-buffer-pop-up-window) 332 (reusable-frames . visible)))) 333 ;; Run pre-response hook 334 (when (and (member (plist-get proc-info :http-status) '("200" "100")) 335 gptel-pre-response-hook) 336 (with-current-buffer (marker-buffer (plist-get proc-info :position)) 337 (run-hooks 'gptel-pre-response-hook)))) 338 339 (when-let ((http-msg (plist-get proc-info :status)) 340 (http-status (plist-get proc-info :http-status))) 341 ;; Find data chunk(s) and run callback 342 ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 343 (when-let (((member http-status '("200" "100"))) 344 (response (funcall (plist-get proc-info :parser) nil proc-info)) 345 ((not (equal response "")))) 346 (funcall (or (plist-get proc-info :callback) 347 #'gptel-curl--stream-insert-response) 348 response proc-info)))))) 349 350 (cl-defgeneric gptel-curl--parse-stream (backend proc-info) 351 "Stream parser for gptel-curl. 352 353 Implementations of this function run as part of the process 354 filter for the active query, and return partial responses from 355 the LLM. 356 357 BACKEND is the LLM backend in use. 358 359 PROC-INFO is a plist with process information and other context. 360 See `gptel-curl--get-response' for its contents.") 361 362 (defun gptel-curl--sentinel (process _status) 363 "Process sentinel for gptel curl requests. 364 365 PROCESS and _STATUS are process parameters." 366 (let ((proc-buf (process-buffer process))) 367 (when-let* (((eq (process-status process) 'exit)) 368 (proc-info (alist-get process gptel-curl--process-alist)) 369 (proc-callback (plist-get proc-info :callback))) 370 (when gptel-log-level (gptel-curl--log-response proc-buf proc-info)) ;logging 371 (pcase-let ((`(,response ,http-msg ,error) 372 (with-current-buffer proc-buf 373 (gptel-curl--parse-response proc-info)))) 374 (plist-put proc-info :status http-msg) 375 (when error (plist-put proc-info :error error)) 376 (funcall proc-callback response proc-info))) 377 (setf (alist-get process gptel-curl--process-alist nil 'remove) nil) 378 (kill-buffer proc-buf))) 379 380 (defun gptel-curl--parse-response (proc-info) 381 "Parse the buffer BUF with curl's response. 382 383 PROC-INFO is a plist with contextual information." 384 (let ((token (plist-get proc-info :token)) 385 (parser (plist-get proc-info :parser))) 386 (goto-char (point-max)) 387 (search-backward token) 388 (backward-char) 389 (pcase-let* ((`(,_ . ,header-size) (read (current-buffer)))) 390 (goto-char (point-min)) 391 392 (if-let* ((http-msg (string-trim 393 (buffer-substring (line-beginning-position) 394 (line-end-position)))) 395 (http-status 396 (save-match-data 397 (and (string-match "HTTP/[.0-9]+ +\\([0-9]+\\)" http-msg) 398 (match-string 1 http-msg)))) 399 (response (progn (goto-char header-size) 400 (condition-case nil 401 (gptel--json-read) 402 (error 'json-read-error))))) 403 (cond 404 ;; FIXME Handle the case where HTTP 100 is followed by HTTP (not 200) BUG #194 405 ((member http-status '("200" "100")) 406 (list (string-trim 407 (funcall parser nil response proc-info)) 408 http-msg)) 409 ((plist-get response :error) 410 (let* ((error-data (plist-get response :error)) 411 (error-msg (plist-get error-data :message)) 412 (error-type (plist-get error-data :type)) 413 (backend-name 414 (gptel-backend-name 415 (buffer-local-value 'gptel-backend (plist-get proc-info :buffer))))) 416 (if (stringp error-data) 417 (progn (message "%s error: (%s) %s" backend-name http-msg error-data) 418 (setq error-msg (string-trim error-data))) 419 (when (stringp error-msg) 420 (message "%s error: (%s) %s" backend-name http-msg (string-trim error-msg))) 421 (when error-type (setq http-msg (concat "(" http-msg ") " (string-trim error-type))))) 422 (list nil (concat "(" http-msg ") " (or error-msg ""))))) 423 ((eq response 'json-read-error) 424 (list nil (concat "(" http-msg ") Malformed JSON in response.") 425 "Malformed JSON in response")) 426 (t (list nil (concat "(" http-msg ") Could not parse HTTP response.") 427 "Could not parse HTTP response."))) 428 (list nil (concat "(" http-msg ") Could not parse HTTP response.") 429 "Could not parse HTTP response."))))) 430 431 (provide 'gptel-curl) 432 ;;; gptel-curl.el ends here