(in-package :passepartout) (defparameter *provider-configs* '((:local . (:base-url nil :key-env nil :url-env "LOCAL_BASE_URL" :default-model "llama3")) (:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto")) (:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini")) (:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022")) (:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile")) (:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash")) (:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat")) (:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct")))) (defun provider-config (provider) "Returns the configuration plist for a provider keyword." (cdr (assoc provider *provider-configs*))) (defun provider-available-p (provider) "Checks if a provider is configured. Checks API key or URL env vars." (let* ((config (provider-config provider)) (key-env (getf config :key-env)) (url-env (getf config :url-env)) (base-url (getf config :base-url))) (cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0)))) (url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0)))) (base-url t)))) (defun provider-openai-request (prompt system-prompt &key model (provider :openrouter) tools) "Executes a request against any OpenAI-compatible API endpoint. When :tools is provided, includes function-calling tool definitions in the request." (let* ((config (provider-config provider)) (base-url (getf config :base-url)) (key-env (getf config :key-env)) (url-env (getf config :url-env)) (default-model (getf config :default-model)) (api-key (when key-env (uiop:getenv key-env))) (model-id (or model default-model)) (url (if url-env (let ((host (uiop:getenv url-env))) (if host (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) `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout") ("X-Title" . "Passepartout"))))) (body (let ((base `((model . ,model-id) (messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) )))))) (if tools (append base `((tools . ,(loop for tool in tools collect (list (cons :|type| "function") (cons :|function| (loop for (k v) on tool by #'cddr collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) (:|tool_choice| . "auto"))) base))) (body-json (cl-json:encode-json-to-string body))) (handler-case (let* ((response (dex:post url :headers headers :content body-json :connect-timeout (min 5 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))) (tool-calls (cdr (assoc :|tool_calls| message))) (content (cdr (assoc :content message)))) (cond (tool-calls (list :status :success :tool-calls (loop for tc in tool-calls for fun = (cdr (assoc :|function| tc)) for args-str = (cdr (assoc :|arguments| fun)) for args = (when args-str (cl-json:decode-json-from-string args-str)) collect (list :name (cdr (assoc :|name| fun)) :arguments args)))) (content (list :status :success :content content)) (t (list :status :error :message (format nil "~a: No content" provider))))) (error (c) (list :status :error :message (format nil "~a Failure: ~a" provider c)))))) (defun provider-register-all () "Scans environment variables and registers all available LLM backends." (dolist (entry *provider-configs*) (let ((provider (car entry))) (when (provider-available-p provider) (log-message "LLM BACKEND: Registering provider ~a" provider) (register-probabilistic-backend provider (lambda (prompt system-prompt &key model tools) (provider-openai-request prompt system-prompt :model model :provider provider :tools tools))))))) (defun provider-cascade-initialize () "Reads PROVIDER_CASCADE from env and sets *provider-cascade*." (let ((cascade-str (uiop:getenv "PROVIDER_CASCADE"))) (if cascade-str (setf *provider-cascade* (mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword)) (uiop:split-string cascade-str :separator '(#\,)))) (setf *provider-cascade* (mapcar #'car (remove-if (lambda (e) (member (car e) '(:local))) *provider-configs*)))))) (defun test-provider-connection (provider &optional api-key) "Test a provider API key by hitting its models endpoint. Returns (:ok) on success, (:fail reason) on failure. If API-KEY is nil, reads from environment." (let* ((config (provider-config provider)) (base-url (getf config :base-url)) (key-env (getf config :key-env)) (url-env (getf config :url-env)) (key (or api-key (when key-env (uiop:getenv key-env))))) (handler-case (let ((url (if url-env (let ((host (or (uiop:getenv url-env) ""))) (format nil "http://~a/api/tags" host)) (format nil "~a/models" (or base-url ""))))) (if key-env (progn (dex:get url :headers `(("Authorization" . ,(format nil "Bearer ~a" key))) :connect-timeout 5 :read-timeout 10) '(:ok)) (if url-env (progn (dex:get url :connect-timeout 5 :read-timeout 10) '(:ok)) '(:fail "No URL source for this provider")))) (error (c) `(:fail ,(format nil "~a" c)))))) (provider-register-all) (provider-cascade-initialize) (defskill :passepartout-neuro-provider :priority 50 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) (defun cascade-stream (prompt system-prompt callback) "Streaming cascade: calls provider-openai-stream on the first available backend. Calls CALLBACK with each delta string, then with '' to signal end-of-stream." (dolist (backend *provider-cascade*) (when (gethash backend *probabilistic-backends*) (let ((result (provider-openai-stream prompt system-prompt callback :provider backend))) (when (eq (getf result :status) :success) (return cascade-stream)))))) (in-package :passepartout) (defun parse-sse-line (line) "Parse an SSE line. Returns data string, :done for [DONE], nil otherwise." (cond ((or (null line) (string= line "")) nil) ((char= (char line 0) #\:) nil) ((and (>= (length line) 6) (string-equal (subseq line 0 6) "data: ")) (let ((content (subseq line 6))) (if (string= content "[DONE]") :done content))) (t nil))) (defvar *stream-cancel* nil "When T, the streaming SSE loop exits early.") (defun provider-openai-stream (prompt system-prompt callback &key model (provider :openrouter) tools) "Streaming OpenAI-compatible request. Calls CALLBACK with each delta, then ''." (let* ((config (provider-config provider)) (base-url (getf config :base-url)) (key-env (getf config :key-env)) (url-env (getf config :url-env)) (default-model (getf config :default-model)) (api-key (when key-env (uiop:getenv key-env))) (model-id (or model default-model)) (url (if url-env (let ((host (uiop:getenv url-env))) (if host (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)) (req-headers (list (cons "Content-Type" "application/json"))) (base `((model . ,model-id) (messages . (( (role . "system") (content . ,system-prompt) ) ( (role . "user") (content . ,prompt) ))) (stream . t)))) (when api-key (push (cons "Authorization" (format nil "Bearer ~a" api-key)) req-headers)) (when (eq provider :openrouter) (setf req-headers (append req-headers `(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout") ("X-Title" . "Passepartout"))))) (let ((body (if tools (append base `((tools . ,(loop for tool in tools collect (list (cons :|type| "function") (cons :|function| (loop for (k v) on tool by #'cddr collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) (:|tool_choice| . "auto"))) base))) (handler-case (let* ((body-json (cl-json:encode-json-to-string body)) (stall-seconds 30) (s (dex:post url :headers req-headers :content body-json :connect-timeout (min 5 timeout) :read-timeout stall-seconds :want-stream t))) ;; v0.7.1: track stall timer — reset on each successful chunk (let ((last-chunk-time (get-universal-time))) (loop for raw = (handler-case (read-line s nil nil) (error (c) (declare (ignore c)) nil)) while raw do (when *stream-cancel* ; v0.7.1: cancel check (setf *stream-cancel* nil) (funcall callback " [cancelled]") (return)) (let ((parsed (parse-sse-line raw))) (cond ((null parsed)) ((eq parsed :done) (return)) (t (handler-case (let* ((json (cl-json:decode-json-from-string parsed)) (choices (cdr (assoc :choices json))) (choice (car choices)) (delta (cdr (assoc :delta choice))) (content (cdr (assoc :content delta)))) (when content (funcall callback content) (setf last-chunk-time (get-universal-time)))) (error ()))))) (when (> (- (get-universal-time) last-chunk-time) stall-seconds) (funcall callback "[Response stalled — timed out at 30s]") (return)))) (funcall callback "") (close s) (list :status :success)) (error (c) (list :status :error :message (format nil "~a Stream Failure: ~a" provider c)))))))