;;; http-static-server.lsp — serve lumbda.com's docroot from pure Scheme.
;;;
;;; Runs in any tier that has file->string + the tcp-* family: Python,
;;; C, and both asm builds. The asm-gc build is the target deployment
;;; (~27 KB binary, bounded memory via heap-snapshot per request).
;;;
;;;   ./asm/lumbda-gc < examples/http-static-server.lsp
;;;
;;; Serves GET requests under *docroot*. Default docroot is "www" —
;;; run from the repo root so the relative path resolves.

(define *port* 8080)
(define *docroot* "www")
(define *max-requests* 100000)

(define *crlf* "\r\n")
(define *crlf-crlf* "\r\n\r\n")

;;; ── HTTP helpers ────────────────────────────────────────────

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

(define SPACE 32)
(define DOT   46)
(define (char-at s i) (char->integer (string-ref s i)))

;;; Pull the URL path out of the request line "GET /path HTTP/1.0\r\n..."
(define (second-token s)
  (let ((len (string-length s)))
    (let loop1 ((i 0))
      (cond
        ((= i len) "/")
        ((= (char-at s i) SPACE)
         (let loop2 ((j (+ i 1)))
           (cond
             ((= j len) (substring s (+ i 1) len))
             ((= (char-at s j) SPACE) (substring s (+ i 1) j))
             (else (loop2 (+ j 1))))))
        (else (loop1 (+ i 1)))))))

;;; ── Path safety ─────────────────────────────────────────────

;;; Reject any path containing ".." — keeps requests under docroot.
(define (has-dotdot? s)
  (let ((n (string-length s)))
    (let loop ((i 0))
      (cond
        ((>= (+ i 1) n) #f)
        ((and (= (char-at s i) DOT) (= (char-at s (+ i 1)) DOT)) #t)
        (else (loop (+ i 1)))))))

;;; ── MIME dispatch ───────────────────────────────────────────

(define (ends-with? s suffix)
  (let ((ns (string-length s)) (nf (string-length suffix)))
    (if (< ns nf) #f
        (string=? suffix (substring s (- ns nf) ns)))))

(define (mime-of path)
  (cond
    ((ends-with? path ".html") "text/html; charset=utf-8")
    ((ends-with? path ".css")  "text/css; charset=utf-8")
    ((ends-with? path ".pdf")  "application/pdf")
    ((ends-with? path ".txt")  "text/plain; charset=utf-8")
    ((ends-with? path ".js")   "application/javascript")
    ((ends-with? path ".png")  "image/png")
    ((ends-with? path ".jpg")  "image/jpeg")
    ((ends-with? path ".svg")  "image/svg+xml")
    ((ends-with? path ".ico")  "image/x-icon")
    (else "application/octet-stream")))

;;; ── File resolution ─────────────────────────────────────────

(define (resolve-fs-path url-path)
  (cond
    ((string=? url-path "/") (string-append *docroot* "/index.html"))
    (else (string-append *docroot* url-path))))

(define (serve-file url-path)
  (cond
    ((has-dotdot? url-path)
     (http-response "403 Forbidden" "text/plain" "forbidden\n"))
    (else
      (let ((fs-path (resolve-fs-path url-path)))
        (let ((body (file->string fs-path)))
          (if body
              (http-response "200 OK" (mime-of fs-path) body)
              (let ((nf (file->string (string-append *docroot* "/404.html"))))
                (http-response "404 Not Found" "text/html; charset=utf-8"
                  (if nf nf "not found\n")))))))))

(define (handle-request req)
  (let ((path (second-token req)))
    (serve-file path)))

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

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

(define (server-loop n snap)
  (if (>= n *max-requests*)
      (begin
        (display "request cap reached, exiting\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-request req))
                #f))
          (tcp-close client))
        ;; Rewind per-request allocations on asm; no-op on Python/C.
        (heap-restore snap)
        (server-loop (+ n 1) snap))))

(display "lumbda-www on :") (display *port*)
(display " serving ") (display *docroot*) (newline)
(server-loop 0 (heap-snapshot))