From 1a922449b9291c295ba1d426817d94f07af67335 Mon Sep 17 00:00:00 2001
From: Tim Greene <tim.g.greene@gmail.com>
Date: Thu, 21 Jan 2021 20:36:12 +0000
Subject: [PATCH] Replace error-deferred for HEAD implementation

Currently we're creating deferred errors which are never consumed (these log
exceptions when the next GC cycle runs), instead we can simply throw to be
caught be the outer deferred chain and handled in the normal catch block in
yada.handler/handle-request-with-maybe-subresources.

The only distinction from existing behaviour is that we will now return a 406 in
line with GET when we have no available representation for the HEAD, whereas
previously we would return a 200.

This aligns with the principle that the HEAD response should reflect the GET
other than providing a response body.
---
 src/yada/handler.clj    |  2 +-
 src/yada/methods.clj    |  5 ++---
 test/yada/head_test.clj | 20 ++++++++++++++++++--
 3 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/src/yada/handler.clj b/src/yada/handler.clj
index c5edf7cb..0b16646a 100644
--- a/src/yada/handler.clj
+++ b/src/yada/handler.clj
@@ -152,7 +152,7 @@
                               (and (not (contains? data :body)) (:response custom-response))
                               (custom-error (:response custom-response) rep)
 
-                              true set-content-length)
+                              (not (= :head (:method ctx))) set-content-length)
 
                             (:error-interceptor-chain ctx)
 
diff --git a/src/yada/methods.clj b/src/yada/methods.clj
index 86a9fb49..72ec53fa 100644
--- a/src/yada/methods.clj
+++ b/src/yada/methods.clj
@@ -106,11 +106,10 @@
   (request [this ctx]
 
     (when-not (ctx/exists? ctx)
-      (d/error-deferred (ex-info "" {:status 404})))
+      (throw (ex-info "" {:status 404})))
 
     (when-not (get-in ctx [:response :produces])
-      (d/error-deferred
-       (ex-info "" {:status 406})))
+      (throw (ex-info "" {:status 406})))
 
     ;; HEAD is implemented without delegating to the resource.
 
diff --git a/test/yada/head_test.clj b/test/yada/head_test.clj
index bf3e639a..ac8bbde1 100644
--- a/test/yada/head_test.clj
+++ b/test/yada/head_test.clj
@@ -3,7 +3,7 @@
 (ns yada.head-test
   (:require
    [clojure.test :refer :all]
-   [ring.mock.request :refer [request]]
+   [ring.mock.request :as ring-mock]
    [yada.handler :refer [handler]]
    [yada.resource :refer [as-resource]]))
 
@@ -12,7 +12,7 @@
         h (handler (merge (as-resource resource)
                           {:produces {:media-type "text/plain"
                                       :charset "UTF-8"}}))
-        request (request :head "/")
+        request (ring-mock/request :head "/")
         response @(h request)
         headers (:headers response)]
 
@@ -22,3 +22,19 @@
     (is (nil? (get headers "content-length"))) ; see rfc7231.html#section-3.3
 
     (is (nil? (:body response)))))
+
+(deftest head-content-type-not-unacceptable-test []
+  (let [h (handler (merge (as-resource "Hello World!")
+                          {:produces {:media-type "text/plain"
+                                      :charset "UTF-8"}}))
+        request (-> (ring-mock/request :head "/")
+                    (ring-mock/header :accept "text/foo"))
+        response @(h request)
+        headers (:headers response)]
+
+    (is (= 406 (:status response)))
+    (is (nil? (get headers "content-type")))
+
+    (is (nil? (get headers "content-length"))) ; see rfc7231.html#section-3.3
+
+    (is (nil? (:body response)))))