Add async support to wrap-absolute-redirects

Author: weavejester

src/ring/middleware/absolute_redirects.clj

@@ -28,14 +28,22 @@
     (let [url (URL. (req/request-url request))]
       (str (URL. url location)))))
 
+(defn absolute-redirects-response
+  "Convert a response that redirects to a relative URLs into a response that
+  redirects to an absolute URL. See: wrap-absolute-redirects."
+  [response request]
+  (if (redirect? response)
+    (update-header response "location" absolute-url request)
+    response))
+
 (defn wrap-absolute-redirects
   "Middleware that converts redirects to relative URLs into redirects to
   absolute URLs. While many browsers can handle relative URLs in the Location
   header, RFC 2616 states that the Location header must contain an absolute
   URL."
   [handler]
-  (fn [request]
-    (let [response (handler request)]
-      (if (redirect? response)
-        (update-header response "location" absolute-url request)
-        response))))
+  (fn
+    ([request]
+     (absolute-redirects-response (handler request) request))
+    ([request respond raise]
+     (handler request #(respond (absolute-redirects-response % request)) raise))))

test/ring/middleware/absolute_redirects_test.clj

@@ -43,3 +43,33 @@
           resp    (handler (request :post "/bar"))]
       (is (= (:status resp) 201))
       (is (= (:headers resp) {"Location" "http://localhost/bar/1"})))))
+
+(deftest test-wrap-absolute-redirects-cps
+  (testing "relative redirects"
+    (let [handler (wrap-absolute-redirects (fn [_ respond _] (respond (redirect "/foo"))))
+          resp    (promise)
+          ex      (promise)]
+      (handler (request :get "/") resp ex)
+      (is (not (realized? ex)))
+      (is (= (:status @resp) 302))
+      (is (= (:headers @resp) {"Location" "http://localhost/foo"}))))
+
+  (testing "absolute redirects"
+    (let [handler (wrap-absolute-redirects
+                   (fn [_ respond _] (respond (redirect "http://example.com"))))
+          resp    (promise)
+          ex      (promise)]
+      (handler (request :get "/") resp ex)
+      (is (not (realized? ex)))
+      (is (= (:status @resp) 302))
+      (is (= (:headers @resp) {"Location" "http://example.com"}))))
+
+  (testing "no redirects"
+    (let [handler (wrap-absolute-redirects (fn [_ respond _] (respond (response "hello"))))
+          resp    (promise)
+          ex      (promise)]
+      (handler (request :get "/bar/baz.html") resp ex)
+      (is (not (realized? ex)))
+      (is (= (:status @resp) 200))
+      (is (= (:headers @resp) {}))
+      (is (= (:body @resp) "hello")))))