Skip to content

Commit

Permalink
Create branch with implementation wich uses decorators
Browse files Browse the repository at this point in the history
  • Loading branch information
Philipp Meier committed Nov 11, 2009
1 parent 36f92d2 commit ef70c6f
Show file tree
Hide file tree
Showing 3 changed files with 132 additions and 173 deletions.
38 changes: 21 additions & 17 deletions README.markdown
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
Compojure-rest is a thin layer for building RESTful applications on top
of compojure. It is loosely modeled after webmachine. Every resource is
represented by a bunch of functions.
of compojure. It is loosely modeled after webmachine.
It provides a bunch of decorates which can be combined to provide a
sophisticated implementation of the HTTP RFC.

Compojure-rest is still in active development and must be considered an
incomplete ALPHA release
Expand All @@ -14,25 +15,28 @@ A small example web application as in test.clj
(:use compojure)
(:use compojure-rest))

(defn hello-resource []
(compojure-rest/make-handler {
:get (fn [req] (str "Hello " ((req :route-params {}) :who "unknown foreigner")))
:generate-etag (fn [req] ((req :route-params) :who))
:expires (constantly 10000) ; expire in 10 sec
:last-modified (constantly -10000) ; last modified 10 sec ago
:authorized? (fn [req] (not (= "tiger" ((req :route-params {}) :who))))
:allowed? (fn [req] (not (= "scott" ((req :route-params {}) :who))))
}))

(defn hello-resource [request]
((-> (method-not-allowed)
(wrap-generate-body (fn [r] (str "Hello " ((request :params) :who "stranger"))))
(wrap-etag (comp :who :params))
(wrap-expiry (constantly 10000))
(wrap-last-modified -1000)
(wrap-exists (comp not #(some #{%} ["cat"]) :who :params))
(wrap-auth (comp not #(some #{%} ["evil"]) :who :params))
(wrap-allow (comp not #(some #{%} ["scott"]) :who :params)))
request))

(defroutes my-app
(ANY "/hello/:who" (hello-resource))
(ANY "/simple/" (compojure-rest/make-handler { :get (fn [req] "Simple") }))
(ANY "*" (page-not-found)))
(ANY "/hello/:who" hello-resource)
(GET "/simple" (str "simple"))
(GET "/echo/:foo" (fn [req] {:headers { "Content-Type" "text/plain" } :body (str (dissoc req :servlet-request))}))
(GET "*" (page-not-found)))

(defn main []
(do
(defserver test-server {:port 8080} "/*" (servlet my-app))
(start test-server)))

(run-server {:port 8080}
"/*" (servlet my-app))

Dependencies
------------
Expand Down
236 changes: 95 additions & 141 deletions src/main/clojure/compojure_rest.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,151 +7,105 @@
;; this software.

(ns compojure-rest
(:use compojure))

(declare handle-allowed handle-accept handle-authorized handle-exists create-response
handle-if-match handle-if-none-match)

(def -const-nil (constantly nil))

(def default-resource-functions
{
:valid-method (fn [req]
(let [functions (req ::functions)]
(contains? functions (req :request-method))))
:head -const-nil
:generate-etag -const-nil
:last-modified -const-nil
:expires -const-nil
:allowed? (constantly true)
:authorized? (constantly true)
:content-type-provided #(some #{((% :headers) "accept")} ["text/html" "*/*"])
:exists? (constantly true)
})

;; returns a 2-vector [result new-request]
;; vector-or-f-or-result if a function may return result or [result req']
;; vector-or-f-or-result may be result (single value)
;; vector-or-f-or-result may be 2-vector
(defn with-request [req vector-or-f-or-result]
(let [vector-or-result (if (fn? vector-or-f-or-result)
(vector-or-f-or-result req)
vector-or-f-or-result)
vector (if (sequential? vector-or-result)
vector-or-result
[vector-or-result req])]
(do
(if false (println (str "REQ is " vector)))
vector)))

(defn filter-nil-values [m]
(into {} (filter (fn [[_ v]] (not (nil? v))) m)))
(:use compojure)
(:use clojure.contrib.core)
(:import java.util.Date)
(:import java.lang.System)
(:import java.util.Locale)
(:import java.text.SimpleDateFormat))


(defn evaluate-generate [function-or-value request]
(if (fn? function-or-value)
(function-or-value request)
function-or-value))

(def *http-date-format*
(new java.text.SimpleDateFormat
"EEE, dd MMM yyyy HH:mm:ss Z"
java.util.Locale/US))
(new SimpleDateFormat
"EEE, dd MMM yyyy HH:mm:ss Z"
Locale/US))

(defn http-date [int-or-date]
(if-let [date (if (integer? int-or-date)
(new java.util.Date (+ int-or-date (java.lang.System/currentTimeMillis)))
int-or-date)]
(new Date (+ int-or-date (System/currentTimeMillis)))
int-or-date)]
(.format *http-date-format* date)))

;; todo use cl-conneg instead of "contains"
(defn negotiate-content-type [string-or-fn req]
(if (fn? string-or-fn)
(string-or-fn req)
(let [accept ((req :headers) "accept" "text/html")]
(if (and (not (nil? accept)) (.contains accept string-or-fn))
string-or-fn))))

(defn handle-request [req]
(let [functions (req ::functions)
valid-method (functions :valid-method)
[valid req] (with-request req valid-method)]
(if-not valid
[501 "Not implemented"]
(handle-accept req))))

(defn handle-accept [req]
(let [c-t-p (-> req ::functions :content-type-provided)
[negotiated-type req] (with-request req (partial negotiate-content-type c-t-p))
req (assoc req :negotiated-type negotiated-type)]
(if negotiated-type
(handle-authorized req)
[415 "Unsupported media type"])))


(defn handle-authorized [req]
(let [f-authorized? (-> req ::functions :authorized?)
[authorized req]
(with-request req f-authorized?)]
(if authorized
(handle-allowed req)
[401 "Unauthorized"])))

(defn handle-allowed [req]
(let [[allowed req] (with-request req (-> req ::functions :allowed?))]
(if allowed
(handle-exists req)
[403 "Forbidden"])))

(defn handle-exists [req]
(let [[exists req] (with-request req (-> req ::functions :exists?))]
(if exists
(handle-if-match req)
[404 "Not found"])))

(defn handle-if-match [req]
(let [h-if-match ((req :headers) "if-match")]
(if (or (= h-if-match "*") (nil? h-if-match))
(handle-if-none-match req)
(let [gen-etag (-> req ::functions :generate-etag)
[etag req] (with-request req gen-etag)]
(if (= h-if-match etag)
(handle-if-none-match req)
[412 "precondition failed"])))))

(defn handle-if-none-match [req]
(let [h-if-none-match ((req :headers) "if-none-match")
gen-etag (-> req ::functions :generate-etag)
[etag req] (with-request req gen-etag)]
(if (or (nil? h-if-none-match)
(and (not (= h-if-none-match "*"))
(not (= h-if-none-match etag))))
(create-response req)
(if (some #{(req :request-method)} [:get :head])
[304 "not modified"]
[412 "precondition failed"]))))

(defn create-response [req]
(do
(let [functions (req ::functions)]
(let [
expires (functions :expires)
last-modified (functions :last-modified)
gen-etag (functions :generate-etag)
method (req :request-method)
handler (functions method)
[etag req] (with-request req gen-etag)
[body req] (with-request req handler)
[h-expires req] (with-request req expires)
[h-last-modified req] (with-request req last-modified)
resp-headers (filter-nil-values
{ "Content-Type" (req :negotiated-type)
"Expires" (http-date h-expires)
"Last-Modified" (http-date h-last-modified)
"ETag" etag
})
]
{
:status 200
:headers resp-headers
:body body
}))))

(defn make-handler [functions]
(fn [req]
(let [functions-with-defaults (merge default-resource-functions functions)]
(handle-request (assoc req ::functions functions-with-defaults)))))
(defn wrap-header [handler header generate-header]
(fn [request]
(let [value (evaluate-generate generate-header request)
response (handler request)]
(assoc-in response [:headers header] (str value)))))

(defn wrap-if-match [handler gen-etag]
(fn [request]
(let [if-match (-?> request :headers (get "if-match"))]
(if (or (= if-match "*") (nil? if-match))
(handler request)
(let [etag (gen-etag request)]
(if (= if-match etag)
(handler (assoc-in request [::rest :etag] etag))
{:status 412 :body "precondition failed"}))))))

(defn wrap-if-none-match [handler gen-etag]
(fn [request]
(let [if-none-match (-?> request :headers (get "if-none-match"))]
(if (or (nil? if-none-match)
(and (not (= if-none-match "*"))
(not (= if-none-match (gen-etag request)))))
(handler request)
(if (some #{(request :request-method)} [:get :head])
{:status 304 }
{:status 412 :body "precondition failed"})))))

(defn wrap-generate-etag [handler generate-etag]
(fn [request]
(let [etag (or (-?> request ::rest :etag) (generate-etag request))]
((wrap-header handler "Etag" etag) request))))

(defn wrap-expiry [handler generate-expires]
(wrap-header handler "Expires"
#(http-date (evaluate-generate generate-expires %))))

(defn wrap-last-modified [handler generate-last-modified]
(wrap-header handler "Last-Modified"
#(http-date (evaluate-generate generate-last-modified %))))

(defn wrap-exists [handler exists-function]
(fn [request]
(if (exists-function request)
(handler request)
{:status 404 :body "not found"})))

(defn wrap-auth [handler auth-function]
(fn [request]
(if (auth-function request)
(handler request)
{:status 401 :body "unauthorized"})))

(defn wrap-allow [handler allow-function]
(fn [request]
(if (allow-function request)
(handler request)
{:status 403 :body "forbidden"})))

(defn wrap-generate-body [handler generate-body-function-or-val]
(fn [request]
(if (match-method :get request)
(compojure.http.response/create-response
request
(if (fn? generate-body-function-or-val)
(generate-body-function-or-val request)
generate-body-function-or-val))
(handler request))))

(defn wrap-etag [handler generate-etag]
(-> handler
(wrap-if-match generate-etag)
(wrap-if-none-match generate-etag)
(wrap-generate-etag generate-etag)))

(defn method-not-allowed []
(fn [request]
(compojure.http.response/create-response
request {:status 405 :body "method not allowed"})))
31 changes: 16 additions & 15 deletions src/test/clojure/test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,25 +10,26 @@
(:use compojure)
(:use compojure-rest))

(defn hello-resource []
(compojure-rest/make-handler
{
:get (fn [req] (str "Hello " ((req :route-params {}) :who "unknown foreigner")))
:generate-etag (fn [req] ((req :route-params) :who))
:expires (constantly 10000) ; expire in 10 sec
:last-modified (constantly -10000) ; last modified 10 sec ago
:authorized? (fn [req] (not (= "tiger" ((req :route-params {}) :who))))
:allowed? (fn [req] (not (= "scott" ((req :route-params {}) :who))))
:exists? #(not (= "cat" ((% :route-params {}) :who)))
}))

(defn hello-resource [request]
((-> (method-not-allowed)
(wrap-generate-body (fn [r] (str "Hello " ((request :params) :who "stranger"))))
(wrap-etag (comp :who :params))
(wrap-expiry (constantly 10000))
(wrap-last-modified -1000)
(wrap-exists (comp not #(some #{%} ["cat"]) :who :params))
(wrap-auth (comp not #(some #{%} ["evil"]) :who :params))
(wrap-allow (comp not #(some #{%} ["scott"]) :who :params)))
request))

(defroutes my-app
(ANY "/hello/:who" (hello-resource))
(ANY "/simple/" (compojure-rest/make-handler { :get (fn [req] "Simple") }))
(ANY "*" (page-not-found)))
(ANY "/hello/:who" hello-resource)
(GET "/simple" (str "simple"))
(GET "/echo/:foo" (fn [req] {:headers { "Content-Type" "text/plain" } :body (str (dissoc req :servlet-request))}))
(GET "*" (page-not-found)))

(defn main []
(do
(defserver test-server {:port 8080} "/*" (servlet my-app))
(start test-server)))


0 comments on commit ef70c6f

Please sign in to comment.