Add --trace FILE flag to capture full session traffic
ober
800bf1269e55043403d81b20415a0bb52c9bba25
--- a/main-binary.ss +++ b/main-binary.ss @@ -12,7 +12,7 @@ ((null? args) #f) ((member (car args) '("--help" "-h" "--version" "-v" "--debug" "-d" "--tui" "--no-tui" "--verbose" "--repl" "--no-mcp")) (has-positional-args? (cdr args))) - ((member (car args) '("--model" "-m" "--provider" "-p" "--repl-port")) + ((member (car args) '("--model" "-m" "--provider" "-p" "--repl-port" "--trace")) (if (null? (cdr args)) #f (has-positional-args? (cddr args)))) (else #t))) --- a/src/jcode/core/agent.ss +++ b/src/jcode/core/agent.ss @@ -304,13 +304,26 @@ Prefer using the edit tool over write for modifying existing files." (raw-args . ,(if (> (string-length raw-args) 200) (substring raw-args 0 200) raw-args)))) + (when (tracing?) + (log-trace logger "tool-args-parse-failed" + `((tool . ,name) (id . ,(tool-call-id tc)) (raw-args . ,raw-args)))) (make-tool-result (tool-call-id tc) (format "Error: malformed tool arguments JSON — ~a" raw-args))) (begin + (when (tracing?) + (log-trace logger "tool-call" + `((tool . ,name) (id . ,(tool-call-id tc)) (args . ,raw-args)))) (when cb (cb 'start name args)) (let* ((raw-result (tool-execute name args)) (result (truncate-tool-output raw-result))) (log-debug logger "tool-result" `((tool . ,name) (result-length . ,(string-length result)))) + (when (tracing?) + (log-trace logger "tool-result" + `((tool . ,name) + (id . ,(tool-call-id tc)) + (raw-bytes . ,(string-length raw-result)) + (truncated? . ,(not (= (string-length raw-result) (string-length result)))) + (content . ,raw-result)))) (when cb (cb 'end name args)) (make-tool-result (tool-call-id tc) result)))))) --- a/src/jcode/core/log.ss +++ b/src/jcode/core/log.ss @@ -6,6 +6,10 @@ log-info log-warn log-error + log-trace + tracing? + open-trace-log! + close-trace-log! err->string) (import :std/misc/string) @@ -17,15 +21,55 @@ (*log-level*) (*log-level* (car args)))) +;; ---- Trace log ---- +;; Single file that captures EVERYTHING (debug logs + full HTTP bodies + +;; full tool args/results) for offline analysis. A global (not a parameter) +;; so worker threads see the same port without explicit capture. + +(def *trace-port* #f) + +(def (tracing?) (and *trace-port* #t)) + +(def (pad3 n) + (cond ((>= n 100) (number->string n)) + ((>= n 10) (string-append "0" (number->string n))) + (else (string-append "00" (number->string n))))) + +(def (trace-timestamp) + (let ((t (current-time))) + (string-append + (number->string (time-second t)) + "." + (pad3 (quotient (time-nanosecond t) 1000000))))) + +(def (open-trace-log! path) + "Open PATH for trace output. Truncates on open. Line-buffered for crash safety." + (close-trace-log!) + (set! *trace-port* + (open-file-output-port + path + (file-options no-fail) + (buffer-mode line) + (make-transcoder (utf-8-codec)))) + (fprintf *trace-port* "~a ==== jcode trace started ====~n" (trace-timestamp))) + +(def (close-trace-log!) + (when *trace-port* + (guard (e [#t (void)]) + (fprintf *trace-port* "~a ==== jcode trace ended ====~n" (trace-timestamp)) + (close-port *trace-port*)) + (set! *trace-port* #f))) + (def (err->string e) (with-output-to-string (lambda () (display-condition e)))) (def (log-at level label name msg data) - (when (level-enabled? level (*log-level*)) - (let ((line (format "[~a] ~a: ~a" label name msg))) - (if (null? data) - (fprintf (current-error-port) "~a~n" line) - (fprintf (current-error-port) "~a ~a~n" line (format-alist data)))))) + (let* ((line (format "[~a] ~a: ~a" label name msg)) + (suffix (if (null? data) "" (string-append " " (format-alist data))))) + (when (level-enabled? level (*log-level*)) + (fprintf (current-error-port) "~a~a~n" line suffix)) + (when *trace-port* + (fprintf *trace-port* "~a ~a~a~n" (trace-timestamp) line suffix)))) (def (level-enabled? level min-level) (case level @@ -47,3 +91,13 @@ (def (log-info name msg . rest) (log-at 1 "INFO" name msg (if (null? rest) '() (car rest)))) (def (log-warn name msg . rest) (log-at 2 "WARN" name msg (if (null? rest) '() (car rest)))) (def (log-error name msg . rest) (log-at 3 "ERROR" name msg (if (null? rest) '() (car rest)))) + +;; log-trace writes ONLY to the trace file (never to stderr). Use it for +;; firehose payloads — full HTTP bodies, full tool results — that would spam +;; stderr but are exactly what you need when analyzing a session offline. +(def (log-trace name msg . rest) + (when *trace-port* + (let* ((data (if (null? rest) '() (car rest))) + (line (format "[TRACE] ~a: ~a" name msg)) + (suffix (if (null? data) "" (string-append " " (format-alist data))))) + (fprintf *trace-port* "~a ~a~a~n" (trace-timestamp) line suffix)))) --- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -21,6 +21,29 @@ (def logger (make-logger "provider")) +;; ---- Redaction helpers (used for trace logging) ---- +;; The trace file captures full HTTP requests; we strip credentials so the +;; file is safe to share when debugging. Header names are matched verbatim +;; against the values our code emits (Authorization, x-api-key). + +(def (redact-headers headers) + (map (lambda (h) + (let ((name (car h))) + (cond + ((or (equal? name "Authorization") + (equal? name "x-api-key") + (equal? name "api-key")) + (cons name "<REDACTED>")) + (else h)))) + headers)) + +(def (redact-url url) + ;; Google embeds the API key as ?key=...; nuke from "key=" onwards. + (let ((idx (string-contains url "key="))) + (if idx + (string-append (substring url 0 idx) "key=<REDACTED>") + url))) + ;; Retry policy for transient API errors (429, 5xx) (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) @@ -336,8 +359,17 @@ (def (openai-chat provider messages tools) (let* ((url (string-append (provider-base-url provider) "/chat/completions")) (headers (openai-headers provider)) - (body (openai-body provider messages tools))) - (let-values (((status text) (http-post-json url headers (json-object->string body)))) + (body (openai-body provider messages tools)) + (body-json (json-object->string body))) + (when (tracing?) + (log-trace logger "openai-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 "openai-response" + `((status . ,status) (body . ,text)))) (if (= status 200) (openai-parse-response (string->json-object text)) (error 'openai-chat (format "API error ~a: ~a" status text)))))) @@ -369,8 +401,17 @@ (def (anthropic-chat provider messages tools) (let* ((url (string-append (provider-base-url provider) "/messages")) (headers (anthropic-headers provider)) - (body (anthropic-body provider messages tools))) - (let-values (((status text) (http-post-json url headers (json-object->string body)))) + (body (anthropic-body provider messages tools)) + (body-json (json-object->string body))) + (when (tracing?) + (log-trace logger "anthropic-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 "anthropic-response" + `((status . ,status) (body . ,text)))) (if (= status 200) (anthropic-parse-response (string->json-object text)) (error 'anthropic-chat (format "API error ~a: ~a" status text)))))) @@ -505,8 +546,17 @@ "/models/" (provider-model provider) ":generateContent?key=" (provider-api-key provider))) (headers '(("Content-Type" . "application/json"))) - (body (google-body provider messages tools))) - (let-values (((status text) (http-post-json url headers (json-object->string body)))) + (body (google-body provider messages tools)) + (body-json (json-object->string body))) + (when (tracing?) + (log-trace logger "google-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 "google-response" + `((status . ,status) (body . ,text)))) (if (= status 200) (google-parse-response (string->json-object text)) (error 'google-chat (format "API error ~a: ~a" status text)))))) @@ -634,8 +684,14 @@ (tc-table (make-hash-table)) (usage-acc (make-hash-table))) (let* ((body-json (json-object->string body)) - (dummy (log-info logger "stream-request" - `((url . ,url) (body-len . ,(string-length body-json))))) + (dummy (begin + (log-info logger "stream-request" + `((url . ,url) (body-len . ,(string-length body-json)))) + (when (tracing?) + (log-trace logger "openai-stream-request" + `((url . ,(redact-url url)) + (headers . ,(redact-headers headers)) + (body . ,body-json)))))) (http-status (jcode-http-post-stream url headers body-json (lambda (event-str) @@ -643,6 +699,8 @@ (log-debug logger "sse-event" `((data . ,(if (> (string-length event-str) 120) (substring event-str 0 120) event-str)))) + (when (tracing?) + (log-trace logger "openai-sse-event" `((data . ,event-str)))) ;; Strip "data: " prefix (let* ((data (if (string-prefix? "data: " event-str) (substring event-str 6 (string-length event-str)) @@ -709,6 +767,13 @@ (tokens-in . ,(or (hash-get usage-acc "prompt_tokens") 0)) (tokens-out . ,(or (hash-get usage-acc "completion_tokens") 0)) (cost . ,(or (hash-get usage-acc "cost") 0)))) + (when (tracing?) + (log-trace logger "openai-stream-result" + `((content . ,content) + (tool-calls . ,(map (lambda (tc) + (cons (tool-call-name tc) + (tool-call-arguments tc))) + tool-calls))))) (values content tool-calls (list (cons 'tokens-in (or (hash-get usage-acc "prompt_tokens") 0)) (cons 'tokens-out (or (hash-get usage-acc "completion_tokens") 0)) @@ -732,16 +797,24 @@ (let* ((url (string-append (provider-base-url provider) "/messages")) (headers (anthropic-stream-headers provider)) (body (anthropic-stream-body provider messages tools)) + (body-json (json-object->string body)) (text-acc (open-output-string)) ;; tool use accumulators: id -> alist (tu-table (make-hash-table)) (current-idx (make-parameter #f)) (usage-acc (make-hash-table)) (event-type #f)) + (when (tracing?) + (log-trace logger "anthropic-stream-request" + `((url . ,(redact-url url)) + (headers . ,(redact-headers headers)) + (body . ,body-json)))) (let ((http-status - (jcode-http-post-stream url headers (json-object->string body) + (jcode-http-post-stream url headers body-json (lambda (event-str) (when event-str + (when (tracing?) + (log-trace logger "anthropic-sse-event" `((data . ,event-str)))) ;; Anthropic SSE uses multiple lines per event: "event: ...\ndata: ..." (let* ((lines (string-split event-str #\newline)) (data-str #f)) @@ -818,6 +891,13 @@ (or (hash-get acc "name") "unknown") (or (hash-get acc "args") "{}")))) indices))) + (when (tracing?) + (log-trace logger "anthropic-stream-result" + `((content . ,content) + (tool-calls . ,(map (lambda (tc) + (cons (tool-call-name tc) + (tool-call-arguments tc))) + tool-calls))))) (values content tool-calls (list (cons 'tokens-in (or (hash-get usage-acc "input_tokens") 0)) (cons 'tokens-out (or (hash-get usage-acc "output_tokens") 0)) --- a/src/jcode/ui/cli.ss +++ b/src/jcode/ui/cli.ss @@ -45,6 +45,15 @@ (current-log-level 'debug)) (when (assoc '--no-mcp opts) (set! *no-mcp* #t)) + ;; --trace FILE (or JCODE_TRACE env var) — capture full HTTP traffic, + ;; tool args, tool results, and all log lines to FILE for offline analysis. + (let* ((trace-opt (assoc '--trace opts)) + (trace-path (cond (trace-opt (cdr trace-opt)) + (else (getenv "JCODE_TRACE"))))) + (when (and trace-path (not (equal? trace-path ""))) + (open-trace-log! trace-path) + (current-log-level 'debug) + (fprintf (current-error-port) "[trace] writing to ~a~n" trace-path))) (load-config) (session-init-db) (init-tools) @@ -68,7 +77,8 @@ ((equal? (car rest) "session") (session-command (cdr rest))) ((equal? (car rest) "config") (config-command (cdr rest))) ((equal? (car rest) "serve") (serve-main (cdr rest))) - (else (one-shot-mode (string-join rest " ") opts)))))) + (else (one-shot-mode (string-join rest " ") opts))) + (close-trace-log!)))) (def (parse-args args) (let loop ((args args) (opts '())) @@ -87,6 +97,8 @@ ((and (equal? (car args) "--repl-port") (pair? (cdr args))) (loop (cddr args) (cons (cons '--repl-port (string->number (cadr args))) opts))) ((equal? (car args) "--repl") (loop (cdr args) (cons '(--repl-port . 0) opts))) + ((and (equal? (car args) "--trace") (pair? (cdr args))) + (loop (cddr args) (cons (cons '--trace (cadr args)) opts))) ((and (equal? (car args) "--model") (pair? (cdr args))) (loop (cddr args) (cons (cons '--model (cadr args)) opts))) ((and (equal? (car args) "-m") (pair? (cdr args))) @@ -134,6 +146,9 @@ OPTIONS: --repl Start debug REPL on auto-assigned port --repl-port N Start debug REPL on specific port --verbose Log TUI events to ~/jcode.log + --trace FILE Trace EVERYTHING to FILE: full HTTP requests/responses + (API keys redacted), full tool args/results, all log + lines. Implies --debug. Also reads JCODE_TRACE env var. COMMANDS: session list List all sessions --- a/src/jcode/ui/tui.ss +++ b/src/jcode/ui/tui.ss @@ -215,7 +215,8 @@ (event-loop state) (stop-jcode-repl!) (restore-stderr!) - (close-tui-log!)))) + (close-tui-log!) + (close-trace-log!)))) (def (init-tools-for-tui) ;; Import and init tools — same as cli.ss @@ -249,6 +250,8 @@ (loop (cdr args))) ((equal? (car args) "--verbose") (loop (cdr args))) ;; handled in tui-main before this + ((and (equal? (car args) "--trace") (pair? (cdr args))) + (loop (cddr args))) ;; trace log already opened by cli-main (#t (loop (cdr args)))))) ;; ---- Event loop ----