mirror of
https://github.com/penpot/penpot.git
synced 2025-05-11 03:36:37 +02:00
♻️ Refactor images storage.
This commit is contained in:
parent
b98d8519d4
commit
2cebbbc2f8
34 changed files with 2032 additions and 1630 deletions
|
@ -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))))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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))))))))
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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))))))
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue