amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

provider: add bt:with-timeout + LLM_REQUEST_TIMEOUT env var
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Details

Browse Source
This commit is contained in:
Amr Gharbeia
2026-05-04 18:21:10 -04:00
parent be6e14a62e
commit 740ff3bb89
2 changed files with 34 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
org/system-model-provider.org
View File

@@ -65,6 +65,9 @@ Providers register themselves at boot. No API key? That provider doesn't registe
(format nil "http://~a/v1/chat/completions" host)
(format nil "~a/chat/completions" base-url)))
(format nil "~a/chat/completions" base-url)))
(timeout (or (ignore-errors
(parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT")))
30))
(headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
,@(when (eq provider :openrouter)
@@ -75,15 +78,20 @@ Providers register themselves at boot. No API key? That provider doesn't registe
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))))
(handler-case
(let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 60))
(json (cl-json:decode-json-from-string response))
(choices (cdr (assoc :choices json)))
(first-choice (car choices))
(message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message))))
(if content
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content in response (~s)" provider json))))
(bt:with-timeout (timeout)
(let* ((response (dex:post url :headers headers :content body
:connect-timeout (min 10 timeout)
:read-timeout (max 10 (- timeout 5))))
(json (cl-json:decode-json-from-string response))
(choices (cdr (assoc :choices json)))
(first-choice (car choices))
(message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message))))
(if content
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content in response (~s)" provider json)))))
(bt:timeout ()
(list :status :error :message (format nil "~a: Request timed out after ~d seconds" provider timeout)))
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
#+end_src