Fix Response Status Code for Failing JSON Emits

modules/rest-util/src/blaze/middleware/fhir/output.clj

@@ -13,7 +13,8 @@
    [muuntaja.parse :as parse]
    [prometheus.alpha :as prom]
    [ring.util.response :as ring]
-   [taoensso.timbre :as log])
+   [taoensso.timbre :as log]
+   [jsonista.core :as j])
   (:import
    [java.io ByteArrayOutputStream]))
 
@@ -27,34 +28,102 @@
 
 (def ^:private parse-accept (parse/fast-memoize 1000 parse/parse-accept))
 
-(defn- generate-json [body]
+(defn- e->byte-array [e byte-array-fn]
+  (-> e
+      ba/anomaly
+      handler-util/operation-outcome
+      byte-array-fn))
+
+(defn- generate-json** [body]
+  (fhir-spec/unform-json body))
+
+
+(comment
+  (defn- parse-json [body]
+    (fhir-spec/conform-json (fhir-spec/parse-json body)))
+
+
+  (parse-json (generate-json** {:fhir/type :fhir/Patient :id "0"}))
+;; => {:fhir/type :fhir/Patient, :id "0"}
+  :end)
+
+(defn- generate-json* [response]
+  (try
+    (update response :body generate-json**)
+    (catch Throwable e
+      (update response :body (constantly (generate-json** (handler-util/operation-outcome (ba/anomaly e))))))))
+
+
+(comment
+  (def invalid-body {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"foo\u001Ebar"})
+  (def valid-body   {:fhir/type :fhir/Patient :id "0"})
+
+  (ring/response valid-body)
+  ;; => {:status 200, :headers {}, :body {:fhir/type :fhir/Patient, :id "0"}}
+
+  (def valid-resp (ring/response valid-body))
+
+  (ring/response invalid-body)
+  ;; => {:status 200, :headers {}, :body {:fhir/type :fhir/Patient, :id "0", :gender #fhir/code"foobar"}}
+
+  (def invalid-resp (ring/response invalid-body))
+
+  (generate-json* valid-resp)
+;; => {:status 200, :headers {}, :body #object["[B" 0x72aa21ba "[B@72aa21ba"]}
+  (-> valid-resp
+      generate-json*
+      parse-json)
+;; => {:cognitect.anomalies/category :cognitect.anomalies/incorrect, :cognitect.anomalies/message "Invalid JSON representation of a resource.", :x #:cognitect.anomalies{:category :cognitect.anomalies/incorrect, :message "No implementation of method: :-read-value of protocol: #'jsonista.core/ReadValue found for class: clojure.lang.PersistentArrayMap"}, :fhir/issues [#:fhir.issues{:severity "error", :code "value", :diagnostics "Given resource does not contain a `resourceType` property."}]}
+
+  (parse-json (j/write-value-as-string {:fhir/type :fhir/Patient :id "0"}))
+;; => {:cognitect.anomalies/category :cognitect.anomalies/incorrect, :cognitect.anomalies/message "Invalid JSON representation of a resource.", :x {:fhir/type "fhir/Patient", :id "0"}, :fhir/issues [#:fhir.issues{:severity "error", :code "value", :diagnostics "Given resource does not contain a `resourceType` property."}]}
+
+  :end)
+
+
+(defn- generate-json [response]
   (log/trace "generate JSON")
   (with-open [_ (prom/timer generate-duration-seconds "json")]
-    (fhir-spec/unform-json body)))
+    (generate-json* response)))
 
-(defn- generate-xml** [body]
+(defn- xml-byte-array [body]
   (let [out (ByteArrayOutputStream.)]
     (with-open [writer (io/writer out)]
       (xml/emit (fhir-spec/unform-xml body) writer))
     (.toByteArray out)))
 
-(defn- generate-xml* [body]
+
+(comment
+
+  (defn- parse-xml [body]
+    (with-open [reader (io/reader body)]
+      (fhir-spec/conform-xml (xml/parse reader))))
+
+  (parse-xml (xml-byte-array {:fhir/type :fhir/Patient :id "0"}))
+  ;; => {:id "0", :fhir/type :fhir/Patient}
+
+  :end)
+
+
+(defn- generate-xml* [response]
   (try
-    (generate-xml** body)
+    (update response :body xml-byte-array)
     (catch Throwable e
-      (generate-xml** (handler-util/operation-outcome (ba/anomaly e))))))
+      (assoc response
+             :body (e->byte-array e xml-byte-array)
+             :status 500))))
 
-(defn- generate-xml [body]
+(defn- generate-xml [response]
   (log/trace "generate XML")
   (with-open [_ (prom/timer generate-duration-seconds "xml")]
-    (generate-xml* body)))
+    (generate-xml* response)))
 
 (defn- encode-response-json [{:keys [body] :as response} content-type]
-  (cond-> response body (-> (update :body generate-json)
+  (cond-> response body (-> generate-json
                             (ring/content-type content-type))))
 
 (defn- encode-response-xml [{:keys [body] :as response} content-type]
-  (cond-> response body (-> (update :body generate-xml)
+  (cond-> response body (-> generate-xml
                             (ring/content-type content-type))))
 
 (defn- format-key [format]

modules/rest-util/test/blaze/middleware/fhir/output_test.clj

@@ -88,7 +88,14 @@
                     :query-params {"_format" format}})
         :status := 200
         [:headers "Content-Type"] := content-type
-        [:body parse-json] := {:fhir/type :fhir/Patient :id "0"}))))
+        [:body parse-json] := {:fhir/type :fhir/Patient :id "0"})))
+
+  (testing "invalid JSON"
+    (given (call (special-resource-handler {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"foo\u001Ebar"}) {:headers {"accept" "application/fhir+json"}})
+      :status := 500
+      [:headers "Content-Type"] := "application/fhir+json;charset=utf-8"
+      [:body parse-json :fhir/type] := :fhir/OperationOutcome
+      [:body parse-json :issue 0 :diagnostics] := "(I still need to find out what the correct diagnostic message looks like)")))
 
 (defn- parse-xml [body]
   (with-open [reader (io/reader body)]
@@ -136,9 +143,11 @@
       [:headers "Content-Type"] := nil
       :body := nil))
 
-  (testing "failing XML emit"
+  (testing "invalid XML"
     (given (call (special-resource-handler {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"foo\u001Ebar"}) {:headers {"accept" "application/fhir+xml"}})
+      :status := 500
       [:headers "Content-Type"] := "application/fhir+xml;charset=utf-8"
+      [:body parse-xml :fhir/type] := :fhir/OperationOutcome
       [:body parse-xml :issue 0 :diagnostics] := "Invalid white space character (0x1e) in text to output (in xml 1.1, could output as a character entity)")))
 
 (deftest not-acceptable-test