Keep HEAD a HEAD across a 301, 302 or 303

README.md

@@ -180,8 +180,10 @@ those characters are emitted unchanged.
 All return `(Result Response String)` (or `(Result ResponseStream String)` for the streaming variants).
 
 All methods follow HTTP redirects automatically (up to `Client.default-max-redirects`,
-which is 10). For 301/302/303 responses the method is changed to GET and the body is
-dropped. For 307/308 responses the original method and body are preserved. Use the
+which is 10). For 301/302/303 responses a GET or HEAD keeps its method; any other
+method becomes a GET, and the body and the headers describing it (`Content-Type`,
+`Content-Length`, …) are dropped. For 307/308 responses the original method and body
+are preserved. Use the
 `-with-max-redirects` variants to control the limit, or pass 0 to disable.
 
 A relative `Location` is resolved against the URL of the hop that produced it,

docs/Client.html

@@ -549,8 +549,8 @@ <h3 id="request">
                     <p class="doc">
                         <p>sends an HTTP request to the given URL. Returns <code>(Result Response String)</code>.</p>
 <p>Follows up to <code>default-max-redirects</code> HTTP redirects automatically. For 301,
-302, and 303 responses the method is changed to GET. For 307 and 308 the
-original method is preserved.</p>
+302, and 303 responses a GET or HEAD keeps its method and any other method
+becomes a GET. For 307 and 308 the original method is preserved.</p>
 <p>See <code>request-with-max-redirects</code> to control the redirect limit.</p>
 
                     </p>
@@ -667,8 +667,9 @@ <h3 id="request-stream-with-max-redirects">
                     <p class="doc">
                         <p>sends an HTTP request and returns a
 <code>ResponseStream</code>, following up to <code>max-redirects</code> HTTP redirects.</p>
-<p>For 301, 302, and 303 responses the method is changed to GET and the body is
-dropped. For 307 and 308 responses the original method and body are preserved.</p>
+<p>For 301, 302, and 303 responses a GET or HEAD keeps its method; any other
+method becomes a GET, and the body and the headers describing it are dropped.
+For 307 and 308 responses the original method and body are preserved.</p>
 <p>Pass 0 to disable redirect following.</p>
 
                     </p>

http-client.carp

@@ -316,10 +316,14 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
     (or (= code 301)
         (or (= code 302) (or (= code 303) (or (= code 307) (= code 308))))))
 
+  ; RFC 9110 §15.4.2–§15.4.4 method rewriting.
   (hidden redirect-verb)
   (private redirect-verb)
   (defn redirect-verb [code verb]
-    (if (or (= code 307) (= code 308)) @verb @"GET"))
+    (cond
+      (or (= code 307) (= code 308)) @verb
+      (or (= verb "GET") (= verb "HEAD")) @verb
+      @"GET"))
 
   ; uri@0.5.1 parses `/` as an empty path, so URI.resolve inherits the base
   ; path; drop this once a uri after 0.5.1 is pinned (carpentry-org/uri#35).
@@ -357,14 +361,25 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
                   (Result.Error _) @location
                   (Result.Success resolved) (URI.str &resolved)))))))
 
-  (hidden remove-content-length)
-  (private remove-content-length)
-  (defn remove-content-length [headers]
+  ; the fields RFC 9110 §15.4 drops when a redirect changes the method.
+  (hidden content-header?)
+  (private content-header?)
+  (defn content-header? [name]
+    (Array.contains?
+      &[@"content-encoding"
+        @"content-language"
+        @"content-location"
+        @"content-type"
+        @"content-length"
+        @"digest"
+        @"last-modified"]
+      &(String.ascii-to-lower name)))
+
+  (hidden remove-content-headers)
+  (private remove-content-headers)
+  (defn remove-content-headers [headers]
     (Map.kv-reduce
-      &(fn [acc k v]
-        (if (= &(String.ascii-to-lower k) "content-length")
-          acc
-          (Map.put acc k v)))
+      &(fn [acc k v] (if (content-header? k) acc (Map.put acc k v)))
       (the (Map String (Array String)) {})
       headers))
 
@@ -449,7 +464,7 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
                                   (when-do (/= &new-verb &cur-verb)
                                     (set! cur-body @"")
                                     (set! cur-headers
-                                          (remove-content-length &cur-headers)))
+                                          (remove-content-headers &cur-headers)))
                                   (set! cur-verb new-verb))
                                 (set! remaining (Int.dec remaining))))))
                       (do
@@ -475,8 +490,9 @@ to follow. Used by `request`, `request-stream`, and convenience methods.")
   (doc request-stream-with-max-redirects "sends an HTTP request and returns a
 `ResponseStream`, following up to `max-redirects` HTTP redirects.
 
-For 301, 302, and 303 responses the method is changed to GET and the body is
-dropped. For 307 and 308 responses the original method and body are preserved.
+For 301, 302, and 303 responses a GET or HEAD keeps its method; any other
+method becomes a GET, and the body and the headers describing it are dropped.
+For 307 and 308 responses the original method and body are preserved.
 
 Pass 0 to disable redirect following.")
   (defn request-stream-with-max-redirects [verb url headers body max-redirects]
@@ -541,8 +557,8 @@ Returns `(Result Response String)`. Pass 0 to disable redirect following.")
     "sends an HTTP request to the given URL. Returns `(Result Response String)`.
 
 Follows up to `default-max-redirects` HTTP redirects automatically. For 301,
-302, and 303 responses the method is changed to GET. For 307 and 308 the
-original method is preserved.
+302, and 303 responses a GET or HEAD keeps its method and any other method
+becomes a GET. For 307 and 308 the original method is preserved.
 
 See `request-with-max-redirects` to control the redirect limit.")
   (defn request [verb url headers body]
@@ -749,7 +765,7 @@ See `RequestConfig` for timeout and redirect details.")
                                     (when-do (/= &new-verb &cur-verb)
                                       (set! cur-body @"")
                                       (set! cur-headers
-                                            (remove-content-length &cur-headers)))
+                                            (remove-content-headers &cur-headers)))
                                     (set! cur-verb new-verb))
                                   (set! remaining (Int.dec remaining))))))
                         (do

test/http-client.carp

@@ -26,6 +26,61 @@
 (defn get-body [url]
   (match (Client.get url) (Result.Success r) @(Response.body &r) _ @""))
 
+; Reports the error text, so a failed request cannot pass for an empty body.
+(defn status-and-body [res]
+  (match res
+    (Result.Success r) (fmt "%d [%s]" @(Response.code &r) (Response.body &r))
+    (Result.Error e) e))
+
+(defn head-status-and-body [url] (status-and-body (Client.head url)))
+
+(defn head-with-jar-status-and-body [url]
+  (let-do [jar (CookieJar.create)]
+    (status-and-body (Client.head-with-jar url &jar))))
+
+(def probe-names
+  [@"CONTENT-TYPE"
+   @"Content-Encoding"
+   @"Content-Language"
+   @"Content-Location"
+   @"Content-Length"
+   @"Digest"
+   @"Last-Modified"
+   @"X-Keep-Me"])
+
+(defn probe-map []
+  (Map.from-array
+    (Array.copy-map &(fn [n] (Pair.init @n [@"probe"])) &probe-names)))
+
+(defn probe-url [status-code]
+  (fmt
+    "http://127.0.0.1:8791/redirect-to?url=/headers&status_code=%d"
+    status-code))
+
+; The probe headers that reached the target, prefixed with the status code so
+; a failed request cannot pass for a stripped header set.
+(defn kept-headers [res]
+  (match res
+    (Result.Error e) e
+    (Result.Success r)
+      (let-do [dump (Response.body &r)
+               kept []]
+        (foreach [n &probe-names]
+                 (when (String.contains-string? dump &(fmt "%s: " n))
+                   (set! kept (Array.push-back kept @n))))
+        (fmt "%d %s" @(Response.code &r) &(String.join "," &kept)))))
+
+(defn surviving-headers [status-code]
+  (kept-headers (Client.post &(probe-url status-code) (probe-map) "{\"a\": 1}")))
+
+(defn surviving-headers-with-jar [status-code]
+  (let-do [jar (CookieJar.create)]
+    (kept-headers
+      (Client.post-with-jar &(probe-url status-code)
+                            (probe-map)
+                            "{\"a\": 1}"
+                            &jar))))
+
 (defn count-occurrences [s needle]
   (let-do [n 0
            rest @s
@@ -196,6 +251,50 @@
       _ false)
     "307 redirect preserves POST method")
 
+  (assert-equal test
+    "200 []"
+    &(head-status-and-body
+      "http://127.0.0.1:8791/redirect-to?url=/get&status_code=301")
+    "301 redirect keeps HEAD a HEAD")
+
+  (assert-equal test
+    "200 []"
+    &(head-status-and-body
+      "http://127.0.0.1:8791/redirect-to?url=/get&status_code=302")
+    "302 redirect keeps HEAD a HEAD")
+
+  (assert-equal test
+    "200 []"
+    &(head-status-and-body
+      "http://127.0.0.1:8791/redirect-to?url=/get&status_code=303")
+    "303 redirect keeps HEAD a HEAD")
+
+  (assert-equal test
+    "200 []"
+    &(head-with-jar-status-and-body
+      "http://127.0.0.1:8791/redirect-to?url=/get&status_code=301")
+    "301 redirect keeps HEAD a HEAD on the cookie-jar path")
+
+  (assert-equal test
+    "200 X-Keep-Me"
+    &(surviving-headers 303)
+    "a redirect that changes the method drops the headers describing the body")
+
+  (assert-equal test
+    "200 CONTENT-TYPE,Content-Encoding,Content-Language,Content-Location,Content-Length,Digest,Last-Modified,X-Keep-Me"
+    &(surviving-headers 307)
+    "a redirect that keeps the method keeps the headers describing the body")
+
+  (assert-equal test
+    "200 X-Keep-Me"
+    &(surviving-headers-with-jar 303)
+    "the same drop holds on the cookie-jar path")
+
+  (assert-equal test
+    "200 CONTENT-TYPE,Content-Encoding,Content-Language,Content-Location,Content-Length,Digest,Last-Modified,X-Keep-Me"
+    &(surviving-headers-with-jar 307)
+    "the same keep holds on the cookie-jar path")
+
   (assert-true test
     (match (Client.request "GET"
                            "http://127.0.0.1:8791/redirect-to?url=/headers&status_code=302"