provider: fix UTF-8 mojibake in TLS line reader, retry stream flakiness
ober
e0a50ecb43df75e001f7a6682abd4b34a3e1df34
--- a/src/jcode/provider/provider.ss +++ b/src/jcode/provider/provider.ss @@ -48,13 +48,18 @@ (def *api-retry-policy* (make-retry-policy 3 1.0 30.0 #t)) (def (retryable-error? e) - ;; Check if the error message contains a retryable HTTP status + ;; Retry on transient HTTP statuses AND on streaming-layer flakiness: + ;; mid-stream silence (watchdog timeout) and pre-status connection + ;; close (e.g. provider RST after handshake). Both have been observed + ;; intermittently from real providers and reliably succeed on retry. (let ((msg (with-output-to-string (lambda () (display-condition e))))) (or (string-contains msg "429") (string-contains msg "500") (string-contains msg "502") (string-contains msg "503") - (string-contains msg "529")))) + (string-contains msg "529") + (string-contains msg "connection closed before HTTP status") + (string-contains msg "stream read timed out")))) (def (api-call-with-retry thunk) (retry/predicate thunk retryable-error? 3 1.0)) @@ -184,27 +189,42 @@ (loop (+ offset n))))) (jcode-tls-flush conn))) +;; Build a UTF-8 string from a reverse list of bytes, dropping a trailing +;; CR (carriage return) if present. Shared by the line readers below. +(def (bytes->line rev-bytes) + (let* ((trimmed (if (and (pair? rev-bytes) (= (car rev-bytes) 13)) + (cdr rev-bytes) rev-bytes)) + (bytes (reverse trimmed)) + (n (length bytes)) + (bv (make-bytevector n))) + (let loop ((b bytes) (i 0)) + (if (>= i n) + (utf8->string bv) + (begin (bytevector-u8-set! bv i (car b)) + (loop (cdr b) (+ i 1))))))) + ;; TLS I/O: read one line (up to \n). Returns string or #f on EOF. +;; Accumulates raw bytes and decodes UTF-8 once at the end. Reading byte +;; by byte and treating each byte as a Scheme char would split multibyte +;; UTF-8 sequences (e.g. emoji, em dash) into per-byte latin-1 mojibake +;; that propagates through SSE/JSON parsing and corrupts the TUI. (def (tls-read-line conn) - (let ((out (open-output-string)) - (buf (make-bytevector 1)) + (let ((buf (make-bytevector 1)) + (rev-bytes '()) (got-any #f)) (let loop () (let ((n (jcode-tls-read conn buf 1))) (cond ((<= n 0) - (if got-any (get-output-string out) #f)) + (and got-any (bytes->line rev-bytes))) (else (set! got-any #t) - (let ((ch (integer->char (bytevector-u8-ref buf 0)))) - (if (char=? ch #\newline) - (let ((s (get-output-string out))) - ;; Strip trailing \r - (if (and (> (string-length s) 0) - (char=? (string-ref s (- (string-length s) 1)) #\return)) - (substring s 0 (- (string-length s) 1)) - s)) - (begin (write-char ch out) (loop)))))))))) + (let ((b (bytevector-u8-ref buf 0))) + (cond + ((= b 10) (bytes->line rev-bytes)) + (else + (set! rev-bytes (cons b rev-bytes)) + (loop)))))))))) ;; TLS I/O: read exactly n bytes as string (def (tls-read-n conn n) @@ -397,7 +417,9 @@ (unless (= status 200) (let ((body (tls-read-all conn))) (error 'jcode-http-post-stream - (format "API error ~a: ~a" status body)))) + (if (= status 0) + (format "connection closed before HTTP status received (host: ~a)" host) + (format "API error ~a: ~a" status body))))) ;; Read SSE lines until EOF or chunked terminator (let loop () (let ((line (tls-read-line conn))) @@ -426,7 +448,9 @@ (unless (= status 200) (let ((body (port-read-all in))) (error 'jcode-http-post-stream - (format "API error ~a: ~a" status body)))) + (if (= status 0) + (format "connection closed before HTTP status received (host: ~a)" host) + (format "API error ~a: ~a" status body))))) ;; Read SSE lines until EOF or chunked terminator (let loop () (let ((c (peek-char in)))