Add multimethod for entity parsing

Parse json request entity by default

USe :require instead of :use

Use qualified var for clarity

Use uniform reference to mock fns

Inline checkable atom into fact

Remove media-type parameters for dispatching

Consider charset

Remove superfluous delimiter

Use some-> instead of m-bind

Revert to Clojure 1.4 compatible solution

Use ISO-8859-1 as default encoding

Add convenience fn for checking if content can be parsed

Add test with missing content-type

Do not change default implementation

Move entity parsing to representation ns

Add description for parse-request-entity

CHANGES.markdown

@@ -5,6 +5,8 @@
 * Values can be added to the context at the beginning of the execution
   flow using the :initialize-context action.
 
+* JSON body can be parsed into :request-entity by setting representation/parse-request-entity for :processable?
+
 ## Bugs fixed
 
 * Support multimethods as decision functions.

src/liberator/representation.clj

@@ -2,6 +2,7 @@
   (:require
    [clojure.data.json :as json]
    [clojure.data.csv :as csv]
+   [clojure.string :refer [split trim]]
    [liberator.util :as util]
    [hiccup.core :refer [html]]
    [hiccup.page :refer [html5 xhtml]]))
@@ -27,9 +28,9 @@
     (str k)))
 
 (defn html-table [data fields lang dictionary]
-  [:div [:table 
+  [:div [:table
          [:thead
-          [:tr 
+          [:tr
            (for [field fields] [:th (or (dictionary field lang)
                                         (default-dictionary field lang))])]]
          [:tbody (for [row data]
@@ -85,7 +86,7 @@
     :keys [dictionary fields] :or {dictionary default-dictionary}
     :as context} mode]
   (let [content
-        [:div [:table 
+        [:div [:table
 
                [:tbody (for [[key value] data]
                          [:tr
@@ -175,7 +176,7 @@
   (if (and charset (not (.equalsIgnoreCase charset "UTF-8")))
     (java.io.ByteArrayInputStream.
      (.getBytes string (java.nio.charset.Charset/forName charset)))
-      
+
     ;; "If no Accept-Charset header is present, the default is that
     ;; any character set is acceptable." (p101). In the case of Strings, it is unnecessary to convert to a byte stream now, and doing so might even make things harder for test-suites, so we just return the string.
     string))
@@ -208,11 +209,11 @@
       {:body
        (in-charset this charset)
        :headers {"Content-Type" (format "%s;charset=%s" (get representation :media-type "text/plain") charset)}}))
-  
+
   ;; If an input-stream is returned, we have no way of telling whether it's been encoded properly (charset and encoding), so we have to assume it is, given that we told the developer what representation was negotiated.
   java.io.File
   (as-response [this _] {:body this})
-  
+
   ;; We assume the input stream is already in the requested
   ;; charset. Decoding and encoding an existing charset unnecessarily
   ;; would be expensive.
@@ -260,6 +261,37 @@
   ([ring-response-map] (ring-response nil ring-response-map))
   ([value ring-response-map] (->RingResponse ring-response-map value)))
 
+(defn- content-type [ctx]
+  (get-in ctx [:request :headers "content-type"]))
+
+(defn- encoding [ctx]
+  (or
+   (second (flatten (re-seq #"charset=([^;]+)" (content-type ctx))))
+   "ISO-8859-1"))
+
+(defmulti parse-request-entity
+  (fn [ctx]
+    (when-let [media-type (content-type ctx)]
+      (-> media-type
+          (split #"\s*;\s*")
+          first))))
+
+(defmethod parse-request-entity "application/json" [ctx]
+  (if-let [body (:body (:request ctx))]
+    {:request-entity (json/read-str (slurp body :encoding (encoding ctx)) :key-fn keyword)}
+    true))
+
+(defmethod parse-request-entity :default [ctx]
+  (if-let [body (:body (:request ctx))]
+    {:request-entity body}
+    true))
+
+(defn parsable-content-type?
+  "Tells if the request has a content-type that can be parsed by
+  the default implementation for :processable?"
+  [ctx]
+  (contains? (methods parse-request-entity) (content-type ctx)))
+
 ;; Copyright (c) Philipp Meier ([email protected]). All rights reserved.
 ;; The use and distribution terms for this software are covered by the Eclipse
 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which

test/test_representation.clj

@@ -1,6 +1,10 @@
 (ns test-representation
   (:require [midje.sweet :refer :all]
-            [liberator.representation :refer :all]))
+            [liberator.representation :refer :all]
+            [liberator.core :refer :all]
+            [checkers :refer :all]
+            [ring.mock.request :as mock]
+            [clojure.data.json :as json]))
 
 ;; test for issue #19
 ;; https://github.com/clojure-liberator/liberator/pull/19
@@ -49,7 +53,7 @@
 
 (facts "Can give ring response map to override response values"
    (facts "returns single ring response unchanged"
-     (let [response {:status 123 
+     (let [response {:status 123
                      :headers {"Content-Type" "application/json;charset=UTF-8"
                                "X-Foo" "Bar"}
                      :body "123" }]
@@ -77,3 +81,61 @@
                {:status 200})
              => (contains {:headers {"X-Foo" "bar"
                                      "Content-Type" "text/plain;charset=UTF-8"}})))))
+(facts "about entity parsing"
+
+  (fact "it parses a json entity"
+    (let [request-entity (atom nil)
+          r (resource :allowed-methods [:post]
+                      :handle-created (fn [ctx] (reset! request-entity (:request-entity ctx)) "created")
+                      :processable? parse-request-entity)
+          resp (r (-> (mock/request :post "/" )
+                      (mock/body (json/write-str {:foo "bar"}))
+                      (mock/content-type "application/json")))]
+      resp => (is-status 201)
+      @request-entity => {:foo "bar"}))
+
+  (fact "it parses a json entity when media-type parameters are present"
+    (let [request-entity (atom nil)
+          r (resource :allowed-methods [:post]
+                      :handle-created (fn [ctx] (reset! request-entity (:request-entity ctx)) "created")
+                      :processable? parse-request-entity)
+          resp (r (-> (mock/request :post "/" )
+                      (mock/body (json/write-str {:foo "bar"}))
+                      (mock/content-type "application/json;charset=iso8859-15;profile=x-vnd-foo")))]
+      resp => (is-status 201)
+      @request-entity => {:foo "bar"}))
+
+  (fact "it parses a json entity with UTF-8"
+    (let [request-entity (atom nil)
+          r (resource :allowed-methods [:post]
+                      :handle-created (fn [ctx] (reset! request-entity (:request-entity ctx)) "created")
+                      :processable? parse-request-entity)
+          resp (r (-> (mock/request :post "/" )
+                      (mock/body "{\"foo\": \"ɦ\"}")
+                      (mock/content-type "application/json;charset=utf-8")))]
+      resp => (is-status 201)
+      @request-entity => {:foo "ɦ"}))
+
+  (fact "it parses a json entity with US-ASCII"
+    (let [request-entity (atom nil)
+          r (resource :allowed-methods [:post]
+                      :handle-created (fn [ctx] (reset! request-entity (:request-entity ctx)) "created")
+                      :processable? parse-request-entity)
+          resp (r (-> (mock/request :post "/" )
+                      (mock/body "{\"foo\": \"ɦ\"}")
+                      (mock/content-type "application/json;charset=us-ascii")))]
+      resp => (is-status 201)
+      @request-entity => {:foo "��"}))
+
+  (fact "it can cope with missing content-type"
+    (let [r (resource :allowed-methods [:post]
+                      :processable? parse-request-entity)
+          resp (r (-> (mock/request :post "/" )
+                      (mock/body "{\"foo\": \"bar\"}")))]
+      resp => (is-status 201)))
+
+  (fact "it can parse json"
+    (parsable-content-type? {:request {:headers {"content-type" "application/json"}}}) => true)
+
+  (fact "it cannot parse exotic content"
+    (parsable-content-type? {:request {:headers {"content-type" "foobar/foo"}}}) => false))