Merge pull request #253 from uxbox/issue/482/improve-thumbnail-handling

♻️ Refactor thumbnail generation.
2025-02-10 09:08:31 -05:00 · 2020-06-09 16:08:27 +02:00 · 2020-06-09 16:08:27 +02:00 · fd91a7b1f4
commit fd91a7b1f4
parent 60ec32f7cc 3f554df687
5 changed files with 194 additions and 142 deletions
--- 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]
--- a/backend/src/uxbox/images.clj
+++ b/backend/src/uxbox/images.clj
@ -10,85 +10,109 @@
 (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.)
+(defn format->extension
+  [format]
+  (case format
+    :png  ".png"
+    :jpeg ".jpg"
+    :webp ".webp"))
+
+(defn format->mtype
+  [format]
+  (case format
+    :png  "image/png"
+    :jpeg "image/jpeg"
+    :webp "image/webp"))
+
+(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))]
-     (doto (ConvertCmd.)
-       (.run opr (into-array (map str [input tmp]))))
-     (let [thumbnail-data (fs/slurp-bytes tmp)]
-       (fs/delete tmp)
-       (ByteArrayInputStream. thumbnail-data)))))
+    (generic-process (assoc params :operation op))))

-(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.)
+(defmethod process :profile-thumbnail
+  [{:keys [quality width height] :as params}]
+  (us/assert ::thumbnail-params params)
+  (let [op (doto (IMOperation.)
             (.addImage)
             (.autoOrient)
             (.strip)
@ -97,21 +121,44 @@
             (.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)))))
+    (generic-process (assoc params :operation op))))

-(defn info
-  [content-type path]
-  (let [instance (Info. (str path))]
-    (when-not (= content-type (.getProperty instance "Mime type"))
+(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)}))
+     :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]
--- 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]
--- 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

--- 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)