Skip to content

Commit

Permalink
Adds more tests to flow of post requests
Browse files Browse the repository at this point in the history 
* facts for can-post-to-missing?
* facts for redirections works for post requests
* midje checkers for NOT-FOUND
* logging of invoked handler
* drop initial "-" of functions and macros
* rename -defdecision to defdecision*
  • Loading branch information
@ordnungswidrig
ordnungswidrig committed Aug 28, 2012
1 parent be51828 commit d0e8c05
Show file tree
Hide file tree
Showing 3 changed files with 101 additions and 77 deletions.
119 changes: 61 additions & 58 deletions src/liberator/core.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,12 +75,12 @@
(defn request-method-in [& methods]
#(some #{(:request-method (:request %))} methods))

(defn -gen-etag [context]
(defn gen-etag [context]
(or (context ::etag)
(if-let [f ((:resource context) :etag)]
(format "\"%s\"" (f context)))))

(defn -gen-last-modified [context]
(defn gen-last-modified [context]
(or (::last-modified context)
(if-let [f (get-in context [:resource :last-modified])]
(as-date (f context)))))
Expand Down Expand Up @@ -111,16 +111,16 @@
{:status 500 :body (str "No handler found for key \"" name "\"."
" Keys defined for resource are " (keys resource))}))

(defn -defdecision
(defn defdecision*
[name test then else]
`(defn ~name [~'context]
(decide ~(keyword name) ~test ~then ~else ~'context)))

(defmacro defdecision
([name then else]
(-defdecision name nil then else))
(defdecision* name nil then else))
([name test then else]
(-defdecision name test then else)))
(defdecision* name test then else)))

(defmacro defaction [name next]
`(defdecision ~name ~next ~next))
Expand All @@ -143,51 +143,54 @@
{:keys [resource request representation] :as context}]
(let [context (assoc context :status status :message message)]
(if-let [handler (resource (keyword name))]
(merge-with
merge-map-element
(do
(log "Handler" (keyword name))
(merge-with
merge-map-element

;; Status
{:status status}
;; Status
{:status status}

;; ETags
(when-let [etag (-gen-etag context)]
{:headers {"ETag" etag}})
;; ETags
(when-let [etag (gen-etag context)]
{:headers {"ETag" etag}})

;; Last modified
(when-let [last-modified (-gen-last-modified context)]
{:headers {"Last-Modified" (http-date last-modified)}})
;; Last modified
(when-let [last-modified (gen-last-modified context)]
{:headers {"Last-Modified" (http-date last-modified)}})

;; Content negotiations
{:headers
(-> {}
(set-header-maybe "Content-Type"
(str (:media-type representation)
(when-let [charset (:charset representation)] (str ";charset=" charset))))
(set-header-maybe "Content-Language" (:language representation))
(set-header-maybe "Content-Encoding"
(let [e (:encoding representation)]
(if-not (= "identity" e) e)))
(set-header-maybe "Vary" (build-vary-header representation)))}

;; Finally the result of the handler. We allow the handler to
;; override the status and headers.
;;
;; The rules about who should take responsibility for encoding
;; the response are defined in the BodyResponse protocol.
(let [handler-response (handler context)
response (as-response handler-response context)]
;; We get an obscure 'cannot be cast to java.util.Map$Entry'
;; error if our BodyResponse function doesn't return a map,
;; so we check it now.
(when-not (or (map? response) (nil? response))
(throw (Exception. (format "%s as-response function did not return a map (or nil) for instance of %s"
'Representation (type handler-response)))))
response))
;; Content negotiations
{:headers
(-> {}
(set-header-maybe "Content-Type"
(str (:media-type representation)
(when-let [charset (:charset representation)] (str ";charset=" charset))))
(set-header-maybe "Content-Language" (:language representation))
(set-header-maybe "Content-Encoding"
(let [e (:encoding representation)]
(if-not (= "identity" e) e)))
(set-header-maybe "Vary" (build-vary-header representation)))}

;; Finally the result of the handler. We allow the handler to
;; override the status and headers.
;;
;; The rules about who should take responsibility for encoding
;; the response are defined in the BodyResponse protocol.
(let [handler-response (handler context)
response (as-response handler-response context)]
;; We get an obscure 'cannot be cast to java.util.Map$Entry'
;; error if our BodyResponse function doesn't return a map,
;; so we check it now.
(when-not (or (map? response) (nil? response))
(throw (Exception. (format "%s as-response function did not return a map (or nil) for instance of %s"
'Representation (type handler-response)))))
response)))

;; If there is no handler we just return the information we have so far.
{:status status
:headers {"Content-Type" "text/plain"}
:body message})))
(do (log "Handler (default)" (keyword name))
{:status status
:headers {"Content-Type" "text/plain"}
:body message}))))

(defmacro ^:private defhandler [name status message]
`(defn ~name [context#]
Expand All @@ -196,7 +199,7 @@
(defn header-exists? [header context]
(contains? (:headers (:request context)) header))

(defn -if-match-star [context]
(defn if-match-star [context]
(= "*" ((:headers (:request context)) "if-match")))

(defn =method [method context]
Expand All @@ -218,7 +221,7 @@

;; Provide :see-other which returns a location or override :handle-see-other
(defn handle-see-other [{:keys [resource request] :as context}]
(-handle-moved :see-other 303 context))
(handle-moved :see-other 303 context))

(defhandler handle-ok 200 "OK")

Expand Down Expand Up @@ -248,10 +251,10 @@
can-post-to-missing? handle-not-found)

(defn handle-moved-permamently [context]
(-handle-moved :moved-permanently 301 context))
(handle-moved :moved-permanently 301 context))

(defn handle-moved-temporarily [context]
(-handle-moved :moved-temporarily 307 context))
(handle-moved :moved-temporarily 307 context))

(defdecision ^{:step :N5} can-post-to-gone? post! handle-gone)

Expand All @@ -276,7 +279,7 @@
(defhandler handle-precondition-failed 412 "Precondition failed.")

(defdecision if-match-star-exists-for-missing?
-if-match-star
if-match-star
handle-precondition-failed
method-put?)

Expand Down Expand Up @@ -305,7 +308,7 @@
post-to-existing?)

(defn modified-since? [context]
(let [last-modified (-gen-last-modified context)]
(let [last-modified (gen-last-modified context)]
(decide :modified-since?
(fn [context] (and last-modified
(.after last-modified
Expand All @@ -328,7 +331,7 @@
method-delete?)

(defn ^{:step :K13} etag-matches-for-if-none? [context]
(let [etag (-gen-etag context)]
(let [etag (gen-etag context)]
(decide :etag-matches-for-if-none?
#(= (get-in % [:request :headers "if-none-match"]) etag)
if-none-match
Expand All @@ -344,7 +347,7 @@
if-none-match-star? if-modified-since-exists?)

(defn ^{:step :H12} unmodified-since? [context]
(let [last-modified (-gen-last-modified context)]
(let [last-modified (gen-last-modified context)]
(decide :unmodified-since?
(fn [context] (and last-modified
(.after last-modified
Expand All @@ -365,7 +368,7 @@
if-unmodified-since-valid-date? if-none-match-exists?)

(defn ^{:step :G11} etag-matches-for-if-match? [context]
(let [etag (-gen-etag context)]
(let [etag (gen-etag context)]
(decide
:etag-matches-for-if-match?
#(= ((% :headers) "if-match") etag)
Expand All @@ -374,7 +377,7 @@
(assoc context ::etag etag))))

(defdecision ^{:step :G9} if-match-star?
-if-match-star if-unmodified-since-exists? etag-matches-for-if-match?)
if-match-star if-unmodified-since-exists? etag-matches-for-if-match?)

(defdecision ^{:step :G8} if-match-exists? (partial header-exists? "if-match")
if-match-star? if-unmodified-since-exists?)
Expand Down Expand Up @@ -527,7 +530,7 @@
:available-encodings ["identity"]})

;; resources are a map of implementation methods
(defn -resource [request kvs]
(defn run-resource [request kvs]
(try
(service-available? {:request request
:resource
Expand All @@ -541,17 +544,17 @@
::throwable e}))) ; ::throwable gets picked up by an error renderer

(defn resource [& kvs]
(fn [request] (-resource request (apply hash-map kvs))))
(fn [request] (run-resource request (apply hash-map kvs))))

(defmacro defresource [name & kvs]
(if (vector? (first kvs))
(let [args (first kvs)
kvs (rest kvs)]
`(defn ~name [~@args]
(fn [request#]
(-resource request# ~(apply hash-map kvs)))))
(run-resource request# ~(apply hash-map kvs)))))
`(defn ~name [request#]
(-resource request# ~(apply hash-map kvs)))))
(run-resource request# ~(apply hash-map kvs)))))

(defn wrap-trace-as-response-header [handler]
(fn [request]
Expand Down
1 change: 1 addition & 0 deletions test/checkers.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@
(fn [actual]
(fact actual => (is-status 303))
(fact actual => (header-value "Location" location))))
(def NOT-FOUND (is-status 404))


(defchecker all [& checkers]
Expand Down
58 changes: 39 additions & 19 deletions test/test_flow.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,24 +4,44 @@
checkers
[ring.mock.request :only [request header]]))

(def r-post-to-existing
(resource :method-allowed? (request-method-in :post)
:exists? true
:handle-created "OK"))
(with-console-logger
(let [resp (-> (request :post "/")
(r-post-to-existing))]
(fact resp => CREATED)
(fact resp => (body "OK"))))


(with-console-logger
(let [r (resource :method-allowed? (request-method-in :post)
(let [r (resource :method-allowed? (request-method-in :post)
:exists? true
:post-redirect? true
:handle-created "OK"
:new? false?
:see-other "http://example.com/foo")
resp (r (request :post "/")) ]
(fact resp => (SEE-OTHER "http://example.com/foo"))))
:handle-created "Created")
resp (r(request :post "/"))]
(fact "Post to existing" resp => CREATED)
(fact resp => (body "Created")))


(let [r (resource :method-allowed? (request-method-in :post)
:exists? true
:post-redirect? true
:see-other "http://example.com/foo")
resp (r (request :post "/")) ]
(fact "Post to existing resource and redirect" resp => (SEE-OTHER "http://example.com/foo")))

(let [r (resource :method-allowed? (request-method-in :post)
:exists? false
:post-redirect? true
:can-post-to-missing? true
:see-other "http://example.com/foo")
resp (r (request :post "/")) ]
(fact "Post to missing can redirect" resp => (SEE-OTHER "http://example.com/foo")))

(let [r (resource :method-allowed? (request-method-in :post)
:exists? false
:can-post-to-missing? true)
resp (r (request :post "/")) ]
(fact "Post to missing if post to missing is allowed" resp => CREATED))

(let [r (resource :method-allowed? (request-method-in :post)
:exists? false
:can-post-to-missing? false)
resp (r (request :post "/")) ]
(fact "Post to missing can give 404" resp => NOT-FOUND))

(let [r (resource :method-allowed? (request-method-in :post)
:exists? true
:can-post-to-missing? false)
resp (r (request :post "/")) ]
(fact "Post to existing if post to missing forbidden is allowed" resp => CREATED))

0 comments on commit d0e8c05

Please sign in to comment.