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