✨ Integrate svgclean and graal-js to svgparse service.

backend/deps.edn

@@ -17,6 +17,8 @@
   org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.0"}
   org.slf4j/slf4j-api {:mvn/version "1.7.30"}
 
+  org.graalvm.js/js {:mvn/version "20.3.0"}
+
   io.prometheus/simpleclient {:mvn/version "0.9.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.9.0"}
   io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
@@ -54,6 +56,7 @@
   org.im4java/im4java {:mvn/version "1.4.0"}
   org.lz4/lz4-java {:mvn/version "1.7.1"}
   commons-io/commons-io {:mvn/version "2.8.0"}
+  org.apache.commons/commons-pool2 {:mvn/version "2.9.0"}
   com.sun.mail/jakarta.mail {:mvn/version "2.0.0"}
 
   puppetlabs/clj-ldap {:mvn/version"0.3.0"}

backend/scripts/repl

@@ -2,4 +2,4 @@
 set -ex
 
 # clojure -Ojmx-remote -A:dev -e "(set! *warn-on-reflection* true)" -m rebel-readline.main
-clojure -A:jmx-remote:dev -J-Xms256m -J-Xmx256m -M -m rebel-readline.main
+clojure -A:jmx-remote:dev -J-Xms512m -J-Xmx512m -M -m rebel-readline.main

backend/src/app/main.clj

@@ -84,9 +84,14 @@
      :svgparse    (ig/ref :app.svgparse/handler)
      :storage     (ig/ref :app.storage/storage)}
 
+
+    :app.svgparse/svgc
+    {:metrics (ig/ref :app.metrics/metrics)}
+
     ;; HTTP Handler for SVG parsing
     :app.svgparse/handler
-    {:metrics (ig/ref :app.metrics/metrics)}
+    {:metrics (ig/ref :app.metrics/metrics)
+     :svgc    (ig/ref :app.svgparse/svgc)}
 
     :app.rpc/rpc
     {:pool    (ig/ref :app.db/pool)

backend/src/app/svgparse.clj

@@ -17,67 +17,127 @@
    [clojure.java.shell :as shell]
    [clojure.spec.alpha :as s]
    [clojure.xml :as xml]
+   [app.util.graal :as graal]
+   [app.util.pool :as pool]
    [integrant.core :as ig])
   (:import
    java.io.InputStream
+   java.util.function.Consumer
    org.apache.commons.io.IOUtils))
 
-(defn- string->input-stream
-  [^String data]
-  (IOUtils/toInputStream data "UTF-8"))
+;; (defn- clean-svg
+;;   [^InputStream input]
+;;   (let [result (shell/sh
+;;                 ;; "svgcleaner" "--allow-bigger-file" "-c" "-"
+;;                 "svgo"
+;;                 "--enable=prefixIds,removeDimensions,removeXMLNS,removeScriptElement"
+;;                 "--disable=removeViewBox,moveElemsAttrsToGroup"
+;;                 "-i" "-" "-o" "-"
 
-(defn- stream->string
-  [input]
-  (with-open [istream (io/input-stream input)]
-    (-> (IOUtils/toString input "UTF-8"))))
+;;                 :in input :out-enc :bytes)
+;;         err-str (:err result)]
+;;     (when (or (not= 0 (:exit result))
+;;               ;; svgcleaner returns 0 with some errors, we need to check
+;;               (and (not= err-str "") (not (nil? err-str)) (str/starts-with? err-str "Error")))
+;;       (ex/raise :type :validation
+;;                 :code :unable-to-optimize
+;;                 :hint (:err result)))
+;;     (io/input-stream (:out result))))
 
-(defn- clean-svg
-  [^InputStream input]
-  (let [result (shell/sh
-                ;; "svgcleaner" "--allow-bigger-file" "-c" "-"
-                "svgo"
-                "--enable=prefixIds,removeDimensions,removeXMLNS,removeScriptElement"
-                "--disable=removeViewBox,moveElemsAttrsToGroup"
-                "-i" "-" "-o" "-"
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SVG Clean
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-                :in input :out-enc :bytes)
-        err-str (:err result)]
-    (when (or (not= 0 (:exit result))
-              ;; svgcleaner returns 0 with some errors, we need to check
-              (and (not= err-str "") (not (nil? err-str)) (str/starts-with? err-str "Error")))
-      (ex/raise :type :validation
-                :code :unable-to-optimize
-                :hint (:err result)))
-    (io/input-stream (:out result))))
+(declare do-svg-clean)
+(declare prepare-context-pool)
 
-(defn parse
-  [^InputStream input]
-  (with-open [istream (io/input-stream input)]
-    (-> (clean-svg istream)
-        (xml/parse))))
+(defmethod ig/pre-init-spec ::svgc [_]
+  (s/keys :req-un [::mtx/metrics]))
+
+(defmethod ig/init-key ::svgc
+  [_ {:keys [metrics] :as cfg}]
+  (let [ctx-pool (prepare-context-pool)]
+    (with-meta
+      (fn [data]
+        (with-open [ctx (pool/acquire ctx-pool)]
+          (do-svg-clean @ctx data)))
+      {::ctx-pool ctx-pool})))
+
+(defmethod ig/halt-key! ::svgc
+  [_ f]
+  (let [{:keys [::ctx-pool]} (meta f)]
+    (pool/clear! ctx-pool)
+    (pool/close! ctx-pool)))
+
+(defn- prepare-context-pool
+  []
+  (pool/create
+   {:min-idle 0
+    :max-idle 3
+    :max-total 3
+    :create
+    (fn []
+      (let [ctx (graal/context "js")]
+        (->> (graal/source "js" (io/resource "svgclean.js"))
+             (graal/eval! ctx))
+        ctx))
+    :destroy
+    (fn [ctx]
+      (graal/close! ctx))}))
+
+(defn- do-svg-clean
+  [ctx data]
+  (let [res     (promise)
+        cleaner (->> (graal/source "js" "require('svgclean')")
+                     (graal/eval! ctx))
+        resultp (graal/invoke-member cleaner "optimize" data)]
+    (graal/invoke-member resultp "then"
+                         (reify Consumer
+                           (accept [_ val]
+                             (deliver res val))))
+    (graal/invoke-member resultp "catch"
+                         (reify Consumer
+                           (accept [_ err]
+                             (deliver res err))))
+
+    (let [result (deref res)]
+      (if (instance? Throwable result)
+        (throw result)
+        result))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Handler
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare handler)
+(declare process-request)
+
+(s/def ::svgc fn?)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::mtx/metrics]))
+  (s/keys :req-un [::mtx/metrics ::svgc]))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [metrics] :as cfg}]
-  (->> {:registry (:registry metrics)
-        :type :summary
-        :name "http_handler_svgparse_timing"
-        :help "svg parse timings"}
-       (mtx/instrument handler)))
+  (let [handler #(handler cfg %)]
+    (->> {:registry (:registry metrics)
+          :type :summary
+          :name "http_handler_svgparse_timing"
+          :help "svg parse timings"}
+         (mtx/instrument handler))))
 
 (defn- handler
-  [{:keys [headers body] :as request}]
+  [cfg {:keys [headers body] :as request}]
   (when (not= "image/svg+xml" (get headers "content-type"))
     (ex/raise :type :validation
               :code :unsupported-mime-type
               :mime (get headers "content-type")))
   {:status 200
-   :body (parse body)})
+   :body (process-request cfg body)})
+
+(defn process-request
+  [{:keys [svgc] :as cfg} body]
+  (let [data (slurp body)
+        data (svgc data)]
+    (with-open [istream (IOUtils/toInputStream data "UTF-8")]
+      (xml/parse istream))))

backend/src/app/util/graal.clj

@@ -0,0 +1,61 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2021 UXBOX Labs SL
+
+(ns app.util.graal
+  "Graal Polyglot integration layer."
+  (:import
+   java.util.function.Consumer
+   org.graalvm.polyglot.Context
+   org.graalvm.polyglot.Source
+   org.graalvm.polyglot.Value))
+
+(defn ^Source source
+  [lang content]
+  (if (string? content)
+    (Source/create ^String lang ^String content)
+    (.. (Source/newBuilder lang content)
+        (build))))
+
+(defn ^Context context
+  [lang]
+  (.. (Context/newBuilder (into-array String [lang]))
+      (allowAllAccess true)
+      (allowIO true)
+      (build)))
+
+(defn ^Value eval!
+  [ctx source]
+  (.eval ^Context ctx ^Source source))
+
+(defn ^Value get-bindings
+  [ctx]
+  (.getBindings ^Context ctx))
+
+(defn ^Value get-member
+  [vobj name]
+  (.getMember ^Value vobj ^String name))
+
+(defn ^Value invoke
+  [vobj & params]
+  (.execute ^Value vobj (into-array Object params)))
+
+(defn ^Value invoke-member
+  [vobj name & params]
+  (let [params (into-array Object params)]
+    (.invokeMember ^Value vobj ^String name params)))
+
+(defn ^Value set-member!
+  [vobj name obj]
+  (.putMember ^Value vobj ^String name ^Object obj)
+  vobj)
+
+(defn close!
+  [ctx]
+  (when ctx
+    (.close ^Context ctx)))

backend/src/app/util/pool.clj

@@ -0,0 +1,65 @@
+(ns app.util.pool
+  (:import
+   java.lang.AutoCloseable
+   org.apache.commons.pool2.PooledObject
+   org.apache.commons.pool2.PooledObjectFactory
+   org.apache.commons.pool2.impl.GenericObjectPool
+   org.apache.commons.pool2.impl.DefaultPooledObject
+   org.apache.commons.pool2.impl.BaseGenericObjectPool))
+
+(def noop (constantly true))
+
+(deftype CloseableWrapper [obj pool]
+  clojure.lang.IDeref
+  (deref [_] obj)
+
+  AutoCloseable
+  (close [_]
+    (.returnObject ^GenericObjectPool pool obj)))
+
+(defn create
+  [{:keys [create destroy validate activate passivate max-idle max-total min-idle]
+    :or {destroy noop
+         validate noop
+         activate noop
+         passivate noop
+         max-idle 10
+         max-total 10
+         min-idle 0}}]
+  (let [object-factory
+        (proxy [PooledObjectFactory] []
+          (makeObject [] (DefaultPooledObject. (create)))
+          (destroyObject [^PooledObject o] (destroy (.getObject o)))
+          (validateObject [^PooledObject o] (validate (.getObject o)))
+          (activateObject [^PooledObject o] (activate (.getObject o)))
+          (passivateObject [^PooledObject o] (passivate (.getObject o))))
+
+        config
+        (doto (org.apache.commons.pool2.impl.GenericObjectPoolConfig.)
+          (.setMaxTotal max-total)
+          (.setMaxIdle max-idle)
+          (.setMinIdle min-idle)
+          (.setBlockWhenExhausted true))]
+    (GenericObjectPool. object-factory config)))
+
+(defn borrow
+  [^GenericObjectPool pool]
+  (.borrowObject pool))
+
+(defn return
+  [^GenericObjectPool pool object]
+  (.returnObject pool object))
+
+(defn acquire
+  [pool]
+  (let [obj (borrow pool)]
+    (CloseableWrapper. obj pool)))
+
+(defn clear!
+  "Clear idle objects in pool."
+  [pool]
+  (.clear ^GenericObjectPool pool))
+
+(defn close!
+  [^BaseGenericObjectPool pool]
+  (.close pool))