clinic: add integration test for create patient endpoint; minor refactor

.github/workflows/clinic.yaml

@@ -16,17 +16,34 @@ env:
   JAVA_VERSION: 17
 
 jobs:
-  clj-tests:
-    name: Clojure Tests
+  tests:
+    name: Tests
     runs-on: ubuntu-latest
     timeout-minutes: 10
+    services:
+      hapi-fhir:
+        image: hapiproject/hapi:latest
+        env:
+          server.port: 8090
+          hapi.fhir.tester.home.server_address: http://localhost:8090/fhir
+          hapi.fhir.allow_multiple_delete: true
+        ports:
+          - 8090:8090
     defaults:
       run:
         working-directory: ./clinic
     steps:
-      - uses: actions/checkout@v4
-      - uses: actions/setup-java@v3
+      - name: Checkout Source
+        uses: actions/checkout@v4
+      - name: Setup JDK
+        uses: actions/setup-java@v3
         with:
           distribution: ${{ env.JDK_DISTRIBUTION }}
           java-version: ${{ env.JAVA_VERSION }}
-      - run: lein test
+
+      # can't use `services.[id].options` to add Docker health checks because
+      # HAPI has a scratch docker image without a shell installation.
+      - name: HAPI FHIR Health Check
+        run: while ! curl -sSI "http://localhost:8090"; do sleep 5; done
+      - name: Run Tests
+        run: lein test

clinic/docker-compose.yaml

@@ -70,6 +70,7 @@ services:
       spring.jpa.properties.hibernate.search.enabled: false
       server.port: 8090
       hapi.fhir.tester.home.server_address: http://localhost:8090/fhir
+      hapi.fhir.allow_multiple_delete: true
     volumes:
       - hapi-data:/data/hapi
     ports:

clinic/project.clj

@@ -3,6 +3,7 @@
   :url "https://github.com/nilenso/ashutosh-onboarding/blob/main/clinic"
   :dependencies [[aero "1.1.6"]
                  [clj-http "3.12.3"]
+                 [clojure.java-time "1.3.0"]
                  [compojure "1.7.0"]
                  [mount "0.1.17"]
                  [org.clojure/clojure "1.11.1"]

clinic/src/clj/clinic/core.clj

@@ -11,7 +11,7 @@
   ([join-thread]
    (mount/start)
    (reset! server
-           (jetty/run-jetty (config/wrap #'routes/handler)
+           (jetty/run-jetty #'routes/handler
                             {:port (config/get-value :http-port)
                              :join? join-thread}))))
 

clinic/src/clj/clinic/fhir/client.clj

@@ -1,6 +1,6 @@
 (ns clinic.fhir.client
   (:require [cheshire.core :as json]
-            [clj-http.client :as c]))
+            [clj-http.client :as http]))
 
 (defn create!
   "Performs a HTTP POST request on a FHIR server at the given `base-url` for a
@@ -11,7 +11,7 @@
   (-> (if (= "Bundle" (resource :resourceType))
         base-url ; Bundle resources should POST at the server root
         (str base-url "/" (resource :resourceType)))
-      (c/post {:headers (into {"Content-Type" "application/fhir+json"} headers)
-               :body (json/generate-string resource)
-               :throw-exceptions false})
+      (http/post {:headers (into {"Content-Type" "application/fhir+json"} headers)
+                  :body (json/generate-string resource)
+                  :throw-exceptions false})
       (update :body json/parse-string true)))

clinic/src/clj/clinic/routes/core.clj

@@ -1,5 +1,6 @@
 (ns clinic.routes.core
-  (:require [clinic.routes.patient :as patient]
+  (:require [clinic.config :as config]
+            [clinic.routes.patient :as patient]
             [clojure.stacktrace :as stacktrace]
             [compojure.core :refer [context defroutes]]
             [compojure.route :refer [not-found]]
@@ -22,6 +23,7 @@
 (def handler
   "The default API route handler."
   (-> routes
+      (config/wrap)
       (wrap-json-body {:keywords? true})
       (wrap-json-response)
       (wrap-exception-handler)))

clinic/src/clj/clinic/routes/patient.clj

@@ -3,8 +3,8 @@
             [compojure.core :refer [defroutes POST]]
             [ring.util.response :as r]))
 
-(defn- create-patient [{{fhir-server-url :fhir-server-base-url} :config
-                        params :body}]
+(defn- create-patient! [{{fhir-server-url :fhir-server-base-url} :config
+                         params :body}]
   (try
     (-> (svc/create! fhir-server-url params)
         (r/response)
@@ -16,4 +16,4 @@
         (throw e)))))
 
 (defroutes handler
-  (POST "/" _ create-patient))
+  (POST "/" _ create-patient!))

clinic/src/clj/clinic/service/patient.clj

@@ -2,7 +2,8 @@
   (:require [clinic.fhir.client :as fc]
             [clinic.fhir.utils :as fu]
             [clojure.spec.alpha :as s]
-            [clojure.string :as string]))
+            [clojure.string :as string]
+            [java-time.api :as jt]))
 
 (def mrn-system "urn:nilenso:clinic:mrn")
 (def marital-status-system "http://hl7.org/fhir/ValueSet/marital-status")
@@ -11,13 +12,17 @@
 
 (def ^:private not-blank? (complement string/blank?))
 
+(defn- date? [v]
+  (try (jt/local-date v)
+       (catch Exception _ nil)))
+
 (s/def ::id (s/and string? not-blank?))
-(s/def ::mrn (s/and string? not-blank?))
+(s/def ::mrn (s/and string? (partial re-matches #"\d{3}-\d{3}-\d{3}")))
 (s/def ::first-name (s/and string? not-blank?))
 (s/def ::last-name (s/and string? not-blank?))
-(s/def ::birth-date (s/and string? not-blank?))
+(s/def ::birth-date (s/and string? date?))
 (s/def ::gender #{"male" "female" "other" "unknown"})
-(s/def ::marital-status #{nil, "A" "D" "I" "L" "M" "P" "S" "T" "U" "W" "UNK"})
+(s/def ::marital-status (s/nilable #{"A" "D" "I" "L" "M" "P" "S" "T" "U" "W" "UNK"}))
 (s/def ::email (s/nilable (s/and string? not-blank?)))
 (s/def ::phone (s/nilable (s/and string? not-blank?)))
 
@@ -29,7 +34,7 @@
   (s/keys :req-un [::id ::mrn ::first-name ::last-name ::birth-date ::gender]
           :opt-un [::marital-status ::email ::phone]))
 
-(defn- generate-mrn []
+(defn generate-mrn []
   (String/format "%03d-%03d-%03d"
                  (into-array [(rand-int 999)
                               (rand-int 999)
@@ -43,11 +48,11 @@
                                 :given [(params :first-name)]}]
                         :birthDate (params :birth-date)
                         :gender (params :gender)
-                        :maritalStatus {:coding [{:system marital-status-system
-                                                  :code (or (get params :marital-status)
-                                                            "UNK")}]}
                         :telecom []
                         :active true})]
+    (when (params :marital-status)
+      (swap! resource assoc :maritalStatus {:coding [{:system marital-status-system
+                                                      :code (params :marital-status)}]}))
     (when (params :email)
       (swap! resource update :telecom conj {:system email-system
                                             :value (params :email)}))

clinic/test/clj/clinic/config_test.clj

@@ -7,7 +7,8 @@
 (deftest get-value-test
   (with-redefs [aero/read-config (constantly {:test-key "test-val"})]
     (mount/start #'config/config)
-    (is (= "test-val" (config/get-value :test-key)))))
+    (is (= "test-val" (config/get-value :test-key)))
+    (mount/stop)))
 
 (deftest wrap-test
   (let [request (atom {})
@@ -16,4 +17,5 @@
     (with-redefs [aero/read-config (constantly test-config)]
       (mount/start #'config/config)
       ((config/wrap next-handler) {:method :get})
-      (is (= test-config (@request :config))))))
+      (is (= test-config (@request :config)))
+      (mount/stop))))

clinic/test/clj/clinic/factory.clj

@@ -0,0 +1,20 @@
+(ns clinic.factory
+  (:require [clojure.spec.gen.alpha :as gen]
+            [clojure.spec.alpha :as s]
+            [clinic.service.patient :as patient]))
+
+(defn- generate-date []
+  (String/format "%04d-%02d-%02d"
+                 (into-array [(+ 1970 (rand-int 52))
+                              (inc (rand-int 12))
+                              (inc (rand-int 28))])))
+
+(defn- with-generator-fn [gen-fn]
+  (-> (fn [& _] (gen-fn))
+      (gen/fmap (gen/return nil))
+      (constantly)))
+
+(defn create-params []
+  (->> {::patient/birth-date (with-generator-fn generate-date)}
+       (s/gen ::patient/create-params)
+       (gen/generate)))

clinic/test/clj/clinic/routes/patient_integration_test.clj

@@ -0,0 +1,41 @@
+(ns clinic.routes.patient-integration-test
+  (:require [clinic.factory :as factory]
+            [clinic.routes.core :as routes]
+            [clinic.test-utils :as tu]
+            [clojure.test :refer [deftest is testing use-fixtures]]
+            [ring.mock.request :as mr]
+            [cheshire.core :as json]))
+
+(defn- create-patient-request [body]
+  (-> (mr/request :post "/api/v1/patients/")
+      (mr/json-body body)))
+
+(use-fixtures :once tu/load-config-fixture)
+(use-fixtures :each tu/expunge-fhir-data-fixture)
+
+(deftest create-patient-test
+  (testing "with invalid request body"
+    (doseq [missing-field [:first-name :last-name :birth-date :gender]]
+      (is (= 400 (-> (factory/create-params)
+                     (dissoc missing-field)
+                     (create-patient-request)
+                     (routes/handler)
+                     (get :status))))))
+
+  (testing "with valid request body"
+    (let [params (factory/create-params)
+          {status :status
+           body :body} (-> params
+                           (create-patient-request)
+                           (routes/handler)
+                           (update :body json/parse-string true))]
+      (is (= 201 status))
+      (is (contains? body :id))
+      (is (contains? body :mrn))
+      (is (= (params :first-name) (body :first-name)))
+      (is (= (params :last-name) (body :last-name)))
+      (is (= (params :birth-date) (body :birth-date)))
+      (is (= (params :gender) (body :gender)))
+      (is (= (params :marital-status) (body :marital-status)))
+      (is (= (params :phone) (body :phone)))
+      (is (= (params :email) (body :email))))))

clinic/test/clj/clinic/routes/patient_test.clj

@@ -1,6 +1,7 @@
 (ns clinic.routes.patient-test
   (:require [clinic.routes.core :as routes]
             [clinic.service.patient :as svc]
+            [clojure.stacktrace :as st]
             [clojure.test :refer [deftest is testing]]
             [ring.mock.request :as mr]))
 
@@ -34,4 +35,6 @@
 
       (testing "with unknown service error"
         (reset! response-fn #(throw (RuntimeException. "test-error")))
-        (is (= 500 (:status (routes/handler (create-patient-request)))))))))
+        (is (= 500 (with-redefs [println (constantly nil)
+                                 st/print-stack-trace (constantly nil)]
+                     (:status (routes/handler (create-patient-request))))))))))

clinic/test/clj/clinic/service/patient_test.clj

@@ -1,17 +1,13 @@
 (ns clinic.service.patient-test
-  (:require [clinic.fhir.client :as fc]
+  (:require [clinic.factory :as factory]
+            [clinic.fhir.client :as fc]
             [clinic.service.patient :as svc]
-            [clojure.spec.alpha :as s]
-            [clojure.spec.gen.alpha :as gen]
             [clojure.test :refer [deftest is testing]]))
 
 (defmacro catch-thrown-data [& body]
   `(try ~@body
         (catch clojure.lang.ExceptionInfo e# (ex-data e#))))
 
-(defn- generate-create-params []
-  (gen/generate (s/gen :clinic.service.patient/create-params)))
-
 (deftest create-test
   (let [call-args (atom [])
         response-fn (atom (constantly nil))]
@@ -20,19 +16,17 @@
                                 (@response-fn (second args)))]
       (testing "with missing required param fields"
         (doseq [missing-field [:first-name :last-name :birth-date :gender]]
-          (->  (generate-create-params)
-               (dissoc missing-field)
-               ((partial svc/create! "test-server-url"))
-               (catch-thrown-data)
-               (get :type)
-               (= :invalid-params)
-               (is))))
+          (is (= :invalid-params (->  (factory/create-params)
+                                      (dissoc missing-field)
+                                      ((partial svc/create! "test-server-url"))
+                                      (catch-thrown-data)
+                                      (get :type))))))
 
       (testing "with valid params"
         (reset! response-fn (fn [resource] {:status 201
                                             :body (assoc resource :id "test-id")}))
         (doseq [missing-field [:marital-status :email :phone nil]]
-          (let [params (-> (generate-create-params)
+          (let [params (-> (factory/create-params)
                            (dissoc missing-field))
                 patient (svc/create! "test-server-url" params)]
             (is (= "test-server-url" (@call-args 0)))
@@ -42,24 +36,20 @@
             (is (= (params :last-name) (patient :last-name)))
             (is (= (params :birth-date) (patient :birth-date)))
             (is (= (params :gender) (patient :gender)))
-            (is (= (get params :marital-status "UNK") (patient :marital-status)))
+            (is (= (params :marital-status) (patient :marital-status)))
             (is (= (params :email) (patient :email)))
             (is (= (params :phone) (patient :phone))))))
 
       (testing "with mrn conflict"
         (reset! response-fn (constantly {:status 200}))
-        (-> (generate-create-params)
-            ((partial svc/create! "test-server-url"))
-            (catch-thrown-data)
-            (get :type)
-            (= :mrn-conflict)
-            (is)))
+        (is (= :mrn-conflict (-> (factory/create-params)
+                                 ((partial svc/create! "test-server-url"))
+                                 (catch-thrown-data)
+                                 (get :type)))))
 
       (testing "with upstream service non-20x response"
         (reset! response-fn (constantly {:status 400}))
-        (-> (generate-create-params)
-            ((partial svc/create! "test-server-url"))
-            (catch-thrown-data)
-            (get :type)
-            (= :upstream-error)
-            (is))))))
+        (is (= :upstream-error (-> (factory/create-params)
+                                   ((partial svc/create! "test-server-url"))
+                                   (catch-thrown-data)
+                                   (get :type))))))))

clinic/test/clj/clinic/test_utils.clj

@@ -0,0 +1,25 @@
+(ns clinic.test-utils
+  (:require [cheshire.core :as json]
+            [clj-http.client :as http]
+            [clinic.config :as config]
+            [mount.core :as mount]))
+
+(defn load-config-fixture [f]
+  (mount/start #'config/config)
+  (f)
+  (mount/stop))
+
+(defn expunge-fhir-data! [server-url]
+  (-> server-url
+      (str "/$expunge")
+      (http/post {:headers {"Content-Type" "application/fhir+json"}
+                  :body (json/generate-string {:resourceType "Parameters"
+                                               :parameter [{:name "expungeEverything"
+                                                            :valueBoolean true}]})
+                  :throw-exceptions false})))
+
+(defn expunge-fhir-data-fixture [f]
+  (-> :fhir-server-base-url
+      (config/get-value)
+      (expunge-fhir-data!))
+  (f))