Fix "failing XML emit" logic

Update both the request body and status in case of errors, not just the
body.

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

@@ -38,23 +38,31 @@
       (xml/emit (fhir-spec/unform-xml body) writer))
     (.toByteArray out)))
 
-(defn- generate-xml* [body]
+(defn- generate-xml-error [e]
+  (-> e
+      ba/anomaly
+      handler-util/operation-outcome
+      generate-xml**))
+
+(defn- generate-xml* [response]
   (try
-    (generate-xml** body)
+    (update response :body generate-xml**)
     (catch Throwable e
-      (generate-xml** (handler-util/operation-outcome (ba/anomaly e))))))
+      (assoc response
+             :body (generate-xml-error 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]

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

@@ -138,7 +138,9 @@
 
   (testing "failing XML emit"
     (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