implement binary decoding middleware (WIP)

TODO: Find the right place to add the `:fhir.binary/Binary`
spec.

modules/fhir-structure/src/blaze/fhir/spec.clj

@@ -15,6 +15,7 @@
    [com.fasterxml.jackson.core JsonFactory StreamReadConstraints]
    [com.fasterxml.jackson.databind DeserializationFeature ObjectMapper]
    [com.fasterxml.jackson.dataformat.cbor CBORFactory]
+   [java.util Base64]
    [java.util.regex Pattern]))
 
 (set! *warn-on-reflection* true)
@@ -115,6 +116,14 @@
       (s2/unform spec resource)
       (throw (ex-info (format "Missing spec: %s" key) {:key key})))))
 
+(defn unform-binary
+  "Returns the binary representation of the base64-encoded `x` string."
+  [^String x]
+  (let [key (transform-type-key (type/type x) "binary")]
+    (if-let [spec (s2/get-spec key)]
+      (.decode (Base64/getDecoder) x)
+      (throw (ex-info (format "Missing spec: %s" key) {:key key :x x})))))
+
 (defn fhir-type
   "Returns the FHIR type of `x` as keyword with the namespace `fhir` or nil if
   `x` has no FHIR type."

modules/rest-api/src/blaze/rest_api/routes.clj

@@ -103,6 +103,8 @@
       {:fhir.resource/type name}
       [""
        (cond-> {:name (keyword name "type")}
+         (= name "Binary")
+         (assoc :response-type :binary)
          (contains? interactions :search-type)
          (assoc :get {:interaction "search-type"
                       :middleware [[wrap-db node db-sync-timeout]

modules/rest-api/src/blaze/rest_api/spec.clj

@@ -102,7 +102,7 @@
   boolean?)
 
 (s/def ::operation/response-type
-  #{:json})
+  #{:json :binary})
 
 (s/def ::operation/resource-types
   (s/coll-of string?))

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

@@ -49,6 +49,11 @@
   (with-open [_ (prom/timer generate-duration-seconds "xml")]
     (generate-xml* body)))
 
+(defn- generate-binary [body]
+  (log/trace "generate binary")
+  (with-open [_ (prom/timer generate-duration-seconds "binary")]
+    (fhir-spec/unform-binary body)))
+
 (defn- encode-response-json [{:keys [body] :as response} content-type]
   (cond-> response body (-> (update :body generate-json)
                             (ring/content-type content-type))))
@@ -57,6 +62,10 @@
   (cond-> response body (-> (update :body generate-xml)
                             (ring/content-type content-type))))
 
+(defn- encode-response-binary [{:keys [body] :as response} content-type]
+  (cond-> response body (-> (update :body generate-binary)
+                            (ring/content-type content-type))))
+
 (defn- format-key [format]
   (condp = format
     "application/fhir+json" :fhir+json
@@ -97,10 +106,16 @@
    (fn [request respond raise]
      (handler request #(respond (handle-response opts request %)) raise))))
 
+(defn handle-binary-response [opts request response]
+  (case (request-format request)
+    :fhir+json (encode-response-json response "application/fhir+json;charset=utf-8")
+    :fhir+xml (encode-response-xml response "application/fhir+xml;charset=utf-8")
+    (encode-response-binary response "text/plain;charset=utf-8")))
+
 (defn wrap-binary-output
   "Middleware to output binary resources."
   ([handler]
    (wrap-binary-output handler {}))
   ([handler opts]
    (fn [request respond raise]
-     (handler request #(respond (handle-response opts request %)) raise))))
+     (handler request #(respond (handle-binary-response opts request %)) raise))))