;;; portal-http-server.lsp — serve S-expression portal bytes over HTTP.
;;;
;;; The server holds some state (bindings). On GET /portal it serializes
;;; those bindings as an S-expression portal (just (define ...) forms)
;;; and returns them as the HTTP body. A client can (tcp-connect) +
;;; read, strip the HTTP headers, and evaluate the body — which is
;;; literally Scheme source.
;;;
;;; This closes the loop: continuations / state across machines via
;;; sockets, using the language itself as the wire format.
;;;
;;; Runs byte-identically in Python, C, and asm:
;;;   python3 lumbda.py --fast examples/portal-http-server.lsp
;;;   ./c/lumbda examples/portal-http-server.lsp
;;;   ./asm/lumbda < examples/portal-http-server.lsp
;;;
;;; Default port 9085.

(define *port* 9085)
(define *max-requests* 100000)

;;; ── Some state worth migrating ───────────────────────────────
;;;
;;; This is the "work" the server has done that a client might want
;;; to pick up and resume. fib(30) and some lists.

(define counter 0)
(define my-int 42)
(define my-list (list 1 2 3 4 5 6 7 8 9 10))
(define my-str "portal was here")
(define my-fib
  (let loop ((a 0) (b 1) (i 0))
    (if (= i 30) a (loop b (+ a b) (+ i 1)))))

;;; ── S-expression portal serializer ───────────────────────────
;;; Same pattern as rpc-server's response builder; no ports needed.

(define (atom->string v)
  (cond
    ((number? v) (number->string v))
    ((symbol? v) (symbol->string v))
    ((null? v)   "()")
    ((pair? v)   (string-append "(" (list->string v) ")"))
    ((string? v) (string-append "\"" v "\""))
    (else        "#<unknown>")))

(define (list->string lst)
  (cond
    ((null? lst) "")
    ((null? (cdr lst)) (atom->string (car lst)))
    (else (string-append (atom->string (car lst)) " " (list->string (cdr lst))))))

(define (portal-body)
  ;; Produce the S-expression portal as a single string.
  (string-append
    ";; lumbda portable portal\n"
    "(define counter " (number->string counter) ")\n"
    "(define my-int " (number->string my-int) ")\n"
    "(define my-list '(" (list->string my-list) "))\n"
    "(define my-str \"" my-str "\")\n"
    "(define my-fib " (number->string my-fib) ")\n"))

;;; ── HTTP plumbing ────────────────────────────────────────────

(define (http-response status ctype body)
  (string-append
    "HTTP/1.0 " status "\r\n"
    "Content-Type: " ctype "\r\n"
    "Content-Length: " (number->string (string-length body)) "\r\n"
    "Connection: close\r\n\r\n"
    body))

;; Get second space-separated token from the request line (the path).
(define (path-of req)
  (let ((len (string-length req)))
    (let loop1 ((i 0))
      (cond
        ((= i len) "")
        ((= (char->integer (string-ref req i)) 32)
         (let loop2 ((j (+ i 1)))
           (cond
             ((= j len) (substring req (+ i 1) len))
             ((= (char->integer (string-ref req j)) 32) (substring req (+ i 1) j))
             (else (loop2 (+ j 1))))))
        (else (loop1 (+ i 1)))))))

(define (handle req)
  (let ((path (path-of req)))
    (cond
      ((string=? path "/portal")
       (http-response "200 OK" "application/scheme" (portal-body)))
      ((string=? path "/")
       (http-response "200 OK" "text/html"
         "<!doctype html><title>portal-http</title><h1>lumbda portal-http</h1><p>GET /portal returns the S-expression portal.</p>"))
      (else
       (http-response "404 Not Found" "text/plain"
         (string-append "not found: " path "\n"))))))

;;; ── Main loop ────────────────────────────────────────────────

(define server (tcp-listen *port*))

(define (serve-loop n snap)
  ;; counter is mutated per request, so the portal body changes with use.
  (set! counter (+ counter 1))
  (if (>= n *max-requests*)
      (begin (display "request cap reached\n") (tcp-close server))
      (begin
        (let ((client (tcp-accept server)))
          (let ((req (tcp-recv client 4096)))
            (if (and req (> (string-length req) 0))
                (tcp-send client (handle req))
                #f))
          (tcp-close client))
        (heap-restore snap)
        (serve-loop (+ n 1) snap))))

(display "portal-http on :") (display *port*)
(display " — GET /portal for the S-exp portal") (newline)
(serve-loop 0 (heap-snapshot))
