Browse files

Added 'validate-accept' processor with tests. Also 'process-get' make…

…s an

attempt to use the optimal content type found by the 'validate-accept'
processor which it installs in the request map at key :optimal-ct. If it is
not found, 'process-get' will call util/optimal-media-type itself.
  • Loading branch information...
1 parent b86ca9a commit d87aae652ba647201350ea813baa53bbb9c3b76c @tmciver committed Jan 31, 2013
Showing with 31 additions and 2 deletions.
  1. +15 −2 src/hottop/proc.clj
  2. +16 −0 test/hottop/test/proc.clj
17 src/hottop/proc.clj
@@ -1,7 +1,6 @@
(ns hottop.proc
(:require [clojure.string :as str]
[clojure.set :as set]
- [clojure.string :as str]
[hottop.util :as util]
[hottop.response :as response]
[ring.util.response :as ring]))
@@ -47,6 +46,19 @@ and resource arguments."
(handler request resource)
(response/code 401)))))
+(defn ^{:webmachine-node :c4} validate-accept
+ "Returns a hottop handler function that checks if the resource provides a
+content type acceptable to the client. This handler function returns a 406
+response if the resource does not provide one, otherwise the passed-in handler
+is called with the request and resource as arguments."
+ [handler]
+ (fn [request resource]
+ (if (get-in request [:headers "accept"])
+ (if-let [optimal-ct (util/optimal-media-type request resource)]
+ (handler (assoc request :optimal-ct optimal-ct) resource)
+ (response/code 406))
+ (handler request resource))))
(defn ^{:webmachine-node :b3} process-options
"If the request method is OPTIONS, creates a response whose :status is 200 and
whose \"Allow\" header is a string of comma-separated, upper-case HTTP
@@ -91,7 +103,8 @@ Note: this should be changed so that it uses a 'content-types-provided' function
that could be placed into the resource map by a previous function and only
attempt to calculate the optimal content type to use if said function has not
been used."
- (if-let [ct-desired (util/optimal-media-type request resource)]
+ (if-let [ct-desired (or (:optimal-ct request) ;; put in place by 'validate-accept'
+ (util/optimal-media-type request resource))]
(if-let [ct-fn (get-in resource [:content-types-provided ct-desired])]
(let [get-fn (get-in resource [:methods :get])
result (ct-fn (get-fn request))]
16 test/hottop/test/proc.clj
@@ -43,6 +43,22 @@
(is (= response1 :handler1))
(is (= 401 (:status response2)))))
+ (testing "Test Validate Accept"
+ (let [request1 (-> (request :get "/test")
+ (header "Accept" "text/html"))
+ request2 (-> (request :get "/test")
+ (header "Accept" "text/csv"))
+ resource1 (create-readonly-html-resource (constantly "hello!"))
+ resource2 (-> base-resource
+ (assoc-in [:methods :get] (constantly "hello."))
+ (assoc-in [:content-types-provided "text/csv"] identity))
+ response1 ((validate-accept (fn [r _] r)) request1 resource1)
+ response2 ((validate-accept (constantly :handler2)) request2 resource1)
+ response3 ((validate-accept (fn [r _] r)) request2 resource2)]
+ (is (= (:optimal-ct response1) "text/html"))
+ (is (= response2 (response/code 406)))
+ (is (= (:optimal-ct response3) "text/csv"))))
(testing "Process GET"
(let [request1 (-> (request :get "/test")
(header "Accept" "text/html"))

0 comments on commit d87aae6

Please sign in to comment.