fixes
ober
68dcb3fd479318fc7f7de76cf03e674952b2b358
--- a/src/jcode/provider/openai.ss +++ b/src/jcode/provider/openai.ss @@ -10,6 +10,10 @@ current-max-tokens-floor current-tool-choice-override current-openai-object-tool-arguments + current-openai-flatten-tool-history + current-openai-suppress-tools + sanitize-openai-wire-messages + flatten-openai-tool-history openai-tool-argument-mapping-error? call-with-openai-tool-argument-retry openai-body @@ -750,6 +754,8 @@ (message-thinking msg))))))))) (def current-openai-object-tool-arguments (make-parameter #f)) +(def current-openai-flatten-tool-history (make-parameter #f)) +(def current-openai-suppress-tools (make-parameter #f)) (def (openai-condition-string e) (with-output-to-string (lambda () (display-condition e)))) @@ -759,15 +765,260 @@ (and (string-contains msg "API error 400") (string-contains msg "Can only get item pairs from a mapping")))) +;; Some OpenAI-compatible servers validate the messages array with strict +;; mapping checks and 400 on structural variants the OpenAI reference server +;; accepts ("Can only get item pairs from a mapping"). Recover with an +;; escalating sanitization ladder, re-attempting the identical request after +;; each projection change: +;; stage 1 - tool_call arguments as parsed JSON objects instead of strings +;; stage 2 - no tool structure in history: assistant tool_calls become a +;; text bridge and role:"tool" results become plain user text +;; stage 3 - additionally drop tools/tool_choice for this attempt +;; Only the mapping-validation 400 advances the ladder; any other error +;; propagates immediately, and a stage-3 failure re-raises to the caller. (def (call-with-openai-tool-argument-retry thunk) - (guard (e - ((and (not (current-openai-object-tool-arguments)) - (openai-tool-argument-mapping-error? e)) - (log-warn logger "retrying-with-object-tool-arguments" '()) - (parameterize ((current-openai-object-tool-arguments #t)) - (thunk))) - (else (raise e))) - (thunk))) + (let loop ((stage 0)) + (guard (e + ((and (< stage 3) (openai-tool-argument-mapping-error? e)) + (let ((next (+ stage 1))) + (log-warn logger "openai-mapping-error-retry" + `((stage . ,next) + (object-arguments . ,(>= next 1)) + (flatten-tool-history . ,(>= next 2)) + (suppress-tools . ,(>= next 3)))) + (parameterize ((current-openai-object-tool-arguments (>= next 1)) + (current-openai-flatten-tool-history (>= next 2)) + (current-openai-suppress-tools (>= next 3))) + (loop next)))) + (else (raise e))) + (thunk)))) + +;;; Wire sanitization + tool-history flattening ;;; + +;; Final invariant pass over the outgoing messages array: every element must +;; be a JSON object with a string role and string content, tool_calls (when +;; present) a non-empty list of {id,type,function{name,arguments}} objects +;; with non-empty string ids, and tool results must carry a non-empty string +;; tool_call_id. Clean messages pass through by identity; repairs are copied, +;; counted, and logged so a malformed projection can never reach the server. + +(def (map-with-index f lst) + (let ((i (box -1))) + (map (lambda (x) + (set-box! i (+ 1 (unbox i))) + (f x (unbox i))) + lst))) + +(def (openai-wire-coerce-content v) + (cond ((string? v) v) + ((not v) "") + (else (format "~a" v)))) + +(def (openai-wire-text-message role content) + (let ((m (make-hash-table))) + (hash-put! m "role" role) + (hash-put! m "content" content) + m)) + +(def (sanitize-openai-wire-arguments v) + (cond + ((string? v) v) + ((hash-table? v) v) + ((not v) "{}") + (else (guard (_ [else "{}"]) (json-object->string v))))) + +(def (openai-wire-call-name fn) + (let ((name (and (hash-table? fn) (hash-get fn "name")))) + (if (string? name) name "unknown"))) + +(def (openai-wire-call-arguments fn) + (sanitize-openai-wire-arguments + (and (hash-table? fn) (hash-get fn "arguments")))) + +(def (openai-wire-call-arguments-text fn) + (let ((args (openai-wire-call-arguments fn))) + (if (string? args) args (json-object->string args)))) + +(def (openai-wire-call-id tc i j) + (let ((id (and (hash-table? tc) (hash-get tc "id")))) + (if (openai-nonempty-id? id) + id + (format "call_san_~a_~a" i j)))) + +(def (openai-wire-call-ok? tc fn) + (and (hash-table? tc) + (hash-table? fn) + (openai-nonempty-id? (hash-get tc "id")) + (string? (hash-get fn "name")) + (let ((a (hash-get fn "arguments"))) + (or (string? a) (hash-table? a))))) + +(def (rebuild-openai-wire-call tc fn i j) + (let ((call (make-hash-table)) + (new-fn (make-hash-table))) + (hash-put! call "id" (openai-wire-call-id tc i j)) + (hash-put! call "type" "function") + (hash-put! new-fn "name" (openai-wire-call-name fn)) + (hash-put! new-fn "arguments" (openai-wire-call-arguments fn)) + (hash-put! call "function" new-fn) + call)) + +(def (sanitize-openai-wire-call tc i j) + (let ((fn (and (hash-table? tc) (hash-get tc "function")))) + (if (openai-wire-call-ok? tc fn) + tc + (rebuild-openai-wire-call tc fn i j)))) + +(def (sanitize-openai-wire-call-list calls i changed) + (map-with-index + (lambda (tc j) + (let ((c (sanitize-openai-wire-call tc i j))) + (unless (eq? c tc) (set-box! changed #t)) + c)) + calls)) + +(def (repair-openai-wire-assistant json content new-calls repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" new-calls) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-assistant-calls json content calls i repaired) + (let ((changed (box #f))) + (let ((new-calls (sanitize-openai-wire-call-list calls i changed))) + (if (and (not (unbox changed)) (string? content)) + json + (repair-openai-wire-assistant json content new-calls repaired))))) + +(def (repair-openai-wire-assistant-plain json content drop-calls? repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (when drop-calls? (hash-remove! copy "tool_calls")) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-assistant-plain json content repaired) + ;; Assistant without (or with a malformed/empty) tool_calls projection. + ;; Content must be a string; a present-but-useless tool_calls key is dropped. + (let ((drop-calls? (hash-key? json "tool_calls")) + (content-ok? (string? content))) + (if (and (not drop-calls?) content-ok?) + json + (repair-openai-wire-assistant-plain json content drop-calls? repaired)))) + +(def (sanitize-openai-wire-assistant json i repaired) + (let ((content (hash-get json "content")) + (calls (hash-get json "tool_calls"))) + (if (pair? calls) + (sanitize-openai-wire-assistant-calls json content calls i repaired) + (sanitize-openai-wire-assistant-plain json content repaired)))) + +(def (repair-openai-wire-tool json tcid content i repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (unless (openai-nonempty-id? tcid) + (hash-put! copy "tool_call_id" (format "call_san_~a" i))) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-tool json i repaired) + (let ((tcid (hash-get json "tool_call_id")) + (content (hash-get json "content"))) + (if (and (openai-nonempty-id? tcid) (string? content)) + json + (repair-openai-wire-tool json tcid content i repaired)))) + +(def (sanitize-openai-wire-text json content repaired) + (if (string? content) + json + (begin + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (hash-put! copy "content" (openai-wire-coerce-content content)) + copy)))) + +(def (repair-openai-wire-unknown-role json role content repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (openai-wire-text-message + (if (string? role) role "user") + (openai-wire-coerce-content content))) + +(def (sanitize-openai-wire-hash-message json i repaired) + (let ((role (hash-get json "role")) + (content (hash-get json "content"))) + (cond + ((equal? role "assistant") + (sanitize-openai-wire-assistant json i repaired)) + ((equal? role "tool") + (sanitize-openai-wire-tool json i repaired)) + ((or (equal? role "system") (equal? role "user")) + (sanitize-openai-wire-text json content repaired)) + (else (repair-openai-wire-unknown-role json role content repaired))))) + +(def (sanitize-openai-wire-message json i repaired) + (if (hash-table? json) + (sanitize-openai-wire-hash-message json i repaired) + (begin + (set-box! repaired (+ 1 (unbox repaired))) + (openai-wire-text-message "user" (format "~a" json))))) + +(def (sanitize-openai-wire-messages json-messages) + (let ((repaired (box 0))) + (let ((out (map-with-index + (lambda (json i) + (sanitize-openai-wire-message json i repaired)) + json-messages))) + (when (> (unbox repaired) 0) + (log-warn logger "sanitize-openai-wire-messages" + `((repairs . ,(unbox repaired))))) + out))) + +(def (openai-wire-call->text tc) + (let ((fn (and (hash-table? tc) (hash-get tc "function")))) + (string-append "Called tool " (openai-wire-call-name fn) + " with arguments " (openai-wire-call-arguments-text fn)))) + +(def (flatten-openai-wire-calls-bridge calls) + (string-join (map openai-wire-call->text calls) "\n")) + +(def (flatten-openai-wire-assistant json) + (let ((content (hash-get json "content")) + (bridge (flatten-openai-wire-calls-bridge (hash-get json "tool_calls")))) + (openai-wire-text-message "assistant" + (if (and (string? content) (> (string-length content) 0)) + (string-append content "\n" bridge) + bridge)))) + +(def (flatten-openai-wire-tool json) + (let ((content (openai-wire-coerce-content (hash-get json "content")))) + (openai-wire-text-message "user" + (string-append "Tool result: " content)))) + +(def (flatten-assistant-candidate? json role) + (and (equal? role "assistant") + (hash-table? json) + (pair? (hash-get json "tool_calls")))) + +(def (flatten-openai-wire-message json) + (let ((role (and (hash-table? json) (hash-get json "role")))) + (cond + ((flatten-assistant-candidate? json role) + (flatten-openai-wire-assistant json)) + ((equal? role "tool") + (flatten-openai-wire-tool json)) + (else json)))) + +(def (flatten-openai-tool-history json-messages) + (map flatten-openai-wire-message json-messages)) + +(def (maybe-flatten-openai-tool-history json-messages) + (if (current-openai-flatten-tool-history) + (flatten-openai-tool-history json-messages) + json-messages)) (def (openai-chat provider messages tools) (call-with-openai-tool-argument-retry @@ -967,10 +1218,13 @@ (hash-put! opts "include_usage" #t) (hash-put! body "stream_options" opts))) (hash-put! body "messages" - (openai-correlate-tool-result-ids - (map (lambda (m) (openai-message->json provider m)) messages))) + (sanitize-openai-wire-messages + (openai-correlate-tool-result-ids + (maybe-flatten-openai-tool-history + (map (lambda (m) (openai-message->json provider m)) messages))))) (when (and tools (not (null? tools)) - (model-supports-tools? provider)) + (model-supports-tools? provider) + (not (current-openai-suppress-tools))) (hash-put! body "tools" tools) (hash-put! body "tool_choice" (openai-tool-choice provider))) body)) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -16,6 +16,10 @@ current-max-tokens-floor current-tool-choice-override current-openai-object-tool-arguments + current-openai-flatten-tool-history + current-openai-suppress-tools + sanitize-openai-wire-messages + flatten-openai-tool-history openai-tool-argument-mapping-error? call-with-openai-tool-argument-retry openai-body @@ -1616,6 +1620,8 @@ (message-thinking msg))))))))) (def current-openai-object-tool-arguments (make-parameter #f)) +(def current-openai-flatten-tool-history (make-parameter #f)) +(def current-openai-suppress-tools (make-parameter #f)) (def (openai-condition-string e) (with-output-to-string (lambda () (display-condition e)))) @@ -1625,15 +1631,260 @@ (and (string-contains msg "API error 400") (string-contains msg "Can only get item pairs from a mapping")))) +;; Some OpenAI-compatible servers validate the messages array with strict +;; mapping checks and 400 on structural variants the OpenAI reference server +;; accepts ("Can only get item pairs from a mapping"). Recover with an +;; escalating sanitization ladder, re-attempting the identical request after +;; each projection change: +;; stage 1 - tool_call arguments as parsed JSON objects instead of strings +;; stage 2 - no tool structure in history: assistant tool_calls become a +;; text bridge and role:"tool" results become plain user text +;; stage 3 - additionally drop tools/tool_choice for this attempt +;; Only the mapping-validation 400 advances the ladder; any other error +;; propagates immediately, and a stage-3 failure re-raises to the caller. (def (call-with-openai-tool-argument-retry thunk) - (guard (e - ((and (not (current-openai-object-tool-arguments)) - (openai-tool-argument-mapping-error? e)) - (log-warn logger "retrying-with-object-tool-arguments" '()) - (parameterize ((current-openai-object-tool-arguments #t)) - (thunk))) - (else (raise e))) - (thunk))) + (let loop ((stage 0)) + (guard (e + ((and (< stage 3) (openai-tool-argument-mapping-error? e)) + (let ((next (+ stage 1))) + (log-warn logger "openai-mapping-error-retry" + `((stage . ,next) + (object-arguments . ,(>= next 1)) + (flatten-tool-history . ,(>= next 2)) + (suppress-tools . ,(>= next 3)))) + (parameterize ((current-openai-object-tool-arguments (>= next 1)) + (current-openai-flatten-tool-history (>= next 2)) + (current-openai-suppress-tools (>= next 3))) + (loop next)))) + (else (raise e))) + (thunk)))) + +;;; Wire sanitization + tool-history flattening ;;; + +;; Final invariant pass over the outgoing messages array: every element must +;; be a JSON object with a string role and string content, tool_calls (when +;; present) a non-empty list of {id,type,function{name,arguments}} objects +;; with non-empty string ids, and tool results must carry a non-empty string +;; tool_call_id. Clean messages pass through by identity; repairs are copied, +;; counted, and logged so a malformed projection can never reach the server. + +(def (map-with-index f lst) + (let ((i (box -1))) + (map (lambda (x) + (set-box! i (+ 1 (unbox i))) + (f x (unbox i))) + lst))) + +(def (openai-wire-coerce-content v) + (cond ((string? v) v) + ((not v) "") + (else (format "~a" v)))) + +(def (openai-wire-text-message role content) + (let ((m (make-hash-table))) + (hash-put! m "role" role) + (hash-put! m "content" content) + m)) + +(def (sanitize-openai-wire-arguments v) + (cond + ((string? v) v) + ((hash-table? v) v) + ((not v) "{}") + (else (guard (_ [else "{}"]) (json-object->string v))))) + +(def (openai-wire-call-name fn) + (let ((name (and (hash-table? fn) (hash-get fn "name")))) + (if (string? name) name "unknown"))) + +(def (openai-wire-call-arguments fn) + (sanitize-openai-wire-arguments + (and (hash-table? fn) (hash-get fn "arguments")))) + +(def (openai-wire-call-arguments-text fn) + (let ((args (openai-wire-call-arguments fn))) + (if (string? args) args (json-object->string args)))) + +(def (openai-wire-call-id tc i j) + (let ((id (and (hash-table? tc) (hash-get tc "id")))) + (if (openai-nonempty-id? id) + id + (format "call_san_~a_~a" i j)))) + +(def (openai-wire-call-ok? tc fn) + (and (hash-table? tc) + (hash-table? fn) + (openai-nonempty-id? (hash-get tc "id")) + (string? (hash-get fn "name")) + (let ((a (hash-get fn "arguments"))) + (or (string? a) (hash-table? a))))) + +(def (rebuild-openai-wire-call tc fn i j) + (let ((call (make-hash-table)) + (new-fn (make-hash-table))) + (hash-put! call "id" (openai-wire-call-id tc i j)) + (hash-put! call "type" "function") + (hash-put! new-fn "name" (openai-wire-call-name fn)) + (hash-put! new-fn "arguments" (openai-wire-call-arguments fn)) + (hash-put! call "function" new-fn) + call)) + +(def (sanitize-openai-wire-call tc i j) + (let ((fn (and (hash-table? tc) (hash-get tc "function")))) + (if (openai-wire-call-ok? tc fn) + tc + (rebuild-openai-wire-call tc fn i j)))) + +(def (sanitize-openai-wire-call-list calls i changed) + (map-with-index + (lambda (tc j) + (let ((c (sanitize-openai-wire-call tc i j))) + (unless (eq? c tc) (set-box! changed #t)) + c)) + calls)) + +(def (repair-openai-wire-assistant json content new-calls repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" new-calls) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-assistant-calls json content calls i repaired) + (let ((changed (box #f))) + (let ((new-calls (sanitize-openai-wire-call-list calls i changed))) + (if (and (not (unbox changed)) (string? content)) + json + (repair-openai-wire-assistant json content new-calls repaired))))) + +(def (repair-openai-wire-assistant-plain json content drop-calls? repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (when drop-calls? (hash-remove! copy "tool_calls")) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-assistant-plain json content repaired) + ;; Assistant without (or with a malformed/empty) tool_calls projection. + ;; Content must be a string; a present-but-useless tool_calls key is dropped. + (let ((drop-calls? (hash-key? json "tool_calls")) + (content-ok? (string? content))) + (if (and (not drop-calls?) content-ok?) + json + (repair-openai-wire-assistant-plain json content drop-calls? repaired)))) + +(def (sanitize-openai-wire-assistant json i repaired) + (let ((content (hash-get json "content")) + (calls (hash-get json "tool_calls"))) + (if (pair? calls) + (sanitize-openai-wire-assistant-calls json content calls i repaired) + (sanitize-openai-wire-assistant-plain json content repaired)))) + +(def (repair-openai-wire-tool json tcid content i repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (unless (openai-nonempty-id? tcid) + (hash-put! copy "tool_call_id" (format "call_san_~a" i))) + (unless (string? content) + (hash-put! copy "content" (openai-wire-coerce-content content))) + copy)) + +(def (sanitize-openai-wire-tool json i repaired) + (let ((tcid (hash-get json "tool_call_id")) + (content (hash-get json "content"))) + (if (and (openai-nonempty-id? tcid) (string? content)) + json + (repair-openai-wire-tool json tcid content i repaired)))) + +(def (sanitize-openai-wire-text json content repaired) + (if (string? content) + json + (begin + (set-box! repaired (+ 1 (unbox repaired))) + (let ((copy (hash-copy json))) + (hash-put! copy "content" (openai-wire-coerce-content content)) + copy)))) + +(def (repair-openai-wire-unknown-role json role content repaired) + (set-box! repaired (+ 1 (unbox repaired))) + (openai-wire-text-message + (if (string? role) role "user") + (openai-wire-coerce-content content))) + +(def (sanitize-openai-wire-hash-message json i repaired) + (let ((role (hash-get json "role")) + (content (hash-get json "content"))) + (cond + ((equal? role "assistant") + (sanitize-openai-wire-assistant json i repaired)) + ((equal? role "tool") + (sanitize-openai-wire-tool json i repaired)) + ((or (equal? role "system") (equal? role "user")) + (sanitize-openai-wire-text json content repaired)) + (else (repair-openai-wire-unknown-role json role content repaired))))) + +(def (sanitize-openai-wire-message json i repaired) + (if (hash-table? json) + (sanitize-openai-wire-hash-message json i repaired) + (begin + (set-box! repaired (+ 1 (unbox repaired))) + (openai-wire-text-message "user" (format "~a" json))))) + +(def (sanitize-openai-wire-messages json-messages) + (let ((repaired (box 0))) + (let ((out (map-with-index + (lambda (json i) + (sanitize-openai-wire-message json i repaired)) + json-messages))) + (when (> (unbox repaired) 0) + (log-warn logger "sanitize-openai-wire-messages" + `((repairs . ,(unbox repaired))))) + out))) + +(def (openai-wire-call->text tc) + (let ((fn (and (hash-table? tc) (hash-get tc "function")))) + (string-append "Called tool " (openai-wire-call-name fn) + " with arguments " (openai-wire-call-arguments-text fn)))) + +(def (flatten-openai-wire-calls-bridge calls) + (string-join (map openai-wire-call->text calls) "\n")) + +(def (flatten-openai-wire-assistant json) + (let ((content (hash-get json "content")) + (bridge (flatten-openai-wire-calls-bridge (hash-get json "tool_calls")))) + (openai-wire-text-message "assistant" + (if (and (string? content) (> (string-length content) 0)) + (string-append content "\n" bridge) + bridge)))) + +(def (flatten-openai-wire-tool json) + (let ((content (openai-wire-coerce-content (hash-get json "content")))) + (openai-wire-text-message "user" + (string-append "Tool result: " content)))) + +(def (flatten-assistant-candidate? json role) + (and (equal? role "assistant") + (hash-table? json) + (pair? (hash-get json "tool_calls")))) + +(def (flatten-openai-wire-message json) + (let ((role (and (hash-table? json) (hash-get json "role")))) + (cond + ((flatten-assistant-candidate? json role) + (flatten-openai-wire-assistant json)) + ((equal? role "tool") + (flatten-openai-wire-tool json)) + (else json)))) + +(def (flatten-openai-tool-history json-messages) + (map flatten-openai-wire-message json-messages)) + +(def (maybe-flatten-openai-tool-history json-messages) + (if (current-openai-flatten-tool-history) + (flatten-openai-tool-history json-messages) + json-messages)) (def (openai-chat provider messages tools) (call-with-openai-tool-argument-retry @@ -1852,10 +2103,13 @@ (hash-put! opts "include_usage" #t) (hash-put! body "stream_options" opts))) (hash-put! body "messages" - (openai-correlate-tool-result-ids - (map (lambda (m) (openai-message->json provider m)) messages))) + (sanitize-openai-wire-messages + (openai-correlate-tool-result-ids + (maybe-flatten-openai-tool-history + (map (lambda (m) (openai-message->json provider m)) messages))))) (when (and tools (not (null? tools)) - (model-supports-tools? provider)) + (model-supports-tools? provider) + (not (current-openai-suppress-tools))) (hash-put! body "tools" tools) (hash-put! body "tool_choice" (openai-tool-choice provider))) body)) --- a/test/run.ss +++ b/test/run.ss @@ -2,6 +2,7 @@ ;;; jcode test suite (import (scheme) + (prefix (jerboa core) j:) (jcode core log) (jcode core agent-defs) (jcode tool task) @@ -474,6 +475,128 @@ "API error 400: Can only get item pairs from a mapping"))))]) (check! "mapping-template failure retries once" result "retried") (check! "mapping-template retry attempt count" attempts 2))) +(let ([attempts 0] + [stages '()]) + (let ([result + (call-with-openai-tool-argument-retry + (lambda () + (set! attempts (+ attempts 1)) + (set! stages + (cons (list (and (current-openai-object-tool-arguments) #t) + (and (current-openai-flatten-tool-history) #t) + (and (current-openai-suppress-tools) #t)) + stages)) + (if (current-openai-suppress-tools) + "survived" + (error 'provider + "API error 400: Can only get item pairs from a mapping"))))]) + (check! "mapping ladder reaches final stage" result "survived") + (check! "mapping ladder attempt count" attempts 4) + (check! "mapping ladder stage progression" (reverse stages) + '((#f #f #f) (#t #f #f) (#t #t #f) (#t #t #t))))) + +(check-pred! "mapping ladder gives up after final stage" + (guard (e [else 'caught]) + (call-with-openai-tool-argument-retry + (lambda () + (error 'provider + "API error 400: Can only get item pairs from a mapping")))) + (lambda (x) (eq? x 'caught))) + +(let ([attempts 0]) + (check-pred! "non-mapping provider error not retried" + (guard (e [else (list 'caught attempts)]) + (call-with-openai-tool-argument-retry + (lambda () + (set! attempts (+ attempts 1)) + (error 'provider "API error 500: boom")))) + (lambda (x) + (and (pair? x) (eq? (car x) 'caught) (= (cadr x) 1))))) + +(let ([clean (j:make-hash-table)]) + (j:hash-put! clean "role" "user") + (j:hash-put! clean "content" "hi") + (check! "sanitize keeps clean message identical" + (eq? (car (sanitize-openai-wire-messages (list clean))) clean) #t)) + +(let ([out (sanitize-openai-wire-messages (list "oops"))]) + (check! "sanitize coerces non-hash element role" + (j:hash-get (car out) "role") "user") + (check! "sanitize coerces non-hash element content" + (j:hash-get (car out) "content") "oops")) + +(let ([tool (j:make-hash-table)]) + (j:hash-put! tool "role" "tool") + (j:hash-put! tool "tool_call_id" "") + (j:hash-put! tool "content" "res") + (let ([fixed (car (sanitize-openai-wire-messages (list tool)))]) + (check! "sanitize fills empty tool_call_id" + (j:hash-get fixed "tool_call_id") "call_san_0") + (check! "sanitize preserves tool role" + (j:hash-get fixed "role") "tool"))) + +(let ([asst (j:make-hash-table)]) + (j:hash-put! asst "role" "assistant") + (j:hash-put! asst "content" "hi") + (j:hash-put! asst "tool_calls" '()) + (check! "sanitize drops empty tool_calls" + (j:hash-get (car (sanitize-openai-wire-messages (list asst))) "tool_calls") + #f)) + +(let ([asst (j:make-hash-table)] + [tc (j:make-hash-table)] + [fn (j:make-hash-table)]) + (j:hash-put! fn "name" "bash") + (j:hash-put! fn "arguments" "{}") + (j:hash-put! tc "id" "") + (j:hash-put! tc "type" "function") + (j:hash-put! tc "function" fn) + (j:hash-put! asst "role" "assistant") + (j:hash-put! asst "content" "") + (j:hash-put! asst "tool_calls" (list tc)) + (let* ([fixed (car (sanitize-openai-wire-messages (list asst)))] + [calls (j:hash-get fixed "tool_calls")] + [call (car calls)]) + (check! "sanitize fills empty tool_call id" + (j:hash-get call "id") "call_san_0_0") + (check! "sanitize keeps call function name" + (j:hash-get (j:hash-get call "function") "name") "bash"))) + +(let ([asst (j:make-hash-table)] + [tc (j:make-hash-table)] + [fn (j:make-hash-table)] + [tool (j:make-hash-table)]) + (j:hash-put! fn "name" "bash") + (j:hash-put! fn "arguments" "{\"command\":\"ls\"}") + (j:hash-put! tc "id" "c1") + (j:hash-put! tc "type" "function") + (j:hash-put! tc "function" fn) + (j:hash-put! asst "role" "assistant") + (j:hash-put! asst "content" "") + (j:hash-put! asst "tool_calls" (list tc)) + (j:hash-put! tool "role" "tool") + (j:hash-put! tool "tool_call_id" "c1") + (j:hash-put! tool "content" "file.txt") + (let ([out (flatten-openai-tool-history (list asst tool))]) + (check! "flatten removes tool_calls key" + (j:hash-get (car out) "tool_calls") #f) + (check! "flatten keeps assistant role" + (j:hash-get (car out) "role") "assistant") + (check! "flatten assistant bridges call as text" + (j:hash-get (car out) "content") + "Called tool bash with arguments {\"command\":\"ls\"}") + (check! "flatten rewrites tool result as user" + (j:hash-get (cadr out) "role") "user") + (check! "flatten preserves tool result text" + (j:hash-get (cadr out) "content") "Tool result: file.txt"))) + +(let ([p (make-provider "unit-openai" "unit-key" "unit-model" + "http://127.0.0.1:1/v1")]) + (parameterize ([current-openai-suppress-tools #t]) + (let ([body (openai-body p '() (list (j:make-hash-table)))]) + (check! "suppress-tools drops tools key" (j:hash-get body "tools") #f) + (check! "suppress-tools drops tool_choice" + (j:hash-get body "tool_choice") #f)))) (let ([m (make-tool-result "call-123" "result")]) (check! "tool-result role" (message-role m) "tool")