Add middleware for x-forwarded-proto header

src/ring/middleware/proxy_headers.clj

@@ -20,3 +20,25 @@
      (handler (forwarded-remote-addr-request request)))
     ([request respond raise]
      (handler (forwarded-remote-addr-request request) respond raise))))
+
+(def ^:private valid-scheme? #{"http" "https" "ws" "wss"})
+
+(defn forwarded-scheme-request
+  "Change the :scheme key of the request map to the last value present in the
+  X-Forwarded-Proto header. See: wrap-forwarded-scheme."
+  [request]
+  (let [forwarded-proto (get-in request [:headers "x-forwarded-proto"])
+        scheme (some-> forwarded-proto str/lower-case str/trim)]
+    (if (and scheme (valid-scheme? forwarded-proto))
+      (assoc request :scheme (keyword scheme))
+      request)))
+
+(defn wrap-forwarded-scheme
+  "Middleware that changes the :scheme of the request map to the last value
+  present in the X-Forwarded-Proto header."
+  [handler]
+  (fn
+    ([request]
+     (handler (forwarded-scheme-request request)))
+    ([request respond raise]
+     (handler (forwarded-scheme-request request) respond raise))))

test/ring/middleware/proxy_headers_test.clj

@@ -45,3 +45,22 @@
         (handler req resp ex)
         (is (not (realized? ex)))
         (is (= (:body @resp) "1.2.3.4"))))))
+
+(deftest test-wrap-forwarded-proto
+  (let [handler (wrap-forwarded-scheme (comp response :scheme))]
+    (testing "without x-forwarded-proto"
+      (let [req (request :get "/")
+            resp (handler req)]
+        (is (= (:body resp) :http))))
+
+    (testing "with x-forwarded-proto"
+      (let [req (-> (request :get "/")
+                    (header  "x-forwarded-proto" "https"))
+            resp (handler req)]
+        (is (= (:body resp) :https))))
+
+    (testing "unknown schemes are ignored"
+      (let [req (->  (request :get "/")
+                     (header "x-forwarded-proto" "ftp"))
+            resp (handler req)]
+        (is (= (:body resp) :http))))))