diff --git a/.github/scripts/large-batch.sh b/.github/scripts/large-batch.sh
new file mode 100755
index 0000000000..4ca71e5e1f
--- /dev/null
+++ b/.github/scripts/large-batch.sh
@@ -0,0 +1,83 @@
+#!/bin/bash
+set -euo pipefail
+
+#
+# This script sends one large batch bundle and checks that every entry is
+# processed and that the response entries keep the order of the request
+# entries.
+#
+# The entries of a batch bundle are processed concurrently with a sliding
+# window. So the bundle interleaves writes with reads, because the reads are
+# much faster than the writes and make the entries complete out of order. The
+# response entries have to keep the bundle order nonetheless.
+#
+
+script_dir="$(dirname "$(readlink -f "$0")")"
+. "$script_dir/util.sh"
+
+base="http://localhost:8080/fhir"
+
+# the bundle holds one read after each write, so it has twice as many entries
+num_writes="${1:-2000}"
+num_entries=$((num_writes * 2))
+
+prefix="large-batch"
+
+# tag marking the patients written by this script, so that all of them can be
+# counted with a single search
+tag_system="http://acme.org/codes"
+tag_code="$prefix"
+
+bundle() {
+ jq -nc --arg prefix "$prefix" --arg system "$tag_system" --arg code "$tag_code" \
+ --argjson num "$num_entries" '
+ {
+ resourceType: "Bundle",
+ type: "batch",
+ entry: [
+ range($num) |
+ if . % 2 == 0 then
+ {
+ resource: {
+ resourceType: "Patient",
+ id: "\($prefix)-\(.)",
+ meta: {tag: [{system: $system, code: $code}]}
+ },
+ request: {method: "PUT", url: "Patient/\($prefix)-\(.)"}
+ }
+ else
+ {request: {method: "GET", url: "Patient?_summary=count"}}
+ end
+ ]
+ }'
+}
+
+start="$(date +%s)"
+result="$(bundle | transact "$base")"
+echo "ℹ️ processed $num_entries batch bundle entries in $(($(date +%s) - start)) s"
+
+test "resource type" "$(echo "$result" | jq -r '.resourceType')" "Bundle"
+test "bundle type" "$(echo "$result" | jq -r '.type')" "batch-response"
+test "number of response entries" "$(echo "$result" | jq -r '.entry | length')" "$num_entries"
+
+test "distinct statuses of the write entries" \
+ "$(echo "$result" | jq -r '[.entry | to_entries[] | select(.key % 2 == 0) | .value.response.status] | unique | join(",")')" \
+ "201"
+
+test "distinct statuses of the read entries" \
+ "$(echo "$result" | jq -r '[.entry | to_entries[] | select(.key % 2 == 1) | .value.response.status] | unique | join(",")')" \
+ "200"
+
+# every write entry has to answer with the location of the patient that the
+# request entry at that very position created
+test "number of write entries at the wrong position" \
+ "$(echo "$result" | jq -r --arg prefix "$prefix" '
+ [.entry | to_entries[]
+ | select(.key % 2 == 0)
+ | select((.value.response.location // "" | split("/") | .[5]) != "\($prefix)-\(.key)")]
+ | length')" \
+ "0"
+
+test "number of created patients" \
+ "$(search_strict "$base/Patient?_tag=$tag_system|$tag_code&_summary=count" | jq -r '.total')" \
+ "$num_writes"
diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index f5c8e80396..8c15123b0c 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -1568,6 +1568,9 @@ jobs:
- name: Batch Metadata
run: .github/scripts/batch-metadata.sh
+ - name: Large Batch Bundle
+ run: .github/scripts/large-batch.sh
+
- name: Transaction
run: .github/scripts/transaction.sh
diff --git a/docs/api/interaction/batch.md b/docs/api/interaction/batch.md
index c0fba10d1b..327a4e2a7a 100644
--- a/docs/api/interaction/batch.md
+++ b/docs/api/interaction/batch.md
@@ -1,6 +1,6 @@
# Batch
-The batch interaction allows submitting a set of actions to be performed as a single HTTP request. The semantics of the individual actions described in the `batch` Bundle are identical of the semantics of the corresponding individual request. The actions are performed in order but can be interleaved by other individual requests or actions from other batch interactions.
+The batch interaction allows submitting a set of actions to be performed as a single HTTP request. The semantics of the individual actions described in the `batch` Bundle are identical of the semantics of the corresponding individual request. The actions are independent of each other, are performed in no particular order and can be interleaved by other individual requests or actions from other batch interactions.
```
POST [base]
@@ -20,6 +20,20 @@ The request body has to be a Bundle of type `batch`. The following methods are s
The methods `HEAD` and `PATCH` are not supported and will result in an error entry with status `422`, unknown methods in an error entry with status `400`.
+## Processing Rules
+
+FHIR requires that there are [no interdependencies][1] between the entries of a batch bundle: the success or failure of one action must not alter the success or failure or the resulting content of another one. Blaze relies on that rule and processes the entries concurrently. That concurrency is about submitting the actions; the transactions they create are still applied one at a time as described in the note above.
+
+* **No order.** The actions aren't performed in the order of the bundle, and no order between any two of them is guaranteed. Two actions writing the same resource are applied in an undefined order.
+* **Reads aren't separated from writes.** In a [transaction](transaction.md) bundle, the `GET` actions are executed after the writes, against the new database state. In a batch, a `GET` is just another independent action, so whether it sees a write of the same bundle is undefined. Use a transaction bundle if an action has to read what the same bundle writes.
+* **Bounded concurrency.** At most 64 actions are processed at a time, and never more than half of the maximum number of in-flight transactions set by the [environment variable](../../deployment/environment-variables.md) `DB_MAX_IN_FLIGHT_TRANSACTIONS`. So a single batch can't take more than half of the places for in-flight transactions away from other clients.
+* **Backpressure.** A write action rejected because that maximum is reached is retried a few times. If it still doesn't get one of the places, it keeps its `503` in the response bundle, where it then really means that the server is saturated.
+
+None of this affects the response bundle, whose entries always keep the order of the request entries.
+
+> [!NOTE]
+> Up to version 1.10.1, the actions of a batch were processed one after another in the order of the bundle. Bundles relying on that order were already outside what FHIR guarantees, but they can behave differently now.
+
## Response
Blaze returns a `200 OK` with a Bundle of type `batch-response`. The response bundle contains one entry for each entry of the request bundle, in the same order. Each entry contains the status and further details like `ETag` value, last modified time and location under `Bundle.entry.response`. For successful reads and searches, the resource or search result Bundle is returned under `Bundle.entry.resource`.
@@ -52,3 +66,5 @@ In contrast to the [transaction](transaction.md) interaction, actions in a batch
]
}
```
+
+[1]:
diff --git a/docs/deployment/environment-variables.md b/docs/deployment/environment-variables.md
index 9d9568ed40..d9148d4fd6 100644
--- a/docs/deployment/environment-variables.md
+++ b/docs/deployment/environment-variables.md
@@ -473,6 +473,8 @@ Timeout in milliseconds for all reading FHIR interactions acquiring the newest d
The maximum number of transactions that were submitted but are not yet indexed. Submitting a transaction while that maximum is reached will return a 503 Service Unavailable response instead, asking the client to try again later. Because such a transaction is rejected before any of its data is written, lowering this value bounds the memory the not yet indexed transactions occupy. Please increase it if you experience such 503 responses under a write load your system can otherwise sustain.
+The value also bounds how many entries of a batch bundle Blaze processes concurrently. That number is at most 64 and never more than half of this maximum, so that a single batch bundle can't take more than half of the places for in-flight transactions away from other clients.
+
**Default:** 1024
#### `DB_SEARCH_PARAM_BUNDLE`
diff --git a/modules/async/deps.edn b/modules/async/deps.edn
index e6966e5762..384332893b 100644
--- a/modules/async/deps.edn
+++ b/modules/async/deps.edn
@@ -15,7 +15,10 @@
{:extra-paths ["test"]
:extra-deps
- {blaze/test-util
+ {blaze/module-test-util
+ {:local/root "../module-test-util"}
+
+ blaze/test-util
{:local/root "../test-util"}}}
:kaocha
diff --git a/modules/async/src/blaze/async/comp.clj b/modules/async/src/blaze/async/comp.clj
index fc0740d27b..7d8e994365 100644
--- a/modules/async/src/blaze/async/comp.clj
+++ b/modules/async/src/blaze/async/comp.clj
@@ -6,7 +6,6 @@
(:require
[blaze.anomaly :as ba]
[clojure.math :as math]
- [cognitect.anomalies :as anom]
[taoensso.timbre :as log])
(:import
[java.util.concurrent CompletionStage CompletableFuture TimeUnit CompletionException]))
@@ -299,10 +298,7 @@
(fn [~binding-form]
~@body)))
-(defn- retryable? [{::anom/keys [category]}]
- (#{::anom/busy} category))
-
-(defn- retry* [future-fn action-name max-retries num-retry]
+(defn- retry* [future-fn retryable? action-name max-retries num-retry]
(-> (future-fn)
(exceptionally-compose
(fn [e]
@@ -312,9 +308,10 @@
(-> (future)
(complete-on-timeout!
nil delay TimeUnit/MILLISECONDS)
- (then-compose
+ (then-compose-async
(fn [_]
- (retry* future-fn action-name max-retries (inc num-retry))))))
+ (retry* future-fn retryable? action-name max-retries
+ (inc num-retry))))))
e)))))
(defn retry
@@ -322,14 +319,26 @@
the function `f` with no arguments completes normally will complete with its
result.
- Otherwise retries by calling `f` again with no arguments if the anomaly is of
- category `::anom/busy`. Waits between retries starting with 100 ms growing
- exponentially.
+ Otherwise retries by calling `f` again with no arguments if calling the
+ function `retryable?` with the anomaly returns true. Retries every busy
+ anomaly if `retryable?` isn't given. Waits between retries starting with
+ 100 ms growing exponentially.
+
+ Only anomalies for which retrying is safe should be matched by `retryable?`.
+ The category alone often doesn't tell that. A busy anomaly for example is
+ returned by a request that was rejected before it had any effect as well as by
+ one that timed out after it maybe had one already.
+
+ The retry is done using the default asynchronous execution facility and not on
+ the thread that completes the wait. That thread schedules all timeouts of the
+ JVM, so `f` doing any work on it would delay every other timeout.
Please be aware that `num-retries` shouldn't be higher than the max stack
depth. Otherwise, the CompletionStage would fail with a StackOverflowException."
- [f action-name num-retries]
- (retry* f action-name num-retries 0))
+ ([f action-name num-retries]
+ (retry f action-name num-retries ba/busy?))
+ ([f action-name num-retries retryable?]
+ (retry* f retryable? action-name num-retries 0)))
(defn retry2
"Returns a CompletionStage that, when the CompletionStage as result of calling
diff --git a/modules/async/src/blaze/async/comp_spec.clj b/modules/async/src/blaze/async/comp_spec.clj
index 5cc10cdb7a..f38b0d0e95 100644
--- a/modules/async/src/blaze/async/comp_spec.clj
+++ b/modules/async/src/blaze/async/comp_spec.clj
@@ -120,7 +120,8 @@
:ret ac/completable-future?)
(s/fdef ac/retry
- :args (s/cat :f ifn? :action-name string? :num-retries pos-int?)
+ :args (s/cat :f ifn? :action-name string? :num-retries pos-int?
+ :retryable? (s/? ifn?))
:ret ac/completable-future?)
(s/fdef ac/retry2
diff --git a/modules/async/test/blaze/async/comp_test.clj b/modules/async/test/blaze/async/comp_test.clj
index d7da170bd1..0cca246af0 100644
--- a/modules/async/test/blaze/async/comp_test.clj
+++ b/modules/async/test/blaze/async/comp_test.clj
@@ -4,10 +4,13 @@
[blaze.async.comp :as ac :refer [do-sync do-async]]
[blaze.async.comp-spec]
[blaze.executors :as ex]
+ [blaze.module.test-util :as mtu]
[blaze.test-util :as tu :refer [given-failed-future]]
[clojure.spec.test.alpha :as st]
+ [clojure.string :as str]
[clojure.test :as test :refer [deftest is testing]]
- [cognitect.anomalies :as anom])
+ [cognitect.anomalies :as anom]
+ [juxt.iota :refer [given]])
(:import
[java.util.concurrent TimeUnit]))
@@ -16,6 +19,12 @@
(test/use-fixtures :each tu/fixture)
+(defn- delay-scheduler-thread?
+ "Returns true if `thread-name` is the name of the thread that schedules all
+ timeouts of the JVM."
+ [thread-name]
+ (str/includes? thread-name "delayScheduler"))
+
(deftest completed-future-test
(testing "on completed future"
(is (= ::x @(ac/completed-future ::x))))
@@ -384,6 +393,34 @@
(given-failed-future (ac/retry future-fn "action-114844" 1)
::anom/category := ::anom/busy))))
+ (testing "with a retryable predicate"
+ (testing "an anomaly the predicate matches is retried"
+ (let [counter (atom 0)
+ future-fn #(ac/completed-future
+ (let [n (swap! counter inc)]
+ (if (= 2 n) ::x (ba/conflict))))]
+ (is (= ::x @(ac/retry future-fn "action-114844" 1 ba/conflict?)))))
+
+ (testing "a busy anomaly the predicate doesn't match isn't retried"
+ (let [counter (atom 0)
+ future-fn #(ac/completed-future
+ (let [n (swap! counter inc)]
+ (if (= 2 n) ::x (ba/busy))))]
+ (given-failed-future (ac/retry future-fn "action-114844" 1 ba/conflict?)
+ ::anom/category := ::anom/busy)
+
+ (is (= 1 @counter)))))
+
+ (testing "the retry doesn't happen on the thread that schedules the delay
+ because that single thread schedules all timeouts of the JVM"
+ (let [counter (atom 0)
+ future-fn #(ac/completed-future
+ (let [n (swap! counter inc)]
+ (if (= 2 n) {:result ::x} (ba/busy))))]
+ (given @(mtu/assoc-thread-name (ac/retry future-fn "action-114844" 1))
+ [meta :thread-name] :!? delay-scheduler-thread?
+ :result := ::x)))
+
(testing "times"
(testing "with second call successful"
(let [counter (atom 0)
diff --git a/modules/db/src/blaze/db/api.clj b/modules/db/src/blaze/db/api.clj
index 93dcf9a81c..0fcb527dd4 100644
--- a/modules/db/src/blaze/db/api.clj
+++ b/modules/db/src/blaze/db/api.clj
@@ -56,9 +56,13 @@
transaction in case of success or will complete exceptionally with an anomaly
in case of a transaction error or other errors. Fails with an unavailable
anomaly if `node` is closed, because its indexing loop wouldn't pick the
- transaction up anymore. Fails with a busy anomaly if `node` already has the
- maximum number of transactions submitted but not yet indexed, before anything
- of the transaction is written.
+ transaction up anymore. Fails with a busy anomaly of
+ `:blaze.db.anom/category` `:submit-rejected` if `node` already has the maximum
+ number of transactions submitted but not yet indexed. Such a rejection happens
+ before anything of the transaction is written, so it's the only failure of a
+ transaction that can be safely retried by submitting it again. Every other
+ busy anomaly, especially the one of a timeout, can also mean that the
+ transaction was applied after all.
Functions applied after the returned future are executed on the common
ForkJoinPool."
diff --git a/modules/db/src/blaze/db/node.clj b/modules/db/src/blaze/db/node.clj
index 0e4cab9aac..c8706c54aa 100644
--- a/modules/db/src/blaze/db/node.clj
+++ b/modules/db/src/blaze/db/node.clj
@@ -72,6 +72,7 @@
[blaze.anomaly :as ba :refer [if-ok]]
[blaze.async.comp :as ac :refer [do-sync]]
[blaze.coll.core :as coll]
+ [blaze.db.anom :as-alias db-anom]
[blaze.db.api :as d]
[blaze.db.impl.batch-db :as batch-db]
[blaze.db.impl.codec :as codec]
@@ -304,17 +305,20 @@
"Returns a function that tries to take one of the places for in-flight
transactions.
- That function returns a busy anomaly and counts the rejection if the maximum
- number of in-flight transactions is already reached. It's the only point at
- which a transaction is turned away, so it has to be called before any data of
- the transaction is stored."
+ That function returns a rejection anomaly and counts the rejection if the
+ maximum number of in-flight transactions is already reached. It's the only
+ point at which a transaction is turned away, so it has to be called before any
+ data of the transaction is stored. That's also why the anomaly is categorized
+ as a rejection, which tells a caller that submitting the transaction again is
+ safe."
[node-name state max-in-flight-transactions]
(fn []
(let [[old new] (swap-vals! state acquire-in-flight
max-in-flight-transactions)]
(when (identical? old new)
(prom/inc! submit-rejections-total node-name)
- (ba/busy (max-in-flight-msg max-in-flight-transactions))))))
+ (ba/busy (max-in-flight-msg max-in-flight-transactions)
+ ::db-anom/category :submit-rejected)))))
(defn- settle-in-flight
"Stops counting the transaction as submitting and starts counting it as
diff --git a/modules/db/src/blaze/db/spec.clj b/modules/db/src/blaze/db/spec.clj
index aeb93af87e..80c0bdf23b 100644
--- a/modules/db/src/blaze/db/spec.clj
+++ b/modules/db/src/blaze/db/spec.clj
@@ -1,5 +1,6 @@
(ns blaze.db.spec
(:require
+ [blaze.db.anom :as-alias db-anom]
[blaze.db.impl.index.resource-handle :as rh]
[blaze.db.impl.protocols :as p]
[blaze.db.node.protocols :as np]
@@ -117,3 +118,6 @@
(s/def :blaze.db/max-in-flight-transactions
pos-int?)
+
+(s/def ::db-anom/category
+ #{:submit-rejected})
diff --git a/modules/db/test/blaze/db/node_test.clj b/modules/db/test/blaze/db/node_test.clj
index faae42bf3b..ec8c717ffd 100644
--- a/modules/db/test/blaze/db/node_test.clj
+++ b/modules/db/test/blaze/db/node_test.clj
@@ -5,6 +5,7 @@
[blaze.async.comp-spec]
[blaze.async.flow :as flow]
[blaze.async.flow-spec]
+ [blaze.db.anom :as-alias db-anom]
[blaze.db.api :as d]
[blaze.db.api-spec]
[blaze.db.impl.db-spec]
@@ -580,7 +581,8 @@
third submit is still rejected"
(given-failed-future (submit-patient node "2")
::anom/category := ::anom/busy
- ::anom/message := "The maximum number of 2 in-flight transactions is reached. Please try again later."))
+ ::anom/message := "The maximum number of 2 in-flight transactions is reached. Please try again later."
+ ::db-anom/category := :submit-rejected))
(testing "no resource content is stored for the rejected transaction"
(is (= puts @put-count))))
diff --git a/modules/interaction/src/blaze/interaction/transaction.clj b/modules/interaction/src/blaze/interaction/transaction.clj
index d32ac814d9..55aa6791c9 100644
--- a/modules/interaction/src/blaze/interaction/transaction.clj
+++ b/modules/interaction/src/blaze/interaction/transaction.clj
@@ -296,7 +296,7 @@
(defmethod m/pre-init-spec :blaze.interaction/transaction [_]
(s/keys :req-un [:blaze.db/node ::rest-api/batch-handler :blaze/clock :blaze/rng-fn
::rest-api/db-sync-timeout]
- :opt-un [:blaze/validator]))
+ :opt-un [:blaze/validator :blaze.db/max-in-flight-transactions]))
(defmethod ig/init-key :blaze.interaction/transaction [_ context]
(log/info "Init FHIR transaction interaction handler")
diff --git a/modules/interaction/test/blaze/interaction/transaction_test.clj b/modules/interaction/test/blaze/interaction/transaction_test.clj
index ed78402e0f..f03d65f674 100644
--- a/modules/interaction/test/blaze/interaction/transaction_test.clj
+++ b/modules/interaction/test/blaze/interaction/transaction_test.clj
@@ -258,6 +258,13 @@
[:cause-data ::s/problems 0 :via] := [:blaze.rest-api/db-sync-timeout]
[:cause-data ::s/problems 0 :val] := ::invalid))
+ (testing "invalid max-in-flight-transactions"
+ (given-failed-system (assoc-in config [:blaze.interaction/transaction :max-in-flight-transactions] ::invalid)
+ :key := :blaze.interaction/transaction
+ :reason := ::ig/build-failed-spec
+ [:cause-data ::s/problems 0 :via] := [:blaze.db/max-in-flight-transactions]
+ [:cause-data ::s/problems 0 :val] := ::invalid))
+
(testing "invalid validator"
(given-failed-system (assoc-in config [:blaze.interaction/transaction :validator] ::invalid)
:key := :blaze.interaction/transaction
diff --git a/modules/job-async-interaction/src/blaze/job/async_interaction.clj b/modules/job-async-interaction/src/blaze/job/async_interaction.clj
index d344d45171..a8fc2cecca 100644
--- a/modules/job-async-interaction/src/blaze/job/async_interaction.clj
+++ b/modules/job-async-interaction/src/blaze/job/async_interaction.clj
@@ -145,7 +145,8 @@
(defmethod m/pre-init-spec :blaze.job/async-interaction [_]
(s/keys :req [:blaze/base-url]
:req-un [::main-node ::admin-node ::rest-api/batch-handler
- ::rest-api/db-sync-timeout :blaze/context-path]))
+ ::rest-api/db-sync-timeout :blaze/context-path]
+ :opt-un [:blaze.db/max-in-flight-transactions]))
(defmethod ig/init-key :blaze.job/async-interaction
[_ config]
diff --git a/modules/job-async-interaction/test/blaze/job/async_interaction_test.clj b/modules/job-async-interaction/test/blaze/job/async_interaction_test.clj
index 9f2d906ec7..0cbfe9501a 100644
--- a/modules/job-async-interaction/test/blaze/job/async_interaction_test.clj
+++ b/modules/job-async-interaction/test/blaze/job/async_interaction_test.clj
@@ -305,6 +305,13 @@
:key := :blaze.job/async-interaction
:reason := ::ig/build-failed-spec
[:cause-data ::s/problems 0 :via] := [:blaze/context-path]
+ [:cause-data ::s/problems 0 :val] := ::invalid))
+
+ (testing "invalid max-in-flight-transactions"
+ (given-failed-system (assoc-in config [:blaze.job/async-interaction :max-in-flight-transactions] ::invalid)
+ :key := :blaze.job/async-interaction
+ :reason := ::ig/build-failed-spec
+ [:cause-data ::s/problems 0 :via] := [:blaze.db/max-in-flight-transactions]
[:cause-data ::s/problems 0 :val] := ::invalid)))
(derive :blaze.db.main/node :blaze.db/node)
diff --git a/modules/rest-util/src/blaze/handler/fhir/util.clj b/modules/rest-util/src/blaze/handler/fhir/util.clj
index 7c95cf71ba..87aca34f25 100644
--- a/modules/rest-util/src/blaze/handler/fhir/util.clj
+++ b/modules/rest-util/src/blaze/handler/fhir/util.clj
@@ -5,6 +5,7 @@
[blaze.anomaly :as ba :refer [if-ok]]
[blaze.async.comp :as ac :refer [do-sync]]
[blaze.coll.core :as coll]
+ [blaze.db.anom :as-alias db-anom]
[blaze.db.api :as d]
[blaze.fhir.canonical :as canonical]
[blaze.fhir.spec :as fhir-spec]
@@ -604,31 +605,141 @@
:else
entry)))
-(defn process-batch-entry
- "Processes `entry` from `idx` of a batch bundle using :batch-handler from
- `context`."
- {:arglists '([context idx entry])}
- [{:keys [batch-handler] :as context} idx entry]
+(defn- entry-response
+ "Calls the :batch-handler from `context` with `entry` and returns a
+ CompletableFuture that will complete with the response entry or will complete
+ exceptionally with an anomaly."
+ {:arglists '([context entry])}
+ [{:keys [batch-handler] :as context} entry]
+ (-> (batch-handler (batch-request context entry))
+ (ac/then-apply bundle-response)))
+
+(defn- entry-error-response [idx anom]
+ (if (ba/interrupted? anom)
+ anom
+ ((bundle-error-response idx) anom)))
+
+(defn- validated-entry-response
+ "Validates `entry` from `idx` of a batch bundle and returns a
+ CompletableFuture that will complete with the response entry of calling
+ `response-fn`, turning a possible anomaly into an error response entry."
+ [idx entry response-fn]
(if-ok [_ (validate-entry idx entry)]
- (-> (batch-handler (batch-request context entry))
- (ac/then-apply bundle-response)
- (ac/exceptionally
- (fn [anom]
- (if (ba/interrupted? anom)
- anom
- ((bundle-error-response idx) anom)))))
+ (-> (response-fn)
+ (ac/exceptionally (partial entry-error-response idx)))
(comp ac/completed-future response-entry
handler-util/bundle-error-response)))
-(defn- process-batch-entries* [context [entry & more] idx results]
- (if entry
- (-> (process-batch-entry context idx entry)
+(defn process-batch-entry
+ "Processes `entry` from `idx` of a batch bundle using :batch-handler from
+ `context`."
+ [context idx entry]
+ (validated-entry-response idx entry #(entry-response context entry)))
+
+(def ^:private ^:const num-entry-retries
+ "The number of times an entry of a batch bundle is retried after it was
+ rejected because the maximum number of in-flight transactions was reached.
+
+ Kept small on purpose. An entry that still doesn't get one of the places keeps
+ its 503, where it then really means that the server is saturated. An unbounded
+ retry would turn the backpressure into an internal queue."
+ 3)
+
+(defn- submit-rejected?
+ "Checks whether `anom` is the anomaly of a transaction that was rejected
+ because the maximum number of in-flight transactions was reached."
+ [anom]
+ (identical? :submit-rejected (::db-anom/category anom)))
+
+(defn- process-batch-entry-retrying
+ "Like `process-batch-entry` but retries `entry` up to `num-entry-retries`
+ times if it was rejected because the maximum number of in-flight transactions
+ was reached.
+
+ Retrying is safe because such a rejection happens before anything is written.
+ So it stays narrowed to exactly that rejection and isn't widened to every
+ `::anom/busy` anomaly, which can also mean that the transaction of `entry` was
+ applied after all."
+ [context idx entry]
+ (validated-entry-response
+ idx entry
+ #(ac/retry (fn [] (entry-response context entry))
+ (format "batch bundle entry %d" idx) num-entry-retries
+ submit-rejected?)))
+
+(def ^:private ^:const max-window
+ "The maximum number of entries of a batch bundle that are processed
+ concurrently.
+
+ 64 is where the transaction load test is already near its plateau."
+ 64)
+
+(defn- window
+ "Returns the number of entries of a batch bundle that are processed
+ concurrently.
+
+ Caps the window at half of `max-in-flight-transactions` so that a batch never
+ takes more than half of the places for in-flight transactions away from other
+ clients, also when that maximum is configured below its default of 1024. That
+ default doesn't lower the window below `max-window`, so a missing
+ `max-in-flight-transactions` amounts to the same."
+ [max-in-flight-transactions]
+ (cond-> max-window
+ max-in-flight-transactions
+ (min (max 1 (quot max-in-flight-transactions 2)))))
+
+(defn- take-entry!
+ "Takes the next entry from `remaining`, an atom over a sequence of index-entry
+ tuples, and returns that tuple or nil if no entry is left."
+ [remaining]
+ (ffirst (swap-vals! remaining next)))
+
+(defn- process-entries!
+ "Runs one worker that takes the next entry from `remaining` and processes it,
+ one after another, until no entry is left.
+
+ Returns a CompletableFuture that will complete with `results`, the
+ index-response-entry tuples of all entries this worker processed."
+ [context remaining results]
+ (if-let [[idx entry] (take-entry! remaining)]
+ (-> (process-batch-entry-retrying context idx entry)
(ac/then-compose-async
(fn [result]
- (process-batch-entries* context more (inc idx) (conj results result)))))
+ (process-entries! context remaining (conj results [idx result])))))
(ac/completed-future results)))
(defn process-batch-entries
- "Processes `entries` of a batch bundle using :batch-handler from `context`."
- [context entries]
- (process-batch-entries* context entries 0 []))
+ "Processes `entries` of a batch bundle using :batch-handler from `context`.
+
+ Keeps at most `window` entries in flight, starting the next entry as soon as
+ one completes. The response entries keep the order of `entries`. In terms of
+ Reactor, that's `Flux.flatMapSequential` with a `maxConcurrency` of `window`.
+
+ The window isn't a counter checked before each entry. Instead as many workers
+ as the window is wide pull entries from one shared queue, each taking the next
+ entry as soon as its current one completed. That bounds the entries in flight
+ by construction, because a worker holds exactly one entry at a time and there
+ are never more workers than the window is wide.
+
+ Which entries a worker gets isn't fixed. It takes whatever is at the head of
+ the queue at the moment it becomes free, so a worker with fast entries
+ processes more of them than one held up by a slow entry or by the backoff of
+ `process-batch-entry-retrying`. That's what the shared queue buys: assigning
+ the entries to the workers upfront would leave the other workers idle while
+ one of them waits.
+
+ So the workers complete in arbitrary order, each with only its own entries.
+ The bundle order is restored at the end by sorting the index-response-entry
+ tuples of all workers. Unlike `flatMapSequential`, nothing is emitted before
+ that, which costs nothing here because the response bundle has to be complete
+ before it can be sent."
+ {:arglists '([context entries])}
+ [{:keys [max-in-flight-transactions] :as context} entries]
+ (let [remaining (atom (map-indexed vector entries))
+ workers (mapv (fn [_] (process-entries! context remaining []))
+ (range (min (count entries)
+ (window max-in-flight-transactions))))]
+ (-> (ac/all-of workers)
+ (ac/then-apply
+ (fn [_]
+ (into [] (map second) (sort-by first (mapcat ac/join workers))))))))
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 29bc52a0ea..7b12105f44 100644
--- a/modules/rest-util/src/blaze/handler/fhir/util_spec.clj
+++ b/modules/rest-util/src/blaze/handler/fhir/util_spec.clj
@@ -123,6 +123,7 @@
:args (s/cat :context (s/keys :req [:blaze/base-url]
:req-un [::rest-api/batch-handler]
:opt [:blaze/db :blaze/cancelled?
- :blaze.preference/return])
+ :blaze.preference/return]
+ :opt-un [:blaze.db/max-in-flight-transactions])
:entries (s/coll-of :fhir.Bundle/entry))
:ret (s/or :response-entry :fhir.Bundle/entry :anomaly ::anom/anomaly))
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 c83432ead3..87920b7457 100644
--- a/modules/rest-util/test/blaze/handler/fhir/util_test.clj
+++ b/modules/rest-util/test/blaze/handler/fhir/util_test.clj
@@ -2,6 +2,7 @@
(:require
[blaze.anomaly :as ba]
[blaze.async.comp :as ac]
+ [blaze.db.anom :as-alias db-anom]
[blaze.db.api :as d]
[blaze.db.api-stub :as api-stub :refer [with-system-data]]
[blaze.fhir.spec.generators :as fg]
@@ -1004,3 +1005,163 @@
:url #fhir/uri "Patient"}}])
::anom/category := ::anom/interrupted
::anom/message := "msg-152801")))
+
+(defn- get-entry
+ ([]
+ (get-entry "Patient"))
+ ([url]
+ {:fhir/type :fhir.Bundle/entry
+ :request {:fhir/type :fhir.Bundle.entry/request
+ :method #fhir/code "GET"
+ :url (type/uri url)}}))
+
+(defn- window-recording-handler
+ "Returns a tuple of a batch handler that completes its responses not before
+ `window` requests are in flight and an atom holding the maximum number of
+ requests that were in flight."
+ [window]
+ (let [latch (ac/future)
+ in-flight (atom 0)
+ max-in-flight (atom 0)]
+ [(fn [_]
+ (let [n (swap! in-flight inc)]
+ (swap! max-in-flight max n)
+ (when (<= window n)
+ (ac/complete! latch nil)))
+ (ac/then-apply
+ latch
+ (fn [_]
+ (swap! in-flight dec)
+ (ring/response nil))))
+ max-in-flight]))
+
+(deftest process-batch-entries-window-test
+ (testing "up to 64 entries are processed concurrently"
+ (let [[batch-handler max-in-flight] (window-recording-handler 64)]
+ (is (= 100 (count (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ (repeat 100 (get-entry)))
+ 10000 []))))
+ (is (= 64 @max-in-flight))))
+
+ (testing "the window is at most half of the maximum number of in-flight transactions"
+ (let [[batch-handler max-in-flight] (window-recording-handler 4)]
+ (is (= 16 (count (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"
+ :max-in-flight-transactions 8}
+ (repeat 16 (get-entry)))
+ 10000 []))))
+ (is (= 4 @max-in-flight))))
+
+ (testing "at least one entry is processed at a time"
+ (let [[batch-handler max-in-flight] (window-recording-handler 1)]
+ (is (= 4 (count (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"
+ :max-in-flight-transactions 1}
+ (repeat 4 (get-entry)))
+ 10000 []))))
+ (is (= 1 @max-in-flight)))))
+
+(deftest process-batch-entries-order-test
+ (testing "the response entries keep the order of the request entries"
+ (let [num-entries 10
+ pending (atom [])
+ batch-handler
+ (fn [{:keys [uri]}]
+ (let [response (ac/future)]
+ (when (= num-entries (count (swap! pending conj [uri response])))
+ (run! (fn [[uri response]] (ac/complete! response (ring/response uri)))
+ (rseq @pending)))
+ response))]
+ (is (= (mapv (partial str "/Patient/") (range num-entries))
+ (mapv :resource
+ (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ (mapv (comp get-entry (partial str "Patient/"))
+ (range num-entries)))
+ 10000 [])))))))
+
+(deftest process-batch-entries-retry-test
+ (testing "an entry rejected because the maximum number of in-flight transactions was reached is retried"
+ (let [calls (atom 0)
+ batch-handler
+ (fn [_]
+ (ac/completed-future
+ (if (< (swap! calls inc) 3)
+ (ba/busy "msg-124737" ::db-anom/category :submit-rejected)
+ (ring/response nil))))]
+ (given (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ [(get-entry)])
+ 10000 [])
+ [0 :response :status] := #fhir/string "200")
+
+ (is (= 3 @calls))))
+
+ (testing "after three retries the entry keeps its 503"
+ (let [calls (atom 0)
+ batch-handler
+ (fn [_]
+ (swap! calls inc)
+ (ac/completed-future (ba/busy "msg-124737" ::db-anom/category :submit-rejected)))]
+ (given (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ [(get-entry)])
+ 10000 [])
+ [0 :response :status] := #fhir/string "503"
+ [0 :response :outcome :issue 0 :diagnostics] := #fhir/string "msg-124737")
+
+ (is (= 4 @calls))))
+
+ (testing "a busy anomaly that isn't such a rejection isn't retried, because
+ it can also happen after the transaction of the entry was already
+ committed"
+ (let [calls (atom 0)
+ batch-handler
+ (fn [_]
+ (swap! calls inc)
+ (ac/completed-future (ba/busy "msg-124737")))]
+ (given (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ [(get-entry)])
+ 10000 [])
+ [0 :response :status] := #fhir/string "503"
+ [0 :response :outcome :issue 0 :diagnostics] := #fhir/string "msg-124737")
+
+ (is (= 1 @calls))))
+
+ (testing "other anomalies aren't retried"
+ (let [calls (atom 0)
+ batch-handler
+ (fn [_]
+ (swap! calls inc)
+ (ac/completed-future (ba/fault "msg-124737")))]
+ (given (deref (fhir-util/process-batch-entries
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ [(get-entry)])
+ 10000 [])
+ [0 :response :status] := #fhir/string "500")
+
+ (is (= 1 @calls))))
+
+ (testing "a single batch entry isn't retried"
+ (let [calls (atom 0)
+ batch-handler
+ (fn [_]
+ (swap! calls inc)
+ (ac/completed-future (ba/busy "msg-124737" ::db-anom/category :submit-rejected)))]
+ (given @(fhir-util/process-batch-entry
+ {:batch-handler batch-handler
+ :blaze/base-url "base-url-121502"}
+ 0 (get-entry))
+ [:response :status] := #fhir/string "503")
+
+ (is (= 1 @calls)))))
diff --git a/resources/blaze.edn b/resources/blaze.edn
index d74f60b6fa..12e0a7ba38 100644
--- a/resources/blaze.edn
+++ b/resources/blaze.edn
@@ -195,7 +195,8 @@
:batch-handler #blaze/ref :blaze.rest-api/batch-handler
:clock #blaze/ref :blaze/clock
:rng-fn #blaze/ref :blaze/rng-fn
- :db-sync-timeout #blaze/cfg ["DB_SYNC_TIMEOUT" pos-int? 10000]}
+ :db-sync-timeout #blaze/cfg ["DB_SYNC_TIMEOUT" pos-int? 10000]
+ :max-in-flight-transactions #blaze/cfg ["DB_MAX_IN_FLIGHT_TRANSACTIONS" pos-int? 1024]}
:blaze.interaction/update
{:node #blaze/ref :blaze.db.main/node}
@@ -464,6 +465,7 @@
:admin-node #blaze/ref :blaze.db.admin/node
:batch-handler #blaze/ref :blaze.rest-api/batch-handler
:db-sync-timeout #blaze/cfg ["DB_SYNC_TIMEOUT" pos-int? 10000]
+ :max-in-flight-transactions #blaze/cfg ["DB_MAX_IN_FLIGHT_TRANSACTIONS" pos-int? 1024]
:blaze/base-url #blaze/var base-url
:context-path #blaze/cfg ["CONTEXT_PATH" string? "/fhir"]
:clock #blaze/ref :blaze/clock