github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-30 22:40:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

🎉 Start the parallel exporter tree with system and browser

Browse Source 
New code grows under `exporter.*` instead of extending `app.*`:
`exporter.main` holds the future entry point, `exporter.utils.system`
is an async-aware Integrant-style lifecycle (`init-key`/`halt-key`
multimethods, `ref`s, dependency ordering, `^:async` + `await`, no
promesa chains), and `exporter.browser` ports the whole browser
namespace as a pool service with an injectable factory. Each piece
ships with its tests, registered in the test runner.

AI-assisted-by: muse-spark-1.3-contributor
This commit is contained in:
Andrey Antukh 2026-10-07 17:34:55 +00:00
parent ade36617b3
commit ab6d77954a
8 changed files with 854 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.serena/memories/exporter/core.md
View File

@ -34,6 +34,13 @@ on this side: the row of the job, its cancel and its result are the backend's.
- Deploy: the compose service is one `penpot-exporter` (the same image, `CMD ["node", "app.js"]`); scale by replicas, K is per process. Nginx has no `/api/export` route anymore: the frontend talks to the backend's RPC only (`create-export-assets-job`), and downloads ride `/assets/by-id/?share-id=`/auth of the job resource.
- Useful beats while debugging: the boot log names `:workers K`; each poller logs `running job`/`job settled`; the runner logs `export job settled` with `:outcome`, and a cancel logs `job cancelled by backend` on the watchdog.
## The new tree (refactor in progress)
- New code grows under `exporter.*`, in parallel to the legacy `app.*` tree: `exporter.main` will replace `app.core` once every piece is ported; do not extend `app.*`.
- Lifecycle is `exporter.utils.system`: async-aware Integrant-style init/halt (`init-key`/`halt-key` multimethods, `ref`s, `weavejester.dependency` ordering, `^:async` + `cljs.core/await`, no promesa chains); tests are `^:async deftest` with `await` directly in the body.
- First ported service is `exporter.browser` (whole `app.browser` at once): the running instance is the raw pool, the public API takes it first (`exec` fails fast on a nil pool), the browser factory is injected through config for hermetic tests, and the new tree carries no promesa.
- Async test vars prove their chain only when really awaited: a test passing with 0 assertions means the chain broke upstream.
## Render details
- Headless engines (wasm/Skia) lease one render worker for the whole run (`rd/with-scope`); browser renders go one DOM page per partition of 50.

246
exporter/src/exporter/browser.cljs Normal file
View File

@ -0,0 +1,246 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter.browser
"The browser pool service and the page API its pages speak.
The pool is a system component (`:exporter.browser/pool`): `init-key`
builds a `generic-pool` of Chromium browsers, `halt-key` drains it.
Everything else here is the plain page API the renderers use; none of
it touches the pool, so none of it needs the system.
There are no promesa chains in this namespace: Playwright and
`generic-pool` already speak native promises, and `await` covers the
rest."
(:refer-clojure :exclude [eval])
(:require
["generic-pool" :as gp]
["generic-pool/lib/errors.js" :as gpe]
["playwright" :as pw]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.util.object :as obj]
[exporter.utils.system :as system]))
(l/set-level! :trace)
(def ^:private TimeoutError gpe/TimeoutError)
;; --- PAGE API
(def default-timeout 30000)
(def default-viewport-width 1920)
(def default-viewport-height 1080)
(def default-user-agent
(str "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 "
"(KHTML, like Gecko) Chrome/99.0.3729.169 Safari/537.36"))
(defn create-cookies
[uri {:keys [name token] :or {name "auth-token"}}]
(let [domain (str (:host uri)
(when (:port uri)
(str ":" (:port uri))))]
#js [#js {:domain domain
:path "/"
:name name
:value token}]))
(defn nav
([page url] (nav page url nil))
([page url {:keys [wait-until timeout] :or {wait-until "networkidle" timeout 20000}}]
(.goto ^js page (str url) #js {:waitUntil wait-until :timeout timeout})))
(defn sleep
[page ms]
(.waitForTimeout ^js page ms))
(defn- ^:async wait-for-fonts-async
[page timeout]
(try
(await (.waitForFunction ^js page
"async () => {
if (!document.fonts) return true;
try {
await Promise.all(Array.from(document.fonts, (face) => face.load()));
} catch (e) {}
await document.fonts.ready;
return document.fonts.status === 'loaded';
}"
nil
#js {:timeout timeout}))
(catch :default cause
(l/warn :hint "wait-for-fonts timed out; continuing anyway"
:cause (ex-message cause))
nil)))
(defn wait-for-fonts
"Wait until the browser has finished loading all fonts.
Checking `document.fonts.status === 'loaded'` on its own is not enough:
the render page injects its `@font-face` rules asynchronously and the
browser only loads a face lazily, when some painted text actually uses
it. A face that is declared but not yet requested stays in the `unloaded`
state, which does NOT keep `document.fonts.status` at `loading`, so the
check can pass before any real font glyphs are available. The export is
then captured with a (usually wider) fallback font, and auto-width text
laid out with the real font metrics overflows its bounds and gets clipped.
To avoid that we explicitly request every declared face and await
`document.fonts.ready` before checking the status."
([page] (wait-for-fonts page nil))
([page {:keys [timeout] :or {timeout 15000}}]
(wait-for-fonts-async page timeout)))
(defn wait-for
([locator] (wait-for locator nil))
([locator {:keys [state timeout] :or {state "visible" timeout 10000}}]
(.waitFor ^js locator #js {:state state :timeout timeout})))
(defn screenshot
([frame] (screenshot frame {}))
([frame {:keys [full-page? omit-background? type quality path]
:or {type "png" full-page? false omit-background? false quality 95}}]
(let [options (-> (obj/new)
(obj/set! "type" (name type))
(obj/set! "omitBackground" omit-background?)
(cond-> path (obj/set! "path" path))
(cond-> (= "jpeg" type) (obj/set! "quality" quality))
(cond-> full-page? (-> (obj/set! "fullPage" true)
(obj/set! "clip" nil))))]
(.screenshot ^js frame options))))
(defn emulate-media
[page {:keys [media]}]
(.emulateMedia ^js page #js {:media media})
page)
(defn pdf
([page] (pdf page {}))
([page {:keys [scale path page-ranges]
:or {page-ranges "1"
scale 1}}]
(.pdf ^js page #js {:path path
:scale scale
:pageRanges page-ranges
:printBackground true
:preferCSSPageSize true})))
(defn eval
[frame f]
(.evaluate ^js frame f))
(defn select
[frame selector]
(.locator ^js frame selector))
(defn select-all
[frame selector]
(.$$ ^js frame selector))
;; --- POOL SERVICE
(def defaults
"Static pool defaults. The sizing (`::max`) mirrors the worker
concurrency default; the wiring layer passes the env-derived value."
{::max 2
::acquire-timeout 10000
::idle-timeout 10000
::launch-args ["--allow-insecure-localhost" "--font-render-hinting=none"]})
(defn- default-create-browser
[launch-args]
(fn []
(.launch pw/chromium #js {:args (clj->js launch-args)})))
(defn- ^:async create-instance
[create-browser id-counter]
(let [browser (await (create-browser))
id (swap! id-counter inc)]
(l/info :origin "factory" :action "create" :browser-id id)
(unchecked-set browser "__id" id)
browser))
(defn- destroy-instance
[browser]
(l/info :origin "factory" :action "destroy"
:browser-id (unchecked-get browser "__id"))
(.close ^js browser))
(defn- validate-instance
[browser]
(l/info :origin "factory" :action "validate"
:browser-id (unchecked-get browser "__id"))
(.isConnected ^js browser))
(defn- make-factory
[create-browser]
(let [id-counter (atom 0)]
#js {:create (fn [] (create-instance create-browser id-counter))
:destroy destroy-instance
:validate validate-instance}))
(defmethod system/init-key ::pool
[_ cfg]
(let [opts (merge defaults (d/without-nils cfg))
create-browser (or (::create-browser opts)
(default-create-browser (::launch-args opts)))]
(l/info :hint "initializing browser pool" :max (::max opts))
(gp/createPool (make-factory create-browser)
#js {:max (::max opts)
:min 0
:testOnBorrow true
:evictionRunIntervalMillis 5000
:numTestsPerEvictionRun 5
:acquireTimeoutMillis (::acquire-timeout opts)
:idleTimeoutMillis (::idle-timeout opts)})))
(defn- ^:async drain-pool
[pool]
(await (.drain ^js pool))
(await (.clear ^js pool))
nil)
(defmethod system/halt-key ::pool
[_ pool]
(when pool
(l/info :hint "finalizing browser pool")
(drain-pool pool)))
(defn- throw-browser-error
[cause]
(if (instance? TimeoutError cause)
(ex/raise :type :internal
:code :timeout
:hint (ex-message cause)
:cause cause)
(throw cause)))
(defn ^:async exec
"Check out a browser, run `handle` with a fresh page, and put the
browser back. `handle` takes the page and may return a plain value or
a promise. On failure the browser is destroyed instead of reused, and
a Playwright timeout surfaces as an `:timeout` error."
[pool context-opts handle]
(when-not pool
(throw (ex-info "browser pool is not started" {:reason ::not-started})))
(let [browser (await (.acquire ^js pool))]
(try
(let [context (await (.newContext ^js browser context-opts))
_ (l/trace :hint "exec:handle:start" :browser-id (unchecked-get browser "__id"))
page (await (.newPage ^js context))
result (await (handle page))]
(await (.close ^js context))
(l/trace :hint "exec:handle:end" :browser-id (unchecked-get browser "__id"))
(await (.release ^js pool browser))
result)
(catch :default cause
(try
(await (.destroy ^js pool browser))
(catch :default destroy-cause
(l/warn :hint "browser destroy failed"
:cause (ex-message destroy-cause))))
(throw-browser-error cause)))))

12
exporter/src/exporter/main.cljs Normal file
View File

@ -0,0 +1,12 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter.main
"Entry point of the new exporter tree.
This namespace will replace `app.core` once every piece of `app.*`
has been ported over. New code grows under `exporter.*`, in parallel
to the legacy `app.*` tree, until the old one can be removed.")

243
exporter/src/exporter/utils/system.cljs Normal file
View File

@ -0,0 +1,243 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter.utils.system
"Async-aware Integrant-style system lifecycle for the new tree.
The shape mirrors `integrant.core`, trimmed down: a config map of
qualified keys to values, `ref`s between them, and two multimethods,
`init-key` and `halt-key`, that turn values into running components
and back. The dependency graph rides `weavejester.dependency`, the
same library Integrant uses.
The difference is async: `init` and `halt` are `^:async`, every step
is awaited, and an `init-key` method may return a plain value or a
promise. `init` never throws synchronously; every failure, including
invalid config, surfaces as a rejected promise.
Deliberately left out from Integrant: refsets, profiles, vars,
expand/converge, suspend/resume, composite keys, EDN reading and
namespace loading."
(:require
[clojure.set :as set]
[clojure.string :as str]
[clojure.walk :as walk]
[weavejester.dependency :as dep]))
(defrecord Ref [key])
(defn ref
"Create a reference to a top-level key in a config map. The ref
resolves to the running instance, once its target has started."
[key]
(when-not (qualified-keyword? key)
(throw (ex-info (str "Invalid reference: " key ". Must be a qualified keyword.")
{:reason ::invalid-ref
:ref key})))
(->Ref key))
(defn ref?
"Return true if its argument is a ref."
[x]
(instance? Ref x))
(defn- derived-from?
[key candidate]
(or (= key candidate) (isa? key candidate)))
(defn find-derived
"Return a seq of all entries in a map, m, where the key is the
candidate key or derived from it. If there are no matching keys, nil
is returned."
[m k]
(seq (filter #(or (= (key %) k) (derived-from? (key %) k)) m)))
(defn- find-derived-1
[m k]
(let [kvs (find-derived m k)]
(when (next kvs)
(throw (ex-info (str "Ambiguous key: " k ". Found multiple candidates: "
(str/join ", " (map key kvs)))
{:reason ::ambiguous-key
:key k
:matching (mapv key kvs)})))
(first kvs)))
(defn- depth-search
[pred? coll]
(filter pred? (tree-seq coll? seq coll)))
(defn- find-derived-refs
[config v]
(->> (depth-search ref? v)
(map :key)
(mapcat #(map key (find-derived config %)))))
(defn- dependency-graph
[config]
(reduce-kv (fn [g k v]
(reduce #(dep/depend %1 k %2) g (find-derived-refs config v)))
(dep/graph)
config))
(defn- key-comparator
[graph]
(dep/topo-comparator #(compare (str %1) (str %2)) graph))
(defn- config-keyset
[config ks]
(set (mapcat #(map key (find-derived config %)) ks)))
(defn- validate-init
"Check the config and the requested keys, and return the relevant
keys in init order: requested, plus their transitive dependencies.
A circular dependency surfaces the `weavejester.dependency` ex-info."
[config ks]
(doseq [k (keys config)]
(when-not (qualified-keyword? k)
(throw (ex-info (str "Invalid config key: " k ". Keys must be qualified keywords.")
{:reason ::invalid-config
:key k}))))
(doseq [k ks]
(when-not (seq (find-derived config k))
(throw (ex-info (str "Unknown key: " k ". It matches nothing in the config.")
{:reason ::unknown-key
:key k}))))
(let [graph (dependency-graph config)
keyset (config-keyset config ks)
relevant (select-keys config (set/union keyset
(dep/transitive-dependencies-set graph keyset)))
ref-keys (distinct (map :key (depth-search ref? (vals relevant))))
missing (filterv #(nil? (find-derived relevant %)) ref-keys)]
(when (seq missing)
(throw (ex-info (str "Missing definitions for refs: " (str/join ", " missing))
{:reason ::missing-refs
:config config
:missing-refs missing})))
(doseq [k ref-keys]
(find-derived-1 relevant k))
(let [comparator (key-comparator graph)]
(vec (sort comparator (keys relevant))))))
(defn- resolve-refs
[sys v]
(walk/postwalk #(if (ref? %) (val (find-derived-1 sys (:key %))) %) v))
(defmulti init-key
"Turn a config value associated with a key into a running component.
May return a plain value or a promise; the system awaits it either way."
{:arglists '([key config])}
(fn [key _config] key))
(defmethod init-key :default
[k _config]
(throw (ex-info (str "No init-key method for " k)
{:reason ::missing-init-key
:key k})))
(defmulti halt-key
"Stop the running component associated with a key. Receives the
running instance returned by `init-key`, so anything halt needs must
travel inside it. May return a plain value or a promise; the system
awaits it either way. Must be idempotent."
{:arglists '([key instance])}
(fn [key _instance] key))
(defmethod halt-key :default
[_instance-key _instance]
nil)
(defn ^:private ^:async build-key
[sys k v]
(try
(assoc sys k (await (init-key k (resolve-refs sys v))))
(catch :default cause
(throw (ex-info (str "Error on key " k " when building system")
{:reason ::init-failed
:key k
:value v
:system sys}
cause)))))
(defn- halt-order
[sys ks]
(let [config (or (::origin (meta sys)) {})
graph (dependency-graph config)
keyset (config-keyset config ks)
comparator (key-comparator graph)]
(->> (set/union keyset (dep/transitive-dependents-set graph keyset))
(filter #(contains? sys %))
(sort comparator)
(reverse)
(vec))))
(defn ^:private ^:async halt-keys
"Halt every key in ks, collecting failures instead of stopping at the
first one. Returns a vector of `{:key :cause}` maps."
[sys ks]
(loop [failures []
ks ks]
(if (seq ks)
(let [k (first ks)
failures (try
(await (halt-key k (sys k)))
failures
(catch :default cause
(conj failures {:key k :cause cause})))]
(recur failures (rest ks)))
failures)))
(defn ^:private ^:async halt-silently
[sys]
(when (map? sys)
(await (halt-keys sys (halt-order sys (keys sys)))))
nil)
(defn ^:async init
"Turn a config map into a running system map. Keys start in
dependency order, each one awaited, with refs resolved to the running
instances. With two args, only those keys start, plus whatever they
depend on.
Returns a promise of the system map. If a component fails to start,
what already started is halted in reverse order, and the promise
rejects with the original failure carrying `:reason ::init-failed`,
the offending `:key`, and the partial `:system`."
([config]
(init config (keys config)))
([config ks]
(assert (map? config) "init needs a config map")
(let [order (validate-init config ks)]
(try
(loop [sys (with-meta {} {::origin config})
ks order]
(if (seq ks)
(recur (await (build-key sys (first ks) (config (first ks))))
(rest ks))
sys))
(catch :default cause
(await (halt-silently (:system (ex-data cause))))
(throw cause))))))
(defn ^:async halt
"Halt a running system map in reverse dependency order, awaiting each
component. With two args, halt those keys plus whatever depends on them.
Returns a promise of nil. Every component is given its chance to stop:
failures are collected, and once everything ran, the promise rejects
with `:reason ::halt-failed` and the `:failures` vector."
([sys]
(halt sys (keys sys)))
([sys ks]
(when-not (and (map? sys) (::origin (meta sys)))
(throw (ex-info "halt needs a system map built by init."
{:reason ::not-a-system})))
(let [failures (await (halt-keys sys (halt-order sys ks)))]
(when (seq failures)
(throw (ex-info (str "Failed to halt " (count failures) " component(s): "
(str/join ", " (map :key failures)))
{:reason ::halt-failed
:failures failures}))))))

108
exporter/test/exporter_tests/browser_test.cljs Normal file
View File

@ -0,0 +1,108 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter-tests.browser-test
"The browser pool service: lifecycle through the system, and the
acquire/use/release contract of exec, against a fake browser factory."
(:require
["generic-pool/lib/errors.js" :as gpe]
[cljs.test :as t :include-macros true]
[exporter.browser :as browser]
[exporter.utils.system :as system]))
(defn- stub-page
[]
#js {:marker :stub-page})
(defn- stub-context
[calls page]
#js {:newPage (fn [] (swap! calls conj :new-page) (js/Promise.resolve page))
:close (fn [] (swap! calls conj :close-context) (js/Promise.resolve nil))})
(defn- stub-browser
[calls]
(let [page (stub-page)]
#js {:newContext (fn [_opts]
(swap! calls conj :new-context)
(js/Promise.resolve (stub-context calls page)))
:isConnected (fn [] true)
:close (fn []
(swap! calls conj :close-browser)
(js/Promise.resolve nil))}))
(defn- fake-create-browser
[calls]
(fn []
(swap! calls conj :create-browser)
(js/Promise.resolve (stub-browser calls))))
(defn- test-config
[calls]
{:exporter.browser/pool {:exporter.browser/max 1
:exporter.browser/create-browser (fake-create-browser calls)}})
(t/deftest ^:async pool-starts-and-stops-through-the-system
(try
(let [calls (atom [])
sys (await (system/init (test-config calls)))]
(t/is (some? (:exporter.browser/pool sys)))
(t/is (nil? (await (system/halt sys)))))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async exec-acquires-runs-handle-and-releases
(try
(let [calls (atom [])
sys (await (system/init (test-config calls)))
pool (:exporter.browser/pool sys)
seen (atom nil)
result (await (browser/exec pool {} (fn [page] (reset! seen page) :handle-result)))]
(t/is (= :handle-result result))
(t/is (= :stub-page (.-marker @seen)))
(t/is (= [:create-browser :new-context :new-page :close-context] @calls))
(t/is (not (some #{:close-browser} @calls)))
(t/testing "a second exec reuses the released browser: nothing is created again"
(await (browser/exec pool {} (fn [_] :again)))
(t/is (= 1 (count (filter #{:create-browser} @calls)))))
(await (system/halt sys)))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async exec-destroys-the-browser-on-failure
(try
(let [calls (atom [])
sys (await (system/init (test-config calls)))
pool (:exporter.browser/pool sys)]
(try
(await (browser/exec pool {} (fn [_] (js/Promise.reject (ex-info "render broke" {})))))
(t/is false "exec should have rejected when the handle fails")
(catch :default cause
(t/is (= "render broke" (ex-message cause)))
(t/is (some #{:close-browser} @calls))))
(await (system/halt sys)))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))
(t/deftest ^:async exec-without-pool-fails-fast
(try
(await (browser/exec nil {} (fn [_] :never)))
(t/is false "exec should have rejected without a pool")
(catch :default cause
(t/is (= ::browser/not-started (-> cause ex-data :reason))))))
(t/deftest ^:async exec-translates-playwright-timeouts
(try
(let [calls (atom [])
sys (await (system/init (test-config calls)))
pool (:exporter.browser/pool sys)]
(try
(await (browser/exec pool {} (fn [_] (js/Promise.reject (gpe/TimeoutError. "timeout exceeded")))))
(t/is false "exec should have rejected on a playwright timeout")
(catch :default cause
(t/is (= :timeout (-> cause ex-data :code)))))
(await (system/halt sys)))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))

16
exporter/test/exporter_tests/main_test.cljs Normal file
View File

@ -0,0 +1,16 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter-tests.main-test
"The new `exporter.*` tree loads: requiring `exporter.main` resolves
its namespace."
(:require
[cljs.test :as t :include-macros true]
[exporter.main]))
(t/deftest new-tree-loads
(t/testing "exporter.main resolves once required"
(t/is (some? (find-ns 'exporter.main)))))

8
exporter/test/exporter_tests/runner.cljs
View File

@ -11,11 +11,14 @@
[clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]]
[exporter-tests.api-test]
[exporter-tests.browser-test]
[exporter-tests.consumer-config-test]
[exporter-tests.consumer-plan-test]
[exporter-tests.jobs-test]
[exporter-tests.main-test]
[exporter-tests.renderer-svg-test]
[exporter-tests.shell-test]
[exporter-tests.system-test]
[exporter-tests.wasm-pool-test]
[exporter-tests.worker-test]
[goog.object :as gobj]))
@ -30,13 +33,16 @@
(println (str "UNHANDLED-REJECTION: " reason))))
(def test-namespaces
['exporter-tests.consumer-plan-test
['exporter-tests.browser-test
'exporter-tests.consumer-plan-test
'exporter-tests.jobs-test
'exporter-tests.main-test
'exporter-tests.api-test
'exporter-tests.worker-test
'exporter-tests.consumer-config-test
'exporter-tests.renderer-svg-test
'exporter-tests.shell-test
'exporter-tests.system-test
'exporter-tests.wasm-pool-test])
(assert (every? find-ns-obj test-namespaces)

215
exporter/test/exporter_tests/system_test.cljs Normal file
View File

@ -0,0 +1,215 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns exporter-tests.system-test
"The async system lifecycle: dependency-ordered init and halt, with
refs resolved to the running instances."
(:require
[cljs.test :as t :include-macros true]
[exporter.utils.system :as system]))
;; Each init method records its key on the tracker carried by its own
;; config, and returns a running instance that carries the tracker back,
;; so the matching halt method can record on the same atom.
(defn- track-init
[tracker k]
(swap! tracker conj k)
{:tracker tracker :component k})
(defn- track-halt
[tracker k]
(swap! tracker conj [:halted k])
nil)
(defmethod system/init-key :order-test/a [_ {:keys [tracker]}] (track-init tracker :order-test/a))
(defmethod system/init-key :order-test/b [_ {:keys [tracker]}] (track-init tracker :order-test/b))
(defmethod system/init-key :order-test/c [_ {:keys [tracker]}] (track-init tracker :order-test/c))
(defmethod system/halt-key :order-test/a [_ {:keys [tracker]}] (track-halt tracker :order-test/a))
(defmethod system/halt-key :order-test/b [_ {:keys [tracker]}] (track-halt tracker :order-test/b))
(defmethod system/halt-key :order-test/c [_ {:keys [tracker]}] (track-halt tracker :order-test/c))
(defn- order-config
[tracker]
{:order-test/a {:tracker tracker}
:order-test/b {:tracker tracker :dep (system/ref :order-test/a)}
:order-test/c {:tracker tracker :dep (system/ref :order-test/b)}})
(defmethod system/init-key :refs-test/db [_ {:keys [tracker]}]
(swap! tracker conj :refs-test/db)
{:tracker tracker :component :refs-test/db :conn :fake-conn})
(defmethod system/init-key :refs-test/api [_ {:keys [tracker dep]}]
(swap! tracker conj [:refs-test/api-sees dep])
{:tracker tracker :component :refs-test/api})
(defmethod system/init-key :async-test/db [_ _]
(js/Promise. (fn [resolve _] (js/setTimeout (fn [] (resolve :async-conn)) 5))))
(defmethod system/init-key :async-test/api [_ {:keys [dep]}]
{:component :async-test/api :dep dep})
(defmethod system/init-key :fail-test/a [_ {:keys [tracker]}] (track-init tracker :fail-test/a))
(defmethod system/init-key :fail-test/b [_ {:keys [tracker fail?]}]
(swap! tracker conj :fail-test/b)
(if fail?
(js/Promise.reject (ex-info "cannot connect" {}))
{:tracker tracker :component :fail-test/b}))
(defmethod system/halt-key :fail-test/a [_ {:keys [tracker]}] (track-halt tracker :fail-test/a))
(defmethod system/init-key :haltfail-test/a [_ {:keys [tracker]}] (track-init tracker :haltfail-test/a))
(defmethod system/init-key :haltfail-test/b [_ {:keys [tracker boom?]}]
(assoc (track-init tracker :haltfail-test/b) :boom? boom?))
(defmethod system/halt-key :haltfail-test/a [_ {:keys [tracker]}] (track-halt tracker :haltfail-test/a))
(defmethod system/halt-key :haltfail-test/b [_ {:keys [tracker boom?]}]
(swap! tracker conj [:haltfail-test/b-ran boom?])
(when boom?
(throw (ex-info "cannot stop" {})))
nil)
(derive :derive-test/child :derive-test/parent)
(derive :derive-test/other :derive-test/parent)
(defmethod system/init-key :derive-test/child [_ _] :child-running)
(defmethod system/init-key :derive-test/other [_ _] :other-running)
(defmethod system/init-key :derive-test/consumer [_ {:keys [dep]}] dep)
(defmethod system/init-key :derive-test/consumer2 [_ {:keys [dep]}] dep)
(defmethod system/init-key :circ-test/a [_ _] :circ-a-running)
(defmethod system/init-key :circ-test/b [_ _] :circ-b-running)
(defmethod system/init-key :nohalt-test/a [_ _] :nohalt-a-running)
(t/deftest ^:async inits-keys-in-dependency-order
(try
(let [tracker (atom [])
sys (await (system/init (order-config tracker)))]
(t/is (= [:order-test/a :order-test/b :order-test/c] @tracker))
(t/is (= #{:order-test/a :order-test/b :order-test/c} (set (keys sys)))))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async resolves-refs-to-running-instances
(try
(let [tracker (atom [])
sys (await (system/init {:refs-test/db {:tracker tracker}
:refs-test/api {:tracker tracker
:dep (system/ref :refs-test/db)}}))]
(t/is (= [:refs-test/db
[:refs-test/api-sees {:tracker tracker
:component :refs-test/db
:conn :fake-conn}]]
@tracker))
(t/is (= :refs-test/api (:component (:refs-test/api sys)))))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async awaits-promised-instances
(try
(let [sys (await (system/init {:async-test/db {}
:async-test/api {:dep (system/ref :async-test/db)}}))]
(t/is (= :async-conn (:async-test/db sys)))
(t/is (= :async-conn (:dep (:async-test/api sys)))))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async missing-ref-fails-init
(try
(await (system/init {:missing-test/a {:dep (system/ref :missing-test/ghost)}}))
(t/is false "init should have rejected on a missing ref")
(catch :default cause
(t/is (= ::system/missing-refs (-> cause ex-data :reason)))
(t/is (= [:missing-test/ghost] (-> cause ex-data :missing-refs))))))
(t/deftest ^:async failed-init-halts-what-already-started
(let [tracker (atom [])]
(try
(await (system/init {:fail-test/a {:tracker tracker}
:fail-test/b {:tracker tracker
:fail? true
:dep (system/ref :fail-test/a)}}))
(t/is false "init should have rejected when a component fails")
(catch :default cause
(t/is (= ::system/init-failed (-> cause ex-data :reason)))
(t/is (= :fail-test/b (-> cause ex-data :key)))
(t/is (= [:fail-test/a :fail-test/b [:halted :fail-test/a]] @tracker))))))
(t/deftest ^:async halts-in-reverse-dependency-order
(try
(let [tracker (atom [])
sys (await (system/init (order-config tracker)))
result (await (system/halt sys))]
(t/is (nil? result))
(t/is (= [[:halted :order-test/c]
[:halted :order-test/b]
[:halted :order-test/a]]
(drop 3 @tracker))))
(catch :default cause
(t/is false (str "unexpected halt failure: " (ex-message cause))))))
(t/deftest ^:async halt-continues-past-a-failing-component
(try
(let [tracker (atom [])
sys (await (system/init {:haltfail-test/a {:tracker tracker}
:haltfail-test/b {:tracker tracker
:boom? true
:dep (system/ref :haltfail-test/a)}}))]
(try
(await (system/halt sys))
(t/is false "halt should have rejected when a component fails to stop")
(catch :default cause
(t/is (= ::system/halt-failed (-> cause ex-data :reason)))
(t/is (= [:haltfail-test/b] (mapv :key (-> cause ex-data :failures))))))
(t/is (= [:haltfail-test/a
:haltfail-test/b
[:haltfail-test/b-ran true]
[:halted :haltfail-test/a]]
@tracker)))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async init-subset-pulls-its-dependencies
(try
(let [tracker (atom [])
sys (await (system/init (order-config tracker) [:order-test/c]))]
(t/is (= [:order-test/a :order-test/b :order-test/c] @tracker))
(t/is (= #{:order-test/a :order-test/b :order-test/c} (set (keys sys)))))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async ref-to-a-parent-resolves-the-derived-child
(try
(let [sys (await (system/init {:derive-test/child {}
:derive-test/consumer {:dep (system/ref :derive-test/parent)}}))]
(t/is (= :child-running (:derive-test/consumer sys))))
(catch :default cause
(t/is false (str "unexpected init failure: " (ex-message cause))))))
(t/deftest ^:async ref-to-a-parent-with-two-children-is-ambiguous
(try
(await (system/init {:derive-test/child {}
:derive-test/other {}
:derive-test/consumer2 {:dep (system/ref :derive-test/parent)}}))
(t/is false "init should have rejected on an ambiguous ref")
(catch :default cause
(t/is (= ::system/ambiguous-key (-> cause ex-data :reason))))))
(t/deftest ^:async circular-dependencies-fail-init
(try
(await (system/init {:circ-test/a {:dep (system/ref :circ-test/b)}
:circ-test/b {:dep (system/ref :circ-test/a)}}))
(t/is false "init should have rejected on a circular dependency")
(catch :default cause
(t/is (= :weavejester.dependency/circular-dependency
(-> cause ex-data :reason))))))
(t/deftest ^:async key-without-halt-method-halts-cleanly
(try
(let [sys (await (system/init {:nohalt-test/a {}}))
result (await (system/halt sys))]
(t/is (= :nohalt-a-running (:nohalt-test/a sys)))
(t/is (nil? result)))
(catch :default cause
(t/is false (str "unexpected failure: " (ex-message cause))))))