;;; wire.lsp -- length-prefixed S-expression framing over TCP.
;;;
;;; Layout for one message:
;;;
;;;   <8 ASCII digits, zero-padded, decimal byte length><payload>
;;;
;;; Header carries the byte count of the payload. Payload is the raw
;;; S-expression text produced by `write-to-string`; reader parses
;;; via `read-from-string`.
;;;
;;; Why 8 digits: caps one message at 99,999,999 bytes (~95 MiB),
;;; comfortable for the bend RPC traffic shape. Fixed width means
;;; recv-exact never has to find a delimiter.
;;;
;;; Lifted from `ecdsa/lumbda/fleet/wire.lsp` in www.foxhop.net -- the
;;; same protocol the lumbda fleet workers already speak. Should
;;; promote to lumbda's stdlib once enough callers want it.
;;;
;;; License: AGPLv3 (lumbda's license; matches the contributing repo).

(define *wire-header-width* 8)

;; wire-send-raw / wire-recv-raw — frame a raw payload string without
;; S-expression serialization. Used by binary mode dispatch where the
;; payload bytes are NOT a Scheme expression.

(define (wire-send-raw sock payload)
  (let* ((plen (string-length payload))
         (header (zero-pad-left (number->string plen) *wire-header-width*)))
    (tcp-send sock header)
    (tcp-send sock payload)))

(define (wire-recv-raw sock)
  (let ((header (recv-exact sock *wire-header-width*)))
    (cond
      ((eq? header #f) #f)
      (else
       (let ((plen (string->number header)))
         (cond
           ((or (eq? plen #f) (< plen 0)) #f)
           (else (recv-exact sock plen))))))))

;; Left-pad string s with '0' chars until length = width.
(define (zero-pad-left s width)
  (let ((slen (string-length s)))
    (if (>= slen width)
        s
        (let loop ((acc s) (need (- width slen)))
          (if (= need 0)
              acc
              (loop (string-append "0" acc) (- need 1)))))))

;; recv-exact reads exactly n bytes from sock; returns the bytes
;; concatenated, or #f if the peer closes early.
;;
;; Earlier draft built the result via (string-append acc chunk) in
;; the loop, which is O(n^2) on payload size -- at 32 MB payloads
;; that's ~1 GB of memory-copy work; C tier stalled, Python tier
;; suffered. This version collects chunks in a list, then
;; concatenates once via (apply string-append ...) which every tier
;; implements as single-pass O(n).
;;
;; asm tier note: multi-line "..." docstrings crash the asm reader
;; (seen 2026-06-05 — single line + ;; comments works fine).
(define (recv-exact sock n)
  (let loop ((chunks '()) (remaining n))
    (cond
      ((= remaining 0) (apply string-append (reverse chunks)))
      (else
       (let ((chunk (tcp-recv sock remaining)))
         (cond
           ((eq? chunk #f) #f)
           ((= (string-length chunk) 0) #f)   ; peer closed
           (else
            (loop (cons chunk chunks)
                  (- remaining (string-length chunk))))))))))

;; Frame sexp as <8-digit-length><payload>, send over sock.
(define (wire-send sock sexp)
  (let* ((payload (write-to-string sexp))
         (plen (string-length payload))
         (header (zero-pad-left (number->string plen) *wire-header-width*))
         (frame (string-append header payload)))
    (tcp-send sock frame)))

;; Read one framed S-expression. Returns parsed sexp on success,
;; #f on peer-closed / malformed header.
(define (wire-recv sock)
  (let ((header (recv-exact sock *wire-header-width*)))
    (cond
      ((eq? header #f) #f)
      (else
       (let ((plen (string->number header)))
         (cond
           ((or (eq? plen #f) (< plen 0)) #f)
           (else
            (let ((payload (recv-exact sock plen)))
              (cond
                ((eq? payload #f) #f)
                (else (read-from-string payload)))))))))))
