forked from ahyatt/llm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathllm-request.el
178 lines (152 loc) · 7.44 KB
/
llm-request.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
;;; llm-request.el --- Request handling code -*- lexical-binding: t; package-lint-main-file: "llm.el"; -*-
;; Copyright (c) 2023 Free Software Foundation, Inc.
;; 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file provides basic functions for providers who need to request data. It
;; assumes the server is using json.
;;; Code:
(require 'json)
(require 'cl-macs)
(require 'url-http)
(require 'rx)
(defcustom llm-request-timeout 60
"The number of seconds to wait for a response from a HTTP server.
Request timings are depending on the request. Requests that need
more output may take more time, and there is other processing
besides just token generation that can take a while. Sometimes
the LLM can get stuck, and you don't want it to take too long.
This should be balanced to be good enough for hard requests but
not very long so that we can end stuck requests."
:type 'integer
:group 'llm)
(defun llm-request--content ()
"From the current buffer, return the content of the response."
(decode-coding-string
(buffer-substring-no-properties
(or (and (boundp 'url-http-end-of-headers) url-http-end-of-headers)
(save-match-data
(save-excursion
(goto-char (point-min))
(search-forward "\n\n" nil t)
(forward-line)
(point))))
(point-max)) 'utf-8))
(defvar-local llm-request--partial-callback nil
"The callback to call when a partial response is received.")
(defvar url-http-response-status)
(cl-defun llm-request-sync-raw-output (url &key headers data timeout)
"Make a request to URL. The raw text response will be returned.
HEADERS will be added in the Authorization header, in addition to
standard json header. This is optional.
DATA will be jsonified and sent as the request body.
This is required.
TIMEOUT is the number of seconds to wait for a response."
(let ((url-request-method "POST")
(url-request-extra-headers
(append headers '(("Content-Type" . "application/json"))))
(url-request-data (encode-coding-string (json-encode data) 'utf-8)))
(let ((buf (url-retrieve-synchronously url t nil (or timeout llm-request-timeout))))
(if buf
(with-current-buffer buf
(url-http-parse-response)
(if (and (>= url-http-response-status 200)
(< url-http-response-status 300))
(llm-request--content)
(error "LLM request failed with code %d: %s (additional information: %s)"
url-http-response-status
(nth 2 (assq url-http-response-status url-http-codes))
(string-trim (llm-request--content)))))
(error "LLM request timed out")))))
(cl-defun llm-request-sync (url &key headers data timeout)
"Make a request to URL. The parsed response will be returned.
HEADERS will be added in the Authorization header, in addition to
standard json header. This is optional.
DATA will be jsonified and sent as the request body.
This is required.
TIMEOUT is the number of seconds to wait for a response."
(json-read-from-string (llm-request-sync-raw-output url
:headers headers
:data data
:timeout timeout)))
(defun llm-request--handle-new-content (_ _ pre-change)
"Handle new content in the current buffer.
PRE-CHANGE is the length of text replaced, which for insertions
is zero."
(when (= 0 pre-change)
(save-match-data
(save-excursion
;; Make sure we actually have any content before invoking a callback.
(when (and llm-request--partial-callback
(boundp 'url-http-end-of-headers)
url-http-end-of-headers)
(funcall llm-request--partial-callback (llm-request--content)))))))
(cl-defun llm-request-async (url &key headers data on-success on-success-raw on-error on-partial)
"Make a request to URL.
Nothing will be returned.
HEADERS will be added in the Authorization header, in addition to
standard json header. This is optional.
DATA will be jsonified and sent as the request body.
This is required.
ON-SUCCESS will be called with the response body as a json
object. This is optional in the case that ON-SUCCESS-DATA is set,
and required otherwise.
ON-ERROR will be called with the error code and a response-body.
This is required.
ON-PARTIAL will be called with the potentially incomplete response
body as a string. This is an optional argument.
ON-SUCCESS-RAW, if set, will be called in the buffer with the
response body, and expect the response content. This is an
optional argument, and mostly useful for streaming. If not set,
the buffer is turned into JSON and passed to ON-SUCCESS."
(let ((url-request-method "POST")
(url-request-extra-headers
(append headers '(("Content-Type" . "application/json"))))
(url-request-data (encode-coding-string (json-encode data) 'utf-8))
(old-mime-encoding url-mime-encoding-string))
;; This is necessary for streaming, otherwise we get gzip'd data that is
;; unparseable until the end. The responses should be small enough that this
;; should not be any big loss. We can't use let-binding here, since the use
;; of this variable happens asynchronously, so not enclosed by the
;; let-binding.
(setq url-mime-encoding-string "identity")
(let ((buffer
(url-retrieve
url
;; For some reason the closure you'd expect did not work here.
(lambda (_ on-success on-error)
;; Restore the old mime encoding. This may cause race conditions
;; if we try to stream two things at around the same time.
(setq url-mime-encoding-string old-mime-encoding)
;; No matter what, we need to stop listening for changes.
(remove-hook 'after-change-functions #'llm-request--handle-new-content t)
(condition-case error
(let ((code (url-http-parse-response)))
(if (eq code 200)
(if on-success-raw
(funcall on-success-raw (llm-request--content))
(funcall on-success (json-read-from-string (llm-request--content))))
(funcall on-error code (ignore-errors
(json-read-from-string (llm-request--content))))))
(error (funcall on-error (car error) (error-message-string error)))))
(list on-success on-error)
t)))
(when (and buffer on-partial)
(with-current-buffer buffer
(setq llm-request--partial-callback on-partial)
(add-hook 'after-change-functions
#'llm-request--handle-new-content
nil t)))
buffer)))
(provide 'llm-request)
;;; llm-request.el ends here