From d655d63a8db1ecc3c59856d8f3717fbec70d553b Mon Sep 17 00:00:00 2001
From: Leandro Doctors <leandro.doctors@dkfz-heidelberg.de>
Date: Fri, 25 Oct 2024 16:11:15 +0200
Subject: [PATCH] fix: "invalid XML" logic

Update both the request body and status in case of errors, not just the
body.
---
 .../src/blaze/middleware/fhir/output.clj      | 22 +++++++++++++------
 .../blaze/middleware/fhir/output_test.clj     |  4 +++-
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/modules/rest-util/src/blaze/middleware/fhir/output.clj b/modules/rest-util/src/blaze/middleware/fhir/output.clj
index 4d5217b10..109e73380 100644
--- a/modules/rest-util/src/blaze/middleware/fhir/output.clj
+++ b/modules/rest-util/src/blaze/middleware/fhir/output.clj
@@ -32,29 +32,37 @@
   (with-open [_ (prom/timer generate-duration-seconds "json")]
     (fhir-spec/unform-json body)))
 
-(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]
+(defn- e->xml-byte-array [e]
+  (-> e
+      ba/anomaly
+      handler-util/operation-outcome
+      xml-byte-array))
+
+(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->xml-byte-array e)
+             :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)
                             (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]
diff --git a/modules/rest-util/test/blaze/middleware/fhir/output_test.clj b/modules/rest-util/test/blaze/middleware/fhir/output_test.clj
index beddb78c2..fd8e8962c 100644
--- a/modules/rest-util/test/blaze/middleware/fhir/output_test.clj
+++ b/modules/rest-util/test/blaze/middleware/fhir/output_test.clj
@@ -136,9 +136,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