web.carp

(doc Web "is a minimal web framework for Carp with WebSocket and Server-Sent
Events support.

## Installation

```
(load \"git@github.com:carpentry-org/web@0.9.3\")
```

## Usage

```
(load \"git@github.com:carpentry-org/web@0.9.3\")

(defn hello [req params]
  (Response.text @\"Hello, world!\"))

(defn echo [event params ws]
  (match-ref event
    (WSEvent.Connect) (WebSocket.send ws \"connected\")
    (WSEvent.Message msg) (WebSocket.send ws &(fmt \"echo: %s\" msg))
    (WSEvent.Binary data) (WebSocket.send-binary ws data)
    (WSEvent.Close) ()))

(defn clock [event params s]
  (match-ref event
    (SSEEvent.Connect) (SSEStream.send-event s \"ready\" \"\")
    (SSEEvent.Tick) (SSEStream.send s &(Int.str (System.time)))
    (SSEEvent.Close) ()))

(defserver \"0.0.0.0\" 8080
  (GET \"/hello\" hello)
  (WS  \"/ws/echo\" echo)
  (SSE \"/events\" clock))
```")

(load "git@github.com:carpentry-org/http@0.4.2")
(load "git@github.com:carpentry-org/socket@0.2.3")
(load "git@github.com:carpentry-org/json@0.6.0")
(load "git@github.com:carpentry-org/file@0.3.0")
(load "git@github.com:carpentry-org/log@0.2.0")
(load "git@github.com:carpentry-org/utf8.carp@0.2.0")

; Byte-indexed prefix/suffix tests; the core ones measure in bytes but slice
; in characters.
(hidden web-starts-with?)
(defn web-starts-with? [s sub]
  (let [n (String.length sub)]
    (and (>= (String.length s) n) (= sub &(String.byte-slice s 0 n)))))

(hidden web-ends-with?)
(defn web-ends-with? [s sub]
  (let [n (String.length s)
        m (String.length sub)]
    (and (>= n m) (= sub &(String.byte-slice s (- n m) n)))))

(defmodule SHA1
  (hidden of-int)
  (defn of-int [x] (Uint32.from-long (Long.from-int x)))

  (hidden shl)
  (defn shl [x k] (Uint32.bit-shift-left x (of-int k)))

  (hidden shr)
  (defn shr [x k] (Uint32.bit-shift-right x (of-int k)))

  (hidden u32)
  (defn u32 [hi lo]
    (Uint32.bit-or
      (Uint32.bit-shift-left (Uint32.from-long hi) (of-int 16))
      (Uint32.from-long lo)))

  (hidden rotl32)
  (defn rotl32 [x n] (Uint32.bit-or (shl x n) (shr x (- 32 n))))

  (hidden word32)
  (defn word32 [b0 b1 b2 b3]
    (Uint32.bit-or
      (Uint32.bit-or (shl (of-int b0) 24) (shl (of-int b1) 16))
      (Uint32.bit-or (shl (of-int b2) 8) (of-int b3))))

  (doc digest "computes the SHA-1 digest of a byte array, returning 20 bytes.")
  (defn digest [data]
    (let-do [msg-len (Array.length data)
             bit-len (Uint64.*
               (Uint64.from-long (Long.from-int msg-len))
               (Uint64.from-long 8l))
             pad-len (let [r (Int.mod (+ msg-len 9) 64)]
               (+ (+ msg-len 9) (if (= r 0) 0 (- 64 r))))
             buf (Array.replicate pad-len &(Byte.from-int 0))]
      (for [i 0 msg-len] (Array.aset! &buf i @(Array.unsafe-nth data i)))
      (Array.aset! &buf msg-len (Byte.from-int 128))
      (for [i 0 8]
        (let [sh (Uint64.from-long (Long.from-int (* (- 7 i) 8)))
              by (Uint64.bit-and (Uint64.bit-shift-right bit-len sh)
                                 (Uint64.from-long 255l))]
          (Array.aset! &buf
                       (+ (- pad-len 8) i)
                       (Byte.from-int (Long.to-int (Uint64.to-long by))))))
      (let-do [h0 (u32 26437l 8961l)
               h1 (u32 61389l 43913l)
               h2 (u32 39098l 56574l)
               h3 (u32 4146l 21622l)
               h4 (u32 50130l 57840l)
               kc0 (u32 23170l 31129l)
               kc1 (u32 28377l 60321l)
               kc2 (u32 36635l 48348l)
               kc3 (u32 51810l 49622l)]
        (for [blk 0 (/ pad-len 64)]
          (let-do [off (* blk 64)
                   w (Array.replicate 80 &(Uint32.zero))]
            (for [j 0 16]
              (let [bi (+ off (* j 4))]
                (Array.aset! &w
                             j
                             (word32
                               (Byte.to-int @(Array.unsafe-nth &buf bi))
                               (Byte.to-int @(Array.unsafe-nth &buf (+ bi 1)))
                               (Byte.to-int @(Array.unsafe-nth &buf (+ bi 2)))
                               (Byte.to-int @(Array.unsafe-nth &buf (+ bi 3)))))))
            (for [j 16 80]
              (Array.aset! &w
                           j
                           (rotl32
                             (Uint32.bit-xor
                               (Uint32.bit-xor @(Array.unsafe-nth &w (- j 3))
                                               @(Array.unsafe-nth &w (- j 8)))
                               (Uint32.bit-xor @(Array.unsafe-nth &w (- j 14))
                                               @(Array.unsafe-nth &w (- j 16))))
                             1)))
            (let-do [a h0
                     b h1
                     c h2
                     d h3
                     e h4]
              (for [j 0 80]
                (let-do [f (cond
                           (< j 20)
                             (Uint32.bit-or (Uint32.bit-and b c)
                                            (Uint32.bit-and (Uint32.bit-not b) d))
                           (< j 40) (Uint32.bit-xor b (Uint32.bit-xor c d))
                           (< j 60)
                             (Uint32.bit-or
                               (Uint32.bit-or (Uint32.bit-and b c)
                                              (Uint32.bit-and b d))
                               (Uint32.bit-and c d))
                           (Uint32.bit-xor b (Uint32.bit-xor c d)))
                         k (cond (< j 20) kc0 (< j 40) kc1 (< j 60) kc2 kc3)
                         temp (Uint32.+
                           (Uint32.+ (Uint32.+ (Uint32.+ (rotl32 a 5) f) e) k)
                           @(Array.unsafe-nth &w j))]
                  (set! e d)
                  (set! d c)
                  (set! c (rotl32 b 30))
                  (set! b a)
                  (set! a temp)))
              (set! h0 (Uint32.+ h0 a))
              (set! h1 (Uint32.+ h1 b))
              (set! h2 (Uint32.+ h2 c))
              (set! h3 (Uint32.+ h3 d))
              (set! h4 (Uint32.+ h4 e)))))
        (let-do [result (Array.replicate 20 &(Byte.from-int 0))]
          (for [i 0 5]
            (let [h (cond (= i 0) h0 (= i 1) h1 (= i 2) h2 (= i 3) h3 h4)
                  base (* i 4)]
              (for [j 0 4]
                (Array.aset! &result
                             (+ base j)
                             (Byte.from-int
                               (Long.to-int
                                 (Uint32.to-long
                                   (Uint32.bit-and (shr h (* (- 3 j) 8))
                                                   (of-int 255)))))))))
          result))))

  (doc hex-digest "computes the SHA-1 digest of a byte array and returns it
as a 40-character lowercase hex string.")
  (defn hex-digest [data]
    (let-do [d (digest data)
             hex @"0123456789abcdef"
             out (Array.replicate 40 &\0)]
      (for [i 0 20]
        (let-do [b (Byte.to-int @(Array.unsafe-nth &d i))]
          (Array.aset! &out (* i 2) (String.char-at &hex (bit-shift-right b 4)))
          (Array.aset! &out (+ (* i 2) 1) (String.char-at &hex (bit-and b 15)))))
      (String.from-chars &out))))

(defmodule Base64
  (hidden b64-alphabet)
  (def b64-alphabet
    @"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")

  (doc encode "base64-encodes a byte array.")
  (defn encode [data]
    (let-do [len (Array.length data)
             out (the (Array Char) [])
             i 0]
      (while (<= (+ i 3) len)
        (let-do [b0 (Byte.to-int @(Array.unsafe-nth data i))
                 b1 (Byte.to-int @(Array.unsafe-nth data (+ i 1)))
                 b2 (Byte.to-int @(Array.unsafe-nth data (+ i 2)))]
          (Array.push-back! &out
                            (String.char-at &b64-alphabet (bit-shift-right b0 2)))
          (Array.push-back! &out
                            (String.char-at &b64-alphabet
                                            (bit-or (bit-shift-left (bit-and b0
                                                                             3)
                                                                    4)
                                                    (bit-shift-right b1 4))))
          (Array.push-back! &out
                            (String.char-at &b64-alphabet
                                            (bit-or (bit-shift-left (bit-and b1
                                                                             15)
                                                                    2)
                                                    (bit-shift-right b2 6))))
          (Array.push-back! &out (String.char-at &b64-alphabet (bit-and b2 63)))
          (set! i (+ i 3))))
      (let [rem (- len i)]
        (cond
          (= rem 1)
            (let-do [b0 (Byte.to-int @(Array.unsafe-nth data i))]
              (Array.push-back! &out
                                (String.char-at &b64-alphabet
                                                (bit-shift-right b0 2)))
              (Array.push-back! &out
                                (String.char-at &b64-alphabet
                                                (bit-shift-left (bit-and b0 3) 4)))
              (Array.push-back! &out \=)
              (Array.push-back! &out \=))
          (= rem 2)
            (let-do [b0 (Byte.to-int @(Array.unsafe-nth data i))
                     b1 (Byte.to-int @(Array.unsafe-nth data (+ i 1)))]
              (Array.push-back! &out
                                (String.char-at &b64-alphabet
                                                (bit-shift-right b0 2)))
              (Array.push-back! &out
                                (String.char-at &b64-alphabet
                                                (bit-or (bit-shift-left (bit-and b0
                                                                                 3)
                                                                        4)
                                                        (bit-shift-right b1 4))))
              (Array.push-back! &out
                                (String.char-at &b64-alphabet
                                                (bit-shift-left (bit-and b1 15)
                                                                2)))
              (Array.push-back! &out \=))
          ()))
      (String.from-chars &out))))

(defmodule HMAC
  (hidden hex-encode)
  (private hex-encode)
  (defn hex-encode [bytes]
    (let-do [hex @"0123456789abcdef"
             len (Array.length bytes)
             out (Array.replicate (* len 2) &\0)]
      (for [i 0 len]
        (let-do [b (Byte.to-int @(Array.unsafe-nth bytes i))]
          (Array.aset! &out (* i 2) (String.char-at &hex (bit-shift-right b 4)))
          (Array.aset! &out (+ (* i 2) 1) (String.char-at &hex (bit-and b 15)))))
      (String.from-chars &out)))

  (hidden block-size)
  (private block-size)
  (def block-size 64)

  (doc sha1 "computes the HMAC-SHA1 digest of `msg` using `key`.
Returns 20 raw bytes.")
  (defn sha1 [key msg]
    (let-do [norm (if (> (Array.length key) block-size) (SHA1.digest key) @key)
             padded (Array.replicate block-size &(Byte.from-int 0))]
      (for [i 0 (Array.length &norm)]
        (Array.aset! &padded i @(Array.unsafe-nth &norm i)))
      (let-do [i-pad (Array.replicate block-size &(Byte.from-int 0))
               o-pad (Array.replicate block-size &(Byte.from-int 0))]
        (for [i 0 block-size]
          (let-do [kb (Byte.to-int @(Array.unsafe-nth &padded i))]
            (Array.aset! &i-pad i (Byte.from-int (bit-xor kb 54)))
            (Array.aset! &o-pad i (Byte.from-int (bit-xor kb 92)))))
        (let [inner-data (Array.concat &[i-pad @msg])
              inner-hash (SHA1.digest &inner-data)
              outer-data (Array.concat &[o-pad inner-hash])]
          (SHA1.digest &outer-data)))))

  (doc sha1-hex "computes the HMAC-SHA1 of `msg` using `key`, returning a
40-character lowercase hex string.")
  (defn sha1-hex [key msg] (hex-encode &(sha1 key msg))))

(defmodule Map
  (doc update-value! "calls `f` with a reference to the value at key `k`.
Does nothing if the key is not found. The reference allows mutation through
FFI functions (e.g. reading into a stream's buffer).")
  (defn update-value! [m k f]
    (let [idx (Int.positive-mod (hash k) @(n-buckets m))]
      (let [bucket (Array.unsafe-nth (buckets m) idx)
            i (Bucket.find bucket k)]
        (when (>= i 0)
          (~f (Pair.b (Array.unsafe-nth (Bucket.entries bucket) i)))))))

  (doc value-ref! "calls `f` with a reference to the value at key `k` and
returns whatever `f` returns. If the key is missing, returns `default`.")
  (defn value-ref! [m k f default]
    (let [idx (Int.positive-mod (hash k) @(n-buckets m))]
      (let [bucket (Array.unsafe-nth (buckets m) idx)
            i (Bucket.find bucket k)]
        (if (>= i 0)
          (~f (Pair.b (Array.unsafe-nth (Bucket.entries bucket) i)))
          default)))))

(relative-include "src/fstat_mtime.h")
(private web-fstat-mtime)
(hidden web-fstat-mtime)
(register web-fstat-mtime (Fn [Int] Long) "web_fstat_mtime")

(relative-include "src/is_directory.h")
(private web-is-directory?)
(hidden web-is-directory?)
(register web-is-directory? (Fn [&String] Bool) "web_is_directory")

(hidden web-pad2)
(defn web-pad2 [n] (if (< n 10) (fmt "0%d" n) (Int.str n)))

(hidden web-day-name)
(defn web-day-name [w]
  (String.slice "SunMonTueWedThuFriSat" (* w 3) (* (+ w 1) 3)))

(hidden web-month-name)
(defn web-month-name [m]
  (String.slice "JanFebMarAprMayJunJulAugSepOctNovDec" (* (- m 1) 3) (* m 3)))

; unix seconds → an RFC 9110 IMF-fixdate string, e.g. "Sun, 06 Nov 1994 08:49:37 GMT".
(hidden web-http-date)
(defn web-http-date [secs]
  (let [days (Long./ secs 86400l)
        tod (Long.mod secs 86400l)
        z (Long.+ days 719468l)
        era (Long./ z 146097l)
        doe (Long.- z (Long.* era 146097l))
        yoe (Long./
          (Long.-
            (Long.+ (Long.- doe (Long./ doe 1460l)) (Long./ doe 36524l))
            (Long./ doe 146096l))
          365l)
        y0 (Long.+ yoe (Long.* era 400l))
        doy (Long.- doe
                    (Long.+ (Long.* 365l yoe)
                            (Long.- (Long./ yoe 4l) (Long./ yoe 100l))))
        mp (Long./ (Long.+ (Long.* 5l doy) 2l) 153l)
        d (Long.to-int
          (Long.+ (Long.- doy (Long./ (Long.+ (Long.* 153l mp) 2l) 5l)) 1l))
        m (Long.to-int (if (Long.< mp 10l) (Long.+ mp 3l) (Long.- mp 9l)))
        y (Long.to-int (if (< m 3) (Long.+ y0 1l) y0))
        hh (Long.to-int (Long./ tod 3600l))
        mm (Long.to-int (Long./ (Long.mod tod 3600l) 60l))
        ss (Long.to-int (Long.mod tod 60l))
        wd (Long.to-int (Long.mod (Long.+ days 4l) 7l))]
    (fmt "%s, %s %s %s %s:%s:%s GMT"
         &(web-day-name wd)
         &(web-pad2 d)
         &(web-month-name m)
         &(Int.str y)
         &(web-pad2 hh)
         &(web-pad2 mm)
         &(web-pad2 ss))))

(hidden web-date-uint)
(defn web-date-uint [bytes start count]
  (let-do [v 0
           ok true]
    (for [i start (+ start count)]
      (let [b @(Array.unsafe-nth bytes i)]
        (if (and (>= b 48b) (<= b 57b))
          (set! v (+ (* v 10) (- (Byte.to-int b) 48)))
          (set! ok false))))
    (if ok v -1)))

(hidden web-date-month)
(defn web-date-month [bytes off]
  (let-do [result -1
           names (String.to-bytes "JanFebMarAprMayJunJulAugSepOctNovDec")]
    (for [m 0 12]
      (when (and
          (= @(Array.unsafe-nth bytes off) @(Array.unsafe-nth &names (* m 3)))
          (and
            (= @(Array.unsafe-nth bytes (+ off 1))
               @(Array.unsafe-nth &names (+ (* m 3) 1)))
            (= @(Array.unsafe-nth bytes (+ off 2))
               @(Array.unsafe-nth &names (+ (* m 3) 2)))))
        (set! result (+ m 1))))
    result))

(hidden web-epoch-of)
(defn web-epoch-of [y m d hh mi se]
  (let [yl (Long.from-int (if (< m 3) (- y 1) y))
        era (Long./ yl 400l)
        yoe (Long.- yl (Long.* era 400l))
        mp (Long.from-int (if (> m 2) (- m 3) (+ m 9)))
        doy (Long.+ (Long./ (Long.+ (Long.* 153l mp) 2l) 5l)
                    (Long.from-int (- d 1)))
        doe (Long.+
          (Long.+ (Long.* yoe 365l) (Long./ yoe 4l))
          (Long.- doy (Long./ yoe 100l)))
        days (Long.- (Long.+ (Long.* era 146097l) doe) 719468l)]
    (Long.+ (Long.* days 86400l)
            (Long.+ (Long.* (Long.from-int hh) 3600l)
                    (Long.+ (Long.* (Long.from-int mi) 60l) (Long.from-int se))))))

; an RFC 9110 IMF-fixdate string → unix seconds, or Nothing if malformed.
(hidden web-parse-http-date)
(defn web-parse-http-date [s]
  (let [bytes (String.to-bytes s)]
    (if (< (Array.length &bytes) 29)
      (Maybe.Nothing)
      (let [dd (web-date-uint &bytes 5 2)
            mon (web-date-month &bytes 8)
            yyyy (web-date-uint &bytes 12 4)
            hh (web-date-uint &bytes 17 2)
            mi (web-date-uint &bytes 20 2)
            se (web-date-uint &bytes 23 2)]
        (if (or (< dd 1)
                (or (> dd 31)
                    (or (< mon 1)
                        (or (< yyyy 0)
                            (or (< hh 0)
                                (or (> hh 23)
                                    (or (< mi 0)
                                        (or (> mi 59) (or (< se 0) (> se 60))))))))))
          (Maybe.Nothing)
          (Maybe.Just (web-epoch-of yyyy mon dd hh mi se)))))))

(defmodule Response
  (doc text "creates a 200 OK response with a plain text body.")
  (defn text [body]
    (let [k @"Content-Type"
          v [@"text/plain; charset=utf-8"]]
      (init 200 @"OK" @"HTTP/1.1" [] (Map.put {} &k &v) body)))

  (doc html "creates a 200 OK response with an HTML body.")
  (defn html [body]
    (let [k @"Content-Type"
          v [@"text/html; charset=utf-8"]]
      (init 200 @"OK" @"HTTP/1.1" [] (Map.put {} &k &v) body)))

  (doc json "creates a 200 OK response with a JSON body.")
  (defn json [j]
    (let [k @"Content-Type"
          v [@"application/json"]
          body (match (JSON.str j) (Result.Success s) s (Result.Error _) @"{}")]
      (init 200 @"OK" @"HTTP/1.1" [] (Map.put {} &k &v) body)))

  (doc not-found "creates a 404 Not Found response.")
  (defn not-found [] (init 404 @"Not Found" @"HTTP/1.1" [] {} @"Not Found"))

  (doc bad-request "creates a 400 Bad Request response.")
  (defn bad-request []
    (init 400 @"Bad Request" @"HTTP/1.1" [] {} @"Bad Request"))

  (doc redirect "creates a 302 redirect response to `url`.")
  (defn redirect [url]
    (let [k @"Location"
          v [url]]
      (init 302 @"Found" @"HTTP/1.1" [] (Map.put {} &k &v) @"")))

  (doc with-header "adds a header to a response.")
  (defn with-header [r k v]
    (set-headers r
                 (Map.update-with-default @(headers &r)
                                          &k
                                          &(fn [a] (Array.push-back a @&v))
                                          [])))

  (doc with-status "sets the status code and message of a response.")
  (defn with-status [r code msg] (set-message (set-code r code) msg))

  (doc content-type-for "infers an HTTP `Content-Type` for a file path
based on its extension, matched case-insensitively, so `photo.JPG` and
`photo.jpg` are the same. Unknown extensions return
`application/octet-stream`.")
  (defn content-type-for [path]
    (let [lowered (String.ascii-to-lower path)]
      (cond
        (web-ends-with? &lowered ".html") @"text/html; charset=utf-8"
        (web-ends-with? &lowered ".js") @"application/javascript; charset=utf-8"
        (web-ends-with? &lowered ".mjs") @"application/javascript; charset=utf-8"
        (web-ends-with? &lowered ".css") @"text/css; charset=utf-8"
        (web-ends-with? &lowered ".svg") @"image/svg+xml"
        (web-ends-with? &lowered ".json") @"application/json"
        (web-ends-with? &lowered ".png") @"image/png"
        (web-ends-with? &lowered ".jpg") @"image/jpeg"
        (web-ends-with? &lowered ".jpeg") @"image/jpeg"
        (web-ends-with? &lowered ".gif") @"image/gif"
        (web-ends-with? &lowered ".ico") @"image/x-icon"
        (web-ends-with? &lowered ".webp") @"image/webp"
        (web-ends-with? &lowered ".woff") @"font/woff"
        (web-ends-with? &lowered ".woff2") @"font/woff2"
        (web-ends-with? &lowered ".txt") @"text/plain; charset=utf-8"
        (web-ends-with? &lowered ".xml") @"application/xml"
        (web-ends-with? &lowered ".pdf") @"application/pdf"
        @"application/octet-stream")))

  (doc file "creates a 200 OK response by reading `path` from disk. Returns
a 404 Not Found response if the file is missing or unreadable. The
`Content-Type` header is inferred from the file extension via
[`content-type-for`](#content-type-for). An `ETag` header is computed
from the SHA-1 hash of the file contents.")
  (defn file [path]
    (match (File.open-with path "r")
      (Result.Error _) (not-found)
      (Result.Success f)
        (match (File.read-all &f)
          (Result.Error _) (do (File.close f) (not-found))
          (Result.Success contents)
            (let-do [ct-k @"Content-Type"
                     ct-v [(content-type-for path)]
                     etag (fmt "\"%s\""
                               &(SHA1.hex-digest &(String.to-bytes &contents)))
                     et-k @"ETag"
                     et-v [etag]
                     hdrs (Map.put (Map.put {} &ct-k &ct-v) &et-k &et-v)]
              (File.close f)
              (init 200 @"OK" @"HTTP/1.1" [] hdrs contents)))))

  (doc chunked "creates a response with `Transfer-Encoding: chunked`.

The body is built from an array of chunk strings, each encoded with the
chunked framing (`<hex-length>\\r\\n<data>\\r\\n`) and terminated by a
final `0\\r\\n\\r\\n`.

```
(Response.chunked 200 @\"text/plain\"
  &[@\"first chunk\" @\"second chunk\"])
```

The chunks are pre-encoded into a single buffer. For truly lazy streaming
where chunks are generated on demand, a future version will provide a
callback-based API.")
  (defn chunked [code content-type chunks]
    (let-do [sb (StringBuf.create)]
      (for [i 0 (Array.length chunks)]
        (let-do [chunk (Array.unsafe-nth chunks i)
                 len (String.length chunk)]
          (StringBuf.append-str &sb &(fmt "%x\r\n" len))
          (StringBuf.append-str &sb chunk)
          (StringBuf.append-str &sb "\r\n")))
      (StringBuf.append-str &sb "0\r\n\r\n")
      (let-do [body (StringBuf.to-string &sb)]
        (StringBuf.delete sb)
        (->
          (init code (Status.reason code) @"HTTP/1.1" [] {} body)
          (with-header @"Transfer-Encoding" @"chunked")
          (with-header @"Content-Type" content-type)))))

  (doc sendfile "creates a 200 OK response that signals the server to
transfer the file at `path` directly to the socket via `sendfile(2)`,
avoiding the user-space copy. Falls back to [`file`](#file) if the
server does not detect the `X-Sendfile` header.

The `Content-Type` is inferred from the extension. The server sets
`Content-Length` from the file size. An `ETag` header is computed from
the file's modification time and size, avoiding a full read of the
file contents.

The server advertises `Accept-Ranges: bytes` and honours a single
`Range` request against the transfer, answering `206 Partial Content`
with a `Content-Range` header (or `416` when unsatisfiable).")
  (defn sendfile [path]
    (let [fd (IO.Raw.open path IO.Raw.O-RDONLY)]
      (if (< fd 0)
        (-> (init 200 @"OK" @"HTTP/1.1" [] {} @"")
            (with-header @"Content-Type" (content-type-for path))
            (with-header @"X-Sendfile" @path))
        (let-do [sz (IO.Raw.fstat-size fd)
                 mt (web-fstat-mtime fd)]
          (ignore (IO.Raw.close-fd fd))
          (if (or (< sz 0l) (< mt 0l))
            (-> (init 200 @"OK" @"HTTP/1.1" [] {} @"")
                (with-header @"Content-Type" (content-type-for path))
                (with-header @"X-Sendfile" @path))
            (let [etag (fmt "\"%x-%x\"" mt sz)]
              (-> (init 200 @"OK" @"HTTP/1.1" [] {} @"")
                  (with-header @"Content-Type" (content-type-for path))
                  (with-header @"X-Sendfile" @path)
                  (with-header @"ETag" etag)
                  (with-header @"Last-Modified" (web-http-date mt))))))))))

(doc Form "provides helpers for parsing `application/x-www-form-urlencoded`
and `multipart/form-data` request bodies.")
(defmodule Form
  (doc parse "parses a URL-encoded form body into a `(Map String String)`.

```
(let [data (Form.decode (Request.body req))]
  (Map.get &data \"username\"))
```

Keys and values are URL-decoded. Duplicate keys keep the last value.")
  (hidden decode-form-value)
  (defn decode-form-value [s]
    (let-do [cs (String.to-bytes s)
             len (Array.length &cs)]
      (for [i 0 len]
        (when (= @(Array.unsafe-nth &cs i) (Char.to-byte \+))
          (Array.aset! &cs i (Char.to-byte \space))))
      (URI.unescape &(String.from-bytes &cs))))

  (defn decode [body]
    (let-do [result (the (Map String String) {})
             pairs &(String.split-by body &[\&])]
      (for [i 0 (Array.length pairs)]
        (let [pair (Array.unsafe-nth pairs i)]
          (when (> (String.length pair) 0)
            (let [eq (String.index-of pair \=)]
              (if (< eq 0)
                (Map.put! &result &(decode-form-value pair) &@"")
                (let [k (decode-form-value &(String.byte-slice pair 0 eq))
                      v (decode-form-value
                        &(String.byte-slice pair (+ eq 1) (String.length pair)))]
                  (Map.put! &result &k &v)))))))
      result))

  (doc parse-request "parses the form body from a request. Returns an empty
map if the content type is not `application/x-www-form-urlencoded`.")
  (defn decode-request [req]
    (if (match (Request.header req "Content-Type")
        (Maybe.Just ct)
          (web-starts-with? &ct "application/x-www-form-urlencoded")
        (Maybe.Nothing) false)
      (decode (Request.body req))
      (the (Map String String) {})))

  (doc decode-multipart "decodes a `multipart/form-data` body given the
boundary string, via http’s `Multipart.parse`. Returns
`(Result (Array FormPart) String)`; fails when the opening boundary
delimiter is absent.

```
(match (Form.decode-multipart body \"boundary123\")
  (Result.Success parts) (Array.nth &parts 0)
  (Result.Error _) (Maybe.Nothing))
```

Each part’s `name`, optional `filename`, and optional `content-type` are
extracted from its MIME headers. The `body` field is the raw content between
the part headers and the next boundary delimiter.")
  (defn decode-multipart [body boundary] (Multipart.parse body boundary))

  (doc multipart? "checks whether a request has a `multipart/form-data`
content type.")
  (defn multipart? [req]
    (match (Request.header req "Content-Type")
      (Maybe.Just ct) (web-starts-with? &ct "multipart/form-data")
      (Maybe.Nothing) false))

  (doc decode-multipart-request "decodes the multipart form body of a
request, taking the boundary from its `Content-Type` header, via http’s
`Request.multipart-data`. Returns `(Result (Array FormPart) String)`; fails
when the request is not `multipart/form-data` or carries no boundary.

```
(defn upload [req params]
  (match (Form.decode-multipart-request req)
    (Result.Success parts)
      (Response.text (fmt \"got %d parts\" (Array.length &parts)))
    (Result.Error _) (Response.bad-request)))
```")
  (defn decode-multipart-request [req] (Request.multipart-data req)))

(doc WSEvent "represents an event on a WebSocket connection.

Handlers receive one of these for each lifecycle event:
- `Connect`: the connection was upgraded from HTTP
- `(Message msg)`: a text message arrived
- `(Binary data)`: a binary message arrived
- `Close`: the peer requested a close")
(deftype WSEvent
  Connect
  (Message [String])
  (Binary [(Array Byte)])
  Close)

(doc WebSocket "represents an active WebSocket connection.

Handlers receive a reference to this and call [`WebSocket.send`](#send) or
[`WebSocket.send-binary`](#send-binary) to queue outgoing text or binary
frames. The event loop drains the outbox after the handler returns.

The `protocol` field holds the negotiated subprotocol (RFC 6455 §4.2.2),
or `Nothing` if no subprotocol was negotiated.")
(deftype WebSocket [fd Int
                    protocol (Maybe String)
                    outbox (Array (Array Byte))])

(hidden WSFrame)
(deftype WSFrame
  [fin Bool
   opcode Int
   rsv Int
   masked Bool
   payload (Array Byte)
   consumed Int])

(defmodule WebSocket
  (hidden encode-ws-frame)
  (defn encode-ws-frame [opcode payload]
    (let-do [len (Array.length payload)
             frame (the (Array Byte) [])]
      (Array.push-back! &frame (Byte.from-int (+ 128 opcode)))
      ; FIN + opcode
      (cond
        (< len 126) (Array.push-back! &frame (Byte.from-int len))
        (< len 65536)
          (do
            (Array.push-back! &frame (Byte.from-int 126))
            (Array.push-back! &frame (Byte.from-int (/ len 256)))
            (Array.push-back! &frame (Byte.from-int (Int.mod len 256))))
        (do
          (Array.push-back! &frame (Byte.from-int 127))
          (for [k 0 4] (Array.push-back! &frame (Byte.from-int 0)))
          (Array.push-back! &frame
                            (Byte.from-int (bit-and (bit-shift-right len 24) 255)))
          (Array.push-back! &frame
                            (Byte.from-int (bit-and (bit-shift-right len 16) 255)))
          (Array.push-back! &frame
                            (Byte.from-int (bit-and (bit-shift-right len 8) 255)))
          (Array.push-back! &frame (Byte.from-int (bit-and len 255)))))
      (for [k 0 len] (Array.push-back! &frame @(Array.unsafe-nth payload k)))
      frame))

  (doc encode-text "encodes a string as a WebSocket text frame (no mask).")
  (defn encode-text [msg]
    (let [bytes (String.to-bytes msg)] (encode-ws-frame 1 &bytes)))

  (doc encode-binary
    "encodes a byte array as a WebSocket binary frame (no mask).")
  (defn encode-binary [data] (encode-ws-frame 2 data))

  (hidden encode-pong)
  (defn encode-pong [payload] (encode-ws-frame 10 payload))

  (doc encode-ping
    "encodes a WebSocket ping frame with the given payload (may be empty).")
  (defn encode-ping [payload] (encode-ws-frame 9 payload))

  (hidden encode-close)
  (defn encode-close []
    (the (Array Byte) [(Byte.from-int 136) (Byte.from-int 0)]))
  ; 0x88 FIN + close, len 0

  (hidden encode-close-with-code)
  (defn encode-close-with-code [code]
    (the (Array Byte)
         [(Byte.from-int 136)
          ; 0x88 FIN + close
          (Byte.from-int 2)
          ; payload length 2
          (Byte.from-int (bit-and (bit-shift-right code 8) 255))
          (Byte.from-int (bit-and code 255))]))

  (hidden frame-len-exceeds?)
  ; Whether the frame at `offset` declares a payload longer than `cap`, decided
  ; without ever overflowing Int (a 64-bit length in [2^31, 2^32) would wrap to a
  ; negative Int). Returns false while the length field isn't fully buffered yet,
  ; so the caller keeps waiting for more bytes.
  (defn frame-len-exceeds? [buf offset cap]
    (let [avail (- (Array.length buf) offset)]
      (if (< avail 2)
        false
        (let [plen0 (bit-and
                (Byte.to-int @(Array.unsafe-nth buf (+ offset 1)))
                127)]
          (cond
            (< plen0 126)
            false
            (= plen0 126)
            (if (< avail 4)
              false
              (>
                (+
                  (* (Byte.to-int @(Array.unsafe-nth buf (+ offset 2))) 256)
                  (Byte.to-int @(Array.unsafe-nth buf (+ offset 3))))
                cap))
            ; 64-bit length in bytes offset+2..offset+9, big-endian
            (< avail 10)
            false
            ; any high-32 bit set => >= 2^32, far past any cap
            (>
              (bit-or
                (bit-or
                  (Byte.to-int @(Array.unsafe-nth buf (+ offset 2)))
                  (Byte.to-int @(Array.unsafe-nth buf (+ offset 3))))
                (bit-or
                  (Byte.to-int @(Array.unsafe-nth buf (+ offset 4)))
                  (Byte.to-int @(Array.unsafe-nth buf (+ offset 5)))))
              0)
            true
            ; low word's top byte >= 128 => >= 2^31, which would overflow Int
            (>= (Byte.to-int @(Array.unsafe-nth buf (+ offset 6))) 128)
            true
            ; remaining value is < 2^31, so computing and comparing it is safe
            (>
              (+
                (* (Byte.to-int @(Array.unsafe-nth buf (+ offset 6))) 16777216)
                (+
                  (* (Byte.to-int @(Array.unsafe-nth buf (+ offset 7))) 65536)
                  (+
                    (* (Byte.to-int @(Array.unsafe-nth buf (+ offset 8))) 256)
                    (Byte.to-int @(Array.unsafe-nth buf (+ offset 9))))))
              cap))))))

  (hidden decode-frame)
  (defn decode-frame [buf offset]
    (let [len (Array.length buf)
          avail (- len offset)]
      (if (< avail 2)
        (the (Maybe WSFrame) (Maybe.Nothing))
        (let-do [b0 (Byte.to-int @(Array.unsafe-nth buf offset))
                 b1 (Byte.to-int @(Array.unsafe-nth buf (+ offset 1)))
                 fin (> (bit-and b0 128) 0)
                 rsv (bit-and (bit-shift-right b0 4) 7)
                 opcode (bit-and b0 15)
                 masked (> (bit-and b1 128) 0)
                 plen0 (bit-and b1 127)
                 hdr-size 2
                 plen plen0
                 ok true]
          (cond
            (= plen0 126)
              (if (< avail 4)
                (set! ok false)
                (do
                  (set! hdr-size 4)
                  (set! plen
                        (+
                          (*
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 2)))
                            256)
                          (Byte.to-int @(Array.unsafe-nth buf (+ offset 3)))))))
            (= plen0 127)
              (if (< avail 10)
                (set! ok false)
                (do
                  (set! hdr-size 10)
                  (if (or
                      (>
                        (bit-or
                          (bit-or
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 2)))
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 3))))
                          (bit-or
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 4)))
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 5)))))
                        0)
                      ; a low-word top byte >= 128 makes the length >= 2^31, which
                      ; would overflow Int to a negative payload length
                      (>= (Byte.to-int @(Array.unsafe-nth buf (+ offset 6))) 128))
                    (set! ok false)
                    (set! plen
                          (+
                            (+
                              (+
                                (*
                                  (Byte.to-int @(Array.unsafe-nth buf
                                                                  (+ offset 6)))
                                  16777216)
                                (*
                                  (Byte.to-int @(Array.unsafe-nth buf
                                                                  (+ offset 7)))
                                  65536))
                              (*
                                (Byte.to-int @(Array.unsafe-nth buf (+ offset 8)))
                                256))
                            (Byte.to-int @(Array.unsafe-nth buf (+ offset 9))))))))
            ())
          (if (not ok)
            (Maybe.Nothing)
            (let [mask-size (if masked 4 0)
                  total (+ (+ hdr-size mask-size) plen)]
              (if (< avail total)
                (Maybe.Nothing)
                (let-do [mask-off (+ offset hdr-size)
                         data-off (+ mask-off mask-size)
                         payload (Array.replicate plen &(Byte.from-int 0))]
                  (for [k 0 plen]
                    (let [b @(Array.unsafe-nth buf (+ data-off k))
                          unmasked (if masked
                            (Byte.from-int
                              (bit-xor (Byte.to-int b)
                                       (Byte.to-int
                                         @(Array.unsafe-nth buf
                                                            (+ mask-off
                                                               (Int.mod k 4))))))
                            b)]
                      (Array.aset! &payload k unmasked)))
                  (Maybe.Just (WSFrame.init fin opcode rsv masked payload total))))))))))

  (hidden control-frame-protocol-error?)
  ; RFC 6455 constraints a control frame (opcode >= 8) must satisfy, checked
  ; before it is acted on. Violating any one fails the connection with 1002:
  ;   §5.5 control frames MUST NOT be fragmented (FIN must be set),
  ;   §5.5 their payload MUST be <= 125 bytes,
  ;   §5.2 only close (8), ping (9) and pong (10) are defined — the reserved
  ;        control opcodes 0xB-0xF must be rejected, not silently ignored.
  (defn control-frame-protocol-error? [opcode fin plen]
    (or (not fin) (> plen 125) (and (/= opcode 8) (/= opcode 9) (/= opcode 10))))

  (hidden close-response-code)
  ; RFC 6455 §5.5.1/§7.4: the status code to echo for a received close frame
  ; (1002 malformed, 1007 non-UTF-8 reason), or Nothing when it had no payload.
  (defn close-response-code [payload]
    (let [len (Array.length payload)]
      (cond
        (= len 0) (Maybe.Nothing)
        (= len 1) (Maybe.Just 1002)
        (let [code (+
                (* (Byte.to-int @(Array.unsafe-nth payload 0)) 256)
                (Byte.to-int @(Array.unsafe-nth payload 1)))]
          (cond
            (or (< code 1000)
                (and (>= code 1004) (<= code 1006))
                (and (>= code 1012) (<= code 2999))
                (> code 4999))
              (Maybe.Just 1002)
            (not (UTF8.valid? &(Array.suffix payload 2))) (Maybe.Just 1007)
            (Maybe.Just code))))))

  (hidden close-response-frame)
  (defn close-response-frame [payload]
    (match (close-response-code payload)
      (Maybe.Nothing) (encode-close)
      (Maybe.Just code) (encode-close-with-code code)))

  (doc send "queues a text message for sending on the WebSocket connection.")
  (defn send [ws msg] (Array.push-back! (WebSocket.outbox ws) (encode-text msg)))

  (doc send-binary
    "queues a binary message for sending on the WebSocket connection.")
  (defn send-binary [ws data]
    (Array.push-back! (WebSocket.outbox ws) (encode-binary data)))

  (private ws-write-fd-)
  (hidden ws-write-fd-)
  (relative-include "src/ws_write.h")
  (register ws-write-fd- (Fn [Int &(Array Byte)] Int) "ws_write_fd")

  (doc send-now "sends a text message immediately, bypassing the outbox.
Writes the WebSocket frame directly to the socket, waiting for the socket to
drain if the kernel send buffer is full. Use this inside handlers that block
for a long time (e.g. LLM streaming) so that each message reaches the client
without waiting for the handler to return.

Returns `true` when the whole frame was written. Returns `false` when the
connection is dead or the client stopped draining; the caller should stop
sending on this connection.")
  (defn send-now [ws msg]
    (let [frame (encode-text msg)]
      (= (ws-write-fd- @(WebSocket.fd ws) &frame) (Array.length &frame))))

  (doc send-binary-now
    "sends a binary message immediately, bypassing the outbox.
Like [`send-now`](#send-now) but for binary data.")
  (defn send-binary-now [ws data]
    (let [frame (encode-binary data)]
      (= (ws-write-fd- @(WebSocket.fd ws) &frame) (Array.length &frame)))))

(hidden ws-magic-guid)
(def ws-magic-guid @"258EAFA5-E914-47DA-95CA-C5AB0DC85B11")

(hidden ws-accept-key)
(defn ws-accept-key [client-key]
  (let [combined (String.append client-key &ws-magic-guid)
        hash (SHA1.digest &(String.to-bytes &combined))]
    (Base64.encode &hash)))

(doc Handler "is the type of route handler functions.

A handler takes a reference to the parsed `Request` and a reference to a
`(Map String String)` of path parameters captured by `:name` segments in the
route pattern. It returns a `Response`.")

(deftype Route
  [method String
   pattern String
   handler (Fn [&Request &(Map String String)] Response)])

(doc match-route "matches a route `pattern` against a request `path`.

Pattern segments starting with `:` are named captures. A `*` as the last
segment matches the rest of the path and captures it as the `*` parameter.
The bare pattern `*` matches any path. Returns `(Maybe (Map String String))`
containing the captured parameters, or `Nothing` if the path does not match.

Examples: `/api/*` matches `/api/foo/bar` with `* = foo/bar`.
`/users/:id/*` matches `/users/42/posts/1` with `id = 42`, `* = posts/1`.")
(defn match-route [pattern path]
  (if (= pattern "*")
    (Maybe.Just (the (Map String String) {}))
    (let [pat-parts &(String.split-by pattern &[\/])
          path-parts &(String.split-by path &[\/])
          n-pat (Array.length pat-parts)
          n-path (Array.length path-parts)
          has-glob (and (> n-pat 0)
                        (= (Array.unsafe-nth pat-parts (- n-pat 1)) "*"))]
      (if (if has-glob (< n-path (- n-pat 1)) (/= n-pat n-path))
        (Maybe.Nothing)
        (let-do [params (the (Map String String) {})
                 matched true
                 fixed-segs (if has-glob (- n-pat 1) n-pat)]
          (for [i 0 fixed-segs]
            (let [pp (Array.unsafe-nth pat-parts i)
                  rp (Array.unsafe-nth path-parts i)]
              (if (and (> (String.length pp) 0) (= (String.char-at pp 0) \:))
                (let [k (String.suffix pp 1)] (Map.put! &params &k rp))
                (when-do (/= pp rp) (set! matched false) (break)))))
          ; Capture the glob tail if present
          (when (and matched has-glob)
            (let-do [tail @""]
              (for [j fixed-segs n-path]
                (do
                  (when (> j fixed-segs) (set! tail (String.append &tail "/")))
                  (set! tail
                        (String.append &tail (Array.unsafe-nth path-parts j)))))
              (Map.put! &params &@"*" &tail)))
          (if matched (Maybe.Just params) (Maybe.Nothing)))))))

(doc WSRoute
  "a WebSocket route entry. The handler receives a [`WSEvent`](#WSEvent),
the captured path parameters, and a [`WebSocket`](#WebSocket) handle for sending
responses. The `protocols` field lists the subprotocols that this route supports
(RFC 6455 §4.2.2). An empty list means no subprotocol negotiation.")
(deftype WSRoute
  [pattern String
   protocols (Array String)
   handler (Fn [&WSEvent &(Map String String) &WebSocket] ())])

(doc SSEEvent "represents an event on a Server-Sent Events stream.

Handlers receive one of these for each lifecycle event:
- `Connect`: the stream was opened
- `Tick`: `App.sse-tick-interval` seconds passed since the last push
- `Close`: the peer went away; anything queued in response is discarded")
(deftype SSEEvent Connect Tick Close)

(doc SSEStream "represents an open Server-Sent Events stream.

Handlers receive a reference to this and call [`SSEStream.send`](#send),
[`SSEStream.send-event`](#send-event) or [`SSEStream.send-raw`](#send-raw) to
queue outgoing events. The event loop drains the outbox after the handler
returns.

The `last-event-id` field holds the `Last-Event-ID` header a reconnecting
client sent, or `Nothing` on a fresh stream.")
(deftype SSEStream [fd Int
                    last-event-id (Maybe String)
                    outbox (Array String)])

(doc SSE "encodes the Server-Sent Events wire format (WHATWG HTML §9.2.6).

Every function here returns one complete block, terminated by the blank line
that dispatches it. Carriage returns and newlines are stripped from field
values, and a `data` value spanning several lines becomes one `data:` line per
line.")
(defmodule SSE
  ; CR and LF never occur inside a multi-byte UTF-8 sequence, so this is safe
  ; to do bytewise.
  (hidden scrub)
  (defn scrub [value]
    (let-do [bs (String.to-bytes value)
             out (the (Array Byte) [])]
      (for [i 0 (Array.length &bs)]
        (let [b @(Array.unsafe-nth &bs i)]
          (unless (or (= b (Char.to-byte \return)) (= b (Char.to-byte \newline)))
            (Array.push-back! &out b))))
      (String.from-bytes &out)))

  (hidden split-lines)
  (defn split-lines [value]
    (let-do [bs (String.to-bytes value)
             n (Array.length &bs)
             out (the (Array String) [])
             cur (the (Array Byte) [])
             i 0]
      (while (< i n)
        (let [b @(Array.unsafe-nth &bs i)]
          (cond
            (= b (Char.to-byte \return))
              (do
                (Array.push-back! &out (String.from-bytes &cur))
                (set! cur (the (Array Byte) []))
                (set! i
                      (if (and (< (+ i 1) n)
                               (= @(Array.unsafe-nth &bs (+ i 1))
                                  (Char.to-byte \newline)))
                        (+ i 2)
                        (+ i 1))))
            (= b (Char.to-byte \newline))
              (do
                (Array.push-back! &out (String.from-bytes &cur))
                (set! cur (the (Array Byte) []))
                (set! i (+ i 1)))
            (do (Array.push-back! &cur b) (set! i (+ i 1))))))
      (Array.push-back! &out (String.from-bytes &cur))
      out))

  (doc encode "encodes one event with an optional name, `id` and `retry`.

`retry` is the reconnection time in milliseconds a client should wait before
reopening the stream. An empty `payload` still emits an empty `data:` line, so
the event is dispatched with an empty payload rather than dropped.")
  (sig encode
       (Fn [(Maybe String) (Ref String) (Maybe String) (Maybe Int)] String))
  (defn encode [name payload id retry]
    (let-do [parts (the (Array String) [])]
      (match id
        (Maybe.Just v) (Array.push-back! &parts (fmt "id: %s\n" &(scrub &v)))
        (Maybe.Nothing) ())
      (match name
        (Maybe.Just v) (Array.push-back! &parts (fmt "event: %s\n" &(scrub &v)))
        (Maybe.Nothing) ())
      (match retry
        (Maybe.Just ms) (Array.push-back! &parts (fmt "retry: %d\n" ms))
        (Maybe.Nothing) ())
      (let-do [ls (split-lines payload)]
        (for [i 0 (Array.length &ls)]
          (Array.push-back! &parts (fmt "data: %s\n" (Array.unsafe-nth &ls i)))))
      (Array.push-back! &parts @"\n")
      (String.concat &parts)))

  (doc data "encodes a `data`-only event.")
  (defn data [value]
    (encode (Maybe.Nothing) value (Maybe.Nothing) (Maybe.Nothing)))

  (doc event "encodes an event with a name, which the client listens for by
that name instead of `message`.")
  (defn event [name value]
    (encode (Maybe.Just @name) value (Maybe.Nothing) (Maybe.Nothing)))

  (doc comment-line "encodes a comment line. Clients ignore it; it keeps the
stream and any proxy in front of it from timing out.")
  (defn comment-line [text] (fmt ": %s\n\n" &(scrub text)))

  (doc retry-after "encodes a lone reconnection time in milliseconds.")
  (defn retry-after [ms] (fmt "retry: %d\n\n" ms)))

(defmodule SSEStream
  (doc send "queues a `data`-only event on the stream.")
  (defn send [s value] (Array.push-back! (SSEStream.outbox s) (SSE.data value)))

  (doc send-event "queues an event with a name on the stream.")
  (defn send-event [s name value]
    (Array.push-back! (SSEStream.outbox s) (SSE.event name value)))

  (doc send-raw "queues an already encoded block, for instance one built with
[`SSE.encode`](./SSE.html#encode).")
  (defn send-raw [s chunk] (Array.push-back! (SSEStream.outbox s) chunk)))

(doc SSERoute
  "a Server-Sent Events route entry. The handler receives an
[`SSEEvent`](#SSEEvent), the captured path parameters, and an
[`SSEStream`](#SSEStream) handle for queueing events.")
(deftype SSERoute
  [pattern String
   handler (Fn [&SSEEvent &(Map String String) &SSEStream] ())])

(deftype App
  [routes (Array Route)
   ws-routes (Array WSRoute)
   sse-routes (Array SSERoute)
   error-handler (Fn [&Request Int String] Response)])

; Index of the CR opening the CRLFCRLF that ends the header block, or -1.
(hidden web-header-end-index)
(defn web-header-end-index [buf]
  (let-do [found -1
           len (Array.length buf)]
    (when (>= len 4)
      (for [i 0 (- len 3)]
        (when-do (and
            (= @(Array.unsafe-nth buf i) (Char.to-byte \return))
            (and
              (= @(Array.unsafe-nth buf (+ i 1)) (Char.to-byte \newline))
              (and
                (= @(Array.unsafe-nth buf (+ i 2)) (Char.to-byte \return))
                (= @(Array.unsafe-nth buf (+ i 3)) (Char.to-byte \newline)))))
          (set! found i)
          (break))))
    found))

(defn web-has-header-end [buf] (>= (web-header-end-index buf) 0))

; Index of the first CRLF at or after `start`, searching below `limit`, or -1.
(hidden web-crlf-index)
(defn web-crlf-index [buf start limit]
  (let-do [found -1]
    (when (and (>= start 0) (>= (- limit start) 2))
      (for [i start (- limit 1)]
        (when-do (and
            (= @(Array.unsafe-nth buf i) (Char.to-byte \return))
            (= @(Array.unsafe-nth buf (+ i 1)) (Char.to-byte \newline)))
          (set! found i)
          (break))))
    found))

(hidden web-ows?)
(defn web-ows? [b] (or (= b (Char.to-byte \space)) (= b (Char.to-byte \tab))))

(hidden web-byte-lower)
(defn web-byte-lower [b] (if (and (>= b 65b) (<= b 90b)) (Byte.+ b 32b) b))

; Case-insensitive match of lowercase ASCII `name` at `pos`, bounded by `limit`.
(hidden web-bytes-match?)
(defn web-bytes-match? [buf pos limit name]
  (let-do [nl (Array.length name)
           ok (and (>= pos 0) (<= (+ pos nl) limit))]
    (when ok
      (for [i 0 nl]
        (unless-do (=
            (web-byte-lower @(Array.unsafe-nth buf (+ pos i)))
            @(Array.unsafe-nth name i))
          (set! ok false)
          (break))))
    ok))

; Parses a Content-Length value in [pos, limit); -1 if malformed. Saturating.
(hidden web-parse-content-length)
(defn web-parse-content-length [buf pos limit]
  (let-do [i pos
           v 0
           digits 0]
    (while (and (< i limit) (web-ows? @(Array.unsafe-nth buf i)))
      (set! i (+ i 1)))
    (while-do (and (< i limit)
                   (and (>= @(Array.unsafe-nth buf i) 48b)
                        (<= @(Array.unsafe-nth buf i) 57b)))
      (set! digits (+ digits 1))
      (when (< v 100000000)
        (set! v (+ (* v 10) (- (Byte.to-int @(Array.unsafe-nth buf i)) 48))))
      (set! i (+ i 1)))
    (while (and (< i limit) (web-ows? @(Array.unsafe-nth buf i)))
      (set! i (+ i 1)))
    (if (and (> digits 0) (= i limit)) v -1)))

; Whether the final Transfer-Encoding coding in [pos, limit) is chunked (§3.3.3).
(hidden web-chunked-value?)
(defn web-chunked-value? [buf pos limit]
  (let-do [e limit]
    (while (and (> e pos) (web-ows? @(Array.unsafe-nth buf (- e 1))))
      (set! e (- e 1)))
    (and (>= (- e pos) 7)
         (and
           (web-bytes-match? buf (- e 7) e &(String.to-bytes "chunked"))
           (or (= (- e 7) pos)
               (let [b @(Array.unsafe-nth buf (- e 8))]
                 (or (= b (Char.to-byte \,)) (web-ows? b))))))))

; The value of a single hexadecimal digit, or -1.
(hidden web-hex-digit)
(defn web-hex-digit [b]
  (cond
    (and (>= b 48b) (<= b 57b)) (- (Byte.to-int b) 48)
    (and (>= b 97b) (<= b 102b)) (- (Byte.to-int b) 87)
    (and (>= b 65b) (<= b 70b)) (- (Byte.to-int b) 55)
    -1))

; Parses a chunk-size line in [pos, limit); -1 if malformed. Saturating.
(hidden web-parse-chunk-size)
(defn web-parse-chunk-size [buf pos limit]
  (let-do [i pos
           v 0
           digits 0
           hex true]
    (while-do (and (< i limit) hex)
      (let [d (web-hex-digit @(Array.unsafe-nth buf i))]
        (if (< d 0)
          (set! hex false)
          (do
            (set! digits (+ digits 1))
            (when (< v 100000000) (set! v (+ (* v 16) d)))
            (set! i (+ i 1))))))
    (while (and (< i limit) (web-ows? @(Array.unsafe-nth buf i)))
      (set! i (+ i 1)))
    (if (and (> digits 0)
             (or (= i limit) (= @(Array.unsafe-nth buf i) (Char.to-byte \;))))
      v
      -1)))

; Whether the trailer section at `pos` is complete: (Pair status resume-pos).
(hidden web-trailer-status)
(defn web-trailer-status [buf pos limit]
  (let-do [p pos
           status 0
           done false]
    (while-do (not done)
      (let [nl (web-crlf-index buf p limit)]
        (cond
          (< nl 0) (set! done true)
          (= nl p) (do (set! status 1) (set! done true))
          (set! p (+ nl 2)))))
    (Pair.init status p)))

; Walks the chunk framing at `body-start` (RFC 7230 §4.1), skipping over data
; bytes: 1 complete, 0 needs more bytes, -1 malformed. Resumes from `cursor`
; (positive: chunk-size line, negative: negated trailer line, 0: start over),
; which is range-checked, not validated — every path that clears the read
; buffer must reset it.
(hidden web-chunked-status)
(defn web-chunked-status [buf body-start cursor]
  (let-do [len (Array.length buf)
           back (if (< cursor 0) (- 0 cursor) cursor)
           usable (and (>= back body-start) (<= back len))
           pos (if usable back body-start)
           status 0
           next-cursor 0
           done (and usable (< cursor 0))]
    (when done
      (let-do [t (web-trailer-status buf pos len)]
        (set! status @(Pair.a &t))
        (set! next-cursor (- 0 @(Pair.b &t)))))
    (while-do (not done)
      (let [nl (web-crlf-index buf pos len)]
        (if (< nl 0)
          (do (set! next-cursor pos) (set! done true))
          (let [size (web-parse-chunk-size buf pos nl)]
            (cond
              (< size 0) (do (set! status -1) (set! done true))
              (= size 0)
                (let-do [t (web-trailer-status buf (+ nl 2) len)]
                  (set! status @(Pair.a &t))
                  (set! next-cursor (- 0 @(Pair.b &t)))
                  (set! done true))
              (< (- len (+ nl 2)) (+ size 2))
                (do (set! next-cursor pos) (set! done true))
              (let [after (+ (+ nl 2) size)]
                (if (and
                    (= @(Array.unsafe-nth buf after) (Char.to-byte \return))
                    (= @(Array.unsafe-nth buf (+ after 1))
                       (Char.to-byte \newline)))
                  (set! pos (+ after 2))
                  (do (set! status -1) (set! done true)))))))))
    (Pair.init status next-cursor)))

; Index of the first colon in [start, limit), or -1.
(hidden web-colon-index)
(defn web-colon-index [buf start limit]
  (let-do [found -1]
    (when (>= start 0)
      (for [i start limit]
        (when-do (= @(Array.unsafe-nth buf i) (Char.to-byte \:))
          (set! found i)
          (break))))
    found))

; Whether a header line in [start, limit) has whitespace before its colon (§3.2.4).
(hidden web-space-before-colon?)
(defn web-space-before-colon? [buf start limit]
  (let [c (web-colon-index buf start limit)]
    (and (> c start) (web-ows? @(Array.unsafe-nth buf (- c 1))))))

; The framing of one request, read once from the raw header block; the gate
; and the body decoder both consume it. `malformed` covers everything RFC 7230
; §3.3.3 and §3.2.4 require a 400 for.
(hidden WebFraming)
(deftype WebFraming
  [body-start Int
   content-length (Maybe Int)
   chunked Bool
   expects-continue Bool
   malformed Bool])

; Reads the framing of the request in `buf`; Nothing while headers are incomplete.
(hidden web-parse-framing)
(defn web-parse-framing [buf]
  (let [hdr-end (web-header-end-index buf)]
    (if (< hdr-end 0)
      (the (Maybe WebFraming) (Maybe.Nothing))
      (let-do [cl -2
               bad false
               te false
               chunked false
               expects false
               cl-name &(String.to-bytes "content-length:")
               te-name &(String.to-bytes "transfer-encoding:")
               ex-name &(String.to-bytes "expect:")
               line-start (+ (web-crlf-index buf 0 hdr-end) 2)]
        ; line-start 1 means no header lines below hdr-end at all
        (when (> line-start 1)
          (while (< line-start hdr-end)
            (let-do [nl (web-crlf-index buf line-start (+ hdr-end 2))
                     line-end (if (< nl 0) hdr-end nl)]
              (when (web-space-before-colon? buf line-start line-end)
                (set! bad true))
              (cond
                (web-bytes-match? buf line-start line-end cl-name)
                  (let [v (web-parse-content-length buf
                                                    (+ line-start
                                                       (Array.length cl-name))
                                                    line-end)]
                    (cond
                      (< v 0) (set! bad true)
                      (= cl -2) (set! cl v)
                      (/= cl v) (set! bad true)
                      ()))
                (web-bytes-match? buf line-start line-end te-name)
                  (do
                    (set! te true)
                    (set! chunked
                          (web-chunked-value? buf
                                              (+ line-start
                                                 (Array.length te-name))
                                              line-end)))
                (web-bytes-match? buf line-start line-end ex-name)
                  (let-do [vs (+ line-start (Array.length ex-name))
                           ve line-end]
                    (while (and (< vs ve) (web-ows? @(Array.unsafe-nth buf vs)))
                      (set! vs (+ vs 1)))
                    (while (and (> ve vs)
                                (web-ows? @(Array.unsafe-nth buf (- ve 1))))
                      (set! ve (- ve 1)))
                    (set! expects
                          (and (= (- ve vs) 12)
                               (web-bytes-match? buf
                                                 vs
                                                 ve
                                                 &(String.to-bytes "100-continue")))))
                ())
              (set! line-start (+ line-end 2)))))
        (when (and te (or (not chunked) (/= cl -2))) (set! bad true))
        (Maybe.Just
          (WebFraming.init (+ hdr-end 4)
                           (if (= cl -2)
                             (the (Maybe Int) (Maybe.Nothing))
                             (Maybe.Just cl))
                           (and te (and chunked (not bad)))
                           expects
                           bad))))))

; Whether `buf` holds a whole HTTP request: 1 complete, 0 needs more bytes,
; -1 malformed (400). Paired with the chunk cursor for `web-chunked-status`.
(hidden web-request-status)
(defn web-request-status [buf cursor]
  (match (web-parse-framing buf)
    (Maybe.Nothing) (Pair.init 0 0)
    (Maybe.Just f)
      (cond
        @(WebFraming.malformed &f) (Pair.init -1 0)
        @(WebFraming.chunked &f)
          (web-chunked-status buf @(WebFraming.body-start &f) cursor)
        (match-ref (WebFraming.content-length &f)
          (Maybe.Just cl)
            (Pair.init
              (if (>= (- (Array.length buf) @(WebFraming.body-start &f)) @cl)
                1
                0)
              0)
          (Maybe.Nothing) (Pair.init 1 0)))))

(hidden web-request-complete?)
(defn web-request-complete? [buf] @(Pair.a &(web-request-status buf 0)))

; Whether the request asks for a 100 Continue: HTTP/1.1 plus Expect: 100-continue.
(hidden web-wants-continue?)
(defn web-wants-continue? [buf]
  (match (web-parse-framing buf)
    (Maybe.Nothing) false
    (Maybe.Just f)
      (and @(WebFraming.expects-continue &f)
           (let [nl (web-crlf-index buf 0 (Array.length buf))]
             (and (>= nl 8)
                  (web-bytes-match? buf
                                    (- nl 8)
                                    nl
                                    &(String.to-bytes "http/1.1")))))))

; Case-insensitive header value lookup. Header names in the parsed map
; preserve original case (RFC 7230 §3.2 says names are case-insensitive).
(hidden header-values-ci)
(defn header-values-ci [hdrs name]
  (let [lower-name &(String.ascii-to-lower name)]
    (Map.kv-reduce
      &(fn [acc k v]
        (if (= &(String.ascii-to-lower k) lower-name)
          (Array.concat &[acc @v])
          acc))
      (the (Array String) [])
      hdrs)))

(defn web-keep-alive? [req]
  (let [conns (header-values-ci (Request.headers req) "Connection")]
    (if (Array.empty? &conns)
      (= (Request.version req) "HTTP/1.1")
      ; RFC 9110 §5.3/§7.6.1: repeated lines form one comma-separated token list
      (not
        (Array.any?
          &(fn [c]
            (Array.any? &(fn [t] (= &(String.trim t) "close"))
                        &(String.split-by &(String.ascii-to-lower c) &[\,])))
          &conns)))))

(defn web-finalize-response [resp keep-alive]
  (let [body-len (String.length (Response.body &resp))
        has-te (Map.contains? (Response.headers &resp) "Transfer-Encoding")
        has-cl (Map.contains? (Response.headers &resp) "Content-Length")
        has-date (Map.contains? (Response.headers &resp) "Date")
        conn-k @"Connection"
        conn-v [(if keep-alive @"keep-alive" @"close")]
        dated (let [withconn (Map.put @(Response.headers &resp) &conn-k &conn-v)]
          (if has-date
            withconn
            (let [d-k @"Date"
                  d-v [(web-http-date (Long.from-int (System.time)))]]
              (Map.put withconn &d-k &d-v))))
        h (if (or has-te has-cl)
          dated
          (let [cl-k @"Content-Length"
                cl-v [(Int.str body-len)]]
            (Map.put dated &cl-k &cl-v)))]
    (Response.set-headers resp h)))

(defn read-request-buf [client buf]
  (let-do [got-request false]
    (TcpStream.clear-buf buf)
    (while true
      (match (TcpStream.read-append client buf)
        (Result.Error _) (break)
        (Result.Success n)
          (cond
            (<= n 0) (break)
            (web-has-header-end buf) (do (set! got-request true) (break))
            ())))
    got-request))

; Extract and URL-decode the request path. The leading "/" is stripped
; by `URI.path`, so this returns "" for the root.

(defn web-request-path [req]
  (URI.unescape
    &(match-ref (URI.path (Request.uri req))
      (Maybe.Just p) @p
      (Maybe.Nothing) @"")))

; Like web-request-path but with a leading "/" suitable for route matching.
(hidden web-routable-path)
(defn web-routable-path [req]
  (let [raw (web-request-path req)]
    (if (String.empty? &raw) @"/" (String.append "/" &raw))))

; Reject paths that contain ".." segments to prevent directory traversal.
(defn web-safe-path? [path]
  (let-do [parts &(String.split-by path &[\/])
           safe true]
    (for [i 0 (Array.length parts)]
      (when-do (= (Array.unsafe-nth parts i) "..") (set! safe false) (break)))
    safe))

(defn web-find-handler [routes req]
  (let-do [result (the (Maybe (Pair Int (Map String String))) (Maybe.Nothing))
           path (web-routable-path req)
           verb (Request.verb req)
           ; RFC 7231: HEAD must match GET routes when no explicit HEAD route
           is-head (= verb "HEAD")]
    (for [i 0 (Array.length routes)]
      (let [r (Array.unsafe-nth routes i)]
        (when (or (= (Route.method r) verb)
                  (and is-head (= (Route.method r) "GET")))
          (match (match-route (Route.pattern r) &path)
            (Maybe.Just params)
              (do (set! result (Maybe.Just (Pair.init i params))) (break))
            (Maybe.Nothing) ()))))
    result))

; Find a matching WebSocket route by path (method is always GET for upgrades).
(hidden web-find-ws-handler)
(defn web-find-ws-handler [ws-routes path]
  (let-do [result (the (Maybe (Pair Int (Map String String))) (Maybe.Nothing))]
    (for [i 0 (Array.length ws-routes)]
      (let [r (Array.unsafe-nth ws-routes i)]
        (match (match-route (WSRoute.pattern r) path)
          (Maybe.Just params)
            (do (set! result (Maybe.Just (Pair.init i params))) (break))
          (Maybe.Nothing) ())))
    result))

; Parse a comma-separated Sec-WebSocket-Protocol header value into a list
; of trimmed, non-empty protocol tokens (RFC 6455 §4.2.1).
(hidden ws-parse-protocols)
(defn ws-parse-protocols [header-val]
  (let-do [parts &(String.split-by header-val &[\,])
           result (the (Array String) [])]
    (for [i 0 (Array.length parts)]
      (let [trimmed (String.trim (Array.unsafe-nth parts i))]
        (when (> (String.length &trimmed) 0) (Array.push-back! &result trimmed))))
    result))

; Select the first client-requested protocol that appears in the server's
; supported list (RFC 6455 §4.2.2). Returns Nothing if no match or either
; list is empty.
(hidden ws-negotiate-protocol)
(defn ws-negotiate-protocol [client-protos server-protos]
  (let-do [result (the (Maybe String) (Maybe.Nothing))]
    (for [i 0 (Array.length client-protos)]
      (let-do [found false]
        (for [j 0 (Array.length server-protos)]
          (when-do (= (Array.unsafe-nth client-protos i)
                      (Array.unsafe-nth server-protos j))
            (set! result (Maybe.Just @(Array.unsafe-nth client-protos i)))
            (set! found true)
            (break)))
        (when found (break))))
    result))

; Try to parse a WebSocket upgrade from a raw HTTP buffer. Returns
; (Maybe (Pair String (Pair Int (Pair (Maybe String) (Map String String)))))
; — the accept key, route index, negotiated protocol, and params — or
; Nothing if it is not an upgrade.
(hidden web-try-ws-upgrade)
(defn web-try-ws-upgrade [buf ws-routes]
  (if (= 0 (Array.length ws-routes))
    (the
      (Maybe (Pair String (Pair Int (Pair (Maybe String) (Map String String)))))
      (Maybe.Nothing))
    (let [raw &(String.from-bytes buf)]
      (match (Request.parse raw)
        (Result.Error _)
        (Maybe.Nothing)
        (Result.Success req)
        ; RFC 7230 §3.2: header field names are case-insensitive
        (let [has-upgrade (let [vals (header-values-ci (Request.headers &req)
                                                       "Upgrade")]
                (if (> (Array.length &vals) 0)
                  ; RFC 6455 §4.2.1: Upgrade value is case-insensitive
                  (=
                    &(String.ascii-to-lower (Array.unsafe-first &vals))
                    "websocket")
                  false))
              key-vals (header-values-ci (Request.headers &req)
                                         "Sec-WebSocket-Key")
              ; RFC 6455 §4.2.1: Sec-WebSocket-Version MUST be 13
              version-vals (header-values-ci (Request.headers &req)
                                             "Sec-WebSocket-Version")
              version-ok (if (> (Array.length &version-vals) 0)
                (= (Array.unsafe-first &version-vals) "13")
                false)
              ; RFC 6455 §4.2.1: Sec-WebSocket-Protocol (optional)
              proto-vals (header-values-ci (Request.headers &req)
                                           "Sec-WebSocket-Protocol")
              client-protos (if (> (Array.length &proto-vals) 0)
                (ws-parse-protocols (Array.unsafe-first &proto-vals))
                (the (Array String) []))]
          (if (and has-upgrade (> (Array.length &key-vals) 0))
            (if (not version-ok)
              ; Bad or missing version — signal with route-idx -1
              (Maybe.Just
                (Pair.init @""
                           (Pair.init -1
                                      (Pair.init (the (Maybe String)
                                                      (Maybe.Nothing))
                                                 (the (Map String String) {})))))
              (let [path (web-routable-path &req)]
                (match (web-find-ws-handler ws-routes &path)
                  (Maybe.Just route-match)
                    (let [ri @(Pair.a &route-match)
                          params @(Pair.b &route-match)
                          server-protos (WSRoute.protocols (Array.unsafe-nth ws-routes
                                                                             ri))
                          negotiated (if (> (Array.length &client-protos) 0)
                            (ws-negotiate-protocol &client-protos server-protos)
                            (the (Maybe String) (Maybe.Nothing)))]
                      (Maybe.Just
                        (Pair.init
                          (ws-accept-key (Array.unsafe-first &key-vals))
                          (Pair.init ri (Pair.init negotiated params)))))
                  (Maybe.Nothing) (Maybe.Nothing))))
            (Maybe.Nothing)))))))

; Find a matching Server-Sent Events route by path.
(hidden web-find-sse-handler)
(defn web-find-sse-handler [sse-routes path]
  (let-do [result (the (Maybe (Pair Int (Map String String))) (Maybe.Nothing))]
    (for [i 0 (Array.length sse-routes)]
      (let [r (Array.unsafe-nth sse-routes i)]
        (match (match-route (SSERoute.pattern r) path)
          (Maybe.Just params)
            (do (set! result (Maybe.Just (Pair.init i params))) (break))
          (Maybe.Nothing) ())))
    result))

; Try to match a raw HTTP buffer against a Server-Sent Events route. Returns
; (Maybe (Pair Int (Pair (Maybe String) (Map String String)))) — the route
; index, the Last-Event-ID header, and the params — or Nothing.
(hidden web-try-sse)
(defn web-try-sse [buf sse-routes]
  (if (Array.empty? sse-routes)
    (the (Maybe (Pair Int (Pair (Maybe String) (Map String String))))
         (Maybe.Nothing))
    (match (Request.parse &(String.from-bytes buf))
      (Result.Error _) (Maybe.Nothing)
      (Result.Success req)
        (if (/= (Request.verb &req) "GET")
          (Maybe.Nothing)
          (match (web-find-sse-handler sse-routes &(web-routable-path &req))
            (Maybe.Nothing) (Maybe.Nothing)
            (Maybe.Just m)
              (let [ids (header-values-ci (Request.headers &req) "Last-Event-ID")
                    last-id (if (Array.empty? &ids)
                      (the (Maybe String) (Maybe.Nothing))
                      (Maybe.Just @(Array.unsafe-first &ids)))]
                (Maybe.Just (Pair.init @(Pair.a &m)
                                       (Pair.init last-id @(Pair.b &m))))))))))

; Run before-hooks. Each hook can annotate `params` via Map.put! and
; optionally short-circuit by returning (Maybe.Just response).
(defn web-run-before [hooks req params]
  (let-do [result (the (Maybe Response) (Maybe.Nothing))]
    (for [i 0 (Array.length hooks)]
      (match (~(Array.unsafe-nth hooks i) req params)
        (Maybe.Just resp) (do (set! result (Maybe.Just resp)) (break))
        (Maybe.Nothing) ()))
    result))

; Run after-hooks, folding the response through each one.
(defn web-run-after [hooks req params resp]
  (let-do [r resp]
    (for [i 0 (Array.length hooks)]
      (set! r (~(Array.unsafe-nth hooks i) req params r)))
    r))

(deftype RangeResolution
  (Full [])
  (Partial [Long Long])
  (Unsatisfiable []))

; An unparseable range serves the whole representation (RFC 9110 §14.2); a
; multi-range set resolves to its first satisfiable range.
(defn web-resolve-range [spec total]
  (match (ByteRange.parse spec)
    (Result.Error _) (RangeResolution.Full)
    (Result.Success specs)
      (let [rs (ByteRange.resolve &specs total)]
        (if (Array.empty? &rs)
          (RangeResolution.Unsatisfiable)
          (let [p (Array.unsafe-first &rs)]
            (RangeResolution.Partial @(Pair.a p) @(Pair.b p)))))))

; Read the internal X-Sendfile-Range marker carrying the request's raw Range.
(hidden web-range-header)
(defn web-range-header [resp]
  (match (Map.get-maybe (Response.headers resp) "X-Sendfile-Range")
    (Maybe.Just vals)
      (if (> (Array.length &vals) 0)
        (Maybe.Just @(Array.unsafe-first &vals))
        (Maybe.Nothing))
    (Maybe.Nothing) (Maybe.Nothing)))

(hidden web-strip-range-marker)
(defn web-strip-range-marker [resp]
  (Response.set-headers resp
                        (Map.remove @(Response.headers &resp)
                                    &@"X-Sendfile-Range")))

; Attach the request's Range header to a sendfile response as an internal
; marker, resolved against the file size at transfer setup.
(hidden web-mark-range)
(defn web-mark-range [req resp]
  (match (web-sendfile-path &resp)
    (Maybe.Nothing) resp
    (Maybe.Just _)
      (match (Request.header req "Range")
        (Maybe.Nothing) resp
        (Maybe.Just rv)
          (let [k @"X-Sendfile-Range"
                v [rv]]
            (Response.set-headers resp (Map.put @(Response.headers &resp) &k &v))))))

; Resolve the marker attached by web-mark-range against a known file size.
(hidden web-resolve-marker)
(defn web-resolve-marker [resp total]
  (match (web-range-header resp)
    (Maybe.Nothing) (RangeResolution.Full)
    (Maybe.Just rh) (web-resolve-range &rh total)))

(hidden web-accept-ranges)
(defn web-accept-ranges [resp]
  (let [k @"Accept-Ranges"
        v [@"bytes"]]
    (Response.set-headers resp (Map.put @(Response.headers &resp) &k &v))))

; A 416 Range Not Satisfiable response with Content-Range: bytes */total.
(hidden web-range-not-satisfiable)
(defn web-range-not-satisfiable [total]
  (let [cr-k @"Content-Range"
        cr-v [(ContentRange.unsatisfied total)]
        ar-k @"Accept-Ranges"
        ar-v [@"bytes"]
        hdrs (Map.put (Map.put {} &cr-k &cr-v) &ar-k &ar-v)]
    (Response.init 416 @"Range Not Satisfiable" @"HTTP/1.1" [] hdrs @"")))

; Turn a full sendfile response into a 206 with Content-Range and
; Accept-Ranges. Content-Length and body are set by web-serialize-response.
(hidden web-partial-headers)
(defn web-partial-headers [resp start end total]
  (let [cr-k @"Content-Range"
        cr-v [(ContentRange.bytes start end total)]
        ar-k @"Accept-Ranges"
        ar-v [@"bytes"]
        hdrs (Map.put
          (Map.put @(Response.headers &resp) &cr-k &cr-v)
          &ar-k
          &ar-v)]
    (Response.set-headers
      (Response.with-status resp 206 @"Partial Content")
      hdrs)))

; HEAD variant: full-file sendfile response, body stripped, Accept-Ranges and
; Content-Length set from the file size.
(hidden web-head-full)
(defn web-head-full [resp sz]
  (let [hdrs (Map.remove @(Response.headers &resp) &@"X-Sendfile")
        ar-k @"Accept-Ranges"
        ar-v [@"bytes"]
        cl-k @"Content-Length"
        cl-v [(Long.str sz)]
        h (Map.put (Map.put hdrs &ar-k &ar-v) &cl-k &cl-v)]
    (-> resp (Response.set-body @"") (Response.set-headers h))))

; HEAD variant: 206 with Content-Range and range-length Content-Length, no body.
(hidden web-head-partial)
(defn web-head-partial [resp start end total]
  (let [hdrs (Map.remove @(Response.headers &resp) &@"X-Sendfile")
        cr-k @"Content-Range"
        cr-v [(ContentRange.bytes start end total)]
        ar-k @"Accept-Ranges"
        ar-v [@"bytes"]
        cl-k @"Content-Length"
        cl-v [(Long.str (+ (- end start) 1l))]
        h (Map.put (Map.put (Map.put hdrs &cr-k &cr-v) &ar-k &ar-v) &cl-k &cl-v)]
    (->
      (Response.with-status resp 206 @"Partial Content")
      (Response.set-body @"")
      (Response.set-headers h))))

; Strip the response body for HEAD requests while preserving Content-Length.
; For sendfile responses, computes Content-Length from the file and removes
; X-Sendfile so the server does not attempt a file transfer.
; When Transfer-Encoding is present, strips the body without adding
; Content-Length (RFC 7230 Section 3.3.2).
(hidden web-strip-head-body)
(defn web-strip-head-body [resp]
  (match (web-sendfile-path &resp)
    (Maybe.Just sf-path)
      (let [ffd (IO.Raw.open &sf-path IO.Raw.O-RDONLY)]
        (if (< ffd 0)
          (Response.not-found)
          (let-do [sz (IO.Raw.fstat-size ffd)]
            (ignore (IO.Raw.close-fd ffd))
            (if (< sz 0l)
              (Response.not-found)
              (match (web-resolve-marker &resp sz)
                (RangeResolution.Full)
                  (web-head-full (web-strip-range-marker resp) sz)
                (RangeResolution.Partial start end)
                  (web-head-partial (web-strip-range-marker resp) start end sz)
                (RangeResolution.Unsatisfiable) (web-range-not-satisfiable sz))))))
    (Maybe.Nothing)
      (if (Map.contains? (Response.headers &resp) "Transfer-Encoding")
        (Response.set-body resp @"")
        (let [body-len (String.length (Response.body &resp))
              hdrs @(Response.headers &resp)
              cl-k @"Content-Length"
              cl-v [(Int.str body-len)]]
          (-> resp
              (Response.set-body @"")
              (Response.set-headers (Map.put hdrs &cl-k &cl-v)))))))

; An entity-tag's opaque tag, weak marker removed (RFC 9110 §8.8.3.2).
(hidden web-etag-opaque)
(defn web-etag-opaque [tag]
  (if (web-starts-with? tag "W/")
    (String.byte-slice tag 2 (String.length tag))
    @tag))

; Split an If-None-Match value into entity-tags; a quoted tag may hold commas,
; so the scan is quote-aware and skips anything malformed.
(hidden web-parse-etag-list)
(defn web-parse-etag-list [s]
  (let-do [len (String.length s)
           out (the (Array String) [])
           i 0]
    (while (< i len)
      (let [c (String.char-at s i)]
        (if (or (= c \,) (or (= c \space) (= c \tab)))
          (set! i (+ i 1))
          (let-do [start i]
            (when (and (= c \W)
                       (and (< (+ i 1) len) (= (String.char-at s (+ i 1)) \/)))
              (set! i (+ i 2)))
            (if (and (< i len) (= (String.char-at s i) \"))
              (let-do [j (+ i 1)]
                (while (and (< j len) (/= (String.char-at s j) \"))
                  (set! j (+ j 1)))
                (if (< j len)
                  (do
                    (Array.push-back! &out (String.byte-slice s start (+ j 1)))
                    (set! i (+ j 1)))
                  (set! i len)))
              (while (and (< i len) (/= (String.char-at s i) \,))
                (set! i (+ i 1))))))))
    out))

; True when one entity-tag in `inm` weakly matches the opaque tag `tag`.
(hidden web-etag-list-match?)
(defn web-etag-list-match? [inm tag]
  (let-do [tags (web-parse-etag-list inm)
           found false]
    (for [i 0 (Array.length &tags)]
      (when (= tag &(web-etag-opaque (Array.unsafe-nth &tags i)))
        (set! found true)))
    found))

; True when If-None-Match matches the response's ETag under the weak
; comparison function, or is `*` (RFC 9110 §13.1.2).
(hidden web-etag-match?)
(defn web-etag-match? [req resp]
  (let [inms (header-values-ci (Request.headers req) "If-None-Match")]
    (cond
      (Array.empty? &inms) false
      (Array.any? &(fn [v] (= &(String.trim v) "*")) &inms) true
      (let [vals (header-values-ci (Response.headers resp) "ETag")]
        (if (Array.empty? &vals)
          false
          (let-do [tag (web-etag-opaque (Array.unsafe-first &vals))
                   found false]
            (for [i 0 (Array.length &inms)]
              (when (web-etag-list-match? (Array.unsafe-nth &inms i) &tag)
                (set! found true)))
            found))))))

(hidden web-get-or-head?)
(defn web-get-or-head? [req]
  (let [v (Request.verb req)] (or (= v "GET") (= v "HEAD"))))

; Restatus with an empty body, dropping the headers that framed the old one
; plus the sendfile markers that would otherwise put a file back in its place.
(hidden web-bodyless)
(defn web-bodyless [resp code reason]
  (let [drop-keys [@"content-length" @"content-type" @"transfer-encoding"
                   @"x-sendfile" @"x-sendfile-range"]
        hdrs (Map.kv-reduce
          &(fn [m k v]
            (if (Array.contains? &drop-keys &(String.ascii-to-lower k))
              m
              (Map.put m k v)))
          (the (Map String (Array String)) {})
          (Response.headers &resp))]
    (-> resp
        (Response.with-status code reason)
        (Response.set-body @"")
        (Response.set-headers hdrs))))

; Turn a response into a 304 keeping the headers RFC 9110 §15.4.5 requires.
(hidden web-not-modified)
(defn web-not-modified [resp] (web-bodyless resp 304 @"Not Modified"))

; The 412 a failed precondition owes a non-GET/HEAD request (RFC 9110 §15.5.13).
(hidden web-precondition-failed)
(defn web-precondition-failed [resp]
  (web-bodyless resp 412 @"Precondition Failed"))

; True when the response's Last-Modified is not newer than If-Modified-Since.
(hidden web-if-modified-since?)
(defn web-if-modified-since? [req resp]
  (match (Request.header req "If-Modified-Since")
    (Maybe.Nothing) false
    (Maybe.Just ims)
      (match (web-parse-http-date &ims)
        (Maybe.Nothing) false
        (Maybe.Just since)
          (let [vals (header-values-ci (Response.headers resp) "Last-Modified")]
            (if (Array.empty? &vals)
              false
              (match (web-parse-http-date (Array.unsafe-first &vals))
                (Maybe.Nothing) false
                (Maybe.Just mtime) (not (Long.< since mtime))))))))

; If-None-Match takes precedence over If-Modified-Since (RFC 9110 §13.1.3),
; which applies to GET and HEAD only; a non-2xx response ignores both (§13.2.1).
(hidden web-conditional-not-modified?)
(defn web-conditional-not-modified? [req resp]
  (let [code @(Response.code resp)]
    (cond
      (or (< code 200) (>= code 300)) false
      (Array.empty? &(header-values-ci (Request.headers req) "If-None-Match"))
        (and (web-get-or-head? req) (web-if-modified-since? req resp))
      (web-etag-match? req resp))))

; Forward-declare App.max-header-line so top-level validation helpers can
; reference it before the main (defmodule App ...) block.
(defmodule App (def max-header-line 8192))

; Check whether a method token is a standard HTTP method (RFC 7231 + PATCH).
(defn web-valid-method? [m]
  (or (= m "GET")
      (or (= m "HEAD")
          (or (= m "POST")
              (or (= m "PUT")
                  (or (= m "DELETE")
                      (or (= m "PATCH")
                          (or (= m "OPTIONS") (or (= m "TRACE") (= m "CONNECT"))))))))))

; Validate the HTTP request line before full parsing.
; Checks method, version, and request-line length.
; Returns (Maybe Response) — Nothing if valid, (Just resp) if malformed.
(defn web-validate-request-line [buf]
  (let [raw &(String.from-bytes buf)
        len (String.length raw)
        first-crlf (String.find-crlf raw 0 len)]
    (cond
      (< first-crlf 0) (Maybe.Just (Response.bad-request))
      (> first-crlf App.max-header-line) (Maybe.Just (Response.bad-request))
      (let [request-line &(String.byte-slice raw 0 first-crlf)
            sp1 (String.index-of request-line \space)]
        (if (< sp1 0)
          (Maybe.Just (Response.bad-request))
          (let [sp2 (String.index-of-from request-line \space (+ sp1 1))]
            (if (< sp2 0)
              (Maybe.Just (Response.bad-request))
              (let [method &(String.byte-slice request-line 0 sp1)
                    version &(String.byte-slice request-line
                                                (+ sp2 1)
                                                (String.length request-line))]
                (cond
                  (not (or (= version "HTTP/1.0") (= version "HTTP/1.1")))
                    (Maybe.Just (Response.bad-request))
                  (not (web-valid-method? method))
                    (Maybe.Just (Response.bad-request))
                  (the (Maybe Response) (Maybe.Nothing)))))))))))

; Dechunk a chunked request body and normalize its framing headers:
; Transfer-Encoding removed, Content-Length set, trailers discarded.
(hidden web-decode-body)
(defn web-decode-body [chunked? req]
  (if chunked?
    (match (TransferEncoding.dechunk (Request.body &req))
      (Result.Error e) (Result.Error e)
      (Result.Success decoded)
        (let [cl-v [(Int.str (String.length &decoded))]
              hdrs (Map.kv-reduce
                &(fn [acc k v]
                  (if (= &(String.ascii-to-lower k) "transfer-encoding")
                    acc
                    (Map.put acc k v)))
                {}
                (Request.headers &req))]
          (Result.Success
            (-> req
                (Request.set-body decoded)
                (Request.set-headers (Map.put hdrs &@"Content-Length" &cl-v))))))
    (Result.Success req)))

; Build the response for a complete request. Returns `(Pair Response Bool)`.
(defn web-build-response [app before-hooks after-hooks buf]
  (let [raw &(String.from-bytes buf)
        chunked (match (web-parse-framing buf)
          (Maybe.Just f) @(WebFraming.chunked &f)
          (Maybe.Nothing) false)
        decoded (match (Request.parse raw)
          (Result.Success parsed) (web-decode-body chunked parsed)
          (Result.Error e) (Result.Error e))]
    (match decoded
      (Result.Error _) (Pair.init (Response.bad-request) false)
      (Result.Success req)
        (let [ka (web-keep-alive? &req)
              is-head (= (Request.verb &req) "HEAD")
              route-match (web-find-handler (App.routes app) &req)
              handler-idx (match-ref &route-match
                (Maybe.Just p) @(Pair.a p)
                (Maybe.Nothing) -1)
              params (match route-match
                (Maybe.Just p) @(Pair.b &p)
                (Maybe.Nothing) (the (Map String String) {}))
              resp (match (web-run-before before-hooks &req &params)
                (Maybe.Just early) early
                (Maybe.Nothing)
                  (if (< handler-idx 0)
                    (~(App.error-handler app) &req 404 @"Not Found")
                    (let [r (Array.unsafe-nth (App.routes app) handler-idx)]
                      (~(Route.handler r) &req &params))))
              after-resp (web-run-after after-hooks &req &params resp)
              ranged (web-mark-range &req after-resp)
              ; a failed precondition: 304 for GET/HEAD, 412 for anything else
              cond-resp (if (web-conditional-not-modified? &req &ranged)
                (if (web-get-or-head? &req)
                  (web-not-modified ranged)
                  (web-precondition-failed ranged))
                ranged)
              ; HEAD: strip body, preserve Content-Length
              final (if is-head (web-strip-head-body cond-resp) cond-resp)]
          (Pair.init final ka)))))

; Check if a response has an X-Sendfile header and extract the path.
(defn web-sendfile-path [resp]
  (match (Map.get-maybe (Response.headers resp) "X-Sendfile")
    (Maybe.Just vals)
      (if (> (Array.length &vals) 0)
        (Maybe.Just @(Array.unsafe-first &vals))
        (Maybe.Nothing))
    (Maybe.Nothing) (Maybe.Nothing)))

; Serialize a response for the wire. For sendfile responses, strips the
; X-Sendfile header and sets Content-Length from the file size.
(defn web-serialize-response [resp ka file-size]
  (let [clean (if (>= file-size 0l)
          (let [hdrs (Map.remove @(Response.headers &resp) &@"X-Sendfile")]
            (-> resp (Response.set-body @"") (Response.set-headers hdrs)))
          resp)
        finalized (web-finalize-response clean ka)
        ; For sendfile: override Content-Length with the actual file size
        final (if (>= file-size 0l)
          (let [cl-key @"Content-Length"
                cl-val [(Long.str file-size)]]
            (Response.set-headers finalized
                                  (Map.put @(Response.headers &finalized)
                                           &cl-key
                                           &cl-val)))
          finalized)
        s (Response.str &final)]
    (String.to-bytes &s)))

(deftype ConnState
  [streams (Map Int TcpStream)
   read-bufs (Map Int (Array Byte))
   write-bufs (Map Int (Array Byte))
   write-positions (Map Int Int)
   keep-alives (Map Int Bool)
   last-active (Map Int Int)
   read-start (Map Int Int)
   chunk-cursor (Map Int Int)
   sf-fds (Map Int Int)
   sf-offsets (Map Int Long)
   sf-sizes (Map Int Long)
   to-close (Array Int)
   ws-route-idx (Map Int Int)
   ws-params (Map Int (Map String String))
   ws-protocol (Map Int (Maybe String))
   ws-frag-bufs (Map Int (Array Byte))
   ws-frag-opcodes (Map Int Int)
   ws-frag-start (Map Int Int)
   ws-ping-count (Map Int Int)
   ws-last-ping (Map Int Int)
   sse-route-idx (Map Int Int)
   sse-params (Map Int (Map String String))
   sse-last-id (Map Int (Maybe String))
   sse-last-tick (Map Int Int)])

(defmodule App
  (doc create "creates an empty App with no routes and a default error handler.")
  (defn create []
    (init []
          []
          []
          (fn [req code msg]
            (Response.with-status (Response.text @&msg) code msg))))

  (doc set-error "sets a custom error handler.")
  (defn set-error [app handler] (set-error-handler app handler))

  (doc route "adds a route to the app.")
  (defn route [app method pattern handler]
    (set-routes app
                (Array.push-back @(routes &app)
                                 (Route.init method pattern handler))))

  (doc GET "adds a GET route.")
  (defn GET [app pattern handler] (route app @"GET" pattern handler))
  (doc POST "adds a POST route.")
  (defn POST [app pattern handler] (route app @"POST" pattern handler))
  (doc PUT "adds a PUT route.")
  (defn PUT [app pattern handler] (route app @"PUT" pattern handler))
  (doc DELETE "adds a DELETE route.")
  (defn DELETE [app pattern handler] (route app @"DELETE" pattern handler))
  (doc PATCH "adds a PATCH route.")
  (defn PATCH [app pattern handler] (route app @"PATCH" pattern handler))

  (doc WS "adds a WebSocket route. The handler is called for each lifecycle
event ([`WSEvent`](#WSEvent)): `Connect`, `Message`, `Binary`, and `Close`.

```
(defn echo [event params ws]
  (match-ref event
    (WSEvent.Connect) (WebSocket.send ws \"connected\")
    (WSEvent.Message msg) (WebSocket.send ws &(fmt \"echo: %s\" msg))
    (WSEvent.Binary data) (WebSocket.send-binary ws data)
    (WSEvent.Close) ()))

(defserver \"0.0.0.0\" 3000
  (WS \"/ws/echo\" echo))
```")
  (defn WS [app pattern handler]
    (set-ws-routes app
                   (Array.push-back @(ws-routes &app)
                                    (WSRoute.init pattern [] handler))))

  (doc WSP "adds a WebSocket route with subprotocol negotiation.

The `protocols` array lists the subprotocols this route supports
(RFC 6455 §4.2.2). During the upgrade handshake, the server selects
the first client-requested protocol that appears in this list and
includes it in the `Sec-WebSocket-Protocol` response header. The
negotiated protocol is available via `(WebSocket.protocol ws)`.

```
(defn chat [event params ws]
  (match-ref event
    (WSEvent.Connect)
      (match-ref (WebSocket.protocol ws)
        (Maybe.Just p) (WebSocket.send ws &(fmt \"using protocol %s\" p))
        (Maybe.Nothing) (WebSocket.send ws \"no subprotocol\"))
    _ ()))

(defserver \"0.0.0.0\" 3000
  (WSP \"/ws/chat\" [@\"chat-v2\" @\"chat-v1\"] chat))
```")
  (defn WSP [app pattern protocols handler]
    (set-ws-routes app
                   (Array.push-back @(ws-routes &app)
                                    (WSRoute.init pattern protocols handler))))

  (doc SSE "adds a Server-Sent Events route. A GET to `pattern` is answered
with a `text/event-stream` body that stays open, and the handler is called for
each lifecycle event ([`SSEEvent`](#SSEEvent)): `Connect`, `Tick` and `Close`.

`Tick` fires every `App.sse-tick-interval` seconds; when it queues nothing, a
comment line goes out instead so idle streams survive proxies. Server-Sent
Events are one-way, so anything the client writes to the stream is ignored.

```
(defn clock [event params s]
  (match-ref event
    (SSEEvent.Connect) (SSEStream.send-event s \"ready\" \"\")
    (SSEEvent.Tick) (SSEStream.send s &(Int.str (System.time)))
    (SSEEvent.Close) ()))

(defserver \"0.0.0.0\" 3000
  (SSE \"/events\" clock))
```")
  (defn SSE [app pattern handler]
    (set-sse-routes app
                    (Array.push-back @(sse-routes &app)
                                     (SSERoute.init pattern handler))))

  (doc static-dir "registers a wildcard GET route that serves files from
`dir` on disk via sendfile. Register after API routes so it acts as a
fallback.")
  (defn static-dir [app dir]
    (route app
           @"GET"
           @"*"
           (fn [req params]
             (let [path (web-request-path req)
                   rel (if (String.empty? &path) @"index.html" path)]
               (if (not (web-safe-path? &rel))
                 (Response.not-found)
                 (Response.sendfile
                   &(String.append &(String.append &dir "/") &rel)))))))

  (def max-request-size 1048576)
  (def idle-timeout 60)
  (def header-timeout 15)
  (def request-timeout 60)
  (def ws-ping-interval 30)
  (def ws-max-missed-pongs 3)
  (def ws-frag-ttl 30)
  (def ws-max-frag-size 1048576)
  (def sse-tick-interval 15)
  (def running true)

  (private sweep-interval)
  (hidden sweep-interval)
  (def sweep-interval 30)

  (hidden queue-close)
  (defn queue-close [cs fd] (Array.push-back! (ConnState.to-close cs) fd))

  (hidden conn-done-writing)
  (defn conn-done-writing [cs poll fd]
    (let-do [ka (Map.get (ConnState.keep-alives cs) &fd)]
      (Map.remove! (ConnState.write-bufs cs) &fd)
      (Map.remove! (ConnState.write-positions cs) &fd)
      (Map.remove! (ConnState.keep-alives cs) &fd)
      (if ka
        (do
          (unless (Map.contains? (ConnState.ws-route-idx cs) &fd)
            (Map.update-value! (ConnState.read-bufs cs)
                               &fd
                               &(fn [b] (TcpStream.clear-buf b))))
          (Map.put! (ConnState.read-start cs) &fd &0)
          (Map.put! (ConnState.chunk-cursor cs) &fd &0)
          (ignore (Poll.modify poll fd poll-read)))
        (queue-close cs fd))))

  (hidden conn-done-sendfile)
  (defn conn-done-sendfile [cs poll fd]
    (do
      (ignore (IO.Raw.close-fd (Map.get (ConnState.sf-fds cs) &fd)))
      (Map.remove! (ConnState.sf-fds cs) &fd)
      (Map.remove! (ConnState.sf-offsets cs) &fd)
      (Map.remove! (ConnState.sf-sizes cs) &fd)
      (conn-done-writing cs poll fd)))

  ; Open a sendfile response's target, resolve an optional byte range against
  ; its size, and return the serialized head. A satisfiable range seeds the fd's
  ; offset/size so the existing transfer loop sends exactly [start, end].
  (hidden setup-sendfile)
  (defn setup-sendfile [cs fd resp ka]
    (match (web-sendfile-path &resp)
      (Maybe.Nothing) (web-serialize-response resp ka -1l)
      (Maybe.Just p)
        (let [ffd (IO.Raw.open &p IO.Raw.O-RDONLY)]
          (if (< ffd 0)
            (web-serialize-response (Response.not-found) ka -1l)
            (let [sz (IO.Raw.fstat-size ffd)]
              (if (< sz 0l)
                (do
                  (ignore (IO.Raw.close-fd ffd))
                  (web-serialize-response (Response.not-found) ka -1l))
                (match (web-resolve-marker &resp sz)
                  (RangeResolution.Full)
                    (do
                      (Map.put! (ConnState.sf-fds cs) &fd &ffd)
                      (Map.put! (ConnState.sf-offsets cs) &fd &0l)
                      (Map.put! (ConnState.sf-sizes cs) &fd &sz)
                      (web-serialize-response
                        (web-accept-ranges (web-strip-range-marker resp))
                        ka
                        sz))
                  (RangeResolution.Partial start end)
                    (do
                      (Map.put! (ConnState.sf-fds cs) &fd &ffd)
                      (Map.put! (ConnState.sf-offsets cs) &fd &start)
                      (Map.put! (ConnState.sf-sizes cs) &fd &(+ end 1l))
                      (web-serialize-response
                        (web-partial-headers (web-strip-range-marker resp)
                                             start
                                             end
                                             sz)
                        ka
                        (+ (- end start) 1l)))
                  (RangeResolution.Unsatisfiable)
                    (do
                      (ignore (IO.Raw.close-fd ffd))
                      (web-serialize-response (web-range-not-satisfiable sz)
                                              ka
                                              -1l)))))))))

  (hidden conn-cleanup)
  (defn conn-cleanup [cs sse-routes poll fd]
    (do
      (when-do (Map.contains? (ConnState.sse-route-idx cs) &fd)
        (let [params (Map.value-ref! (ConnState.sse-params cs)
                                     &fd
                                     &(fn [p] @p)
                                     (the (Map String String) {}))
              last-id (Map.value-ref! (ConnState.sse-last-id cs)
                                      &fd
                                      &(fn [i] @i)
                                      (the (Maybe String) (Maybe.Nothing)))
              s (SSEStream.init fd last-id [])]
          (~(SSERoute.handler (Array.unsafe-nth sse-routes
                                                (Map.get (ConnState.sse-route-idx cs)
                                                         &fd))) &(SSEEvent.Close)
                                                                &params
                                                                &s))
        (Map.remove! (ConnState.sse-route-idx cs) &fd)
        (Map.remove! (ConnState.sse-params cs) &fd)
        (Map.remove! (ConnState.sse-last-id cs) &fd)
        (Map.remove! (ConnState.sse-last-tick cs) &fd))
      (ignore (Poll.remove-fd poll fd))
      (Map.update-value! (ConnState.streams cs)
                         &fd
                         &(fn [s] (TcpStream.close! s)))
      (Map.remove! (ConnState.streams cs) &fd)
      (Map.remove! (ConnState.read-bufs cs) &fd)
      (Map.remove! (ConnState.write-bufs cs) &fd)
      (Map.remove! (ConnState.write-positions cs) &fd)
      (Map.remove! (ConnState.keep-alives cs) &fd)
      (Map.remove! (ConnState.last-active cs) &fd)
      (Map.remove! (ConnState.read-start cs) &fd)
      (Map.remove! (ConnState.chunk-cursor cs) &fd)
      (when-do (Map.contains? (ConnState.sf-fds cs) &fd)
        (ignore (IO.Raw.close-fd (Map.get (ConnState.sf-fds cs) &fd)))
        (Map.remove! (ConnState.sf-fds cs) &fd)
        (Map.remove! (ConnState.sf-offsets cs) &fd)
        (Map.remove! (ConnState.sf-sizes cs) &fd))
      (Map.remove! (ConnState.ws-route-idx cs) &fd)
      (Map.remove! (ConnState.ws-params cs) &fd)
      (Map.remove! (ConnState.ws-protocol cs) &fd)
      (Map.remove! (ConnState.ws-frag-bufs cs) &fd)
      (Map.remove! (ConnState.ws-frag-opcodes cs) &fd)
      (Map.remove! (ConnState.ws-frag-start cs) &fd)
      (Map.remove! (ConnState.ws-ping-count cs) &fd)
      (Map.remove! (ConnState.ws-last-ping cs) &fd)))

  (hidden handle-accept)
  (defn handle-accept [cs poll listener]
    (match (TcpListener.accept listener)
      (Result.Error _) ()
      (Result.Success client)
        (let-do [cfd (TcpStream.poll-fd &client)]
          (TcpStream.set-nodelay &client)
          (TcpStream.set-nonblocking &client)
          (ignore (Poll.add poll cfd poll-read))
          (Map.put! (ConnState.streams cs) &cfd &client)
          (Map.put! (ConnState.read-bufs cs) &cfd &(the (Array Byte) []))
          (Map.put! (ConnState.last-active cs) &cfd &(System.time))
          (Map.put! (ConnState.read-start cs) &cfd &0)
          (Map.put! (ConnState.chunk-cursor cs) &cfd &0))))

  (hidden handle-writable)
  (defn handle-writable [cs poll fd]
    (match (Map.get-maybe (ConnState.streams cs) &fd)
      (Maybe.Nothing) ()
      (Maybe.Just stream)
        (let [stream2 @&stream
              pos (Map.get (ConnState.write-positions cs) &fd)
              n (Map.value-ref! (ConnState.write-bufs cs)
                                &fd
                                &(fn [buf]
                                  (match (TcpStream.send-nb &stream buf pos)
                                    (Result.Success k) k
                                    (Result.Error _) -1))
                                -1)]
          (if (< n 0)
            (queue-close cs fd)
            (do
              (when (> n 0)
                (Map.put! (ConnState.last-active cs) &fd &(System.time)))
              (let [new-pos (+ pos n)
                    buf-len (Map.value-ref! (ConnState.write-bufs cs)
                                            &fd
                                            &(fn [b] (Array.length b))
                                            0)]
                (cond
                  (< new-pos buf-len)
                    (Map.put! (ConnState.write-positions cs) &fd &new-pos)
                  (Map.contains? (ConnState.sf-fds cs) &fd)
                    (let-do [sf-fd (Map.get (ConnState.sf-fds cs) &fd)
                             sf-off (Map.get (ConnState.sf-offsets cs) &fd)
                             sf-sz (Map.get (ConnState.sf-sizes cs) &fd)
                             sn (match (TcpStream.sendfile-chunk &stream2
                                                                 sf-fd
                                                                 &sf-off
                                                                 (- sf-sz sf-off))
                               (Result.Success k) k
                               (Result.Error _) -1)]
                      (Map.put! (ConnState.sf-offsets cs) &fd &sf-off)
                      (cond
                        (< sn 0) (queue-close cs fd)
                        (>= sf-off sf-sz) (conn-done-sendfile cs poll fd)
                        ()))
                  (conn-done-writing cs poll fd))))))))

  (hidden ws-flatten-outbox)
  (defn ws-flatten-outbox [ws wbuf]
    (for [i 0 (Array.length (WebSocket.outbox ws))]
      (let [frame (Array.unsafe-nth (WebSocket.outbox ws) i)]
        (for [j 0 (Array.length frame)]
          (Array.push-back! wbuf @(Array.unsafe-nth frame j))))))

  (hidden sse-flatten-outbox)
  (defn sse-flatten-outbox [s wbuf]
    (for [i 0 (Array.length (SSEStream.outbox s))]
      (let [chunk (String.to-bytes (Array.unsafe-nth (SSEStream.outbox s) i))]
        (for [j 0 (Array.length &chunk)]
          (Array.push-back! wbuf @(Array.unsafe-nth &chunk j))))))

  ; The head deliberately carries no Content-Length: the body is the stream.
  (hidden sse-response-head)
  (def sse-response-head @"HTTP/1.1 200 OK\r\nContent-Type: text/event-stream\r\nCache-Control: no-cache\r\nConnection: keep-alive\r\n\r\n")

  (hidden sse-keep-alive-chunk)
  (def sse-keep-alive-chunk @":\n\n")

  (hidden handle-sse-open)
  (defn handle-sse-open [cs sse-routes poll fd stream route-idx last-id params]
    (let-do [wbuf (String.to-bytes &sse-response-head)
             s (SSEStream.init fd @last-id [])]
      (~(SSERoute.handler (Array.unsafe-nth sse-routes route-idx)) &(SSEEvent.Connect)
                                                                   params
                                                                   &s)
      (sse-flatten-outbox &s &wbuf)
      (Map.put! (ConnState.write-bufs cs) &fd &wbuf)
      (Map.put! (ConnState.write-positions cs) &fd &0)
      (Map.put! (ConnState.keep-alives cs) &fd &true)
      (Map.put! (ConnState.sse-route-idx cs) &fd &route-idx)
      (Map.put! (ConnState.sse-params cs) &fd params)
      (Map.put! (ConnState.sse-last-id cs) &fd last-id)
      (Map.put! (ConnState.sse-last-tick cs) &fd &(System.time))
      (Map.update-value! (ConnState.read-bufs cs)
                         &fd
                         &(fn [b] (TcpStream.clear-buf b)))
      (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                               &fd
                               &(fn [b]
                                 (match (TcpStream.send-nb &stream b 0)
                                   (Result.Success k) k
                                   (Result.Error _) -1))
                               -1)
            buf-len (Array.length &wbuf)]
        (cond
          (< n0 0) (queue-close cs fd)
          (< n0 buf-len)
            (do
              (Map.put! (ConnState.write-positions cs) &fd &n0)
              (ignore (Poll.modify poll fd poll-write)))
          (conn-done-writing cs poll fd)))))

  ; The protocol is one-way, so a readable event is either the peer going away
  ; or bytes with nowhere to go.
  (hidden handle-sse-readable)
  (defn handle-sse-readable [cs -poll fd]
    (match (Map.get-maybe (ConnState.streams cs) &fd)
      (Maybe.Nothing) ()
      (Maybe.Just stream)
        (let [n (Map.value-ref! (ConnState.read-bufs cs)
                                &fd
                                &(fn [buf]
                                  (match (TcpStream.read-append-nb &stream buf)
                                    (Result.Success k) k
                                    (Result.Error _) -1))
                                -1)]
          (cond
            (= n TcpStream.read-blocked) ()
            (<= n 0) (queue-close cs fd)
            (Map.update-value! (ConnState.read-bufs cs)
                               &fd
                               &(fn [b] (TcpStream.clear-buf b)))))))

  (hidden handle-ws-upgrade)
  (defn handle-ws-upgrade [cs
                           ws-routes
                           poll
                           fd
                           stream
                           accept
                           route-idx
                           proto
                           params]
    (let-do [resp-str (match-ref proto
               (Maybe.Just p)
                 (fmt
                   "HTTP/1.1 101 Switching Protocols\r\nUpgrade: websocket\r\nConnection: Upgrade\r\nSec-WebSocket-Accept: %s\r\nSec-WebSocket-Protocol: %s\r\n\r\n"
                   accept
                   p)
               (Maybe.Nothing)
                 (fmt
                   "HTTP/1.1 101 Switching Protocols\r\nUpgrade: websocket\r\nConnection: Upgrade\r\nSec-WebSocket-Accept: %s\r\n\r\n"
                   accept))
             wbuf (String.to-bytes &resp-str)
             ws (WebSocket.init fd @proto [])]
      (~(WSRoute.handler (Array.unsafe-nth ws-routes route-idx)) &(WSEvent.Connect)
                                                                 params
                                                                 &ws)
      (ws-flatten-outbox &ws &wbuf)
      (Map.put! (ConnState.write-bufs cs) &fd &wbuf)
      (Map.put! (ConnState.write-positions cs) &fd &0)
      (Map.put! (ConnState.keep-alives cs) &fd &true)
      (Map.put! (ConnState.ws-route-idx cs) &fd &route-idx)
      (Map.put! (ConnState.ws-params cs) &fd params)
      (Map.put! (ConnState.ws-protocol cs) &fd proto)
      (Map.update-value! (ConnState.read-bufs cs)
                         &fd
                         &(fn [b] (TcpStream.clear-buf b)))
      (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                               &fd
                               &(fn [b]
                                 (match (TcpStream.send-nb &stream b 0)
                                   (Result.Success k) k
                                   (Result.Error _) -1))
                               -1)
            buf-len (Array.length &wbuf)]
        (cond
          (< n0 0) (queue-close cs fd)
          (< n0 buf-len)
            (do
              (Map.put! (ConnState.write-positions cs) &fd &n0)
              (ignore (Poll.modify poll fd poll-write)))
          (conn-done-writing cs poll fd)))))

  (hidden handle-ws-readable)
  (defn handle-ws-readable [cs ws-routes poll fd]
    (match (Map.get-maybe (ConnState.streams cs) &fd)
      (Maybe.Nothing) ()
      (Maybe.Just stream)
        (let [stream2 @&stream
              n (Map.value-ref! (ConnState.read-bufs cs)
                                &fd
                                &(fn [buf]
                                  (match (TcpStream.read-append-nb &stream buf)
                                    (Result.Success k) k
                                    (Result.Error _) -1))
                                -1)]
          (cond
            (= n TcpStream.read-blocked) ()
            (<= n 0) (queue-close cs fd)
            (do
              (Map.put! (ConnState.last-active cs) &fd &(System.time))
              (let-do [buf (Map.value-ref! (ConnState.read-bufs cs)
                                           &fd
                                           &(fn [b] @b)
                                           (the (Array Byte) []))
                       route-idx (Map.get (ConnState.ws-route-idx cs) &fd)
                       params (Map.value-ref! (ConnState.ws-params cs)
                                              &fd
                                              &(fn [p] @p)
                                              (the (Map String String) {}))
                       proto (Map.value-ref! (ConnState.ws-protocol cs)
                                             &fd
                                             &(fn [p] @p)
                                             (the (Maybe String) (Maybe.Nothing)))
                       ws (WebSocket.init fd proto [])
                       offset 0
                       should-close false]
                (while-do (< offset (Array.length &buf))
                  ; reject a frame whose declared length exceeds the cap before
                  ; buffering or decoding it — a 64-bit length would otherwise
                  ; overflow Int to a negative length and crash the decoder
                  (when-do (WebSocket.frame-len-exceeds? &buf
                                                         offset
                                                         App.max-request-size)
                    (Array.push-back! (WebSocket.outbox &ws)
                                      (WebSocket.encode-close-with-code 1009))
                    (set! should-close true)
                    (break))
                  (match (WebSocket.decode-frame &buf offset)
                    (Maybe.Nothing) (break)
                    (Maybe.Just frame)
                      (let [fin @(WSFrame.fin &frame)
                            op @(WSFrame.opcode &frame)
                            consumed @(WSFrame.consumed &frame)
                            plen (Array.length (WSFrame.payload &frame))
                            is-control (>= op 8)]
                        (cond
                          ; RFC 6455 §5.2: RSV bits MUST be 0 (no extensions negotiated)
                          (> @(WSFrame.rsv &frame) 0)
                          (do
                            (Array.push-back! (WebSocket.outbox &ws)
                                              (WebSocket.encode-close-with-code 1002))
                            (set! should-close true)
                            (break))
                          ; RFC 6455 §5.1: client frames MUST be masked
                          (not @(WSFrame.masked &frame))
                          (do
                            (Array.push-back! (WebSocket.outbox &ws)
                                              (WebSocket.encode-close-with-code 1002))
                            (set! should-close true)
                            (break))
                          ; Control frames: always process immediately (RFC 6455 §5.4)
                          is-control
                          ; but first reject the ones that violate §5.2/§5.5
                          ; (fragmented, oversized, or a reserved opcode)
                          (if (WebSocket.control-frame-protocol-error? op
                                                                       fin
                                                                       plen)
                            (do
                              (Array.push-back! (WebSocket.outbox &ws)
                                                (WebSocket.encode-close-with-code 1002))
                              (set! should-close true)
                              (break))
                            (do
                              (cond
                                (= op 9)
                                ; ping -> pong
                                (Array.push-back! (WebSocket.outbox &ws)
                                                  (WebSocket.encode-pong (WSFrame.payload &frame)))
                                (= op 10)
                                ; pong — reset server-initiated ping counter
                                (Map.put! (ConnState.ws-ping-count cs) &fd &0)
                                (= op 8)
                                ; close
                                (do
                                  (~(WSRoute.handler (Array.unsafe-nth ws-routes
                                                                       route-idx)) &(WSEvent.Close)
                                                                                   &params
                                                                                   &ws)
                                  (Array.push-back! (WebSocket.outbox &ws)
                                                    (WebSocket.close-response-frame (WSFrame.payload &frame)))
                                  (set! should-close true)
                                  (break))
                                ())
                              (set! offset (+ offset consumed))))
                          ; Single data frame too large
                          (> plen App.max-request-size)
                          (do
                            (Array.push-back! (WebSocket.outbox &ws)
                                              (WebSocket.encode-close-with-code 1009))
                            (set! should-close true)
                            (break))
                          ; First fragment (FIN=0, opcode 1 or 2)
                          (and (not fin) (or (= op 1) (= op 2)))
                          (if (Map.contains? (ConnState.ws-frag-opcodes cs) &fd)
                            ; Protocol error: new message while fragments pending
                            (do
                              (Map.remove! (ConnState.ws-frag-bufs cs) &fd)
                              (Map.remove! (ConnState.ws-frag-opcodes cs) &fd)
                              (Map.remove! (ConnState.ws-frag-start cs) &fd)
                              (Array.push-back! (WebSocket.outbox &ws)
                                                (WebSocket.encode-close-with-code 1002))
                              (set! should-close true)
                              (break))
                            (if (> plen App.ws-max-frag-size)
                              ; First fragment already exceeds limit
                              (do
                                (Array.push-back! (WebSocket.outbox &ws)
                                                  (WebSocket.encode-close-with-code 1009))
                                (set! should-close true)
                                (break))
                              (let-do [payload @(WSFrame.payload &frame)]
                                (Map.put! (ConnState.ws-frag-opcodes cs) &fd &op)
                                (Map.put! (ConnState.ws-frag-bufs cs)
                                          &fd
                                          &payload)
                                (Map.put! (ConnState.ws-frag-start cs)
                                          &fd
                                          &(System.time))
                                (set! offset (+ offset consumed)))))
                          ; Continuation frame (opcode 0)
                          (= op 0)
                          (if (not
                              (Map.contains? (ConnState.ws-frag-opcodes cs) &fd))
                            ; Protocol error: continuation without start
                            (do
                              (Array.push-back! (WebSocket.outbox &ws)
                                                (WebSocket.encode-close-with-code 1002))
                              (set! should-close true)
                              (break))
                            (let [frag-size (Map.value-ref! (ConnState.ws-frag-bufs cs)
                                                            &fd
                                                            &(fn [b]
                                                              (Array.length b))
                                                            0)]
                              (if (> (+ frag-size plen) App.ws-max-frag-size)
                                ; Accumulated message too large
                                (do
                                  (Map.remove! (ConnState.ws-frag-bufs cs) &fd)
                                  (Map.remove! (ConnState.ws-frag-opcodes cs)
                                               &fd)
                                  (Map.remove! (ConnState.ws-frag-start cs) &fd)
                                  (Array.push-back! (WebSocket.outbox &ws)
                                                    (WebSocket.encode-close-with-code 1009))
                                  (set! should-close true)
                                  (break))
                                (let-do [frag-buf (Map.value-ref! (ConnState.ws-frag-bufs cs)
                                                                  &fd
                                                                  &(fn [b] @b)
                                                                  (the (Array Byte)
                                                                       []))]
                                  (for [k 0 plen]
                                    (Array.push-back! &frag-buf
                                                      @(Array.unsafe-nth (WSFrame.payload &frame)
                                                                         k)))
                                  (if fin
                                    ; Message complete — dispatch
                                    (let-do [orig-op (Map.get (ConnState.ws-frag-opcodes cs)
                                                              &fd)]
                                      (Map.remove! (ConnState.ws-frag-bufs cs)
                                                   &fd)
                                      (Map.remove! (ConnState.ws-frag-opcodes cs)
                                                   &fd)
                                      (Map.remove! (ConnState.ws-frag-start cs)
                                                   &fd)
                                      ; fragments are reassembled before dispatch, so this
                                      ; UTF-8 check is message-level (RFC 6455 §8.1 Non-Strict)
                                      (if (= orig-op 1)
                                        (if (UTF8.valid? &frag-buf)
                                          (~(WSRoute.handler (Array.unsafe-nth ws-routes
                                                                               route-idx))
                                            &(WSEvent.Message (String.from-bytes &frag-buf))
                                            &params
                                            &ws)
                                          (do
                                            (Array.push-back! (WebSocket.outbox &ws)
                                                              (WebSocket.encode-close-with-code 1007))
                                            (set! should-close true)
                                            (break)))
                                        (~(WSRoute.handler (Array.unsafe-nth ws-routes
                                                                             route-idx)) &(WSEvent.Binary @&frag-buf)
                                                                                         &params
                                                                                         &ws))
                                      (set! offset (+ offset consumed)))
                                    ; More fragments expected
                                    (do
                                      (Map.put! (ConnState.ws-frag-bufs cs)
                                                &fd
                                                &frag-buf)
                                      (set! offset (+ offset consumed))))))))
                          ; Unfragmented message (FIN=1, opcode 1 or 2)
                          (and fin (or (= op 1) (= op 2)))
                          (if (Map.contains? (ConnState.ws-frag-opcodes cs) &fd)
                            ; Protocol error: non-continuation during fragmentation
                            (do
                              (Map.remove! (ConnState.ws-frag-bufs cs) &fd)
                              (Map.remove! (ConnState.ws-frag-opcodes cs) &fd)
                              (Map.remove! (ConnState.ws-frag-start cs) &fd)
                              (Array.push-back! (WebSocket.outbox &ws)
                                                (WebSocket.encode-close-with-code 1002))
                              (set! should-close true)
                              (break))
                            (do
                              (if (= op 1)
                                (if (UTF8.valid? (WSFrame.payload &frame))
                                  (~(WSRoute.handler (Array.unsafe-nth ws-routes
                                                                       route-idx))
                                    &(WSEvent.Message
                                      (String.from-bytes (WSFrame.payload &frame)))
                                    &params
                                    &ws)
                                  (do
                                    (Array.push-back! (WebSocket.outbox &ws)
                                                      (WebSocket.encode-close-with-code 1007))
                                    (set! should-close true)
                                    (break)))
                                (~(WSRoute.handler (Array.unsafe-nth ws-routes
                                                                     route-idx))
                                  &(WSEvent.Binary @(WSFrame.payload &frame))
                                  &params
                                  &ws))
                              (set! offset (+ offset consumed))))
                          ; Unknown opcode — protocol error (RFC 6455 §5.2)
                          (do
                            (Array.push-back! (WebSocket.outbox &ws)
                                              (WebSocket.encode-close-with-code 1002))
                            (set! should-close true)
                            (break))))))
                ; Update read-buf with remaining bytes
                (if (>= offset (Array.length &buf))
                  (Map.update-value! (ConnState.read-bufs cs)
                                     &fd
                                     &(fn [b] (TcpStream.clear-buf b)))
                  (let-do [remaining (the (Array Byte) [])]
                    (for [i offset (Array.length &buf)]
                      (Array.push-back! &remaining @(Array.unsafe-nth &buf i)))
                    (Map.put! (ConnState.read-bufs cs) &fd &remaining)))
                ; Drain outbox
                (let [outbox-len (Array.length (WebSocket.outbox &ws))]
                  (if (> outbox-len 0)
                    (let-do [wbuf (the (Array Byte) [])]
                      (ws-flatten-outbox &ws &wbuf)
                      (Map.put! (ConnState.write-bufs cs) &fd &wbuf)
                      (Map.put! (ConnState.write-positions cs) &fd &0)
                      (Map.put! (ConnState.keep-alives cs)
                                &fd
                                &(not should-close))
                      (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                                               &fd
                                               &(fn [b]
                                                 (match (TcpStream.send-nb &stream2
                                                                           b
                                                                           0)
                                                   (Result.Success k) k
                                                   (Result.Error _) -1))
                                               -1)
                            buf-len (Array.length &wbuf)]
                        (cond
                          (< n0 0) (queue-close cs fd)
                          (< n0 buf-len)
                            (do
                              (Map.put! (ConnState.write-positions cs) &fd &n0)
                              (ignore (Poll.modify poll fd poll-write)))
                          (when should-close (queue-close cs fd)))))
                    (when should-close (queue-close cs fd))))))))))

  (hidden handle-readable)
  (defn handle-readable [cs app before-hooks after-hooks poll fd]
    ; Active WebSocket and Server-Sent Events connections bypass HTTP parsing
    (cond
      (Map.contains? (ConnState.ws-route-idx cs) &fd)
        (handle-ws-readable cs (App.ws-routes app) poll fd)
      (Map.contains? (ConnState.sse-route-idx cs) &fd)
        (handle-sse-readable cs poll fd)
      (match (Map.get-maybe (ConnState.streams cs) &fd)
        (Maybe.Nothing) ()
        (Maybe.Just stream)
          (let [stream2 @&stream
                n (Map.value-ref! (ConnState.read-bufs cs)
                                  &fd
                                  &(fn [buf]
                                    (match (TcpStream.read-append-nb &stream buf)
                                      (Result.Success k) k
                                      (Result.Error _) -1))
                                  -1)]
            (cond
              (= n TcpStream.read-blocked) ()
              (<= n 0) (queue-close cs fd)
              (do
                (Map.put! (ConnState.last-active cs) &fd &(System.time))
                (when (= (Map.get (ConnState.read-start cs) &fd) 0)
                  (Map.put! (ConnState.read-start cs) &fd &(System.time)))
                (let [too-big (Map.value-ref! (ConnState.read-bufs cs)
                                              &fd
                                              &(fn [buf]
                                                (> (Array.length buf)
                                                   App.max-request-size))
                                              false)]
                  (if too-big
                    (queue-close cs fd)
                    (let-do [cursor (Map.get (ConnState.chunk-cursor cs) &fd)
                             st (Map.value-ref! (ConnState.read-bufs cs)
                                                &fd
                                                &(fn [buf]
                                                  (web-request-status buf cursor))
                                                (Pair.init 0 0))
                             status @(Pair.a &st)]
                      (Map.put! (ConnState.chunk-cursor cs) &fd (Pair.b &st))
                      ; headers complete: negate read-start (see http-timeout-close?)
                      (let [rs (Map.get (ConnState.read-start cs) &fd)]
                        (when-do (and (> rs 0)
                                      (Map.value-ref! (ConnState.read-bufs cs)
                                                      &fd
                                                      &(fn [buf]
                                                        (web-has-header-end buf))
                                                      false))
                          (Map.put! (ConnState.read-start cs) &fd &(- 0 rs))
                          ; 100 Continue goes out directly — the write path
                          ; would clear the partly read request
                          (when (and (= status 0)
                                     (Map.value-ref! (ConnState.read-bufs cs)
                                                     &fd
                                                     &(fn [buf]
                                                       (web-wants-continue? buf))
                                                     false))
                            (let [cbuf (String.to-bytes "HTTP/1.1 100 Continue\r\n\r\n")
                                  n (match (TcpStream.send-nb &stream2 &cbuf 0)
                                    (Result.Success k) k
                                    (Result.Error _) -1)]
                              (cond
                                (< n 0) (queue-close cs fd)
                                (and (> n 0) (< n (Array.length &cbuf)))
                                  (queue-close cs fd)
                                ())))))
                      (when-do (/= status 0)
                        (Map.put! (ConnState.read-start cs) &fd &0)
                        ; Validate request line before parsing
                        (let [bad-req (if (< status 0)
                                (Maybe.Just (Response.bad-request))
                                (Map.value-ref! (ConnState.read-bufs cs)
                                                &fd
                                                &(fn [buf]
                                                  (web-validate-request-line buf))
                                                (the (Maybe Response)
                                                     (Maybe.Nothing))))]
                          (match bad-req
                            ; Malformed request — send 400 and close
                            (Maybe.Just bad-resp)
                            (let-do [wbuf (web-serialize-response bad-resp
                                                                  false
                                                                  -1l)]
                              (Map.put! (ConnState.write-bufs cs) &fd &wbuf)
                              (Map.put! (ConnState.write-positions cs) &fd &0)
                              (Map.put! (ConnState.keep-alives cs) &fd &false)
                              (Map.update-value! (ConnState.read-bufs cs)
                                                 &fd
                                                 &(fn [b]
                                                   (TcpStream.clear-buf b)))
                              (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                                                       &fd
                                                       &(fn [b]
                                                         (match (TcpStream.send-nb &stream2
                                                                                   b
                                                                                   0)
                                                           (Result.Success k) k
                                                           (Result.Error _) -1))
                                                       -1)
                                    buf-len (Array.length &wbuf)]
                                (cond
                                  (< n0 0) (queue-close cs fd)
                                  (< n0 buf-len)
                                    (do
                                      (Map.put! (ConnState.write-positions cs)
                                                &fd
                                                &n0)
                                      (ignore (Poll.modify poll fd poll-write)))
                                  (queue-close cs fd))))
                            (Maybe.Nothing)
                            ; Check for WebSocket upgrade before normal HTTP response
                            (let [ws-info (Map.value-ref! (ConnState.read-bufs cs)
                                                          &fd
                                                          &(fn [buf]
                                                            (web-try-ws-upgrade buf
                                                                                (App.ws-routes app)))
                                                          (the
                                                            (Maybe
                                                              (Pair String
                                                                    (Pair Int
                                                                          (Pair (Maybe String)
                                                                                (Map String
                                                                                     String)))))
                                                            (Maybe.Nothing)))]
                              (match ws-info
                                (Maybe.Just info)
                                  (let [accept @(Pair.a &info)
                                        ri @(Pair.a (Pair.b &info))
                                        proto @(Pair.a (Pair.b (Pair.b &info)))
                                        ps @(Pair.b (Pair.b (Pair.b &info)))]
                                    (if (< ri 0)
                                      ; RFC 6455 §4.2.1: bad Sec-WebSocket-Version → 426
                                      (let-do [resp-str @"HTTP/1.1 426 Upgrade Required\r\nSec-WebSocket-Version: 13\r\nContent-Length: 0\r\nConnection: close\r\n\r\n"
                                               wbuf (String.to-bytes &resp-str)]
                                        (Map.put! (ConnState.write-bufs cs)
                                                  &fd
                                                  &wbuf)
                                        (Map.put! (ConnState.write-positions cs)
                                                  &fd
                                                  &0)
                                        (Map.put! (ConnState.keep-alives cs)
                                                  &fd
                                                  &false)
                                        (Map.update-value! (ConnState.read-bufs cs)
                                                           &fd
                                                           &(fn [b]
                                                             (TcpStream.clear-buf b)))
                                        (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                                                                 &fd
                                                                 &(fn [b]
                                                                   (match (TcpStream.send-nb &stream2
                                                                                             b
                                                                                             0)
                                                                     (Result.Success k)
                                                                       k
                                                                     (Result.Error _)
                                                                       -1))
                                                                 -1)
                                              buf-len (Array.length &wbuf)]
                                          (cond
                                            (< n0 0) (queue-close cs fd)
                                            (< n0 buf-len)
                                              (do
                                                (Map.put! (ConnState.write-positions cs)
                                                          &fd
                                                          &n0)
                                                (ignore (Poll.modify poll
                                                                     fd
                                                                     poll-write)))
                                            (queue-close cs fd))))
                                      (handle-ws-upgrade cs
                                                         (App.ws-routes app)
                                                         poll
                                                         fd
                                                         stream2
                                                         &accept
                                                         ri
                                                         &proto
                                                         &ps)))
                                (Maybe.Nothing)
                                  (match (Map.value-ref! (ConnState.read-bufs cs)
                                                         &fd
                                                         &(fn [buf]
                                                           (web-try-sse buf
                                                                        (App.sse-routes app)))
                                                         (the
                                                           (Maybe
                                                             (Pair Int
                                                                   (Pair (Maybe String)
                                                                         (Map String
                                                                              String))))
                                                           (Maybe.Nothing)))
                                    (Maybe.Just si)
                                      (handle-sse-open cs
                                                       (App.sse-routes app)
                                                       poll
                                                       fd
                                                       stream2
                                                       @(Pair.a &si)
                                                       (Pair.a (Pair.b &si))
                                                       (Pair.b (Pair.b &si)))
                                    (Maybe.Nothing)
                                  (let-do [pair (Map.value-ref! (ConnState.read-bufs cs)
                                                                &fd
                                                                &(fn [buf]
                                                                  (web-build-response app
                                                                                      before-hooks
                                                                                      after-hooks
                                                                                      buf))
                                                                (Pair.init (Response.bad-request)
                                                                           false))
                                           resp @(Pair.a &pair)
                                           ka @(Pair.b &pair)
                                           wbuf (setup-sendfile cs fd resp ka)]
                                    (Map.put! (ConnState.write-bufs cs)
                                              &fd
                                              &wbuf)
                                    (Map.put! (ConnState.write-positions cs)
                                              &fd
                                              &0)
                                    (Map.put! (ConnState.keep-alives cs) &fd &ka)
                                    (let [n0 (Map.value-ref! (ConnState.write-bufs cs)
                                                             &fd
                                                             &(fn [b]
                                                               (match (TcpStream.send-nb &stream2
                                                                                         b
                                                                                         0)
                                                                 (Result.Success k)
                                                                   k
                                                                 (Result.Error _)
                                                                   -1))
                                                             -1)
                                          buf-len (Array.length &wbuf)]
                                      (cond
                                        (< n0 0) (queue-close cs fd)
                                        (or (< n0 buf-len)
                                            (Map.contains? (ConnState.sf-fds cs)
                                                           &fd))
                                          (do
                                            (Map.put! (ConnState.write-positions cs)
                                                      &fd
                                                      &n0)
                                            (ignore (Poll.modify poll
                                                                 fd
                                                                 poll-write)))
                                        (conn-done-writing cs poll fd)))))))))))))))))))

  (doc ws-ping-action "Decides what to do for a WebSocket connection's ping
    state. Returns 0 (nothing), 1 (send ping), or 2 (close as dead).
    Setting ping-interval to 0 or negative disables pinging.")
  (defn ws-ping-action [ping-interval
                        max-missed
                        idle
                        pcount
                        since-ping
                        write-pending]
    (cond
      (<= ping-interval 0) 0
      (< idle ping-interval) 0
      (>= pcount max-missed) 2
      (and (or (= pcount 0) (>= since-ping ping-interval)) (not write-pending))
        1
      0))

  (doc http-timeout-close? "Decides whether an HTTP connection timed out.
    `rs` is positive while headers arrive (header-timeout), negated once they
    are complete (request-timeout), and 0 between requests (idle-timeout).")
  (defn http-timeout-close? [rs now header-to request-to idle idle-to]
    (cond
      (and (> rs 0) (> (- now rs) header-to)) true
      (and (< rs 0) (> (+ now rs) request-to)) true
      (> idle idle-to)))

  (hidden sweep-idle)
  (defn sweep-idle [cs sse-routes poll]
    (let [now (System.time)
          keys (Map.keys (ConnState.last-active cs))]
      (for [j 0 (Array.length &keys)]
        (let [rfd @(Array.unsafe-nth &keys j)
              ts (Map.get (ConnState.last-active cs) &rfd)
              idle (- now ts)
              is-ws (Map.contains? (ConnState.ws-route-idx cs) &rfd)]
          (cond
            is-ws
            ; WebSocket: ping/pong dead client detection
            (let-do [pcount (if (Map.contains? (ConnState.ws-ping-count cs) &rfd)
                       (Map.get (ConnState.ws-ping-count cs) &rfd)
                       0)
                     last-ping (if (Map.contains? (ConnState.ws-last-ping cs)
                                                  &rfd)
                       (Map.get (ConnState.ws-last-ping cs) &rfd)
                       0)
                     since-ping (- now last-ping)
                     write-pending (Map.contains? (ConnState.write-bufs cs) &rfd)
                     action (ws-ping-action App.ws-ping-interval
                                            App.ws-max-missed-pongs
                                            idle
                                            pcount
                                            since-ping
                                            write-pending)]
              (cond
                (= action 2) (queue-close cs rfd)
                (= action 1)
                  (let-do [ping-frame (WebSocket.encode-ping &(the (Array Byte)
                                                                   []))]
                    (Map.put! (ConnState.write-bufs cs) &rfd &ping-frame)
                    (Map.put! (ConnState.write-positions cs) &rfd &0)
                    (Map.put! (ConnState.keep-alives cs) &rfd &true)
                    (Map.put! (ConnState.ws-ping-count cs) &rfd &(+ pcount 1))
                    (Map.put! (ConnState.ws-last-ping cs) &rfd &now)
                    (ignore (Poll.modify poll rfd poll-write)))
                ())
              ; Fragment TTL: close connections with stale partial messages
              (when (and (> App.ws-frag-ttl 0)
                         (Map.contains? (ConnState.ws-frag-start cs) &rfd))
                (let [frag-ts (Map.get (ConnState.ws-frag-start cs) &rfd)]
                  (when-do (> (- now frag-ts) App.ws-frag-ttl)
                    (Map.remove! (ConnState.ws-frag-start cs) &rfd)
                    (Map.remove! (ConnState.ws-frag-bufs cs) &rfd)
                    (Map.remove! (ConnState.ws-frag-opcodes cs) &rfd)
                    (queue-close cs rfd)))))
            (Map.contains? (ConnState.sse-route-idx cs) &rfd)
            ; Server-Sent Events: timed push, and exempt from the HTTP timeouts
            (when (and (> App.sse-tick-interval 0)
                       (and (not (Map.contains? (ConnState.write-bufs cs) &rfd))
                            (not (Array.contains? (ConnState.to-close cs)
                                                  &rfd))))
              (let [last-tick (Map.get (ConnState.sse-last-tick cs) &rfd)]
                (when-do (>= (- now last-tick) App.sse-tick-interval)
                  (let-do [params (Map.value-ref! (ConnState.sse-params cs)
                                                  &rfd
                                                  &(fn [p] @p)
                                                  (the (Map String String) {}))
                           last-id (Map.value-ref! (ConnState.sse-last-id cs)
                                                   &rfd
                                                   &(fn [i] @i)
                                                   (the (Maybe String)
                                                        (Maybe.Nothing)))
                           s (SSEStream.init rfd last-id [])
                           wbuf (the (Array Byte) [])]
                    (~(SSERoute.handler (Array.unsafe-nth sse-routes
                                                          (Map.get (ConnState.sse-route-idx cs)
                                                                   &rfd))) &(SSEEvent.Tick)
                                                                           &params
                                                                           &s)
                    (sse-flatten-outbox &s &wbuf)
                    (when (Array.empty? &wbuf)
                      (set! wbuf (String.to-bytes &sse-keep-alive-chunk)))
                    (Map.put! (ConnState.sse-last-tick cs) &rfd &now)
                    (Map.put! (ConnState.write-bufs cs) &rfd &wbuf)
                    (Map.put! (ConnState.write-positions cs) &rfd &0)
                    (Map.put! (ConnState.keep-alives cs) &rfd &true)
                    (ignore (Poll.modify poll rfd poll-write))))))
            ; HTTP: slow-loris headers, slow-drip bodies, and idle connections
            (let [rs (Map.get (ConnState.read-start cs) &rfd)]
              (when (http-timeout-close? rs
                                         now
                                         App.header-timeout
                                         App.request-timeout
                                         idle
                                         App.idle-timeout)
                (queue-close cs rfd))))))))

  (hidden flush-closed)
  (defn flush-closed [cs sse-routes poll]
    (for [j 0 (Array.length (ConnState.to-close cs))]
      (conn-cleanup cs
                    sse-routes
                    poll
                    @(Array.unsafe-nth (ConnState.to-close cs) j))))

  (private poll-timeout-ms)
  (hidden poll-timeout-ms)
  (doc poll-timeout-ms "milliseconds `Poll.wait` may block: the sweep interval,
or the time until the earliest SSE tick comes due, whichever is sooner.

Streams with a pending write are ignored, since their fd already wakes the
loop on writability and [`sweep-idle`](#sweep-idle) skips their tick anyway.")
  (defn poll-timeout-ms [cs sse-routes]
    (if (or (Array.empty? sse-routes) (< App.sse-tick-interval 1))
      (* 1000 sweep-interval)
      (let-do [now (System.time)
               keys (Map.keys (ConnState.sse-last-tick cs))
               soonest sweep-interval]
        (for [j 0 (Array.length &keys)]
          (let [rfd @(Array.unsafe-nth &keys j)]
            (unless (Map.contains? (ConnState.write-bufs cs) &rfd)
              (let [due (- (+ (Map.get (ConnState.sse-last-tick cs) &rfd)
                              App.sse-tick-interval)
                           now)]
                (when (< due soonest) (set! soonest due))))))
        (* 1000 (max 1 soonest)))))

  (hidden static-form?)
  (defndynamic static-form? [f] (and (list? f) (= 'static (car f))))

  (hidden before-form?)
  (defndynamic before-form? [f] (and (list? f) (= 'before (car f))))

  (hidden after-form?)
  (defndynamic after-form? [f] (and (list? f) (= 'after (car f))))

  (hidden errors-form?)
  (defndynamic errors-form? [f] (and (list? f) (= 'errors (car f))))

  (hidden wsp-form?)
  (defndynamic wsp-form? [f] (and (list? f) (= 'WSP (car f))))

  (hidden workers-form?)
  (defndynamic workers-form? [f] (and (list? f) (= 'workers (car f))))

  (hidden cors-form?)
  (defndynamic cors-form? [f] (and (list? f) (= 'cors (car f))))

  (hidden route-form?)
  (defndynamic route-form? [f]
    (and (list? f)
         (or (= 'GET (car f))
             (= 'POST (car f))
             (= 'PUT (car f))
             (= 'DELETE (car f))
             (= 'PATCH (car f))
             (= 'WS (car f))
             (= 'WSP (car f))
             (= 'SSE (car f))
             (= 'static (car f))
             (= 'before (car f))
             (= 'after (car f))
             (= 'errors (car f))
             (= 'cors (car f)))))

  (hidden route-call)
  (defndynamic route-call [r]
    (cond
      (App.static-form? r) (list 'App.static-dir (list 'copy (cadr r)))
      (App.before-form? r) (list 'App.use-before (cadr r))
      (App.after-form? r) (list 'App.use-after (cadr r))
      (App.errors-form? r) (list 'App.set-error (cadr r))
      (App.wsp-form? r)
        (list 'App.WSP (list 'copy (cadr r)) (caddr r) (car (cdr (cdr (cdr r)))))
      (list (Symbol.prefix 'App (car r)) (list 'copy (cadr r)) (caddr r))))

  (doc serve "starts the web server on `host`:`port`.

Uses kqueue/epoll for concurrent connection handling with HTTP keep-alive.
Sockets are non-blocking, reads accumulate into a per-connection buffer,
and writes drain across writable events.

The loop is single-threaded, so peak throughput is bounded by one core.
For multi-core scaling, see [`serve-with-workers`](#serve-with-workers).")
  (defn serve [app before-hooks after-hooks host port]
    (match (TcpListener.bind host port)
      (Result.Error e) (IO.errorln &(fmt "Failed to bind: %s" &e))
      (Result.Success listener)
        (match (Poll.create)
          (Result.Error e) (do (IO.errorln &e) (TcpListener.close listener))
          (Result.Success poll)
            (let-do [lfd (TcpListener.poll-fd &listener)
                     cs (ConnState.init {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        []
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {}
                                        {})
                     poll-timeout (* 1000 sweep-interval)]
              (IO.println &(fmt "Listening on %s:%d" host port))
              (set! App.running true)
              (System.signal System.signal-int (fn [_] (set! App.running false)))
              (System.signal System.signal-term
                             (fn [_] (set! App.running false)))
              (ignore (Poll.add-read &poll &listener))
              (while App.running
                (match (the (Result (Array PollEvent) String)
                            (Poll.wait &poll poll-timeout))
                  (Result.Error _) (break)
                  (Result.Success events)
                    (do
                      (ConnState.set-to-close! &cs [])
                      (for [i 0 (Array.length &events)]
                        (let [e (Array.unsafe-nth &events i)
                              fd (PollEvent.fd e)]
                          (cond
                            (= fd lfd) (handle-accept &cs &poll &listener)
                            (PollEvent.writable e)
                              (handle-writable &cs &poll fd)
                            (PollEvent.readable e)
                              (handle-readable &cs
                                               app
                                               before-hooks
                                               after-hooks
                                               &poll
                                               fd)
                            ())))
                      (sweep-idle &cs (App.sse-routes app) &poll)
                      (flush-closed &cs (App.sse-routes app) &poll)
                      (set! poll-timeout
                            (poll-timeout-ms &cs (App.sse-routes app))))))
              (Poll.close poll)
              (TcpListener.close listener)))))

  (doc serve-with-workers "starts `n` worker processes, each running its own
event loop bound to `host`:`port`. The kernel distributes incoming
connections across workers via SO_REUSEPORT (Linux 3.9+, most BSDs).

Falls back to single-process [`serve`](#serve) when `n` is 1 or less.

```
(App.serve-with-workers &app &bh &ah \"0.0.0.0\" 3000 4)
```

Or via [`defserver`](#defserver):

```
(defserver \"0.0.0.0\" 3000
  (workers 4)
  (GET \"/\" handler))
```")
  (defn serve-with-workers [app before-hooks after-hooks host port n]
    (if (<= n 1)
      (serve app before-hooks after-hooks host port)
      (let-do [spawned 0]
        (for [i 0 n]
          (let [pid (System.fork)]
            (cond
              (< pid 0) (IO.errorln "fork() failed")
              (= pid 0)
                (do
                  (serve app before-hooks after-hooks host port)
                  (System.exit 0))
              (do
                (IO.println &(fmt "Spawned worker %d (pid %d)" (+ i 1) pid))
                (set! spawned (+ spawned 1))))))
        (if (= spawned 0)
          (IO.errorln "No workers spawned; exiting")
          (do
            (System.signal System.signal-int (fn [_] ()))
            (System.signal System.signal-term (fn [_] ()))
            (let [status 0]
              (for [_ 0 spawned]
                (ignore (System.wait (Pointer.address &status)))))
            (IO.println &(fmt "All %d workers exited" spawned))))))))

(doc StaticFile "provides static file serving with directory index support,
path traversal prevention, and efficient transfer via sendfile(2).")
(defmodule StaticFile
  (doc exists? "checks whether path exists and is a readable regular file.")
  (defn exists? [path]
    (if (web-is-directory? path)
      false
      (match (File.open-with path "r")
        (Result.Error _) false
        (Result.Success f) (do (File.close f) true))))

  (doc find-index "returns the full path of the first existing index file in
dir, or Nothing if none match.")
  (defn find-index [dir index-files]
    (let-do [result (the (Maybe String) (Maybe.Nothing))]
      (for [i 0 (Array.length index-files)]
        (let [candidate (fmt "%s/%s" dir (Array.unsafe-nth index-files i))]
          (when-do (exists? &candidate)
            (set! result (Maybe.Just candidate))
            (break))))
      result))

  (doc serve "serves a static file from root for the relative path rel.
rejects .. segments and tries index-files for directory paths.
returns a 404 if the path is unsafe or no file matches.")
  (defn serve [root rel index-files]
    (if (not (web-safe-path? rel))
      (Response.not-found)
      (let [path (if (String.empty? rel) @root (fmt "%s/%s" root rel))]
        (if (or (String.empty? rel) (web-ends-with? rel "/"))
          (let [dir (if (web-ends-with? &path "/")
                  (String.byte-slice &path 0 (- (String.length &path) 1))
                  @&path)]
            (match (find-index &dir index-files)
              (Maybe.Just idx-path) (Response.sendfile &idx-path)
              (Maybe.Nothing) (Response.not-found)))
          (if (exists? &path)
            (Response.sendfile &path)
            (match (find-index &path index-files)
              (Maybe.Just idx-path) (Response.sendfile &idx-path)
              (Maybe.Nothing) (Response.not-found)))))))

  (doc handler "creates a request handler that serves static files from root,
using index.html for directory paths. register with a * glob route.")
  (defn handler [root]
    (let [idx [@"index.html"]]
      (fn [req params]
        (let [rel (Map.get-with-default params "*" &@"")]
          (StaticFile.serve &root &rel &idx)))))

  (doc handler-with "like handler but with custom index file names.")
  (defn handler-with [root index-files]
    (fn [req params]
      (let [rel (Map.get-with-default params "*" &@"")]
        (StaticFile.serve &root &rel &index-files))))

  (doc mount "registers a GET route at prefix/* that serves static files
from root.")
  (defn mount [app prefix root]
    (App.GET app (String.append &prefix "/*") (handler root))))

(defmodule CORS
  (def origin @"*")
  (def methods @"GET, POST, PUT, DELETE, PATCH, OPTIONS")
  (def headers @"Content-Type, Authorization")
  (def max-age @"86400")
  (def credentials false)
  (def expose-headers @"")

  (doc setup "configures CORS origin, methods, headers, and max-age.")
  (defn setup [o m h ma]
    (do (set! origin o) (set! methods m) (set! headers h) (set! max-age ma)))

  (doc configure "sets the allowed origin for CORS. Use `setup` for full
configuration.")
  (defn configure [allowed-origin] (set! origin allowed-origin))

  (doc set-credentials! "enables or disables `Access-Control-Allow-Credentials`.
Origin must not be `*` when enabled.")
  (defn set-credentials! [c] (set! credentials c))

  (doc set-expose-headers! "sets the `Access-Control-Expose-Headers` value.
Pass an empty string to omit (the default).")
  (defn set-expose-headers! [h] (set! expose-headers h))

  (doc before-hook "handles CORS preflight `OPTIONS` requests. Returns a
204 with CORS headers, or `Nothing` for non-OPTIONS requests.")
  (defn before-hook [req -params]
    (if (= (Request.verb req) "OPTIONS")
      (let [r (-> (Response.text @"")
                  (Response.with-status 204 @"No Content")
                  (Response.with-header @"Access-Control-Allow-Methods"
                                        @&methods)
                  (Response.with-header @"Access-Control-Allow-Headers"
                                        @&headers)
                  (Response.with-header @"Access-Control-Max-Age" @&max-age))]
        (Maybe.Just
          (if credentials
            (Response.with-header r @"Access-Control-Allow-Credentials" @"true")
            r)))
      (Maybe.Nothing)))

  (doc after-hook "adds CORS headers to every response.")
  (defn after-hook [-req -params resp]
    (let [r1 (Response.with-header resp @"Access-Control-Allow-Origin" @&origin)
          r2 (if (= &origin "*") r1 (Response.with-header r1 @"Vary" @"Origin"))
          r3 (if credentials
            (Response.with-header r2 @"Access-Control-Allow-Credentials" @"true")
            r2)]
      (if (> (String.length &expose-headers) 0)
        (Response.with-header r3
                              @"Access-Control-Expose-Headers"
                              @&expose-headers)
        r3))))

(defmodule Cookie
  (def secret @"")

  (doc set-secret "configures the secret key for cookie signing.")
  (defn set-secret [s] (set! secret s))

  (doc sign
    "signs a cookie value using HMAC-SHA1, returning `value.hex-signature`.")
  (defn sign [value]
    (let [sig (HMAC.sha1-hex &(String.to-bytes &secret) &(String.to-bytes value))]
      (fmt "%s.%s" value &sig)))

  (doc verify "verifies a signed cookie value produced by [`sign`](#sign).
Returns the original value if valid, or `Nothing` if invalid.")
  (hidden constant-time-eq)
  (private constant-time-eq)
  (defn constant-time-eq [a b]
    (let-do [la (String.length a)
             lb (String.length b)
             result (bit-xor la lb)]
      (for [i 0 (Int.min la lb)]
        (set! result
              (bit-or result
                      (bit-xor (Char.to-int (String.char-at a i))
                               (Char.to-int (String.char-at b i))))))
      (= result 0)))

  (defn verify [signed]
    (let [len (String.length signed)]
      ; 40 hex chars + 1 dot + at least 1 char value = 42
      (if (< len 42)
        (the (Maybe String) (Maybe.Nothing))
        (let [dot-pos (- len 41)]
          (if (/= (String.char-at signed dot-pos) \.)
            (Maybe.Nothing)
            (let [value &(String.byte-slice signed 0 dot-pos)
                  sig &(String.byte-slice signed (+ dot-pos 1) len)
                  expected (HMAC.sha1-hex &(String.to-bytes &secret)
                                          &(String.to-bytes value))]
              (if (constant-time-eq sig &expected)
                (Maybe.Just @value)
                (Maybe.Nothing)))))))))

(defmodule Request
  (doc cookies-map
    "returns all cookies from the request as a `(Map String String)`.")
  (defn cookies-map [req]
    (let-do [result (the (Map String String) {})]
      (for [i 0 (Array.length (cookies req))]
        (let [c (Array.unsafe-nth (cookies req) i)]
          (Map.put! &result (Cookie.name c) (Cookie.value c))))
      result))

  (doc cookie "gets a single cookie value by name.")
  (defn cookie [req name]
    (let-do [result (the (Maybe String) (Maybe.Nothing))]
      (for [i 0 (Array.length (cookies req))]
        (let [c (Array.unsafe-nth (cookies req) i)]
          (when-do (= (Cookie.name c) name)
            (set! result (Maybe.Just @(Cookie.value c)))
            (break))))
      result))

  (doc signed-cookie "gets and verifies a signed cookie by name. Returns the
original value, or `Nothing` if missing or invalid.")
  (defn signed-cookie [req name]
    (match (cookie req name)
      (Maybe.Just val) (Cookie.verify &val)
      (Maybe.Nothing) (Maybe.Nothing))))

(defmodule Response
  (doc set-cookie "adds a `Set-Cookie` header to the response.")
  (defn set-cookie [resp cookie]
    (with-header resp @"Set-Cookie" (Cookie.set &cookie)))

  (doc set-simple-cookie "adds a `Set-Cookie` header with a name and value.
Uses `Path=/`, `HttpOnly`, and `SameSite=Lax` as defaults.")
  (defn set-simple-cookie [resp name value]
    (set-cookie resp
                (Cookie.init name
                             value
                             @"/"
                             (Maybe.Nothing)
                             (Maybe.Nothing)
                             false
                             true
                             (SameSite.Lax))))

  (doc set-cookie-with-max-age "adds a `Set-Cookie` header with a `Max-Age`
attribute (in seconds).")
  (defn set-cookie-with-max-age [resp cookie max-age]
    (let [base (Cookie.set &cookie)]
      (with-header resp @"Set-Cookie" (fmt "%s; Max-Age=%d" &base max-age))))

  (doc clear-cookie "expires a cookie by name with `Max-Age=0`. The `path` must
match the path used when the cookie was set.")
  (defn clear-cookie [resp name path]
    (set-cookie-with-max-age resp
                             (Cookie.init name
                                          @""
                                          path
                                          (Maybe.Nothing)
                                          (Maybe.Nothing)
                                          false
                                          false
                                          (SameSite.Lax))
                             0)))

(doc cookie-secret "sets the signing secret for cookies, for use inside
[`defserver`](#defserver).")
(defn cookie-secret [s] (Cookie.set-secret s))

(doc log-before "before-hook that records the request start time in params
under the key `_start`. Pair with [`log-after`](#log-after).")
(defn log-before [-req params]
  (do
    (Map.put! params &@"_start" &(Long.str (Uint64.to-long (System.nanotime))))
    (Maybe.Nothing)))

(doc log-after "after-hook that prints `METHOD path STATUS TIMEms` to
stdout. Reads the start time from `_start` in params, set by
[`log-before`](#log-before).

```
(defserver \"0.0.0.0\" 3000
  (before log-before)
  (after log-after)
  (GET \"/\" hello))
```")
(defn log-after [req params resp]
  (let-do [start (match (Long.from-string &(Map.get params "_start"))
             (Maybe.Just v) v
             (Maybe.Nothing) 0l)
           now (Uint64.to-long (System.nanotime))
           elapsed (/ (- now start) 1000000l)]
    (Log.info "%s /%s %d %ldms"
              (Request.verb req)
              &(web-request-path req)
              (Response.code &resp)
              elapsed)
    resp))

(doc defserver "generates a `main` function that builds an `App`, registers
routes, and starts serving on `host`:`port`.

Each route is `(METHOD \"/path\" handler)` where METHOD is one of `GET`,
`POST`, `PUT`, `DELETE`, or `PATCH`. Any other form in the body is
evaluated as a setup expression before the server starts, in source order.

Use `(workers N)` to fork N worker processes via SO_REUSEPORT.
Use `(cors origin)` or `(cors origin methods headers max-age)` to enable
CORS with automatic preflight handling.")
(defmacro defserver [host port :rest body]
  (let [; extract worker count and cors, then filter both out
        worker-forms (filter App.workers-form? body)
        worker-count (if (= 0 (length worker-forms)) 0 (cadr (car worker-forms)))
        cors-forms (filter App.cors-form? body)
        forms (filter
          (fn [f] (and (not (App.workers-form? f)) (not (App.cors-form? f))))
          body)
        routes (filter
          (fn [f]
            (and (App.route-form? f)
                 (not (App.before-form? f))
                 (not (App.after-form? f))))
          forms)
        befores (filter App.before-form? forms)
        afters (filter App.after-form? forms)
        setup (filter (fn [f] (not (App.route-form? f))) forms)
        ; Build the app with routes
        app-form (cons '-> (cons '(App.create) (map App.route-call routes)))
        ; Generate CORS setup calls
        cors-setup (map
          (fn [f]
            (if (= (length f) 2)
              (list 'CORS.configure (cadr f))
              (list 'CORS.setup
                    (cadr f)
                    (caddr f)
                    (car (cdr (cdr (cdr f))))
                    (car (cdr (cdr (cdr (cdr f))))))))
          cors-forms)
        ; CORS hooks (prepend before, append after)
        cors-bh (unless (empty? cors-forms)
          (list (list 'fn ['req 'params] (list 'CORS.before-hook 'req 'params))))
        cors-ah (unless (empty? cors-forms)
          (list
            (list 'fn
                  ['req 'params 'resp]
                  (list 'CORS.after-hook 'req 'params 'resp))))
        ; Build hook arrays as lambdas wrapping the user's functions
        explicit-bh (map
          (fn [f] (list 'fn ['req 'params] (list (cadr f) 'req 'params)))
          befores)
        explicit-ah (map
          (fn [f]
            (list 'fn ['req 'params 'resp] (list (cadr f) 'req 'params 'resp)))
          afters)
        before-arr (collect-into (append cors-bh explicit-bh) array)
        after-arr (collect-into (append explicit-ah cors-ah) array)
        serve-call (if (> worker-count 0)
          (list 'App.serve-with-workers '&app '&bh '&ah host port worker-count)
          (list 'App.serve '&app '&bh '&ah host port))
        body-forms (append cors-setup
                           (append setup
                                   (list
                                     (list 'let
                                           ['app
                                            app-form
                                            'bh
                                            before-arr
                                            'ah
                                            after-arr]
                                           serve-call))))]
    (eval (list 'defn 'main (array) (cons 'do body-forms)))))