provider: Grok CLI Responses-API adapter (add-grok phase 4)
ober
0986f005b315d1d9f321f1de8b50cd7c24da04d3
--- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -13,7 +13,16 @@ provider-base-url model-rejects-tools? extract-text-tool-calls - recover-text-tool-calls) + recover-text-tool-calls + ;; Grok Responses adapter (Phase 4) — exported so unit tests can drive + ;; the pure helpers without making real HTTP calls. + responses-parse-response + message->responses-input + responses-body + responses-headers + grok-backend + grok-backend-from + grok-list-models) (import :std/text/json :std/net/request @@ -25,6 +34,7 @@ :jcode/core/log :jcode/core/message :jcode/core/models + :jcode/core/grok-auth :jcode/provider/sampling :jerboa/core :jerboa/runtime) @@ -107,6 +117,11 @@ ((ollama) "http://localhost:11434/v1") ((mlx) "http://127.0.0.1:8080/v1") ((xai) "https://api.x.ai/v1") + ;; Grok CLI: prefer ~/.grok/models_cache.json info.base_url so the live + ;; proxy can rotate hosts without code changes; falls back to the + ;; canonical cli-chat-proxy URL. + ((grok) (grok-model-info-ref (grok-default-model-info) "base_url" + "https://cli-chat-proxy.grok.com/v1")) ((groq) "https://api.groq.com/openai/v1") ((mistral) "https://api.mistral.ai/v1") ((together) "https://api.together.xyz/v1") @@ -134,6 +149,7 @@ ((google) (google-chat provider messages tools)) ((ollama) (ollama-chat provider messages tools)) ((mlx) (openai-chat provider messages tools)) + ((grok) (grok-dispatch-chat provider messages tools)) (else (error 'provider-chat "Unknown provider" (provider-name provider))))))) (def (provider-stream provider messages tools callback) @@ -161,6 +177,15 @@ (case (string->symbol (provider-name provider)) ((openai openrouter deepseek xai groq mistral together cerebras perplexity mlx) (openai-chat-with-stats provider messages tools)) + ((grok) + ;; If grok's api_backend is chat_completions we get logprobs/finish via + ;; the existing OpenAI path; for "responses" we fall through to the + ;; default (non-stats) wrapper — Responses doesn't expose logprobs in + ;; the same shape, so empty stats are correct. + (case (string->symbol (grok-backend provider)) + ((chat_completions) (openai-chat-with-stats provider messages tools)) + (else (values (provider-chat provider messages tools) + (build-stats #f '() '()))))) (else (values (provider-chat provider messages tools) (build-stats #f '() '()))))))) @@ -1462,6 +1487,10 @@ (case (string->symbol (provider-name provider)) ((openai openrouter deepseek ollama mlx xai groq mistral together cerebras perplexity) (openai-stream-chat provider messages tools token-cb)) + ((grok) + (case (string->symbol (grok-backend provider)) + ((chat_completions) (openai-stream-chat provider messages tools token-cb)) + (else (grok-responses-stream-chat provider messages tools token-cb)))) ((anthropic) (anthropic-stream-chat provider messages tools token-cb)) ((google) ;; Google: non-streaming fallback — no stats available. @@ -1483,6 +1512,226 @@ (values content tool-calls usage))) ;;; ================================================================ +;;; Grok CLI — OpenAI Responses-API adapter (cli-chat-proxy.grok.com) +;;; ================================================================ +;; +;; The Grok CLI proxy speaks OpenAI's Responses API ("/responses"), not the +;; older Chat Completions API. We dispatch through `grok-backend` so the same +;; "grok" provider can also serve models whose models_cache.json says +;; api_backend = "chat_completions" (via the existing OpenAI path). +;; +;; First-pass scope (per docs/add-grok.md design decision #6): +;; - text-only chat (no tool calling — Responses tool spec unverified +;; against cli-chat-proxy.grok.com) +;; - streaming via SSE: response.output_text.delta + response.completed +;; - usage parsed into the existing (tokens-in tokens-out cost) shape +;; - 401 surfaces a clear "Run grok login" hint +;; +;; When the proxy's tool spec is confirmed, wire OpenAI-style tools into the +;; "tools" / "tool_choice" body fields below; the response parser already +;; lifts "function_call" output items into make-assistant-message tool calls. + +(def (grok-backend-from info) + ;; Pure: returns "chat_completions" | "responses" | other-string from an + ;; info-alist (as returned by grok-default-model-info / grok-model-info-from). + ;; Defaults to "responses" when the field is missing or not a string. + (or (grok-model-info-ref info "api_backend" "responses") "responses")) + +(def (grok-backend provider) + (grok-backend-from (grok-default-model-info))) + +(def (grok-list-models provider) + ;; Read the user's ~/.grok/models_cache.json directly — the Grok CLI proxy + ;; doesn't expose a public /models listing, but the cache mirrors what + ;; `grok login` discovered. Fall back to the canonical grok-build pair. + (let ((cached (grok-models-cache-models))) + (if (pair? cached) cached '(("grok-build" . "Grok Build"))))) + +(def (grok-dispatch-chat provider messages tools) + (case (string->symbol (grok-backend provider)) + ((chat_completions) (openai-chat provider messages tools)) + (else (grok-responses-chat provider messages tools)))) + +;; ---- Responses API: payload helpers ---- + +(def (responses-headers provider) + (let ((key (or (provider-api-key provider) ""))) + `(("Content-Type" . "application/json") + ("Authorization" . ,(string-append "Bearer " key))))) + +(def (message->responses-input msg) + ;; Responses API expects {role, content} entries. For first pass we send + ;; content as a plain string for all roles, mapping "tool" results to + ;; "user" so the model still sees the text (no tool calling support yet). + (let ((ht (make-hash-table))) + (hash-put! ht "role" + (if (equal? (message-role msg) "tool") "user" (message-role msg))) + (hash-put! ht "content" + (cdr (extract-thinking (or (message-content msg) "")))) + ht)) + +(def (responses-body provider messages tools) + (let ((body (make-hash-table))) + (hash-put! body "model" (provider-model provider)) + (hash-put! body "input" (map message->responses-input messages)) + (when (and tools (not (null? tools))) + (log-info logger "grok-responses-tools-skipped" + `((count . ,(length tools)) + (reason . "tool spec not yet verified vs cli-chat-proxy")))) + body)) + +;; ---- Responses API: response parsing ---- + +(def (responses-collect-text output) + ;; Concatenate every output_text block under message-type output items. + (let ((acc (open-output-string))) + (for-each + (lambda (item) + (when (and (hash-table? item) + (equal? (hash-get item "type") "message")) + (let ((content (hash-get item "content"))) + (when (list? content) + (for-each + (lambda (block) + (when (and (hash-table? block) + (equal? (hash-get block "type") "output_text")) + (let ((t (hash-get block "text"))) + (when (string? t) (put-string acc t))))) + content))))) + output) + (get-output-string acc))) + +(def (responses-collect-tool-calls output) + ;; Pull function_call output items into tool-call records (will be ignored + ;; until Responses tool calling is wired into responses-body). + (let ((acc (box '()))) + (for-each + (lambda (item) + (when (and (hash-table? item) + (equal? (hash-get item "type") "function_call")) + (let ((name (hash-get item "name")) + (args (or (hash-get item "arguments") "{}")) + (id (or (hash-get item "id") ""))) + (when (and name (string? name)) + (set-box! acc (cons (restore-tool-call id name args) + (unbox acc))))))) + output) + (reverse (unbox acc)))) + +(def (responses-parse-response json) + ;; Parse an OpenAI Responses non-streaming envelope into an assistant + ;; message. Accepts the parsed JSON hash directly so tests can drive it. + (let* ((output (or (hash-get json "output") '())) + (text (responses-collect-text output)) + (tcs (responses-collect-tool-calls output))) + (if (null? tcs) + (make-assistant-message text) + (make-assistant-message text tcs)))) + +;; ---- Responses API: non-streaming chat ---- + +(def (grok-responses-chat provider messages tools) + (let* ((url (string-append (provider-base-url provider) "/responses")) + (headers (responses-headers provider)) + (body (responses-body provider messages tools)) + (body-json (json-object->string body))) + (when (tracing?) + (log-trace logger "grok-responses-request" + `((url . ,(redact-url url)) + (headers . ,(redact-headers headers)) + (body . ,body-json)))) + (let-values (((status text) (http-post-json url headers body-json))) + (when (tracing?) + (log-trace logger "grok-responses-response" + `((status . ,status) (body . ,text)))) + (cond + ((= status 200) + (responses-parse-response (string->json-object text))) + ((= status 401) + (error 'grok-responses-chat + "Grok authentication failed (HTTP 401). Run `grok login` to refresh ~/.grok/auth.json.")) + (else + (error 'grok-responses-chat + (format "Grok Responses API error ~a: ~a" status text))))))) + +;; ---- Responses API: streaming chat ---- + +(def (grok-responses-stream-chat provider messages tools token-cb) + ;; Stream via SSE. Returns (values content tool-calls usage-alist stats-alist) + ;; matching openai-stream-chat / anthropic-stream-chat. Responses SSE events + ;; carry their type either in an "event: <type>" line or in the JSON's "type" + ;; field — we prefer JSON and fall back to the line. + (let* ((url (string-append (provider-base-url provider) "/responses")) + (headers (responses-headers provider)) + (body (let ((b (responses-body provider messages tools))) + (hash-put! b "stream" #t) b)) + (body-json (json-object->string body)) + (text-acc (open-output-string)) + (tool-calls-box (box '())) + (usage-acc (make-hash-table)) + (finish-reason-box (box #f)) + (event-type #f)) + (when (tracing?) + (log-trace logger "grok-responses-stream-request" + `((url . ,(redact-url url)) + (headers . ,(redact-headers headers)) + (body . ,body-json)))) + (let ((http-status + (jcode-http-post-stream url headers body-json + (lambda (line) + (when line + (when (tracing?) + (log-trace logger "grok-responses-sse" `((line . ,line)))) + (cond + ((string-prefix? "event: " line) + (set! event-type (substring line 7 (string-length line)))) + ((string-prefix? "data: " line) + (let* ((data-str (substring line 6 (string-length line))) + (json (guard (e [#t #f]) (string->json-object data-str)))) + (when (and json (hash-table? json)) + (let ((etype (or (and (string? (hash-get json "type")) + (hash-get json "type")) + event-type))) + (cond + ((equal? etype "response.output_text.delta") + (let ((delta (hash-get json "delta"))) + (when (and delta (string? delta) (> (string-length delta) 0)) + (put-string text-acc delta) + (token-cb delta)))) + ((equal? etype "response.completed") + (let* ((resp (hash-get json "response")) + (usage (and (hash-table? resp) (hash-get resp "usage"))) + (st (and (hash-table? resp) (hash-get resp "status")))) + (when (and usage (hash-table? usage)) + (hash-for-each (lambda (k v) (hash-put! usage-acc k v)) usage)) + (when (string? st) (set-box! finish-reason-box st)) + (let ((out (and (hash-table? resp) (hash-get resp "output")))) + (when (list? out) + (let ((extra (responses-collect-tool-calls out))) + (when (pair? extra) + (set-box! tool-calls-box + (append (unbox tool-calls-box) extra)))))))))))))))))))) + (unless (= http-status 200) + (log-error logger "grok-responses-stream-http-error" + `((status . ,http-status) (url . ,url))))) + (let* ((content (get-output-string text-acc)) + (in-tok (or (hash-get usage-acc "input_tokens") 0)) + (out-tok (or (hash-get usage-acc "output_tokens") 0)) + (cost (compute-cost (provider-model provider) usage-acc)) + (tcs (unbox tool-calls-box))) + (when (tracing?) + (log-trace logger "grok-responses-stream-result" + `((content . ,content) + (tokens-in . ,in-tok) + (tokens-out . ,out-tok) + (tool-calls . ,(length tcs))))) + (values content tcs + (list (cons 'tokens-in in-tok) + (cons 'tokens-out out-tok) + (cons 'cost cost)) + (build-stats (unbox finish-reason-box) '() '()))))) + +;;; ================================================================ ;;; Model listing: live fetch from provider /models endpoints ;;; ================================================================ @@ -1714,6 +1963,7 @@ ((google) (google-list-models provider)) ((ollama) (ollama-list-models provider)) ((mlx) (ollama-list-models provider)) + ((grok) (grok-list-models provider)) (else (error 'provider-list-models (format "Unknown provider '~a'" (provider-name provider)))))) --- a/test/run.ss +++ b/test/run.ss @@ -1692,6 +1692,81 @@ (check! "ctx window grok-build = 512000" (model-context-window "grok-build") 512000) (check! "ctx window grok-3 unaffected (no clause)" (model-context-window "grok-3") #f) +;; ── provider: grok Responses adapter ────────────────────────────── +;; All hermetic — tests drive the pure helpers exported by the provider +;; module (responses-{headers,body,parse-response}, message->responses-input, +;; grok-backend-from, grok-list-models). No live HTTP. + +(section "=== provider: grok Responses ===") + +;; grok-backend-from: cache says responses by default; chat_completions when set. +(check! "grok-backend-from default → responses" (grok-backend-from '()) "responses") +(check! "grok-backend-from chat_completions" + (grok-backend-from '(("api_backend" . "chat_completions"))) "chat_completions") +(check! "grok-backend-from responses" + (grok-backend-from '(("api_backend" . "responses"))) "responses") + +;; responses-headers: Bearer token; no secret in the table key/value besides +;; the Authorization line. +(let ([h (responses-headers (make-provider "grok" "abc123" "grok-build" "https://x/v1"))]) + (check! "responses-headers content-type" + (cdr (assoc "Content-Type" h)) "application/json") + (check! "responses-headers bearer" + (cdr (assoc "Authorization" h)) "Bearer abc123")) + +;; message->responses-input: role + content; tool maps to user (no tools yet). +(let ([u (message->responses-input (make-user-message "hi"))]) + (check! "msg→resp role=user" (hashtable-ref u "role" #f) "user") + (check! "msg→resp content=hi" (hashtable-ref u "content" #f) "hi")) +(let ([a (message->responses-input (make-assistant-message "out"))]) + (check! "msg→resp role=assistant" (hashtable-ref a "role" #f) "assistant") + (check! "msg→resp content=out" (hashtable-ref a "content" #f) "out")) +(let ([s (message->responses-input (make-system-message "sys"))]) + (check! "msg→resp role=system" (hashtable-ref s "role" #f) "system")) +(let ([t (message->responses-input (make-tool-result "cid" "result-text"))]) + (check! "msg→resp tool→user" (hashtable-ref t "role" #f) "user") + (check! "msg→resp tool content" (hashtable-ref t "content" #f) "result-text")) + +;; responses-body: model + input present; tools deliberately NOT serialized +;; (first-pass scope — Responses tool spec unverified against cli-chat-proxy). +(let* ([p (make-provider "grok" "k" "grok-build" "https://x/v1")] + [b (responses-body p (list (make-user-message "hi")) '())]) + (check! "responses-body model" (hashtable-ref b "model" #f) "grok-build") + (check-pred! "responses-body input list" (hashtable-ref b "input" #f) list?) + (check! "responses-body no tools (empty tools)" + (hashtable-ref b "tools" #f) #f)) +(let* ([p (make-provider "grok" "k" "grok-build" "https://x/v1")] + [b (responses-body p '() (list (make-hashtable equal-hash equal?)))]) + (check! "responses-body no tools (non-empty tools still skipped)" + (hashtable-ref b "tools" #f) #f)) + +;; responses-parse-response: plain text → assistant message, no tool calls. +(let ([m (responses-parse-response + (string->json-object + "{\"output\":[{\"type\":\"message\",\"role\":\"assistant\",\"content\":[{\"type\":\"output_text\",\"text\":\"Hello world\"}]}]}"))]) + (check! "responses-parse text" (message-content m) "Hello world") + (check! "responses-parse no tcs" (message-tool-calls m) #f)) + +;; responses-parse-response: function_call output items become tool calls. +(let ([m (responses-parse-response + (string->json-object + "{\"output\":[{\"type\":\"function_call\",\"id\":\"call_1\",\"name\":\"search\",\"arguments\":\"{\\\"q\\\":\\\"x\\\"}\"}]}"))]) + (check-pred! "responses-parse fc → tcs" + (message-tool-calls m) (lambda (tcs) (and (pair? tcs) (= 1 (length tcs))))) + (let ([tc (car (message-tool-calls m))]) + (check! "responses-parse fc name" (tool-call-name tc) "search") + (check! "responses-parse fc id" (tool-call-id tc) "call_1"))) + +;; responses-parse-response: empty output → empty content, no tcs. +(let ([m (responses-parse-response (string->json-object "{\"output\":[]}"))]) + (check! "responses-parse empty text" (message-content m) "") + (check! "responses-parse empty no tcs" (message-tool-calls m) #f)) + +;; grok-list-models: always includes grok-build (cache or fallback). +(check-pred! "grok-list-models has grok-build" + (grok-list-models (make-provider "grok" "" "grok-build" "https://x/v1")) + (lambda (ms) (assoc "grok-build" ms))) + ;; ── Results ─────────────────────────────────────────────────────── (printf "~n~a passed, ~a failed~n" pass-count fail-count)