diff --git a/.github/scripts/patient-identical-update.sh b/.github/scripts/patient-identical-update.sh new file mode 100755 index 000000000..9849dc2cb --- /dev/null +++ b/.github/scripts/patient-identical-update.sh @@ -0,0 +1,49 @@ +#!/bin/bash -e + +# +# This script tests that an update without changes of the resource content +# doesn't create a new history entry. +# + +SCRIPT_DIR="$(dirname "$(readlink -f "$0")")" +. "$SCRIPT_DIR/util.sh" + +bundle() { +cat < [2]: diff --git a/docs/monitoring.md b/docs/monitoring.md index f833dda24..5321ef1df 100644 --- a/docs/monitoring.md +++ b/docs/monitoring.md @@ -4,6 +4,28 @@ It's recommended to use [Prometheus][1] and [Grafana][2] to monitor the runtime ![](monitoring/prometheus.png) +## Prometheus Config + +A basic Prometheus config looks like this: + +```yml +global: + scrape_interval: 15s + +scrape_configs: +- job_name: 'node' + static_configs: + - targets: [':9100'] + - labels: + instance: 'blaze' + +- job_name: 'blaze' + static_configs: + - targets: [':8081'] + - labels: + instance: 'blaze' +``` + ## Import the Blaze Dashboard In order to import the Blaze dashboard into your Grafana instance, please copy the contents of [blaze.json](monitoring/blaze.json) and pate it into the import dialog on the Import dashboard site: diff --git a/modules/anomaly/src/blaze/anomaly.clj b/modules/anomaly/src/blaze/anomaly.clj index c73c97000..fdf7a1b33 100644 --- a/modules/anomaly/src/blaze/anomaly.clj +++ b/modules/anomaly/src/blaze/anomaly.clj @@ -28,6 +28,10 @@ (identical? ::anom/not-found (::anom/category x))) +(defn conflict? [x] + (identical? ::anom/conflict (::anom/category x))) + + (defn fault? [x] (identical? ::anom/fault (::anom/category x))) @@ -70,8 +74,11 @@ (anomaly* ::anom/fault msg kvs))) -(defn busy [msg & {:as kvs}] - (anomaly* ::anom/busy msg kvs)) +(defn busy + ([] + (busy nil)) + ([msg & {:as kvs}] + (anomaly* ::anom/busy msg kvs))) (defn- format-exception diff --git a/modules/anomaly/src/blaze/anomaly_spec.clj b/modules/anomaly/src/blaze/anomaly_spec.clj index f99671195..db3b0a713 100644 --- a/modules/anomaly/src/blaze/anomaly_spec.clj +++ b/modules/anomaly/src/blaze/anomaly_spec.clj @@ -26,6 +26,11 @@ :ret boolean?) +(s/fdef ba/conflict? + :args (s/cat :x any?) + :ret boolean?) + + (s/fdef ba/fault? :args (s/cat :x any?) :ret boolean?) @@ -67,7 +72,7 @@ (s/fdef ba/busy - :args (s/cat :msg (s/nilable string?) :kvs (s/* (s/cat :k keyword? :v any?))) + :args (s/cat :msg (s/? (s/nilable string?)) :kvs (s/* (s/cat :k keyword? :v any?))) :ret ::anom/anomaly) diff --git a/modules/anomaly/test/blaze/anomaly_test.clj b/modules/anomaly/test/blaze/anomaly_test.clj index 230ed7dbe..dcab09ca7 100644 --- a/modules/anomaly/test/blaze/anomaly_test.clj +++ b/modules/anomaly/test/blaze/anomaly_test.clj @@ -62,6 +62,17 @@ (is (not (ba/anomaly? nil))))) +(deftest conflict?-test + (testing "a conflict anomaly has to have the right category" + (is (ba/conflict? {::anom/category ::anom/conflict}))) + + (testing "anomalies with other categories are no conflict anomalies" + (is (not (ba/conflict? {::anom/category ::anom/fault})))) + + (testing "nil is no conflict anomaly" + (is (not (ba/anomaly? nil))))) + + (deftest fault?-test (testing "a fault anomaly has to have the right category" (is (ba/fault? {::anom/category ::anom/fault}))) @@ -152,7 +163,6 @@ (testing "without message" (is (= (ba/fault) {::anom/category ::anom/fault}))) - (testing "with nil message" (is (= (ba/fault nil) {::anom/category ::anom/fault}))) @@ -169,6 +179,9 @@ (deftest busy-test + (testing "without message" + (is (= (ba/busy) {::anom/category ::anom/busy}))) + (testing "with nil message" (is (= (ba/busy nil) {::anom/category ::anom/busy}))) diff --git a/modules/async/src/blaze/async/comp.clj b/modules/async/src/blaze/async/comp.clj index feb85c512..2cf7262a2 100644 --- a/modules/async/src/blaze/async/comp.clj +++ b/modules/async/src/blaze/async/comp.clj @@ -66,6 +66,19 @@ (.complete ^CompletableFuture future x)) +(defn- ->Supplier [f] + (reify Supplier + (get [_] + (ba/throw-when (f))))) + + +(defn complete-async! + "Completes `future` with the result of `f` invoked with no arguments from an + asynchronous task using the default executor." + [future f] + (.completeAsync ^CompletableFuture future (->Supplier f))) + + (defn or-timeout! "Exceptionally completes `future` with a TimeoutException if not otherwise completed before `timeout` in `unit`. @@ -135,12 +148,6 @@ (.cancel ^CompletableFuture future false)) -(defn- ->Supplier [f] - (reify Supplier - (get [_] - (ba/throw-when (f))))) - - (defn supply-async "Returns a CompletableFuture that is asynchronously completed by a task running in `executor` with the value obtained by calling the function `f` @@ -236,6 +243,12 @@ (-completion-cause [e] e)) +(defn- ->BiFunction [f] + (reify BiFunction + (apply [_ x e] + (ba/throw-when (f x (some-> e -completion-cause ba/anomaly)))))) + + (defn handle "Returns a CompletionStage that, when `stage` completes either normally or exceptionally, is executed with `stage`'s result and exception as arguments to @@ -247,9 +260,22 @@ [stage f] (.handle ^CompletionStage stage - (reify BiFunction - (apply [_ x e] - (ba/throw-when (f x (some-> e -completion-cause ba/anomaly))))))) + (->BiFunction f))) + + +(defn handle-async + "Returns a CompletionStage that, when `stage` completes either normally or + exceptionally, is executed using `stage`'s default asynchronous execution + facility, with `stage`'s result and exception as arguments to the function + `f`. + + When `stage` is complete, the function `f` is invoked with the result (or nil + if none) and the anomaly (or nil if none) of `stage` as arguments, and the + `f`'s result is used to complete the returned stage." + [stage f] + (.handleAsync + ^CompletionStage stage + (->BiFunction f))) (defn exceptionally @@ -275,6 +301,24 @@ (then-compose identity))) +(defn exceptionally-compose-async + "Returns a CompletionStage that, when `stage` completes exceptionally, is + composed using the results of the function `f` applied to `stage`'s anomaly, + using `stage`'s default asynchronous execution facility." + [stage f] + (-> stage + (handle + (fn [_ e] + (if (nil? e) + stage + (-> stage + (handle-async + (fn [_ e] + (f e))) + (then-compose identity))))) + (then-compose identity))) + + (defn when-complete "Returns a CompletionStage with the same result or exception as `stage`, that executes the given action when `stage` completes. @@ -340,7 +384,31 @@ (defn retry - "Please be aware that `num-retries` shouldn't be higher than the max stack + "Returns a CompletionStage that, when the CompletionStage as result of calling + the function`f` with no arguments completes normally will complete with its + result. + + Otherwise retires by calling `f` again with no arguments. Wait's between + retries starting with 100 ms growing exponentially. + + Please be aware that `num-retries` shouldn't be higher than the max stack depth. Otherwise, the CompletionStage would fail with a StackOverflowException." - [future-fn num-retries] - (retry* future-fn num-retries 0)) + [f num-retries] + (retry* f num-retries 0)) + + +(defn retry2 + "Returns a CompletionStage that, when the CompletionStage as result of calling + the function`f` with no arguments completes normally will complete with its + result. + + Otherwise retires by calling `f` again with no arguments if calling the + function `retry?` with the anomaly returned by the CompletionStage returns + true." + [f retry?] + (-> (f) + (exceptionally-compose-async + (fn [e] + (if (retry? e) + (retry2 f retry?) + (completed-future e)))))) diff --git a/modules/async/src/blaze/async/comp_spec.clj b/modules/async/src/blaze/async/comp_spec.clj index b0b7b44ee..fd989a359 100644 --- a/modules/async/src/blaze/async/comp_spec.clj +++ b/modules/async/src/blaze/async/comp_spec.clj @@ -37,6 +37,11 @@ :ret boolean?) +(s/fdef ac/complete-async! + :args (s/cat :future ac/completable-future? :f ifn?) + :ret boolean?) + + (s/fdef ac/or-timeout! :args (s/cat :future ac/completable-future? :timeout pos-int? :unit #(instance? TimeUnit %)) @@ -75,7 +80,7 @@ (s/fdef ac/supply-async - :args (s/cat :f fn? :executor (s/? ex/executor?)) + :args (s/cat :f ifn? :executor (s/? ex/executor?)) :ret ac/completable-future?) @@ -85,23 +90,23 @@ (s/fdef ac/then-apply - :args (s/cat :stage ac/completion-stage? :f fn?) + :args (s/cat :stage ac/completion-stage? :f ifn?) :ret ac/completion-stage?) (s/fdef ac/then-apply-async - :args (s/cat :stage ac/completion-stage? :f fn? + :args (s/cat :stage ac/completion-stage? :f ifn? :executor (s/? ex/executor?)) :ret ac/completion-stage?) (s/fdef ac/then-compose - :args (s/cat :stage ac/completion-stage? :f fn?) + :args (s/cat :stage ac/completion-stage? :f ifn?) :ret ac/completion-stage?) (s/fdef ac/then-compose-async - :args (s/cat :stage ac/completion-stage? :f fn? + :args (s/cat :stage ac/completion-stage? :f ifn? :executor (s/? ex/executor?)) :ret ac/completion-stage?) @@ -111,6 +116,11 @@ :ret ac/completion-stage?) +(s/fdef ac/handle-async + :args (s/cat :stage ac/completion-stage? :f ifn?) + :ret ac/completion-stage?) + + (s/fdef ac/exceptionally :args (s/cat :stage ac/completion-stage? :f ifn?) :ret ac/completion-stage?) @@ -121,13 +131,18 @@ :ret ac/completion-stage?) +(s/fdef ac/exceptionally-compose-async + :args (s/cat :stage ac/completion-stage? :f ifn?) + :ret ac/completion-stage?) + + (s/fdef ac/when-complete - :args (s/cat :stage ac/completion-stage? :f fn?) + :args (s/cat :stage ac/completion-stage? :f ifn?) :ret ac/completion-stage?) (s/fdef ac/when-complete-async - :args (s/cat :stage ac/completion-stage? :f fn? + :args (s/cat :stage ac/completion-stage? :f ifn? :executor ex/executor?) :ret ac/completion-stage?) diff --git a/modules/async/test/blaze/async/comp_test.clj b/modules/async/test/blaze/async/comp_test.clj index 38326438d..2730dc591 100644 --- a/modules/async/test/blaze/async/comp_test.clj +++ b/modules/async/test/blaze/async/comp_test.clj @@ -24,7 +24,7 @@ (is (= ::x @(ac/completed-future ::x)))) (testing "on exceptionally completed future" - (given-failed-future (ac/completed-future (ba/fault "")) + (given-failed-future (ac/completed-future (ba/fault)) ::anom/category := ::anom/fault))) @@ -59,6 +59,18 @@ (is (= "e" (ex-message (ex-cause e))))))))) +(deftest complete-test + (let [future (ac/future)] + (ac/complete! future 1) + (is (= 1 @future)))) + + +(deftest complete-async-test + (let [future (ac/future)] + (ac/complete-async! future (constantly 1)) + (is (= 1 @future)))) + + (deftest or-timeout!-test (testing "with timeout happen" (let [f (ac/future)] @@ -194,6 +206,20 @@ (is (= "e" @f'))))) +(deftest handle-async-test + (testing "with success" + (let [f (ac/future) + f' (ac/handle-async f (fn [x _] x))] + (ac/complete! f 1) + (is (= 1 @f')))) + + (testing "with error" + (let [f (ac/future) + f' (ac/handle-async f (fn [_ e] (::anom/message e)))] + (ac/complete-exceptionally! f (ex-info "e" {})) + (is (= "e" @f'))))) + + (deftest exceptionally-test (testing "the exception of a failed future will be converted to an anomaly" (is (= @(-> (ac/failed-future (Exception. "msg-125548")) @@ -207,6 +233,36 @@ "msg-131026")))) +(deftest exceptionally-compose-test + (testing "the exception of a failed future will be converted to an anomaly" + (is (= @(-> (ac/failed-future (Exception. "msg-125548")) + (ac/exceptionally-compose + (comp ac/completed-future ::anom/message))) + "msg-125548"))) + + (testing "the anomaly returned in a in-between stage shows up" + (is (= @(-> (ac/completed-future "foo") + (ac/then-apply (constantly (ba/fault "msg-131026"))) + (ac/exceptionally-compose + (comp ac/completed-future ::anom/message))) + "msg-131026")))) + + +(deftest exceptionally-compose-async-test + (testing "the exception of a failed future will be converted to an anomaly" + (is (= @(-> (ac/failed-future (Exception. "msg-125548")) + (ac/exceptionally-compose-async + (comp ac/completed-future ::anom/message))) + "msg-125548"))) + + (testing "the anomaly returned in a in-between stage shows up" + (is (= @(-> (ac/completed-future "foo") + (ac/then-apply (constantly (ba/fault "msg-131026"))) + (ac/exceptionally-compose-async + (comp ac/completed-future ::anom/message))) + "msg-131026")))) + + (deftest cancel-test (let [f (ac/supply-async (constantly ::a) (ac/delayed-executor 100 TimeUnit/MILLISECONDS))] (is (not (ac/done? f))) @@ -271,7 +327,7 @@ (is (nil? @(do-sync [_ (ac/completed-future 1)]))))) (testing "on normally exceptionally future" - (given-failed-future (do-sync [x (ac/completed-future (ba/fault ""))] (inc x)) + (given-failed-future (do-sync [x (ac/completed-future (ba/fault))] (inc x)) ::anom/category := ::anom/fault))) @@ -285,14 +341,14 @@ (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 2 n) ::x (ba/busy ""))))] + (if (= 2 n) ::x (ba/busy))))] (is (= ::x @(ac/retry future-fn 1))))) (testing "first call not retryable" (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 2 n) ::x (ba/fault ""))))] + (if (= 2 n) ::x (ba/fault))))] (given-failed-future (ac/retry future-fn 1) ::anom/category := ::anom/fault)))) @@ -301,14 +357,14 @@ (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 3 n) ::x (ba/busy ""))))] + (if (= 3 n) ::x (ba/busy))))] (is (= ::x @(ac/retry future-fn 2))))) (testing "one retry" (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 3 n) ::x (ba/busy ""))))] + (if (= 3 n) ::x (ba/busy))))] (given-failed-future (ac/retry future-fn 1) ::anom/category := ::anom/busy)))) @@ -317,7 +373,7 @@ (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 2 n) ::x (ba/busy "")))) + (if (= 2 n) ::x (ba/busy)))) start (System/nanoTime)] @(ac/retry future-fn 1) (is (< 1e8 (- (System/nanoTime) start))))) @@ -326,7 +382,7 @@ (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 3 n) ::x (ba/busy "")))) + (if (= 3 n) ::x (ba/busy)))) start (System/nanoTime)] @(ac/retry future-fn 2) (is (< 3e8 (- (System/nanoTime) start))))) @@ -335,7 +391,26 @@ (let [counter (atom 0) future-fn #(ac/completed-future (let [n (swap! counter inc)] - (if (= 4 n) ::x (ba/busy "")))) + (if (= 4 n) ::x (ba/busy)))) start (System/nanoTime)] @(ac/retry future-fn 3) (is (< 7e8 (- (System/nanoTime) start))))))) + + +(deftest retry2-test + (testing "with first call successful" + (let [f #(ac/completed-future ::result)] + (is (= ::result @(ac/retry2 f (constantly true)))))) + + (testing "with second call successful" + (let [counter (atom 2) + f #(ac/completed-future + (if (zero? (swap! counter dec)) + ::result + (ba/fault)))] + (testing "first call retryable" + (is (= ::result @(ac/retry2 f (constantly true))))) + + (testing "first call not retryable" + (given-failed-future (ac/retry2 f (constantly false)) + ::anom/category := ::anom/fault))))) diff --git a/modules/db-resource-store-cassandra/src/blaze/db/resource_store/cassandra.clj b/modules/db-resource-store-cassandra/src/blaze/db/resource_store/cassandra.clj index 61c646852..022e97d20 100644 --- a/modules/db-resource-store-cassandra/src/blaze/db/resource_store/cassandra.clj +++ b/modules/db-resource-store-cassandra/src/blaze/db/resource_store/cassandra.clj @@ -136,7 +136,7 @@ (deftype CassandraResourceStore [session get-statement put-statement] rs/ResourceStore (-get [_ hash] - (log/trace "get" hash) + (log/trace "get resource with hash:" hash) (execute-get session get-statement hash)) (-multi-get [_ hashes] diff --git a/modules/db-tx-log/src/blaze/db/tx_log/spec.clj b/modules/db-tx-log/src/blaze/db/tx_log/spec.clj index a8b56e74e..28e4e40c9 100644 --- a/modules/db-tx-log/src/blaze/db/tx_log/spec.clj +++ b/modules/db-tx-log/src/blaze/db/tx_log/spec.clj @@ -24,7 +24,7 @@ (s/def :blaze.db.tx-cmd/op - #{"create" "put" "delete"}) + #{"create" "put" "keep" "delete"}) (s/def :blaze.db.tx-cmd/type @@ -44,7 +44,7 @@ (s/def :blaze.db.tx-cmd/if-match - :blaze.db/t) + (s/or :t :blaze.db/t :ts (s/coll-of :blaze.db/t :kind vector? :min-count 1))) (s/def :blaze.db.tx-cmd/if-none-match @@ -73,6 +73,14 @@ :blaze.db.tx-cmd/if-none-match])) +(defmethod tx-cmd "keep" [_] + (s/keys :req-un [:blaze.db.tx-cmd/op + :blaze.db.tx-cmd/type + :blaze.resource/id + :blaze.resource/hash] + :opt-un [:blaze.db.tx-cmd/if-match])) + + (defmethod tx-cmd "delete" [_] (s/keys :req-un [:blaze.db.tx-cmd/op :blaze.db.tx-cmd/type diff --git a/modules/db/src/blaze/db/impl/db.clj b/modules/db/src/blaze/db/impl/db.clj index 666fae725..b2a30c0eb 100644 --- a/modules/db/src/blaze/db/impl/db.clj +++ b/modules/db/src/blaze/db/impl/db.clj @@ -21,7 +21,7 @@ node) (-as-of [_ t] - (assert (<= ^long t ^long basis-t)) + (assert (<= ^long t ^long basis-t) (format "(<= %d %d)" t basis-t)) (Db. node kv-store basis-t t)) (-basis-t [_] diff --git a/modules/db/src/blaze/db/impl/index/cbor.clj b/modules/db/src/blaze/db/impl/index/cbor.clj index 2b993b1f5..01515c6b4 100644 --- a/modules/db/src/blaze/db/impl/index/cbor.clj +++ b/modules/db/src/blaze/db/impl/index/cbor.clj @@ -1,6 +1,7 @@ (ns blaze.db.impl.index.cbor (:refer-clojure :exclude [read]) (:require + [blaze.fhir.hash :as hash] [jsonista.core :as j]) (:import [com.fasterxml.jackson.dataformat.cbor CBORFactory])) @@ -9,7 +10,8 @@ (def ^:private cbor-object-mapper (j/object-mapper {:factory (CBORFactory.) - :decode-key-fn true})) + :decode-key-fn true + :modules [hash/object-mapper-module]})) (defn read [bytes] diff --git a/modules/db/src/blaze/db/impl/index/tx_error.clj b/modules/db/src/blaze/db/impl/index/tx_error.clj index 7d9720272..b69780440 100644 --- a/modules/db/src/blaze/db/impl/index/tx_error.clj +++ b/modules/db/src/blaze/db/impl/index/tx_error.clj @@ -1,7 +1,9 @@ (ns blaze.db.impl.index.tx-error (:require + [blaze.byte-buffer :as bb] [blaze.db.impl.index.cbor :as cbor] [blaze.db.kv :as kv] + [blaze.fhir.hash :as hash] [cognitect.anomalies :as anom]) (:import [com.google.common.primitives Longs])) @@ -10,15 +12,21 @@ (set! *warn-on-reflection* true) +(defn- decode-tx-cmd [tx-cmd] + (update tx-cmd :hash (comp hash/from-byte-buffer! bb/wrap))) + + (defn- decode-tx-error "Returns an anomaly." [bytes] - (let [{:keys [category message http-status]} (cbor/read bytes)] + (let [{:keys [category message http-status tx-cmd]} (cbor/read bytes)] (cond-> {::anom/category (keyword "cognitect.anomalies" category)} message (assoc ::anom/message message) http-status - (assoc :http/status http-status)))) + (assoc :http/status http-status) + tx-cmd + (assoc :blaze.db/tx-cmd (decode-tx-cmd tx-cmd))))) (defn- encode-key [^long t] @@ -34,12 +42,17 @@ (some-> (kv/get kv-store :tx-error-index (encode-key t)) decode-tx-error)) -(defn- encode-tx-error [{::anom/keys [category message] :http/keys [status]}] - (cbor/write {:category (name category) :message message :http-status status})) +(defn- encode-tx-error + [{::anom/keys [category message] :http/keys [status] :blaze.db/keys [tx-cmd]}] + (cbor/write + (cond-> {:category (name category) :message message} + status + (assoc :http-status status) + tx-cmd + (assoc :tx-cmd tx-cmd)))) (defn index-entry "Returns an entry of the TxError index build from `t` and `anomaly`." [t anomaly] [:tx-error-index (encode-key t) (encode-tx-error anomaly)]) - diff --git a/modules/db/src/blaze/db/node.clj b/modules/db/src/blaze/db/node.clj index 8f90801f9..8bcc308bb 100644 --- a/modules/db/src/blaze/db/node.clj +++ b/modules/db/src/blaze/db/node.clj @@ -152,7 +152,10 @@ (fn [future state _ {:keys [e] new-t :t new-error-t :error-t}] (cond (<= t (max new-t new-error-t)) - (do (ac/complete! future (db/db node new-t)) + (do (log/trace "complete database future with new db with t =" new-t) + ;; it's important to complete async here, because otherwise all + ;; the later work will happen on the indexer thread + (ac/complete-async! future #(db/db node new-t)) (remove-watch state future)) e @@ -180,11 +183,13 @@ (defn- commit-error! [{:keys [kv-store state]} t anomaly] + (log/trace "commit transaction error with t =" t) (kv/put! kv-store [(tx-error/index-entry t anomaly)]) (advance-error-t! state t)) (defn- store-tx-entries! [kv-store entries] + (log/trace "store" (count entries) "transaction index entries") (with-open [_ (prom/timer duration-seconds "store-tx-entries")] (kv/put! kv-store entries))) @@ -208,6 +213,7 @@ (defn- commit-success! [{:keys [kv-store state]} t instant] + (log/trace "commit transaction success with t =" t) (kv/put! kv-store (tx-success-entries t instant)) (advance-t! state t)) diff --git a/modules/db/src/blaze/db/node/transaction.clj b/modules/db/src/blaze/db/node/transaction.clj index 9655555c7..4b1d3d523 100644 --- a/modules/db/src/blaze/db/node/transaction.clj +++ b/modules/db/src/blaze/db/node/transaction.clj @@ -6,7 +6,8 @@ [blaze.db.impl.index.tx-success :as tx-success] [blaze.fhir.hash :as hash] [blaze.fhir.spec :as fhir-spec] - [blaze.fhir.spec.type :as type])) + [blaze.fhir.spec.type :as type] + [taoensso.timbre :as log])) (defmulti prepare-op (fn [_ [op]] op)) @@ -37,7 +38,7 @@ (defmethod prepare-op :put - [{:keys [references-fn]} [op resource [precond-op precond]]] + [{:keys [references-fn]} [op resource [precond-op & precond-vals]]] (let [hash (hash/generate resource) refs (references-fn resource)] {:hash-resource @@ -51,9 +52,21 @@ (seq refs) (assoc :refs refs) (identical? :if-match precond-op) - (assoc :if-match precond) + (assoc :if-match (vec precond-vals)) (identical? :if-none-match precond-op) - (assoc :if-none-match (prepare-if-none-match precond)))})) + (assoc :if-none-match (prepare-if-none-match (first precond-vals))))})) + + +(defmethod prepare-op :keep + [_ [_ type id hash if-match]] + {:blaze.db/tx-cmd + (cond-> + {:op "keep" + :type type + :id id + :hash hash} + if-match + (assoc :if-match if-match))}) (defmethod prepare-op :delete @@ -93,6 +106,7 @@ (defn load-tx-result [{:keys [tx-cache kv-store] :as node} t] + (log/trace "load transaction result with t =" t) (if (tx-success/tx tx-cache t) (db/db node t) (if-let [anomaly (tx-error/tx-error kv-store t)] diff --git a/modules/db/src/blaze/db/node/tx_indexer/verify.clj b/modules/db/src/blaze/db/node/tx_indexer/verify.clj index 95af94e61..b3d72994a 100644 --- a/modules/db/src/blaze/db/node/tx_indexer/verify.clj +++ b/modules/db/src/blaze/db/node/tx_indexer/verify.clj @@ -9,6 +9,7 @@ [blaze.db.impl.index.type-stats :as type-stats] [blaze.db.kv.spec] [blaze.fhir.hash :as hash] + [blaze.util :as u] [clojure.string :as str] [prometheus.alpha :as prom :refer [defhistogram]] [taoensso.timbre :as log])) @@ -150,10 +151,14 @@ (update-in [:stats tid :total] inc-0))))) +(defn- print-etags [ts] + (str/join "," (map (partial format "W/\"%d\"") ts))) + + (defn- verify-tx-cmd-put-msg [type id if-match if-none-match] (cond if-match - (format "verify-tx-cmd :put %s/%s if-match: %d" type id if-match) + (format "verify-tx-cmd :put %s/%s if-match: %s" type id (print-etags if-match)) if-none-match (format "verify-tx-cmd :put %s/%s if-none-match: %s" type id if-none-match) :else @@ -161,11 +166,12 @@ (defn- precondition-failed-msg [if-match type id] - (format "Precondition `W/\"%d\"` failed on `%s/%s`." if-match type id)) + (format "Precondition `%s` failed on `%s/%s`." (print-etags if-match) type id)) -(defn- precondition-failed-anomaly [if-match type id] - (ba/conflict (precondition-failed-msg if-match type id) :http/status 412)) +(defn- precondition-failed-anomaly [if-match type id tx-cmd] + (ba/conflict (precondition-failed-msg if-match type id) + :http/status 412 :blaze.db/tx-cmd tx-cmd)) (defn- precondition-any-failed-msg [type id] @@ -185,15 +191,16 @@ (defmethod verify-tx-cmd "put" - [db-before t res {:keys [type id hash if-match if-none-match]}] - (log/trace (verify-tx-cmd-put-msg type id if-match if-none-match)) + [db-before t res {:keys [type id hash if-match if-none-match] :as tx-cmd}] + (log/trace (verify-tx-cmd-put-msg type id (u/to-seq if-match) if-none-match)) (with-open [_ (prom/timer duration-seconds "verify-put")] (let [tid (codec/tid type) - {:keys [num-changes op] :or {num-changes 0} old-t :t} + if-match (u/to-seq if-match) + {:keys [num-changes op] :or {num-changes 0} old-t :t old-hash :hash} (d/resource-handle db-before type id)] (cond - (and if-match (not= if-match old-t)) - (throw-anom (precondition-failed-anomaly if-match type id)) + (and if-match (not (some #{old-t} if-match))) + (throw-anom (precondition-failed-anomaly if-match type id tx-cmd)) (and (some? old-t) (= "*" if-none-match)) (throw-anom (precondition-any-failed-anomaly type id)) @@ -201,6 +208,9 @@ (and (some? old-t) (= if-none-match old-t)) (throw-anom (precondition-version-failed-anomaly type id if-none-match)) + (= old-hash hash) + res + :else (cond-> (-> (update res :entries into (index-entries tid id t hash (inc num-changes) :put)) @@ -210,6 +220,31 @@ (update-in [:stats tid :total] inc-0)))))) +(defn- verify-tx-cmd-keep-msg [type id if-match] + (if if-match + (format "verify-tx-cmd :keep %s/%s if-match: %s" type id (print-etags if-match)) + (format "verify-tx-cmd :keep %s/%s" type id))) + + +(defmethod verify-tx-cmd "keep" + [db-before _ res {:keys [type id hash if-match] :as tx-cmd}] + (log/trace (verify-tx-cmd-keep-msg type id (u/to-seq if-match))) + (with-open [_ (prom/timer duration-seconds "verify-keep")] + (let [if-match (u/to-seq if-match) + {old-hash :hash old-t :t} (d/resource-handle db-before type id)] + (cond + (and if-match (not (some #{old-t} if-match))) + (throw-anom (precondition-failed-anomaly if-match type id tx-cmd)) + + (not= hash old-hash) + (let [msg (format "Keep failed on `%s/%s`." type id)] + (log/trace msg) + (throw-anom (ba/conflict msg :blaze.db/tx-cmd tx-cmd))) + + :else + res)))) + + (defmethod verify-tx-cmd "delete" [db-before t res {:keys [type id]}] (log/trace "verify-tx-cmd :delete" (str type "/" id)) diff --git a/modules/db/src/blaze/db/node/validation.clj b/modules/db/src/blaze/db/node/validation.clj index 7622c8466..e70e454b5 100644 --- a/modules/db/src/blaze/db/node/validation.clj +++ b/modules/db/src/blaze/db/node/validation.clj @@ -17,6 +17,11 @@ [(name (fhir-spec/fhir-type resource)) id]) +(defmethod extract-type-id :keep + [[_ type id]] + [type id]) + + (defmethod extract-type-id :delete [[_ type id]] [type id]) diff --git a/modules/db/src/blaze/db/spec.clj b/modules/db/src/blaze/db/spec.clj index 8ccf54dad..4eff39add 100644 --- a/modules/db/src/blaze/db/spec.clj +++ b/modules/db/src/blaze/db/spec.clj @@ -11,8 +11,12 @@ [com.github.benmanes.caffeine.cache LoadingCache])) +(defn node? [x] + (satisfies? np/Node x)) + + (s/def :blaze.db/node - #(satisfies? np/Node %)) + node?) (defn loading-cache? [x] @@ -73,7 +77,7 @@ (defmethod put-precond-op :if-match [_] (s/cat :op #{:if-match} - :t :blaze.db/t)) + :ts (s/+ :blaze.db/t))) (defmethod put-precond-op :if-none-match [_] @@ -91,6 +95,14 @@ :precondition (s/? :blaze.db.tx-op.put/precondition))) +(defmethod tx-op :keep [_] + (s/cat :op #{:keep} + :type :fhir.resource/type + :id :blaze.resource/id + :hash :blaze.resource/hash + :if-match (s/? (s/coll-of :blaze.db/t :kind vector? :min-count 1)))) + + (defmethod tx-op :delete [_] (s/cat :op #{:delete} :type :fhir.resource/type diff --git a/modules/db/test/blaze/db/api_test.clj b/modules/db/test/blaze/db/api_test.clj index 5fc77b6eb..fdff82516 100644 --- a/modules/db/test/blaze/db/api_test.clj +++ b/modules/db/test/blaze/db/api_test.clj @@ -364,7 +364,20 @@ node [[:put {:fhir/type :fhir/Patient :id "0"} [:if-none-match 1]]]) ::anom/category := ::anom/conflict - ::anom/message := "Resource `Patient/0` with version 1 already exists."))))) + ::anom/message := "Resource `Patient/0` with version 1 already exists.")))) + + (testing "with identical content" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"female"}]] + [[:put {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"female"}]]] + + (testing "versionId is still 1" + (given @(d/pull node (d/resource-handle (d/db node) "Patient" "0")) + :fhir/type := :fhir/Patient + :id := "0" + [:meta :versionId] := #fhir/id"1" + :gender := #fhir/code"female" + [meta :blaze.db/op] := :put))))) (testing "Diamond Reference Dependencies" (with-system-data [{:blaze.db/keys [node]} config] @@ -4439,13 +4452,11 @@ [(type/coding {:system #fhir/uri"system" :code code})]})})] - (with-system [{:blaze.db/keys [node]} config] - @(d/transact - node - [[:put {:fhir/type :fhir/Patient :id "0"}] - [:put (observation "0" #fhir/code"code-1")] - [:put (observation "1" #fhir/code"code-2")] - [:put (observation "2" #fhir/code"code-3")]]) + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}] + [:put (observation "0" #fhir/code"code-1")] + [:put (observation "1" #fhir/code"code-2")] + [:put (observation "2" #fhir/code"code-3")]]] (given @(pull-compartment-query node "Patient" "0" "Observation" @@ -4465,19 +4476,15 @@ [(type/coding {:system #fhir/uri"system" :code code})]})})] - (with-system [{:blaze.db/keys [node]} config] - @(d/transact - node - [[:put {:fhir/type :fhir/Patient :id "0"}] - [:put (observation "0" #fhir/code"code-1")] - [:put (observation "1" #fhir/code"code-2")] - [:put (observation "2" #fhir/code"code-2")] - [:put (observation "3" #fhir/code"code-2")]]) - @(d/transact - node - [[:put (observation "0" #fhir/code"code-2")] - [:put (observation "1" #fhir/code"code-1")] - [:put (observation "3" #fhir/code"code-2")]]) + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}] + [:put (observation "0" #fhir/code"code-1")] + [:put (observation "1" #fhir/code"code-2")] + [:put (observation "2" #fhir/code"code-2")] + [:put (observation "3" #fhir/code"code-2")]] + [[:put (observation "0" #fhir/code"code-2")] + [:put (observation "1" #fhir/code"code-1")] + [:put (observation "3" #fhir/code"code-2")]]] (given @(pull-compartment-query node "Patient" "0" "Observation" @@ -4490,7 +4497,7 @@ [1 :id] := "2" [1 :meta :versionId] := #fhir/id"1" [2 :id] := "3" - [2 :meta :versionId] := #fhir/id"2")))) + [2 :meta :versionId] := #fhir/id"1")))) (testing "doesn't return deleted resources" (with-system-data [{:blaze.db/keys [node]} config] @@ -4520,15 +4527,11 @@ [(type/coding {:system #fhir/uri"system" :code code})]})})] - (with-system [{:blaze.db/keys [node]} config] - @(d/transact - node - [[:put {:fhir/type :fhir/Patient :id "0"}] - [:put (observation "0" #fhir/code"code")] - [:put (observation "1" #fhir/code"code")]]) - @(d/transact - node - [[:delete "Observation" "0"]]) + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put {:fhir/type :fhir/Patient :id "0"}] + [:put (observation "0" #fhir/code"code")] + [:put (observation "1" #fhir/code"code")]] + [[:delete "Observation" "0"]]] (given @(pull-compartment-query node "Patient" "0" "Observation" diff --git a/modules/db/test/blaze/db/impl/index/tx_error_test.clj b/modules/db/test/blaze/db/impl/index/tx_error_test.clj index 25dc3c182..7dbd7b679 100644 --- a/modules/db/test/blaze/db/impl/index/tx_error_test.clj +++ b/modules/db/test/blaze/db/impl/index/tx_error_test.clj @@ -38,4 +38,28 @@ (testing "nothing is found on empty db" (with-system [{kv-store ::kv/mem} config] - (is (nil? (tx-error/tx-error kv-store 1)))))) + (is (nil? (tx-error/tx-error kv-store 1))))) + + (testing "HTTP status can be stored" + (with-system [{kv-store ::kv/mem} config] + (kv/put! kv-store + [(tx-error/index-entry + 1 {::anom/category ::anom/conflict + :http/status 412})]) + + (given (tx-error/tx-error kv-store 1) + ::anom/category := ::anom/conflict + :http/status := 412))) + + (testing "Transaction command can be stored" + (let [tx-cmd {:op "keep" :type "Patient" :id "0" + :hash #blaze/hash"C9ADE22457D5AD750735B6B166E3CE8D6878D09B64C2C2868DCB6DE4C9EFBD4F"}] + (with-system [{kv-store ::kv/mem} config] + (kv/put! kv-store + [(tx-error/index-entry + 1 {::anom/category ::anom/fault + :blaze.db/tx-cmd tx-cmd})]) + + (given (tx-error/tx-error kv-store 1) + ::anom/category := ::anom/fault + :blaze.db/tx-cmd tx-cmd))))) diff --git a/modules/db/test/blaze/db/node/transaction_test.clj b/modules/db/test/blaze/db/node/transaction_test.clj index df5a141af..cca7ea1b8 100644 --- a/modules/db/test/blaze/db/node/transaction_test.clj +++ b/modules/db/test/blaze/db/node/transaction_test.clj @@ -5,9 +5,12 @@ [blaze.db.node.transaction :as tx] [blaze.db.node.transaction-spec] [blaze.fhir.spec.type] - [blaze.test-util :as tu] + [blaze.test-util :as tu :refer [satisfies-prop]] + [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [deftest testing]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] [cognitect.anomalies :as anom] [juxt.iota :refer [given]])) @@ -51,13 +54,13 @@ (testing "without value" (given (tx/prepare-ops - context - [[:create - {:fhir/type :fhir/Observation :id "0" - :subject #fhir/Reference - {:reference #fhir/string - {:extension [#fhir/Extension{:url "foo"}]}}}]]) - [0 0 :refs] :? empty?))) + context + [[:create + {:fhir/type :fhir/Observation :id "0" + :subject #fhir/Reference + {:reference #fhir/string + {:extension [#fhir/Extension{:url "foo"}]}}}]]) + [0 0 :refs] :? empty?))) (testing "with disabled referential integrity check" (given (tx/prepare-ops @@ -106,8 +109,26 @@ [0 0 :refs] :? empty?))) (testing "with matches" - (given (tx/prepare-ops context [[:put {:fhir/type :fhir/Patient :id "0"} [:if-match 4]]]) - [0 0 :if-match] := 4))) + (satisfies-prop 100 + (prop/for-all [if-match (gen/vector (s/gen :blaze.db/t) 1 10)] + (let [tx-op [:put {:fhir/type :fhir/Patient :id "0"} (into [:if-match] if-match)]] + (= if-match (:if-match (ffirst (tx/prepare-ops context [tx-op]))))))))) + + (testing "keep" + (let [hash #blaze/hash"7B3980C2BFCF43A8CDD61662E1AABDA9CA6431964820BC8D52958AEC9A270378"] + (testing "without any if-match ts" + (given (tx/prepare-ops context [[:keep "Patient" "0" hash]]) + [0 0 :op] := "keep" + [0 0 :type] := "Patient" + [0 0 :id] := "0" + [0 0 :hash] := hash + [1] := {})) + + (testing "with matches" + (satisfies-prop 100 + (prop/for-all [if-match (gen/vector (s/gen :blaze.db/t) 1 10)] + (let [tx-op [:keep "Patient" "0" hash if-match]] + (= if-match (:if-match (ffirst (tx/prepare-ops context [tx-op])))))))))) (testing "delete" (given (tx/prepare-ops context [[:delete "Patient" "0"]]) diff --git a/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj b/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj index 16ec13bd8..c0302f929 100644 --- a/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj +++ b/modules/db/test/blaze/db/node/tx_indexer/verify_test.clj @@ -77,7 +77,7 @@ (testing "adding a second version of a patient to a store containing it already" (let [hash (hash/generate patient-0-v2)] - (doseq [if-match [nil 1]] + (doseq [if-match [nil 1 [1] [1 2]]] (with-system-data [{:blaze.db/keys [node]} config] [[[:put patient-0]]] @@ -106,6 +106,115 @@ [4 1 ss-tu/decode-key] := {:t 2} [4 2 ss-tu/decode-val] := {:total 1 :num-changes 2}))))) + (testing "adding a second version of an already deleted patient" + (let [hash (hash/generate patient-0-v2)] + (doseq [if-match [nil 2 [2] [1 2]]] + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]] + [[:delete "Patient" "0"]]] + + (given (verify/verify-tx-cmds + (d/db node) 3 + [(cond-> {:op "put" :type "Patient" :id "0" :hash hash} + if-match + (assoc :if-match if-match))]) + [0 0] := :resource-as-of-index + [0 1 rao-tu/decode-key] := {:type "Patient" :id "0" :t 3} + [0 2 rao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + + [1 0] := :type-as-of-index + [1 1 tao-tu/decode-key] := {:type "Patient" :t 3 :id "0"} + [1 2 tao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + + [2 0] := :system-as-of-index + [2 1 sao-tu/decode-key] := {:t 3 :type "Patient" :id "0"} + [2 2 sao-tu/decode-val] := {:hash hash :num-changes 3 :op :put} + + [3 0] := :type-stats-index + [3 1 ts-tu/decode-key] := {:type "Patient" :t 3} + [3 2 ts-tu/decode-val] := {:total 1 :num-changes 3} + + [4 0] := :system-stats-index + [4 1 ss-tu/decode-key] := {:t 3} + [4 2 ss-tu/decode-val] := {:total 1 :num-changes 3}))))) + + (testing "adding a patient with identical content" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]]] + + (is (empty? (verify/verify-tx-cmds + (d/db node) 2 + [{:op "put" :type "Patient" :id "0" + :hash (hash/generate patient-0)}]))))) + + (testing "keeping a non-existing patient fails" + (with-system [{:blaze.db/keys [node]} config] + + (let [tx-cmd {:op "keep" :type "Patient" :id "0" :hash (hash/generate patient-0)}] + (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + ::anom/category := ::anom/conflict + ::anom/message := "Keep failed on `Patient/0`." + :blaze.db/tx-cmd := tx-cmd)))) + + (testing "keeping a non-matching patient fails" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]] + [[:put patient-0-v2]]] + + (let [tx-cmd {:op "keep" :type "Patient" :id "0" :hash (hash/generate patient-0)}] + (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + ::anom/category := ::anom/conflict + ::anom/message := "Keep failed on `Patient/0`." + :blaze.db/tx-cmd := tx-cmd)))) + + (testing "keeping a hash matching but non-matching if-match patient fails" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]] + [[:put patient-0-v2]]] + + (testing "with a precondition failure" + (doseq [if-match [3 [3]]] + (let [tx-cmd {:op "keep" :type "Patient" :id "0" + :hash (hash/generate patient-0-v2) + :if-match if-match}] + (given (verify/verify-tx-cmds + (d/db node) 1 + [tx-cmd]) + ::anom/category := ::anom/conflict + ::anom/message := "Precondition `W/\"3\"` failed on `Patient/0`." + :http/status := 412 + :blaze.db/tx-cmd := tx-cmd)))))) + + (testing "keeping a non-matching hash and non-matching if-match patient fails" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]] + [[:put patient-0-v2]]] + + (testing "with a precondition failure" + (doseq [if-match [3 [3]]] + (let [tx-cmd {:op "keep" :type "Patient" :id "0" + :hash (hash/generate patient-0) + :if-match if-match}] + (given (verify/verify-tx-cmds (d/db node) 1 [tx-cmd]) + ::anom/category := ::anom/conflict + ::anom/message := "Precondition `W/\"3\"` failed on `Patient/0`." + :http/status := 412 + :blaze.db/tx-cmd := tx-cmd)))))) + + (testing "keeping a matching patient" + (with-system-data [{:blaze.db/keys [node]} config] + [[[:put patient-0]]] + + (testing "with different if-matches" + (doseq [if-match [nil 1 [1] [1 2]]] + (is (empty? (verify/verify-tx-cmds + (d/db node) 1 + [(cond-> + {:op "keep" :type "Patient" :id "0" + :hash (hash/generate patient-0)} + if-match + (assoc :if-match if-match))]))))))) + (testing "deleting a patient from an empty store" (with-system [{:blaze.db/keys [node]} config] (given (verify/verify-tx-cmds diff --git a/modules/db/test/blaze/db/node/validation_test.clj b/modules/db/test/blaze/db/node/validation_test.clj index 8701d7a19..69379f062 100644 --- a/modules/db/test/blaze/db/node/validation_test.clj +++ b/modules/db/test/blaze/db/node/validation_test.clj @@ -16,6 +16,16 @@ (deftest validate-ops-test + (testing "single keep" + (is (nil? (validation/validate-ops [[:keep "Patient" "0" #blaze/hash"7B3980C2BFCF43A8CDD61662E1AABDA9CA6431964820BC8D52958AEC9A270378"]])))) + + (testing "duplicate keep" + (given (validation/validate-ops [[:keep "Patient" "0" #blaze/hash"7B3980C2BFCF43A8CDD61662E1AABDA9CA6431964820BC8D52958AEC9A270378"] + [:keep "Patient" "0" #blaze/hash"C9ADE22457D5AD750735B6B166E3CE8D6878D09B64C2C2868DCB6DE4C9EFBD4F"]]) + ::anom/category := ::anom/incorrect + :cognitect.anomalies/message := "Duplicate resource `Patient/0`.", + :fhir/issue := "invariant")) + (testing "single delete" (is (nil? (validation/validate-ops [[:delete "Patient" "0"]])))) @@ -24,4 +34,11 @@ [:delete "Patient" "0"]]) ::anom/category := ::anom/incorrect :cognitect.anomalies/message := "Duplicate resource `Patient/0`.", + :fhir/issue := "invariant")) + + (testing "duplicate keep/delete" + (given (validation/validate-ops [[:keep "Patient" "0" #blaze/hash"C9ADE22457D5AD750735B6B166E3CE8D6878D09B64C2C2868DCB6DE4C9EFBD4F"] + [:delete "Patient" "0"]]) + ::anom/category := ::anom/incorrect + :cognitect.anomalies/message := "Duplicate resource `Patient/0`.", :fhir/issue := "invariant"))) diff --git a/modules/fhir-client/src/blaze/fhir_client.clj b/modules/fhir-client/src/blaze/fhir_client.clj index c08bec00c..607b43a24 100644 --- a/modules/fhir-client/src/blaze/fhir_client.clj +++ b/modules/fhir-client/src/blaze/fhir_client.clj @@ -35,6 +35,13 @@ (impl/update (str base-uri "/" (name type) "/" id) resource opts)) +(defn transact + "Returns a CompletableFuture that completes with `bundle` transacted." + {:arglists '([base-uri bundle & [opts]])} + [base-uri bundle & [opts]] + (impl/transact base-uri bundle opts)) + + (defn- execute-type-get-msg [type name {:keys [query-params]}] (format "Execute $%s on type %s with params %s" name type query-params)) diff --git a/modules/fhir-client/src/blaze/fhir_client/impl.clj b/modules/fhir-client/src/blaze/fhir_client/impl.clj index 0d2c373d3..7a14431a6 100644 --- a/modules/fhir-client/src/blaze/fhir_client/impl.clj +++ b/modules/fhir-client/src/blaze/fhir_client/impl.clj @@ -120,6 +120,21 @@ handle-error)) +(defn transact [uri bundle opts] + (log/trace "Transact") + (hc/post + uri + (merge + {:accept :fhir+json + :content-type :fhir+json + :body (generate-body bundle) + :as :fhir + :async? true} + opts) + :body + handle-error)) + + (defn- next-url [page] (type/value (:url (first (filter (comp #{"next"} :relation) (:link page)))))) diff --git a/modules/fhir-client/src/blaze/fhir_client_spec.clj b/modules/fhir-client/src/blaze/fhir_client_spec.clj index 36817a13f..9944eb3a8 100644 --- a/modules/fhir-client/src/blaze/fhir_client_spec.clj +++ b/modules/fhir-client/src/blaze/fhir_client_spec.clj @@ -29,6 +29,12 @@ :ret ac/completable-future?) +(s/fdef fhir-client/transact + :args (s/cat :base-uri string? :bundle :blaze/resource + :opts (s/? :blaze.fhir-client/options)) + :ret ac/completable-future?) + + (s/fdef fhir-client/execute-type-get :args (s/cat :base-uri string? :type :fhir.resource/type :name string? :opts (s/? :blaze.fhir-client/options)) diff --git a/modules/fhir-client/test/blaze/fhir_client_test.clj b/modules/fhir-client/test/blaze/fhir_client_test.clj index 76d703178..afaa35f12 100644 --- a/modules/fhir-client/test/blaze/fhir_client_test.clj +++ b/modules/fhir-client/test/blaze/fhir_client_test.clj @@ -5,13 +5,13 @@ [blaze.fhir.spec.type] [blaze.test-util :as tu :refer [given-failed-future]] [clojure.spec.test.alpha :as st] - [clojure.test :as test :refer [are deftest is testing]] + [clojure.test :as test :refer [deftest is testing]] [cognitect.anomalies :as anom] [jsonista.core :as j] [juxt.iota :refer [given]] [taoensso.timbre :as log]) (:import - [com.pgssoft.httpclient HttpClientMock Condition] + [com.pgssoft.httpclient Condition HttpClientMock] [java.nio.file Files Path] [java.nio.file.attribute FileAttribute])) @@ -75,7 +75,7 @@ (given-failed-future (fhir-client/read "http://localhost:8080/fhir" "Patient" "0" - {:http-client http-client}) + {:http-client http-client}) ::anom/category := ::anom/not-found [:fhir/issues 0 :severity] := #fhir/code"error" [:fhir/issues 0 :code] := #fhir/code"not-found"))) @@ -112,7 +112,7 @@ (given-failed-future (fhir-client/read "http://localhost:8080/fhir" "Patient" "0" - {:http-client http-client}) + {:http-client http-client}) ::anom/category := ::anom/unavailable))) (testing "Gateway timeout without JSON response (external load-balancer)" @@ -185,6 +185,28 @@ [:fhir/issues 0 :severity] := #fhir/code"error")))) +(deftest transact-test + (let [http-client (HttpClientMock.) + bundle {:fhir/type :fhir/Bundle + :type #fhir/code"transaction" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0"}}]}] + + (-> (.onPost http-client "http://localhost:8080/fhir") + (.doReturn (j/write-value-as-string {:resourceType "Bundle"})) + (.withHeader "content-type" "application/fhir+json")) + + (given @(fhir-client/transact "http://localhost:8080/fhir" bundle + {:http-client http-client}) + :fhir/type := :fhir/Bundle))) + + (deftest execute-type-get-test (testing "success" (let [http-client (HttpClientMock.)] diff --git a/modules/interaction/.clj-kondo/config.edn b/modules/interaction/.clj-kondo/config.edn index 8aa8bb1e8..3578e40fa 100644 --- a/modules/interaction/.clj-kondo/config.edn +++ b/modules/interaction/.clj-kondo/config.edn @@ -37,6 +37,7 @@ {:aliases {blaze.db.api d blaze.test-util tu + blaze.util u cuerdas.core c-str ring.util.response ring}}} diff --git a/modules/interaction/src/blaze/interaction/create.clj b/modules/interaction/src/blaze/interaction/create.clj index 9632b09b0..cb68bf82d 100644 --- a/modules/interaction/src/blaze/interaction/create.clj +++ b/modules/interaction/src/blaze/interaction/create.clj @@ -3,14 +3,13 @@ https://www.hl7.org/fhir/http.html#create" (:require - [blaze.anomaly :as ba] + [blaze.anomaly :as ba :refer [if-ok]] [blaze.async.comp :as ac] [blaze.db.api :as d] [blaze.db.spec] [blaze.fhir.response.create :as response] [blaze.fhir.spec.type :as type] [blaze.handler.util :as handler-util] - [blaze.interaction.create.spec] [blaze.interaction.util :as iu] [clojure.spec.alpha :as s] [clojure.string :as str] @@ -37,9 +36,7 @@ (ba/incorrect (resource-type-mismatch-msg type body) :fhir/issue "invariant" - :fhir/operation-outcome "MSG_RESOURCE_TYPE_MISMATCH") - - :else body)) + :fhir/operation-outcome "MSG_RESOURCE_TYPE_MISMATCH"))) (defn- create-op [resource conditional-clauses] @@ -66,39 +63,36 @@ (:hash resource-handle))) -(defn- handler [{:keys [node executor] :as context}] +(defn- handler [{:keys [node] :as context}] (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match :keys [headers body] :as request}] - (let [id (iu/luid context) - conditional-clauses (conditional-clauses headers)] - (-> (ac/completed-future (validate-resource type body)) - (ac/then-apply #(assoc % :id id)) - (ac/then-compose - #(d/transact node [(create-op % conditional-clauses)])) - ;; it's important to switch to the executor here, because otherwise - ;; the central indexing thread would execute response building. - (ac/then-apply-async identity executor) - (ac/then-compose - (fn [db-after] - (if-let [handle (d/resource-handle db-after type id)] - (response/build-response - (response-context request db-after) nil handle) - (let [handle (first (d/type-query db-after type conditional-clauses))] + (if-ok [_ (validate-resource type body)] + (let [id (iu/luid context) + conditional-clauses (conditional-clauses headers) + tx-op (create-op (assoc body :id id) conditional-clauses)] + (-> (d/transact node [tx-op]) + (ac/then-compose + (fn [db-after] + (if-let [handle (d/resource-handle db-after type id)] (response/build-response - (response-context request db-after) handle handle))))) - (ac/exceptionally - (fn [e] - (cond-> e - (ba/not-found? e) - (assoc - ::anom/category ::anom/fault - ::anom/message (resource-content-not-found-msg e) - :fhir/issue "incomplete")))))))) + (response-context request db-after) tx-op nil handle) + (let [handle (first (d/type-query db-after type conditional-clauses))] + (response/build-response + (response-context request db-after) tx-op handle handle))))) + (ac/exceptionally + (fn [e] + (cond-> e + (ba/not-found? e) + (assoc + ::anom/category ::anom/fault + ::anom/message (resource-content-not-found-msg e) + :fhir/issue "incomplete")))))) + ac/completed-future))) (defmethod ig/pre-init-spec :blaze.interaction/create [_] - (s/keys :req-un [:blaze.db/node ::executor :blaze/clock :blaze/rng-fn])) + (s/keys :req-un [:blaze.db/node :blaze/clock :blaze/rng-fn])) (defmethod ig/init-key :blaze.interaction/create [_ context] diff --git a/modules/interaction/src/blaze/interaction/create/spec.clj b/modules/interaction/src/blaze/interaction/create/spec.clj deleted file mode 100644 index 700853452..000000000 --- a/modules/interaction/src/blaze/interaction/create/spec.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns blaze.interaction.create.spec - (:require - [blaze.executors :as ex] - [clojure.spec.alpha :as s])) - - -(s/def :blaze.interaction.create/executor - ex/executor?) diff --git a/modules/interaction/src/blaze/interaction/delete.clj b/modules/interaction/src/blaze/interaction/delete.clj index e60efa7cf..973906878 100644 --- a/modules/interaction/src/blaze/interaction/delete.clj +++ b/modules/interaction/src/blaze/interaction/delete.clj @@ -6,7 +6,6 @@ [blaze.async.comp :as ac] [blaze.db.api :as d] [blaze.db.spec] - [blaze.interaction.delete.spec] [clojure.spec.alpha :as s] [integrant.core :as ig] [reitit.core :as reitit] @@ -37,15 +36,12 @@ (defmethod ig/pre-init-spec :blaze.interaction/delete [_] - (s/keys :req-un [:blaze.db/node ::executor])) + (s/keys :req-un [:blaze.db/node])) -(defmethod ig/init-key :blaze.interaction/delete [_ {:keys [node executor]}] +(defmethod ig/init-key :blaze.interaction/delete [_ {:keys [node]}] (log/info "Init FHIR delete interaction handler") (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match {:keys [id]} :path-params}] (-> (d/transact node [[:delete type id]]) - ;; it's important to switch to the executor here, - ;; because otherwise the central indexing thread would execute - ;; response building. - (ac/then-apply-async build-response executor)))) + (ac/then-apply build-response)))) diff --git a/modules/interaction/src/blaze/interaction/delete/spec.clj b/modules/interaction/src/blaze/interaction/delete/spec.clj deleted file mode 100644 index 29b721794..000000000 --- a/modules/interaction/src/blaze/interaction/delete/spec.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns blaze.interaction.delete.spec - (:require - [blaze.executors :as ex] - [clojure.spec.alpha :as s])) - - -(s/def :blaze.interaction.delete/executor - ex/executor?) diff --git a/modules/interaction/src/blaze/interaction/history/util.clj b/modules/interaction/src/blaze/interaction/history/util.clj index a6daa3319..e6d7faf74 100644 --- a/modules/interaction/src/blaze/interaction/history/util.clj +++ b/modules/interaction/src/blaze/interaction/history/util.clj @@ -3,6 +3,7 @@ [blaze.fhir.spec.type :as type] [blaze.handler.fhir.util :as fhir-util] [blaze.interaction.util :as iu] + [blaze.util :as u] [reitit.core :as reitit]) (:import [java.time Instant OffsetDateTime] @@ -22,7 +23,7 @@ #(try (Instant/from (OffsetDateTime/parse %)) (catch DateTimeParseException _)) - (fhir-util/to-seq v))) + (u/to-seq v))) (defn page-t @@ -30,7 +31,7 @@ start with a database as-of `page-t`." {:arglists '([query-params])} [{v "__page-t"}] - (some fhir-util/parse-nat-long (fhir-util/to-seq v))) + (some fhir-util/parse-nat-long (u/to-seq v))) (defn nav-url diff --git a/modules/interaction/src/blaze/interaction/search/params/include.clj b/modules/interaction/src/blaze/interaction/search/params/include.clj index 9c409384a..fb1dd0d33 100644 --- a/modules/interaction/src/blaze/interaction/search/params/include.clj +++ b/modules/interaction/src/blaze/interaction/search/params/include.clj @@ -1,8 +1,7 @@ (ns blaze.interaction.search.params.include (:require [blaze.anomaly :as ba :refer [when-ok]] - [blaze.handler.fhir.util :as fhir-util] - [blaze.util :refer [conj-vec]] + [blaze.util :as u] [clojure.string :as str])) @@ -26,13 +25,13 @@ (comp (filter (fn [[k]] (= name k))) (mapcat - (fn [[_k v]] (keep #(forward-value handling %) (fhir-util/to-seq v))))) + (fn [[_k v]] (keep #(forward-value handling %) (u/to-seq v))))) (completing (fn [res x] (if (ba/anomaly? x) (reduced x) (let [[source-type include-def] x] - (update res source-type conj-vec include-def))))) + (update res source-type u/conj-vec include-def))))) {} query-params)) @@ -50,13 +49,13 @@ (comp (filter (fn [[k]] (= name k))) (mapcat - (fn [[_k v]] (keep #(reverse-value handling %) (fhir-util/to-seq v))))) + (fn [[_k v]] (keep #(reverse-value handling %) (u/to-seq v))))) (completing (fn [res x] (if (ba/anomaly? x) (reduced x) (let [[target-type include-def] x] - (update res target-type conj-vec include-def))))) + (update res target-type u/conj-vec include-def))))) {} query-params)) diff --git a/modules/interaction/src/blaze/interaction/transaction.clj b/modules/interaction/src/blaze/interaction/transaction.clj index 790388e88..7028d878a 100644 --- a/modules/interaction/src/blaze/interaction/transaction.clj +++ b/modules/interaction/src/blaze/interaction/transaction.clj @@ -6,14 +6,12 @@ [blaze.anomaly :as ba :refer [if-ok when-ok]] [blaze.async.comp :as ac :refer [do-sync]] [blaze.db.api :as d] - [blaze.executors :as ex] [blaze.fhir.spec :as fhir-spec] [blaze.fhir.spec.type :as type] [blaze.handler.fhir.util :as fhir-util] [blaze.handler.util :as handler-util] [blaze.interaction.transaction.bundle :as bundle] [blaze.interaction.transaction.bundle.url :as url] - [blaze.interaction.transaction.spec] [blaze.interaction.util :as iu] [blaze.spec] [clojure.spec.alpha :as s] @@ -332,30 +330,32 @@ (defn- update-entry - [{:keys [db] :as context} type {:keys [num-changes id] :as handle}] + [{:keys [db] :as context} type tx-op old-handle {:keys [id] :as handle}] (let [tx (d/tx db (:t handle)) - vid (str (:blaze.db/t tx))] + vid (str (:blaze.db/t tx)) + created (and (not (iu/keep? tx-op)) + (or (nil? old-handle) (identical? :delete (:op old-handle))))] {:fhir/type :fhir.Bundle/entry :response (cond-> {:fhir/type :fhir.Bundle.entry/response - :status (if (= 1 num-changes) "201" "200") + :status (if created "201" "200") :etag (str "W/\"" vid "\"") :lastModified (:blaze.db.tx/instant tx)} - (= 1 num-changes) + created (assoc :location (location context type id vid)))})) (defmethod build-response-entry "PUT" [{:keys [db return-preference] :as context} _ - {{:fhir/keys [type] :keys [id]} :resource}] + {{:fhir/keys [type] :keys [id]} :resource :keys [tx-op]}] (let [type (name type) - handle (d/resource-handle db type id)] + [new-handle old-handle] (take 2 (d/instance-history db type id))] (if (identical? :blaze.preference.return/representation return-preference) - (do-sync [resource (pull db handle)] - (assoc (update-entry context type handle) :resource resource)) - (ac/completed-future (update-entry context type handle))))) + (do-sync [resource (pull db new-handle)] + (assoc (update-entry context type tx-op old-handle new-handle) :resource resource)) + (ac/completed-future (update-entry context type tx-op old-handle new-handle))))) (defmethod build-response-entry "DELETE" @@ -372,9 +372,7 @@ (defn- build-response-entries* [{:keys [db] :as context} entries] (with-open [batch-db (d/new-batch-db db)] - (->> entries - (map-indexed (partial build-response-entry (assoc context :db batch-db))) - doall))) + (into [] (map-indexed (partial build-response-entry (assoc context :db batch-db))) entries))) (defn- build-response-entries [context entries] @@ -517,17 +515,21 @@ (mapv ac/join futures)))) +(defn- transact [{:keys [node] :as context} entries] + (if-ok [entries (bundle/assoc-tx-ops (d/db node) entries)] + (-> (let [tx-ops (bundle/tx-ops entries)] + (if (empty? tx-ops) + (d/sync node) + (d/transact node tx-ops))) + (ac/then-compose #(build-response-entries (assoc context :db %) entries))) + ac/completed-future)) + + (defmethod process-entries "transaction" - [{:keys [node executor] :as context} _ entries] - (let [writes (bundle/writes entries)] - (-> (if (empty? writes) - (d/sync node) - (d/transact node (bundle/tx-ops writes))) - ;; it's important to switch to the executor here, because otherwise - ;; the central indexing thread would execute response building. - (ac/then-compose-async - #(build-response-entries (assoc context :db %) entries) - executor)))) + [context _ entries] + (ac/retry2 #(transact context entries) + #(and (ba/conflict? %) (= "keep" (-> % :blaze.db/tx-cmd :op)) + (nil? (:http/status %))))) (defn- process-context @@ -550,28 +552,15 @@ (defmethod ig/pre-init-spec :blaze.interaction/transaction [_] - (s/keys :req-un [:blaze.db/node ::executor :blaze/clock :blaze/rng-fn])) + (s/keys :req-un [:blaze.db/node :blaze/clock :blaze/rng-fn])) (defmethod ig/init-key :blaze.interaction/transaction [_ context] (log/info "Init FHIR transaction interaction handler") (fn [{{:keys [type] :as bundle} :body :as request}] - (-> (ac/completed-future (validate-and-prepare-bundle context bundle)) - (ac/then-compose - #(if (empty? %) - (ac/completed-future []) - (process-entries (process-context context request) request %))) - (ac/then-apply #(ring/response (response-bundle context type %)))))) - - -(defn- executor-init-msg [] - (format "Init FHIR transaction interaction executor with %d threads" - (.availableProcessors (Runtime/getRuntime)))) - - -(defmethod ig/init-key ::executor [_ _] - (log/info (executor-init-msg)) - (ex/cpu-bound-pool "blaze-transaction-interaction-%d")) - - -(derive ::executor :blaze.metrics/thread-pool-executor) + (if-ok [bundle (validate-and-prepare-bundle context bundle)] + (-> (if (empty? bundle) + (ac/completed-future []) + (process-entries (process-context context request) request bundle)) + (ac/then-apply #(ring/response (response-bundle context type %)))) + ac/completed-future))) diff --git a/modules/interaction/src/blaze/interaction/transaction/bundle.clj b/modules/interaction/src/blaze/interaction/transaction/bundle.clj index accdc95fc..c7175643b 100644 --- a/modules/interaction/src/blaze/interaction/transaction/bundle.clj +++ b/modules/interaction/src/blaze/interaction/transaction/bundle.clj @@ -1,7 +1,7 @@ (ns blaze.interaction.transaction.bundle "FHIR Bundle specific stuff." (:require - [blaze.anomaly :as ba] + [blaze.anomaly :as ba :refer [when-ok]] [blaze.fhir.spec.type :as type] [blaze.interaction.transaction.bundle.links :as links] [blaze.interaction.transaction.bundle.url :as url] @@ -20,7 +20,7 @@ (filterv write? entries)) -(defmulti entry-tx-op (fn [{{:keys [method]} :request}] (type/value method))) +(defmulti entry-tx-op (fn [_ {{:keys [method]} :request}] (type/value method))) (defn- conditional-clauses [if-none-exist] @@ -29,29 +29,44 @@ (defmethod entry-tx-op "POST" - [{:keys [resource] {if-none-exist :ifNoneExist} :request}] + [_ {:keys [resource] {if-none-exist :ifNoneExist} :request :as entry}] (let [clauses (conditional-clauses if-none-exist)] - (cond-> - [:create resource] - (seq clauses) - (conj clauses)))) + (assoc entry + :tx-op + (cond-> + [:create (iu/strip-meta resource)] + (seq clauses) + (conj clauses))))) (defmethod entry-tx-op "PUT" - [{{if-match :ifMatch if-none-match :ifNoneMatch} :request :keys [resource]}] - (iu/put-tx-op resource if-match if-none-match)) + [db {{if-match :ifMatch if-none-match :ifNoneMatch} :request :keys [resource] + :as entry}] + (when-ok [tx-op (iu/update-tx-op db (iu/strip-meta resource) if-match + if-none-match)] + (assoc entry :tx-op tx-op))) (defmethod entry-tx-op "DELETE" - [{{:keys [url]} :request}] + [_ {{:keys [url]} :request :as entry}] (let [[type id] (url/match-url (type/value url))] - [:delete type id])) + (assoc entry :tx-op [:delete type id]))) -(defn tx-ops - "Returns transaction operations of all `entries` of a transaction bundle." - [entries] +(defmethod entry-tx-op :default + [_ entry] + entry) + + +(defn assoc-tx-ops + "Returns `entries` with transaction operation associated under :tx-op. Or an + anomaly in case of errors." + [db entries] (transduce - (comp (map entry-tx-op) (halt-when ba/anomaly?)) + (comp (map (partial entry-tx-op db)) (halt-when ba/anomaly?)) conj (links/resolve-entry-links entries))) + + +(defn tx-ops [entries] + (into [] (keep :tx-op) entries)) diff --git a/modules/interaction/src/blaze/interaction/transaction/spec.clj b/modules/interaction/src/blaze/interaction/transaction/spec.clj deleted file mode 100644 index ebdf498ff..000000000 --- a/modules/interaction/src/blaze/interaction/transaction/spec.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns blaze.interaction.transaction.spec - (:require - [blaze.executors :as ex] - [clojure.spec.alpha :as s])) - - -(s/def :blaze.interaction.transaction/executor - ex/executor?) diff --git a/modules/interaction/src/blaze/interaction/update.clj b/modules/interaction/src/blaze/interaction/update.clj index 8a877e6a0..13814ad97 100644 --- a/modules/interaction/src/blaze/interaction/update.clj +++ b/modules/interaction/src/blaze/interaction/update.clj @@ -3,13 +3,12 @@ https://www.hl7.org/fhir/http.html#update" (:require - [blaze.anomaly :as ba] + [blaze.anomaly :as ba :refer [if-ok]] [blaze.async.comp :as ac] [blaze.db.api :as d] [blaze.fhir.response.create :as response] [blaze.fhir.spec.type :as type] [blaze.handler.util :as handler-util] - [blaze.interaction.update.spec] [blaze.interaction.util :as iu] [clojure.spec.alpha :as s] [cognitect.anomalies :as anom] @@ -56,13 +55,7 @@ (->> body :meta :tag (some iu/subsetted?)) (ba/incorrect "Resources with tag SUBSETTED may be incomplete and so can't be used in updates." - :fhir/issue "processing") - - :else body)) - - -(defn- tx-op [resource {:strs [if-match if-none-match]}] - (iu/put-tx-op resource if-match if-none-match)) + :fhir/issue "processing"))) (defn- response-context [{:keys [headers] :as request} db-after] @@ -72,42 +65,48 @@ (assoc :blaze.preference/return return-preference)))) -(defn- db-before [db-after] - (d/as-of db-after (dec (d/basis-t db-after)))) - - (defn- resource-content-not-found-msg [{:blaze.db/keys [resource-handle]}] (format "The resource `%s/%s` was successfully updated but it's content with hash `%s` was not found during response creation." (name (type/type resource-handle)) (:id resource-handle) (:hash resource-handle))) +(defn- update-resource + [{:keys [node]} + {{:strs [if-match if-none-match]} :headers :as request} + {:fhir/keys [type] :keys [id] :as resource}] + (if-ok [tx-op (iu/update-tx-op (d/db node) resource if-match if-none-match)] + (-> (d/transact node [tx-op]) + (ac/then-compose + (fn [db-after] + (let [[new-handle old-handle] (take 2 (d/instance-history db-after (name type) id))] + (response/build-response + (response-context request db-after) + tx-op + old-handle + new-handle))))) + ac/completed-future)) + + (defmethod ig/pre-init-spec :blaze.interaction/update [_] - (s/keys :req-un [:blaze.db/node ::executor])) + (s/keys :req-un [:blaze.db/node])) -(defmethod ig/init-key :blaze.interaction/update [_ {:keys [node executor]}] +(defmethod ig/init-key :blaze.interaction/update [_ context] (log/info "Init FHIR update interaction handler") (fn [{{{:fhir.resource/keys [type]} :data} ::reitit/match - {:keys [id]} :path-params - :keys [headers body] - :as request}] - (-> (ac/completed-future (validate-resource type id body)) - (ac/then-compose #(d/transact node [(tx-op % headers)])) - ;; it's important to switch to the executor here, because otherwise - ;; the central indexing thread would execute response building. - (ac/then-apply-async identity executor) - (ac/then-compose - (fn [db-after] - (response/build-response - (response-context request db-after) - (d/resource-handle (db-before db-after) type id) - (d/resource-handle db-after type id)))) - (ac/exceptionally - (fn [e] - (cond-> e - (ba/not-found? e) - (assoc - ::anom/category ::anom/fault - ::anom/message (resource-content-not-found-msg e) - :fhir/issue "incomplete"))))))) + {:keys [id]} :path-params :keys [body] :as request}] + (if-ok [_ (validate-resource type id body) + resource (iu/strip-meta body)] + (-> (ac/retry2 #(update-resource context request resource) + #(and (ba/conflict? %) (= "keep" (-> % :blaze.db/tx-cmd :op)) + (nil? (:http/status %)))) + (ac/exceptionally + (fn [e] + (cond-> e + (ba/not-found? e) + (assoc + ::anom/category ::anom/fault + ::anom/message (resource-content-not-found-msg e) + :fhir/issue "incomplete"))))) + ac/completed-future))) diff --git a/modules/interaction/src/blaze/interaction/update/spec.clj b/modules/interaction/src/blaze/interaction/update/spec.clj deleted file mode 100644 index bdf995d6d..000000000 --- a/modules/interaction/src/blaze/interaction/update/spec.clj +++ /dev/null @@ -1,8 +0,0 @@ -(ns blaze.interaction.update.spec - (:require - [blaze.executors :as ex] - [clojure.spec.alpha :as s])) - - -(s/def :blaze.interaction.update/executor - ex/executor?) diff --git a/modules/interaction/src/blaze/interaction/util.clj b/modules/interaction/src/blaze/interaction/util.clj index 6a7de11a2..c08d1f1fe 100644 --- a/modules/interaction/src/blaze/interaction/util.clj +++ b/modules/interaction/src/blaze/interaction/util.clj @@ -2,8 +2,10 @@ (:require [blaze.anomaly :as ba] [blaze.db.api :as d] - [blaze.handler.fhir.util :as fhir-util] + [blaze.fhir.hash :as hash] + [blaze.fhir.spec.type :as type] [blaze.luid :as luid] + [blaze.util :as u] [clojure.string :as str] [cuerdas.core :as c-str])) @@ -25,7 +27,7 @@ [[k v]] (map #(into [k] (map str/trim) (str/split % #",")) - (fhir-util/to-seq v))) + (u/to-seq v))) (def ^:private query-params->clauses-xf @@ -71,15 +73,76 @@ (etag->t if-none-match))) -(defn put-tx-op [resource if-match if-none-match] - (let [if-match (some-> if-match etag->t) +(defn- parse-if-match [if-match] + (keep etag->t (str/split if-match #","))) + + +(defn- precondition-failed-msg [{:fhir/keys [type] :keys [id]} if-match] + (if (str/blank? if-match) + (format "Empty precondition failed on `%s/%s`." (name type) id) + (format "Precondition `%s` failed on `%s/%s`." if-match (name type) id))) + + +(defn- update-tx-op-no-preconditions + [db {:fhir/keys [type] :keys [id] :as resource}] + (if-let [resource-handle (d/resource-handle db (name type) id)] + (let [new-hash (hash/generate resource)] + (if (= (:hash resource-handle) new-hash) + [:keep (name type) id new-hash] + [:put resource])) + [:put resource])) + + +(defn- update-tx-op-if-match + [db {:fhir/keys [type] :keys [id] :as resource} if-match ts] + (if-let [resource-handle (d/resource-handle db (name type) id)] + (let [new-hash (hash/generate resource)] + (if (= (:hash resource-handle) new-hash) + (let [t (:t resource-handle)] + (cond + (some #{t} ts) + [:keep (name type) id new-hash (filterv (partial <= t) ts)] + (every? (partial > t) ts) + (ba/conflict (precondition-failed-msg resource if-match) + :http/status 412) + :else + [:put resource (into [:if-match] (filter (partial < t) ts))])) + [:put resource (into [:if-match] ts)])) + [:put resource (into [:if-match] ts)])) + + +(defn update-tx-op + "Returns either a put or a keep tx-op with `resource` and possible + preconditions from `if-match` and `if-none-match` or an anomaly." + [db resource if-match if-none-match] + (let [parsed-if-match (some-> if-match parse-if-match) if-none-match (some-> if-none-match prep-if-none-match)] (cond - if-match [:put resource [:if-match if-match]] + (and (some? parsed-if-match) (empty? parsed-if-match)) + (ba/conflict (precondition-failed-msg resource if-match) + :http/status 412) + parsed-if-match (update-tx-op-if-match db resource if-match parsed-if-match) if-none-match [:put resource [:if-none-match if-none-match]] - :else [:put resource]))) + :else (update-tx-op-no-preconditions db resource)))) (defn subsetted? [{:keys [system code]}] (and (= #fhir/uri"http://terminology.hl7.org/CodeSystem/v3-ObservationValue" system) (= #fhir/code"SUBSETTED" code))) + + +(defn strip-meta + "Strips :versionId :lastUpdated from :meta of `resource`." + {:arglists '([resource])} + [{:keys [meta] :as resource}] + (let [meta (into {} (keep (fn [[k v]] (when (and v (not (#{:versionId :lastUpdated} k))) [k v]))) meta)] + (if (empty? meta) + (dissoc resource :meta) + (assoc resource :meta (type/map->Meta meta))))) + + +(defn keep? + "Determines whether `tx-op` is a keep operator." + {:arglists '([tx-op])} + [[op]] + (identical? :keep op)) diff --git a/modules/interaction/test/blaze/interaction/create_test.clj b/modules/interaction/test/blaze/interaction/create_test.clj index d44847efb..b1c7eb101 100644 --- a/modules/interaction/test/blaze/interaction/create_test.clj +++ b/modules/interaction/test/blaze/interaction/create_test.clj @@ -10,12 +10,13 @@ [blaze.db.api-stub :refer [create-mem-node-config with-system-data]] [blaze.db.resource-store :as rs] - [blaze.executors :as ex] + [blaze.db.spec :refer [node?]] [blaze.fhir.response.create-spec] [blaze.fhir.spec.type] [blaze.interaction.create] [blaze.interaction.test-util :refer [wrap-error]] [blaze.interaction.util-spec] + [blaze.log] [blaze.test-util :as tu :refer [given-thrown with-system]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] @@ -60,19 +61,17 @@ :key := :blaze.interaction/create :reason := ::ig/build-failed-spec [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :executor)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 3 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) - (testing "invalid executor" - (given-thrown (ig/init {:blaze.interaction/create {:executor ::invalid}}) + (testing "invalid node" + (given-thrown (ig/init {:blaze.interaction/create {:node ::invalid}}) :key := :blaze.interaction/create :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) - [:explain ::s/problems 3 :pred] := `ex/executor? - [:explain ::s/problems 3 :val] := ::invalid))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) + [:explain ::s/problems 2 :pred] := `node? + [:explain ::s/problems 2 :val] := ::invalid))) (defn create-config [node-config] diff --git a/modules/interaction/test/blaze/interaction/delete_test.clj b/modules/interaction/test/blaze/interaction/delete_test.clj index 165c3a968..4e85b763d 100644 --- a/modules/interaction/test/blaze/interaction/delete_test.clj +++ b/modules/interaction/test/blaze/interaction/delete_test.clj @@ -4,8 +4,9 @@ https://www.hl7.org/fhir/http.html#delete" (:require [blaze.db.api-stub :refer [mem-node-config with-system-data]] - [blaze.executors :as ex] + [blaze.db.spec :refer [node?]] [blaze.interaction.delete] + [blaze.log] [blaze.test-util :as tu :refer [given-thrown]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] @@ -33,16 +34,14 @@ (given-thrown (ig/init {:blaze.interaction/delete {}}) :key := :blaze.interaction/delete :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :executor)))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)))) (testing "invalid executor" - (given-thrown (ig/init {:blaze.interaction/delete {:executor ::invalid}}) + (given-thrown (ig/init {:blaze.interaction/delete {:node ::invalid}}) :key := :blaze.interaction/delete :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `ex/executor? - [:explain ::s/problems 1 :val] := ::invalid))) + [:explain ::s/problems 0 :pred] := `node? + [:explain ::s/problems 0 :val] := ::invalid))) (def config diff --git a/modules/interaction/test/blaze/interaction/transaction/bundle_spec.clj b/modules/interaction/test/blaze/interaction/transaction/bundle_spec.clj index 262faa8c7..dd138e440 100644 --- a/modules/interaction/test/blaze/interaction/transaction/bundle_spec.clj +++ b/modules/interaction/test/blaze/interaction/transaction/bundle_spec.clj @@ -3,9 +3,15 @@ [blaze.db.spec] [blaze.interaction.transaction.bundle :as bundle] [blaze.interaction.util-spec] - [clojure.spec.alpha :as s])) + [clojure.spec.alpha :as s] + [cognitect.anomalies :as anom])) + + +(s/fdef bundle/assoc-tx-ops + :args (s/cat :db :blaze.db/db :entries (s/coll-of map? :min-count 1)) + :ret (s/or :entries (s/coll-of map? :min-count 1) :anomaly ::anom/anomaly)) (s/fdef bundle/tx-ops :args (s/cat :entries (s/coll-of map? :min-count 1)) - :ret :blaze.db/tx-ops) + :ret (s/coll-of :blaze.db/tx-op :kind vector?)) diff --git a/modules/interaction/test/blaze/interaction/transaction/bundle_test.clj b/modules/interaction/test/blaze/interaction/transaction/bundle_test.clj index 51a9cb789..e25f0685e 100644 --- a/modules/interaction/test/blaze/interaction/transaction/bundle_test.clj +++ b/modules/interaction/test/blaze/interaction/transaction/bundle_test.clj @@ -1,11 +1,17 @@ (ns blaze.interaction.transaction.bundle-test (:require + [blaze.db.api :as d] + [blaze.db.api-stub :refer [mem-node-config with-system-data]] + [blaze.fhir.spec.type :as type] [blaze.interaction.transaction.bundle :as bundle] [blaze.interaction.transaction.bundle-spec] - [blaze.test-util :as tu] + [blaze.test-util :as tu :refer [with-system]] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [deftest testing]] - [juxt.iota :refer [given]])) + [cognitect.anomalies :as anom] + [juxt.iota :refer [given]]) + (:import + [java.time Instant])) (st/instrument) @@ -15,136 +21,162 @@ (deftest tx-ops-test - (testing "create" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "id-220129"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"POST" - :url #fhir/uri"Patient"}}]) - [0 count] := 2 - [0 0] := :create - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-220129")) - - (testing "conditional create" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "id-220200"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"POST" - :url #fhir/uri"Patient" - :ifNoneExist "birthdate=2020"}}]) - [0 count] := 3 - [0 0] := :create - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-220200" - [0 2 count] := 1 - [0 2 0] := ["birthdate" "2020"]) - - (testing "with empty :ifNoneExist" + (with-system [{:blaze.db/keys [node]} mem-node-config] + (testing "create" (given - (bundle/tx-ops + (bundle/assoc-tx-ops + (d/db node) [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "id-220200"} + {:fhir/type :fhir/Patient :id "id-220129" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"POST" - :url #fhir/uri"Patient" - :ifNoneExist ""}}]) - [0 count] := 2 - [0 0] := :create - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-220200")) + :url #fhir/uri"Patient"}}]) + count := 1 + [0 :tx-op] := [:create {:fhir/type :fhir/Patient :id "id-220129"}])) - (testing "with ignorable _sort search parameter" + (testing "conditional create" (given - (bundle/tx-ops + (bundle/assoc-tx-ops + (d/db node) [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "id-220200"} + {:fhir/type :fhir/Patient :id "id-220200" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"POST" :url #fhir/uri"Patient" - :ifNoneExist "_sort=a"}}]) - [0 count] := 2 - [0 0] := :create - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-220200"))) + :ifNoneExist "birthdate=2020"}}]) + count := 1 + [0 :tx-op] := [:create + {:fhir/type :fhir/Patient :id "id-220200"} + [["birthdate" "2020"]]]) + + (testing "with empty :ifNoneExist" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "id-220200" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"POST" + :url #fhir/uri"Patient" + :ifNoneExist ""}}]) + count := 1 + [0 :tx-op] := [:create {:fhir/type :fhir/Patient :id "id-220200"}])) + + (testing "with ignorable _sort search parameter" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "id-220200" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"POST" + :url #fhir/uri"Patient" + :ifNoneExist "_sort=a"}}]) + count := 1 + [0 :tx-op] := [:create {:fhir/type :fhir/Patient :id "id-220200"}]))) + + (testing "update" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "id-214728" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/id-214728"}}]) + count := 1 + [0 :tx-op] := [:put {:fhir/type :fhir/Patient :id "id-214728"}]) - (testing "update" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "id-214728"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"PUT" - :url #fhir/uri"Patient/id-214728"}}]) - [0 count] := 2 - [0 0] := :put - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-214728")) + (testing "with precondition" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "id-214728" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/id-214728" + :ifMatch "W/\"215150\""}}]) + count := 1 + [0 :tx-op] := [:put + {:fhir/type :fhir/Patient :id "id-214728"} + [:if-match 215150]]))) - (testing "version aware update" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "id-214728"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"PUT" - :url #fhir/uri"Patient/id-214728" - :ifMatch "W/\"215150\""}}]) - [0 count] := 3 - [0 0] := :put - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-214728" - [0 2] := [:if-match 215150])) + (testing "conditional update" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "id-214728" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH})} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/id-214728" + :ifNoneMatch "*"}}]) + count := 1 + [0 :tx-op] := [:put + {:fhir/type :fhir/Patient :id "id-214728"} + [:if-none-match :any]])) + + (testing "delete" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"DELETE" + :url #fhir/uri"Patient/id-215232"}}]) + count := 1 + [0 :tx-op] := [:delete "Patient" "id-215232"]))) - (testing "conditional update" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "id-214728"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"PUT" - :url #fhir/uri"Patient/id-214728" - :ifNoneMatch "*"}}]) - [0 count] := 3 - [0 0] := :put - [0 1 :fhir/type] := :fhir/Patient - [0 1 :id] := "id-214728" - [0 2] := [:if-none-match :any])) + (with-system-data [{:blaze.db/keys [node]} mem-node-config] + [[[:create {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"female"}]] + [[:put {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"male"}]]] - (testing "delete" - (given - (bundle/tx-ops - [{:fhir/type :fhir.Bundle/entry - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"DELETE" - :url #fhir/uri"Patient/id-215232"}}]) - [0 count] := 3 - [0 0] := :delete - [0 1] := "Patient" - [0 2] := "id-215232"))) + (testing "update" + (testing "with older precondition" + (given + (bundle/assoc-tx-ops + (d/db node) + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH}) + :gender #fhir/code"male"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]) + ::anom/category := ::anom/conflict + ::anom/message := "Precondition `W/\"1\"` failed on `Patient/0`." + :http/status := 412))))) diff --git a/modules/interaction/test/blaze/interaction/transaction_test.clj b/modules/interaction/test/blaze/interaction/transaction_test.clj index 67fb83956..7fd5dd1d6 100644 --- a/modules/interaction/test/blaze/interaction/transaction_test.clj +++ b/modules/interaction/test/blaze/interaction/transaction_test.clj @@ -6,9 +6,10 @@ https://www.hl7.org/fhir/http.html#ops" (:require [blaze.async.comp :as ac] + [blaze.db.api :as d] [blaze.db.api-stub :refer [mem-node-config with-system-data]] [blaze.db.resource-store :as rs] - [blaze.executors :as ex] + [blaze.db.spec :refer [node?]] [blaze.fhir.spec.type :as type] [blaze.handler.util :as handler-util] [blaze.interaction.create] @@ -35,8 +36,7 @@ [ring.util.response :as ring] [taoensso.timbre :as log]) (:import - [java.time Instant] - [java.util.concurrent ThreadPoolExecutor])) + [java.time Instant])) (st/instrument) @@ -115,38 +115,28 @@ :key := :blaze.interaction/transaction :reason := ::ig/build-failed-spec [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :executor)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 3 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)))) - (testing "invalid executor" - (given-thrown (ig/init {:blaze.interaction/transaction {:executor ::invalid}}) + (testing "invalid node" + (given-thrown (ig/init {:blaze.interaction/transaction {:node ::invalid}}) :key := :blaze.interaction/transaction :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :clock)) - [:explain ::s/problems 2 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) - [:explain ::s/problems 3 :pred] := `ex/executor? - [:explain ::s/problems 3 :val] := ::invalid))) - - -(deftest init-executor-test - (testing "nil config" - (given (ig/init {:blaze.interaction.transaction/executor nil}) - :blaze.interaction.transaction/executor :instanceof ThreadPoolExecutor))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :clock)) + [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :rng-fn)) + [:explain ::s/problems 2 :pred] := `node? + [:explain ::s/problems 2 :val] := ::invalid))) (def config (assoc mem-node-config :blaze.interaction/transaction {:node (ig/ref :blaze.db/node) - :executor (ig/ref :blaze.interaction.transaction/executor) :clock (ig/ref :blaze.test/fixed-clock) :rng-fn (ig/ref :blaze.test/fixed-rng-fn)} :blaze.interaction/create {:node (ig/ref :blaze.db/node) - :executor (ig/ref :blaze.test/executor) :clock (ig/ref :blaze.test/fixed-clock) :rng-fn (ig/ref :blaze.test/fixed-rng-fn)} @@ -160,12 +150,10 @@ {:node (ig/ref :blaze.db/node)} :blaze.interaction/delete - {:node (ig/ref :blaze.db/node) - :executor (ig/ref :blaze.test/executor)} + {:node (ig/ref :blaze.db/node)} :blaze.interaction/update - {:node (ig/ref :blaze.db/node) - :executor (ig/ref :blaze.test/executor)} + {:node (ig/ref :blaze.db/node)} ::router {:node (ig/ref :blaze.db/node) @@ -175,9 +163,7 @@ :delete-handler (ig/ref :blaze.interaction/delete) :update-handler (ig/ref :blaze.interaction/update)} - :blaze.interaction.transaction/executor {} :blaze.test/fixed-rng-fn {} - :blaze.test/executor {} :blaze.page-store/local {:secure-rng (ig/ref :blaze.test/fixed-rng)} :blaze.test/fixed-rng {})) @@ -191,13 +177,15 @@ :batch-handler (batch-handler router))))) -(defmacro with-handler [[handler-binding] & more] +(defmacro with-handler [[handler-binding & [node-binding]] & more] (let [[txs body] (tu/extract-txs-body more)] `(with-system-data [{handler# :blaze.interaction/transaction - router# ::router} config] + router# ::router + node# :blaze.db/node} config] ~txs (let [~handler-binding (-> handler# (wrap-defaults router#) - wrap-error)] + wrap-error) + ~(or node-binding '_) node#] ~@body)))) @@ -270,8 +258,7 @@ (let [entries [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "0"} + {:fhir/type :fhir/Patient :id "0"} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"PUT" @@ -343,8 +330,7 @@ (testing "and updated resource" (let [entries [{:resource - {:fhir/type :fhir/Patient - :id "0" + {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"male"} :request {:fhir/type :fhir.Bundle.entry/request @@ -417,6 +403,122 @@ (given response :status := "200" :etag := "W/\"2\"" + :lastModified := Instant/EPOCH))))))) + + (testing "with identical content" + (let [entries + [{:resource + {:fhir/type :fhir/Patient :id "0" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH}) + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0"}}]] + + (testing "without return preference" + (with-handler [handler] + [[[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + (let [{:keys [status body] + {[{:keys [resource response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type (type/code type) + :entry entries}})] + + (testing "response status" + (is (= 200 status))) + + (testing "bundle" + (given body + :fhir/type := :fhir/Bundle + :id := "AAAAAAAAAAAAAAAA" + :type := (type/code (str type "-response")))) + + (testing "entry resource" + (is (nil? resource))) + + (testing "entry response" + (given response + :status := "200" + :etag := "W/\"1\"" + :lastModified := Instant/EPOCH))))) + + (testing "with representation return preference" + (with-handler [handler] + [[[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + (let [{:keys [status body] + {[{:keys [resource response]}] :entry} :body} + @(handler + {:headers {"prefer" "return=representation"} + :body + {:fhir/type :fhir/Bundle + :type (type/code type) + :entry entries}})] + + (testing "response status" + (is (= 200 status))) + + (testing "bundle" + (given body + :fhir/type := :fhir/Bundle + :id := "AAAAAAAAAAAAAAAA" + :type := (type/code (str type "-response")))) + + (testing "entry resource" + (given resource + :fhir/type := :fhir/Patient + :id := "0" + :gender := #fhir/code"female" + [:meta :versionId] := #fhir/id"1" + [:meta :lastUpdated] := Instant/EPOCH)) + + (testing "entry response" + (given response + :status := "200" + :etag := "W/\"1\"" + :lastModified := Instant/EPOCH))))) + + (testing "and content changing transaction in between" + (with-handler [handler node] + [[[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]) + + (let [{:keys [status body] + {[{:keys [resource response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type (type/code type) + :entry entries}})] + + (testing "response status" + (is (= 200 status))) + + (testing "bundle" + (given body + :fhir/type := :fhir/Bundle + :id := "AAAAAAAAAAAAAAAA" + :type := (type/code (str type "-response")))) + + (testing "entry resource" + (is (nil? resource))) + + (testing "entry response" + (given response + :status := "200" + :etag := "W/\"4\"" :lastModified := Instant/EPOCH)))))))) (testing "and create interaction" @@ -1081,8 +1183,7 @@ :entry [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "0" + {:fhir/type :fhir/Patient :id "0" :meta {:tag [#fhir/Coding @@ -1139,8 +1240,7 @@ :entry [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "A_B"} + {:fhir/type :fhir/Patient :id "A_B"} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"PUT" @@ -1168,8 +1268,7 @@ :entry [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "1"} + {:fhir/type :fhir/Patient :id "1"} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"PUT" @@ -1189,34 +1288,107 @@ [:issue 0 :expression 1] := "Bundle.entry[0].resource.id"))))) (testing "on optimistic locking failure" - (with-handler [handler] - [[[:create {:fhir/type :fhir/Patient :id "0"}]] - [[:put {:fhir/type :fhir/Patient :id "0"}]]] + (testing "with different content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]] - (let [{:keys [status body]} - @(handler - {:body - {:fhir/type :fhir/Bundle - :type #fhir/code"transaction" - :entry - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "0"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"PUT" - :url #fhir/uri"Patient/0" - :ifMatch "W/\"1\""}}]}})] + (let [{:keys [status body]} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"transaction" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] - (testing "returns error" - (is (= 412 status)) + (testing "returns error" + (is (= 412 status)) - (given body - :fhir/type := :fhir/OperationOutcome - [:issue 0 :severity] := #fhir/code"error" - [:issue 0 :code] := #fhir/code"conflict" - [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))))) + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))))) + + (testing "with identical content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + (let [{:keys [status body]} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"transaction" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`.")))) + + (testing "and content changing transaction in between" + (with-handler [handler node] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]) + + (let [{:keys [status body]} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"transaction" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))) + + (testing "we did not retry to the error transaction is 3" + (is (= 3 (:error-t @(:state node))))))))) (testing "on duplicate resources" (with-handler [handler] @@ -1228,16 +1400,14 @@ :entry [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "0"} + {:fhir/type :fhir/Patient :id "0"} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"PUT" :url #fhir/uri"Patient/0"}} {:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "0"} + {:fhir/type :fhir/Patient :id "0"} :request {:fhir/type :fhir.Bundle.entry/request :method #fhir/code"PUT" @@ -1604,8 +1774,7 @@ :entry [{:fhir/type :fhir.Bundle/entry :resource - {:fhir/type :fhir/Patient - :id "0" + {:fhir/type :fhir/Patient :id "0" :meta {:tag [#fhir/Coding @@ -1689,40 +1858,125 @@ [:issue 0 :expression 0] := "Bundle.entry[0].request.url")))))) (testing "on optimistic locking failure" - (with-handler [handler] - [[[:create {:fhir/type :fhir/Patient :id "0"}]] - [[:put {:fhir/type :fhir/Patient :id "0"}]]] + (testing "with different content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]] - (let [{:keys [status] {[{:keys [response]}] :entry} :body} - @(handler - {:body - {:fhir/type :fhir/Bundle - :type #fhir/code"batch" - :entry - [{:fhir/type :fhir.Bundle/entry - :resource - {:fhir/type :fhir/Patient - :id "0"} - :request - {:fhir/type :fhir.Bundle.entry/request - :method #fhir/code"PUT" - :url #fhir/uri"Patient/0" - :ifMatch "W/\"1\""}}]}})] + (let [{:keys [status] {[{:keys [response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"batch" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] - (testing "response status" - (is (= 200 status))) + (testing "response status" + (is (= 200 status))) - (testing "returns error" - (testing "with status" - (is (= "412" (:status response)))) + (testing "returns error" + (testing "with status" + (is (= "412" (:status response)))) - (testing "with outcome" - (given (:outcome response) - :fhir/type := :fhir/OperationOutcome - [:issue 0 :severity] := #fhir/code"error" - [:issue 0 :code] := #fhir/code"conflict" - [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`." - [:issue 0 :expression 0] := "Bundle.entry[0]")))))) + (testing "with outcome" + (given (:outcome response) + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`." + [:issue 0 :expression 0] := "Bundle.entry[0]")))))) + + (testing "with identical content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + (let [{:keys [status] {[{:keys [response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"batch" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] + + (testing "response status" + (is (= 200 status))) + + (testing "returns error" + (testing "with status" + (is (= "412" (:status response)))) + + (testing "with outcome" + (given (:outcome response) + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`." + [:issue 0 :expression 0] := "Bundle.entry[0]"))))) + + (testing "and content changing transaction in between" + (with-handler [handler node] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]) + + (let [{:keys [status] {[{:keys [response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"batch" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0" + :ifMatch "W/\"1\""}}]}})] + + (testing "response status" + (is (= 200 status))) + + (testing "returns error" + (testing "with status" + (is (= "412" (:status response)))) + + (testing "with outcome" + (given (:outcome response) + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`." + [:issue 0 :expression 0] := "Bundle.entry[0]")))) + + (testing "we did not retry to the error transaction is 3" + (is (= 3 (:error-t @(:state node))))))))) (testing "without return preference" (with-handler [handler] @@ -1753,6 +2007,75 @@ :etag := "W/\"1\"" :lastModified := Instant/EPOCH)))) + (testing "with identical content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"}]]] + + (let [{:keys [status] {[{:keys [resource response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"batch" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0"}}]}})] + + (testing "response status" + (is (= 200 status))) + + (testing "entry resource" + (is (nil? resource))) + + (testing "entry response" + (given response + :status := "200" + :etag := "W/\"1\"" + :lastModified := Instant/EPOCH)))) + + (testing "and content changing transaction in between" + (with-handler [handler node] + [[[:create {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2021"}]]) + + (let [{:keys [status] {[{:keys [resource response]}] :entry} :body} + @(handler + {:body + {:fhir/type :fhir/Bundle + :type #fhir/code"batch" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url #fhir/uri"Patient/0"}}]}})] + + (testing "response status" + (is (= 200 status))) + + (testing "entry resource" + (is (nil? resource))) + + (testing "entry response" + (given response + :status := "200" + :etag := "W/\"4\"" + :lastModified := Instant/EPOCH)))))) + (testing "leading slash in URL is removed" (with-handler [handler] (let [{:keys [status] {[{:keys [resource response]}] :entry} :body} diff --git a/modules/interaction/test/blaze/interaction/update_test.clj b/modules/interaction/test/blaze/interaction/update_test.clj index 83b23c54e..c20f1e566 100644 --- a/modules/interaction/test/blaze/interaction/update_test.clj +++ b/modules/interaction/test/blaze/interaction/update_test.clj @@ -7,18 +7,22 @@ (:require [blaze.anomaly-spec] [blaze.async.comp :as ac] + [blaze.db.api :as d] [blaze.db.api-stub :refer [create-mem-node-config with-system-data]] [blaze.db.resource-store :as rs] - [blaze.executors :as ex] + [blaze.db.spec :refer [node?]] [blaze.fhir.response.create-spec] - [blaze.fhir.spec.type] + [blaze.fhir.spec.type :as type] [blaze.interaction.test-util :refer [wrap-error]] [blaze.interaction.update] - [blaze.test-util :as tu :refer [given-thrown with-system]] + [blaze.log] + [blaze.test-util :as tu :refer [given-thrown satisfies-prop with-system]] [clojure.spec.alpha :as s] [clojure.spec.test.alpha :as st] [clojure.test :as test :refer [deftest is testing]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] [integrant.core :as ig] [juxt.iota :refer [given]] [reitit.core :as reitit] @@ -67,16 +71,14 @@ (given-thrown (ig/init {:blaze.interaction/update {}}) :key := :blaze.interaction/update :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `(fn ~'[%] (contains? ~'% :executor)))) + [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)))) - (testing "invalid executor" - (given-thrown (ig/init {:blaze.interaction/update {:executor ::invalid}}) + (testing "invalid node" + (given-thrown (ig/init {:blaze.interaction/update {:node ::invalid}}) :key := :blaze.interaction/update :reason := ::ig/build-failed-spec - [:explain ::s/problems 0 :pred] := `(fn ~'[%] (contains? ~'% :node)) - [:explain ::s/problems 1 :pred] := `ex/executor? - [:explain ::s/problems 1 :val] := ::invalid))) + [:explain ::s/problems 0 :pred] := `node? + [:explain ::s/problems 0 :val] := ::invalid))) (defn create-config [node-config] @@ -99,11 +101,13 @@ ::reitit/router router)))) -(defmacro with-handler [[handler-binding] & more] +(defmacro with-handler [[handler-binding & [node-binding]] & more] (let [[txs body] (tu/extract-txs-body more)] - `(with-system-data [{handler# :blaze.interaction/update} config] + `(with-system-data [{node# :blaze.db/node + handler# :blaze.interaction/update} config] ~txs - (let [~handler-binding (-> handler# wrap-defaults wrap-error)] + (let [~handler-binding (-> handler# wrap-defaults wrap-error) + ~(or node-binding '_) node#] ~@body)))) @@ -205,26 +209,97 @@ [:issue 0 :details :coding 0 :code] := #fhir/code"MSG_RESOURCE_ID_MISMATCH" [:issue 0 :diagnostics] := "The resource id `1` doesn't match the endpoints id `0`."))))) - (testing "optimistic locking failure" + (testing "arbitrary If-Match header fails" (with-handler [handler] - [[[:create {:fhir/type :fhir/Patient :id "0"}]] - [[:put {:fhir/type :fhir/Patient :id "0"}]]] + (satisfies-prop 1000 + (prop/for-all [if-match gen/string] + (let [{:keys [status]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" if-match} + :body {:fhir/type :fhir/Patient :id "0"}})] - (let [{:keys [status body]} - @(handler - {:path-params {:id "0"} - ::reitit/match patient-match - :headers {"if-match" "W/\"1\""} - :body {:fhir/type :fhir/Patient :id "0"}})] + (= 412 status)))))) - (testing "returns error" - (is (= 412 status)) + (testing "optimistic locking failure" + (testing "with different content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]] + + (let [{:keys [status body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" "W/\"1\""} + :body {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))))) + + (testing "with identical content" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]] + [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + (let [{:keys [status body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" "W/\"1\""} + :body {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`.")))) + + (testing "and content changing transaction in between" + (with-handler [handler node] + [[[:create {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"male"}]]) - (given body - :fhir/type := :fhir/OperationOutcome - [:issue 0 :severity] := #fhir/code"error" - [:issue 0 :code] := #fhir/code"conflict" - [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))))) + (let [{:keys [status body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" "W/\"1\""} + :body {:fhir/type :fhir/Patient :id "0" + :gender #fhir/code"female"}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Precondition `W/\"1\"` failed on `Patient/0`."))) + + (testing "we did not retry to the error transaction is 3" + (is (= 3 (:error-t @(:state node))))))))) (testing "violated referential integrity" (with-handler [handler] @@ -350,49 +425,86 @@ (testing "on recreated, previously deleted resource" (testing "with no Prefer header" - (with-handler [handler] - [[[:create {:fhir/type :fhir/Patient :id "0"}]] - [[:delete "Patient" "0"]]] + (doseq [if-match [nil "W/\"2\"" "W/\"1\",W/\"2\""]] + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0"}]] + [[:delete "Patient" "0"]]] - (let [{:keys [status headers body]} - @(handler - {:path-params {:id "0"} - ::reitit/match patient-match - :body {:fhir/type :fhir/Patient :id "0"}})] + (let [{:keys [status headers body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" if-match} + :body {:fhir/type :fhir/Patient :id "0"}})] - (testing "Returns 201" - (is (= 201 status))) + (testing "Returns 201" + (is (= 201 status))) - (testing "Location header" - (is (= (str base-url "/Patient/0/_history/3") (get headers "Location")))) + (testing "Location header" + (is (= (str base-url "/Patient/0/_history/3") (get headers "Location")))) - (testing "Transaction time in Last-Modified header" - (is (= "Thu, 1 Jan 1970 00:00:00 GMT" (get headers "Last-Modified")))) + (testing "Transaction time in Last-Modified header" + (is (= "Thu, 1 Jan 1970 00:00:00 GMT" (get headers "Last-Modified")))) - (testing "VersionId in ETag header" - (is (= "W/\"3\"" (get headers "ETag")))) + (testing "VersionId in ETag header" + (is (= "W/\"3\"" (get headers "ETag")))) - (testing "Location header" - (is (= (str base-url "/Patient/0/_history/3") (get headers "Location")))) + (testing "Location header" + (is (= (str base-url "/Patient/0/_history/3") (get headers "Location")))) - (testing "Contains the resource as body" - (given body - :fhir/type := :fhir/Patient - :id := "0" - [:meta :versionId] := #fhir/id"3" - [:meta :lastUpdated] := Instant/EPOCH)))))) + (testing "Contains the resource as body" + (given body + :fhir/type := :fhir/Patient + :id := "0" + [:meta :versionId] := #fhir/id"3" + [:meta :lastUpdated] := Instant/EPOCH))))))) (testing "on successful update of an existing resource" (testing "with no Prefer header" + (doseq [if-match [nil "W/\"1\"" "W/\"1\",W/\"2\""]] + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0"}]]] + + (let [{:keys [status headers body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" if-match} + :body {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"}})] + + (testing "Returns 200" + (is (= 200 status))) + + (testing "Transaction time in Last-Modified header" + (is (= "Thu, 1 Jan 1970 00:00:00 GMT" (get headers "Last-Modified")))) + + (testing "VersionId in ETag header" + (is (= "W/\"2\"" (get headers "ETag")))) + + (testing "Contains the resource as body" + (given body + :fhir/type := :fhir/Patient + :id := "0" + :birthDate := #fhir/date"2020" + [:meta :versionId] := #fhir/id"2" + [:meta :lastUpdated] := Instant/EPOCH))))))) + + (testing "on update of an existing resource with identical content" + (doseq [if-match [nil "W/\"1\"" "W/\"1\",W/\"2\""]] (with-handler [handler] - [[[:create {:fhir/type :fhir/Patient :id "0"}]]] + [[[:create {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"}]]] (let [{:keys [status headers body]} @(handler {:path-params {:id "0"} ::reitit/match patient-match + :headers {"if-match" if-match} :body {:fhir/type :fhir/Patient :id "0" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH}) :birthDate #fhir/date"2020"}})] (testing "Returns 200" @@ -401,16 +513,54 @@ (testing "Transaction time in Last-Modified header" (is (= "Thu, 1 Jan 1970 00:00:00 GMT" (get headers "Last-Modified")))) - (testing "VersionId in ETag header" - (is (= "W/\"2\"" (get headers "ETag")))) + (testing "VersionId in ETag header is not incremented" + (is (= "W/\"1\"" (get headers "ETag")))) - (testing "Contains the resource as body" + (testing "Contains the resource as body with the non-incremented versionId" (given body :fhir/type := :fhir/Patient :id := "0" :birthDate := #fhir/date"2020" - [:meta :versionId] := #fhir/id"2" - [:meta :lastUpdated] := Instant/EPOCH)))))) + [:meta :versionId] := #fhir/id"1" + [:meta :lastUpdated] := Instant/EPOCH))))) + + (testing "and content changing transaction in between" + (doseq [if-match [nil "W/\"1\",W/\"2\""]] + (with-handler [handler node] + [[[:create {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2020"}]]] + + ;; don't wait for the transaction to be finished because the handler + ;; call should see the first version of the patient + (d/transact node [[:put {:fhir/type :fhir/Patient :id "0" + :birthDate #fhir/date"2021"}]]) + + (let [{:keys [status headers body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-match" if-match} + :body {:fhir/type :fhir/Patient :id "0" + :meta (type/map->Meta {:versionId #fhir/id"1" + :lastUpdated Instant/EPOCH}) + :birthDate #fhir/date"2020"}})] + + (testing "Returns 200" + (is (= 200 status))) + + (testing "Transaction time in Last-Modified header" + (is (= "Thu, 1 Jan 1970 00:00:00 GMT" (get headers "Last-Modified")))) + + (testing "VersionId in ETag header shows one retry" + (is (= "W/\"4\"" (get headers "ETag")))) + + (testing "Contains the resource as body with the non-incremented versionId" + (given body + :fhir/type := :fhir/Patient + :id := "0" + :birthDate := #fhir/date"2020" + [:meta :versionId] := #fhir/id"4" + [:meta :lastUpdated] := Instant/EPOCH))))))) (testing "with disabled referential integrity check" (with-system [{handler :blaze.interaction/update} (create-config {:enforce-referential-integrity false})] @@ -477,7 +627,28 @@ :body {:fhir/type :fhir/Patient :id "0"}})] (testing "Returns 201" - (is (= 201 status))))))) + (is (= 201 status)))))) + + (testing "with deleted resource" + (with-handler [handler] + [[[:create {:fhir/type :fhir/Patient :id "0"}]] + [[:delete "Patient" "0"]]] + + (let [{:keys [status body]} + @(handler + {:path-params {:id "0"} + ::reitit/match patient-match + :headers {"if-none-match" "*"} + :body {:fhir/type :fhir/Patient :id "0"}})] + + (testing "returns error" + (is (= 412 status)) + + (given body + :fhir/type := :fhir/OperationOutcome + [:issue 0 :severity] := #fhir/code"error" + [:issue 0 :code] := #fhir/code"conflict" + [:issue 0 :diagnostics] := "Resource `Patient/0` already exists.")))))) (testing "W/\"1\"" (testing "with existing resource" @@ -510,7 +681,7 @@ {:path-params {:id "0"} ::reitit/match patient-match :headers {"if-none-match" "W/\"2\""} - :body {:fhir/type :fhir/Patient :id "0"}})] + :body {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"female"}})] (testing "Returns 200" (is (= 200 status)))))))))) diff --git a/modules/interaction/test/blaze/interaction/util_spec.clj b/modules/interaction/test/blaze/interaction/util_spec.clj index 1c21ce95d..6489ed7a8 100644 --- a/modules/interaction/test/blaze/interaction/util_spec.clj +++ b/modules/interaction/test/blaze/interaction/util_spec.clj @@ -26,3 +26,20 @@ (s/fdef iu/t :args (s/cat :db :blaze.db/db) :ret :blaze.db/t) + + +(s/fdef iu/update-tx-op + :args (s/cat :db :blaze.db/db :resource :blaze/resource + :if-match (s/nilable string?) + :if-none-match (s/nilable string?)) + :ret (s/or :tx-op :blaze.db/tx-op :anomaly ::anom/anomaly)) + + +(s/fdef iu/strip-meta + :args (s/cat :resource :blaze/resource) + :ret :blaze/resource) + + +(s/fdef iu/keep? + :args (s/cat :tx-op (s/nilable :blaze.db/tx-op)) + :ret boolean?) diff --git a/modules/interaction/test/blaze/interaction/util_test.clj b/modules/interaction/test/blaze/interaction/util_test.clj index fc7e7e609..33e24bc75 100644 --- a/modules/interaction/test/blaze/interaction/util_test.clj +++ b/modules/interaction/test/blaze/interaction/util_test.clj @@ -1,10 +1,16 @@ (ns blaze.interaction.util-test (:require + [blaze.db.api :as d] + [blaze.db.api-stub :refer [mem-node-config with-system-data]] + [blaze.db.tx-log.spec] [blaze.interaction.util :as iu] [blaze.interaction.util-spec] - [blaze.test-util :as tu] + [blaze.test-util :as tu :refer [satisfies-prop with-system]] [clojure.spec.test.alpha :as st] + [clojure.string :as str] [clojure.test :as test :refer [are deftest is testing]] + [clojure.test.check.generators :as gen] + [clojure.test.check.properties :as prop] [cognitect.anomalies :as anom] [juxt.iota :refer [given]])) @@ -114,3 +120,76 @@ "_foo" "__token" "__t"))) + + +(deftest put-tx-op-test + (testing "with empty database" + (with-system [{:blaze.db/keys [node]} mem-node-config] + (testing "with empty if-match header" + (given (iu/update-tx-op (d/db node) {:fhir/type :fhir/Patient :id "0"} "" nil) + ::anom/category := ::anom/conflict + ::anom/message := "Empty precondition failed on `Patient/0`." + :http/status := 412)) + + (testing "with invalid if-match header" + (satisfies-prop 1000 + (prop/for-all [if-match (gen/such-that (complement str/blank?) gen/string)] + (let [anom (iu/update-tx-op (d/db node) {:fhir/type :fhir/Patient :id "0"} if-match nil)] + (and (= ::anom/conflict (::anom/category anom)) + (= (format "Precondition `%s` failed on `Patient/0`." if-match) (::anom/message anom)) + (= 412 (:http/status anom))))))) + + (testing "without preconditions" + (is (= (iu/update-tx-op (d/db node) {:fhir/type :fhir/Patient :id "0"} nil nil) + [:put {:fhir/type :fhir/Patient :id "0"}]))) + + (testing "with some precondition" + (satisfies-prop 10 + (prop/for-all [ts (gen/vector (gen/choose 1 10) 1 3)] + (is (= (iu/update-tx-op (d/db node) {:fhir/type :fhir/Patient :id "0"} (str/join "," (map (partial format "W/\"%d\"") ts)) nil) + [:put {:fhir/type :fhir/Patient :id "0"} (into [:if-match] ts)]))))))) + + (testing "with an existing, identical patient; the other patient is there in order to show that the t depends only on the matching patient" + (let [hash #blaze/hash"9D4C35D80AFF36B057C99523FDF18423110AAB69ED4F744EB85445F9C7D16443" + male-patient {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"male"}] + (with-system-data [{:blaze.db/keys [node]} mem-node-config] + [[[:put {:fhir/type :fhir/Patient :id "0" :gender #fhir/code"female"}]] + [[:put male-patient]] + [[:put {:fhir/type :fhir/Patient :id "1"}]]] + + (testing "without preconditions" + (testing "generates a keep op with the hash of the current patient version" + (is (= (iu/update-tx-op (d/db node) male-patient nil nil) + [:keep "Patient" "0" hash])))) + + (testing "with one matching if-match" + (testing "generates a keep op with the hash of the current patient version and the t of the if-match header" + (is (= (iu/update-tx-op (d/db node) male-patient "W/\"2\"" nil) + [:keep "Patient" "0" hash [2]])))) + + (testing "with newer if-match" + (testing "generates a put op because the newer t could still match inside the transaction" + (is (= (iu/update-tx-op (d/db node) male-patient "W/\"3\"" nil) + [:put male-patient [:if-match 3]])))) + + (testing "with older if-match" + (testing "returns an conflict, because the older t will never match again" + (given (iu/update-tx-op (d/db node) male-patient "W/\"1\"" nil) + ::anom/category := ::anom/conflict + ::anom/message := "Precondition `W/\"1\"` failed on `Patient/0`." + :http/status := 412))) + + (testing "with the same and older if-match" + (testing "generates a keep op with the hash of the current patient version" + (is (= (iu/update-tx-op (d/db node) male-patient "W/\"1\",W/\"2\"" nil) + [:keep "Patient" "0" hash [2]])))) + + (testing "with the same and newer if-match" + (testing "generates a keep op with the hash of the current patient version" + (is (= (iu/update-tx-op (d/db node) male-patient "W/\"2\",W/\"3\"" nil) + [:keep "Patient" "0" hash [2 3]])))) + + (testing "with newer and older if-match" + (testing "generates a put op because the newer t could still match inside the transaction and removes the older t that can't match anymore" + (is (= (iu/update-tx-op (d/db node) male-patient "W/\"1\",W/\"3\"" nil) + [:put male-patient [:if-match 3]])))))))) diff --git a/modules/jepsen/.gitignore b/modules/jepsen/.gitignore new file mode 100644 index 000000000..b25ca9046 --- /dev/null +++ b/modules/jepsen/.gitignore @@ -0,0 +1 @@ +store diff --git a/modules/jepsen/src/blaze/jepsen/register.clj b/modules/jepsen/src/blaze/jepsen/register.clj index 652bef144..0a16cc9b4 100644 --- a/modules/jepsen/src/blaze/jepsen/register.clj +++ b/modules/jepsen/src/blaze/jepsen/register.clj @@ -32,15 +32,35 @@ (defn read [{:keys [base-uri] :as context} id] @(-> (fhir-client/read base-uri "Patient" id context) - (ac/then-apply :multipleBirth) - (ac/exceptionally #(when-not (ba/not-found? %) %)))) + (ac/then-apply + (fn [resource] + {:type :ok :value (:multipleBirth resource)})) + (ac/exceptionally + (fn [e] + {:type (if (ba/not-found? e) :ok :fail) :value nil})))) (defn write! [{:keys [base-uri] :as context} id value] - @(fhir-client/update - base-uri - {:fhir/type :fhir/Patient :id id :multipleBirth value} - context)) + @(-> (if (even? value) + (fhir-client/update + base-uri + {:fhir/type :fhir/Patient :id id :multipleBirth value} + context) + (fhir-client/transact + base-uri + {:fhir/type :fhir/Bundle + :type #fhir/code"transaction" + :entry + [{:fhir/type :fhir.Bundle/entry + :resource + {:fhir/type :fhir/Patient :id id :multipleBirth value} + :request + {:fhir/type :fhir.Bundle.entry/request + :method #fhir/code"PUT" + :url (type/uri (str "Patient/" id))}}]} + context)) + (ac/then-apply (constantly {:type :ok})) + (ac/exceptionally (constantly {:type :fail})))) (defn failing-write! [{:keys [base-uri] :as context}] @@ -65,9 +85,8 @@ (invoke! [_ test op] (case (:f op) - :read (assoc op :type :ok :value (read context (:id test))) - :write (do (write! context (:id test) (:value op)) - (assoc op :type :ok)))) + :read (merge op (read context (:id test))) + :write (merge op (write! context (:id test) (:value op))))) (teardown! [this _test] this) diff --git a/modules/jepsen/test/blaze/jepsen/register_test.clj b/modules/jepsen/test/blaze/jepsen/register_test.clj index fa2367c92..a23a39246 100644 --- a/modules/jepsen/test/blaze/jepsen/register_test.clj +++ b/modules/jepsen/test/blaze/jepsen/register_test.clj @@ -6,7 +6,8 @@ [blaze.jepsen.register :as register] [blaze.test-util :as tu] [clojure.spec.test.alpha :as st] - [clojure.test :as test :refer [deftest is]])) + [clojure.test :as test :refer [deftest]] + [juxt.iota :refer [given]])) (st/instrument) @@ -32,4 +33,6 @@ (deftest read-test (with-redefs [fhir-client/read fhir-client-read] - (is (= multiple-birth (register/read {:base-uri base-uri} id))))) + (given (register/read {:base-uri base-uri} id) + :type := :ok + :value := multiple-birth))) diff --git a/modules/module-base/.clj-kondo/config.edn b/modules/module-base/.clj-kondo/config.edn index e3b746ad7..292528086 100644 --- a/modules/module-base/.clj-kondo/config.edn +++ b/modules/module-base/.clj-kondo/config.edn @@ -1,4 +1,7 @@ -{:linters +{:lint-as + {prometheus.alpha/defcounter clojure.core/def} + + :linters {:unsorted-required-namespaces {:level :error} @@ -12,6 +15,11 @@ {:level :warning} :warn-on-reflection - {:level :warning :warn-only-on-interop true}} + {:level :warning :warn-only-on-interop true} + + :consistent-alias + {:aliases + {blaze.util u + clojure.spec.alpha s}}} :skip-comments true} diff --git a/modules/module-base/Makefile b/modules/module-base/Makefile index c6dcaacb7..319e5bff0 100644 --- a/modules/module-base/Makefile +++ b/modules/module-base/Makefile @@ -1,13 +1,16 @@ lint: - clj-kondo --lint src deps.edn + clj-kondo --lint src test deps.edn -test: - true +prep: + clojure -X:deps prep -test-coverage: - true +test: prep + clojure -M:test:kaocha --profile :ci + +test-coverage: pep + clojure -M:test:coverage clean: rm -rf .clj-kondo/.cache .cpcache target -.PHONY: lint test test-coverage clean +.PHONY: lint prep test test-coverage clean diff --git a/modules/module-base/deps.edn b/modules/module-base/deps.edn index ad015fec0..7ac89b4ec 100644 --- a/modules/module-base/deps.edn +++ b/modules/module-base/deps.edn @@ -17,4 +17,26 @@ {:mvn/version "0.8.1"} prom-metrics/prom-metrics - {:mvn/version "0.6-alpha.7"}}} + {:mvn/version "0.6-alpha.7"}} + + :aliases + {:test + {:extra-paths ["test"] + + :extra-deps + {blaze/test-util + {:local/root "../test-util"}}} + + :kaocha + {:extra-deps + {lambdaisland/kaocha + {:mvn/version "1.71.1119"}} + + :main-opts ["-m" "kaocha.runner"]} + + :coverage + {:extra-deps + {cloverage/cloverage + {:mvn/version "1.2.4"}} + + :main-opts ["-m" "cloverage.coverage" "--codecov" "-p" "src" "-s" "test"]}}} diff --git a/modules/module-base/src/blaze/util.clj b/modules/module-base/src/blaze/util.clj index 75ae2375e..dbb0c91e1 100644 --- a/modules/module-base/src/blaze/util.clj +++ b/modules/module-base/src/blaze/util.clj @@ -11,3 +11,9 @@ "Returns the duration in seconds from a System/nanoTime `start`." [start] (/ (double (- (System/nanoTime) start)) 1e9)) + + +(defn to-seq + "Coerces `x` to a sequence." + [x] + (if (or (nil? x) (sequential? x)) x [x])) diff --git a/modules/module-base/src/blaze/util_spec.clj b/modules/module-base/src/blaze/util_spec.clj new file mode 100644 index 000000000..8f544467f --- /dev/null +++ b/modules/module-base/src/blaze/util_spec.clj @@ -0,0 +1,14 @@ +(ns blaze.util-spec + (:require + [blaze.util :as u] + [clojure.spec.alpha :as s])) + + +(s/fdef u/duration-s + :args (s/cat :start int?) + :ret double?) + + +(s/fdef u/to-seq + :args (s/cat :x any?) + :ret (s/nilable sequential?)) diff --git a/modules/module-base/test/blaze/module_test.clj b/modules/module-base/test/blaze/module_test.clj new file mode 100644 index 000000000..479cb0243 --- /dev/null +++ b/modules/module-base/test/blaze/module_test.clj @@ -0,0 +1,27 @@ +(ns blaze.module-test + (:require + [blaze.module :refer [reg-collector]] + [blaze.test-util :as tu] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [deftest is]] + [integrant.core :as ig] + [prometheus.alpha :refer [defcounter]]) + (:import + [io.prometheus.client Collector])) + + +(st/instrument) + + +(test/use-fixtures :each tu/fixture) + + +(defcounter collector + "Collector") + + +(deftest reg-collector-test + (reg-collector ::collector + collector) + + (is (instance? Collector (::collector (ig/init {::collector nil}))))) diff --git a/modules/module-base/test/blaze/util_test.clj b/modules/module-base/test/blaze/util_test.clj new file mode 100644 index 000000000..1d64a618b --- /dev/null +++ b/modules/module-base/test/blaze/util_test.clj @@ -0,0 +1,28 @@ +(ns blaze.util-test + (:require + [blaze.test-util :as tu] + [blaze.util :as u] + [clojure.spec.test.alpha :as st] + [clojure.test :as test :refer [deftest is testing]])) + + +(set! *warn-on-reflection* true) +(st/instrument) + + +(test/use-fixtures :each tu/fixture) + + +(deftest duration-s-test + (is (pos? (u/duration-s (System/nanoTime))))) + + +(deftest to-seq-test + (testing "nil" + (is (nil? (u/to-seq nil)))) + + (testing "non-sequential value" + (is (= [1] (u/to-seq 1)))) + + (testing "sequential value" + (is (= [1] (u/to-seq [1]))))) diff --git a/modules/module-base/tests.edn b/modules/module-base/tests.edn new file mode 100644 index 000000000..94fe5636c --- /dev/null +++ b/modules/module-base/tests.edn @@ -0,0 +1,5 @@ +#kaocha/v1 + #merge + [{} + #profile {:ci {:reporter kaocha.report/documentation + :color? false}}] diff --git a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj index 1a2946a32..457f6ada4 100644 --- a/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj +++ b/modules/operation-measure-evaluate-measure/src/blaze/fhir/operation/evaluate_measure.clj @@ -67,14 +67,12 @@ (= :post request-method) (let [id (luid context)] (-> (d/transact node (tx-ops result id)) - ;; it's important to switch to the transaction - ;; executor here, because otherwise the central - ;; indexing thread would execute response building. - (ac/then-apply-async identity executor) (ac/then-compose (fn [db-after] (response/build-response - (response-context context db-after) nil + (response-context context db-after) + nil + nil (d/resource-handle db-after "MeasureReport" id)))))))))))) diff --git a/modules/rest-util/src/blaze/fhir/response/create.clj b/modules/rest-util/src/blaze/fhir/response/create.clj index 46aaf6977..4fafe8857 100644 --- a/modules/rest-util/src/blaze/fhir/response/create.clj +++ b/modules/rest-util/src/blaze/fhir/response/create.clj @@ -38,12 +38,17 @@ (d/pull db new-handle))) +(defn- keep? [[op]] + (identical? :keep op)) + + (defn build-response - [{:blaze/keys [db] :as context} old-handle {:keys [id] :as new-handle}] + [{:blaze/keys [db] :as context} tx-op old-handle {:keys [id] :as new-handle}] (let [type (name (fhir-spec/fhir-type new-handle)) tx (d/tx db (:t new-handle)) vid (str (:blaze.db/t tx)) - created (or (nil? old-handle) (identical? :delete (:op old-handle)))] + created (and (not (keep? tx-op)) + (or (nil? old-handle) (identical? :delete (:op old-handle))))] (log/trace (format "build-response of %s/%s with vid = %s" type id vid)) (do-sync [body (body context new-handle)] (cond-> diff --git a/modules/rest-util/src/blaze/fhir/response/create_spec.clj b/modules/rest-util/src/blaze/fhir/response/create_spec.clj index e1b757426..a07a22030 100644 --- a/modules/rest-util/src/blaze/fhir/response/create_spec.clj +++ b/modules/rest-util/src/blaze/fhir/response/create_spec.clj @@ -1,6 +1,7 @@ (ns blaze.fhir.response.create-spec (:require [blaze.db.api-spec] + [blaze.db.spec] [blaze.fhir.response.create :as create] [blaze.http.spec] [blaze.spec] @@ -11,5 +12,6 @@ (s/fdef create/build-response :args (s/cat :context (s/keys :req [:blaze/base-url :blaze/db ::reitit/router] :opt [:blaze.preference/return]) + :tx-op (s/nilable :blaze.db/tx-op) :old-handle (s/nilable :blaze.db/resource-handle) :new-handle :blaze.db/resource-handle)) diff --git a/modules/rest-util/src/blaze/handler/fhir/util.clj b/modules/rest-util/src/blaze/handler/fhir/util.clj index 1598b2752..e0a792529 100644 --- a/modules/rest-util/src/blaze/handler/fhir/util.clj +++ b/modules/rest-util/src/blaze/handler/fhir/util.clj @@ -3,16 +3,11 @@ (:refer-clojure :exclude [sync]) (:require [blaze.fhir.spec] + [blaze.util :as u] [clojure.spec.alpha :as s] [reitit.core :as reitit])) -(defn to-seq - "Coerces `x` to a sequence." - [x] - (if (or (nil? x) (sequential? x)) x [x])) - - (defn parse-nat-long [s] (when-let [n (parse-long s)] (when-not (neg? n) @@ -26,7 +21,7 @@ if there is any." {:arglists '([query-params])} [{v "__t"}] - (some parse-nat-long (to-seq v))) + (some parse-nat-long (u/to-seq v))) (def ^:private ^:const default-page-size 50) @@ -40,7 +35,7 @@ value of 50. Limits value to 10000." {:arglists '([query-params])} [{v "_count"}] - (or (some #(some-> (parse-nat-long %) (min max-page-size)) (to-seq v)) + (or (some #(some-> (parse-nat-long %) (min max-page-size)) (u/to-seq v)) default-page-size)) @@ -51,7 +46,7 @@ default value of 0." {:arglists '([query-params])} [{v "__page-offset"}] - (or (some parse-nat-long (to-seq v)) 0)) + (or (some parse-nat-long (u/to-seq v)) 0)) (defn page-type @@ -61,7 +56,7 @@ Values have to be valid FHIR resource type names." {:arglists '([query-params])} [{v "__page-type"}] - (some #(when (s/valid? :fhir.resource/type %) %) (to-seq v))) + (some #(when (s/valid? :fhir.resource/type %) %) (u/to-seq v))) (defn page-id @@ -71,7 +66,7 @@ Values have to be valid FHIR id's." {:arglists '([query-params])} [{v "__page-id"}] - (some #(when (s/valid? :blaze.resource/id %) %) (to-seq v))) + (some #(when (s/valid? :blaze.resource/id %) %) (u/to-seq v))) (defn type-url diff --git a/modules/rest-util/src/blaze/handler/fhir/util_spec.clj b/modules/rest-util/src/blaze/handler/fhir/util_spec.clj index eca67ec3e..f3369066f 100644 --- a/modules/rest-util/src/blaze/handler/fhir/util_spec.clj +++ b/modules/rest-util/src/blaze/handler/fhir/util_spec.clj @@ -9,11 +9,6 @@ [reitit.core :as reitit])) -(s/fdef util/to-seq - :args (s/cat :x any?) - :ret (s/nilable sequential?)) - - (s/fdef util/t :args (s/cat :query-params (s/nilable :ring.request/query-params)) :ret (s/nilable :blaze.db/t)) diff --git a/modules/rest-util/test/blaze/fhir/response/create_test.clj b/modules/rest-util/test/blaze/fhir/response/create_test.clj index 91b600d74..ff818ca9b 100644 --- a/modules/rest-util/test/blaze/fhir/response/create_test.clj +++ b/modules/rest-util/test/blaze/fhir/response/create_test.clj @@ -40,7 +40,7 @@ (testing "created" (testing "with no Prefer header" (let [{:keys [status headers body]} - @(build-response context nil resource-handle)] + @(build-response context nil nil resource-handle)] (testing "Returns 201" (is (= 201 status))) @@ -65,7 +65,7 @@ (assoc context :blaze.preference/return :blaze.preference.return/minimal) {:keys [body]} - @(build-response context nil resource-handle)] + @(build-response context nil nil resource-handle)] (testing "Contains no body" (is (nil? body))))) @@ -75,15 +75,25 @@ (assoc context :blaze.preference/return :blaze.preference.return/representation) {:keys [body]} - @(build-response context nil resource-handle)] + @(build-response context nil nil resource-handle)] (testing "Contains the resource as body" - (is (= resource body)))))) + (is (= resource body))))) + + (testing "with return=OperationOutcome Prefer header" + (let [context + (assoc context + :blaze.preference/return :blaze.preference.return/OperationOutcome) + {:keys [body]} + @(build-response context nil nil resource-handle)] + + (testing "Contains the OperationOutcome as body" + (is (= :fhir/OperationOutcome (:fhir/type body))))))) (testing "updated" (testing "with no Prefer header" (let [{:keys [status headers body]} - @(build-response context resource-handle resource-handle)] + @(build-response context nil resource-handle resource-handle)] (testing "Returns 200" (is (= 200 status))) @@ -104,7 +114,7 @@ (assoc context :blaze.preference/return :blaze.preference.return/minimal) {:keys [body]} - @(build-response context resource-handle resource-handle)] + @(build-response context nil resource-handle resource-handle)] (testing "Contains no body" (is (nil? body))))) @@ -114,7 +124,27 @@ (assoc context :blaze.preference/return :blaze.preference.return/representation) {:keys [body]} - @(build-response context resource-handle resource-handle)] + @(build-response context nil resource-handle resource-handle)] + + (testing "Contains the resource as body" + (is (= resource body)))))) + + (testing "kept" + (testing "with no Prefer header" + (let [{:keys [status headers body]} + @(build-response context [:keep "Patient" "0" #blaze/hash"C9ADE22457D5AD750735B6B166E3CE8D6878D09B64C2C2868DCB6DE4C9EFBD4F"] nil + resource-handle)] + + (testing "Returns 200" + (is (= 200 status))) + + (testing "Transaction time in Last-Modified header" + (is (= "Thu, 1 Jan 1970 00:00:00 GMT" + (get headers "Last-Modified")))) + + (testing "Version in ETag header" + ;; 1 is the T of the transaction of the resource update + (is (= "W/\"1\"" (get headers "ETag")))) (testing "Contains the resource as body" (is (= resource body))))))))) diff --git a/modules/rest-util/test/blaze/handler/fhir/util_test.clj b/modules/rest-util/test/blaze/handler/fhir/util_test.clj index cf8ce7865..7083bffe4 100644 --- a/modules/rest-util/test/blaze/handler/fhir/util_test.clj +++ b/modules/rest-util/test/blaze/handler/fhir/util_test.clj @@ -13,17 +13,6 @@ (test/use-fixtures :each tu/fixture) -(deftest to-seq-test - (testing "nil" - (is (nil? (fhir-util/to-seq nil)))) - - (testing "non-sequential value" - (is (= [1] (fhir-util/to-seq 1)))) - - (testing "sequential value" - (is (= [1] (fhir-util/to-seq [1]))))) - - (deftest t-test (testing "no query param" (is (nil? (fhir-util/t {})))) diff --git a/resources/blaze.edn b/resources/blaze.edn index e6d879290..112e895f9 100644 --- a/resources/blaze.edn +++ b/resources/blaze.edn @@ -107,13 +107,11 @@ :blaze.interaction/create {:node #blaze/ref :blaze.db/node - :executor #blaze/ref :blaze.server/executor :clock #blaze/ref :blaze/clock :rng-fn #blaze/ref :blaze/rng-fn} :blaze.interaction/delete - {:node #blaze/ref :blaze.db/node - :executor #blaze/ref :blaze.server/executor} + {:node #blaze/ref :blaze.db/node} :blaze.interaction/read {} @@ -134,15 +132,11 @@ :blaze.interaction/transaction {:node #blaze/ref :blaze.db/node - :executor #blaze/ref :blaze.interaction.transaction/executor :clock #blaze/ref :blaze/clock :rng-fn #blaze/ref :blaze/rng-fn} - :blaze.interaction.transaction/executor {} - :blaze.interaction/update - {:node #blaze/ref :blaze.db/node - :executor #blaze/ref :blaze.server/executor} + {:node #blaze/ref :blaze.db/node} ;; ;; FHIR Operation Evaluate Measure diff --git a/src/blaze/system.clj b/src/blaze/system.clj index de66245c1..fcc615fa8 100644 --- a/src/blaze/system.clj +++ b/src/blaze/system.clj @@ -5,7 +5,6 @@ The specs at the beginning of the namespace describe the config which has to be given to `init!``. The server port has a default of `8080`." (:require - [blaze.executors :as ex] [blaze.log] [clojure.java.io :as io] [clojure.string :as str] @@ -117,8 +116,6 @@ :health-handler (ig/ref :blaze.handler/health) :context-path (->Cfg "CONTEXT_PATH" string? "/fhir")} - :blaze.server/executor {} - :blaze/server {:port (->Cfg "SERVER_PORT" nat-int? 8080) :handler (ig/ref :blaze.handler/app) @@ -221,17 +218,3 @@ (defmethod ig/init-key :blaze/secure-rng [_ _] (SecureRandom.)) - - -(defn- executor-init-msg [] - (format "Init server executor with %d threads" - (.availableProcessors (Runtime/getRuntime)))) - - -(defmethod ig/init-key :blaze.server/executor - [_ _] - (log/info (executor-init-msg)) - (ex/cpu-bound-pool "server-%d")) - - -(derive :blaze.server/executor :blaze.metrics/thread-pool-executor) diff --git a/test/blaze/system_test.clj b/test/blaze/system_test.clj index 57c6da2be..11f4a5c02 100644 --- a/test/blaze/system_test.clj +++ b/test/blaze/system_test.clj @@ -100,8 +100,7 @@ :rng-fn (ig/ref :blaze.test/fixed-rng-fn)} :blaze.interaction/read {} :blaze.interaction/delete - {:node (ig/ref :blaze.db/node) - :executor (ig/ref :blaze.test/executor)} + {:node (ig/ref :blaze.db/node)} :blaze.interaction/search-system {:clock (ig/ref :blaze.test/fixed-clock) :rng-fn (ig/ref :blaze.test/fixed-rng-fn)