Fix OpenAI tool-call history compatibility
ober
48d283efb01b4cb1a9b18ee49f655ee79b3e82e1
--- a/src/jcode/core/message.ss +++ b/src/jcode/core/message.ss @@ -153,8 +153,12 @@ #f))) (def (json->tool-call json) - (let ((fn (hash-ref json "function" #f))) + (let* ((fn (hash-ref json "function" #f)) + (raw-id (hash-ref json "id" "")) + (id (if (and (string? raw-id) (> (string-length raw-id) 0)) + raw-id + (uuid-string)))) (restore-tool-call - (hash-ref json "id" "") + id (hash-ref fn "name" "") (hash-ref fn "arguments" "{}")))) --- a/src/jcode/provider/openai.ss +++ b/src/jcode/provider/openai.ss @@ -9,6 +9,10 @@ current-max-tokens-cap current-max-tokens-floor current-tool-choice-override + current-openai-object-tool-arguments + openai-tool-argument-mapping-error? + call-with-openai-tool-argument-retry + openai-body openai-function-tool-choice hashish-get openai-tool-choice-name @@ -745,7 +749,107 @@ (message-tool-call-id msg) (message-thinking msg))))))))) +(def current-openai-object-tool-arguments (make-parameter #f)) + +(def (openai-condition-string e) + (with-output-to-string (lambda () (display-condition e)))) + +(def (openai-tool-argument-mapping-error? e) + (let ((msg (openai-condition-string e))) + (and (string-contains msg "API error 400") + (string-contains msg "Can only get item pairs from a mapping")))) + +(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))) + (def (openai-chat provider messages tools) + (call-with-openai-tool-argument-retry + (lambda () (openai-chat-once provider messages tools)))) + +(def (openai-tool-call-with-object-arguments tc) + (let* ((fn (hash-get tc "function")) + (args (and (hash-table? fn) (hash-get fn "arguments"))) + (parsed + (and (string? args) + (guard (e (#t #f)) + (string->json-object args))))) + (if (and parsed (hash-table? parsed)) + (let ((tc-copy (hash-copy tc)) + (fn-copy (hash-copy fn))) + (hash-put! fn-copy "arguments" parsed) + (hash-put! tc-copy "function" fn-copy) + tc-copy) + tc))) + +(def (openai-json-with-object-tool-arguments json) + (let ((calls (hash-get json "tool_calls"))) + (if (and calls (pair? calls)) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" + (map openai-tool-call-with-object-arguments calls)) + copy) + json))) + +(def (openai-nonempty-id? id) + (and (string? id) (> (string-length id) 0))) + +(def (openai-normalize-assistant-call-ids json message-index) + (let ((calls (hash-get json "tool_calls"))) + (if (not (and calls (pair? calls))) + (cons json '()) + (let loop ((rest calls) (tool-index 0) (out '()) (ids '())) + (if (null? rest) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" (reverse out)) + (cons copy (reverse ids))) + (let* ((call (car rest)) + (raw-id (hash-get call "id")) + (id (if (openai-nonempty-id? raw-id) + raw-id + (format "call_legacy_~a_~a" message-index tool-index))) + (copy (hash-copy call))) + (hash-put! copy "id" id) + (loop (cdr rest) (+ tool-index 1) + (cons copy out) (cons id ids)))))))) + +(def (openai-correlate-tool-result-ids json-messages) + (let loop ((rest json-messages) (message-index 0) (pending '()) (out '())) + (if (null? rest) + (reverse out) + (let* ((json (car rest)) + (role (hash-get json "role"))) + (cond + ((equal? role "assistant") + (let* ((normalized + (openai-normalize-assistant-call-ids json message-index)) + (next-json (car normalized)) + (ids (cdr normalized))) + (loop (cdr rest) (+ message-index 1) ids + (cons next-json out)))) + ((equal? role "tool") + (let* ((raw-id (hash-get json "tool_call_id")) + (needs-id (not (openai-nonempty-id? raw-id))) + (next-json + (if (and needs-id (pair? pending)) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_call_id" (car pending)) + copy) + json)) + (next-pending + (if (pair? pending) (cdr pending) pending))) + (loop (cdr rest) (+ message-index 1) next-pending + (cons next-json out)))) + (else + (loop (cdr rest) (+ message-index 1) '() + (cons json out)))))))) +(def (openai-chat-once provider messages tools) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) (body (openai-body provider messages tools))) @@ -862,7 +966,9 @@ (let ((opts (make-hash-table))) (hash-put! opts "include_usage" #t) (hash-put! body "stream_options" opts))) - (hash-put! body "messages" (map (lambda (m) (openai-message->json provider m)) messages)) + (hash-put! body "messages" + (openai-correlate-tool-result-ids + (map (lambda (m) (openai-message->json provider m)) messages))) (when (and tools (not (null? tools)) (model-supports-tools? provider)) (hash-put! body "tools" tools) @@ -879,18 +985,21 @@ (and (string? s) (string=? s "")))) (def (openai-message->json provider msg) - (let ((j (message->json-cached msg))) - ;; Moonshot Kimi K3 rejects assistant history entries whose content is the - ;; empty string. Keep the tool-call history intact and add a minimal text - ;; bridge for that provider only. - (if (and (moonshot-kimi-k3? provider) - (equal? (message-role msg) "assistant") - (blank-string? (hash-get j "content"))) - (let ((copy (hash-copy j))) - (hash-put! copy "content" - (if (message-tool-calls msg) "Calling tool." " ")) - copy) - j))) + (let* ((j (message->json-cached msg)) + ;; Moonshot Kimi K3 rejects assistant history entries whose content is + ;; empty. Preserve its tool calls while adding a minimal text bridge. + (compatible + (if (and (moonshot-kimi-k3? provider) + (equal? (message-role msg) "assistant") + (blank-string? (hash-get j "content"))) + (let ((copy (hash-copy j))) + (hash-put! copy "content" + (if (message-tool-calls msg) "Calling tool." " ")) + copy) + j))) + (if (current-openai-object-tool-arguments) + (openai-json-with-object-tool-arguments compatible) + compatible))) ;; Some models reject the `tools` parameter entirely (e.g. DeepSeek's ;; reasoner returns 400 "does not support Function Calling"). @@ -971,7 +1080,7 @@ (cons (cons 'routed-model routed) usage) usage))))) -(def (openai-chat-with-stats provider messages tools) +(def (openai-chat-with-stats-once provider messages tools) ;; Non-streaming variant of openai-chat that also returns a stats alist. ;; Returns (values message stats). (let* ((url (string-append (provider-base-url provider) "/chat/completions")) @@ -989,8 +1098,17 @@ (def (openai-stream-body provider messages tools) (openai-request-body provider messages tools #t)) +(def (openai-chat-with-stats provider messages tools) + (call-with-openai-tool-argument-retry + (lambda () + (openai-chat-with-stats-once provider messages tools)))) (def (openai-stream-chat provider messages tools token-cb) + (call-with-openai-tool-argument-retry + (lambda () + (openai-stream-chat-once provider messages tools token-cb)))) + +(def (openai-stream-chat-once provider messages tools token-cb) ;; Stream via SSE. Calls token-cb with each text token. ;; Returns (values content-string tool-call-list usage-alist) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) @@ -1159,7 +1277,8 @@ a))) (id (hash-get tc "id")) (fn (hash-get tc "function"))) - (when id (hash-put! acc "id" id)) + (when (openai-nonempty-id? id) + (hash-put! acc "id" id)) (when fn (let ((name (hash-get fn "name")) (args (hash-get fn "arguments"))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -15,6 +15,10 @@ current-max-tokens-cap current-max-tokens-floor current-tool-choice-override + current-openai-object-tool-arguments + openai-tool-argument-mapping-error? + call-with-openai-tool-argument-retry + openai-body openai-function-tool-choice current-stream-abort? model-rejects-tools? @@ -1611,7 +1615,107 @@ (message-tool-call-id msg) (message-thinking msg))))))))) +(def current-openai-object-tool-arguments (make-parameter #f)) + +(def (openai-condition-string e) + (with-output-to-string (lambda () (display-condition e)))) + +(def (openai-tool-argument-mapping-error? e) + (let ((msg (openai-condition-string e))) + (and (string-contains msg "API error 400") + (string-contains msg "Can only get item pairs from a mapping")))) + +(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))) + (def (openai-chat provider messages tools) + (call-with-openai-tool-argument-retry + (lambda () (openai-chat-once provider messages tools)))) + +(def (openai-tool-call-with-object-arguments tc) + (let* ((fn (hash-get tc "function")) + (args (and (hash-table? fn) (hash-get fn "arguments"))) + (parsed + (and (string? args) + (guard (e (#t #f)) + (string->json-object args))))) + (if (and parsed (hash-table? parsed)) + (let ((tc-copy (hash-copy tc)) + (fn-copy (hash-copy fn))) + (hash-put! fn-copy "arguments" parsed) + (hash-put! tc-copy "function" fn-copy) + tc-copy) + tc))) + +(def (openai-json-with-object-tool-arguments json) + (let ((calls (hash-get json "tool_calls"))) + (if (and calls (pair? calls)) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" + (map openai-tool-call-with-object-arguments calls)) + copy) + json))) + +(def (openai-nonempty-id? id) + (and (string? id) (> (string-length id) 0))) + +(def (openai-normalize-assistant-call-ids json message-index) + (let ((calls (hash-get json "tool_calls"))) + (if (not (and calls (pair? calls))) + (cons json '()) + (let loop ((rest calls) (tool-index 0) (out '()) (ids '())) + (if (null? rest) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_calls" (reverse out)) + (cons copy (reverse ids))) + (let* ((call (car rest)) + (raw-id (hash-get call "id")) + (id (if (openai-nonempty-id? raw-id) + raw-id + (format "call_legacy_~a_~a" message-index tool-index))) + (copy (hash-copy call))) + (hash-put! copy "id" id) + (loop (cdr rest) (+ tool-index 1) + (cons copy out) (cons id ids)))))))) + +(def (openai-correlate-tool-result-ids json-messages) + (let loop ((rest json-messages) (message-index 0) (pending '()) (out '())) + (if (null? rest) + (reverse out) + (let* ((json (car rest)) + (role (hash-get json "role"))) + (cond + ((equal? role "assistant") + (let* ((normalized + (openai-normalize-assistant-call-ids json message-index)) + (next-json (car normalized)) + (ids (cdr normalized))) + (loop (cdr rest) (+ message-index 1) ids + (cons next-json out)))) + ((equal? role "tool") + (let* ((raw-id (hash-get json "tool_call_id")) + (needs-id (not (openai-nonempty-id? raw-id))) + (next-json + (if (and needs-id (pair? pending)) + (let ((copy (hash-copy json))) + (hash-put! copy "tool_call_id" (car pending)) + copy) + json)) + (next-pending + (if (pair? pending) (cdr pending) pending))) + (loop (cdr rest) (+ message-index 1) next-pending + (cons next-json out)))) + (else + (loop (cdr rest) (+ message-index 1) '() + (cons json out)))))))) +(def (openai-chat-once provider messages tools) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) (body (openai-body provider messages tools))) @@ -1747,7 +1851,9 @@ (let ((opts (make-hash-table))) (hash-put! opts "include_usage" #t) (hash-put! body "stream_options" opts))) - (hash-put! body "messages" (map (lambda (m) (openai-message->json provider m)) messages)) + (hash-put! body "messages" + (openai-correlate-tool-result-ids + (map (lambda (m) (openai-message->json provider m)) messages))) (when (and tools (not (null? tools)) (model-supports-tools? provider)) (hash-put! body "tools" tools) @@ -1765,17 +1871,16 @@ (def (openai-message->json provider msg) (let ((j (message->json msg))) - ;; Moonshot Kimi K3 rejects assistant history entries whose content is the - ;; empty string. Keep the tool-call history intact and add a minimal text - ;; bridge for that provider only. + ;; Moonshot Kimi K3 rejects assistant history entries whose content is + ;; empty. Preserve its tool calls while adding a minimal text bridge. (when (and (moonshot-kimi-k3? provider) (equal? (message-role msg) "assistant") (blank-string? (hash-get j "content"))) (hash-put! j "content" - (if (message-tool-calls msg) - "Calling tool." - " "))) - j)) + (if (message-tool-calls msg) "Calling tool." " "))) + (if (current-openai-object-tool-arguments) + (openai-json-with-object-tool-arguments j) + j))) ;; Some models reject the `tools` parameter entirely (e.g. DeepSeek's ;; reasoner returns 400 "does not support Function Calling"). @@ -1851,7 +1956,7 @@ (append (build-stats fr (unbox lp-box) (unbox en-box)) (openai-usage->alist provider (hash-get json "usage"))))) -(def (openai-chat-with-stats provider messages tools) +(def (openai-chat-with-stats-once provider messages tools) ;; Non-streaming variant of openai-chat that also returns a stats alist. ;; Returns (values message stats). (let* ((url (string-append (provider-base-url provider) "/chat/completions")) @@ -2483,8 +2588,17 @@ (def (openai-stream-body provider messages tools) (openai-request-body provider messages tools #t)) +(def (openai-chat-with-stats provider messages tools) + (call-with-openai-tool-argument-retry + (lambda () + (openai-chat-with-stats-once provider messages tools)))) (def (openai-stream-chat provider messages tools token-cb) + (call-with-openai-tool-argument-retry + (lambda () + (openai-stream-chat-once provider messages tools token-cb)))) + +(def (openai-stream-chat-once provider messages tools token-cb) ;; Stream via SSE. Calls token-cb with each text token. ;; Returns (values content-string tool-call-list usage-alist) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) @@ -2647,7 +2761,8 @@ a))) (id (hash-get tc "id")) (fn (hash-get tc "function"))) - (when id (hash-put! acc "id" id)) + (when (openai-nonempty-id? id) + (hash-put! acc "id" id)) (when fn (let ((name (hash-get fn "name")) (args (hash-get fn "arguments"))) --- a/test/run.ss +++ b/test/run.ss @@ -423,6 +423,57 @@ (let ([tc (restore-tool-call "my-id" "bash" "{}")]) (check! "restore-tool-call id" (tool-call-id tc) "my-id")) +(let* ([json (string->json-object + "{\"role\":\"assistant\",\"tool_calls\":[{\"id\":\"\",\"type\":\"function\",\"function\":{\"name\":\"bash\",\"arguments\":\"{}\"}}]}")] + [msg (json->message json)] + [tc (car (message-tool-calls msg))]) + (check-pred! "empty provider tool-call id is regenerated" + (tool-call-id tc) + (lambda (id) (and (string? id) (> (string-length id) 0))))) + +(let* ([provider (make-provider + "unit-openai" "unit-key" "unit-model" + "http://127.0.0.1:1/v1")] + [call (restore-tool-call "" "bash" "{\"command\":\"true\"}")] + [assistant (make-assistant-message #f (list call))] + [result (make-tool-result "" "ok")] + [body (openai-body provider (list assistant result) '())] + [messages (hashtable-ref body "messages" '())] + [assistant-json (car messages)] + [result-json (cadr messages)] + [call-json (car (hashtable-ref assistant-json "tool_calls" '()))] + [call-id (hashtable-ref call-json "id" #f)]) + (check-pred! "legacy assistant tool-call id is repaired" + call-id + (lambda (id) (and (string? id) (> (string-length id) 0)))) + (check! "legacy tool-result id is correlated" + (hashtable-ref result-json "tool_call_id" #f) + call-id) + (parameterize ([current-openai-object-tool-arguments #t]) + (let* ([object-body (openai-body provider (list assistant result) '())] + [object-messages (hashtable-ref object-body "messages" '())] + [object-assistant (car object-messages)] + [object-call + (car (hashtable-ref object-assistant "tool_calls" '()))] + [object-fn (hashtable-ref object-call "function" #f)]) + (check! "template retry sends tool arguments as a mapping" + (hashtable-ref + (hashtable-ref object-fn "arguments" #f) + "command" + #f) + "true")))) + +(let ([attempts 0]) + (let ([result + (call-with-openai-tool-argument-retry + (lambda () + (set! attempts (+ attempts 1)) + (if (current-openai-object-tool-arguments) + "retried" + (error 'provider + "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 ([m (make-tool-result "call-123" "result")]) (check! "tool-result role" (message-role m) "tool")