Add HEAD headers-only (T3) and opt-in gzip (T11); server-loop cleanup

Message

T3 — HEAD returns headers only: - write-http-response gains head?: which writes the status line and headers (ensure-headers still computes Content-Length) but suppresses the body, including not invoking a streaming producer. - handle-request answers HEAD headers-only for every route (streaming bodies too) and never spawns a streaming goroutine for HEAD.

T11 — opt-in automatic gzip: - make-http-server/http-serve gain gzip: (default #f). When enabled, handle-request runs the existing http-response-gzip over non-streaming responses per the request Accept-Encoding. Off by default, so the default server is byte-for-byte unchanged; streaming/incompressible/small bodies are never compressed.

Cleanup (from the T1 review): - http-server-start returns the same value (the final server) on both the reuse and self-install paths instead of leaking with-async's status symbol. - server-loop drops the now-unreachable socket-select blocking branch (a scheduler is always established before it runs; await-readable still degrades gracefully if ever run without one).

Tests: write-http-response head? unit tests; the integration driver now also checks HEAD (0 body bytes + Content-Length over the wire) and gzip (Accept-Encoding negotiation, Vary, smaller body, off-by-default, streaming file stays byte-exact).

Changed

 src/sigil/http/response.sgl                |  11 +++++++++--
 src/sigil/http/server.sgl                  | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------------------------------
 test/integration/run-streaming-tests.sh    |  77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/integration/streaming-server-main.sgl |  36 ++++++++++++++++++++++++++++--------
 test/test-response.sgl                     |  37 +++++++++++++++++++++++++++++++++++++
 5 files changed, 227 insertions(+), 61 deletions(-)

Diff

src/sigil/http/response.sglmodified

@@ -369,8 +369,14 @@

369

;;;

370

;;; The write function should accept `(socket data)` and return bytes

371

;;; written or `#f`. Returns `#t` on success, `#f` on error.

−372

(define (write-http-response res sock write-fn)

−373

(: http-response? any? procedure? -> boolean?)

+372

;;;

+373

;;; When `head?:` is #t (a response to a HEAD request), the status line and

+374

;;; headers are written but the body is suppressed entirely — including not

+375

;;; invoking a streaming producer. `ensure-headers` still computes the

+376

;;; Content-Length from the body, so a HEAD response advertises the same

+377

;;; headers a GET would while sending zero body bytes.

+378

(define (write-http-response res sock write-fn (keys: (head? #f)))

+379

(: http-response? any? procedure? (head?: boolean?) -> boolean?)

380

(let* ((status (http-response-status res))

381

(body (http-response-body res))

382

(headers (ensure-headers (http-response-headers res) body))

@@ -381,6 +387,7 @@

387

(write-fn sock headers-str)

388

(write-fn sock "\r\n")

389

(cond

+390

(head? #t) ; HEAD: headers only, no body bytes

391

((not body) #t)

392

((string? body)

393

(if (write-fn sock body) #t #f))

src/sigil/http/server.sglmodified

@@ -63,6 +63,7 @@

(backlog default: 128) ; Listen backlog

(timeout default: 30000) ; Request timeout (ms)

(max-request-size default: (* 10 1024 1024)) ; 10MB

+66

(gzip default: #f) ; Opt-in automatic gzip (Accept-Encoding)

(socket default: #f) ; Listening socket

(running default: #f) ; Running state

(clients default: '())) ; Active client connections

@@ -98,19 +99,25 @@

;;; - `backlog:` - Listen queue size (default: 128)

100

;;; - `timeout:` - Request timeout in milliseconds (default: 30000)

101

;;; - `max-request-size:` - Maximum request body size in bytes (default: 10MB)

+102

;;; - `gzip:` - Opt-in automatic gzip. When #t, non-streaming responses are

+103

;;; gzip-encoded per the request's `Accept-Encoding` (only when the client

+104

;;; accepts gzip, the type is compressible, and the body is large enough).

+105

;;; Default #f — the default server behaves exactly as before.

106

(define (make-http-server handler (keys: (port 8080)

107

(host "0.0.0.0")

108

(backlog 128)

109

(timeout 30000)

−105

(max-request-size (* 10 1024 1024))))

−106

      (: procedure? (port: integer?) (host: string?) (backlog: integer?) (timeout: integer?) (max-request-size: integer?) -> http-server?)

+110

(max-request-size (* 10 1024 1024))

+111

(gzip #f)))

+112

      (: procedure? (port: integer?) (host: string?) (backlog: integer?) (timeout: integer?) (max-request-size: integer?) (gzip: any?) -> http-server?)

113

(http-server

114

handler: handler

115

port: port

116

host: host

117

backlog: backlog

118

timeout: timeout

−113

max-request-size: max-request-size))

+119

max-request-size: max-request-size

+120

gzip: gzip))

121

122

;;; Check if server is currently running.

123

;;;

@@ -168,9 +175,15 @@

175

;; one, so streaming responses (which spawn `go` goroutines)

176

;; work whether or not the server was started inside

177

;; `with-async`. When a scheduler is already current, reuse it.

−171

(if (current-scheduler)

−172

(run-server-resume-loop server*)

−173

(with-async (run-server-resume-loop server*))))))))

+178

;; Capture the loop's result in both paths so the return value

+179

;; is the same (the final/stopped server) regardless of which

+180

;; branch ran — `with-async` itself would otherwise yield the

+181

;; scheduler-run status symbol instead.

+182

(let ((final #f))

+183

(if (current-scheduler)

+184

(set! final (run-server-resume-loop server*))

+185

(with-async (set! final (run-server-resume-loop server*))))

+186

final))))))

187

188

;;; Run the guarded server loop, restarting on any escaping exception.

189

;;; Assumes an async scheduler is already active (see http-server-start).

@@ -216,44 +229,38 @@

229

230

;;; Main server loop

231

;;;

−219

;;; When running inside an async scheduler, cooperates with other tasks

−220

;;; (including streaming-response goroutines) via `await-readable`.

−221

;;;

−222

;;; Since http-server-start now always establishes a scheduler before

−223

;;; entering the loop (reusing the caller's, or self-installing one via

−224

;;; `with-async`), the cooperative branch is the path taken in practice.

−225

;;; The socket-select blocking branch is retained as a defensive fallback

−226

;;; for any direct/manual invocation of server-loop without a scheduler.

+232

;;; Cooperates with other tasks (including streaming-response goroutines)

+233

;;; via `await-readable`, which yields to the async scheduler that

+234

;;; http-server-start always establishes before entering the loop (it

+235

;;; reuses the caller's scheduler, or self-installs one via `with-async`).

+236

;;; `await-readable`/`process-connections` degrade to a blocking

+237

;;; `socket-select` on their own if ever run without a scheduler, so the

+238

;;; loop stays correct either way.

239

(define (server-loop server)

240

(if (not (http-server-running server))

241

server

−230

(if (current-scheduler)

−231

;; Cooperative mode: yield to scheduler while waiting for I/O

−232

(let loop ((server server))

−233

(if (not (http-server-running server))

−234

server

−235

(begin

−236

(await-readable (http-server-socket server))

−237

;; Process pending connections with guard to prevent

−238

;; a single bad connection from crashing the server loop

−239

(let ((server* (guard (exn

−240

(else

−241

(log-server-error "Exception in connection processing" exn)

−242

server))

−243

(process-connections server 0))))

−244

(let drain ((s server*))

−245

(if (null? (http-server-clients s))

−246

;; No more clients, wait for next connection

−247

(loop s)

−248

;; More clients - quick poll then continue

−249

(drain (guard (exn

−250

(else

−251

(log-server-error "Exception in drain loop" exn)

−252

s))

−253

(process-connections s 10)))))))))

−254

;; Blocking mode: traditional socket-select loop

−255

(let ((server* (process-connections server 100)))

−256

(server-loop server*)))))

+242

(let loop ((server server))

+243

(if (not (http-server-running server))

+244

server

+245

(begin

+246

(await-readable (http-server-socket server))

+247

;; Process pending connections with guard to prevent

+248

;; a single bad connection from crashing the server loop

+249

(let ((server* (guard (exn

+250

(else

+251

(log-server-error "Exception in connection processing" exn)

+252

server))

+253

(process-connections server 0))))

+254

(let drain ((s server*))

+255

(if (null? (http-server-clients s))

+256

;; No more clients, wait for next connection

+257

(loop s)

+258

;; More clients - quick poll then continue

+259

(drain (guard (exn

+260

(else

+261

(log-server-error "Exception in drain loop" exn)

+262

s))

+263

(process-connections s 10)))))))))))

264

265

;;; Process connections using socket-select

266

(define (process-connections server timeout-ms)

@@ -636,9 +643,21 @@

643

(if (not response)

644

;; Handler returned #f - send 404

645

(set! response (http-response/not-found)))

−639

;; Check if this is a streaming response (SSE, chunked, etc.)

−640

(let ((body (http-response-body response)))

−641

(if (procedure? body)

+646

;; Opt-in automatic gzip (Accept-Encoding). http-response-gzip is a

+647

;; no-op unless the client accepts gzip and the body is a compressible

+648

;; string/bytevector over the size floor, so streaming bodies and the

+649

;; gzip-disabled default are untouched.

+650

(when (http-server-gzip server)

+651

(set! response

+652

(http-response-gzip

+653

(http-request-header request "Accept-Encoding")

+654

response)))

+655

;; HEAD must return identical status + headers but zero body bytes.

+656

;; It never streams: even a streaming body is answered headers-only,

+657

;; and ensure-headers still advertises the correct Content-Length.

+658

(let ((body (http-response-body response))

+659

(head? (eq? (http-request-method request) 'HEAD)))

+660

(if (and (procedure? body) (not head?))

661

;; Streaming response - spawn goroutine and keep socket open

662

(begin

663

(go (guard (exn

@@ -647,9 +666,9 @@

666

(send-response sock response)

667

(socket-close sock)))

668

#f) ; Remove from normal client list (goroutine owns socket now)

−650

;; Normal response - send and close

+669

;; Normal response (or HEAD) - send and close

670

(begin

−652

(send-response sock response)

+671

(send-response sock response head?: head?)

672

(socket-close sock)

673

#f)))))) ; Remove client from list

674

@@ -660,7 +679,7 @@

679

;;; so we loop until the full data is sent. Converts strings to

680

;;; bytevectors for correct byte-offset tracking (socket-write

681

;;; returns bytes written, not characters).

−663

(define (send-response sock response)

+682

(define (send-response sock response (keys: (head? #f)))

683

(write-http-response response sock

684

(lambda (s data)

685

(let* ((bv (if (string? data) (string->utf8 data) data))

@@ -680,7 +699,8 @@

699

(begin

700

(await-writable s)

701

(loop offset (+ attempts 1)))

−683

#f)))))))))

+702

#f)))))))

+703

head?: head?))

704

705

;;; Send an error response

706

(define (send-error-response sock status message)

@@ -705,18 +725,23 @@

725

;;; If you already run inside `with-async` (e.g. you spawn the server with

726

;;; `(go (http-server-start …))` alongside other goroutines), that

727

;;; scheduler is reused — no nested scheduler is created.

+728

;;;

+729

;;; Pass `gzip: #t` to opt into automatic gzip of non-streaming responses

+730

;;; per the request's `Accept-Encoding` (off by default).

731

(define (http-serve handler (keys: (port 8080)

732

(host "0.0.0.0")

733

(backlog 128)

734

(timeout 30000)

−712

(max-request-size (* 10 1024 1024))))

−713

      (: procedure? (port: integer?) (host: string?) (backlog: integer?) (timeout: integer?) (max-request-size: integer?) -> any?)

+735

(max-request-size (* 10 1024 1024))

+736

(gzip #f)))

+737

      (: procedure? (port: integer?) (host: string?) (backlog: integer?) (timeout: integer?) (max-request-size: integer?) (gzip: any?) -> any?)

738

(http-server-start

739

(make-http-server handler

740

port: port

741

host: host

742

backlog: backlog

743

timeout: timeout

−720

max-request-size: max-request-size)))

+744

max-request-size: max-request-size

+745

gzip: gzip)))

746

747

))

test/integration/run-streaming-tests.shmodified

@@ -30,6 +30,7 @@ DL="$(mktemp /tmp/t1-dl.XXXXXX.bin)"

SSE="$(mktemp /tmp/t1-sse.XXXXXX.txt)"

BARE_PORT=18201

WRAPPED_PORT=18202

+33

GZIP_PORT=18203

SRV_PID=""

FAILED=0

@@ -124,6 +125,81 @@ run_mode() {

125

pass "$mode: no async-context error in server log"

126

fi

127

+128

# 4. HEAD returns headers (incl. Content-Length) and ZERO body bytes.

+129

# curl -I masks the old HEAD-body bug (it closes after headers), so we

+130

# save the body to a file and assert it is empty. See review gotchas.

+131

local hb hh hbsize

+132

hb="$(mktemp)"; hh="$(mktemp)"

+133

curl -s --max-time 5 -X HEAD -D "$hh" -o "$hb" "http://127.0.0.1:$port/big-text"

+134

hbsize=$(stat -c%s "$hb" 2>/dev/null || echo -1)

+135

if [ "$hbsize" = "0" ] \

+136

&& head -1 "$hh" | grep -q " 200 " \

+137

&& grep -qi '^content-length:' "$hh"; then

+138

pass "$mode: HEAD /big-text -> headers only (0 body bytes, Content-Length present)"

+139

else

+140

fail "$mode: HEAD expected 0 body bytes + status 200 + Content-Length (got $hbsize body bytes)"

+141

fi

+142

rm -f "$hb" "$hh"

+143

+144

# 5. gzip is OFF by default: even with Accept-Encoding: gzip, no encoding.

+145

local h5

+146

h5="$(curl -s --max-time 5 -H 'Accept-Encoding: gzip' -D - -o /dev/null "http://127.0.0.1:$port/big-text")"

+147

if echo "$h5" | grep -qi '^content-encoding:'; then

+148

fail "$mode: gzip disabled by default but response was content-encoded"

+149

else

+150

pass "$mode: gzip off by default (no Content-Encoding even when client accepts gzip)"

+151

fi

+152

+153

stop_server

+154

}

+155

+156

# gzip-enabled server (T11): opt-in gzip honoring Accept-Encoding.

+157

run_gzip() {

+158

local port="$1"

+159

echo ""

+160

echo "=== gzip mode (port $port) ==="

+161

if ! start_server "$port" "gzip"; then

+162

fail "gzip: server startup"

+163

stop_server

+164

return

+165

fi

+166

+167

# Baseline: identity size (no Accept-Encoding).

+168

local raw_size gz_size hdr

+169

curl -s --max-time 5 -o "$DL" "http://127.0.0.1:$port/big-text"

+170

raw_size=$(stat -c%s "$DL" 2>/dev/null || echo 0)

+171

+172

# With Accept-Encoding: gzip -> Content-Encoding: gzip and a smaller body.

+173

hdr="$(curl -s --max-time 5 -H 'Accept-Encoding: gzip' -D - -o "$DL" "http://127.0.0.1:$port/big-text")"

+174

gz_size=$(stat -c%s "$DL" 2>/dev/null || echo 0)

+175

if echo "$hdr" | grep -qi '^content-encoding: *gzip' \

+176

&& echo "$hdr" | grep -qi '^vary: *Accept-Encoding'; then

+177

pass "gzip: Accept-Encoding: gzip -> Content-Encoding: gzip + Vary"

+178

else

+179

fail "gzip: expected Content-Encoding: gzip and Vary: Accept-Encoding"

+180

fi

+181

if [ "$gz_size" -gt 0 ] && [ "$gz_size" -lt "$raw_size" ]; then

+182

pass "gzip: compressed body smaller than identity ($gz_size < $raw_size bytes)"

+183

else

+184

fail "gzip: compressed body not smaller ($gz_size vs $raw_size bytes)"

+185

fi

+186

+187

# Without Accept-Encoding -> identity (no Content-Encoding).

+188

hdr="$(curl -s --max-time 5 -D - -o /dev/null "http://127.0.0.1:$port/big-text")"

+189

if echo "$hdr" | grep -qi '^content-encoding:'; then

+190

fail "gzip: response without Accept-Encoding must not be gzipped"

+191

else

+192

pass "gzip: no Accept-Encoding -> identity"

+193

fi

+194

+195

# Incompressible/streamed file must never be gzipped, even when enabled.

+196

hdr="$(curl -s --max-time 15 -H 'Accept-Encoding: gzip' -D - -o "$DL" "http://127.0.0.1:$port/file")"

+197

if echo "$hdr" | grep -qi '^content-encoding:' || ! cmp -s "$ASSET" "$DL"; then

+198

fail "gzip: streaming file was altered/encoded (must stay byte-exact identity)"

+199

else

+200

pass "gzip: streaming file stays byte-exact identity (not gzipped)"

+201

fi

+202

203

stop_server

204

}

205

@@ -141,6 +217,7 @@ head -c 2100000 /dev/urandom > "$ASSET"

217

218

run_mode "bare" "$BARE_PORT" # T1: streaming works WITHOUT with-async

219

run_mode "wrapped" "$WRAPPED_PORT" # regression: existing with-async consumers

+220

run_gzip "$GZIP_PORT" # T11: opt-in gzip honoring Accept-Encoding

221

222

echo ""

223

if [ "$FAILED" -eq 0 ]; then

test/integration/streaming-server-main.sglmodified

@@ -30,11 +30,22 @@

;; Asset path captured from argv at startup.

(define *asset-path* (make-parameter "/dev/null"))

+33

;; A compressible text body comfortably over the gzip size floor (1 KB).

+34

(define big-text

+35

(let loop ((n 0) (acc ""))

+36

(if (>= n 200)

+37

acc

+38

(loop (+ n 1)

+39

(string-append acc "The quick brown fox jumps over the lazy dog. ")))))

+40

(define (handler request)

(let ((path (http-request-path request)))

(cond

((string=? path "/hello")

(http-response/text HTTP-OK "Hello, World!"))

+46

;; Large compressible text — exercises opt-in gzip (T11).

+47

((string=? path "/big-text")

+48

(http-response/text HTTP-OK big-text))

;; Streaming file — the "image sometimes doesn't download" path.

((string=? path "/file")

(http-response/file (*asset-path*)))

@@ -50,17 +61,26 @@

(close))))))

(else (http-response/not-found)))))

+64

;;; Modes:

+65

;;; bare -> (http-serve ...) no with-async (T1 fix case; default)

+66

;;; wrapped -> (with-async (go (http-server-start ...))) consumer pattern

+67

;;; gzip -> bare + gzip: #t (opt-in gzip; T11)

(define (main)

(let* ((args (cdr (command-line)))

(port (string->number (list-ref args 0)))

(asset (list-ref args 1))

(mode (if (>= (length args) 3) (list-ref args 2) "bare")))

(*asset-path* asset)

−59

(if (string=? mode "wrapped")

−60

;; Existing-consumer regression path: the server runs as a

−61

;; goroutine inside a caller-owned scheduler. http-server-start

−62

;; must reuse that scheduler rather than nest a second one.

−63

(let ((server (make-http-server handler port: port host: "127.0.0.1")))

−64

(with-async (go (http-server-start server))))

−65

;; Bare path: no with-async at the call site (the T1 fix case).

−66

(http-serve handler port: port host: "127.0.0.1"))))))

+74

(cond

+75

((string=? mode "wrapped")

+76

;; Existing-consumer regression path: the server runs as a

+77

;; goroutine inside a caller-owned scheduler. http-server-start

+78

;; must reuse that scheduler rather than nest a second one.

+79

(let ((server (make-http-server handler port: port host: "127.0.0.1")))

+80

(with-async (go (http-server-start server)))))

+81

((string=? mode "gzip")

+82

;; Opt-in gzip enabled (T11). Still a bare call (T1 fix applies).

+83

(http-serve handler port: port host: "127.0.0.1" gzip: #t))

+84

(else

+85

;; Bare path: no with-async at the call site (the T1 fix case).

+86

(http-serve handler port: port host: "127.0.0.1")))))))

test/test-response.sglmodified

@@ -173,6 +173,43 @@

173

(assert-true (string-contains? output "chunk1"))

174

(assert-true (string-contains? output "chunk2"))))))

175

+176

;; T3: HEAD returns identical status + headers but zero body bytes.

+177

(test "write-http-response head?: suppresses the body but keeps headers"

+178

(let ((written '()))

+179

(define (mock-write sock data)

+180

(set! written (cons data written))

+181

(string-length data))

+182

(let ((res (http-response/text 200 "Test body")))

+183

(write-http-response res 'mock-socket mock-write head?: #t)

+184

(let ((output (apply string-append (reverse written))))

+185

;; Status line + headers present, incl. the GET Content-Length...

+186

(assert-true (string-starts-with? output "HTTP/1.1 200 OK"))

+187

(assert-true (string-contains? output "content-length: 9"))

+188

;; ...but the body itself must NOT be on the wire.

+189

(assert-false (string-contains? output "Test body"))

+190

;; And nothing follows the header terminator.

+191

(assert-true (string-ends-with? output "\r\n\r\n"))))))

+192

+193

;; T3: HEAD must not invoke a streaming producer at all.

+194

(test "write-http-response head?: does not run a streaming body"

+195

(let ((written '())

+196

(produced #f))

+197

(define (mock-write sock data)

+198

(set! written (cons data written))

+199

(string-length data))

+200

(let ((res (http-response

+201

status: 200

+202

headers: #{ content-type: "text/plain" }

+203

body: (lambda (emit-chunk finish)

+204

(set! produced #t)

+205

(emit-chunk "chunk1")

+206

(finish)))))

+207

(write-http-response res 'mock-socket mock-write head?: #t)

+208

(let ((output (apply string-append (reverse written))))

+209

(assert-false produced) ; producer never called

+210

(assert-false (string-contains? output "chunk1"))

+211

(assert-true (string-starts-with? output "HTTP/1.1 200 OK"))))))

+212

213

;; ============================================================

214

;; SSE Heartbeat Tests

215

;; ============================================================