From 3f554df6876773a7abb56fc1d888f5cbb7a6cf76 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Tue, 9 Jun 2020 12:47:51 +0200
Subject: [PATCH] :recycle: Refactor thumbnail generation.

---
 backend/src/uxbox/config.clj                  |   6 +-
 backend/src/uxbox/images.clj                  | 197 +++++++++++-------
 .../src/uxbox/services/mutations/files.clj    |  47 ++---
 .../src/uxbox/services/mutations/images.clj   |  53 +++--
 .../src/uxbox/services/mutations/profile.clj  |  33 +--
 5 files changed, 194 insertions(+), 142 deletions(-)

diff --git a/backend/src/uxbox/config.clj b/backend/src/uxbox/config.clj
index 3440049c3..83b88f6d8 100644
--- a/backend/src/uxbox/config.clj
+++ b/backend/src/uxbox/config.clj
@@ -34,6 +34,8 @@
    :media-uri "http://localhost:3449/media/"
    :assets-uri "http://localhost:3449/static/"
 
+   :image-process-max-threads 2
+
    :sendmail-backend "console"
    :sendmail-reply-to "no-reply@example.com"
    :sendmail-from "no-reply@example.com"
@@ -71,6 +73,7 @@
 (s/def ::debug-humanize-transit ::us/boolean)
 (s/def ::public-uri ::us/string)
 (s/def ::backend-uri ::us/string)
+(s/def ::image-process-max-threads ::us/integer)
 
 (s/def ::google-client-id ::us/string)
 (s/def ::google-client-secret ::us/string)
@@ -101,7 +104,8 @@
                    ::smtp-ssl
                    ::debug-humanize-transit
                    ::allow-demo-users
-                   ::registration-enabled]))
+                   ::registration-enabled
+                   ::image-process-max-threads]))
 
 (defn env->config
   [env]
diff --git a/backend/src/uxbox/images.clj b/backend/src/uxbox/images.clj
index 5fe299de1..bb590aae9 100644
--- a/backend/src/uxbox/images.clj
+++ b/backend/src/uxbox/images.clj
@@ -10,108 +10,155 @@
 (ns uxbox.images
   "Image postprocessing."
   (:require
+   [clojure.core.async :as a]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [datoteka.core :as fs]
-   [uxbox.common.exceptions :as ex]
+   [mount.core :refer [defstate]]
+   [uxbox.config :as cfg]
    [uxbox.common.data :as d]
+   [uxbox.common.exceptions :as ex]
    [uxbox.common.spec :as us]
-   [uxbox.util.storage :as ust]
-   [uxbox.media :as media])
+   [uxbox.media :as media]
+   [uxbox.util.storage :as ust])
   (:import
    java.io.ByteArrayInputStream
    java.io.InputStream
+   java.util.concurrent.Semaphore
    org.im4java.core.ConvertCmd
    org.im4java.core.Info
    org.im4java.core.IMOperation))
 
-;; --- Helpers
-
-(defn format->extension
-  [format]
-  (case format
-    "jpeg" ".jpg"
-    "webp" ".webp"))
-
-(defn format->mtype
-  [format]
-  (case format
-    "jpeg" "image/jpeg"
-    "webp" "image/webp"))
+(defstate semaphore
+  :start (Semaphore. (:image-process-max-threads cfg/config 1)))
 
 ;; --- Thumbnails Generation
 
+(s/def ::cmd keyword?)
+
+(s/def ::path (s/or :path fs/path?
+                    :string string?
+                    :file fs/file?))
+(s/def ::mtype string?)
+
+(s/def ::input
+  (s/keys :req-un [::path]
+          :opt-un [::mtype]))
+
 (s/def ::width integer?)
 (s/def ::height integer?)
+(s/def ::format #{:jpeg :webp :png})
 (s/def ::quality #(< 0 % 101))
-(s/def ::format #{"jpeg" "webp"})
-(s/def ::thumbnail-opts
-  (s/keys :opt-un [::format ::quality ::width ::height]))
+
+(s/def ::thumbnail-params
+  (s/keys :req-un [::cmd ::input ::format ::width ::height]))
 
 ;; Related info on how thumbnails generation
 ;;  http://www.imagemagick.org/Usage/thumbnails/
 
-(defn generate-thumbnail
-  ([input] (generate-thumbnail input nil))
-  ([input {:keys [quality format width height]
-           :or {format "jpeg"
-                quality 92
-                width 200
-                height 200}
-           :as opts}]
-   (us/assert ::thumbnail-opts opts)
-   (us/assert fs/path? input)
-   (let [ext (format->extension format)
-         tmp (fs/create-tempfile :suffix ext)
-         opr (doto (IMOperation.)
-               (.addImage)
-               (.autoOrient)
-               (.strip)
-               (.thumbnail (int width) (int height) ">")
-               (.quality (double quality))
-               (.addImage))]
-     (doto (ConvertCmd.)
-       (.run opr (into-array (map str [input tmp]))))
-     (let [thumbnail-data (fs/slurp-bytes tmp)]
-       (fs/delete tmp)
-       (ByteArrayInputStream. thumbnail-data)))))
+(defn format->extension
+  [format]
+  (case format
+    :png  ".png"
+    :jpeg ".jpg"
+    :webp ".webp"))
 
-(defn generate-profile-thumbnail
-  ([input] (generate-thumbnail input nil))
-  ([input {:keys [quality format width height]
-           :or {format "jpeg"
-                quality 92
-                width 200
-                height 200}
-           :as opts}]
-   (us/assert ::thumbnail-opts opts)
-   (us/assert fs/path? input)
-   (let [ext (format->extension format)
-         tmp (fs/create-tempfile :suffix ext)
-         opr (doto (IMOperation.)
-               (.addImage)
-               (.autoOrient)
-               (.strip)
-               (.thumbnail (int width) (int height) "^")
-               (.gravity "center")
-               (.extent (int width) (int height))
-               (.quality (double quality))
-               (.addImage))]
-     (doto (ConvertCmd.)
-       (.run opr (into-array (map str [input tmp]))))
-     (let [thumbnail-data (fs/slurp-bytes tmp)]
-       (fs/delete tmp)
-       (ByteArrayInputStream. thumbnail-data)))))
+(defn format->mtype
+  [format]
+  (case format
+    :png  "image/png"
+    :jpeg "image/jpeg"
+    :webp "image/webp"))
 
-(defn info
-  [content-type path]
-  (let [instance (Info. (str path))]
-    (when-not (= content-type (.getProperty instance "Mime type"))
+(defn mtype->format
+  [mtype]
+  (case mtype
+    "image/jpeg" :jpeg
+    "image/webp" :webp
+    "image/png"  :png
+    nil))
+
+(defn- generic-process
+  [{:keys [input format quality operation] :as params}]
+  (let [{:keys [path mtype]} input
+        format (or (mtype->format mtype) format)
+        ext    (format->extension format)
+        tmp (fs/create-tempfile :suffix ext)]
+
+    (doto (ConvertCmd.)
+      (.run operation (into-array (map str [path tmp]))))
+
+    (let [thumbnail-data (fs/slurp-bytes tmp)]
+      (fs/delete tmp)
+      (assoc params
+             :format format
+             :mtype  (format->mtype format)
+             :data   (ByteArrayInputStream. thumbnail-data)))))
+
+(defmulti process :cmd)
+
+(defmethod process :generic-thumbnail
+  [{:keys [quality width height] :as params}]
+  (us/assert ::thumbnail-params params)
+  (let [op (doto (IMOperation.)
+             (.addImage)
+             (.autoOrient)
+             (.strip)
+             (.thumbnail (int width) (int height) ">")
+             (.quality (double quality))
+             (.addImage))]
+    (generic-process (assoc params :operation op))))
+
+(defmethod process :profile-thumbnail
+  [{:keys [quality width height] :as params}]
+  (us/assert ::thumbnail-params params)
+  (let [op (doto (IMOperation.)
+             (.addImage)
+             (.autoOrient)
+             (.strip)
+             (.thumbnail (int width) (int height) "^")
+             (.gravity "center")
+             (.extent (int width) (int height))
+             (.quality (double quality))
+             (.addImage))]
+    (generic-process (assoc params :operation op))))
+
+(defmethod process :info
+  [{:keys [input] :as params}]
+  (us/assert ::input input)
+  (let [{:keys [path mtype]} input
+        instance (Info. (str path))
+        mtype'   (.getProperty instance "Mime type")]
+
+    (when (and (string? mtype)
+               (not= mtype mtype'))
       (ex/raise :type :validation
                 :code :image-type-mismatch
                 :hint "Seems like you are uploading a file whose content does not match the extension."))
-    {:width (.getImageWidth instance)
-     :height (.getImageHeight instance)}))
+    {:width  (.getImageWidth instance)
+     :height (.getImageHeight instance)
+     :mtype  mtype'}))
+
+(defmethod process :default
+  [{:keys [cmd] :as params}]
+  (ex/raise :type :internal
+            :code :not-implemented
+            :hint (str "No impl found for process cmd:" cmd)))
+
+(defn run
+  [params]
+  (try
+    (.acquire semaphore)
+    (let [res (a/<!! (a/thread
+                       (try
+                         (process params)
+                         (catch Throwable e
+                           e))))]
+      (if (instance? Throwable res)
+        (throw res)
+        res))
+    (finally
+      (.release semaphore))))
 
 (defn resolve-urls
   [row src dst]
diff --git a/backend/src/uxbox/services/mutations/files.clj b/backend/src/uxbox/services/mutations/files.clj
index 2b5d6a33c..0f53acec7 100644
--- a/backend/src/uxbox/services/mutations/files.clj
+++ b/backend/src/uxbox/services/mutations/files.clj
@@ -119,12 +119,6 @@
 
     (mark-file-deleted conn params)))
 
-(def ^:private sql:mark-file-deleted
-  "update file
-      set deleted_at = clock_timestamp()
-    where id = ?
-      and deleted_at is null")
-
 (defn mark-file-deleted
   [conn {:keys [id] :as params}]
   (db/update! conn :file
@@ -150,14 +144,6 @@
     (files/check-edition-permissions! conn profile-id file-id)
     (create-file-image conn params)))
 
-(def ^:private sql:insert-file-image
-  "insert into file_image
-     (file_id, name, path, width, height, mtype,
-      thumb_path, thumb_width, thumb_height,
-      thumb_quality, thumb_mtype)
-   values ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11)
-   returning *")
-
 (defn- create-file-image
   [conn {:keys [content file-id name] :as params}]
   (when-not (imgs/valid-image-types? (:content-type content))
@@ -165,22 +151,26 @@
               :code :image-type-not-allowed
               :hint "Seems like you are uploading an invalid image."))
 
-  (let [image-opts (images/info (:content-type content) (:tempfile content))
-        image-path (imgs/persist-image-on-fs content)
-        thumb-opts imgs/thumbnail-options
-        thumb-path (imgs/persist-image-thumbnail-on-fs thumb-opts image-path)]
+  (let [info  (images/run {:cmd :info :input {:path (:tempfile content)
+                                              :mtype (:content-type content)}})
+        path  (imgs/persist-image-on-fs content)
+        opts  (assoc imgs/thumbnail-options
+                    :input {:mtype (:mtype info)
+                            :path path})
+        thumb (imgs/persist-image-thumbnail-on-fs opts)]
+
     (-> (db/insert! conn :file-image
                     {:file-id file-id
                      :name name
-                     :path (str image-path)
-                     :width (:width image-opts)
-                     :height (:height image-opts)
-                     :mtype  (:content-type content)
-                     :thumb-path (str thumb-path)
-                     :thumb-width (:width thumb-opts)
-                     :thumb-height (:height thumb-opts)
-                     :thumb-quality (:quality thumb-opts)
-                     :thumb-mtype (images/format->mtype (:format thumb-opts))})
+                     :path (str path)
+                     :width (:width info)
+                     :height (:height info)
+                     :mtype  (:mtype info)
+                     :thumb-path (str (:path thumb))
+                     :thumb-width (:width thumb)
+                     :thumb-height (:height thumb)
+                     :thumb-quality (:quality thumb)
+                     :thumb-mtype (:mtype thumb)})
         (images/resolve-urls :path :uri)
         (images/resolve-urls :thumb-path :thumb-uri))))
 
@@ -193,9 +183,6 @@
 (s/def ::import-image-to-file
   (s/keys :req-un [::image-id ::file-id ::profile-id]))
 
-(def ^:private sql:select-image-by-id
-  "select img.* from image as img where id=$1")
-
 (sm/defmutation ::import-image-to-file
   [{:keys [image-id file-id profile-id] :as params}]
   (db/with-atomic [conn db/pool]
diff --git a/backend/src/uxbox/services/mutations/images.clj b/backend/src/uxbox/services/mutations/images.clj
index dcd1176d7..c335a0fe7 100644
--- a/backend/src/uxbox/services/mutations/images.clj
+++ b/backend/src/uxbox/services/mutations/images.clj
@@ -28,7 +28,7 @@
   {:width 800
    :height 800
    :quality 85
-   :format "jpeg"})
+   :format :jpeg})
 
 (s/def ::id ::us/uuid)
 (s/def ::name ::us/string)
@@ -146,23 +146,27 @@
               :code :image-type-not-allowed
               :hint "Seems like you are uploading an invalid image."))
 
-  (let [image-opts (images/info (:content-type content) (:tempfile content))
-        image-path (persist-image-on-fs content)
-        thumb-opts thumbnail-options
-        thumb-path (persist-image-thumbnail-on-fs thumb-opts image-path)]
+  (let [info  (images/run {:cmd :info :input {:path (:tempfile content)
+                                              :mtype (:content-type content)}})
+        path  (persist-image-on-fs content)
+        opts  (assoc thumbnail-options
+                    :input {:mtype (:mtype info)
+                            :path path})
+        thumb (persist-image-thumbnail-on-fs opts)]
+
     (-> (db/insert! conn :image
                     {:id (or id (uuid/next))
                      :library-id library-id
                      :name name
-                     :path (str image-path)
-                     :width (:width image-opts)
-                     :height (:height image-opts)
-                     :mtype  (:content-type content)
-                     :thumb-path (str thumb-path)
-                     :thumb-width (:width thumb-opts)
-                     :thumb-height (:height thumb-opts)
-                     :thumb-quality (:quality thumb-opts)
-                     :thumb-mtype (images/format->mtype (:format thumb-opts))})
+                     :path (str path)
+                     :width (:width info)
+                     :height (:height info)
+                     :mtype  (:mtype info)
+                     :thumb-path (str (:path thumb))
+                     :thumb-width (:width thumb)
+                     :thumb-height (:height thumb)
+                     :thumb-quality (:quality thumb)
+                     :thumb-mtype (:mtype thumb)})
         (images/resolve-urls :path :uri)
         (images/resolve-urls :thumb-path :thumb-uri))))
 
@@ -172,14 +176,21 @@
     (ust/save! media/media-storage filename tempfile)))
 
 (defn persist-image-thumbnail-on-fs
-  [thumb-opts input-path]
-  (let [input-path (ust/lookup media/media-storage input-path)
-        thumb-data (images/generate-thumbnail input-path thumb-opts)
-        [filename _] (fs/split-ext (fs/name input-path))
-        thumb-name (->> (images/format->extension (:format thumb-opts))
-                         (str "thumbnail-" filename))]
-    (ust/save! media/media-storage thumb-name thumb-data)))
+  [{:keys [input] :as params}]
+  (let [path  (ust/lookup media/media-storage (:path input))
+        thumb (images/run
+                (-> params
+                    (assoc :cmd :generic-thumbnail)
+                    (update :input assoc :path path)))
 
+        name  (str "thumbnail-"
+                   (first (fs/split-ext (fs/name (:path input))))
+                   (images/format->extension (:format thumb)))
+        path  (ust/save! media/media-storage name (:data thumb))]
+
+    (-> thumb
+        (dissoc :data :input)
+        (assoc :path path))))
 
 ;; --- Mutation: Rename Image
 
diff --git a/backend/src/uxbox/services/mutations/profile.clj b/backend/src/uxbox/services/mutations/profile.clj
index 6588339d5..36242ebcf 100644
--- a/backend/src/uxbox/services/mutations/profile.clj
+++ b/backend/src/uxbox/services/mutations/profile.clj
@@ -272,8 +272,15 @@
 
 (sm/defmutation ::update-profile-photo
   [{:keys [profile-id file] :as params}]
+  (when-not (imgs/valid-image-types? (:content-type file))
+    (ex/raise :type :validation
+              :code :image-type-not-allowed
+              :hint "Seems like you are uploading an invalid image."))
+
   (db/with-atomic [conn db/pool]
     (let [profile (profile/retrieve-profile conn profile-id)
+          _       (images/run {:cmd :info :input {:path (:tempfile file)
+                                                  :mtype (:content-type file)}})
           photo   (upload-photo conn params)]
 
       ;; Schedule deletion of old photo
@@ -286,21 +293,18 @@
 
 (defn- upload-photo
   [conn {:keys [file profile-id]}]
-  (when-not (imgs/valid-image-types? (:content-type file))
-    (ex/raise :type :validation
-              :code :image-type-not-allowed
-              :hint "Seems like you are uploading an invalid image."))
-  (let [image-opts (images/info (:content-type file) (:tempfile file))
-        thumb-opts {:width 256
-                    :height 256
-                    :quality 75
-                    :format "jpeg"}
-        prefix (-> (sodi.prng/random-bytes 8)
+  (let [prefix (-> (sodi.prng/random-bytes 8)
                    (sodi.util/bytes->b64s))
-        name   (str prefix ".jpg")
-        path   (fs/path (:tempfile file))
-        photo  (images/generate-profile-thumbnail path thumb-opts)]
-    (ust/save! media/media-storage name photo)))
+        thumb  (images/run
+                 {:cmd :profile-thumbnail
+                  :format :jpeg
+                  :quality 85
+                  :width 256
+                  :height 256
+                  :input  {:path (fs/path (:tempfile file))
+                           :mtype (:content-type file)}})
+        name   (str prefix (images/format->extension (:format thumb)))]
+    (ust/save! media/media-storage name (:data thumb))))
 
 (defn- update-profile-photo
   [conn profile-id path]
@@ -309,7 +313,6 @@
               {:id profile-id})
   nil)
 
-
 ;; --- Mutation: Request Email Change
 
 (declare select-profile-for-update)