♻️ Refactor images storage.

This commit is contained in:
Andrey Antukh 2020-02-03 22:29:59 +01:00
parent b98d8519d4
commit 2cebbbc2f8
34 changed files with 2032 additions and 1630 deletions

View file

@ -10,25 +10,37 @@
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[datoteka.proto :as pt]
[datoteka.storages :as st]
[uxbox.common.data :as d]
[uxbox.common.spec :as us]
[uxbox.util.storage :as ust]
[uxbox.media :as media])
(:import
java.io.ByteArrayInputStream
java.io.InputStream
org.im4java.core.ConvertCmd
org.im4java.core.Info
org.im4java.core.IMOperation))
;; TODO: make this module non-blocking
;; --- Helpers
(defn format->extension
[format]
(case format
"jpeg" ".jpg"
"webp" ".webp"))
(defn format->mtype
[format]
(case format
"jpeg" "image/jpeg"
"webp" "image/webp"))
;; --- Thumbnails Generation
(s/def ::width integer?)
(s/def ::height integer?)
(s/def ::quality #(< 0 % 101))
(s/def ::format #{"jpg" "webp"})
(s/def ::format #{"jpeg" "webp"})
(s/def ::thumbnail-opts
(s/keys :opt-un [::format ::quality ::width ::height]))
@ -37,20 +49,30 @@
(defn generate-thumbnail
([input] (generate-thumbnail input nil))
([input {:keys [size quality format width height]
:or {format "jpg"
([input {:keys [quality format width height]
:or {format "jpeg"
quality 92
width 200
height 200}
:as opts}]
(us/verify ::thumbnail-opts opts)
;; (us/verify ::thumbnail-opts opts)
(us/verify fs/path? input)
(let [tmp (fs/create-tempfile :suffix (str "." format))
(let [ext (format->extension format)
tmp (fs/create-tempfile :suffix ext)
opr (doto (IMOperation.)
(.addImage)
(.autoOrient)
(.resize (int width) (int height) "^")
(.strip)
(.thumbnail (int width) (int height) ">")
(.quality (double quality))
;; (.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]))))
@ -58,50 +80,19 @@
(fs/delete tmp)
(ByteArrayInputStream. thumbnail-data)))))
(defn make-thumbnail
[input {:keys [width height format quality] :as opts}]
(us/verify ::thumbnail-opts opts)
(let [[filename ext] (fs/split-ext (fs/name input))
suffix (->> [width height quality format]
(interpose ".")
(apply str))
thumbnail-path (fs/path input (str "thumb-" suffix))
images-storage media/images-storage
thumbs-storage media/thumbnails-storage]
(if @(st/exists? thumbs-storage thumbnail-path)
(str (st/public-url thumbs-storage thumbnail-path))
(if @(st/exists? images-storage input)
(let [datapath @(st/lookup images-storage input)
thumbnail (generate-thumbnail datapath opts)
path @(st/save thumbs-storage thumbnail-path thumbnail)]
(str (st/public-url thumbs-storage path)))
nil))))
(defn info
[path]
(let [instance (Info. (str path))]
{:width (.getImageWidth instance)
:height (.getImageHeight instance)}))
(defn populate-thumbnail
[entry {:keys [src dst] :as opts}]
(assert (map? entry))
(defn resolve-urls
[row src dst]
(s/assert map? row)
(let [src (if (vector? src) src [src])
dst (if (vector? dst) dst [dst])
src (get-in entry src)]
(if (empty? src)
entry
(assoc-in entry dst (make-thumbnail src opts)))))
(defn populate-thumbnails
[entry & settings]
(reduce populate-thumbnail entry settings))
(defn populate-urls
[entry storage src dst]
(assert (map? entry))
(assert (st/storage? storage))
(let [src (if (vector? src) src [src])
dst (if (vector? dst) dst [dst])
value (get-in entry src)]
value (get-in row src)]
(if (empty? value)
entry
(let [url (str (st/public-url storage value))]
(-> entry
(d/dissoc-in src)
(assoc-in dst url))))))
row
(let [url (ust/public-uri media/media-storage value)]
(assoc-in row dst (str url))))))

View file

@ -2,71 +2,35 @@
;; 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) 2017 Andrey Antukh <niwi@niwi.nz>
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2017-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.media
"A media storage impl for uxbox."
(:require [mount.core :refer [defstate]]
[clojure.java.io :as io]
[cuerdas.core :as str]
[datoteka.core :as fs]
[datoteka.proto :as stp]
[datoteka.storages :as st]
[datoteka.storages.local :refer [localfs]]
[datoteka.storages.misc :refer [hashed scoped]]
[uxbox.config :refer [config]]))
;; --- Backends
(defn- normalize-filename
[path]
(let [parent (or (fs/parent path) "")
[name ext] (fs/split-ext (fs/name path))]
(fs/path parent (str (str/uslug name) ext))))
(defrecord FilenameSlugifiedBackend [storage]
stp/IPublicStorage
(-public-uri [_ path]
(stp/-public-uri storage path))
stp/IStorage
(-save [_ path content]
(let [^Path path (normalize-filename path)]
(stp/-save storage path content)))
(-delete [_ path]
(stp/-delete storage path))
(-exists? [this path]
(stp/-exists? storage path))
(-lookup [_ path]
(stp/-lookup storage path)))
(:require
[mount.core :refer [defstate]]
[clojure.java.io :as io]
[cuerdas.core :as str]
[datoteka.core :as fs]
[uxbox.util.storage :as ust]
[uxbox.config :refer [config]]))
;; --- State
(defstate assets-storage
:start (localfs {:basedir (:assets-directory config)
:baseuri (:assets-uri config)
:transform-filename str/uslug}))
:start (ust/create {:base-path (:assets-directory config)
:base-uri (:assets-uri config)}))
(defstate media-storage
:start (localfs {:basedir (:media-directory config)
:baseuri (:media-uri config)
:transform-filename str/uslug}))
(defstate images-storage
:start (-> media-storage
(scoped "images")
(hashed)
(->FilenameSlugifiedBackend)))
(defstate thumbnails-storage
:start (-> media-storage
(scoped "thumbs")))
:start (ust/create {:base-path (:media-directory config)
:base-uri (:media-uri config)
:xf (comp ust/random-path
ust/slugify-filename)}))
;; --- Public Api
(defn resolve-asset
[path]
(str (st/public-url assets-storage path)))
(str (ust/public-uri assets-storage path)))

View file

@ -14,9 +14,8 @@
[clojure.edn :as edn]
[promesa.core :as p]
[mount.core :as mount]
[cuerdas.core :as str]
[datoteka.storages :as st]
[datoteka.core :as fs]
[cuerdas.core :as str]
[uxbox.config]
[uxbox.common.spec :as us]
[uxbox.db :as db]
@ -27,7 +26,9 @@
[uxbox.util.transit :as t]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]
[uxbox.util.data :as data])
[uxbox.util.data :as data]
[uxbox.services.mutations.images :as images]
[uxbox.util.storage :as ust])
(:import
java.io.Reader
java.io.PushbackReader
@ -65,7 +66,7 @@
(-> (db/query-one conn [sql id name])
(p/then' (constantly id)))))
(def create-icon-sql
(def sql:create-icon
"insert into icons (user_id, id, collection_id, name, metadata, content)
values ('00000000-0000-0000-0000-000000000000'::uuid, $1, $2, $3, $4, $5)
on conflict (id)
@ -85,7 +86,9 @@
extension (second (fs/split-ext filename))
data (svg/parse localpath)
mdata (select-keys data [:width :height :view-box])]
(db/query-one conn [create-icon-sql icon-id id
(db/query-one conn [sql:create-icon
icon-id
id
(:name data filename)
(blob/encode mdata)
(:content data)])))
@ -123,56 +126,43 @@
[conn {:keys [name] :as item}]
(log/info "Creating or updating image collection:" name)
(let [id (uuid/namespaced +images-uuid-ns+ name)
user uuid/zero
sql "insert into image_collections (id, user_id, name)
values ($1, '00000000-0000-0000-0000-000000000000'::uuid, $2)
on conflict (id)
do update set name = $2
returning *;"
sqlv [sql id name]]
(-> (db/query-one conn [sql id name])
(p/then' (constantly id)))))
(defn- retrieve-image-size
[path]
(let [info (Info. (str path) true)]
[(.getImageWidth info) (.getImageHeight info)]))
values ($1, $2, $3)
on conflict (id) do nothing
returning *;"]
(-> (db/query-one db/pool [sql id user name])
(p/then (constantly id)))))
(defn- image-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id
from images as i
where i.id = $1
and i.user_id = '00000000-0000-0000-0000-000000000000'::uuid"]
(let [sql "select id from images as i
where i.id = $1 and i.user_id = '00000000-0000-0000-0000-000000000000'::uuid"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(def create-image-sql
"insert into images (user_id, id, collection_id, name, path, width, height, mimetype)
values ('00000000-0000-0000-0000-000000000000'::uuid, $1, $2, $3, $4, $5, $6, $7)
returning *;")
(defn- create-image
[conn id image-id localpath]
(s/assert fs/path? localpath)
(s/assert ::us/uuid id)
(s/assert ::us/uuid image-id)
(let [storage media/images-storage
filename (fs/name localpath)
[width height] (retrieve-image-size localpath)
(let [filename (fs/name localpath)
extension (second (fs/split-ext filename))
mimetype (case extension
".jpg" "image/jpeg"
".png" "image/png")]
(-> (st/save storage filename localpath)
(p/then (fn [path]
(db/query-one conn [create-image-sql image-id id
filename
(str path)
width
height
mimetype])))
(p/then (constantly nil)))))
file (io/as-file localpath)
mtype (case extension
".jpg" "image/jpeg"
".png" "image/png"
".webp" "image/webp")]
(images/create-image conn {:content {:path localpath
:name filename
:mtype mtype
:size (.length file)}
:id image-id
:collection-id id
:user uuid/zero
:name filename})))
(defn- import-image
[conn id fpath]
@ -218,7 +208,7 @@
(exit! -1))
(fs/path path))
(defn- read-import-file
(defn- read-file
[path]
(let [path (validate-path path)
reader (java.io.PushbackReader. (io/reader path))]
@ -244,7 +234,7 @@
(defn -main
[& [path]]
(let [[basedir data] (read-import-file path)]
(let [[basedir data] (read-file path)]
(start-system)
(-> (db/with-atomic [conn db/pool]
(importer conn basedir data))

View file

@ -21,135 +21,184 @@
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.core :as vc]))
(def +thumbnail-options+
{:src :path
:dst :thumbnail
:width 300
:height 100
:quality 92
(def thumbnail-options
{:width 800
:height 800
:quality 80
:format "webp"})
(defn- populate-thumbnail
[row]
(let [opts +thumbnail-options+]
(-> (px/submit! #(images/populate-thumbnails row opts))
(su/handle-on-context))))
(defn- populate-thumbnails
[rows]
(if (empty? rows)
rows
(p/all (map populate-thumbnail rows))))
(defn- populate-urls
[row]
(images/populate-urls row media/images-storage :path :url))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
;; --- Create Collection
(s/def ::create-image-collection
(declare create-images-collection)
(s/def ::create-images-collection
(s/keys :req-un [::user ::us/name]
:opt-un [::id]))
(sm/defmutation ::create-image-collection
(sm/defmutation ::create-images-collection
[{:keys [id user name] :as params}]
(let [sql "insert into image_collections (id, user_id, name)
values ($1, $2, $3) returning *;"]
(db/query-one db/pool [sql (or id (uuid/next)) user name])))
(db/with-atomic [conn db/pool]
(create-images-collection conn params)))
(defn create-images-collection
[conn {:keys [id user name] :as params}]
(let [id (or id (uuid/next))
sql "insert into image_collections (id, user_id, name)
values ($1, $2, $3)
on conflict (id) do nothing
returning *;"]
(db/query-one db/pool [sql id user name])))
;; --- Update Collection
(s/def ::update-images-collection
(def ^:private
sql:rename-images-collection
"update image_collections
set name = $3
where id = $1
and user_id = $2
returning *;")
(s/def ::rename-images-collection
(s/keys :req-un [::id ::user ::us/name]))
(sm/defmutation ::update-images-collection
(sm/defmutation ::rename-images-collection
[{:keys [id user name] :as params}]
(let [sql "update image_collections
set name = $3
where id = $1
and user_id = $2
returning *;"]
(db/query-one db/pool [sql id user name])))
(db/with-atomic [conn db/pool]
(db/query-one conn [sql:rename-images-collection id user name])))
;; --- Delete Collection
(s/def ::delete-images-collection
(s/keys :req-un [::user ::id]))
(def ^:private
sql:delete-images-collection
"update image_collections
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning id")
(sm/defmutation ::delete-images-collection
[{:keys [id user] :as params}]
(let [sql "update image_collections
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning id"]
(-> (db/query-one db/pool [sql id user])
(p/then' su/raise-not-found-if-nil))))
(-> (db/query-one db/pool [sql:delete-images-collection id user])
(p/then' su/raise-not-found-if-nil)))
;; --- Create Image (Upload)
(defn- store-image-in-fs
[{:keys [name path] :as upload}]
(let [filename (fs/name name)
storage media/images-storage]
(-> (ds/save storage filename (fs/path path))
(su/handle-on-context))))
(def sql:create-image
"insert into images (user_id, name, collection_id, path, width, height, mimetype)
values ($1, $2, $3, $4, $5, $6, $7) returning *")
(defn- store-image-in-db
[conn {:keys [id user name path collection-id height width mimetype]}]
(let [sqlv [sql:create-image user name collection-id
path width height mimetype]]
(-> (db/query-one conn sqlv)
(p/then populate-thumbnail)
(p/then populate-urls))))
(declare select-collection-for-update)
(declare create-image)
(declare persist-image-on-fs)
(declare persist-image-thumbnail-on-fs)
(def valid-image-types?
#{"image/jpeg", "image/png", "image/webp"})
(s/def :uxbox$upload/name ::us/string)
(s/def :uxbox$upload/size ::us/integer)
(s/def :uxbox$upload/mtype ::us/string)
(s/def :uxbox$upload/mtype valid-image-types?)
(s/def :uxbox$upload/path ::us/string)
(s/def ::upload
(s/keys :req-un [:uxbox$upload/name
:uxbox$upload/size
:uxbox$upload/path
:uxbox$upload/mtype]))
(s/def ::file ::upload)
(s/def ::width ::us/integer)
(s/def ::height ::us/integer)
(s/def ::mimetype valid-image-types?)
(s/def ::collection-id ::us/uuid)
(s/def ::content ::upload)
(s/def ::create-image
(s/keys :req-un [::user ::name ::file ::width ::height ::mimetype]
:opt-un [::id ::collection-id]))
(s/def ::upload-image
(s/keys :req-un [::user ::name ::content ::collection-id]
:opt-un [::id]))
(sm/defmutation ::create-image
[{:keys [file] :as params}]
(when-not (valid-image-types? (:mtype file))
(sm/defmutation ::upload-image
[{:keys [collection-id user] :as params}]
(db/with-atomic [conn db/pool]
(p/let [coll (select-collection-for-update conn collection-id)]
(when (not= (:user-id coll) user)
(ex/raise :type :validation
:code :not-authorized))
(create-image conn params))))
(def ^:private sql:insert-image
"insert into images
(id, collection_id, user_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, $12, $13)
returning *")
(defn create-image
[conn {:keys [id content collection-id user name] :as params}]
(when-not (valid-image-types? (:mtype content))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
(-> (store-image-in-fs file)
(p/then (fn [path]
(store-image-in-db db/pool (assoc params :path (str path)))))))
(p/let [image-opts (vc/blocking (images/info (:path content)))
image-path (persist-image-on-fs content)
thumb-opts thumbnail-options
thumb-path (persist-image-thumbnail-on-fs thumb-opts image-path)
id (or id (uuid/next))
sqlv [sql:insert-image
id
collection-id
user
name
(str image-path)
(:width image-opts)
(:height image-opts)
(:mtype content)
(str thumb-path)
(:width thumb-opts)
(:height thumb-opts)
(:quality thumb-opts)
(images/format->mtype (:format thumb-opts))]]
(-> (db/query-one conn sqlv)
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri)))))
(defn- select-collection-for-update
[conn id]
(let [sql "select c.id, c.user_id
from image_collections as c
where c.id = $1
and c.deleted_at is null
for update;"]
(-> (db/query-one conn [sql id])
(p/then' su/raise-not-found-if-nil))))
(defn persist-image-on-fs
[{:keys [name path] :as upload}]
(vc/blocking
(let [filename (fs/name name)]
(ust/save! media/media-storage filename path))))
(defn persist-image-thumbnail-on-fs
[thumb-opts input-path]
(vc/blocking
(let [input-path (ust/lookup media/media-storage input-path)
thumb-data (images/generate-thumbnail input-path thumb-opts)
[filename ext] (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))))
;; --- Update Image
(s/def ::update-image
(s/keys :req-un [::id ::user ::name ::collection-id]))
(def ^:private update-image-sql
(def ^:private sql:update-image
"update images
set name = $3,
collection_id = $2
@ -159,31 +208,30 @@
(sm/defmutation ::update-image
[{:keys [id name user collection-id] :as params}]
(let [sql update-image-sql]
(db/query-one db/pool [sql id collection-id name user])))
(db/query-one db/pool [sql:update-image id collection-id name user]))
;; --- Copy Image
(declare retrieve-image)
(s/def ::copy-image
(s/keys :req-un [::id ::collection-id ::user]))
;; (s/def ::copy-image
;; (s/keys :req-un [::id ::collection-id ::user]))
(sm/defmutation ::copy-image
[{:keys [user id collection-id] :as params}]
(letfn [(copy-image [conn {:keys [path] :as image}]
(-> (ds/lookup media/images-storage (:path image))
(p/then (fn [path] (ds/save media/images-storage (fs/name path) path)))
(p/then (fn [path]
(-> image
(assoc :path (str path) :collection-id collection-id)
(dissoc :id))))
(p/then (partial store-image-in-db conn))))]
;; (sm/defmutation ::copy-image
;; [{:keys [user id collection-id] :as params}]
;; (letfn [(copy-image [conn {:keys [path] :as image}]
;; (-> (ds/lookup media/images-storage (:path image))
;; (p/then (fn [path] (ds/save media/images-storage (fs/name path) path)))
;; (p/then (fn [path]
;; (-> image
;; (assoc :path (str path) :collection-id collection-id)
;; (dissoc :id))))
;; (p/then (partial store-image-in-db conn))))]
(db/with-atomic [conn db/pool]
(-> (retrieve-image conn {:id id :user user})
(p/then su/raise-not-found-if-nil)
(p/then (partial copy-image conn))))))
;; (db/with-atomic [conn db/pool]
;; (-> (retrieve-image conn {:id id :user user})
;; (p/then su/raise-not-found-if-nil)
;; (p/then (partial copy-image conn))))))
;; --- Delete Image

View file

@ -178,46 +178,46 @@
;; --- Mutation: Update Photo
(s/def :uxbox$upload/name ::us/string)
(s/def :uxbox$upload/size ::us/integer)
(s/def :uxbox$upload/mtype ::us/string)
(s/def ::upload
(s/keys :req-un [:uxbox$upload/name
:uxbox$upload/size
:uxbox$upload/mtype]))
;; (s/def :uxbox$upload/name ::us/string)
;; (s/def :uxbox$upload/size ::us/integer)
;; (s/def :uxbox$upload/mtype ::us/string)
;; (s/def ::upload
;; (s/keys :req-un [:uxbox$upload/name
;; :uxbox$upload/size
;; :uxbox$upload/mtype]))
(s/def ::file ::upload)
(s/def ::update-profile-photo
(s/keys :req-un [::user ::file]))
;; (s/def ::file ::upload)
;; (s/def ::update-profile-photo
;; (s/keys :req-un [::user ::file]))
(def valid-image-types?
#{"image/jpeg", "image/png", "image/webp"})
;; (def valid-image-types?
;; #{"image/jpeg", "image/png", "image/webp"})
(sm/defmutation ::update-profile-photo
[{:keys [user file] :as params}]
(letfn [(store-photo [{:keys [name path] :as upload}]
(let [filename (fs/name name)
storage media/images-storage]
(-> (ds/save storage filename path)
#_(su/handle-on-context))))
;; (sm/defmutation ::update-profile-photo
;; [{:keys [user file] :as params}]
;; (letfn [(store-photo [{:keys [name path] :as upload}]
;; (let [filename (fs/name name)
;; storage media/media-storage]
;; (-> (ds/save storage filename path)
;; #_(su/handle-on-context))))
(update-user-photo [path]
(let [sql "update users
set photo = $1
where id = $2
and deleted_at is null
returning id, photo"]
(-> (db/query-one db/pool [sql (str path) user])
(p/then' su/raise-not-found-if-nil)
(p/then profile/resolve-thumbnail))))]
;; (update-user-photo [path]
;; (let [sql "update users
;; set photo = $1
;; where id = $2
;; and deleted_at is null
;; returning id, photo"]
;; (-> (db/query-one db/pool [sql (str path) user])
;; (p/then' su/raise-not-found-if-nil)
;; (p/then profile/resolve-thumbnail))))]
(when-not (valid-image-types? (:mtype file))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
;; (when-not (valid-image-types? (:mtype file))
;; (ex/raise :type :validation
;; :code :image-type-not-allowed
;; :hint "Seems like you are uploading an invalid image."))
(-> (store-photo file)
(p/then update-user-photo))))
;; (-> (store-photo file)
;; (p/then update-user-photo))))
;; --- Mutation: Register Profile

View file

@ -11,15 +11,21 @@
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.pages :as cp]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.projects :as proj]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]))
[uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.core :as vc]))
;; --- Helpers & Specs
@ -123,7 +129,8 @@
(-> (db/query-one conn [sql id name])
(p/then' su/constantly-nil))))
;; --- Mutation: Delete Project
;; --- Mutation: Delete Project File
(declare delete-file)
@ -147,3 +154,97 @@
(let [sql sql:delete-file]
(-> (db/query-one conn [sql id])
(p/then' su/constantly-nil))))
;; --- Mutation: Upload File Image
(s/def ::file-id ::us/uuid)
(s/def ::content ::imgs/upload)
(s/def ::upload-project-file-image
(s/keys :req-un [::user ::file-id ::name ::content]
:opt-un [::id]))
(declare create-file-image)
(sm/defmutation ::upload-project-file-image
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user file-id)
(create-file-image conn params)))
(def ^:private
sql:insert-file-image
"insert into project_file_images
(file_id, user_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, $12)
returning *")
(defn- create-file-image
[conn {:keys [content file-id user name] :as params}]
(when-not (imgs/valid-image-types? (:mtype content))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
(p/let [image-opts (vc/blocking (images/info (:path 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)
sqlv [sql:insert-file-image
file-id
user
name
(str image-path)
(:width image-opts)
(:height image-opts)
(:mtype content)
(str thumb-path)
(:width thumb-opts)
(:height thumb-opts)
(:quality thumb-opts)
(images/format->mtype (:format thumb-opts))]]
(-> (db/query-one db/pool sqlv)
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri)))))
;; --- Mutation: Import from collection
(declare copy-image!)
(s/def ::import-image-to-file
(s/keys :req-un [::image-id ::file-id ::user]))
(def ^:private sql:select-image-by-id
"select img.* from images as img where id=$1")
(sm/defmutation ::import-image-to-file
[{:keys [image-id file-id user]}]
(db/with-atomic [conn db/pool]
(p/let [image (-> (db/query-one conn [sql:select-image-by-id image-id])
(p/then' su/raise-not-found-if-nil))
image-path (copy-image! (:path image))
thumb-path (copy-image! (:thumb-path image))
sqlv [sql:insert-file-image
file-id
user
(:name image)
(str image-path)
(:width image)
(:height image)
(:mtype image)
(str thumb-path)
(:thumb-width image)
(:thumb-height image)
(:thumb-quality image)
(:thumb-mtype image)]]
(-> (db/query-one db/pool sqlv)
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri))))))
(defn- copy-image!
[path]
(vc/blocking
(let [image-path (ust/lookup media/media-storage path)]
(ust/save! media/media-storage (fs/name image-path) image-path))))

View file

@ -21,38 +21,14 @@
[uxbox.util.uuid :as uuid]
[vertx.core :as vc]))
(def +thumbnail-options+
{:src :path
:dst :thumbnail
:width 300
:height 100
:quality 92
:format "webp"})
(defn populate-thumbnail
[row]
(let [opts +thumbnail-options+]
(-> (p/promise row)
(p/then (vc/wrap-blocking #(images/populate-thumbnail % opts))))))
(defn populate-thumbnails
[rows]
(if (empty? rows)
rows
(vc/blocking
(mapv (fn [row]
(images/populate-thumbnail row +thumbnail-options+)) rows))))
(defn populate-urls
[row]
(images/populate-urls row media/images-storage :path :url))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
(def ^:private images-collections-sql
;; --- Query: Images Collections
(def ^:private sql:collections
"select *,
(select count(*) from images where collection_id = ic.id) as num_images
from image_collections as ic
@ -66,9 +42,10 @@
(sq/defquery ::images-collections
[{:keys [user] :as params}]
(db/query db/pool [images-collections-sql user]))
(db/query db/pool [sql:collections user]))
;; --- Retrieve Image
;; --- Query: Image by ID
(defn retrieve-image
[conn id]
@ -84,10 +61,10 @@
(sq/defquery ::image-by-id
[params]
(-> (retrieve-image db/pool (:id params))
(p/then populate-thumbnail)
(p/then populate-urls)))
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri))))
;; --- Query Images by Collection (id)
;; --- Query: Images by collection ID
(def sql:images-by-collection
"select * from images
@ -96,12 +73,7 @@
and deleted_at is null
order by created_at desc")
(def sql:images-by-collection1
(str "with images as (" sql:images-by-collection ")
select im.* from images as im
where im.collection_id is null"))
(def sql:images-by-collection2
(def sql:images-by-collection
(str "with images as (" sql:images-by-collection ")
select im.* from images as im
where im.collection_id = $2"))
@ -110,12 +82,14 @@
(s/keys :req-un [::user]
:opt-un [::collection-id]))
;; TODO: check if we can resolve url with transducer for reduce
;; garbage generation for each request
(sq/defquery ::images-by-collection
[{:keys [user collection-id] :as params}]
(let [sqlv (if (nil? collection-id)
[sql:images-by-collection1 user]
[sql:images-by-collection2 user collection-id])]
(let [sqlv [sql:images-by-collection user collection-id]]
(-> (db/query db/pool sqlv)
(p/then populate-thumbnails)
(p/then #(mapv populate-urls %)))))
(p/then' (fn [rows]
(->> rows
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri))))))))

View file

@ -31,15 +31,15 @@
;; --- Query: Profile (own)
(defn resolve-thumbnail
[user]
(let [opts {:src :photo
:dst :photo
:size [100 100]
:quality 90
:format "jpg"}]
(-> (px/submit! #(images/populate-thumbnails user opts))
(su/handle-on-context))))
;; (defn resolve-thumbnail
;; [user]
;; (let [opts {:src :photo
;; :dst :photo
;; :size [100 100]
;; :quality 90
;; :format "jpg"}]
;; (-> (px/submit! #(images/populate-thumbnails user opts))
;; (su/handle-on-context))))
(defn retrieve-profile
[conn id]

View file

@ -13,6 +13,7 @@
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]))
@ -27,24 +28,6 @@
(s/def ::file-id ::us/uuid)
(s/def ::user ::us/uuid)
(def sql:generic-project-files
"select distinct on (pf.id, pf.created_at)
pf.*,
p.name as project_name,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data
from project_files as pf
inner join projects as p on (pf.project_id = p.id)
inner join project_users as pu on (p.id = pu.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pu.user_id = $1
and pu.can_edit = true
and pf.deleted_at is null
and pp.deleted_at is null
window pages_w as (partition by pf.id order by pp.created_at
range BETWEEN UNBOUNDED PRECEDING
AND UNBOUNDED FOLLOWING)")
;; --- Query: Project Files
(declare retrieve-recent-files)
@ -60,33 +43,77 @@
(retrieve-recent-files db/pool params)
(retrieve-project-files db/pool params)))
(def sql:project-files
(str "with files as (" sql:generic-project-files ")
select * from files where project_id = $2
order by created_at asc"))
(def ^:private sql:generic-project-files
"select distinct
pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_users as pu
inner join project_files as pf on (pf.project_id = pu.project_id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pu.user_id = $1
and pu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following)
order by pf.created_at")
(def sql:recent-files
(str "with files as (" sql:generic-project-files ")
select * from files
order by modified_at desc
limit $2"))
(def ^:private sql:project-files
(str "with files as (" sql:generic-project-files ") "
"select * from files where project_id = $2"))
(defn retrieve-project-files
[conn {:keys [user project-id]}]
(-> (db/query conn [sql:project-files user project-id])
(p/then' (partial mapv decode-row))))
(def ^:private sql:recent-files
"with project_files as (
(select pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_users as pu
inner join project_files as pf on (pf.project_id = pu.project_id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pu.user_id = $1
and pu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following))
union
(select pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_file_users as pfu
inner join project_files as pf on (pfu.file_id = pf.id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pfu.user_id = $1
and pfu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following))
) select pf1.*
from project_files as pf1
order by pf1.modified_at desc
limit $2;")
(defn retrieve-recent-files
[conn {:keys [user]}]
(-> (db/query conn [sql:recent-files user 20])
(p/then' (partial mapv decode-row))))
;; --- Query: Project File (By ID)
(def sql:project-file
(str "with files as (" sql:generic-project-files ")
select * from files where id = $2"))
(def ^:private sql:project-file
(str "with files as (" sql:generic-project-files ") "
"select * from files where id = $2"))
(s/def ::project-file
(s/keys :req-un [::user ::id]))
@ -96,36 +123,10 @@
(-> (db/query-one db/pool [sql:project-file user id])
(p/then' decode-row)))
;; --- Query: Users of the File
(def sql:file-users
"select u.id, u.fullname, u.photo
from users as u
join project_file_users as pfu on (pfu.user_id = u.id)
where pfu.file_id = $1
union all
select u.id, u.fullname, u.photo
from users as u
join project_users as pu on (pu.user_id = u.id)
where pu.project_id = $2")
(def sql:file-users
"select u.id, u.fullname, u.photo
from users as u
join project_file_users as pfu on (pfu.user_id = u.id)
where pfu.file_id = $1
union all
select u.id, u.fullname, u.photo
from users as u
join project_users as pu on (pu.user_id = u.id)
where pu.project_id = $2")
(declare retrieve-minimal-file)
(def sql:minimal-file
(str "with files as (" sql:generic-project-files ")
select id, project_id from files where id = $2"))
(declare retrieve-file-users)
(s/def ::project-file-users
(s/keys :req-un [::user ::file-id]))
@ -134,20 +135,65 @@
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (retrieve-minimal-file conn user file-id)
(p/then (fn [{:keys [id project-id]}]
(db/query conn [sql:file-users id project-id]))))))
(p/then #(retrieve-file-users conn %)))))
(def ^:private sql:minimal-file
(str "with files as (" sql:generic-project-files ") "
"select id, project_id from files where id = $2"))
(defn- retrieve-minimal-file
[conn user-id file-id]
(-> (db/query-one conn [sql:minimal-file user-id file-id])
(p/then' su/raise-not-found-if-nil)))
(def ^:private sql:file-users
"select u.id, u.fullname, u.photo
from users as u
join project_file_users as pfu on (pfu.user_id = u.id)
where pfu.file_id = $1
union all
select u.id, u.fullname, u.photo
from users as u
join project_users as pu on (pu.user_id = u.id)
where pu.project_id = $2")
(defn- retrieve-file-users
[conn {:keys [id project-id] :as file}]
(let [sqlv [sql:file-users id project-id]]
(db/query conn sqlv)))
;; --- Query: Images of the File
(declare retrieve-file-images)
(s/def ::project-file-images
(s/keys :req-un [::user ::file-id]))
(sq/defquery ::project-file-images
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (retrieve-minimal-file conn user file-id)
(p/then #(retrieve-file-images conn %)))))
(def ^:private sql:file-images
"select pfi.*
from project_file_images as pfi
where pfi.file_id = $1")
(defn retrieve-file-images
[conn {:keys [id] :as file}]
(let [sqlv [sql:file-images id]
xf (comp (map #(images/resolve-urls % :path :uri))
(map #(images/resolve-urls % :thumb-path :thumb-uri)))]
(-> (db/query conn sqlv)
(p/then' #(into [] xf %)))))
;; --- Helpers
(defn decode-row
[{:keys [metadata pages data] :as row}]
[{:keys [pages data] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
pages (assoc :pages (vec (remove nil? pages)))
metadata (assoc :metadata (blob/decode metadata)))))
pages (assoc :pages (vec (remove nil? pages))))))

View file

@ -164,20 +164,31 @@
(doto (java.security.SecureRandom/getInstance "SHA1PRNG")
(.setSeed ^bytes (sodi.prng/random-bytes 64)))))
(defn random-path
[^Path path]
(let [name (str (.getFileName path))
hash (-> (sodi.prng/random-bytes @prng 10)
(sodi.util/bytes->b64s))
tokens (re-seq #"[\w\d\-\_]{2}" hash)
path-tokens (take 3 tokens)
rest-tokens (drop 3 tokens)
path (fs/path path-tokens)
frest (apply str rest-tokens)]
(fs/path (list path frest name))))
(defn with-xf
[storage xfm]
(let [xf (::xf storage)]
(if (nil? xf)
(assoc storage ::xf xfm)
(assoc storage ::xf (comp xf xfm)))))
(defn slugify-filename
[path]
(let [parent (or (fs/parent path) "")
[name ext] (fs/split-ext (fs/name path))]
(fs/path parent (str (str/uslug name) ext))))
(def random-path
(map (fn [^Path path]
(let [name (str (.getFileName path))
hash (-> (sodi.prng/random-bytes @prng 10)
(sodi.util/bytes->b64s))
tokens (re-seq #"[\w\d\-\_]{2}" hash)
path-tokens (take 3 tokens)
rest-tokens (drop 3 tokens)
path (fs/path path-tokens)
frest (apply str rest-tokens)]
(fs/path (list path frest name))))))
(def slugify-filename
(map (fn [path]
(let [parent (or (fs/parent path) "")
[name ext] (fs/split-ext (fs/name path))]
(fs/path parent (str (str/uslug name) ext))))))
(defn prefix-path
[prefix]
(map (fn [^Path path] (fs/join (fs/path prefix) path))))