Add HEAD method support and ETag conditional responses

CHANGELOG.md

@@ -4,6 +4,22 @@
 
 ### Added
 
+- **HEAD method support** (RFC 7231). HEAD requests automatically match GET
+  routes and return the same headers (including `Content-Length`) but with an
+  empty body. For `sendfile` responses, the file size is computed for
+  `Content-Length` without transferring the file data.
+
+- **ETag-based conditional responses for static files.** `Response.file`
+  computes an `ETag` from the SHA-1 hash of the file contents.
+  `Response.sendfile` computes an `ETag` from the file's modification time
+  and size, preserving its zero-copy design by avoiding a full file read.
+  When a request includes an `If-None-Match` header that matches the
+  response's `ETag`, the server returns `304 Not Modified` with no body,
+  eliminating redundant file transfers.
+
+- `SHA1.hex-digest` computes the SHA-1 digest of a byte array and returns
+  it as a 40-character lowercase hex string.
+
 - **WebSocket subprotocol negotiation** (RFC 6455 §4.2.2). `App.WSP` registers
   a WebSocket route with a list of supported subprotocols. During the upgrade
   handshake, the server selects the first client-requested protocol that appears
@@ -47,6 +63,10 @@
 
 ### Fixed
 
+- **`web-finalize-response` preserves explicit Content-Length.** When a response
+  already has a `Content-Length` header (e.g. HEAD responses), finalization no
+  longer overrides it with the body length.
+
 - **Content-Length no longer sent with chunked encoding.** `web-finalize-response`
   now skips the `Content-Length` header when `Transfer-Encoding` is already set,
   fixing an RFC 7230 §3.3.2 violation.

src/fstat_mtime.h

@@ -0,0 +1,12 @@
+#include <sys/stat.h>
+
+Long web_fstat_mtime(int fd) {
+#ifdef _WIN32
+    struct _stat64 st;
+    if (_fstat64(fd, &st) == -1) return -1;
+#else
+    struct stat st;
+    if (fstat(fd, &st) == -1) return -1;
+#endif
+    return (Long)st.st_mtime;
+}

test/web.carp

@@ -495,4 +495,237 @@
             (Request.parse "GET / HTTP/1.1\r\nHost: x\r\n\r\n"))
           params (the (Map String String) {})]
       @(Response.code &(log-after &req &params (Response.text @"ok"))))
-    "log-after does not crash without _start param"))
+    "log-after does not crash without _start param")
+
+  ; ---------------------------------------------------------------------------
+  ; SHA1.hex-digest tests
+  ; ---------------------------------------------------------------------------
+
+  ; hex-digest returns a 40-char lowercase hex string
+  (assert-true test
+    (= 40 (String.length &(SHA1.hex-digest &(the (Array Byte) []))))
+    "SHA1 hex-digest returns 40 chars")
+
+  ; hex-digest is deterministic (same input -> same output)
+  (assert-true test
+    (=
+      &(SHA1.hex-digest &(String.to-bytes "hello"))
+      &(SHA1.hex-digest &(String.to-bytes "hello")))
+    "SHA1 hex-digest is deterministic")
+
+  ; different inputs produce different digests
+  (assert-true test
+    (/=
+      &(SHA1.hex-digest &(String.to-bytes "hello"))
+      &(SHA1.hex-digest &(String.to-bytes "world")))
+    "SHA1 hex-digest differs for different inputs")
+
+  ; ---------------------------------------------------------------------------
+  ; HEAD method routing tests
+  ; ---------------------------------------------------------------------------
+
+  ; -- HEAD matches GET routes --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/hello" (fn [r p] (Response.text @"hi"))))
+          req (Result.unsafe-from-success
+            (Request.parse "HEAD /hello HTTP/1.1\r\nHost: x\r\n\r\n"))]
+      (Maybe.just? &(web-find-handler (App.routes &app) &req)))
+    "HEAD matches GET route")
+
+  ; -- HEAD does not match POST routes --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.POST @"/data" (fn [r p] (Response.text @"ok"))))
+          req (Result.unsafe-from-success
+            (Request.parse "HEAD /data HTTP/1.1\r\nHost: x\r\n\r\n"))]
+      (Maybe.nothing? &(web-find-handler (App.routes &app) &req)))
+    "HEAD does not match POST route")
+
+  ; -- HEAD response strips body --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/hello" (fn [r p] (Response.text @"hi"))))
+          req @"HEAD /hello HTTP/1.1\r\nHost: x\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))]
+      (String.empty? (Response.body (Pair.a &pair))))
+    "HEAD response has empty body")
+
+  ; -- HEAD preserves Content-Length from GET body --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/hello" (fn [r p] (Response.text @"hi"))))
+          req @"HEAD /hello HTTP/1.1\r\nHost: x\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))
+          resp @(Pair.a &pair)
+          cl-vals (Map.get-with-default (Response.headers &resp)
+                                        "Content-Length"
+                                        &[@"0"])]
+      (= (Array.unsafe-first &cl-vals) "2"))
+    "HEAD preserves Content-Length from GET body")
+
+  ; -- HEAD + chunked omits Content-Length (RFC 7230 §3.3.2) --
+  (assert-false test
+    (let [app (-> (App.create)
+                  (App.GET @"/stream"
+                           (fn [r p]
+                             (Response.chunked 200 @"text/plain" &[@"hello"]))))
+          req @"HEAD /stream HTTP/1.1\r\nHost: x\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))
+          resp @(Pair.a &pair)]
+      (Map.contains? (Response.headers &resp) "Content-Length"))
+    "HEAD + chunked omits Content-Length")
+
+  ; -- HEAD + chunked preserves Transfer-Encoding --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/stream"
+                           (fn [r p]
+                             (Response.chunked 200 @"text/plain" &[@"hello"]))))
+          req @"HEAD /stream HTTP/1.1\r\nHost: x\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))
+          resp @(Pair.a &pair)]
+      (Map.contains? (Response.headers &resp) "Transfer-Encoding"))
+    "HEAD + chunked preserves Transfer-Encoding")
+
+  ; -- HEAD + chunked has empty body --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/stream"
+                           (fn [r p]
+                             (Response.chunked 200 @"text/plain" &[@"hello"]))))
+          req @"HEAD /stream HTTP/1.1\r\nHost: x\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))]
+      (String.empty? (Response.body (Pair.a &pair))))
+    "HEAD + chunked has empty body")
+
+  ; ---------------------------------------------------------------------------
+  ; ETag / If-None-Match tests
+  ; ---------------------------------------------------------------------------
+
+  ; -- web-etag-match? returns false without If-None-Match --
+  (assert-false test
+    (let [req (Result.unsafe-from-success
+            (Request.parse "GET / HTTP/1.1\r\nHost: x\r\n\r\n"))
+          resp (Response.with-header (Response.text @"hi") @"ETag" @"\"abc\"")]
+      (web-etag-match? &req &resp))
+    "etag-match? false without If-None-Match")
+
+  ; -- web-etag-match? returns true on match --
+  (assert-true test
+    (let [req (Result.unsafe-from-success
+            (Request.parse
+              "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"abc\"\r\n\r\n"))
+          resp (Response.with-header (Response.text @"hi") @"ETag" @"\"abc\"")]
+      (web-etag-match? &req &resp))
+    "etag-match? true when ETags match")
+
+  ; -- web-etag-match? returns false on mismatch --
+  (assert-false test
+    (let [req (Result.unsafe-from-success
+            (Request.parse
+              "GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"xyz\"\r\n\r\n"))
+          resp (Response.with-header (Response.text @"hi") @"ETag" @"\"abc\"")]
+      (web-etag-match? &req &resp))
+    "etag-match? false when ETags differ")
+
+  ; -- 304 Not Modified on matching ETag --
+  (assert-equal test
+    304
+    (let [app (-> (App.create)
+                  (App.GET @"/"
+                           (fn [r p]
+                             (Response.with-header (Response.text @"hi")
+                                                   @"ETag"
+                                                   @"\"abc\""))))
+          req @"GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"abc\"\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))]
+      @(Response.code (Pair.a &pair)))
+    "matching If-None-Match returns 304")
+
+  ; -- 304 preserves ETag header --
+  (assert-true test
+    (let [app (-> (App.create)
+                  (App.GET @"/"
+                           (fn [r p]
+                             (Response.with-header (Response.text @"hi")
+                                                   @"ETag"
+                                                   @"\"abc\""))))
+          req @"GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"abc\"\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))
+          resp @(Pair.a &pair)]
+      (Map.contains? (Response.headers &resp) "ETag"))
+    "304 response preserves ETag header")
+
+  ; -- No 304 when ETags differ --
+  (assert-equal test
+    200
+    (let [app (-> (App.create)
+                  (App.GET @"/"
+                           (fn [r p]
+                             (Response.with-header (Response.text @"hi")
+                                                   @"ETag"
+                                                   @"\"abc\""))))
+          req @"GET / HTTP/1.1\r\nHost: x\r\nIf-None-Match: \"xyz\"\r\n\r\n"
+          bh (the
+            (Array (Fn [&Request &(Map String String)] (Maybe Response)))
+            [])
+          ah (the
+            (Array (Fn [&Request &(Map String String) Response] Response))
+            [])
+          pair (web-build-response &app &bh &ah &(String.to-bytes &req))]
+      @(Response.code (Pair.a &pair)))
+    "mismatched If-None-Match returns 200")
+
+  ; -- finalize preserves explicit Content-Length --
+  (assert-true test
+    (let [resp (-> (Response.text @"")
+                   (Response.with-header @"Content-Length" @"42"))
+          final (web-finalize-response resp true)
+          cl (Map.get-with-default (Response.headers &final)
+                                   "Content-Length"
+                                   &[@"0"])]
+      (= (Array.unsafe-first &cl) "42"))
+    "finalize preserves explicit Content-Length"))