Implement Binary Upload (Fixes #2126) - WIP

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

@@ -35,6 +35,10 @@
   {:name :auth-guard
    :wrap auth-guard/wrap-auth-guard})
 
+(def ^:private wrap-binary-resource
+  {:name :resource
+   :wrap resource/wrap-binary-resource})
+
 (def ^:private wrap-resource
   {:name :resource
    :wrap resource/wrap-resource})
@@ -103,6 +107,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]
@@ -111,7 +117,9 @@
                                    :blaze.rest-api.interaction/handler)})
          (contains? interactions :create)
          (assoc :post {:interaction "create"
-                       :middleware [wrap-resource]
+                       :middleware (if (:response-type :binary)
+                                     [wrap-binary-resource]
+                                     [wrap-resource])
                        :handler (-> interactions :create
                                     :blaze.rest-api.interaction/handler)})
          (contains? interactions :conditional-delete-type)
@@ -179,7 +187,9 @@
                                       :blaze.rest-api.interaction/handler)})
             (contains? interactions :update)
             (assoc :put {:interaction "update"
-                         :middleware [wrap-resource]
+                         :middleware (if (:response-type :binary)
+                                       [wrap-binary-resource]
+                                       [wrap-resource])
                          :handler (-> interactions :update
                                       :blaze.rest-api.interaction/handler)})
             (contains? interactions :delete)

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

@@ -16,6 +16,7 @@
    [ring.util.request :as request])
   (:import
    [com.ctc.wstx.api WstxInputProperties]
+   [java.io InputStream]
    [java.io Reader]
    [javax.xml.stream XMLInputFactory]))
 
@@ -48,10 +49,10 @@
      :fhir/issue "structure"
      :fhir/operation-outcome "MSG_JSON_OBJECT")))
 
-(defn- resource-request-json [{:keys [body] :as request}]
+(defn- resource-as-json [{:keys [body] :as request}]
   (if body
-    (when-ok [x (parse-json body)
-              resource (conform-json x)]
+    (when-ok [b (parse-json body)
+              resource (conform-json b)]
       (assoc request :body resource))
     (ba/incorrect "Missing HTTP body.")))
 
@@ -89,39 +90,74 @@
     ;; is lazy streaming. Otherwise, errors will be thrown outside this function.
     (ba/try-all ::anom/incorrect (fhir-spec/conform-xml (parse-xml reader)))))
 
-(defn- resource-request-xml [{:keys [body] :as request}]
+(defn- resource-as-xml [{:keys [body] :as request}]
   (if body
     (when-ok [resource (parse-and-conform-xml body)]
       (assoc request :body resource))
     (ba/incorrect "Missing HTTP body.")))
 
+(defn- get-binary-data [body]
+  (with-open [_ (prom/timer parse-duration-seconds "binary")
+              ^InputStream input body]
+    (slurp input)))
+
+(defn- resource-as-binary-data [{:keys [body] :as request}]
+  (if body
+    (when-ok [result (get-binary-data body)]
+      (assoc request :body result))
+    (ba/incorrect "Missing HTTP body.")))
+
 (defn- unsupported-media-type-msg [media-type]
   (format "Unsupported media type `%s` expect one of `application/fhir+json` or `application/fhir+xml`."
           media-type))
 
 (defn- resource-request [request]
   (if-let [content-type (request/content-type request)]
     (cond
-      (json-request? content-type) (resource-request-json request)
-      (xml-request? content-type) (resource-request-xml request)
+      (json-request? content-type) (resource-as-json request)
+      (xml-request? content-type) (resource-as-xml request)
       :else
       (ba/incorrect (unsupported-media-type-msg content-type)
                     :http/status 415))
     (if (str/blank? (slurp (:body request)))
       (assoc request :body nil)
-      (ba/incorrect "Content-Type header expected, but is missing."))))
+      (ba/incorrect "Expected Content-Type header for FHIR resources."))))
+
+(defn- binary-resource-request [request]
+  (if-let [content-type (request/content-type request)]
+    (cond
+      (json-request? content-type) (resource-as-json request)
+      (xml-request? content-type) (resource-as-xml request)
+      :else
+      (resource-as-binary-data request))
+    (ba/incorrect "Expected Content-Type header for binary resources.")))
 
 (defn wrap-resource
-  "Middleware to parse a resource from the body according the content-type
+  "Middleware to parse a FHIR resource from the body according the content-type
   header.
 
-  Updates the :body key in the request map on successful parsing and conforming
-  the resource to the internal format.
+  If the resource is successfully parsed and conformed to the internal format,
+  updates the :body key in the request map.
 
-  Returns an OperationOutcome in the internal format, skipping the handler, with
-  an appropriate error on parsing and conforming errors."
+  In case on errors, returns an OperationOutcome in the internal format with the
+  appropriate error and skips the handler."
   [handler]
   (fn [request]
     (if-ok [request (resource-request request)]
       (handler request)
       ac/completed-future)))
+
+(defn wrap-binary-data
+  "Middleware to parse binary data from the body according the content-type
+  header.
+
+  If the resource is successfully parsed and conformed to the internal format,
+  updates the :body key in the request map.
+
+  In case on errors, returns an OperationOutcome in the internal format with the
+  appropriate error and skips the handler."
+  [handler]
+  (fn [request]
+    (if-ok [request (binary-resource-request request)]
+      (handler request)
+      ac/completed-future)))

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

@@ -2,9 +2,10 @@
   (:require
    [blaze.async.comp :as ac]
    [blaze.fhir.spec :as fhir-spec]
+   [blaze.fhir.spec.type :as type]
    [blaze.fhir.test-util]
    [blaze.handler.util :as handler-util]
-   [blaze.middleware.fhir.resource :refer [wrap-resource]]
+   [blaze.middleware.fhir.resource :refer [wrap-binary-data wrap-resource]]
    [blaze.test-util :as tu :refer [satisfies-prop]]
    [clojure.spec.test.alpha :as st]
    [clojure.string :as str]
@@ -23,18 +24,24 @@
 
 (test/use-fixtures :each tu/fixture)
 
-(defn wrap-error [handler]
+(defn- wrap-error [handler]
   (fn [request]
     (-> (handler request)
         (ac/exceptionally handler-util/error-response))))
 
-(def resource-handler
-  "A handler which just returns the :body from the request."
+(def ^:private resource-handler
+  "A handler which just returns the `:body` from a non-binary resource request."
   (-> (comp ac/completed-future :body)
       wrap-resource
       wrap-error))
 
-(defn input-stream
+(def ^:private binary-resource-handler
+  "A handler which just returns the `:body` from a binary resource request."
+  (-> (comp ac/completed-future :body)
+      wrap-binary-data
+      wrap-error))
+
+(defn- input-stream
   ([^String s]
    (ByteArrayInputStream. (.getBytes s StandardCharsets/UTF_8)))
   ([^String s closed?]
@@ -193,6 +200,43 @@
               :body (input-stream (str "<Binary xmlns=\"http://hl7.org/fhir\"><data value=\"" (apply str (repeat (* 8 1024 1024) \a)) "\"/></Binary>"))})
       fhir-spec/fhir-type := :fhir/Binary)))
 
+(deftest binary-test
+  (testing "when sending FHIR-wrapped Binary data"
+    (testing "both handlers should return the same for both wrappers (JSON and XML)"
+      (let [raw-binary-data "105614"
+            b64-encoded-binary-data "MTA1NjE0Cg=="
+            binary-resource-data (type/base64Binary b64-encoded-binary-data)
+            binary-resource-content-type (type/code "text/plain")]
+        (doseq [handler [resource-handler binary-resource-handler]
+                [fhir-content-type resource-string-representation]
+                [["application/fhir+json;charset=utf-8" (str "{\"data\" : \"" raw-binary-data "\", \"resourceType\" : \"Binary\", \"contentType\" : \"" binary-resource-content-type "\"}")]
+                 ["application/fhir+xml;charset=utf-8" (str "<Binary xmlns=\"http://hl7.org/fhir\"><data value=\"" raw-binary-data "\"/><contentType value=\"" binary-resource-content-type "\"/></Binary>")]]]
+          (let [closed? (atom false)]
+            (given @(handler
+                     {:headers {"content-type" fhir-content-type}
+                      :body (input-stream resource-string-representation closed?)})
+              {:fhir/type :fhir/Binary
+               :contentType binary-resource-content-type
+               :data binary-resource-data})
+            (is closed?))))))
+
+  (testing "when sending raw binary resource handling"
+    (testing "small raw binary data"
+      (let [closed? (atom false)
+            raw-binary-data "some binary data"]
+        (given @(binary-resource-handler
+                 {:headers {"content-type" "application/octet-stream"}
+                  :body (input-stream raw-binary-data closed?)})
+          raw-binary-data)
+        (is @closed?)))
+
+    (testing "large raw binary resource"
+      (let [large-data (apply str (repeat (* 8 1014 1024) \a))]  ; 8MB of data
+        (given @(binary-resource-handler
+                 {:headers {"content-type" "application/octet-stream"}
+                  :body (input-stream large-data)})
+          large-data)))))
+
 (def ^:private whitespace
   (gen/fmap str/join (gen/vector (gen/elements [" " "\n" "\r" "\t"]))))