♻️ 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

@ -50,18 +50,30 @@ CREATE INDEX project_files__user_id__idx
CREATE INDEX project_files__project_id__idx CREATE INDEX project_files__project_id__idx
ON project_files(project_id); ON project_files(project_id);
CREATE TABLE project_file_media ( CREATE TABLE project_file_images (
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(), id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
file_id uuid NOT NULL REFERENCES project_files(id) ON DELETE CASCADE, file_id uuid NOT NULL REFERENCES project_files(id) ON DELETE CASCADE,
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
name text NOT NULL,
type text NOT NULL,
path text NOT NULL, path text NOT NULL,
width int NOT NULL,
height int NOT NULL,
mtype text NOT NULL,
metadata bytea NULL DEFAULT NULL thumb_path text NOT NULL,
thumb_width int NOT NULL,
thumb_height int NOT NULL,
thumb_quality int NOT NULL,
thumb_mtype text NOT NULL
); );
CREATE INDEX project_file_media__file_id__idx CREATE INDEX project_file_images__file_id__idx
ON project_file_media(file_id); ON project_file_images(file_id);
CREATE INDEX project_file_images__user_id__idx
ON project_file_images(user_id);
CREATE TABLE project_file_users ( CREATE TABLE project_file_users (
file_id uuid NOT NULL REFERENCES project_files(id) ON DELETE CASCADE, file_id uuid NOT NULL REFERENCES project_files(id) ON DELETE CASCADE,

View file

@ -15,18 +15,24 @@ CREATE INDEX image_collections__user_id__idx
CREATE TABLE images ( CREATE TABLE images (
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(), id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE, user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
collection_id uuid REFERENCES image_collections(id) ON DELETE CASCADE, collection_id uuid NOT NULL REFERENCES image_collections(id) ON DELETE CASCADE,
created_at timestamptz NOT NULL DEFAULT clock_timestamp(), created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(), modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
deleted_at timestamptz DEFAULT NULL, deleted_at timestamptz DEFAULT NULL,
name text NOT NULL,
path text NOT NULL,
width int NOT NULL, width int NOT NULL,
height int NOT NULL, height int NOT NULL,
mimetype text NOT NULL, mtype text NOT NULL,
name text NOT NULL, thumb_path text NOT NULL,
path text NOT NULL thumb_width int NOT NULL,
thumb_height int NOT NULL,
thumb_quality int NOT NULL,
thumb_mtype text NOT NULL
); );
CREATE INDEX images__user_id__idx CREATE INDEX images__user_id__idx

View file

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

View file

@ -2,71 +2,35 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; 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 (ns uxbox.media
"A media storage impl for uxbox." "A media storage impl for uxbox."
(:require [mount.core :refer [defstate]] (:require
[mount.core :refer [defstate]]
[clojure.java.io :as io] [clojure.java.io :as io]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.core :as fs] [datoteka.core :as fs]
[datoteka.proto :as stp] [uxbox.util.storage :as ust]
[datoteka.storages :as st]
[datoteka.storages.local :refer [localfs]]
[datoteka.storages.misc :refer [hashed scoped]]
[uxbox.config :refer [config]])) [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)))
;; --- State ;; --- State
(defstate assets-storage (defstate assets-storage
:start (localfs {:basedir (:assets-directory config) :start (ust/create {:base-path (:assets-directory config)
:baseuri (:assets-uri config) :base-uri (:assets-uri config)}))
:transform-filename str/uslug}))
(defstate media-storage (defstate media-storage
:start (localfs {:basedir (:media-directory config) :start (ust/create {:base-path (:media-directory config)
:baseuri (:media-uri config) :base-uri (:media-uri config)
:transform-filename str/uslug})) :xf (comp ust/random-path
ust/slugify-filename)}))
(defstate images-storage
:start (-> media-storage
(scoped "images")
(hashed)
(->FilenameSlugifiedBackend)))
(defstate thumbnails-storage
:start (-> media-storage
(scoped "thumbs")))
;; --- Public Api ;; --- Public Api
(defn resolve-asset (defn resolve-asset
[path] [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] [clojure.edn :as edn]
[promesa.core :as p] [promesa.core :as p]
[mount.core :as mount] [mount.core :as mount]
[cuerdas.core :as str]
[datoteka.storages :as st]
[datoteka.core :as fs] [datoteka.core :as fs]
[cuerdas.core :as str]
[uxbox.config] [uxbox.config]
[uxbox.common.spec :as us] [uxbox.common.spec :as us]
[uxbox.db :as db] [uxbox.db :as db]
@ -27,7 +26,9 @@
[uxbox.util.transit :as t] [uxbox.util.transit :as t]
[uxbox.util.blob :as blob] [uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid] [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 (:import
java.io.Reader java.io.Reader
java.io.PushbackReader java.io.PushbackReader
@ -65,7 +66,7 @@
(-> (db/query-one conn [sql id name]) (-> (db/query-one conn [sql id name])
(p/then' (constantly id))))) (p/then' (constantly id)))))
(def create-icon-sql (def sql:create-icon
"insert into icons (user_id, id, collection_id, name, metadata, content) "insert into icons (user_id, id, collection_id, name, metadata, content)
values ('00000000-0000-0000-0000-000000000000'::uuid, $1, $2, $3, $4, $5) values ('00000000-0000-0000-0000-000000000000'::uuid, $1, $2, $3, $4, $5)
on conflict (id) on conflict (id)
@ -85,7 +86,9 @@
extension (second (fs/split-ext filename)) extension (second (fs/split-ext filename))
data (svg/parse localpath) data (svg/parse localpath)
mdata (select-keys data [:width :height :view-box])] 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) (:name data filename)
(blob/encode mdata) (blob/encode mdata)
(:content data)]))) (:content data)])))
@ -123,56 +126,43 @@
[conn {:keys [name] :as item}] [conn {:keys [name] :as item}]
(log/info "Creating or updating image collection:" name) (log/info "Creating or updating image collection:" name)
(let [id (uuid/namespaced +images-uuid-ns+ name) (let [id (uuid/namespaced +images-uuid-ns+ name)
user uuid/zero
sql "insert into image_collections (id, user_id, name) sql "insert into image_collections (id, user_id, name)
values ($1, '00000000-0000-0000-0000-000000000000'::uuid, $2) values ($1, $2, $3)
on conflict (id) on conflict (id) do nothing
do update set name = $2 returning *;"]
returning *;" (-> (db/query-one db/pool [sql id user name])
sqlv [sql id name]] (p/then (constantly id)))))
(-> (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)]))
(defn- image-exists? (defn- image-exists?
[conn id] [conn id]
(s/assert ::us/uuid id) (s/assert ::us/uuid id)
(let [sql "select id (let [sql "select id from images as i
from images as i where i.id = $1 and i.user_id = '00000000-0000-0000-0000-000000000000'::uuid"]
where i.id = $1
and i.user_id = '00000000-0000-0000-0000-000000000000'::uuid"]
(-> (db/query-one conn [sql id]) (-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false)))))) (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 (defn- create-image
[conn id image-id localpath] [conn id image-id localpath]
(s/assert fs/path? localpath) (s/assert fs/path? localpath)
(s/assert ::us/uuid id) (s/assert ::us/uuid id)
(s/assert ::us/uuid image-id) (s/assert ::us/uuid image-id)
(let [storage media/images-storage (let [filename (fs/name localpath)
filename (fs/name localpath)
[width height] (retrieve-image-size localpath)
extension (second (fs/split-ext filename)) extension (second (fs/split-ext filename))
mimetype (case extension file (io/as-file localpath)
mtype (case extension
".jpg" "image/jpeg" ".jpg" "image/jpeg"
".png" "image/png")] ".png" "image/png"
(-> (st/save storage filename localpath) ".webp" "image/webp")]
(p/then (fn [path]
(db/query-one conn [create-image-sql image-id id (images/create-image conn {:content {:path localpath
filename :name filename
(str path) :mtype mtype
width :size (.length file)}
height :id image-id
mimetype]))) :collection-id id
(p/then (constantly nil))))) :user uuid/zero
:name filename})))
(defn- import-image (defn- import-image
[conn id fpath] [conn id fpath]
@ -218,7 +208,7 @@
(exit! -1)) (exit! -1))
(fs/path path)) (fs/path path))
(defn- read-import-file (defn- read-file
[path] [path]
(let [path (validate-path path) (let [path (validate-path path)
reader (java.io.PushbackReader. (io/reader path))] reader (java.io.PushbackReader. (io/reader path))]
@ -244,7 +234,7 @@
(defn -main (defn -main
[& [path]] [& [path]]
(let [[basedir data] (read-import-file path)] (let [[basedir data] (read-file path)]
(start-system) (start-system)
(-> (db/with-atomic [conn db/pool] (-> (db/with-atomic [conn db/pool]
(importer conn basedir data)) (importer conn basedir data))

View file

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

View file

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

View file

@ -11,15 +11,21 @@
(:require (:require
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[promesa.core :as p] [promesa.core :as p]
[datoteka.core :as fs]
[uxbox.db :as db] [uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.common.exceptions :as ex] [uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us] [uxbox.common.spec :as us]
[uxbox.common.pages :as cp] [uxbox.common.pages :as cp]
[uxbox.services.mutations :as sm] [uxbox.services.mutations :as sm]
[uxbox.services.mutations.projects :as proj] [uxbox.services.mutations.projects :as proj]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.util :as su] [uxbox.services.util :as su]
[uxbox.util.blob :as blob] [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 ;; --- Helpers & Specs
@ -123,7 +129,8 @@
(-> (db/query-one conn [sql id name]) (-> (db/query-one conn [sql id name])
(p/then' su/constantly-nil)))) (p/then' su/constantly-nil))))
;; --- Mutation: Delete Project
;; --- Mutation: Delete Project File
(declare delete-file) (declare delete-file)
@ -147,3 +154,97 @@
(let [sql sql:delete-file] (let [sql sql:delete-file]
(-> (db/query-one conn [sql id]) (-> (db/query-one conn [sql id])
(p/then' su/constantly-nil)))) (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] [uxbox.util.uuid :as uuid]
[vertx.core :as vc])) [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 ::id ::us/uuid)
(s/def ::name ::us/string) (s/def ::name ::us/string)
(s/def ::user ::us/uuid) (s/def ::user ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid)) (s/def ::collection-id (s/nilable ::us/uuid))
(def ^:private images-collections-sql ;; --- Query: Images Collections
(def ^:private sql:collections
"select *, "select *,
(select count(*) from images where collection_id = ic.id) as num_images (select count(*) from images where collection_id = ic.id) as num_images
from image_collections as ic from image_collections as ic
@ -66,9 +42,10 @@
(sq/defquery ::images-collections (sq/defquery ::images-collections
[{:keys [user] :as params}] [{: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 (defn retrieve-image
[conn id] [conn id]
@ -84,10 +61,10 @@
(sq/defquery ::image-by-id (sq/defquery ::image-by-id
[params] [params]
(-> (retrieve-image db/pool (:id params)) (-> (retrieve-image db/pool (:id params))
(p/then populate-thumbnail) (p/then' #(images/resolve-urls % :path :uri))
(p/then populate-urls))) (p/then' #(images/resolve-urls % :thumb-path :thumb-uri))))
;; --- Query Images by Collection (id) ;; --- Query: Images by collection ID
(def sql:images-by-collection (def sql:images-by-collection
"select * from images "select * from images
@ -96,12 +73,7 @@
and deleted_at is null and deleted_at is null
order by created_at desc") order by created_at desc")
(def sql:images-by-collection1 (def sql:images-by-collection
(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
(str "with images as (" sql:images-by-collection ") (str "with images as (" sql:images-by-collection ")
select im.* from images as im select im.* from images as im
where im.collection_id = $2")) where im.collection_id = $2"))
@ -110,12 +82,14 @@
(s/keys :req-un [::user] (s/keys :req-un [::user]
:opt-un [::collection-id])) :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 (sq/defquery ::images-by-collection
[{:keys [user collection-id] :as params}] [{:keys [user collection-id] :as params}]
(let [sqlv (if (nil? collection-id) (let [sqlv [sql:images-by-collection user collection-id]]
[sql:images-by-collection1 user]
[sql:images-by-collection2 user collection-id])]
(-> (db/query db/pool sqlv) (-> (db/query db/pool sqlv)
(p/then populate-thumbnails) (p/then' (fn [rows]
(p/then #(mapv populate-urls %))))) (->> rows
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri))))))))

View file

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

View file

@ -13,6 +13,7 @@
[promesa.core :as p] [promesa.core :as p]
[uxbox.common.spec :as us] [uxbox.common.spec :as us]
[uxbox.db :as db] [uxbox.db :as db]
[uxbox.images :as images]
[uxbox.services.queries :as sq] [uxbox.services.queries :as sq]
[uxbox.services.util :as su] [uxbox.services.util :as su]
[uxbox.util.blob :as blob])) [uxbox.util.blob :as blob]))
@ -27,24 +28,6 @@
(s/def ::file-id ::us/uuid) (s/def ::file-id ::us/uuid)
(s/def ::user ::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 ;; --- Query: Project Files
(declare retrieve-recent-files) (declare retrieve-recent-files)
@ -60,33 +43,77 @@
(retrieve-recent-files db/pool params) (retrieve-recent-files db/pool params)
(retrieve-project-files db/pool params))) (retrieve-project-files db/pool params)))
(def sql:project-files (def ^:private sql:generic-project-files
(str "with files as (" sql:generic-project-files ") "select distinct
select * from files where project_id = $2 pf.*,
order by created_at asc")) 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 (def ^:private sql:project-files
(str "with files as (" sql:generic-project-files ") (str "with files as (" sql:generic-project-files ") "
select * from files "select * from files where project_id = $2"))
order by modified_at desc
limit $2"))
(defn retrieve-project-files (defn retrieve-project-files
[conn {:keys [user project-id]}] [conn {:keys [user project-id]}]
(-> (db/query conn [sql:project-files user project-id]) (-> (db/query conn [sql:project-files user project-id])
(p/then' (partial mapv decode-row)))) (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 (defn retrieve-recent-files
[conn {:keys [user]}] [conn {:keys [user]}]
(-> (db/query conn [sql:recent-files user 20]) (-> (db/query conn [sql:recent-files user 20])
(p/then' (partial mapv decode-row)))) (p/then' (partial mapv decode-row))))
;; --- Query: Project File (By ID) ;; --- Query: Project File (By ID)
(def sql:project-file (def ^:private sql:project-file
(str "with files as (" sql:generic-project-files ") (str "with files as (" sql:generic-project-files ") "
select * from files where id = $2")) "select * from files where id = $2"))
(s/def ::project-file (s/def ::project-file
(s/keys :req-un [::user ::id])) (s/keys :req-un [::user ::id]))
@ -96,36 +123,10 @@
(-> (db/query-one db/pool [sql:project-file user id]) (-> (db/query-one db/pool [sql:project-file user id])
(p/then' decode-row))) (p/then' decode-row)))
;; --- Query: Users of the File ;; --- 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) (declare retrieve-minimal-file)
(declare retrieve-file-users)
(def sql:minimal-file
(str "with files as (" sql:generic-project-files ")
select id, project_id from files where id = $2"))
(s/def ::project-file-users (s/def ::project-file-users
(s/keys :req-un [::user ::file-id])) (s/keys :req-un [::user ::file-id]))
@ -134,20 +135,65 @@
[{:keys [user file-id] :as params}] [{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn db/pool]
(-> (retrieve-minimal-file conn user file-id) (-> (retrieve-minimal-file conn user file-id)
(p/then (fn [{:keys [id project-id]}] (p/then #(retrieve-file-users conn %)))))
(db/query conn [sql:file-users id project-id]))))))
(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 (defn- retrieve-minimal-file
[conn user-id file-id] [conn user-id file-id]
(-> (db/query-one conn [sql:minimal-file user-id file-id]) (-> (db/query-one conn [sql:minimal-file user-id file-id])
(p/then' su/raise-not-found-if-nil))) (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 ;; --- Helpers
(defn decode-row (defn decode-row
[{:keys [metadata pages data] :as row}] [{:keys [pages data] :as row}]
(when row (when row
(cond-> row (cond-> row
data (assoc :data (blob/decode data)) data (assoc :data (blob/decode data))
pages (assoc :pages (vec (remove nil? pages))) pages (assoc :pages (vec (remove nil? pages))))))
metadata (assoc :metadata (blob/decode metadata)))))

View file

@ -164,8 +164,15 @@
(doto (java.security.SecureRandom/getInstance "SHA1PRNG") (doto (java.security.SecureRandom/getInstance "SHA1PRNG")
(.setSeed ^bytes (sodi.prng/random-bytes 64))))) (.setSeed ^bytes (sodi.prng/random-bytes 64)))))
(defn random-path (defn with-xf
[^Path path] [storage xfm]
(let [xf (::xf storage)]
(if (nil? xf)
(assoc storage ::xf xfm)
(assoc storage ::xf (comp xf xfm)))))
(def random-path
(map (fn [^Path path]
(let [name (str (.getFileName path)) (let [name (str (.getFileName path))
hash (-> (sodi.prng/random-bytes @prng 10) hash (-> (sodi.prng/random-bytes @prng 10)
(sodi.util/bytes->b64s)) (sodi.util/bytes->b64s))
@ -174,10 +181,14 @@
rest-tokens (drop 3 tokens) rest-tokens (drop 3 tokens)
path (fs/path path-tokens) path (fs/path path-tokens)
frest (apply str rest-tokens)] frest (apply str rest-tokens)]
(fs/path (list path frest name)))) (fs/path (list path frest name))))))
(defn slugify-filename (def slugify-filename
[path] (map (fn [path]
(let [parent (or (fs/parent path) "") (let [parent (or (fs/parent path) "")
[name ext] (fs/split-ext (fs/name path))] [name ext] (fs/split-ext (fs/name path))]
(fs/path parent (str (str/uslug name) ext)))) (fs/path parent (str (str/uslug name) ext))))))
(defn prefix-path
[prefix]
(map (fn [^Path path] (fs/join (fs/path prefix) path))))

View file

@ -1,5 +1,5 @@
#kaocha/v1 #kaocha/v1
{:tests {:tests
[{:id :unit [{:id :unit
:test-paths ["test" "src"] :test-paths ["tests" "src"]
:ns-patterns ["test-.*"]}]} :ns-patterns ["test-.*"]}]}

View file

@ -19,6 +19,8 @@
[criterium.core :refer [quick-bench bench with-progress-reporting]] [criterium.core :refer [quick-bench bench with-progress-reporting]]
[promesa.core :as p] [promesa.core :as p]
[promesa.exec :as pe] [promesa.exec :as pe]
[uxbox.migrations]
[uxbox.util.storage :as st]
[mount.core :as mount])) [mount.core :as mount]))
;; --- Benchmarking Tools ;; --- Benchmarking Tools
@ -58,7 +60,7 @@
(defn- run-tests (defn- run-tests
([] (run-tests #"^uxbox.tests.*")) ([] (run-tests #"^uxbox.tests.*"))
([o] ([o]
;; (repl/refresh) (repl/refresh)
(cond (cond
(instance? java.util.regex.Pattern o) (instance? java.util.regex.Pattern o)
(test/run-all-tests o) (test/run-all-tests o)

View file

@ -5,17 +5,18 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[mount.core :as mount] [mount.core :as mount]
[environ.core :refer [env]] [environ.core :refer [env]]
[datoteka.storages :as st]
[uxbox.services.mutations.profile :as profile] [uxbox.services.mutations.profile :as profile]
[uxbox.services.mutations.projects :as projects] [uxbox.services.mutations.projects :as projects]
[uxbox.services.mutations.project-files :as files] [uxbox.services.mutations.project-files :as files]
[uxbox.services.mutations.project-pages :as pages] [uxbox.services.mutations.project-pages :as pages]
[uxbox.services.mutations.images :as images]
[uxbox.fixtures :as fixtures] [uxbox.fixtures :as fixtures]
[uxbox.migrations] [uxbox.migrations]
[uxbox.media] [uxbox.media]
[uxbox.db :as db] [uxbox.db :as db]
[uxbox.util.blob :as blob] [uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid] [uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[uxbox.config :as cfg])) [uxbox.config :as cfg]))
(defn state-init (defn state-init
@ -28,9 +29,7 @@
#'uxbox.services.init/mutation-services #'uxbox.services.init/mutation-services
#'uxbox.migrations/migrations #'uxbox.migrations/migrations
#'uxbox.media/assets-storage #'uxbox.media/assets-storage
#'uxbox.media/media-storage #'uxbox.media/media-storage})
#'uxbox.media/images-storage
#'uxbox.media/thumbnails-storage})
(mount/swap {#'uxbox.config/config config}) (mount/swap {#'uxbox.config/config config})
(mount/start)) (mount/start))
(try (try
@ -55,8 +54,8 @@
(try (try
(next) (next)
(finally (finally
(st/clear! uxbox.media/media-storage) (ust/clear! uxbox.media/media-storage)
(st/clear! uxbox.media/assets-storage)))) (ust/clear! uxbox.media/assets-storage))))
(defn mk-uuid (defn mk-uuid
[prefix & args] [prefix & args]
@ -96,10 +95,17 @@
:file-id file-id :file-id file-id
:name (str "page" i) :name (str "page" i)
:ordering i :ordering i
:data {:shapes [] :data {:version 1
:shapes []
:options {}
:canvas [] :canvas []
:shapes-by-id {}} :shapes-by-id {}}}))
:metadata {}}))
(defn create-images-collection
[conn user-id i]
(images/create-images-collection conn {:id (mk-uuid "imgcoll" i)
:user user-id
:name (str "image collection " i)}))
(defn handle-error (defn handle-error
[err] [err]

View file

@ -1,176 +1,158 @@
(ns uxbox.tests.test-images (ns uxbox.tests.test-images
#_(:require [clojure.test :as t] (:require
[clojure.test :as t]
[promesa.core :as p] [promesa.core :as p]
[suricatta.core :as sc] [datoteka.core :as fs]
[clojure.java.io :as io] [clojure.java.io :as io]
[datoteka.storages :as st]
[uxbox.db :as db] [uxbox.db :as db]
[uxbox.sql :as sql] [uxbox.core :refer [system]]
[uxbox.media :as media] [uxbox.services.mutations :as sm]
[uxbox.http :as http] [uxbox.services.queries :as sq]
[uxbox.services.images :as images] [uxbox.util.storage :as ust]
[uxbox.services :as usv] [uxbox.util.uuid :as uuid]
[uxbox.tests.helpers :as th])) [uxbox.tests.helpers :as th]
[vertx.core :as vc]))
;; (t/use-fixtures :once th/state-init) (t/use-fixtures :once th/state-init)
;; (t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
;; (t/deftest test-http-list-image-collections (t/deftest images-collections-crud
;; (with-open [conn (db/connection)] (let [id (uuid/next)
;; (let [user (th/create-user conn 1) user @(th/create-user db/pool 2)]
;; data {:user (:id user)
;; :name "coll1"}
;; coll (images/create-collection conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/image-collections")
;; [status data] (th/http-get user uri)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 200 status))
;; (t/is (= 1 (count data))))))))
;; (t/deftest test-http-create-image-collection (t/testing "create collection"
;; (with-open [conn (db/connection)] (let [data {::sm/type :create-images-collection
;; (let [user (th/create-user conn 1)] :name "sample collection"
;; (th/with-server {:handler @http/app} :user (:id user)
;; (let [uri (str th/+base-url+ "/api/library/image-collections") :id id}
;; data {:user (:id user) out (th/try-on! (sm/handle data))]
;; :name "coll1"}
;; params {:body data}
;; [status data] (th/http-post user uri params)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 201 status))
;; (t/is (= (:user data) (:id user)))
;; (t/is (= (:name data) "coll1")))))))
;; (t/deftest test-http-update-image-collection ;; (th/print-result! out)
;; (with-open [conn (db/connection)] (t/is (nil? (:error out)))
;; (let [user (th/create-user conn 1) (t/is (= (:id user) (get-in out [:result :user-id])))
;; data {:user (:id user) (t/is (= (:name data) (get-in out [:result :name])))))
;; :name "coll1"}
;; coll (images/create-collection conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll))
;; params {:body (assoc coll :name "coll2")}
;; [status data] (th/http-put user uri params)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 200 status))
;; (t/is (= (:user data) (:id user)))
;; (t/is (= (:name data) "coll2")))))))
;; (t/deftest test-http-image-collection-delete (t/testing "update collection"
;; (with-open [conn (db/connection)] (let [data {::sm/type :rename-images-collection
;; (let [user (th/create-user conn 1) :name "sample collection renamed"
;; data {:user (:id user) :user (:id user)
;; :name "coll1" :id id}
;; :data #{1}} out (th/try-on! (sm/handle data))]
;; coll (images/create-collection conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll))
;; [status data] (th/http-delete user uri)]
;; (t/is (= 204 status))
;; (let [sqlv (sql/get-image-collections {:user (:id user)})
;; result (sc/fetch conn sqlv)]
;; (t/is (empty? result))))))))
;; (t/deftest test-http-create-image ;; (th/print-result! out)
;; (with-open [conn (db/connection)] (t/is (nil? (:error out)))
;; (let [user (th/create-user conn 1)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/images")
;; parts [{:name "sample.jpg"
;; :part-name "file"
;; :content (io/input-stream
;; (io/resource "uxbox/tests/_files/sample.jpg"))}
;; {:part-name "user" :content (str (:id user))}
;; {:part-name "width" :content "100"}
;; {:part-name "height" :content "100"}
;; {:part-name "mimetype" :content "image/png"}]
;; [status data] (th/http-multipart user uri parts)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 201 status))
;; (t/is (= (:user data) (:id user)))
;; (t/is (= (:name data) "sample.jpg")))))))
;; (t/deftest test-http-update-image (t/is (= id (get-in out [:result :id])))
;; (with-open [conn (db/connection)] (t/is (= (:id user) (get-in out [:result :user-id])))
;; (let [user (th/create-user conn 1) (t/is (= (:name data) (get-in out [:result :name])))))
;; data {:user (:id user)
;; :name "test.png"
;; :path "some/path"
;; :width 100
;; :height 100
;; :mimetype "image/png"
;; :collection nil}
;; img (images/create-image conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img))
;; params {:body (assoc img :name "my stuff")}
;; [status data] (th/http-put user uri params)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 200 status))
;; (t/is (= (:user data) (:id user)))
;; (t/is (= (:name data) "my stuff")))))))
;; (t/deftest test-http-copy-image (t/testing "query collections"
;; (with-open [conn (db/connection)] (let [data {::sq/type :images-collections
;; (let [user (th/create-user conn 1) :user (:id user)}
;; storage media/images-storage out (th/try-on! (sq/handle data))]
;; filename "sample.jpg"
;; rcs (io/resource "uxbox/tests/_files/sample.jpg")
;; path @(st/save storage filename rcs)
;; data {:user (:id user)
;; :name filename
;; :path (str path)
;; :width 100
;; :height 100
;; :mimetype "image/jpg"
;; :collection nil}
;; img (images/create-image conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img) "/copy")
;; body {:id (:id img)
;; :collection nil}
;; params {:body body}
;; [status data] (th/http-put user uri params)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 200 status))
;; (let [sqlv (sql/get-images {:user (:id user) :collection nil})
;; result (sc/fetch conn sqlv)]
;; (t/is (= 2 (count result)))))))))
;; (t/deftest test-http-delete-image ;; (th/print-result! out)
;; (with-open [conn (db/connection)] (t/is (nil? (:error out)))
;; (let [user (th/create-user conn 1)
;; data {:user (:id user) (t/is (= 1 (count (:result out))))
;; :name "test.png" (t/is (= (:id user) (get-in out [:result 0 :user-id])))
;; :path "some/path" (t/is (= id (get-in out [:result 0 :id])))))
;; :width 100
;; :height 100 (t/testing "delete collection"
;; :mimetype "image/png" (let [data {::sm/type :delete-images-collection
;; :collection nil} :user (:id user)
;; img (images/create-image conn data)] :id id}
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img)) out (th/try-on! (sm/handle data))]
;; [status data] (th/http-delete user uri)]
;; (t/is (= 204 status)) ;; (th/print-result! out)
;; (let [sqlv (sql/get-images {:user (:id user) :collection nil}) (t/is (nil? (:error out)))
;; result (sc/fetch conn sqlv)] (t/is (= id (get-in out [:result :id])))))
;; (t/is (empty? result))))))))
(t/testing "query collections after delete"
(let [data {::sq/type :images-collections
:user (:id user)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= 0 (count (:result out))))))
))
(t/deftest images-crud
(let [user @(th/create-user db/pool 1)
coll @(th/create-images-collection db/pool (:id user) 1)
image-id (uuid/next)]
(t/testing "upload image to collection"
(let [content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
:size 312043}
data {::sm/type :upload-image
:id image-id
:user (:id user)
:collection-id (:id coll)
:name "testfile"
:content content}
out (th/try-on! (sm/handle data))]
;; out (with-redefs [vc/*context* (vc/get-or-create-context system)]
;; (th/try-on! (sm/handle data)))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= image-id (get-in out [:result :id])))
(t/is (= "testfile" (get-in out [:result :name])))
(t/is (= "image/jpeg" (get-in out [:result :mtype])))
(t/is (= "image/webp" (get-in out [:result :thumb-mtype])))
(t/is (= 800 (get-in out [:result :width])))
(t/is (= 800 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
(t/testing "list images by collection"
(let [data {::sq/type :images-by-collection
:user (:id user)
:collection-id (:id coll)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (= image-id (get-in out [:result 0 :id])))
(t/is (= "testfile" (get-in out [:result 0 :name])))
(t/is (= "image/jpeg" (get-in out [:result 0 :mtype])))
(t/is (= "image/webp" (get-in out [:result 0 :thumb-mtype])))
(t/is (= 800 (get-in out [:result 0 :width])))
(t/is (= 800 (get-in out [:result 0 :height])))
(t/is (string? (get-in out [:result 0 :path])))
(t/is (string? (get-in out [:result 0 :thumb-path])))
(t/is (string? (get-in out [:result 0 :uri])))
(t/is (string? (get-in out [:result 0 :thumb-uri])))))
(t/testing "get image by id"
(let [data {::sq/type :image-by-id
:user (:id user)
:id image-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (= image-id (get-in out [:result :id])))
(t/is (= "testfile" (get-in out [:result :name])))
(t/is (= "image/jpeg" (get-in out [:result :mtype])))
(t/is (= "image/webp" (get-in out [:result :thumb-mtype])))
(t/is (= 800 (get-in out [:result :width])))
(t/is (= 800 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
))
;; TODO: (soft) delete image
;; (t/deftest test-http-list-images
;; (with-open [conn (db/connection)]
;; (let [user (th/create-user conn 1)
;; data {:user (:id user)
;; :name "test.png"
;; :path "some/path"
;; :width 100
;; :height 100
;; :mimetype "image/png"
;; :collection nil}
;; img (images/create-image conn data)]
;; (th/with-server {:handler @http/app}
;; (let [uri (str th/+base-url+ "/api/library/images")
;; [status data] (th/http-get user uri)]
;; ;; (println "RESPONSE:" status data)
;; (t/is (= 200 status))
;; (t/is (= 1 (count data))))))))

View file

@ -31,7 +31,7 @@
(let [error (ex-cause (:error out))] (let [error (ex-cause (:error out))]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation)) (t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :uxbox.services.mutations.auth/wrong-credentials))))) (t/is (th/ex-of-code? error :uxbox.services.mutations.profile/wrong-credentials)))))
(t/deftest success-auth (t/deftest success-auth
(let [user @(th/create-user db/pool 1) (let [user @(th/create-user db/pool 1)

View file

@ -2,11 +2,17 @@
(:require (:require
[clojure.test :as t] [clojure.test :as t]
[promesa.core :as p] [promesa.core :as p]
[datoteka.core :as fs]
[uxbox.db :as db] [uxbox.db :as db]
[uxbox.media :as media]
[uxbox.core :refer [system]]
[uxbox.http :as http] [uxbox.http :as http]
[uxbox.services.mutations :as sm] [uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq] [uxbox.services.queries :as sq]
[uxbox.tests.helpers :as th])) [uxbox.tests.helpers :as th]
[uxbox.util.storage :as ust]
[uxbox.util.uuid :as uuid]
[vertx.core :as vc]))
(t/use-fixtures :once th/state-init) (t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
@ -40,7 +46,7 @@
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= (:name data) (get-in out [:result :name]))) (t/is (= (:name data) (get-in out [:result :name])))
#_(t/is (= (:project-id data) (get-in out [:result :project-id]))))) (t/is (= (:project-id data) (get-in out [:result :project-id])))))
(t/deftest mutation-rename-project-file (t/deftest mutation-rename-project-file
(let [user @(th/create-user db/pool 1) (let [user @(th/create-user db/pool 1)
@ -73,4 +79,78 @@
res @(db/query db/pool [sql (:id proj)])] res @(db/query db/pool [sql (:id proj)])]
(t/is (empty? res))))) (t/is (empty? res)))))
;; ;; TODO: add permisions related tests (t/deftest mutation-upload-file-image
(let [user @(th/create-user db/pool 1)
proj @(th/create-project db/pool (:id user) 1)
pf @(th/create-project-file db/pool (:id user) (:id proj) 1)
content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
:size 312043}
data {::sm/type :upload-project-file-image
:user (:id user)
:file-id (:id pf)
:name "testfile"
:content content
:width 800
:height 800}
out (with-redefs [vc/*context* (vc/get-or-create-context system)]
(th/try-on! (sm/handle data)))]
;; (th/print-result! out)
(t/is (= (:id pf) (get-in out [:result :file-id])))
(t/is (= (:name data) (get-in out [:result :name])))
(t/is (= (:width data) (get-in out [:result :width])))
(t/is (= (:height data) (get-in out [:result :height])))
(t/is (= (:mimetype data) (get-in out [:result :mimetype])))
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
(t/deftest mutation-import-image-file-from-collection
(let [user @(th/create-user db/pool 1)
proj @(th/create-project db/pool (:id user) 1)
pf @(th/create-project-file db/pool (:id user) (:id proj) 1)
coll @(th/create-images-collection db/pool (:id user) 1)
image-id (uuid/next)
content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
:size 312043}
data {::sm/type :upload-image
:id image-id
:user (:id user)
:collection-id (:id coll)
:name "testfile"
:content content}
out1 (th/try-on! (sm/handle data))]
;; (th/print-result! out1)
(t/is (nil? (:error out1)))
(t/is (= image-id (get-in out1 [:result :id])))
(t/is (= "testfile" (get-in out1 [:result :name])))
(t/is (= "image/jpeg" (get-in out1 [:result :mtype])))
(t/is (= "image/webp" (get-in out1 [:result :thumb-mtype])))
(let [data2 {::sm/type :import-image-to-file
:image-id image-id
:file-id (:id pf)
:user (:id user)}
out2 (th/try-on! (sm/handle data2))]
;; (th/print-result! out2)
(t/is (nil? (:error out2)))
(t/is (not= (get-in out2 [:result :path])
(get-in out1 [:result :path])))
(t/is (not= (get-in out2 [:result :thumb-path])
(get-in out1 [:result :thumb-path]))))))

View file

@ -36,9 +36,9 @@
data {::sm/type :create-project-page data {::sm/type :create-project-page
:data {:canvas [] :data {:canvas []
:options {}
:shapes [] :shapes []
:shapes-by-id {}} :shapes-by-id {}}
:metadata {}
:file-id (:id pf) :file-id (:id pf)
:ordering 1 :ordering 1
:name "test page" :name "test page"
@ -50,7 +50,6 @@
(t/is (= (:user data) (get-in out [:result :user-id]))) (t/is (= (:user data) (get-in out [:result :user-id])))
(t/is (= (:name data) (get-in out [:result :name]))) (t/is (= (:name data) (get-in out [:result :name])))
(t/is (= (:data data) (get-in out [:result :data]))) (t/is (= (:data data) (get-in out [:result :data])))
(t/is (= (:metadata data) (get-in out [:result :metadata])))
(t/is (= 0 (get-in out [:result :version]))))) (t/is (= 0 (get-in out [:result :version])))))
(t/deftest mutation-update-project-page-data (t/deftest mutation-update-project-page-data
@ -61,6 +60,7 @@
data {::sm/type :update-project-page-data data {::sm/type :update-project-page-data
:id (:id page) :id (:id page)
:data {:shapes [(uuid/next)] :data {:shapes [(uuid/next)]
:options {}
:canvas [] :canvas []
:shapes-by-id {}} :shapes-by-id {}}
:file-id (:id file) :file-id (:id file)
@ -85,7 +85,7 @@
:id (:id page) :id (:id page)
:version 99 :version 99
:user (:id user) :user (:id user)
:operations []} :changes []}
out (th/try-on! (sm/handle data))] out (th/try-on! (sm/handle data))]
@ -111,18 +111,21 @@
:id (:id page) :id (:id page)
:version 0 :version 0
:user (:id user) :user (:id user)
:operations [[:add-shape sid {:id sid :type :rect}]]} :changes [{:type :add-shape
:id sid
:session-id (uuid/next)
:shape {:id sid
:name "Rect"
:type :rect}}]}
out (th/try-on! (sm/handle data))] out (th/try-on! (sm/handle data))]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= 0 (count (:result out))))
;; (t/is (= 1 (count (:result out)))) (t/is (= 1 (get-in out [:result :version])))
;; (t/is (= (:id data) (get-in out [:result 0 :page-id]))) (t/is (= (:id page) (get-in out [:result :page-id])))
;; (t/is (= 1 (count (get-in out [:result 0 :operations])))) (t/is (= :add-shape (get-in out [:result :changes 0 :type])))
;; (t/is (= :add-shape (get-in out [:result 0 :operations 0 0])))
;; (t/is (= sid (get-in out [:result 0 :operations 0 1])))
)) ))
(t/deftest mutation-update-project-page-3 (t/deftest mutation-update-project-page-3
@ -132,11 +135,17 @@
page @(th/create-project-page db/pool (:id user) (:id file) 1) page @(th/create-project-page db/pool (:id user) (:id file) 1)
sid (uuid/next) sid (uuid/next)
data {::sm/type :update-project-page data {::sm/type :update-project-page
:id (:id page) :id (:id page)
:version 0 :version 0
:user (:id user) :user (:id user)
:operations [[:add-shape sid {:id sid :type :rect}]]} :changes [{:type :add-shape
:id sid
:session-id (uuid/next)
:shape {:id sid
:name "Rect"
:type :rect}}]}
out1 (th/try-on! (sm/handle data)) out1 (th/try-on! (sm/handle data))
out2 (th/try-on! (sm/handle data))] out2 (th/try-on! (sm/handle data))]
@ -146,12 +155,12 @@
(t/is (nil? (:error out1))) (t/is (nil? (:error out1)))
(t/is (nil? (:error out2))) (t/is (nil? (:error out2)))
(t/is (= 0 (count (:result out1))))
(t/is (= 1 (count (:result out2)))) (t/is (= 1 (count (get-in out1 [:result :changes]))))
(t/is (= (:id data) (get-in out2 [:result 0 :page-id]))) (t/is (= 2 (count (get-in out2 [:result :changes]))))
(t/is (= 1 (count (get-in out2 [:result 0 :operations]))))
(t/is (= :add-shape (get-in out2 [:result 0 :operations 0 0]))) (t/is (= (:id data) (get-in out1 [:result :page-id])))
(t/is (= sid (get-in out2 [:result 0 :operations 0 1]))) (t/is (= (:id data) (get-in out2 [:result :page-id])))
)) ))
(t/deftest mutation-delete-project-page (t/deftest mutation-delete-project-page

View file

@ -32,8 +32,7 @@
::sm/type :update-profile ::sm/type :update-profile
:fullname "Full Name" :fullname "Full Name"
:username "user222" :username "user222"
:metadata {:foo "bar"} :lang "en")
:email "user222@uxbox.io")
out (th/try-on! (sm/handle data))] out (th/try-on! (sm/handle data))]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -43,20 +42,20 @@
(t/is (= (:metadata data) (get-in out [:result :metadata]))) (t/is (= (:metadata data) (get-in out [:result :metadata])))
(t/is (not (contains? (:result out) :password))))) (t/is (not (contains? (:result out) :password)))))
(t/deftest test-mutation-update-profile-photo ;; (t/deftest test-mutation-update-profile-photo
(let [user @(th/create-user db/pool 1) ;; (let [user @(th/create-user db/pool 1)
data {::sm/type :update-profile-photo ;; data {::sm/type :update-profile-photo
:user (:id user) ;; :user (:id user)
:file {:name "sample.jpg" ;; :file {:name "sample.jpg"
:path (fs/path "test/uxbox/tests/_files/sample.jpg") ;; :path (fs/path "test/uxbox/tests/_files/sample.jpg")
:size 123123 ;; :size 123123
:mtype "image/jpeg"}} ;; :mtype "image/jpeg"}}
out (th/try-on! (sm/handle data))] ;; out (th/try-on! (sm/handle data))]
;; (th/print-result! out) ;; ;; (th/print-result! out)
(t/is (nil? (:error out))) ;; (t/is (nil? (:error out)))
(t/is (= (:id user) (get-in out [:result :id]))) ;; (t/is (= (:id user) (get-in out [:result :id])))
(t/is (str/starts-with? (get-in out [:result :photo]) "http")))) ;; (t/is (str/starts-with? (get-in out [:result :photo]) "http"))))
;; (t/deftest test-mutation-register-profile ;; (t/deftest test-mutation-register-profile
;; (let[data {:fullname "Full Name" ;; (let[data {:fullname "Full Name"

View file

@ -10,12 +10,13 @@
[beicon.core :as rx] [beicon.core :as rx]
[cuerdas.core :as str] [cuerdas.core :as str]
[potok.core :as ptk] [potok.core :as ptk]
[uxbox.common.spec :as us]
[uxbox.common.data :as d]
[uxbox.main.repo :as rp] [uxbox.main.repo :as rp]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.util.data :refer (jscoll->vec)]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.files :as files] [uxbox.util.webapi :as wapi]
[uxbox.util.i18n :refer [tr]] [uxbox.util.i18n :as i18n :refer [t tr]]
[uxbox.util.router :as r] [uxbox.util.router :as r]
[uxbox.util.uuid :as uuid])) [uxbox.util.uuid :as uuid]))
@ -24,14 +25,7 @@
(s/def ::created-at inst?) (s/def ::created-at inst?)
(s/def ::modified-at inst?) (s/def ::modified-at inst?)
(s/def ::user-id uuid?) (s/def ::user-id uuid?)
(s/def ::collection-id ::us/uuid)
;; (s/def ::collection-id (s/nilable ::us/uuid))
;; (s/def ::mimetype string?)
;; (s/def ::thumbnail us/url-str?)
;; (s/def ::width number?)
;; (s/def ::height number?)
;; (s/def ::url us/url-str?)
(s/def ::collection (s/def ::collection
(s/keys :req-un [::id (s/keys :req-un [::id
@ -40,6 +34,32 @@
::modified-at ::modified-at
::user-id])) ::user-id]))
(declare fetch-icons)
(defn initialize
[collection-id]
(s/assert ::us/uuid collection-id)
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:dashboard-icons :selected] #{}))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (fetch-icons collection-id)))))
;; --- Fetch Collections
(declare collections-fetched)
(def fetch-collections
(ptk/reify ::fetch-collections
ptk/WatchEvent
(watch [_ state s]
(->> (rp/query! :icons-collections)
(rx/map collections-fetched)))))
;; --- Collections Fetched ;; --- Collections Fetched
(defn collections-fetched (defn collections-fetched
@ -58,14 +78,20 @@
state state
items)))) items))))
;; --- Fetch Collections
(def fetch-collections ;; --- Create Collection
(ptk/reify ::fetch-collections
(declare collection-created)
(def create-collection
(ptk/reify ::create-collection
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(->> (rp/query! :icons-collections) (let [name (tr "ds.default-library-title" (gensym "c"))
(rx/map collections-fetched))))) data {:name name}]
(->> (rp/mutation! :create-icons-collection data)
(rx/map collection-created))))))
;; --- Collection Created ;; --- Collection Created
@ -78,70 +104,35 @@
(let [{:keys [id] :as item} (assoc item :type :own)] (let [{:keys [id] :as item} (assoc item :type :own)]
(update state :icons-collections assoc id item))))) (update state :icons-collections assoc id item)))))
;; --- Create Collection
(def create-collection
(ptk/reify ::create-collection
ptk/WatchEvent
(watch [_ state s]
(let [name (tr "ds.default-library-title" (gensym "c"))
data {:name name}]
(->> (rp/mutation! :create-icons-collection data)
(rx/map collection-created))))))
;; --- Collection Updated
(defn collection-updated
[item]
(ptk/reify ::collection-updated
ptk/UpdateEvent
(update [_ state]
(update-in state [:icons-collections (:id item)] merge item))))
;; --- Update Collection
(defrecord UpdateCollection [id]
ptk/WatchEvent
(watch [_ state s]
(let [data (get-in state [:icons-collections id])]
(->> (rp/mutation! :update-icons-collection data)
(rx/map collection-updated)))))
(defn update-collection
[id]
(UpdateCollection. id))
;; --- Rename Collection ;; --- Rename Collection
(defrecord RenameCollection [id name] (defn rename-collection
[id name]
(ptk/reify ::rename-collection
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc-in state [:icons-collections id :name] name)) (assoc-in state [:icons-collections id :name] name))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(rx/of (update-collection id)))) (let [params {:id id :name name}]
(->> (rp/mutation! :rename-icons-collection params)
(defn rename-collection (rx/ignore))))))
[id name]
(RenameCollection. id name))
;; --- Delete Collection ;; --- Delete Collection
(defrecord DeleteCollection [id] (defn delete-collection
[id on-success]
(ptk/reify ::delete-collection
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(update state :icons-collections dissoc id)) (update state :icons-collections dissoc id))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(let [type (get-in state [:dashboard :icons :type])]
(->> (rp/mutation! :delete-icons-collection {:id id}) (->> (rp/mutation! :delete-icons-collection {:id id})
(rx/map #(r/nav :dashboard-icons {:type type})))))) (rx/tap on-success)
(rx/ignore)))))
(defn delete-collection
[id]
(DeleteCollection. id))
;; --- Icon Created ;; --- Icon Created
@ -157,9 +148,11 @@
;; --- Create Icon ;; --- Create Icon
(declare icon-created)
(defn- parse-svg (defn- parse-svg
[data] [data]
{:pre [(string? data)]} (s/assert ::us/string data)
(let [valid-tags #{"defs" "path" "circle" "rect" "metadata" "g" (let [valid-tags #{"defs" "path" "circle" "rect" "metadata" "g"
"radialGradient" "stop"} "radialGradient" "stop"}
div (dom/create-element "div") div (dom/create-element "div")
@ -194,7 +187,7 @@
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(letfn [(parse [file] (letfn [(parse [file]
(->> (files/read-as-text file) (->> (wapi/read-file-as-text file)
(rx/map parse-svg))) (rx/map parse-svg)))
(allowed? [file] (allowed? [file]
(= (.-type file) "image/svg+xml")) (= (.-type file) "image/svg+xml"))
@ -207,7 +200,7 @@
:metadata metadata})] :metadata metadata})]
(->> (rx/from files) (->> (rx/from files)
(rx/filter allowed?) (rx/filter allowed?)
(rx/flat-map parse) (rx/merge-map parse)
(rx/map prepare) (rx/map prepare)
(rx/flat-map #(rp/mutation! :create-icon %)) (rx/flat-map #(rp/mutation! :create-icon %))
(rx/map icon-created)))))) (rx/map icon-created))))))
@ -226,184 +219,158 @@
;; --- Persist Icon ;; --- Persist Icon
(defrecord PersistIcon [id] (defn persist-icon
[id]
(s/assert ::us/uuid id)
(ptk/reify ::persist-icon
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [data (get-in state [:icons id])] (let [data (get-in state [:icons id])]
(->> (rp/mutation! :update-icon data) (->> (rp/mutation! :update-icon data)
(rx/map icon-persisted))))) (rx/ignore))))))
(defn persist-icon
[id]
{:pre [(uuid? id)]}
(PersistIcon. id))
;; --- Icons Fetched
(defrecord IconsFetched [items]
ptk/UpdateEvent
(update [_ state]
(reduce (fn [state {:keys [id] :as icon}]
(let [icon (assoc icon :type :icon)]
(assoc-in state [:icons id] icon)))
state
items)))
(defn icons-fetched
[items]
(IconsFetched. items))
;; --- Load Icons ;; --- Load Icons
(defrecord FetchIcons [id] (declare icons-fetched)
(defn fetch-icons
[id]
(ptk/reify ::fetch-icons
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(let [params (cond-> {} id (assoc :collection-id id))] (let [params (cond-> {} id (assoc :collection-id id))]
(->> (rp/query! :icons-by-collection params) (->> (rp/query! :icons-by-collection params)
(rx/map icons-fetched))))) (rx/map icons-fetched))))))
(defn fetch-icons ;; --- Icons Fetched
[id]
{:pre [(or (uuid? id) (nil? id))]}
(FetchIcons. id))
;; --- Delete Icons (defn icons-fetched
[items]
(defrecord DeleteIcon [id] ;; TODO: specs
(ptk/reify ::icons-fetched
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(-> state (let [icons (d/index-by :id items)]
(update :icons dissoc id) (assoc state :icons icons)))))
(update-in [:dashboard :icons :selected] disj id)))
ptk/WatchEvent
(watch [_ state s]
(->> (rp/mutation! :delete-icon {:id id})
(rx/ignore))))
(defn delete-icon
[id]
{:pre [(uuid? id)]}
(DeleteIcon. id))
;; --- Rename Icon ;; --- Rename Icon
(defrecord RenameIcon [id name] (defn rename-icon
[id name]
(s/assert ::us/uuid id)
(s/assert ::us/string name)
(ptk/reify ::rename-icon
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc-in state [:icons id :name] name)) (assoc-in state [:icons id :name] name))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(rx/of (persist-icon id)))) (rx/of (persist-icon id)))))
(defn rename-icon ;; --- Icon Selection
[id name]
{:pre [(uuid? id) (string? name)]}
(RenameIcon. id name))
;; --- Select icon (defn select-icon
[id]
(defrecord SelectIcon [id] (ptk/reify ::select-icon
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(update-in state [:dashboard :icons :selected] conj id))) (update-in state [:dashboard-icons :selected] (fnil conj #{}) id))))
(defrecord DeselectIcon [id]
ptk/UpdateEvent
(update [_ state]
(update-in state [:dashboard :icons :selected] disj id)))
(defrecord ToggleIconSelection [id]
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:dashboard :icons :selected])]
(rx/of
(if (selected id)
(DeselectIcon. id)
(SelectIcon. id))))))
(defn deselect-icon (defn deselect-icon
[id] [id]
{:pre [(uuid? id)]} (ptk/reify ::deselect-icon
(DeselectIcon. id))
(defn toggle-icon-selection
[id]
(ToggleIconSelection. id))
;; --- Copy Selected Icon
(defrecord CopySelected [id]
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:dashboard :icons :selected])]
(rx/merge
(->> (rx/from selected)
(rx/map #(get-in state [:icons %]))
(rx/map #(dissoc % :id))
(rx/map #(assoc % :collection-id id))
(rx/flat-map #(rp/mutation :create-icon %))
(rx/map :payload)
(rx/map icon-created))
(->> (rx/from selected)
(rx/map deselect-icon))))))
(defn copy-selected
[id]
{:pre [(or (uuid? id) (nil? id))]}
(CopySelected. id))
;; --- Move Selected Icon
(defrecord MoveSelected [id]
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [selected (get-in state [:dashboard :icons :selected])] (update-in state [:dashboard-icons :selected] (fnil disj #{}) id))))
(reduce (fn [state icon]
(assoc-in state [:icons icon :collection] id)) (def deselect-all-icons
state (ptk/reify ::deselect-all-icons
selected))) ptk/UpdateEvent
(update [_ state]
(assoc-in state [:dashboard-icons :selected] #{}))))
;; --- Delete Icons
(defn delete-icon
[id]
(ptk/reify ::delete-icon
ptk/UpdateEvent
(update [_ state]
(update state :icons dissoc id))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state s]
(let [selected (get-in state [:dashboard :icons :selected])]
(rx/merge (rx/merge
(->> (rx/from selected) (rx/of deselect-all-icons)
(rx/map persist-icon)) (->> (rp/mutation! :delete-icon {:id id})
(->> (rx/from selected) (rx/ignore))))))
(rx/map deselect-icon))))))
(defn move-selected
[id]
{:pre [(or (uuid? id) (nil? id))]}
(MoveSelected. id))
;; --- Delete Selected ;; --- Delete Selected
(defrecord DeleteSelected [] (def delete-selected
(ptk/reify ::delete-selected
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [selected (get-in state [:dashboard :icons :selected])] (let [selected (get-in state [:dashboard-icons :selected])]
(->> (rx/from selected) (->> (rx/from selected)
(rx/map delete-icon))))) (rx/map delete-icon))))))
(defn delete-selected
[]
(DeleteSelected.))
;; --- Update Opts (Filtering & Ordering) ;; --- Update Opts (Filtering & Ordering)
(defrecord UpdateOpts [order filter edition]
ptk/UpdateEvent
(update [_ state]
(update-in state [:dashboard :icons] merge
{:edition edition}
(when order {:order order})
(when filter {:filter filter}))))
(defn update-opts (defn update-opts
[& {:keys [order filter edition] [& {:keys [order filter edition]
:or {edition false} :or {edition false}}]
:as opts}] (ptk/reify ::update-opts
(UpdateOpts. order filter edition)) ptk/UpdateEvent
(update [_ state]
(update state :dashboard-icons merge
{:edition edition}
(when order {:order order})
(when filter {:filter filter})))))
;; --- Copy Selected Icon
;; (defrecord CopySelected [id]
;; ptk/WatchEvent
;; (watch [_ state stream]
;; (let [selected (get-in state [:dashboard :icons :selected])]
;; (rx/merge
;; (->> (rx/from selected)
;; (rx/map #(get-in state [:icons %]))
;; (rx/map #(dissoc % :id))
;; (rx/map #(assoc % :collection-id id))
;; (rx/flat-map #(rp/mutation :create-icon %))
;; (rx/map :payload)
;; (rx/map icon-created))
;; (->> (rx/from selected)
;; (rx/map deselect-icon))))))
;; (defn copy-selected
;; [id]
;; {:pre [(or (uuid? id) (nil? id))]}
;; (CopySelected. id))
;; --- Move Selected Icon
;; (defrecord MoveSelected [id]
;; ptk/UpdateEvent
;; (update [_ state]
;; (let [selected (get-in state [:dashboard :icons :selected])]
;; (reduce (fn [state icon]
;; (assoc-in state [:icons icon :collection] id))
;; state
;; selected)))
;; ptk/WatchEvent
;; (watch [_ state stream]
;; (let [selected (get-in state [:dashboard :icons :selected])]
;; (rx/merge
;; (->> (rx/from selected)
;; (rx/map persist-icon))
;; (->> (rx/from selected)
;; (rx/map deselect-icon))))))
;; (defn move-selected
;; [id]
;; {:pre [(or (uuid? id) (nil? id))]}
;; (MoveSelected. id))

View file

@ -11,11 +11,11 @@
[beicon.core :as rx] [beicon.core :as rx]
[potok.core :as ptk] [potok.core :as ptk]
[uxbox.common.spec :as us] [uxbox.common.spec :as us]
[uxbox.common.data :as d]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.repo :as rp] [uxbox.main.repo :as rp]
[uxbox.util.i18n :refer [tr]] [uxbox.util.i18n :refer [tr]]
[uxbox.util.router :as rt] [uxbox.util.router :as rt]
[uxbox.util.data :refer (jscoll->vec)]
[uxbox.util.uuid :as uuid] [uxbox.util.uuid :as uuid]
[uxbox.util.time :as ts] [uxbox.util.time :as ts]
[uxbox.util.router :as r] [uxbox.util.router :as r]
@ -28,38 +28,66 @@
(s/def ::height number?) (s/def ::height number?)
(s/def ::modified-at inst?) (s/def ::modified-at inst?)
(s/def ::created-at inst?) (s/def ::created-at inst?)
(s/def ::mimetype string?) (s/def ::mtype string?)
(s/def ::thumbnail string?) (s/def ::thumbnail string?)
(s/def ::id uuid?) (s/def ::id uuid?)
(s/def ::url string?) (s/def ::url string?)
(s/def ::collection-id (s/nilable uuid?)) (s/def ::collection-id uuid?)
(s/def ::user-id uuid?) (s/def ::user-id uuid?)
(s/def ::collection-entity (s/def ::collection
(s/keys :req-un [::id (s/keys :req-un [::id
::name ::name
::created-at ::created-at
::modified-at ::modified-at
::user-id])) ::user-id]))
(s/def ::image-entity (s/def ::image
(s/keys :opt-un [::collection-id] (s/keys :req-un [::id
:req-un [::id
::name ::name
::width ::width
::height ::height
::mtype
::collection-id
::created-at ::created-at
::modified-at ::modified-at
::mimetype ::uri
::thumbnail ::thumb-uri
::url
::user-id])) ::user-id]))
;; --- Initialize Collection Page
(declare fetch-images)
(defn initialize
[collection-id]
(us/verify ::us/uuid collection-id)
(ptk/reify ::initialize
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:dashboard-images :selected] #{}))
ptk/WatchEvent
(watch [_ state stream]
(rx/of (fetch-images collection-id)))))
;; --- Fetch Collections
(declare collections-fetched)
(def fetch-collections
(ptk/reify ::fetch-collections
ptk/WatchEvent
(watch [_ state s]
(->> (rp/query! :images-collections)
(rx/map collections-fetched)))))
;; --- Collections Fetched ;; --- Collections Fetched
(defn collections-fetched (defn collections-fetched
[items] [items]
(us/verify (s/every ::collection-entity) items) (us/verify (s/every ::collection) items)
(ptk/reify ::collections-fetched (ptk/reify ::collections-fetched
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
@ -70,105 +98,63 @@
state state
items)))) items))))
;; --- Fetch Color Collections
(def fetch-collections
(ptk/reify ::fetch-collections
ptk/WatchEvent
(watch [_ state s]
(->> (rp/query! :images-collections)
(rx/map collections-fetched)))))
;; --- Collection Created
(defn collection-created
[item]
(us/verify ::collection-entity item)
(ptk/reify ::collection-created
ptk/UpdateEvent
(update [_ state]
(let [{:keys [id] :as item} (assoc item :type :own)]
(update state :images-collections assoc id item)))))
;; --- Create Collection ;; --- Create Collection
(declare collection-created)
(def create-collection (def create-collection
(ptk/reify ::create-collection (ptk/reify ::create-collection
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(let [data {:name (tr "ds.default-library-title" (gensym "c"))}] (let [data {:name (tr "ds.default-library-title" (gensym "c"))}]
(->> (rp/mutation! :create-image-collection data) (->> (rp/mutation! :create-images-collection data)
(rx/map collection-created)))))) (rx/map collection-created))))))
;; --- Collection Updated ;; --- Collection Created
(defrecord CollectionUpdated [item] (defn collection-created
[item]
(us/verify ::collection item)
(ptk/reify ::collection-created
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(update-in state [:images-collections (:id item)] merge item))) (let [{:keys [id] :as item} (assoc item :type :own)]
(update state :images-collections assoc id item)))))
(defn collection-updated
[item]
(us/verify ::collection-entity item)
(CollectionUpdated. item))
;; --- Update Collection
(defrecord UpdateCollection [id]
ptk/WatchEvent
(watch [_ state s]
(let [item (get-in state [:images-collections id])]
(->> (rp/mutation! :update-images-collection item)
(rx/map collection-updated)))))
(defn update-collection
[id]
(UpdateCollection. id))
;; --- Rename Collection ;; --- Rename Collection
(defrecord RenameCollection [id name] (defn rename-collection
[id name]
(ptk/reify ::rename-collection
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc-in state [:images-collections id :name] name)) (assoc-in state [:images-collections id :name] name))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(rx/of (update-collection id)))) (let [params {:id id :name name}]
(->> (rp/mutation! :rename-images-collection params)
(defn rename-collection (rx/ignore))))))
[id name]
(RenameCollection. id name))
;; --- Delete Collection ;; --- Delete Collection
(defrecord DeleteCollection [id] (defn delete-collection
[id on-success]
(ptk/reify ::delete-collection
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(update state :images-collections dissoc id)) (update state :images-collections dissoc id))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(let [type (get-in state [:dashboard :images :type])]
(->> (rp/mutation! :delete-images-collection {:id id}) (->> (rp/mutation! :delete-images-collection {:id id})
(rx/map #(rt/nav :dashboard/images nil {:type type})))))) (rx/tap on-success)
(rx/ignore)))))
(defn delete-collection
[id]
(DeleteCollection. id))
;; --- Image Created
(defn image-created
[item]
(us/verify ::image-entity item)
(ptk/reify ::image-created
ptk/UpdateEvent
(update [_ state]
(update state :images assoc (:id item) item))))
;; --- Create Image ;; --- Create Image
(declare image-created)
(def allowed-file-types #{"image/jpeg" "image/png"}) (def allowed-file-types #{"image/jpeg" "image/png"})
(defn create-images (defn create-images
@ -179,41 +165,49 @@
(ptk/reify ::create-images (ptk/reify ::create-images
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc-in state [:dashboard :images :uploading] true)) (assoc-in state [:dashboard-images :uploading] true))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(letfn [(image-size [file] (letfn [(allowed-file? [file]
(->> (files/get-image-size file)
(rx/map (partial vector file))))
(allowed-file? [file]
(contains? allowed-file-types (.-type file))) (contains? allowed-file-types (.-type file)))
(finalize-upload [state] (finalize-upload [state]
(assoc-in state [:dashboard :images :uploading] false)) (assoc-in state [:dashboard-images :uploading] false))
(prepare [[file [width height]]] (on-success [_]
(cond-> {:name (.-name file) (st/emit! finalize-upload)
:mimetype (.-type file) (on-uploaded))
:id (uuid/next) (on-error [e]
:file file (st/emit! finalize-upload)
:width width (rx/throw e))
:height height} (prepare [file]
id (assoc :collection-id id)))] {:name (.-name file)
:collection-id id
:content file})]
(->> (rx/from files) (->> (rx/from files)
(rx/filter allowed-file?) (rx/filter allowed-file?)
(rx/mapcat image-size)
(rx/map prepare) (rx/map prepare)
(rx/mapcat #(rp/mutation! :create-image %)) (rx/mapcat #(rp/mutation! :upload-image %))
(rx/reduce conj []) (rx/reduce conj [])
(rx/do #(st/emit! finalize-upload)) (rx/do on-success)
(rx/do on-uploaded)
(rx/mapcat identity) (rx/mapcat identity)
(rx/map image-created))))))) (rx/map image-created)
(rx/catch on-error)))))))
;; --- Image Created
(defn image-created
[item]
(us/verify ::image item)
(ptk/reify ::image-created
ptk/UpdateEvent
(update [_ state]
(update state :images assoc (:id item) item))))
;; --- Update Image ;; --- Update Image
(defn persist-image (defn persist-image
[id] [id]
{:pre [(uuid? id)]} (us/verify ::us/uuid id)
(ptk/reify ::persist-image (ptk/reify ::persist-image
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
@ -221,31 +215,34 @@
(->> (rp/mutation! :update-image data) (->> (rp/mutation! :update-image data)
(rx/ignore)))))) (rx/ignore))))))
;; --- Images Fetched
(defn images-fetched
[items]
(us/verify (s/every ::image-entity) items)
(ptk/reify ::images-fetched
ptk/UpdateEvent
(update [_ state]
(reduce (fn [state {:keys [id] :as image}]
(assoc-in state [:images id] image))
state
items))))
;; --- Fetch Images ;; --- Fetch Images
(declare images-fetched)
(defn fetch-images (defn fetch-images
"Fetch a list of images of the selected collection" "Fetch a list of images of the selected collection"
[id] [id]
(us/verify (s/nilable ::us/uuid) id) (us/verify ::us/uuid id)
(ptk/reify ::fetch-images (ptk/reify ::fetch-images
ptk/WatchEvent ptk/WatchEvent
(watch [_ state s] (watch [_ state s]
(let [params (cond-> {} id (assoc :collection-id id))] (let [params {:collection-id id}]
(->> (rp/query! :images-by-collection params) (->> (rp/query! :images-by-collection params)
(rx/map images-fetched)))))) (rx/map (partial images-fetched id)))))))
;; --- Images Fetched
(s/def ::images (s/every ::image))
(defn images-fetched
[collection-id items]
(us/verify ::us/uuid collection-id)
(us/verify ::images items)
(ptk/reify ::images-fetched
ptk/UpdateEvent
(update [_ state]
(let [images (d/index-by :id items)]
(assoc state :images images)))))
;; --- Fetch Image ;; --- Fetch Image
@ -281,139 +278,123 @@
{:pre [(map? image)]} {:pre [(map? image)]}
(ImageFetched. image)) (ImageFetched. image))
;; --- Delete Images
(defrecord DeleteImage [id]
ptk/UpdateEvent
(update [_ state]
(-> state
(update :images dissoc id)
(update-in [:dashboard :images :selected] disj id)))
ptk/WatchEvent
(watch [_ state s]
(->> (rp/mutation! :delete-image {:id id})
(rx/ignore))))
(defn delete-image
[id]
{:pre [(uuid? id)]}
(DeleteImage. id))
;; --- Rename Image ;; --- Rename Image
(defrecord RenameImage [id name] (defn rename-image
[id name]
(us/verify ::us/uuid id)
(us/verify ::us/string name)
(ptk/reify ::rename-image
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(assoc-in state [:images id :name] name)) (assoc-in state [:images id :name] name))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(rx/of (persist-image id)))) (rx/of (persist-image id)))))
(defn rename-image ;; --- Image Selection
[id name]
{:pre [(uuid? id) (string? name)]}
(RenameImage. id name))
;; --- Select image (defn select-image
[id]
(defrecord SelectImage [id] (ptk/reify ::select-image
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(update-in state [:dashboard :images :selected] conj id))) (update-in state [:dashboard-images :selected] (fnil conj #{}) id))))
(defrecord DeselectImage [id]
ptk/UpdateEvent
(update [_ state]
(update-in state [:dashboard :images :selected] disj id)))
(defrecord ToggleImageSelection [id]
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:dashboard :images :selected])]
(rx/of
(if (selected id)
(DeselectImage. id)
(SelectImage. id))))))
(defn deselect-image (defn deselect-image
[id] [id]
{:pre [(uuid? id)]} (ptk/reify ::deselect-image
(DeselectImage. id))
(defn toggle-image-selection
[id]
(ToggleImageSelection. id))
;; --- Copy Selected Image
(defrecord CopySelected [id]
ptk/WatchEvent
(watch [_ state stream]
(let [selected (get-in state [:dashboard :images :selected])]
(rx/merge
(->> (rx/from selected)
(rx/flat-map #(rp/mutation! :copy-image {:id % :collection-id id}))
(rx/map image-created))
(->> (rx/from selected)
(rx/map deselect-image))))))
(defn copy-selected
[id]
{:pre [(or (uuid? id) (nil? id))]}
(CopySelected. id))
;; --- Move Selected Image
(defrecord MoveSelected [id]
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(let [selected (get-in state [:dashboard :images :selected])] (update-in state [:dashboard-images :selected] (fnil disj #{}) id))))
(reduce (fn [state image]
(assoc-in state [:images image :collection] id)) (def deselect-all-images
state (ptk/reify ::deselect-all-images
selected))) ptk/UpdateEvent
(update [_ state]
(assoc-in state [:dashboard-images :selected] #{}))))
;; --- Delete Images
(defn delete-image
[id]
(us/verify ::us/uuid id)
(ptk/reify ::delete-image
ptk/UpdateEvent
(update [_ state]
(update state :images dissoc id))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state s]
(let [selected (get-in state [:dashboard :images :selected])]
(rx/merge (rx/merge
(->> (rx/from selected) (rx/of deselect-all-images)
(rx/map persist-image)) (->> (rp/mutation! :delete-image {:id id})
(->> (rx/from selected) (rx/ignore))))))
(rx/map deselect-image))))))
(defn move-selected
[id]
{:pre [(or (uuid? id) (nil? id))]}
(MoveSelected. id))
;; --- Delete Selected ;; --- Delete Selected
(defrecord DeleteSelected [] (def delete-selected
(ptk/reify ::delete-selected
ptk/WatchEvent ptk/WatchEvent
(watch [_ state stream] (watch [_ state stream]
(let [selected (get-in state [:dashboard :images :selected])] (let [selected (get-in state [:dashboard-images :selected])]
(->> (rx/from selected) (->> (rx/from selected)
(rx/map delete-image))))) (rx/map delete-image))))))
(defn delete-selected
[]
(DeleteSelected.))
;; --- Update Opts (Filtering & Ordering) ;; --- Update Opts (Filtering & Ordering)
(defrecord UpdateOpts [order filter edition]
ptk/UpdateEvent
(update [_ state]
(update-in state [:dashboard :images] merge
{:edition edition}
(when order {:order order})
(when filter {:filter filter}))))
(defn update-opts (defn update-opts
[& {:keys [order filter edition] [& {:keys [order filter edition]
:or {edition false} :or {edition false}}]
:as opts}] (ptk/reify ::update-opts
(UpdateOpts. order filter edition)) ptk/UpdateEvent
(update [_ state]
(update state :dashboard-images merge
{:edition edition}
(when order {:order order})
(when filter {:filter filter})))))
;; --- Copy Selected Image
;; (defrecord CopySelected [id]
;; ptk/WatchEvent
;; (watch [_ state stream]
;; (let [selected (get-in state [:dashboard-images :selected])]
;; (rx/merge
;; (->> (rx/from selected)
;; (rx/flat-map #(rp/mutation! :copy-image {:id % :collection-id id}))
;; (rx/map image-created))
;; (->> (rx/from selected)
;; (rx/map deselect-image))))))
;; (defn copy-selected
;; [id]
;; {:pre [(or (uuid? id) (nil? id))]}
;; (CopySelected. id))
;; --- Move Selected Image
;; (defrecord MoveSelected [id]
;; ptk/UpdateEvent
;; (update [_ state]
;; (let [selected (get-in state [:dashboard-images :selected])]
;; (reduce (fn [state image]
;; (assoc-in state [:images image :collection] id))
;; state
;; selected)))
;; ptk/WatchEvent
;; (watch [_ state stream]
;; (let [selected (get-in state [:dashboard-images :selected])]
;; (rx/merge
;; (->> (rx/from selected)
;; (rx/map persist-image))
;; (->> (rx/from selected)
;; (rx/map deselect-image))))))
;; (defn move-selected
;; [id]
;; {:pre [(or (uuid? id) (nil? id))]}
;; (MoveSelected. id))

View file

@ -54,6 +54,7 @@
;; --- Declarations ;; --- Declarations
(declare fetch-users) (declare fetch-users)
(declare fetch-images)
(declare handle-who) (declare handle-who)
(declare handle-pointer-update) (declare handle-pointer-update)
(declare handle-pointer-send) (declare handle-pointer-send)
@ -289,7 +290,8 @@
(rx/of (dp/fetch-file file-id) (rx/of (dp/fetch-file file-id)
(dp/fetch-pages file-id) (dp/fetch-pages file-id)
(initialize-layout file-id) (initialize-layout file-id)
(fetch-users file-id)) (fetch-users file-id)
(fetch-images file-id))
(->> (rx/zip (rx/filter (ptk/type? ::dp/pages-fetched) stream) (->> (rx/zip (rx/filter (ptk/type? ::dp/pages-fetched) stream)
(rx/filter (ptk/type? ::dp/files-fetched) stream)) (rx/filter (ptk/type? ::dp/files-fetched) stream))
(rx/take 1) (rx/take 1)
@ -399,6 +401,7 @@
state state
users)))) users))))
;; --- Toggle layout flag ;; --- Toggle layout flag
(defn toggle-layout-flag (defn toggle-layout-flag
@ -1303,6 +1306,94 @@
query-params {:page-id page-id}] query-params {:page-id page-id}]
(rx/of (rt/nav :workspace path-params query-params)))))) (rx/of (rt/nav :workspace path-params query-params))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Workspace Images
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Fetch Workspace Images
(declare images-fetched)
(defn fetch-images
[file-id]
(ptk/reify ::fetch-images
ptk/WatchEvent
(watch [_ state stream]
(->> (rp/query :project-file-images {:file-id file-id})
(rx/map images-fetched)))))
(defn images-fetched
[images]
(ptk/reify ::images-fetched
ptk/UpdateEvent
(update [_ state]
(let [images (d/index-by :id images)]
(assoc state :workspace-images images)))))
;; --- Upload Image
(declare image-uploaded)
(def allowed-file-types #{"image/jpeg" "image/png"})
(defn upload-image
([file] (upload-image file identity))
([file on-uploaded]
(us/verify fn? on-uploaded)
(ptk/reify ::upload-image
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:workspace-local :uploading] true))
ptk/WatchEvent
(watch [_ state stream]
(let [allowed-file? #(contains? allowed-file-types (.-type %))
finalize-upload #(assoc-in % [:workspace-local :uploading] false)
file-id (get-in state [:workspace-page :file-id])
on-success #(do (st/emit! finalize-upload)
(on-uploaded %))
on-error #(do (st/emit! finalize-upload)
(rx/throw %))
prepare
(fn [file]
{:name (.-name file)
:file-id file-id
:content file})]
(->> (rx/of file)
(rx/filter allowed-file?)
(rx/map prepare)
(rx/mapcat #(rp/mutation! :upload-project-file-image %))
(rx/do on-success)
(rx/map image-uploaded)
(rx/catch on-error)))))))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::width ::us/number)
(s/def ::height ::us/number)
(s/def ::mtype ::us/string)
(s/def ::uri ::us/string)
(s/def ::thumb-uri ::us/string)
(s/def ::image
(s/keys :req-un [::id
::name
::width
::height
::uri
::thumb-uri]))
(defn image-uploaded
[item]
(us/verify ::image item)
(ptk/reify ::image-created
ptk/UpdateEvent
(update [_ state]
(update state :workspace-images assoc (:id item) item))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Page Changes Reactions ;; Page Changes Reactions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -2,6 +2,9 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2017-2019 Andrey Antukh <niwi@niwi.nz> ;; Copyright (c) 2017-2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.main.refs (ns uxbox.main.refs
@ -35,6 +38,10 @@
(-> (l/key :workspace-file) (-> (l/key :workspace-file)
(l/derive st/state))) (l/derive st/state)))
(def workspace-images
(-> (l/key :workspace-images)
(l/derive st/state)))
(def workspace-users (def workspace-users
(-> (l/key :workspace-users) (-> (l/key :workspace-users)
(l/derive st/state))) (l/derive st/state)))

View file

@ -112,7 +112,15 @@
([id] (mutation id {})) ([id] (mutation id {}))
([id params] (mutation id params))) ([id params] (mutation id params)))
(defmethod mutation :create-image (defmethod mutation :upload-image
[id params]
(let [form (js/FormData.)]
(run! (fn [[key val]]
(.append form (name key) val))
(seq params))
(send-mutation! id form)))
(defmethod mutation :upload-project-file-image
[id params] [id params]
(let [form (js/FormData.)] (let [form (js/FormData.)]
(run! (fn [[key val]] (run! (fn [[key val]]

View file

@ -7,9 +7,12 @@
(ns uxbox.main.ui.dashboard.icons (ns uxbox.main.ui.dashboard.icons
(:require (:require
[cljs.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[lentes.core :as l] [lentes.core :as l]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.common.data :as d]
[uxbox.common.spec :as us]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.main.data.icons :as di] [uxbox.main.data.icons :as di]
[uxbox.main.store :as st] [uxbox.main.store :as st]
@ -21,7 +24,7 @@
[uxbox.util.components :refer [chunked-list]] [uxbox.util.components :refer [chunked-list]]
[uxbox.util.data :refer [read-string jscoll->vec seek]] [uxbox.util.data :refer [read-string jscoll->vec seek]]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.i18n :as t :refer [tr]] [uxbox.util.i18n :as i18n :refer [tr t]]
[uxbox.util.router :as rt] [uxbox.util.router :as rt]
[uxbox.util.time :as dt])) [uxbox.util.time :as dt]))
@ -51,111 +54,200 @@
icons icons
(filter #(contains-term? (:name %) term) icons))) (filter #(contains-term? (:name %) term) icons)))
;; --- Refs
(def collections-iref
(-> (l/key :icons-collections)
(l/derive st/state)))
(def opts-iref
(-> (l/in [:dashboard :icons])
(l/derive st/state)))
;; --- Component: Grid Header ;; --- Component: Grid Header
(mf/defc grid-header (mf/defc grid-header
[{:keys [coll] :as props}] [{:keys [collection] :as props}]
(letfn [(on-change [name] (let [{:keys [id type]} collection
(st/emit! (di/rename-collection (:id coll) name))) on-change #(st/emit! (di/rename-collection id %))
(delete [] on-deleted #(st/emit! (rt/nav :dashboard-icons nil {:type type}))
(st/emit! delete #(st/emit! (di/delete-collection id on-deleted))
(di/delete-collection (:id coll)) on-delete #(modal/show! confirm-dialog {:on-accept delete})]
(rt/nav :dashboard/icons nil {:type (:type coll)}))) [:& common/grid-header {:value (:name collection)
(on-delete []
(modal/show! confirm-dialog {:on-accept delete}))]
[:& common/grid-header {:value (:name coll)
:on-change on-change :on-change on-change
:on-delete on-delete}])) :on-delete on-delete}]))
;; --- Nav ;; --- Nav
(mf/defc nav-item (mf/defc nav-item
[{:keys [coll selected?] :as props}] [{:keys [collection selected?] :as props}]
(let [local (mf/use-state {}) (let [local (mf/use-state {})
{:keys [id type name]} coll {:keys [id type name]} collection
editable? (= type :own)] editable? (= type :own)
(letfn [(on-click [event]
on-click
(fn [event]
(let [type (or type :own)] (let [type (or type :own)]
(st/emit! (rt/nav :dashboard-icons {} {:type type :id id})))) (st/emit! (rt/nav :dashboard-icons {} {:type type :id id}))))
(on-input-change [event]
on-input-change
(fn [event]
(-> (dom/get-target event) (-> (dom/get-target event)
(dom/get-value) (dom/get-value)
(swap! local assoc :name))) (swap! local assoc :name)))
(on-cancel [event]
(swap! local dissoc :name :edit)) on-cancel #(swap! local dissoc :name :edit)
(on-double-click [event] on-double-click #(when editable? (swap! local assoc :edit true))
(when editable?
(swap! local assoc :edit true))) on-input-keyup
(on-input-keyup [event] (fn [event]
(when (kbd/enter? event) (when (kbd/enter? event)
(let [value (-> (dom/get-target event) (dom/get-value))] (let [value (-> (dom/get-target event) (dom/get-value))]
(st/emit! (di/rename-collection id (str/trim (:name @local)))) (st/emit! (di/rename-collection id (str/trim (:name @local))))
(swap! local assoc :edit false))))] (swap! local assoc :edit false))))]
[:li {:on-click on-click [:li {:on-click on-click
:on-double-click on-double-click :on-double-click on-double-click
:class-name (when selected? "current")} :class-name (when selected? "current")}
(if (:edit @local) (if (:edit @local)
[:div [:div
[:input.element-title {:value (if (:name @local) [:input.element-title {:value (or (:name @local) name)
(:name @local)
(if id name "Storage"))
:on-change on-input-change :on-change on-input-change
:on-key-down on-input-keyup}] :on-key-down on-input-keyup}]
[:span.close {:on-click on-cancel} i/close]] [:span.close {:on-click on-cancel} i/close]]
[:span.element-title (if id name "Storage")])]))) [:span.element-title name])]))
(mf/defc nav (mf/defc nav
[{:keys [id type colls selected-coll] :as props}] [{:keys [id type collections] :as props}]
(let [own? (= type :own) (let [locale (i18n/use-locale)
own? (= type :own)
builtin? (= type :builtin) builtin? (= type :builtin)
select-tab #(st/emit! (rt/nav :dashboard-icons nil {:type %}))] create-collection #(st/emit! di/create-collection)
select-own-tab #(st/emit! (rt/nav :dashboard-icons nil {:type :own}))
select-buitin-tab #(st/emit! (rt/nav :dashboard-icons nil {:type :builtin}))]
[:div.library-bar [:div.library-bar
[:div.library-bar-inside [:div.library-bar-inside
;; Tabs
[:ul.library-tabs [:ul.library-tabs
[:li {:class-name (when own? "current") [:li {:class (when own? "current")
:on-click (partial select-tab :own)} :on-click select-own-tab}
(tr "ds.your-icons-title")] (t locale "ds.your-icons-title")]
[:li {:class-name (when builtin? "current")
:on-click (partial select-tab :builtin)}
(tr "ds.store-icons-title")]]
[:li {:class (when builtin? "current")
:on-click select-buitin-tab}
(t locale "ds.store-icons-title")]]
;; Collections List
[:ul.library-elements [:ul.library-elements
(when own? (when own?
[:li [:li
[:a.btn-primary {:on-click #(st/emit! di/create-collection)} [:a.btn-primary {:on-click #(st/emit! di/create-collection)}
(tr "ds.icons-collection.new")]]) (tr "ds.icons-collection.new")]])
(when own? (for [item collections]
[:& nav-item {:selected? (nil? id)}]) [:& nav-item {:collection item
(for [item colls]
[:& nav-item {:coll item
:selected? (= (:id item) id) :selected? (= (:id item) id)
:key (:id item)}])]]])) :key (:id item)}])]]]))
;; --- Grid ;; (mf/def grid-options-tooltip
;; :mixins [mf/reactive mf/memo]
;; :render
;; (fn [own {:keys [selected on-select title]}]
;; {:pre [(uuid? selected)
;; (fn? on-select)
;; (string? title)]}
;; (let [colls (mf/react collections-iref)
;; colls (->> (vals colls)
;; (filter #(= :own (:type %)))
;; (remove #(= selected (:id %)))
;; (sort-by :name colls))
;; on-select (fn [event id]
;; (dom/prevent-default event)
;; (dom/stop-propagation event)
;; (on-select id))]
;; [:ul.move-list
;; [:li.title title]
;; [:li
;; [:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
;; (for [{:keys [id name] :as coll} colls]
;; [:li {:key (pr-str id)}
;; [:a {:on-click #(on-select % id)} name]])])))
(mf/defc grid-options
[{:keys [id type selected] :as props}]
(let [local (mf/use-state {})
delete #(st/emit! di/delete-selected)
on-delete #(modal/show! confirm-dialog {:on-accept delete})
;; (on-toggle-copy [event]
;; (swap! local update :show-copy-tooltip not))
;; (on-toggle-move [event]
;; (swap! local update :show-move-tooltip not))
;; (on-copy [selected]
;; (swap! local assoc
;; :show-move-tooltip false
;; :show-copy-tooltip false)
;; (st/emit! (di/copy-selected selected)))
;; (on-move [selected]
;; (swap! local assoc
;; :show-move-tooltip false
;; :show-copy-tooltip false)
;; (st/emit! (di/move-selected selected)))
;; (on-rename [event]
;; (let [selected (first selected)]
;; (st/emit! (di/update-opts :edition selected))))
]
;; MULTISELECT OPTIONS BAR
[:div.multiselect-bar
(when (= type :own)
;; If editable
[:div.multiselect-nav
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.copy")
;; :on-click on-toggle-copy}
;; (when (:show-copy-tooltip @local)
;; [:& grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.copy-to-library")
;; :on-select on-copy}])
;; i/copy]
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.move")
;; :on-click on-toggle-move}
;; (when (:show-move-tooltip @local)
;; [:& grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.move-to-library")
;; :on-select on-move}])
;; i/move]
;; (when (= 1 (count selected))
;; [:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.rename")
;; :on-click on-rename}
;; i/pencil])
[:span.delete.tooltip.tooltip-top
{:alt (tr "ds.multiselect-bar.delete")
:on-click on-delete}
i/trash]]
;; If not editable
;; [:div.multiselect-nav
;; [:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.copy")
;; :on-click on-toggle-copy}
;; (when (:show-copy-tooltip @local)
;; [:& grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.copy-to-library")
;; :on-select on-copy}])
;; i/organize]]
)]))
;; --- Grid Form
(mf/defc grid-form (mf/defc grid-form
[{:keys [id type uploading?] :as props}] [{:keys [id type uploading?] :as props}]
(let [input (mf/use-ref nil) (let [locale (i18n/use-locale)
input (mf/use-ref nil)
on-click #(dom/click (mf/ref-node input)) on-click #(dom/click (mf/ref-node input))
on-select #(st/emit! (->> (dom/get-event-files %) on-select #(st/emit! (->> (dom/get-target %)
(jscoll->vec) (dom/get-files)
(array-seq)
(di/create-icons id)))] (di/create-icons id)))]
[:div.grid-item.add-project {:on-click on-click} [:div.grid-item.add-project {:on-click on-click}
(if uploading? (if uploading?
[:div i/loader-pencil] [:div i/loader-pencil]
[:span (tr "ds.icon-new")]) [:span (t locale "ds.icon-new")])
[:input.upload-icon-input [:input.upload-icon-input
{:style {:display "none"} {:style {:display "none"}
:multiple true :multiple true
@ -165,122 +257,36 @@
:type "file" :type "file"
:on-change on-select}]])) :on-change on-select}]]))
(mf/def grid-options-tooltip
:mixins [mf/reactive mf/memo]
:render
(fn [own {:keys [selected on-select title]}]
{:pre [(uuid? selected)
(fn? on-select)
(string? title)]}
(let [colls (mf/react collections-iref)
colls (->> (vals colls)
(filter #(= :own (:type %)))
(remove #(= selected (:id %)))
(sort-by :name colls))
on-select (fn [event id]
(dom/prevent-default event)
(dom/stop-propagation event)
(on-select id))]
[:ul.move-list
[:li.title title]
[:li
[:a {:href "#" :on-click #(on-select % nil)} "Storage"]]
(for [{:keys [id name] :as coll} colls]
[:li {:key (pr-str id)}
[:a {:on-click #(on-select % id)} name]])])))
;; (mf/def grid-options
;; :mixins [(mf/local) mf/memo]
;; :render
;; (fn [{:keys [::mf/local] :as own}
;; {:keys [id type selected] :as props}]
;; (letfn [(delete []
;; (st/emit! (di/delete-selected)))
;; (on-delete [event]
;; (modal/show! confirm-dialog {:on-accept delete}))
;; (on-toggle-copy [event]
;; (swap! local update :show-copy-tooltip not))
;; (on-toggle-move [event]
;; (swap! local update :show-move-tooltip not))
;; (on-copy [selected]
;; (swap! local assoc
;; :show-move-tooltip false
;; :show-copy-tooltip false)
;; (st/emit! (di/copy-selected selected)))
;; (on-move [selected]
;; (swap! local assoc
;; :show-move-tooltip false
;; :show-copy-tooltip false)
;; (st/emit! (di/move-selected selected)))
;; (on-rename [event]
;; (let [selected (first selected)]
;; (st/emit! (di/update-opts :edition selected))))]
;; ;; MULTISELECT OPTIONS BAR
;; [:div.multiselect-bar
;; (if (or (= type :own) (nil? id))
;; ;; if editable
;; [:div.multiselect-nav {}
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.copy")
;; :on-click on-toggle-copy}
;; (when (:show-copy-tooltip @local)
;; (grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.copy-to-library")
;; :on-select on-copy}))
;; i/copy]
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.move")
;; :on-click on-toggle-move}
;; (when (:show-move-tooltip @local)
;; (grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.move-to-library")
;; :on-select on-move}))
;; i/move]
;; (when (= 1 (count selected))
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.rename")
;; :on-click on-rename}
;; i/pencil])
;; [:span.delete.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.delete")
;; :on-click on-delete}
;; i/trash]]
;; ;; if not editable
;; [:div.multiselect-nav
;; [:span.move-item.tooltip.tooltip-top
;; {:alt (tr "ds.multiselect-bar.copy")
;; :on-click on-toggle-copy}
;; (when (:show-copy-tooltip @local)
;; (grid-options-tooltip {:selected id
;; :title (tr "ds.multiselect-bar.copy-to-library")
;; :on-select on-copy}))
;; i/organize]])])))
;; --- Grid Item ;; --- Grid Item
(mf/defc grid-item (mf/defc grid-item
[{:keys [icon selected? edition?] :as props}] [{:keys [icon selected? edition?] :as props}]
(letfn [(toggle-selection [event] (let [toggle-selection #(st/emit! (if selected?
(st/emit! (di/toggle-icon-selection (:id icon)))) (di/deselect-icon (:id icon))
(on-key-down [event] (di/select-icon (:id icon))))
(when (kbd/enter? event) on-blur
(on-blur event))) (fn [event]
(on-blur [event] (let [target (dom/get-target event)
(let [target (dom/event->target event)
name (dom/get-value target)] name (dom/get-value target)]
(st/emit! (di/update-opts :edition false) (st/emit! (di/update-opts :edition false)
(di/rename-icon (:id icon) name)))) (di/rename-icon (:id icon) name))))
(ignore-click [event]
on-key-down
(fn [event]
(when (kbd/enter? event)
(on-blur event)))
ignore-click
(fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(dom/prevent-default event)) (dom/prevent-default event))
(on-edit [event]
on-edit
(fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(dom/prevent-default event) (dom/prevent-default event)
(st/emit! (di/update-opts :edition (:id icon))))] (st/emit! (di/update-opts :edition (:id icon))))]
[:div.grid-item.small-item.project-th [:div.grid-item.small-item.project-th
[:div.input-checkbox.check-primary [:div.input-checkbox.check-primary
[:input {:type "checkbox" [:input {:type "checkbox"
@ -304,18 +310,13 @@
;; --- Grid ;; --- Grid
(defn make-icons-iref (def icons-iref
[id] (-> (comp (l/key :icons) (l/lens vals))
(-> (comp (l/key :icons)
(l/lens (fn [icons]
(->> (vals icons)
(filter #(= id (:collection-id %)))))))
(l/derive st/state))) (l/derive st/state)))
(mf/defc grid (mf/defc grid
[{:keys [id type coll opts] :as props}] [{:keys [id type collection opts] :as props}]
(let [editable? (or (= type :own) (nil? id)) (let [editable? (= type :own)
icons-iref (mf/use-memo #(make-icons-iref id) #js [id])
icons (->> (mf/deref icons-iref) icons (->> (mf/deref icons-iref)
(filter-icons-by (:filter opts "")) (filter-icons-by (:filter opts ""))
(sort-icons-by (:order opts :name)))] (sort-icons-by (:order opts :name)))]
@ -336,44 +337,48 @@
;; --- Content ;; --- Content
(def opts-iref
(-> (l/key :dashboard-icons)
(l/derive st/state)))
(mf/defc content (mf/defc content
[{:keys [id type coll] :as props}] [{:keys [id type collection] :as props}]
(let [opts (mf/deref opts-iref)] (let [{:keys [selected] :as opts} (mf/deref opts-iref)]
[:*
[:section.dashboard-grid.library [:section.dashboard-grid.library
(when coll (when collection
[:& grid-header {:coll coll}]) [:& grid-header {:collection collection}])
[:& grid {:id id (if collection
:key [id type] [:& grid {:id id :type type :collection collection :opts opts}]
:type type [:span "EMPTY STATE TODO"])
:coll coll (when-not (empty? selected)
:opts opts}] #_[:& grid-options {:id id :type type :selected (:selected opts)}])]))
(when (seq (:selected opts))
#_[:& grid-options {:id id :type type :selected (:selected opts)}])]]))
;; --- Icons Page ;; --- Icons Page
(def collections-iref
(-> (l/key :icons-collections)
(l/derive st/state)))
(mf/defc icons-page (mf/defc icons-page
[{:keys [id type] :as props}] [{:keys [id type] :as props}]
(let [type (or type :own) (let [type (or type :own)
colls (mf/deref collections-iref) collections (mf/deref collections-iref)
colls (cond->> (vals colls) collections (cond->> (vals collections)
(= type :own) (filter #(= :own (:type %))) (= type :own) (filter #(= :own (:type %)))
(= type :builtin) (filter #(= :builtin (:type %))) (= type :builtin) (filter #(= :builtin (:type %)))
true (sort-by :created-at)) true (sort-by :created-at))
selected-coll (cond
(and (= type :own) (nil? id)) nil collection (cond
(uuid? id) (seek #(= id (:id %)) colls) (uuid? id) (seek #(= id (:id %)) collections)
:else (first colls)) :else (first collections))
id (:id selected-coll)]
id (:id collection)]
(mf/use-effect #(st/emit! di/fetch-collections)) (mf/use-effect #(st/emit! di/fetch-collections))
(mf/use-effect {:fn #(st/emit! (di/fetch-icons id)) (mf/use-effect
:deps #js [(str id)]}) {:fn #(when id (st/emit! (di/initialize id)))
:deps (mf/deps id)})
[:section.dashboard-content [:section.dashboard-content
[:& nav {:type type [:& nav {:type type :id id :collections collections}]
:id id [:& content {:type type :id id :collection collection}]]))
:colls colls}]
[:& content {:type type
:id id
:coll selected-coll}]]))

View file

@ -2,55 +2,42 @@
;; License, v. 2.0. If a copy of the MPL was not distributed with this ;; 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/. ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;; ;;
;; Copyright (c) 2015-2016 Andrey Antukh <niwi@niwi.nz> ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; Copyright (c) 2015-2016 Juan de la Cruz <delacruzgarciajuan@gmail.com> ;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2015-2020 Andrey Antukh <niwi@niwi.nz>
;; Copyright (c) 2015-2020 Juan de la Cruz <delacruzgarciajuan@gmail.com>
(ns uxbox.main.ui.dashboard.images (ns uxbox.main.ui.dashboard.images
(:require (:require
[cljs.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[lentes.core :as l] [lentes.core :as l]
[rumext.core :as mx]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.common.data :as d]
[uxbox.common.spec :as us]
[uxbox.main.data.images :as di] [uxbox.main.data.images :as di]
[uxbox.main.data.lightbox :as udl]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.ui.confirm :refer [confirm-dialog]]
[uxbox.main.ui.dashboard.common :as common] [uxbox.main.ui.dashboard.common :as common]
[uxbox.main.ui.keyboard :as kbd] [uxbox.main.ui.keyboard :as kbd]
[uxbox.main.ui.lightbox :as lbx]
[uxbox.main.ui.confirm :refer [confirm-dialog]]
[uxbox.main.ui.modal :as modal] [uxbox.main.ui.modal :as modal]
[uxbox.util.data :refer [read-string jscoll->vec seek]]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.i18n :as t :refer [tr]] [uxbox.util.i18n :as i18n :refer [t tr]]
[uxbox.util.router :as rt] [uxbox.util.router :as rt]
[uxbox.util.time :as dt])) [uxbox.util.time :as dt]))
;; --- Refs
(def collections-iref
(-> (l/key :images-collections)
(l/derive st/state)))
(def opts-iref
(-> (l/in [:dashboard :images])
(l/derive st/state)))
;; --- Page Title ;; --- Page Title
(mf/defc grid-header (mf/defc grid-header
[{:keys [coll] :as props}] [{:keys [collection] :as props}]
(letfn [(on-change [name] (let [{:keys [id type]} collection
(st/emit! (di/rename-collection (:id coll) name))) on-change #(st/emit! (di/rename-collection id %))
on-deleted #(st/emit! (rt/nav :dashboard-images nil {:type type}))
(delete [] delete #(st/emit! (di/delete-collection id on-deleted))
(st/emit! on-delete #(modal/show! confirm-dialog {:on-accept delete})]
(di/delete-collection (:id coll)) [:& common/grid-header {:value (:name collection)
(rt/nav :dashboard/images nil {:type (:type coll)})))
(on-delete []
(modal/show! confirm-dialog {:on-accept delete}))]
[:& common/grid-header {:value (:name coll)
:on-change on-change :on-change on-change
:on-delete on-delete}])) :on-delete on-delete}]))
@ -61,6 +48,7 @@
(let [local (mf/use-state {}) (let [local (mf/use-state {})
{:keys [id type name num-images]} coll {:keys [id type name num-images]} coll
editable? (= type :own) editable? (= type :own)
on-click on-click
(fn [event] (fn [event]
(let [type (or type :own)] (let [type (or type :own)]
@ -68,6 +56,7 @@
on-cancel-edition #(swap! local dissoc :edit) on-cancel-edition #(swap! local dissoc :edit)
on-double-click #(when editable? (swap! local assoc :edit true)) on-double-click #(when editable? (swap! local assoc :edit true))
on-input-keyup on-input-keyup
(fn [event] (fn [event]
(when (kbd/enter? event) (when (kbd/enter? event)
@ -76,6 +65,7 @@
(str/trim))] (str/trim))]
(st/emit! (di/rename-collection id value)) (st/emit! (di/rename-collection id value))
(swap! local assoc :edit false))))] (swap! local assoc :edit false))))]
[:li {:on-click on-click [:li {:on-click on-click
:on-double-click on-double-click :on-double-click on-double-click
:class-name (when selected? "current")} :class-name (when selected? "current")}
@ -87,155 +77,128 @@
[:span.element-title (if id name "Storage")])])) [:span.element-title (if id name "Storage")])]))
(mf/defc nav (mf/defc nav
[{:keys [id type colls] :as props}] [{:keys [id type collections] :as props}]
(let [own? (= type :own) (let [locale (i18n/use-locale)
own? (= type :own)
builtin? (= type :builtin) builtin? (= type :builtin)
select-tab #(st/emit! (rt/nav :dashboard-images nil {:type %}))] create-collection #(st/emit! di/create-collection)
select-own-tab #(st/emit! (rt/nav :dashboard-images nil {:type :own}))
select-buitin-tab #(st/emit! (rt/nav :dashboard-images nil {:type :builtin}))]
[:div.library-bar [:div.library-bar
[:div.library-bar-inside [:div.library-bar-inside
[:ul.library-tabs
[:li {:class-name (when own? "current")
:on-click (partial select-tab :own)}
(tr "ds.your-images-title")]
[:li {:class-name (when builtin? "current")
:on-click (partial select-tab :builtin)}
(tr "ds.store-images-title")]]
;; Tabs
[:ul.library-tabs
[:li {:class (when own? "current")
:on-click select-own-tab}
(t locale "ds.your-images-title")]
[:li {:class (when builtin? "current")
:on-click select-buitin-tab}
(t locale "ds.store-images-title")]]
;; Collections List
[:ul.library-elements [:ul.library-elements
(when own? (when own?
[:li [:li
[:a.btn-primary {:on-click #(st/emit! di/create-collection)} [:a.btn-primary {:on-click create-collection}
(tr "ds.images-collection.new")]]) (t locale "ds.images-collection.new")]])
(when own?
[:& nav-item {:selected? (nil? id)}]) (for [item collections]
(for [item colls]
[:& nav-item {:coll item [:& nav-item {:coll item
:selected? (= (:id item) id) :selected? (= (:id item) id)
:key (:id item)}])]]])) :key (:id item)}])]]]))
;; --- Grid ;; --- Grid
(mf/defc grid-options-tooltip ;; (mf/defc grid-options-tooltip
[{:keys [selected on-select title] :as props}] ;; [{:keys [selected on-select title] :as props}]
{:pre [(uuid? selected) ;; {:pre [(uuid? selected)
(fn? on-select) ;; (fn? on-select)
(string? title)]} ;; (string? title)]}
(let [colls (mf/deref collections-iref) ;; (let [colls (mf/deref collections-iref)
colls (->> (vals colls) ;; colls (->> (vals colls)
(filter #(= :own (:type %))) ;; (filter #(= :own (:type %)))
(remove #(= selected (:id %))) ;; (remove #(= selected (:id %)))
#_(sort-by :name colls)) ;; #_(sort-by :name colls))
on-select (fn [event id] ;; on-select (fn [event id]
(dom/prevent-default event) ;; (dom/prevent-default event)
(dom/stop-propagation event) ;; (dom/stop-propagation event)
(on-select id))] ;; (on-select id))]
[:ul.move-list ;; [:ul.move-list
[:li.title title] ;; [:li.title title]
[:li ;; [:li
(when (not (nil? selected)) ;; (when (not (nil? selected))
[:a {:href "#" :on-click #(on-select % nil)} "Storage"])] ;; [:a {:href "#" :on-click #(on-select % nil)} "Storage"])]
(for [{:keys [id name] :as coll} colls] ;; (for [{:keys [id name] :as coll} colls]
[:li {:key (pr-str id)} ;; [:li {:key (pr-str id)}
[:a {:on-click #(on-select % id)} name]])])) ;; [:a {:on-click #(on-select % id)} name]])]))
(mf/defc grid-options (mf/defc grid-options
[{:keys [id type selected] :as props}] [{:keys [id type selected] :as props}]
(let [local (mf/use-state {})] (let [local (mf/use-state {})
(letfn [(delete [] delete #(st/emit! di/delete-selected)
(st/emit! (di/delete-selected))) on-delete #(modal/show! confirm-dialog {:on-accept delete})
(on-delete [event]
(modal/show! confirm-dialog {:on-accept delete})) ;; (on-toggle-copy [event]
(on-toggle-copy [event] ;; (swap! local update :show-copy-tooltip not))
(swap! local update :show-copy-tooltip not)) ;; (on-toggle-move [event]
(on-toggle-move [event] ;; (swap! local update :show-move-tooltip not))
(swap! local update :show-move-tooltip not)) ;; (on-copy [selected]
(on-copy [selected] ;; (swap! local assoc
(swap! local assoc ;; :show-move-tooltip false
:show-move-tooltip false ;; :show-copy-tooltip false)
:show-copy-tooltip false) ;; (st/emit! (di/copy-selected selected)))
(st/emit! (di/copy-selected selected))) ;; (on-move [selected]
(on-move [selected] ;; (swap! local assoc
(swap! local assoc ;; :show-move-tooltip false
:show-move-tooltip false ;; :show-copy-tooltip false)
:show-copy-tooltip false) ;; (st/emit! (di/move-selected selected)))
(st/emit! (di/move-selected selected))) ;; (on-rename [event]
(on-rename [event] ;; (let [selected (first selected)]
(let [selected (first selected)] ;; (st/emit! (di/update-opts :edition selected))))
(st/emit! (di/update-opts :edition selected))))] ]
;; MULTISELECT OPTIONS BAR ;; MULTISELECT OPTIONS BAR
[:div.multiselect-bar [:div.multiselect-bar
(if (or (= type :own) (nil? id)) (when (= type :own)
;; If editable ;; If editable
[:div.multiselect-nav [:div.multiselect-nav
[:span.move-item.tooltip.tooltip-top ;; [:span.move-item.tooltip.tooltip-top
{:alt (tr "ds.multiselect-bar.copy") ;; {:alt (tr "ds.multiselect-bar.copy")
:on-click on-toggle-copy} ;; :on-click on-toggle-copy}
(when (:show-copy-tooltip @local) ;; (when (:show-copy-tooltip @local)
[:& grid-options-tooltip {:selected id ;; [:& grid-options-tooltip {:selected id
:title (tr "ds.multiselect-bar.copy-to-library") ;; :title (tr "ds.multiselect-bar.copy-to-library")
:on-select on-copy}]) ;; :on-select on-copy}])
i/copy] ;; i/copy]
[:span.move-item.tooltip.tooltip-top ;; [:span.move-item.tooltip.tooltip-top
{:alt (tr "ds.multiselect-bar.move") ;; {:alt (tr "ds.multiselect-bar.move")
:on-click on-toggle-move} ;; :on-click on-toggle-move}
(when (:show-move-tooltip @local) ;; (when (:show-move-tooltip @local)
[:& grid-options-tooltip {:selected id ;; [:& grid-options-tooltip {:selected id
:title (tr "ds.multiselect-bar.move-to-library") ;; :title (tr "ds.multiselect-bar.move-to-library")
:on-select on-move}]) ;; :on-select on-move}])
i/move] ;; i/move]
(when (= 1 (count selected)) ;; (when (= 1 (count selected))
[:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.rename") ;; [:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.rename")
:on-click on-rename} ;; :on-click on-rename}
i/pencil]) ;; i/pencil])
[:span.delete.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.delete") [:span.delete.tooltip.tooltip-top
{:alt (tr "ds.multiselect-bar.delete")
:on-click on-delete} :on-click on-delete}
i/trash]] i/trash]]
;; If not editable ;; If not editable
[:div.multiselect-nav ;; [:div.multiselect-nav
[:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.copy") ;; [:span.move-item.tooltip.tooltip-top {:alt (tr "ds.multiselect-bar.copy")
:on-click on-toggle-copy} ;; :on-click on-toggle-copy}
(when (:show-copy-tooltip @local) ;; (when (:show-copy-tooltip @local)
[:& grid-options-tooltip {:selected id ;; [:& grid-options-tooltip {:selected id
:title (tr "ds.multiselect-bar.copy-to-library") ;; :title (tr "ds.multiselect-bar.copy-to-library")
:on-select on-copy}]) ;; :on-select on-copy}])
i/organize]])]))) ;; i/organize]]
)]))
(mf/defc grid-item
[{:keys [image selected? edition?] :as props}]
(letfn [(toggle-selection [event]
(st/emit! (di/toggle-image-selection (:id image))))
(on-key-down [event]
(when (kbd/enter? event)
(on-blur event)))
(on-blur [event]
(let [target (dom/event->target event)
name (dom/get-value target)]
(st/emit! (di/update-opts :edition false)
(di/rename-image (:id image) name))))
(on-edit [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(st/emit! (di/update-opts :edition (:id image))))]
[:div.grid-item.images-th
[:div.grid-item-th {:style {:background-image (str "url('" (:thumbnail image) "')")}}
[:div.input-checkbox.check-primary
[:input {:type "checkbox"
:id (:id image)
:on-change toggle-selection
:checked selected?}]
[:label {:for (:id image)}]]]
[:div.item-info
(if edition?
[:input.element-name {:type "text"
:auto-focus true
:on-key-down on-key-down
:on-blur on-blur
:on-click on-edit
:default-value (:name image)}]
[:h3 {:on-double-click on-edit} (:name image)])
[:span.date (str (tr "ds.uploaded-at"
(dt/format (:created-at image) "dd/MM/yyyy")))]]]))
;; --- Grid Form ;; --- Grid Form
@ -243,8 +206,9 @@
[{:keys [id type uploading?] :as props}] [{:keys [id type uploading?] :as props}]
(let [input (mf/use-ref nil) (let [input (mf/use-ref nil)
on-click #(dom/click (mf/ref-node input)) on-click #(dom/click (mf/ref-node input))
on-select #(st/emit! (->> (dom/get-event-files %) on-select #(st/emit! (->> (dom/get-target %)
(jscoll->vec) (dom/get-files)
(array-seq)
(di/create-images id)))] (di/create-images id)))]
[:div.grid-item.add-project {:on-click on-click} [:div.grid-item.add-project {:on-click on-click}
(if uploading? (if uploading?
@ -255,26 +219,76 @@
:multiple true :multiple true
:ref input :ref input
:value "" :value ""
:accept "image/jpeg,image/png" :accept "image/jpeg,image/png,image/webp"
:type "file" :type "file"
:on-change on-select}]])) :on-change on-select}]]))
;; --- Grid Item
(mf/defc grid-item
[{:keys [image selected? edition?] :as props}]
(let [toggle-selection #(st/emit! (if selected?
(di/deselect-image (:id image))
(di/select-image (:id image))))
on-blur
(fn [event]
(let [target (dom/get-target event)
name (dom/get-value target)]
(st/emit! (di/update-opts :edition false)
(di/rename-image (:id image) name))))
on-key-down
(fn [event]
(when (kbd/enter? event)
(on-blur event)))
on-edit
(fn [event]
(dom/stop-propagation event)
(dom/prevent-default event)
(st/emit! (di/update-opts :edition (:id image))))
background (str "url('" (:thumb-uri image) "')")]
[:div.grid-item.images-th
[:div.grid-item-th {:style {:background-image background}}
[:div.input-checkbox.check-primary
[:input {:type "checkbox"
:id (:id image)
:on-change toggle-selection
:checked selected?}]
[:label {:for (:id image)}]]]
[:div.item-info
(if edition?
[:input.element-name {:type "text"
:auto-focus true
:on-key-down on-key-down
:on-blur on-blur
:on-click on-edit
:default-value (:name image)}]
[:h3 {:on-double-click on-edit} (:name image)])
[:span.date (tr "ds.uploaded-at" (dt/format (:created-at image) "dd/MM/yyyy"))]]]))
;; --- Grid ;; --- Grid
(defn- make-images-iref ;; (defn- make-images-iref
[id type] ;; [collection-id]
(letfn [(selector-fn [state] ;; (letfn [(selector [state]
(let [images (vals (:images state))] ;; (->> (vals (:images state))
(filterv #(= id (:collection-id %)) images)))] ;; (filterv #(= (:collection-id %) collection-id))))]
(-> (l/lens selector-fn) ;; (-> (l/lens selector)
(l/derive st/state)))) ;; (l/derive st/state))))
(def images-iref
(-> (comp (l/key :images) (l/lens vals))
(l/derive st/state)))
(mf/defc grid (mf/defc grid
[{:keys [id type coll opts] :as props}] [{:keys [id type collection opts] :as props}]
(let [editable? (or (= type :own) (nil? id)) (let [editable? (= type :own)
images-iref (mf/use-memo ;; images-iref (mf/use-memo {:fn #(make-images-iref id)
{:fn #(make-images-iref id type) ;; :deps (mf/deps id)})
:deps (mf/deps id type)})
images (->> (mf/deref images-iref) images (->> (mf/deref images-iref)
(sort-by :created-at))] (sort-by :created-at))]
[:div.dashboard-grid-content [:div.dashboard-grid-content
@ -328,45 +342,46 @@
;; :value filtering}] ;; :value filtering}]
;; [:div.clear-search {:on-click on-clear} i/close]]]]))) ;; [:div.clear-search {:on-click on-clear} i/close]]]])))
(mf/defc content (def opts-iref
[{:keys [id type coll] :as props}] (-> (l/key :dashboard-images)
(let [opts (mf/deref opts-iref)] (l/derive st/state)))
[:*
[:section.dashboard-grid.library
(when coll
[:& grid-header {:coll coll}])
[:& grid {:id id (mf/defc content
:type type [{:keys [id type collection] :as props}]
:coll coll (let [{:keys [selected] :as opts} (mf/deref opts-iref)]
:opts opts}] [:section.dashboard-grid.library
(when (seq (:selected opts)) (when collection
[:& grid-options {:id id :type type :selected (:selected opts)}])]])) [:& grid-header {:collection collection}])
(if collection
[:& grid {:id id :type type :collection collection :opts opts}]
[:span "EMPTY STATE TODO"])
(when-not (empty? selected)
[:& grid-options {:id id :type type :selected selected}])]))
;; --- Images Page ;; --- Images Page
(def collections-iref
(-> (l/key :images-collections)
(l/derive st/state)))
(mf/defc images-page (mf/defc images-page
[{:keys [id type] :as props}] [{:keys [id type] :as props}]
(let [colls (mf/deref collections-iref) (let [collections (mf/deref collections-iref)
colls (cond->> (vals colls) collections (cond->> (vals collections)
(= type :own) (filter #(= :own (:type %))) (= type :own) (filter #(= :own (:type %)))
(= type :builtin) (filter #(= :builtin (:type %))) (= type :builtin) (filter #(= :builtin (:type %)))
true (sort-by :created-at)) true (sort-by :created-at))
coll (cond collection (cond
(and (= type :own) (nil? id)) nil (uuid? id) (d/seek #(= id (:id %)) collections)
(uuid? id) (seek #(= id (:id %)) colls) :else (first collections))
:else (first colls)) id (:id collection)]
id (:id coll)]
(mf/use-effect #(st/emit! di/fetch-collections)) (mf/use-effect #(st/emit! di/fetch-collections))
(mf/use-effect {:fn #(st/emit! (di/fetch-images (:id coll))) (mf/use-effect
:deps #js [(str (:id coll))]}) {:fn #(when id (st/emit! (di/initialize id)))
:deps (mf/deps id)})
[:section.dashboard-content [:section.dashboard-content
[:& nav {:type type [:& nav {:type type :id id :collections collections}]
:id id [:& content {:type type :id id :collection collection}]]))
:colls colls}]
[:& content {:type type
:id id
:coll coll}]]))

View file

@ -6,7 +6,6 @@
(ns uxbox.main.ui.shapes.image (ns uxbox.main.ui.shapes.image
(:require (:require
[lentes.core :as l]
[rumext.alpha :as mf] [rumext.alpha :as mf]
[cuerdas.core :as str] [cuerdas.core :as str]
[uxbox.main.data.images :as udi] [uxbox.main.data.images :as udi]
@ -17,13 +16,6 @@
[uxbox.main.ui.shapes.common :as common] [uxbox.main.ui.shapes.common :as common]
[uxbox.util.geom.matrix :as gmt])) [uxbox.util.geom.matrix :as gmt]))
;; --- Refs
(defn image-ref
[id]
(-> (l/in [:images id])
(l/derive st/state)))
;; --- Image Wrapper ;; --- Image Wrapper
(declare image-shape) (declare image-shape)
@ -31,23 +23,17 @@
(mf/defc image-wrapper (mf/defc image-wrapper
[{:keys [shape] :as props}] [{:keys [shape] :as props}]
(let [selected (mf/deref refs/selected-shapes) (let [selected (mf/deref refs/selected-shapes)
image (mf/deref (image-ref (:image shape)))
selected? (contains? selected (:id shape)) selected? (contains? selected (:id shape))
on-mouse-down #(common/on-mouse-down % shape selected)] on-mouse-down #(common/on-mouse-down % shape selected)]
(mf/use-effect #(st/emit! (udi/fetch-image (:image shape))))
(when image
[:g.shape {:class (when selected? "selected") [:g.shape {:class (when selected? "selected")
:on-mouse-down on-mouse-down} :on-mouse-down on-mouse-down}
[:& image-shape {:shape shape [:& image-shape {:shape shape}]]))
:image image}]])))
;; --- Image Shape ;; --- Image Shape
(mf/defc image-shape (mf/defc image-shape
[{:keys [shape image] :as props}] [{:keys [shape] :as props}]
(let [{:keys [id rotation modifier-mtx]} shape (let [{:keys [id rotation modifier-mtx metadata]} shape
shape (cond shape (cond
(gmt/matrix? modifier-mtx) (geom/transform shape modifier-mtx) (gmt/matrix? modifier-mtx) (geom/transform shape modifier-mtx)
@ -60,13 +46,18 @@
rotation rotation
(+ x (/ width 2)) (+ x (/ width 2))
(+ y (/ height 2)))) (+ y (/ height 2))))
uri (if (or (> (:thumb-width metadata) width)
(> (:thumb-height metadata) height))
(:thumb-uri metadata)
(:uri metadata))
props (-> (attrs/extract-style-attrs shape) props (-> (attrs/extract-style-attrs shape)
(assoc :x x (assoc :x x
:y y :y y
:id (str "shape-" id) :id (str "shape-" id)
:preserveAspectRatio "none" :preserveAspectRatio "none"
:xlinkHref (:url image) :xlinkHref uri
:transform transform :transform transform
:width width :width width
:height height))] :height height))]

View file

@ -11,13 +11,14 @@
[rumext.alpha :as mf] [rumext.alpha :as mf]
[rumext.core :as mx] [rumext.core :as mx]
[uxbox.builtins.icons :as i] [uxbox.builtins.icons :as i]
[uxbox.common.data :as d]
[uxbox.main.data.images :as udi] [uxbox.main.data.images :as udi]
[uxbox.main.data.workspace :as dw] [uxbox.main.data.workspace :as dw]
[uxbox.main.store :as st] [uxbox.main.store :as st]
[uxbox.main.refs :as refs]
[uxbox.main.ui.modal :as modal] [uxbox.main.ui.modal :as modal]
[uxbox.util.data :refer [read-string jscoll->vec]]
[uxbox.util.dom :as dom] [uxbox.util.dom :as dom]
[uxbox.util.i18n :as t :refer [tr]] [uxbox.util.i18n :as i18n :refer [tr t]]
[uxbox.util.uuid :as uuid])) [uxbox.util.uuid :as uuid]))
;; --- Refs ;; --- Refs
@ -30,8 +31,13 @@
(-> (l/key :images) (-> (l/key :images)
(l/derive st/state))) (l/derive st/state)))
(def ^:private workspace-images-iref
(-> (comp (l/key :workspace-images)
(l/lens vals))
(l/derive st/state)))
(def ^:private uploading-iref (def ^:private uploading-iref
(-> (l/in [:dashboard :images :uploading]) (-> (l/in [:workspace-local :uploading])
(l/derive st/state))) (l/derive st/state)))
;; --- Import Image Modal ;; --- Import Image Modal
@ -41,38 +47,54 @@
(mf/defc import-image-modal (mf/defc import-image-modal
[props] [props]
(let [input (mf/use-ref nil) (let [input (mf/use-ref nil)
uploading? (mf/deref uploading-iref)] uploading? (mf/deref uploading-iref)
(letfn [(on-upload-click [event]
(let [input-el (mf/ref-node input)]
(dom/click input-el)))
(on-uploaded [[image]] on-upload-click #(dom/click (mf/ref-node input))
(let [{:keys [id name width height]} image
shape {:name name on-uploaded
:metadata {:width width (fn [{:keys [id name] :as image}]
:height height} (let [shape {:name name
:image id}] :metadata {:width (:width image)
:height (:height image)
:uri (:uri image)
:thumb-width (:thumb-width image)
:thumb-height (:thumb-height image)
:thumb-uri (:thumb-uri image)}}]
(st/emit! (dw/select-for-drawing :image shape)) (st/emit! (dw/select-for-drawing :image shape))
(modal/hide!))) (modal/hide!)))
(on-files-selected [event] on-files-selected
(let [files (dom/get-event-files event) (fn [event]
files (jscoll->vec files)] (st/emit! (-> (dom/get-target event)
(st/emit! (udi/create-images nil files on-uploaded)))) (dom/get-files)
(array-seq)
(first)
(dw/upload-image on-uploaded))))
(on-select-from-library [event] on-select-from-library
(fn [event]
(dom/prevent-default event) (dom/prevent-default event)
(modal/show! import-image-from-coll-modal {})) (modal/show! import-image-from-coll-modal {}))
(on-close [event] on-close
(fn [event]
(dom/prevent-default event) (dom/prevent-default event)
(modal/hide!))] (modal/hide!))]
[:div.lightbox-body [:div.lightbox-body
[:h3 (tr "image.new")] [:h3 (tr "image.new")]
[:div.row-flex [:div.row-flex
;; Select from collections
[:div.lightbox-big-btn {:on-click on-select-from-library} [:div.lightbox-big-btn {:on-click on-select-from-library}
[:span.big-svg i/image] [:span.big-svg i/image]
[:span.text (tr "image.select")]] [:span.text (tr "image.select")]]
;; Select from workspace
[:div.lightbox-big-btn {:on-click on-select-from-library}
[:span.big-svg i/image]
[:span.text (tr "image.select")]]
;; Direct image upload
[:div.lightbox-big-btn {:on-click on-upload-click} [:div.lightbox-big-btn {:on-click on-upload-click}
(if uploading? (if uploading?
[:span.big-svg.upload i/loader-pencil] [:span.big-svg.upload i/loader-pencil]
@ -80,77 +102,97 @@
[:span.text (tr "image.upload")] [:span.text (tr "image.upload")]
[:input.upload-image-input [:input.upload-image-input
{:style {:display "none"} {:style {:display "none"}
:accept "image/jpeg,image/png" :multiple false
:accept "image/jpeg,image/png,image/webp"
:type "file" :type "file"
:ref input :ref input
:on-change on-files-selected}]]] :on-change on-files-selected}]]]
[:a.close {:on-click on-close} i/close]]))) [:a.close {:on-click on-close} i/close]]))
;; --- Import Image from Collection Modal ;; --- Import Image from Collection Modal
(mf/defc image-item (mf/defc image-item
[{:keys [image] :as props}] [{:keys [image] :as props}]
(letfn [(on-click [event] (letfn [(on-click [event]
;; TODO: deduplicate this code...
(let [shape {:name (:name image) (let [shape {:name (:name image)
:metadata {:width (:width image) :metadata {:width (:width image)
:height (:height image)} :height (:height image)
:image (:id image)}] :uri (:uri image)
:thumb-width (:thumb-width image)
:thumb-height (:thumb-height image)
:thumb-uri (:thumb-uri image)}}]
(st/emit! (dw/select-for-drawing :image shape)) (st/emit! (dw/select-for-drawing :image shape))
(modal/hide!)))] (modal/hide!)))]
[:div.library-item {:on-click on-click} [:div.library-item {:on-click on-click}
[:div.library-item-th [:div.library-item-th
{:style {:background-image (str "url('" (:thumbnail image) "')")}}] {:style {:background-image (str "url('" (:thumb-uri image) "')")}}]
[:span (:name image)]])) [:span (:name image)]]))
(mf/defc image-collection
[{:keys [images] :as props}]
[:div.library-content
(for [image images]
[:& image-item {:image image :key (:id image)}])])
(mf/defc import-image-from-coll-modal (mf/defc import-image-from-coll-modal
[props] [props]
(let [local (mf/use-state {:id nil :type :own}) (let [locale (i18n/use-locale)
id (:id @local) local (mf/use-state {:collection-id nil :tab :file})
type (:type @local)
own? (= type :own) collections (mf/deref collections-iref)
builtin? (= type :builtin) collections (->> (vals collections)
colls (mf/deref collections-iref)
colls (->> (vals colls)
(filter #(= type (:type %)))
(sort-by :name)) (sort-by :name))
select-tab #(swap! local assoc :tab %)
collection-id (or (:collection-id @local)
(:id (first collections)))
tab (:tab @local)
images (mf/deref images-iref) images (mf/deref images-iref)
images (->> (vals images) images (->> (vals images)
(filter #(= id (:collection %)))) (filter #(= collection-id (:collection-id %))))
workspace-images (mf/deref workspace-images-iref)
on-close #(do (dom/prevent-default %) on-close #(do (dom/prevent-default %)
(modal/hide!)) (modal/hide!))
select-type #(swap! local assoc :type %)
on-change #(-> (dom/event->value %) on-change #(->> (dom/get-target %)
(read-string) (dom/get-value)
(swap! local assoc :id))] (d/read-string)
(swap! local assoc :collection-id))]
(mf/use-effect #(st/emit! udi/fetch-collections)) (mf/use-effect #(st/emit! udi/fetch-collections))
(mf/use-effect {:deps #js [(str id)] (mf/use-effect
:fn #(st/emit! (udi/fetch-images id))}) {:deps (mf/deps collection-id)
:fn #(when collection-id
(st/emit! (udi/fetch-images collection-id)))})
[:div.lightbox-body.big-lightbox [:div.lightbox-body.big-lightbox
[:h3 (tr "image.import-library")] [:h3 (tr "image.import-library")]
[:div.import-img-library [:div.import-img-library
[:div.library-actions [:div.library-actions
;; Tabs
[:ul.toggle-library [:ul.toggle-library
[:li.your-images {:class (when own? "current") [:li.your-images {:class (when (= tab :file) "current")
:on-click #(select-type :own)} :on-click #(select-tab :file)}
(tr "ds.your-images-title")] (t locale "ds.your-images-title")]
[:li.standard {:class (when builtin? "current") [:li.standard {:class (when (not= tab :file) "current")
:on-click #(select-type :builtin)} :on-click #(select-tab :collection)}
(tr "ds.store-images-title")]] (t locale "ds.store-images-title")]]
;; Collections dropdown
(when (= tab :collection)
[:select.input-select {:on-change on-change} [:select.input-select {:on-change on-change}
(when own? (for [coll collections]
[:option {:value (pr-str nil)} "Storage"])
(for [coll colls]
(let [id (:id coll) (let [id (:id coll)
name (:name coll)] name (:name coll)]
[:option {:key (str id) :value (pr-str id)} name]))]] [:option {:key (str id) :value (pr-str id)} name]))])]
[:& image-collection {:images images}]] (if (= tab :collection)
[:div.library-content
(for [image images]
[:& image-item {:image image :key (:id image)}])]
[:div.library-content
(for [image workspace-images]
[:& image-item {:image image :key (:id image)}])])]
[:a.close {:href "#" :on-click on-close} i/close]])) [:a.close {:href "#" :on-click on-close} i/close]]))

View file

@ -40,10 +40,7 @@
(mf/defc icons-list (mf/defc icons-list
[{:keys [collection-id] :as props}] [{:keys [collection-id] :as props}]
(let [icons-iref (mf/use-memo (let [icons (mf/deref icons/icons-iref)
{:fn #(icons/make-icons-iref collection-id)
:deps (mf/deps collection-id)})
icons (mf/deref icons-iref)
on-select on-select
(fn [event data] (fn [event data]

View file

@ -7,6 +7,8 @@
(ns uxbox.util.blob (ns uxbox.util.blob
"Helpers for work with HTML5 Blob objects.") "Helpers for work with HTML5 Blob objects.")
;; TODO: DEPRECATED
(defn ^boolean blob? (defn ^boolean blob?
[v] [v]
(instance? js/Blob v)) (instance? js/Blob v))

View file

@ -11,7 +11,10 @@
(ns uxbox.util.dom (ns uxbox.util.dom
(:require (:require
[goog.dom :as dom] [goog.dom :as dom]
[cuerdas.core :as str])) [cuerdas.core :as str]
[beicon.core :as rx]
[cuerdas.core :as str]
[uxbox.util.blob :as blob]))
;; --- Deprecated methods ;; --- Deprecated methods
@ -131,3 +134,5 @@
(defn query (defn query
[el query] [el query]
(.querySelector el query)) (.querySelector el query))

View file

@ -10,6 +10,8 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[uxbox.util.blob :as blob])) [uxbox.util.blob :as blob]))
;; TODO: DEPRECATED
(defn read-as-text (defn read-as-text
[file] [file]
(rx/create (rx/create

View file

@ -0,0 +1,68 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.util.webapi
"HTML5 web api helpers."
(:require
[beicon.core :as rx]
[cuerdas.core :as str]))
(defn read-file-as-text
[file]
(rx/create
(fn [sink]
(let [fr (js/FileReader.)]
(aset fr "onload" #(sink (rx/end (.-result fr))))
(.readAsText fr file)
(constantly nil)))))
(defn read-file-as-dataurl
[file]
(rx/create
(fn [sick]
(let [fr (js/FileReader.)]
(aset fr "onload" #(sick (rx/end (.-result fr))))
(.readAsDataURL fr file))
(constantly nil))))
(defn ^boolean blob?
[v]
(instance? js/Blob v))
(defn create-blob
"Create a blob from content."
([content]
(create-blob content "application/octet-stream"))
([content mtype]
(js/Blob. #js [content] #js {:type mtype})))
(defn revoke-uri
[url]
(assert (string? url) "invalid arguments")
(js/URL.revokeObjectURL url))
(defn create-uri
"Create a url from blob."
[b]
(assert (blob? b) "invalid arguments")
(js/URL.createObjectURL b))
;; (defn get-image-size
;; [file]
;; (letfn [(on-load [sink img]
;; (let [size [(.-width img) (.-height img)]]
;; (sink (rx/end size))))
;; (on-subscribe [sink]
;; (let [img (js/Image.)
;; uri (blob/create-uri file)]
;; (set! (.-onload img) (partial on-load sink img))
;; (set! (.-src img) uri)
;; #(blob/revoke-uri uri)))]
;; (rx/create on-subscribe)))