From 740ff3bb896bcc6f6e247ff7c733b004ee7e4612 Mon Sep 17 00:00:00 2001
From: Amr Gharbeia <amr@gharbeia.net>
Date: Mon, 4 May 2026 18:21:10 -0400
Subject: [PATCH] provider: add bt:with-timeout + LLM_REQUEST_TIMEOUT env var

---
 lisp/system-model-provider.lisp | 26 +++++++++++++++++---------
 org/system-model-provider.org   | 26 +++++++++++++++++---------
 2 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/lisp/system-model-provider.lisp b/lisp/system-model-provider.lisp
index 6223ab2..9c37806 100644
--- a/lisp/system-model-provider.lisp
+++ b/lisp/system-model-provider.lisp
@@ -37,6 +37,9 @@
                         (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)
@@ -47,15 +50,20 @@
                   (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))))))
 
diff --git a/org/system-model-provider.org b/org/system-model-provider.org
index 896f927..1872034 100644
--- a/org/system-model-provider.org
+++ b/org/system-model-provider.org
@@ -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