From 35cc2eda99b860db1c15ffd8a29992653cb375f2 Mon Sep 17 00:00:00 2001
From: gered <gered@blarg.ca>
Date: Fri, 29 Aug 2014 09:50:36 -0400
Subject: [PATCH] add basic authentication support

---
 src/clj_hl7_fhir/core.clj | 32 +++++++++++++++++++++++++++-----
 src/clj_hl7_fhir/util.clj | 27 +++++++++++++++++----------
 2 files changed, 44 insertions(+), 15 deletions(-)

diff --git a/src/clj_hl7_fhir/core.clj b/src/clj_hl7_fhir/core.clj
index c9fa578..60c7250 100644
--- a/src/clj_hl7_fhir/core.clj
+++ b/src/clj_hl7_fhir/core.clj
@@ -6,6 +6,27 @@
   (:use [camel-snake-kebab]
         [clj-hl7-fhir.util]))
 
+; HACK: using this dynamic/"with"-wrapping type of API design is arguably a "lazy" design.
+;       in the future I intend to explore reworking the API so as to not require this if
+;       authentication support is needed, but I didn't want to get too held up on it right
+;       now. the problem at the moment is that passing authentication info to the main
+;       FHIR operation functions is that it only works well in the simple cases. usage
+;       of functions like fetch-next-page, fetch-all and get-relative-resource becomes
+;       a little bit messy (have to pass in server/auth info where before none of it
+;       was necessary... kind of gross in my opinion, would rather come up with
+;       something cleaner if at all possible)
+
+(def ^:dynamic *server-auth* nil)
+
+(defmacro with-auth
+  "wraps code that performs FHIR operations such that each will have authentication info
+   added to the HTTP requests made. auth should be a map containing one entry where the
+   key is one of :basic-auth, :digest-auth or :oauth-token (authentication headers that
+   clj-http supports)"
+  [auth & body]
+  `(binding [*server-auth* (select-keys ~auth [:basic-auth :digest-auth :oauth-token])]
+     ~@body))
+
 (defn- ->fhir-resource-name [x]
   (name (->CamelCase x)))
 
@@ -15,16 +36,17 @@
 
 (defn- fhir-request [type base-url resource-url & {:keys [params body params-as-body? follow-location?]}]
   (let [query            (map->query-string params)
+        auth             *server-auth*
         url              (build-url base-url resource-url (if-not params-as-body? query))
         body             (if params-as-body? query body)
         follow-location? (if (nil? follow-location?) true follow-location?)]
     (try
       (let [response      (case type
-                            :get       (http-get-json url)
-                            :form-post (http-post-form url body)
-                            :post      (http-post-json url body)
-                            :put       (http-put-json url body)
-                            :delete    (http-delete-json url body))
+                            :get       (http-get-json url auth)
+                            :form-post (http-post-form url auth body)
+                            :post      (http-post-json url auth body)
+                            :put       (http-put-json url auth body)
+                            :delete    (http-delete-json url auth body))
             response-body (:body response)
             location      (get-in response [:headers "Location"])]
         (if location
diff --git a/src/clj_hl7_fhir/util.clj b/src/clj_hl7_fhir/util.clj
index 7e56d67..2315c69 100644
--- a/src/clj_hl7_fhir/util.clj
+++ b/src/clj_hl7_fhir/util.clj
@@ -66,35 +66,42 @@
 (defn- http-request [f url & [params]]
   (f url (merge {:accept "application/json+fhir"} params)))
 
-(defn http-get-json [url]
-  (http-request http/get url))
+(defn http-get-json [url params]
+  (http-request http/get url params))
 
-(defn http-post-json [url body]
+(defn http-post-json [url params body]
   (http-request
     http/post url
     (merge
       {:content-type "application/json+fhir"}
       (cond
         (map? body)    {:body (json/generate-string body)}
-        (string? body) {:body body}))))
+        (string? body) {:body body})
+      params)))
 
-(defn http-post-form [url body]
+(defn http-post-form [url params body]
   (http-request
     http/post url
     (merge
       {:content-type "application/x-www-form-urlencoded"}
       (cond
         (map? body)    {:body (json/generate-string body)}
-        (string? body) {:body body}))))
+        (string? body) {:body body})
+      params)))
 
-(defn http-put-json [url body]
+(defn http-put-json [url params body]
   (http-request
     http/put url
     (merge
       {:content-type "application/json+fhir"}
       (cond
         (map? body)    {:body (json/generate-string body)}
-        (string? body) {:body body}))))
+        (string? body) {:body body})
+      params)))
 
-(defn http-delete-json [url body]
-  (http-request http/delete url (if body {:body body})))
+(defn http-delete-json [url params body]
+  (http-request
+    http/delete url
+    (merge
+      (if body {:body body})
+      params)))