From 77ed919997f6534c3b4948e5fef6031030c0210a Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Wed, 7 Oct 2026 18:59:02 +0000 Subject: [PATCH] :tada: Port the renderer services to the new tree The wasm worker pool becomes a service with an injectable worker factory and its creation handshake as a unit of its own. The bitmap/pdf/svg flows merge into one browser renderer driven by an explicit context, and the headless driver leases one worker per job with its cancel source injected instead of reaching the registry. Each piece ships with hermetic tests off fake workers and pages. AI-assisted-by: muse-spark-1.3-contributor --- .serena/memories/exporter/core.md | 3 + exporter/src/exporter/renderer/browser.cljs | 486 ++++++++++++++++++ .../src/exporter/renderer/svg_gradient.cljs | 32 ++ exporter/src/exporter/renderer/wasm.cljs | 70 +++ exporter/src/exporter/wasm/pool.cljs | 256 +++++++++ .../exporter_tests/renderer_browser_test.cljs | 154 ++++++ .../exporter_tests/renderer_wasm_test.cljs | 181 +++++++ exporter/test/exporter_tests/runner.cljs | 6 + .../wasm_pool_service_test.cljs | 184 +++++++ 9 files changed, 1372 insertions(+) create mode 100644 exporter/src/exporter/renderer/browser.cljs create mode 100644 exporter/src/exporter/renderer/svg_gradient.cljs create mode 100644 exporter/src/exporter/renderer/wasm.cljs create mode 100644 exporter/src/exporter/wasm/pool.cljs create mode 100644 exporter/test/exporter_tests/renderer_browser_test.cljs create mode 100644 exporter/test/exporter_tests/renderer_wasm_test.cljs create mode 100644 exporter/test/exporter_tests/wasm_pool_service_test.cljs diff --git a/.serena/memories/exporter/core.md b/.serena/memories/exporter/core.md index d8f8ecf0fa..6944749c27 100644 --- a/.serena/memories/exporter/core.md +++ b/.serena/memories/exporter/core.md @@ -41,6 +41,9 @@ on this side: the row of the job, its cancel and its result are the backend's. - 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. - `exporter.main` mirrors the backend's `app.main`: a `system-config` def reading env at the wiring layer, a public `system` atom with the running map, `start`/`stop`/`restart` (`^:async`, resolving `:started`/`:stopped`/`:restarted`), `start-custom` as the test seam, idempotent `install-process-handlers` for the `uncaughtException`/SIGTERM/SIGINT wiring (runs on `start`, never on namespace load), `^:dev/before-load-async`/`^:dev/after-load-async` hooks bridging the promise lifecycle to shadow's `done` callbacks (a hook failure logs, never sticks the reload), and `main` as the entry point: shadow boots `exporter.main/main`, and the old `app.core` reload path (`stop` and the `:devtools` wiring) sits commented out until `app.*` is fully ported. The entry leaves info logging enabled for the new tree (`setup!` on the `exporter` logger, mirroring the old `{:app :info}`); without it the default level filters everything below fatal. - Service config maps take plain (non-namespaced) param keys (`{:exporter.browser/pool {:max 2}}`): the top-level key already scopes the component, so namespacing the params only adds noise. Component keys and error reasons stay namespaced. +- `exporter.wasm.pool` mirrors the browser service for `worker_threads`: the running instance is `{:pool :timeout-ms}` (the pool plus the silence timeout its renders await), `with-worker`/`render-on`/`terminate` take the pool first, the worker factory is injected through config, and the creation handshake (`await-ready`) is its own unit with `:worker-not-ready`/`boot-error` paths. +- `exporter.renderer.browser` merges the bitmap/pdf/svg flows into one `render [ctx params on-object]` (branching by type, `on-object` always awaited, unknown types raise); `ctx` carries what the job params do not freeze (`:browser-pool`, `:base-uri`, `:public-uri`, `:svgo?`). Dead xml predicates from the old tree did not survive the merge. +- `exporter.renderer.wasm` drives headless renders off the wasm pool instance (`{:pool :timeout-ms}`): `with-scope` leases one worker and serializes its renders, and the cancel source arrives injected (`:cancel-signal`/`:cancelled?`/`:on-cancel` fns) instead of reaching the jobs registry. - Async test vars prove their chain only when really awaited: a test passing with 0 assertions means the chain broke upstream. ## Render details diff --git a/exporter/src/exporter/renderer/browser.cljs b/exporter/src/exporter/renderer/browser.cljs new file mode 100644 index 0000000000..bb347edf5c --- /dev/null +++ b/exporter/src/exporter/renderer/browser.cljs @@ -0,0 +1,486 @@ +;; 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.renderer.browser + "Renders through a browser page: bitmap, pdf and svg in one namespace. + + Every flow renders one partition of objects per browser checkout: + navigate once, then capture object by object, calling `on-object` + with each object carrying its `:path`. `on-object` may return a + plain value or a promise; it is always awaited. + + `ctx` carries the environment the job params do not freeze: the + `:browser-pool`, the render `:base-uri` and `:public-uri`, and the + `:svgo?` flag. There are no promesa chains in this namespace." + (:require + ["@penpot/svgo" :as svgo] + ["xml-js" :as xml] + [app.common.data :as d] + [app.common.data.macros :as dm] + [app.common.exceptions :as ex] + [app.common.logging :as l] + [app.common.types.color :as ctc] + [app.common.uri :as u] + [app.util.mime :as mime] + [app.util.shell :as sh] + [clojure.walk :as walk] + [cuerdas.core :as str] + [exporter.browser :as browser] + [exporter.renderer.svg-gradient :as svg-gradient])) + +(l/set-level! :trace) + +(defn- prepare-options + [uri token scale] + #js {:screen #js {:width browser/default-viewport-width + :height browser/default-viewport-height} + :viewport #js {:width browser/default-viewport-width + :height browser/default-viewport-height} + :locale "en-US" + :storageState #js {:cookies (browser/create-cookies uri {:token token})} + :deviceScaleFactor scale + :userAgent browser/default-user-agent}) + +(defn- render-uri + [base-uri query-params] + (-> base-uri + (u/ensure-path-slash) + (u/join "render.html") + (assoc :query (u/map->query-string query-params)))) + +;; --- BITMAP (png, jpeg, webp) + +(defn- ^:async render-bitmap-object + [page type object on-object] + (let [path (await (sh/tempfile :prefix "penpot.tmp.bitmap." :suffix (mime/get-extension type))) + node (browser/select page (str/concat "#screenshot-" (:id object)))] + (await (browser/wait-for node)) + (case type + :png (await (browser/screenshot node {:omit-background? true :type type :path path})) + :jpeg (await (browser/screenshot node {:omit-background? false :type type :path path})) + :webp (let [png-path (await (sh/tempfile :prefix "penpot.tmp.bitmap." :suffix ".png"))] + ;; playwright only supports jpg and png, we need to convert it afterwards + (await (browser/screenshot node {:omit-background? true :type :png :path png-path})) + (await (sh/run-cmd "convert" png-path "-quality" "100" (str "WEBP:" path))))) + (await (on-object (assoc object :path path))))) + +(defn- ^:async render-bitmap-page + [uri page type objects on-object] + (l/info :uri uri) + ;; navigate to the page and perform basic setup + (await (browser/nav page (str uri))) + (await (browser/sleep page 1000)) ; the good old fix with sleep + (await (browser/wait-for-fonts page)) + (await (browser/eval page (js* "() => document.body.style.background = 'transparent'"))) + ;; take the screnshot of requested objects, one by one + (await (js/Promise.all (mapv (fn [object] (render-bitmap-object page type object on-object)) + objects))) + nil) + +(defn- ^:async render-bitmap + [ctx {:keys [file-id page-id share-id token scale type objects skip-children]} on-object] + (let [query {:file-id file-id + :page-id page-id + :share-id share-id + :object-id (mapv :id objects) + :route "objects" + :skip-children skip-children} + uri (render-uri (:base-uri ctx) query)] + (await (browser/exec (:browser-pool ctx) + (prepare-options uri token scale) + (fn [page] (render-bitmap-page uri page type objects on-object)))))) + +;; --- PDF + +(defn- prepare-pdf-uri + [base-uri {:keys [file-id page-id share-id]} object-id] + (let [query {:file-id file-id + :page-id page-id + :share-id share-id + :object-id object-id + :route "objects"}] + (-> base-uri + (u/join "render.html") + (assoc :query (u/map->query-string query))))) + +(defn- sync-page-size + [dom] + (browser/eval dom + (fn [elem] + ;; IMPORTANT: No CLJS runtime allowed. Use only JS + ;; primitives. This runs in a context without access to + ;; cljs.core. Avoid any functions that transpile to + ;; cljs.core/* calls, as they will break in the browser + ;; runtime. + + (let [width (.getAttribute ^js elem "width") + height (.getAttribute ^js elem "height") + style-node (let [node (.createElement js/document "style")] + (.appendChild (.-head js/document) node) + node)] + (set! (.-textContent style-node) + (dm/str "@page { size: " width "px " height "px; margin: 0; }\n" + "html, body, #app { margin: 0; padding: 0; width: " width "px; height: " height "px; overflow: visible; }")))))) + +(defn- ^:async render-pdf-object + [page base-uri params object on-object] + (let [uri (prepare-pdf-uri base-uri params (:id object)) + path (await (sh/tempfile :prefix "penpot.tmp.pdf." :suffix (mime/get-extension (:type params))))] + (l/info :uri uri) + (await (browser/nav page uri)) + (let [dom (browser/select page (dm/str "#screenshot-" (:id object)))] + (await (browser/wait-for dom)) + (await (sync-page-size dom)) + (await (browser/screenshot dom {:full-page? true})) + (await (browser/sleep page 2000)) ; the good old fix with sleep + (await (browser/wait-for-fonts page)) + (await (browser/pdf page {:path path})) + (await (on-object (assoc object :path path)))))) + +(defn- ^:async render-pdf-page + [base-uri page params objects on-object] + (doseq [object objects] + (await (render-pdf-object page base-uri params object on-object))) + nil) + +(defn- ^:async render-pdf + [ctx {:keys [token scale] :as params} on-object] + (let [base-uri (-> (:base-uri ctx) + (u/ensure-path-slash))] + (await (browser/exec (:browser-pool ctx) + (prepare-options base-uri token scale) + (fn [page] + (render-pdf-page base-uri page params (:objects params) on-object)))))) + +;; --- SVG + +(defn- xml->clj + [data] + (js->clj (xml/xml2js data))) + +(defn- clj->xml + [data] + (xml/js2xml (clj->js data))) + +(defn- ^boolean element? + [item] + (and (map? item) + (= "element" (get item "type")))) + +(defn- ^boolean foreign-object-element? + [item] + (and (element? item) + (= "foreignObject" (get item "name")))) + +(defn- ^boolean empty-defs-element? + [item] + (and (= (get item "name") "defs") + (nil? (get item "attributes")) + (nil? (get item "elements")))) + +(defn- ^boolean empty-path-element? + [item] + (and (= (get item "name") "path") + (let [d (get-in item ["attributes" "d"])] + (or (str/blank? d) + (nil? d) + (str/empty? d))))) + +(defn- flatten-toplevel-svg-elements + "Flattens XML data structure if two nested top-side SVG elements found." + [item] + (if (and (= "svg" (get-in item ["elements" 0 "name"])) + (= "svg" (get-in item ["elements" 0 "elements" 0 "name"]))) + (update-in item ["elements" 0] assoc "elements" (get-in item ["elements" 0 "elements" 0 "elements"])) + item)) + +(defn- replace-text-nodes + "Function responsible of replace the foreignObject elements on the + provided XML with the previously rasterized PATH's." + [xmldata nodes] + (letfn [(replace-fobject [item] + (if (foreign-object-element? item) + (let [id (get-in item ["attributes" "id"]) + node (get nodes id)] + (if node + (:svgdata node) + item)) + item)) + + (process-element [item xform] + (d/update-when item "elements" #(into [] xform %)))] + + (let [xform (comp (remove empty-defs-element?) + (remove empty-path-element?) + (map replace-fobject))] + (->> xmldata + (xml->clj) + (flatten-toplevel-svg-elements) + (walk/prewalk (fn [item] + (cond-> item + (element? item) + (process-element xform)))) + (clj->xml))))) + +(defn- parse-viewbox + "Parses viewBox string into width & height map." + [data] + (let [[width height] (->> (str/split data #"\s+") + (drop 2) + (map d/parse-double))] + {:width width + :height height})) + +(defn- replace-internal-uris + "Replaces internal-uri references with public-uri in SVG output. + This ensures that font URLs and other resource references in the + exported SVG use the public-facing URI accessible to end users." + [svg-content internal-uri public-uri] + (let [internal-uri (str internal-uri) + public-uri (str public-uri)] + (if (and (not= internal-uri public-uri) + (str/includes? svg-content internal-uri)) + (str/replace svg-content internal-uri public-uri) + svg-content))) + +(defn- ^:async convert-to-ppm + [pngpath] + (let [ppmpath (str/concat pngpath "origin.ppm")] + (l/trace :fn :convert-to-ppm :path ppmpath) + (await (sh/run-cmd "convert" pngpath ppmpath)) + ppmpath)) + +(defn- ^:async trace-color-mask + [pbmpath] + (l/trace :fn :trace-color-mask :pbmpath pbmpath) + (let [svgpath (str/concat pbmpath ".svg")] + (await (sh/run-cmd "potrace" "--flat" "-b" "svg" pbmpath "-o" svgpath)) + svgpath)) + +(defn- ^:async generate-color-layer + [ppmpath color] + (when-not (ctc/hex-color-string? color) + (ex/raise :type :validation + :code :invalid-color + :hint (str "invalid hex color: " color))) + (l/trace :fn :generate-color-layer :ppmpath ppmpath :color color) + (let [pbmpath (str/concat ppmpath ".mask-" (subs color 1) ".pbm") + stdout (await (sh/run-cmd "ppmcolormask" color ppmpath))] + (await (sh/write-file pbmpath stdout)) + (let [svgpath (await (trace-color-mask pbmpath)) + data (await (sh/read-file svgpath)) + data (xml->clj data) + data (get-in data ["elements" 1])] + {:color color + :svgdata data}))) + +(defn- set-path-color + [id color mapping node] + (let [color-mapping (get mapping color)] + (cond + (and (some? color-mapping) + (= "transparent" (get color-mapping "type"))) + (update node "attributes" assoc + "fill" (get color-mapping "hex") + "fill-opacity" (get color-mapping "opacity")) + + (and (some? color-mapping) + (= "gradient" (get color-mapping "type"))) + (update node "attributes" assoc + "fill" (str "url(#gradient-" id "-" (subs color 1) ")")) + + :else + (update node "attributes" assoc "fill" color)))) + +(defn- get-gradients + [id mapping] + (->> mapping + (filter (fn [[_color data]] + (= (get data "type") "gradient"))) + (mapv (partial svg-gradient/data->gradient-def id)))) + +(defn- join-color-layers + [{:keys [id x y width height mapping] :as node} layers] + (l/trace :fn :join-color-layers :mapping mapping) + (loop [result (-> (:svgdata (first layers)) + (assoc "elements" [])) + layers (seq layers)] + (if-let [{:keys [color svgdata]} (first layers)] + (recur (->> (get svgdata "elements") + (filter #(= (get % "name") "g")) + (map (partial set-path-color id color mapping)) + (update result "elements" into)) + (rest layers)) + + ;; Now we have the result containing the svgdata of a + ;; SVG with all text layers. Now we need to transform + ;; this SVG to G (Group) and remove unnecessary metadata + ;; objects. + (let [vbox (-> (get-in result ["attributes" "viewBox"]) + (parse-viewbox)) + transform (str/fmt "translate(%s, %s) scale(%s, %s)" x y + (/ width (:width vbox)) + (/ height (:height vbox))) + + gradient-defs (get-gradients id mapping) + + elements + (->> (get result "elements") + (mapv (fn [group] + (let [paths (get group "elements")] + (if (= 1 (count paths)) + (let [path (first paths)] + (update path "attributes" + (fn [attrs] + (-> attrs + (d/merge (get group "attributes")) + (update "transform" #(str transform " " %)))))) + (update-in group ["attributes" "transform"] #(str transform " " %))))))) + + elements (cond->> elements + (seq gradient-defs) + (into [{"type" "element" "name" "defs" "attributes" {} + "elements" gradient-defs}]))] + + (-> result + (assoc "name" "g") + (assoc "attributes" {}) + (assoc "elements" elements)))))) + +(defn- ^:async convert-to-svg + [ppmpath node] + (l/trace :fn :convert-to-svg :ppmpath ppmpath :colors (:colors node)) + (let [layers (await (js/Promise.all (mapv (partial generate-color-layer ppmpath) + (:colors node))))] + (join-color-layers node layers))) + +(defn- ^:async trace-node + [node] + (l/trace :fn :trace-node) + (let [pngpath (await (sh/tempfile :prefix "penpot.tmp.render.svg.parse." + :suffix ".origin.png"))] + (await (sh/write-file pngpath (:data node))) + (let [ppmpath (await (convert-to-ppm pngpath)) + svgdata (await (convert-to-svg ppmpath node))] + (-> node + (dissoc :data) + (assoc :svgdata svgdata))))) + +(defn- extract-element-attrs + [^js element] + (let [^js attrs (.. element -attributes) + ^js colors (.. element -dataset -colors) + ^js mapping (.. element -dataset -mapping)] + #js {:id (.. attrs -id -value) + :x (.. attrs -x -value) + :y (.. attrs -y -value) + :width (.. attrs -width -value) + :height (.. attrs -height -value) + :colors (.split colors ",") + :mapping (js/JSON.parse mapping)})) + +(defn- ^:async extract-single-node + [[shot node]] + (l/trace :fn :extract-single-node) + (let [attrs (await (browser/eval node extract-element-attrs))] + {:id (unchecked-get attrs "id") + :x (unchecked-get attrs "x") + :y (unchecked-get attrs "y") + :width (unchecked-get attrs "width") + :height (unchecked-get attrs "height") + :colors (vec (unchecked-get attrs "colors")) + :mapping (js->clj (unchecked-get attrs "mapping")) + :data shot})) + +(defn- ^:async resolve-text-node + [page node] + (let [attrs (await (browser/eval node extract-element-attrs)) + id (unchecked-get attrs "id") + text-node (browser/select page (str "#screenshot-text-" id " foreignObject")) + shot (await (browser/screenshot text-node {:omit-background? true :type "png"}))] + [shot node])) + +(defn- ^:async extract-txt-node + [page item] + (let [[shot node] (await (resolve-text-node page item)) + single (await (extract-single-node [shot node]))] + (await (trace-node single)))) + +(defn- ^:async extract-txt-nodes + [page {:keys [id]}] + (l/trace :fn :process-text-nodes) + (let [nodes (await (browser/select-all page (str/concat "#screenshot-" id " foreignObject"))) + nodes (await (js/Promise.all (mapv (partial extract-txt-node page) nodes)))] + (d/index-by :id nodes))) + +(defn- ^:async extract-svg + [page {:keys [id]}] + (let [node (browser/select page (str/concat "#screenshot-" id))] + (await (browser/wait-for node)) + (await (browser/eval node (fn [elem] (.-outerHTML ^js elem)))))) + +(defn sanitize-svg-content + "SVG standard don't allow the entity nbsp.   is equivalent but + compatible with SVG." + [content] + (str/replace content " " " ")) + +(defn- ^:async render-svg-object + [ctx page type object on-object] + (let [path (await (sh/tempfile :prefix "penpot.tmp.render.svg." :suffix (mime/get-extension type))) + node (browser/select page (str/concat "#screenshot-" (:id object)))] + (await (browser/wait-for node)) + (let [xmldata (await (extract-svg page object)) + txtdata (await (extract-txt-nodes page object)) + result (replace-text-nodes xmldata txtdata) + result (sanitize-svg-content result) + + result (if (:svgo? ctx) + (svgo/optimize result svgo/defaultOptions) + result) + + result (replace-internal-uris result (:base-uri ctx) (:public-uri ctx))] + (await (sh/write-file path result)) + (await (on-object (assoc object :path path)))))) + +(defn- ^:async render-svg-page + [ctx uri page type objects on-object] + (l/info :uri uri) + ;; navigate to the page and perform basic setup + (await (browser/nav page (str uri))) + (await (browser/sleep page 1000)) ; the good old fix with sleep + (await (browser/wait-for-fonts page)) + ;; take the screnshot of requested objects, one by one + (await (js/Promise.all (mapv (fn [object] (render-svg-object ctx page type object on-object)) + objects))) + nil) + +(defn- ^:async render-svg + [ctx {:keys [file-id page-id share-id token scale type objects]} on-object] + (let [query {:file-id file-id + :page-id page-id + :share-id share-id + :render-embed true + :object-id (mapv :id objects) + :route "objects"} + uri (render-uri (:base-uri ctx) query)] + (await (browser/exec (:browser-pool ctx) + (prepare-options uri token scale) + (fn [page] (render-svg-page ctx uri page type objects on-object)))))) + +(defn ^:async render + "Renders one partition of objects through a browser page: bitmap + (png, jpeg, webp), pdf or svg depending on the type in `params`. + Calls `on-object` with each object carrying its `:path`, awaiting it + every time, and resolves nil." + [ctx {:keys [type] :as params} on-object] + (case type + (:png :jpeg :webp) (await (render-bitmap ctx params on-object)) + :pdf (await (render-pdf ctx params on-object)) + :svg (await (render-svg ctx params on-object)) + (ex/raise :type :validation + :code :unknown-render-type + :hint (str "unknown render type: " type)))) diff --git a/exporter/src/exporter/renderer/svg_gradient.cljs b/exporter/src/exporter/renderer/svg_gradient.cljs new file mode 100644 index 0000000000..cfacaf38f5 --- /dev/null +++ b/exporter/src/exporter/renderer/svg_gradient.cljs @@ -0,0 +1,32 @@ +;; 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.renderer.svg-gradient) + +(defn- get-stops + [data] + (->> (get-in data ["gradient" "stops"]) + (mapv (fn [stop-data] + {"type" "element" + "name" "stop" + "attributes" {"offset" (get stop-data "offset") + "stop-color" (get stop-data "color") + "stop-opacity" (get stop-data "opacity")}})))) + +(defn data->gradient-def + [id [color data]] + (let [id (str "gradient-" id "-" (subs color 1)) + gradient-type (get-in data ["gradient" "type"])] + (if (= gradient-type "linear") + {"type" "element" + "name" "linearGradient" + "attributes" {"id" id "x1" "0.5" "y1" "1" "x2" "0.5" "y2" "0"} + "elements" (get-stops data)} + + {"type" "element" + "name" "radialGradient" + "attributes" {"id" id "cx" "0.5" "cy" "0.5" "r" "0.5"} + "elements" (get-stops data)}))) diff --git a/exporter/src/exporter/renderer/wasm.cljs b/exporter/src/exporter/renderer/wasm.cljs new file mode 100644 index 0000000000..3c39f33305 --- /dev/null +++ b/exporter/src/exporter/renderer/wasm.cljs @@ -0,0 +1,70 @@ +;; 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.renderer.wasm + "Main-thread side of the headless renderer. + + Renders run on pooled workers because Skia calls are synchronous and + would block the event loop for every other export. Each job keeps one + worker for all its renders, sharing its caches and pool slot. + + The worker pool arrives as the instance map the pool service owns + (`{:pool :timeout-ms}`); the cancel source arrives as plain fns, so + production wires the jobs registry and tests wire atoms: + + ```clojure + {:cancel-signal (fn [job-id] ...) + :cancelled? (fn [job-id] ...) + :on-cancel (fn [job-id f] ...)} + ```" + (:require + [app.common.logging :as l] + [exporter.wasm.pool :as pool])) + +(defn- serializer + "Chains thunks so a job's renders run one at a time on its worker. A + failure is isolated: it doesn't break the chain for the next one." + [] + (let [queue (atom (js/Promise.resolve nil))] + (fn [thunk] + (let [result (.then @queue (fn [_] (thunk)) (fn [_] (thunk)))] + (reset! queue (.then result (fn [_] nil) (fn [_] nil))) + result)))) + +(defn ^:async with-scope + "Runs `f`, a fn of a 2-arg render fn. Every render goes to the same + worker, one at a time, so the cancel check runs as each render's turn + comes up. Without a `job-id` nothing is wired for cancel." + [wpool cancel-source job-id f] + (let [{:keys [cancel-signal cancelled? on-cancel]} cancel-source] + (await + (pool/with-worker (:pool wpool) + (fn [worker] + ((^:async fn [] + (let [chain (serializer) + live (volatile! worker) + signal (when job-id (cancel-signal job-id)) + opts {:cancel-buffer (some-> signal (.-buffer)) + :cancelled? (when job-id (fn [] (cancelled? job-id))) + :timeout-ms (:timeout-ms wpool)}] + (when job-id + ;; Between objects the worker sees the flag; inside a + ;; render only terminating the thread stops it. Cleared + ;; on the way out so a later cancel cannot terminate a + ;; worker that is by then somebody else's. + (on-cancel job-id (fn [] (pool/terminate @live)))) + (try + (await (f (fn [params on-object] + (chain (fn [] (pool/render-on worker params on-object opts)))))) + (finally + (vreset! live nil))))))))))) + +(defn ^:async render + [wpool cancel-source params on-object] + (let [job-id (:job-id params)] + (l/info :hint "render" :type (:type params) :backend "wasm") + (await (with-scope wpool cancel-source job-id + (fn [render*] (render* params on-object)))))) diff --git a/exporter/src/exporter/wasm/pool.cljs b/exporter/src/exporter/wasm/pool.cljs new file mode 100644 index 0000000000..66653fed01 --- /dev/null +++ b/exporter/src/exporter/wasm/pool.cljs @@ -0,0 +1,256 @@ +;; 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.wasm.pool + "Pool of headless render workers. + + Mirrors `exporter.browser`: a `generic-pool` whose objects are + `worker_threads` instead of browsers, so acquisition and eviction + behave the same way for both render backends. A worker is expensive + to build (it boots its own render-wasm module), hence the pooling. + + Acquisition is not capped: the admission scheduler is the + backpressure, and the idle watchdog guarantees a wedged worker gives + its slot back. + + Workers run the same bundle as the main thread. There is always at + least one worker, since a headless render has nowhere else to go. + + Unlike the browser service, the running instance is a map: the pool + plus the silence timeout the renders await on it. There are no + promesa chains in this namespace: the pool speaks native promises, + and `await` covers the rest." + (:require + ["generic-pool" :as gp] + ["node:path" :as path] + ["node:process" :as proc] + ["node:worker_threads" :as wt] + [app.common.data :as d] + [app.common.exceptions :as ex] + [app.common.logging :as l] + [app.common.transit :as t] + [exporter.utils.system :as system])) + +(l/set-level! :info) + +(def defaults + "Static pool defaults. The sizing (`:max`) mirrors the worker + concurrency default; the wiring layer passes the env-derived values." + {:max 2 + :min 1 + :timeout-ms 300000 + :ready-timeout-ms 60000 + :eviction-interval 30000 + :eviction-batch 2 + :idle-timeout 300000}) + +(defn await-ready + "Resolves the worker once it posts its ready handshake. A worker + that stays silent too long is terminated and rejected with + `:worker-not-ready`; a boot error rejects with its own cause." + [worker timeout-ms] + (js/Promise. + (fn [resolve reject] + (let [timer (js/setTimeout + (fn [] + (l/error :hint "render worker did not become ready") + (.terminate ^js worker) + (reject (ex/error :type :internal + :code :worker-not-ready + :hint "render worker did not become ready"))) + timeout-ms)] + (.on ^js worker "error" + (fn [cause] + (l/error :hint "render worker error" :cause cause) + (unchecked-set worker "__alive" false) + ;; Rejecting after `resolve` is a no-op, so this is safe + ;; for the errors that arrive once the worker is pooled. + (js/clearTimeout timer) + (reject cause))) + (.on ^js worker "exit" + (fn [code] + (l/info :hint "render worker exited" :code code) + (unchecked-set worker "__alive" false))) + ;; Not `.once`: a stray message before the handshake would + ;; consume the listener and hang the worker until the timeout. + (letfn [(on-ready [data] + (when (= "ready" (unchecked-get data "type")) + (js/clearTimeout timer) + (.off ^js worker "message" on-ready) + (resolve worker)))] + (.on ^js worker "message" on-ready)))))) + +(defn- default-script + [] + (path/resolve (aget (.-argv proc/default) 1))) + +(defn- default-create-worker + [script ready-timeout-ms] + (fn [] + (await-ready (new wt/Worker script) ready-timeout-ms))) + +(defn- ^:async create-instance + [create-worker id-counter] + (let [worker (await (create-worker)) + id (swap! id-counter inc)] + (l/info :origin "factory" :action "create" :worker-id id) + (unchecked-set worker "__id" id) + (unchecked-set worker "__alive" true) + worker)) + +(defn- destroy-instance + [worker] + (l/info :origin "factory" :action "destroy" + :worker-id (unchecked-get worker "__id")) + (unchecked-set worker "__alive" false) + (.terminate ^js worker)) + +(defn- validate-instance + [worker] + (true? (unchecked-get worker "__alive"))) + +(defn- make-factory + [create-worker] + (let [id-counter (atom 0)] + #js {:create (fn [] (create-instance create-worker id-counter)) + :destroy destroy-instance + :validate validate-instance})) + +(defmethod system/init-key ::pool + [_ cfg] + (let [opts (merge defaults (d/without-nils cfg)) + max-workers (:max opts) + script (or (:script opts) (default-script)) + create-worker (or (:create-worker opts) + (default-create-worker script (:ready-timeout-ms opts)))] + (l/info :hint "initializing render worker pool" :max max-workers) + {:pool (gp/createPool (make-factory create-worker) + #js {:max max-workers + :min (min max-workers (:min opts)) + :testOnBorrow true + :evictionRunIntervalMillis (:eviction-interval opts) + :numTestsPerEvictionRun (:eviction-batch opts) + :idleTimeoutMillis (:idle-timeout opts)}) + :timeout-ms (:timeout-ms opts)})) + +(defn- ^:async drain-pool + [pool] + (await (.drain ^js pool)) + (await (.clear ^js pool)) + nil) + +(defmethod system/halt-key ::pool + [_ instance] + (when-let [pool (:pool instance)] + (l/info :hint "finalizing render worker pool") + (drain-pool pool))) + +(defn ^:async with-worker + "Acquires one worker for the whole of `f`, a fn of that worker. On + failure the worker is destroyed instead of reused: the module may be + aborted or mid-write, and a terminated worker cannot come back." + [pool f] + (let [worker (await (.acquire ^js pool))] + (try + (let [result (await (f worker))] + (await (.release ^js pool worker)) + result) + (catch :default cause + (try + (await (.destroy ^js pool worker)) + (catch :default cause' + (l/warn :hint "render worker destroy failed" + :cause cause'))) + (throw cause))))) + +(defn- render-on-worker + "Settles when the worker reports the render finished, failed, or the + thread went away. That last case matters: a terminated worker (how a + cancel stops a render mid-Skia) emits `exit` and never `error`, and a + promise left pending there would keep its pool slot borrowed for the + life of the process." + [^js worker params cancel-buffer on-object timeout-ms] + (js/Promise. + (fn [resolve reject] + (let [timer (volatile! nil)] + (letfn [(disarm [] + (when-let [t @timer] + (js/clearTimeout t) + (vreset! timer nil))) + + (rearm [] + (disarm) + (vreset! timer (js/setTimeout + (fn [] + (l/error :hint "render worker went silent, terminating" + :worker-id (unchecked-get worker "__id")) + (cleanup) + ;; Terminating is what frees the pool slot: + ;; the `exit` it raises has no listener left. + (unchecked-set worker "__alive" false) + (.terminate ^js worker) + (reject (ex/error :type :internal + :code :render-timeout + :hint "render worker stopped responding"))) + timeout-ms))) + + (cleanup [] + (disarm) + (.off worker "message" on-message) + (.off worker "error" on-error) + (.off worker "exit" on-exit)) + + (on-error [cause] + (cleanup) + (reject cause)) + + (on-exit [code] + (cleanup) + (reject (ex/error :type :internal + :code :worker-exited + :hint (str "render worker exited with code " code)))) + + (on-message [data] + (rearm) + (case (unchecked-get data "type") + ;; A failure while the main thread handles the object + ;; (moving the file, appending to the zip) has to end + ;; the render too, or nothing ever settles this promise. + "object" (try + (on-object (t/decode-str (unchecked-get data "payload"))) + (catch :default cause + (cleanup) + (reject cause))) + "done" (do (cleanup) (resolve nil)) + "error" (do (cleanup) + (reject (ex/error :type :internal + :code (or (some-> (unchecked-get data "code") keyword) + :wasm-render-error) + :hint (unchecked-get data "message")))) + nil))] + + (.on worker "message" on-message) + (.once worker "error" on-error) + (.once worker "exit" on-exit) + (rearm) + (.postMessage worker #js {:type "render" + :params (t/encode-str params) + :cancel cancel-buffer})))))) + +(defn ^:async render-on + "Renders `params` on an already acquired worker." + [worker params on-object {:keys [cancel-buffer cancelled? timeout-ms]}] + (if (and cancelled? (cancelled?)) + (throw (ex/error :type :internal + :code :job-cancelled + :hint "export job was cancelled")) + (await (render-on-worker worker params cancel-buffer on-object timeout-ms)))) + +(defn terminate + [worker] + (when worker + (unchecked-set worker "__alive" false) + (.terminate worker))) diff --git a/exporter/test/exporter_tests/renderer_browser_test.cljs b/exporter/test/exporter_tests/renderer_browser_test.cljs new file mode 100644 index 0000000000..4f4fd0d0bf --- /dev/null +++ b/exporter/test/exporter_tests/renderer_browser_test.cljs @@ -0,0 +1,154 @@ +;; 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.renderer-browser-test + "The browser renderer: bitmap, pdf and svg flows through a real + pool with fake pages. No text nodes in the svg fixture means no + shell-outs; the exported file itself proves the reassembly." + (:require + ["generic-pool" :as gp] + [app.common.uuid :as uuid] + [app.config :as cf] + [app.util.shell :as sh] + [cljs.test :as t :include-macros true] + [clojure.string :as str] + [exporter.renderer.browser :as render] + [exporter.renderer.svg-gradient :as grad])) + +(defn- stub-locator + [calls evaluate-fn] + #js {:waitFor (fn [_opts] (swap! calls conj :locator-wait) (js/Promise.resolve nil)) + :screenshot (fn [opts] + (swap! calls conj [:screenshot (unchecked-get opts "path")]) + (js/Promise.resolve nil)) + :evaluate (fn [f & _args] (js/Promise.resolve (evaluate-fn f)))}) + +(defn- stub-page + [calls locator] + #js {:goto (fn [url _opts] + (swap! calls conj [:goto (str url)]) + (js/Promise.resolve nil)) + :waitForTimeout (fn [ms] (swap! calls conj [:sleep ms]) (js/Promise.resolve nil)) + :waitForFunction (fn [_src _arg _opts] + (swap! calls conj :wait-for-fonts) + (js/Promise.resolve nil)) + :locator (fn [sel] (swap! calls conj [:select sel]) locator) + :$$ (fn [sel] + (swap! calls conj [:select-all sel]) + (js/Promise.resolve #js [])) + :evaluate (fn [_f & _args] (swap! calls conj :page-eval) (js/Promise.resolve nil)) + :pdf (fn [opts] + (swap! calls conj [:pdf (unchecked-get opts "path")]) + (js/Promise.resolve nil))}) + +(defn- stub-context + [calls page] + #js {:newPage (fn [] (js/Promise.resolve page)) + :close (fn [] (swap! calls conj :close-context) (js/Promise.resolve nil))}) + +(defn- stub-browser + [calls page] + #js {:newContext (fn [_opts] (js/Promise.resolve (stub-context calls page))) + :isConnected (fn [] true) + :close (fn [] (js/Promise.resolve nil))}) + +(defn- test-pool + [calls page] + (gp/createPool #js {:create (fn [] (js/Promise.resolve (stub-browser calls page))) + :destroy (fn [browser] (.close ^js browser)) + :validate (fn [_] true)} + #js {:max 1 :min 0})) + +(defn- test-ctx + [pool] + {:browser-pool pool + :base-uri (cf/get-internal-uri) + :public-uri (cf/get :public-uri) + :svgo? false}) + +(defn- test-object + [id] + {:id id :name id}) + +(defn- test-params + [type ids] + {:file-id (uuid/next) + :page-id (uuid/next) + :token "token" + :scale 1 + :type type + :objects (mapv test-object ids)}) + +(defn- collect-on-object + [] + (let [seen (atom [])] + {:seen seen + :fn (fn [object] (swap! seen conj object) nil)})) + +(t/deftest ^:async renders-bitmaps-through-one-page + (try + (let [calls (atom []) + page (stub-page calls (stub-locator calls (fn [_] nil))) + pool (test-pool calls page) + {:keys [seen fn]} (collect-on-object)] + (await (render/render (test-ctx pool) (test-params :png ["a" "b"]) fn)) + (t/is (= 2 (count @seen))) + (t/is (every? #(str/ends-with? (:path %) ".png") @seen)) + (t/is (= ["a" "b"] (mapv :id @seen))) + (t/testing "one navigation for the whole partition" + (t/is (= 1 (count (filter #(and (vector? %) (= :goto (first %))) @calls)))) + (t/is (str/includes? (second (first (filter #(and (vector? %) (= :goto (first %))) @calls))) + "render.html"))) + (t/is (some #{[:select "#screenshot-a"]} @calls)) + (t/is (some #{[:select "#screenshot-b"]} @calls))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async renders-pdf-navigating-per-object + (try + (let [calls (atom []) + page (stub-page calls (stub-locator calls (fn [_] nil))) + pool (test-pool calls page) + {:keys [seen fn]} (collect-on-object)] + (await (render/render (test-ctx pool) (test-params :pdf ["a" "b"]) fn)) + (t/is (= 2 (count @seen))) + (t/is (every? #(str/ends-with? (:path %) ".pdf") @seen)) + (t/testing "one navigation per object" + (t/is (= 2 (count (filter #(and (vector? %) (= :goto (first %))) @calls))))) + (t/is (= 2 (count (filter #(and (vector? %) (= :pdf (first %))) @calls))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async renders-svg-reassembling-the-document + (try + (let [calls (atom []) + outer " " + locator (stub-locator calls (fn [f] (f #js {:outerHTML outer}))) + page (stub-page calls locator) + pool (test-pool calls page) + {:keys [seen fn]} (collect-on-object) + _ (await (render/render (test-ctx pool) (test-params :svg ["a"]) fn)) + path (:path (first @seen)) + content (await (sh/read-file path))] + (t/is (= 1 (count @seen))) + (t/is (str/ends-with? path ".svg")) + (t/is (str/includes? content "")) + (t/is (not (str/includes? content " ")))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest nbsp-entity-becomes-its-svg-compatible-form + (t/is (= "a b" (render/sanitize-svg-content "a b"))) + (t/is (= "plain" (render/sanitize-svg-content "plain")))) + +(t/deftest gradient-def-names-shapes + (let [stops [{"color" "#000000" "offset" 0 "opacity" 1}] + linear (grad/data->gradient-def "tid" ["#ff0000" {"gradient" {"type" "linear" "stops" stops}}]) + radial (grad/data->gradient-def "tid" ["#00ff00" {"gradient" {"type" "radial" "stops" stops}}])] + (t/is (= "linearGradient" (get linear "name"))) + (t/is (= "radialGradient" (get radial "name"))) + (t/is (= "gradient-tid-ff0000" (get-in linear ["attributes" "id"]))) + (t/is (= 1 (count (get linear "elements")))))) diff --git a/exporter/test/exporter_tests/renderer_wasm_test.cljs b/exporter/test/exporter_tests/renderer_wasm_test.cljs new file mode 100644 index 0000000000..4831f1f59a --- /dev/null +++ b/exporter/test/exporter_tests/renderer_wasm_test.cljs @@ -0,0 +1,181 @@ +;; 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.renderer-wasm-test + "The wasm renderer driver: leased workers, sequential renders, + failure isolation and cancel wiring, against a stub pool, stub + workers and an injected cancel source." + (:require + ["node:events" :as events] + [app.common.transit :as transit] + [cljs.test :as t :include-macros true] + [exporter.renderer.wasm :as render])) + +(defn- stub-worker + [calls behavior] + (let [^js emitter (events/EventEmitter.)] + (unchecked-set emitter "postMessage" + (fn [msg] + (swap! calls conj [:post (unchecked-get msg "type")]) + (behavior emitter msg))) + (unchecked-set emitter "terminate" + (fn [] + (swap! calls conj :terminate) + (.emit emitter "exit" 1) + (js/Promise.resolve nil))) + emitter)) + +(defn- render-behavior + [payload] + (fn [^js emitter _msg] + (js/setTimeout + (fn [] + (.emit emitter "message" #js {:type "object" :payload (transit/encode-str payload)}) + (.emit emitter "message" #js {:type "done"})) + 0))) + +(defn- stub-pool + [calls worker] + #js {:acquire (fn [] (js/Promise.resolve worker)) + :release (fn [_] (swap! calls conj :release) (js/Promise.resolve nil)) + :destroy (fn [_] (swap! calls conj :destroy) (js/Promise.resolve nil))}) + +(defn- stub-cancel-source + [calls cancelled?] + {:cancel-signal (fn [job-id] (swap! calls conj [:cancel-signal job-id]) nil) + :cancelled? (fn [job-id] (swap! calls conj [:cancelled?-asked job-id]) @cancelled?) + :on-cancel (fn [job-id f] (swap! calls conj [:on-cancel job-id f]) nil)}) + +(defn- test-instance + [calls worker] + {:pool (stub-pool calls worker) + :timeout-ms 5000}) + +(defn- test-params + [job-id] + {:job-id job-id + :type :png + :objects [{:id "o1"}]}) + +(defn- posted? + [calls] + (some #(and (vector? %) (= :post (first %))) calls)) + +(t/deftest ^:async with-scope-runs-renders-on-the-leased-worker + (try + (let [calls (atom []) + worker (stub-worker calls (render-behavior {:id "o1" :path "/tmp/o1.png"})) + seen (atom [])] + (await (render/with-scope (test-instance calls worker) + (stub-cancel-source calls (atom false)) + :job-1 + (^:async fn [render*] + (await (render* (test-params :job-1) + (fn [object] (swap! seen conj object) nil))) + (await (render* (test-params :job-1) + (fn [object] (swap! seen conj object) nil)))))) + (t/is (= [{:id "o1" :path "/tmp/o1.png"} + {:id "o1" :path "/tmp/o1.png"}] + @seen)) + (t/is (= 1 (count (filter #{:release} @calls)))) + (t/testing "the job was wired for cancel exactly once" + (t/is (= [[:cancel-signal :job-1] + [:cancelled?-asked :job-1] + [:cancelled?-asked :job-1]] + (filter #(and (vector? %) (not (contains? #{:post :on-cancel} (first %)))) + @calls))) + (let [registrations (filter #(and (vector? %) (= :on-cancel (first %))) @calls)] + (t/is (= 1 (count registrations))) + (t/is (= :job-1 (second (first registrations))))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async cancelled-render-rejects-before-posting + (try + (let [calls (atom []) + worker (stub-worker calls (render-behavior {:id "o1"})) + cancelled (atom true)] + (try + (await (render/with-scope (test-instance calls worker) + (stub-cancel-source calls cancelled) + :job-1 + (fn [render*] + (render* (test-params :job-1) (fn [_] nil))))) + (t/is false "with-scope should have rejected a cancelled render") + (catch :default cause + (t/is (= :job-cancelled (-> cause ex-data :code))) + (t/is (not (posted? @calls)))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async cancel-terminates-the-leased-worker + (try + (let [calls (atom []) + worker (stub-worker calls (fn [_ _])) + handlers (atom [])] + (try + (await (render/with-scope (test-instance calls worker) + {:cancel-signal (fn [_] nil) + :cancelled? (fn [_] false) + :on-cancel (fn [_ f] (swap! handlers conj f) nil)} + :job-1 + (fn [render*] + (let [pending (render* (test-params :job-1) (fn [_] nil))] + ;; the cancel lands mid-render, once + ;; the worker is listening + (js/setTimeout (fn [] ((first @handlers))) 10) + pending)))) + (t/is false "with-scope should have rejected a terminated render") + (catch :default cause + (t/is (= :worker-exited (-> cause ex-data :code))) + (t/is (some #{:terminate} @calls))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async render-takes-the-job-id-from-params + (try + (let [calls (atom []) + worker (stub-worker calls (render-behavior {:id "o1"}))] + (await (render/render (test-instance calls worker) + (stub-cancel-source calls (atom false)) + (test-params :job-9) + (fn [_] nil))) + (t/is (some #{[:cancel-signal :job-9]} @calls))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async render-without-job-id-wires-no-cancel + (try + (let [calls (atom []) + worker (stub-worker calls (render-behavior {:id "o1"}))] + (await (render/render (test-instance calls worker) + (stub-cancel-source calls (atom false)) + (dissoc (test-params :job-9) :job-id) + (fn [_] nil))) + (t/is (not-any? #(and (vector? %) (not= :post (first %))) @calls))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async failed-render-does-not-break-the-chain + (try + (let [calls (atom []) + worker (stub-worker calls (render-behavior {:id "o1"})) + seen (atom [])] + (await (render/with-scope (test-instance calls worker) + (stub-cancel-source calls (atom false)) + :job-1 + (^:async fn [render*] + (try + (await (render* (test-params :job-1) + (fn [_] (throw (ex-info "on-object broke" {}))))) + (catch :default _cause + (swap! calls conj :first-failed))) + (await (render* (test-params :job-1) + (fn [object] (swap! seen conj object) nil)))))) + (t/is (some #{:first-failed} @calls)) + (t/is (= [{:id "o1"}] @seen))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) diff --git a/exporter/test/exporter_tests/runner.cljs b/exporter/test/exporter_tests/runner.cljs index c0781a2288..203967052d 100644 --- a/exporter/test/exporter_tests/runner.cljs +++ b/exporter/test/exporter_tests/runner.cljs @@ -16,9 +16,12 @@ [exporter-tests.consumer-plan-test] [exporter-tests.jobs-test] [exporter-tests.main-test] + [exporter-tests.renderer-browser-test] [exporter-tests.renderer-svg-test] + [exporter-tests.renderer-wasm-test] [exporter-tests.shell-test] [exporter-tests.system-test] + [exporter-tests.wasm-pool-service-test] [exporter-tests.wasm-pool-test] [exporter-tests.worker-test] [goog.object :as gobj])) @@ -40,9 +43,12 @@ 'exporter-tests.api-test 'exporter-tests.worker-test 'exporter-tests.consumer-config-test + 'exporter-tests.renderer-browser-test 'exporter-tests.renderer-svg-test + 'exporter-tests.renderer-wasm-test 'exporter-tests.shell-test 'exporter-tests.system-test + 'exporter-tests.wasm-pool-service-test 'exporter-tests.wasm-pool-test]) (assert (every? find-ns-obj test-namespaces) diff --git a/exporter/test/exporter_tests/wasm_pool_service_test.cljs b/exporter/test/exporter_tests/wasm_pool_service_test.cljs new file mode 100644 index 0000000000..6b28add398 --- /dev/null +++ b/exporter/test/exporter_tests/wasm_pool_service_test.cljs @@ -0,0 +1,184 @@ +;; 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.wasm-pool-service-test + "The wasm worker pool service: lifecycle through the system, the + lend protocol, the render protocol, and the creation handshake, + against fake workers." + (:require + ["node:events" :as events] + [app.common.transit :as transit] + [cljs.test :as t :include-macros true] + [exporter.utils.system :as system] + [exporter.wasm.pool :as pool])) + +(defn- fake-worker + [calls behavior] + (let [emitter (events/EventEmitter.)] + (unchecked-set emitter "postMessage" + (fn [msg] + (swap! calls conj [:post (unchecked-get msg "type")]) + (behavior emitter msg))) + (unchecked-set emitter "terminate" + (fn [] + (swap! calls conj :terminate) + (js/Promise.resolve nil))) + emitter)) + +(defn- fake-create-worker + [calls behavior] + (fn [] + (swap! calls conj :create) + (js/Promise.resolve (fake-worker calls behavior)))) + +(defn- render-behavior + [payload] + (fn [^js emitter _msg] + (js/setTimeout + (fn [] + (.emit emitter "message" #js {:type "object" :payload (transit/encode-str payload)}) + (.emit emitter "message" #js {:type "done"})) + 0))) + +(defn- silent-behavior + [_emitter _msg]) + +(defn- test-config + [calls behavior timeout-ms] + {:exporter.wasm.pool/pool {:max 1 + :min 0 + :timeout-ms timeout-ms + :create-worker (fake-create-worker calls behavior)}}) + +(defn- pool-of + [sys] + (:pool (:exporter.wasm.pool/pool sys))) + +(t/deftest ^:async pool-starts-and-stops-through-the-system + (try + (let [calls (atom []) + sys (await (system/init (test-config calls silent-behavior 5000)))] + (t/is (some? (:exporter.wasm.pool/pool sys))) + (t/is (= 5000 (:timeout-ms (:exporter.wasm.pool/pool sys)))) + (t/is (nil? (await (system/halt sys))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async with-worker-lends-and-reclaims + (try + (let [calls (atom []) + sys (await (system/init (test-config calls silent-behavior 5000))) + pool (pool-of sys) + seen (atom nil) + result (await (pool/with-worker pool (fn [worker] (reset! seen worker) :used)))] + (t/is (= :used result)) + (t/is (some? (unchecked-get @seen "__id"))) + (t/testing "a second use reuses the returned worker: nothing is created again" + (await (pool/with-worker pool (fn [_] :again))) + (t/is (= 1 (count (filter #{:create} @calls))))) + (await (system/halt sys))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async render-on-delivers-objects-and-done + (try + (let [calls (atom []) + sys (await (system/init (test-config calls + (render-behavior {:id "o1" :path "/tmp/o1.png"}) + 5000))) + seen (atom [])] + (t/is (nil? (await (pool/with-worker (pool-of sys) + (fn [worker] + (pool/render-on worker + {} + (fn [object] (swap! seen conj object)) + {:timeout-ms 5000})))))) + (t/is (= [{:id "o1" :path "/tmp/o1.png"}] @seen)) + (await (system/halt sys))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async render-on-rejects-cancelled-upfront + (try + (let [calls (atom []) + sys (await (system/init (test-config calls silent-behavior 5000)))] + (try + (await (pool/with-worker (pool-of sys) + (fn [worker] + (pool/render-on worker + {} + (fn [_]) + {:cancelled? (constantly true) + :timeout-ms 5000})))) + (t/is false "render-on should have rejected a cancelled render") + (catch :default cause + (t/is (= :job-cancelled (-> cause ex-data :code))) + (t/is (not-any? #(and (vector? %) (= :post (first %))) @calls)))) + (await (system/halt sys))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async silent-worker-times-out-and-is-terminated + (try + (let [calls (atom []) + sys (await (system/init (test-config calls silent-behavior 50)))] + (try + (await (pool/with-worker (pool-of sys) + (fn [worker] + (pool/render-on worker {} (fn [_]) {:timeout-ms 50})))) + (t/is false "render-on should have rejected a silent worker") + (catch :default cause + (t/is (= :render-timeout (-> cause ex-data :code))) + (t/is (some #{:terminate} @calls)))) + (await (system/halt sys))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async creation-handshake-resolves-on-ready + (try + (let [worker ^js (events/EventEmitter.) + ready (pool/await-ready worker 500)] + (js/setTimeout #(.emit worker "message" #js {:type "ready"}) 5) + (t/is (identical? worker (await ready)))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async silent-handshake-rejects-and-terminates + (try + (let [calls (atom []) + worker (fake-worker calls silent-behavior)] + (try + (await (pool/await-ready worker 20)) + (t/is false "await-ready should have rejected a silent worker") + (catch :default cause + (t/is (= :worker-not-ready (-> cause ex-data :code))) + (t/is (some #{:terminate} @calls))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async errored-handshake-rejects-with-the-cause + (try + (let [worker ^js (events/EventEmitter.) + ready (pool/await-ready worker 500)] + (js/setTimeout #(.emit worker "error" (ex-info "boot broke" {})) 5) + (try + (await ready) + (t/is false "await-ready should have rejected a broken worker") + (catch :default cause + (t/is (= "boot broke" (ex-message cause)))))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause)))))) + +(t/deftest ^:async terminate-marks-and-kills + (try + (let [calls (atom []) + worker (fake-worker calls silent-behavior)] + (t/is (nil? (pool/terminate nil))) + (pool/terminate worker) + (t/is (false? (unchecked-get worker "__alive"))) + (t/is (some #{:terminate} @calls))) + (catch :default cause + (t/is false (str "unexpected failure: " (ex-message cause))))))