♻️ Big refactor of the default data model.

Introduce teams.
This commit is contained in:
Andrey Antukh 2020-02-17 09:49:04 +01:00
parent 6379c62e37
commit 7a5145fa37
65 changed files with 4529 additions and 3005 deletions

View file

@ -16,7 +16,8 @@
[cuerdas.core :as str]
[environ.core :refer [env]]
[mount.core :refer [defstate]]
[uxbox.common.exceptions :as ex]))
[uxbox.common.exceptions :as ex]
[uxbox.util.time :as tm]))
(def defaults
{:http-server-port 6060
@ -106,3 +107,6 @@
(defstate config
:start (read-config env))
(def default-deletion-delay
(tm/duration {:hours 48}))

View file

@ -12,173 +12,255 @@
[mount.core :as mount]
[promesa.core :as p]
[uxbox.config :as cfg]
[uxbox.common.data :as d]
[uxbox.core]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.migrations]
[uxbox.services.mutations.profile :as mt.profile]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]))
[uxbox.util.uuid :as uuid]
[vertx.util :as vu]))
(defn- mk-uuid
[prefix & args]
(uuid/namespaced uuid/oid (apply str prefix (interpose "-" args))))
;; --- Users creation
(def create-user-sql
"insert into users (id, fullname, username, email, password, photo)
values ($1, $2, $3, $4, $5, $6)
returning *;")
;; --- Profiles creation
(def password (pwhash/derive "123123"))
(defn create-user
[conn user-index]
(log/info "create user" user-index)
(let [sql create-user-sql
id (mk-uuid "user" user-index)
fullname (str "User " user-index)
username (str "user" user-index)
email (str "user" user-index ".test@uxbox.io")
photo ""]
(db/query-one conn [sql id fullname username email password photo])))
;; --- Project User Relation Creation
(def create-project-user-sql
"insert into project_users (project_id, user_id, can_edit)
values ($1, $2, true)
returning *")
(defn create-additional-project-user
[conn [project-index user-index]]
(log/info "create project user" user-index project-index)
(let [sql create-project-user-sql
project-id (mk-uuid "project" project-index user-index)
user-id (mk-uuid "user" (dec user-index))]
(db/query-one conn [sql project-id user-id])))
;; --- Projects creation
(def create-project-sql
"insert into projects (id, user_id, name)
(def sql:create-team
"insert into team (id, name, photo)
values ($1, $2, $3)
returning *;")
(defn create-project
[conn [project-index user-index]]
(log/info "create project" user-index project-index)
(let [sql create-project-sql
id (mk-uuid "project" project-index user-index)
user-id (mk-uuid "user" user-index)
name (str "project " project-index "," user-index)]
(p/do! (db/query-one conn [sql id user-id name])
(when (and (= project-index 0)
(> user-index 0))
(create-additional-project-user conn [project-index user-index])))))
(def sql:create-team-profile
"insert into team_profile_rel (team_id, profile_id, is_owner, is_admin, can_edit)
values ($1, $2, $3, $4, $5)
returning *;")
;; --- Create Page Files
(def sql:create-project
"insert into project (id, team_id, name)
values ($1, $2, $3)
returning *;")
(def create-file-sql
"insert into project_files (id, user_id, project_id, name)
values ($1, $2, $3, $4) returning id")
(def sql:create-project-profile
"insert into project_profile_rel (project_id, profile_id, is_owner, is_admin, can_edit)
values ($1, $2, $3, $4, $5)
returning *")
(defn create-file
[conn [file-index project-index user-index]]
(log/info "create page file" user-index project-index file-index)
(let [sql create-file-sql
id (mk-uuid "page-file" file-index project-index user-index)
user-id (mk-uuid "user" user-index)
project-id (mk-uuid "project" project-index user-index)
name (str "file " file-index "," project-index "," user-index)]
(db/query-one conn [sql id user-id project-id name])))
(def sql:create-file-profile
"insert into file_profile_rel (file_id, profile_id, is_owner, is_admin, can_edit)
values ($1, $2, $3, $4, $5)
returning *")
;; --- Create Pages
(def sql:create-file
"insert into file (id, project_id, name)
values ($1, $2, $3 ) returning *")
(def create-page-sql
"insert into project_pages (id, user_id, file_id, name,
version, ordering, data)
values ($1, $2, $3, $4, $5, $6, $7)
(def sql:create-page
"insert into page (id, file_id, name,
version, ordering, data)
values ($1, $2, $3, $4, $5, $6)
returning id;")
(def create-page-history-sql
"insert into project_page_history (page_id, user_id, version, data)
values ($1, $2, $3, $4)
returning id;")
(defn create-page
[conn [page-index file-index project-index user-index]]
(log/info "create page" user-index project-index file-index page-index)
(let [canvas {:id (mk-uuid "canvas" 1)
:name "Canvas-1"
:type :canvas
:x 200
:y 200
:width 1024
:height 768
:stroke-color "#000000"
:stroke-opacity 1
:fill-color "#ffffff"
:fill-opacity 1}
data {:version 1
:shapes []
:canvas [(:id canvas)]
:options {}
:shapes-by-id {(:id canvas) canvas}}
sql1 create-page-sql
sql2 create-page-history-sql
id (mk-uuid "page" page-index file-index project-index user-index)
user-id (mk-uuid "user" user-index)
file-id (mk-uuid "page-file" file-index project-index user-index)
name (str "page " page-index)
version 0
ordering page-index
data (blob/encode data)]
(p/do!
(db/query-one conn [sql1 id user-id file-id name version ordering data])
#_(db/query-one conn [sql2 id user-id version data]))))
(def preset-small
{:users 50
:projects 5
:files 5
:pages 3})
{:num-teams 50
:num-profiles 50
:num-profiles-per-team 5
:num-projects-per-team 5
:num-files-per-project 5
:num-pages-per-file 3
:num-draft-files-per-profile 10
:num-draft-pages-per-file 3})
(def preset-medium
{:users 500
:projects 20
:files 5
:pages 3})
(defn rng-ids
[rng n max]
(let [stream (->> (.longs rng 0 max)
(.iterator)
(iterator-seq))]
(reduce (fn [acc item]
(if (= (count acc) n)
(reduced acc)
(conj acc item)))
#{}
stream)))
(def preset-big
{:users 5000
:projects 50
:files 5
:pages 4})
(defn rng-vec
[rng vdata n]
(let [ids (rng-ids rng n (count vdata))]
(mapv #(nth vdata %) ids)))
(defn rng-nth
[rng vdata]
(let [stream (->> (.longs rng 0 (count vdata))
(.iterator)
(iterator-seq))]
(nth vdata (first stream))))
(defn collect
[f items]
(reduce (fn [acc n]
(p/then acc (fn [acc]
(p/then (f n)
(fn [res]
(conj acc res))))))
(p/promise [])
items))
(defn run
[opts]
(db/with-atomic [conn db/pool]
(p/do!
(p/run! #(create-user conn %) (range (:users opts)))
(p/run! #(create-project conn %)
(for [user-index (range (:users opts))
project-index (range (:projects opts))]
[project-index user-index]))
(p/run! #(create-file conn %)
(for [user-index (range (:users opts))
project-index (range (:projects opts))
file-index (range (:files opts))]
[file-index project-index user-index]))
(p/run! #(create-page conn %)
(for [user-index (range (:users opts))
project-index (range (:projects opts))
file-index (range (:files opts))
page-index (range (:pages opts))]
[page-index file-index project-index user-index]))
(p/promise nil))))
(let [rng (java.util.Random. 1)
create-profile
(fn [conn index]
(let [id (mk-uuid "profile" index)]
(log/info "create profile" id)
(mt.profile/register-profile conn
{:id id
:fullname (str "Profile " index)
:password "123123"
:demo? true
:email (str "profile" index ".test@uxbox.io")})))
create-profiles
(fn [conn]
(log/info "create profiles")
(collect (partial create-profile conn)
(range (:num-profiles opts))))
create-team
(fn [conn index]
(let [sql sql:create-team
id (mk-uuid "team" index)
name (str "Team" index)]
(log/info "create team" id)
(-> (db/query-one conn [sql id name ""])
(p/then (constantly id)))))
create-teams
(fn [conn]
(log/info "create teams")
(collect (partial create-team conn)
(range (:num-teams opts))))
create-page
(fn [conn owner-id project-id file-id index]
(p/let [id (mk-uuid "page" project-id file-id index)
data {:version 1
:shapes []
:canvas []
:options {}
:shapes-by-id {}}
name (str "page " index)
version 0
ordering index
data (blob/encode data)]
(log/info "create page" id)
(db/query-one conn [sql:create-page
id file-id name version ordering data])))
create-pages
(fn [conn owner-id project-id file-id]
(log/info "create pages")
(p/run! (partial create-page conn owner-id project-id file-id)
(range (:num-pages-per-file opts))))
create-file
(fn [conn owner-id project-id index]
(p/let [id (mk-uuid "file" project-id index)
name (str "file" index)]
(log/info "create file" id)
(db/query-one conn [sql:create-file id project-id name])
(db/query-one conn [sql:create-file-profile
id owner-id true true true])
id))
create-files
(fn [conn owner-id project-id]
(log/info "create files")
(p/let [file-ids (collect (partial create-file conn owner-id project-id)
(range (:num-files-per-project opts)))]
(p/run! (partial create-pages conn owner-id project-id) file-ids)))
create-project
(fn [conn team-id owner-id index]
(p/let [id (mk-uuid "project" team-id index)
name (str "project " index)]
(log/info "create project" id)
(db/query-one conn [sql:create-project id team-id name])
(db/query-one conn [sql:create-project-profile
id owner-id true true true])
id))
create-projects
(fn [conn team-id profile-ids]
(log/info "create projects")
(p/let [owner-id (rng-nth rng profile-ids)
project-ids (collect (partial create-project conn team-id owner-id)
(range (:num-projects-per-team opts)))]
(p/run! (partial create-files conn owner-id) project-ids)))
assign-profile-to-team
(fn [conn team-id owner? profile-id]
(let [sql sql:create-team-profile]
(db/query-one conn [sql team-id profile-id owner? true true])))
setup-team
(fn [conn team-id profile-ids]
(log/info "setup team" team-id profile-ids)
(p/do!
(assign-profile-to-team conn team-id true (first profile-ids))
(p/run! (partial assign-profile-to-team conn team-id false)
(rest profile-ids))
(create-projects conn team-id profile-ids)))
assign-teams-and-profiles
(fn [conn teams profiles]
(log/info "assign teams and profiles")
(vu/loop [team-id (first teams)
teams (rest teams)]
(when-not (nil? team-id)
(p/let [n-profiles-team (:num-profiles-per-team opts)
selected-profiles (rng-vec rng profiles n-profiles-team)]
(setup-team conn team-id selected-profiles)
(p/recur (first teams)
(rest teams))))))
create-draft-pages
(fn [conn owner-id file-id]
(log/info "create draft pages")
(p/run! (partial create-page conn owner-id nil file-id)
(range (:num-draft-pages-per-file opts))))
create-draft-file
(fn [conn owner index]
(p/let [owner-id (:id owner)
id (mk-uuid "file" "draft" owner-id index)
name (str "file" index)
project-id (:id (:default-project owner))]
(log/info "create draft file" id)
(db/query-one conn [sql:create-file id project-id name])
(db/query-one conn [sql:create-file-profile
id owner-id true true true])
id))
create-draft-files
(fn [conn profile]
(p/let [file-ids (collect (partial create-draft-file conn profile)
(range (:num-draft-files-per-profile opts)))]
(p/run! (partial create-draft-pages conn (:id profile)) file-ids)))
]
(db/with-atomic [conn db/pool]
(p/let [profiles (create-profiles conn)
teams (create-teams conn)]
(assign-teams-and-profiles conn teams (map :id profiles))
(p/run! (partial create-draft-files conn) profiles)))))
(defn -main
[& args]
@ -190,8 +272,8 @@
(mount/start))
(let [preset (case (first args)
(nil "small") preset-small
"medium" preset-medium
"big" preset-big
;; "medium" preset-medium
;; "big" preset-big
preset-small)]
(log/info "Using preset:" (pr-str preset))
(deref (run preset)))

View file

@ -34,8 +34,8 @@
(let [type (keyword (get-in req [:path-params :type]))
data (merge (:params req)
{::sq/type type
:user (:user req)})]
(if (or (:user req)
:profile-id (:profile-id req)})]
(if (or (:profile-id req)
(isa? query-types-hierarchy type ::unauthenticated))
(-> (sq/handle (with-meta data {:req req}))
(p/then' (fn [result]
@ -52,8 +52,8 @@
(:body-params req)
(:uploads req)
{::sm/type type
:user (:user req)})]
(if (or (:user req)
:profile-id (:profile-id req)})]
(if (or (:profile-id req)
(isa? mutation-types-hierarchy type ::unauthenticated))
(-> (sm/handle (with-meta data {:req req}))
(p/then' (fn [result]
@ -66,12 +66,11 @@
[req]
(let [data (:body-params req)
user-agent (get-in req [:headers "user-agent"])]
(-> (sm/handle (assoc data ::sm/type :login))
(p/then #(session/create (:id %) user-agent))
(p/then' (fn [token]
{:status 204
:cookies {"auth-token" {:value token :path "/"}}
:body ""})))))
(p/let [profile (sm/handle (assoc data ::sm/type :login))
token (session/create (:id profile) user-agent)]
{:status 200
:cookies {"auth-token" {:value token :path "/"}}
:body profile})))
(defn logout-handler
[req]
@ -83,22 +82,10 @@
:cookies {"auth-token" nil}
:body ""})))))
;; (defn register-handler
;; [req]
;; (let [data (merge (:body-params req)
;; {::sm/type :register-profile})
;; user-agent (get-in req [:headers "user-agent"])]
;; (-> (sm/handle (with-meta data {:req req}))
;; (p/then (fn [{:keys [id] :as user}]
;; (session/create id user-agent)))
;; (p/then' (fn [token]
;; {:status 204
;; :body ""})))))
(defn echo-handler
[req]
{:status 200
:body {:params (:params req)
:cookies (:cookies req)
:headers (:headers req)}})
(p/promise {:status 200
:body {:params (:params req)
:cookies (:cookies req)
:headers (:headers req)}}))

View file

@ -17,26 +17,26 @@
"Retrieves a user id associated with the provided auth token."
[token]
(when token
(let [sql "select user_id from sessions where id = $1"]
(let [sql "select profile_id from session where id = $1"]
(-> (db/query-one db/pool [sql token])
(p/then' (fn [row] (when row (:user-id row))))))))
(p/then' (fn [row] (when row (:profile-id row))))))))
(defn create
[user-id user-agent]
(let [id (uuid/random)
sql "insert into sessions (id, user_id, user_agent) values ($1, $2, $3)"]
sql "insert into session (id, profile_id, user_agent) values ($1, $2, $3)"]
(-> (db/query-one db/pool [sql id user-id user-agent])
(p/then (constantly (str id))))))
(defn delete
[token]
(let [sql "delete from sessions where id = $1"]
(let [sql "delete from session where id = $1"]
(-> (db/query-one db/pool [sql token])
(p/then' (constantly nil)))))
;; --- Interceptor
(defn parse-token
(defn- parse-token
[request]
(try
(when-let [token (get-in request [:cookies "auth-token"])]

View file

@ -37,8 +37,7 @@
;; --- State Management
(defonce state
(atom {}))
(def state (atom {}))
(defn send!
[{:keys [output] :as ws} message]
@ -50,15 +49,15 @@
(fn [ws message] (:type message)))
(defmethod handle-message :connect
[{:keys [file-id user-id] :as ws} message]
(let [local (swap! state assoc-in [file-id user-id] ws)
[{:keys [file-id profile-id] :as ws} message]
(let [local (swap! state assoc-in [file-id profile-id] ws)
sessions (get local file-id)
message {:type :who :users (set (keys sessions))}]
(p/run! #(send! % message) (vals sessions))))
(defmethod handle-message :disconnect
[{:keys [user-id] :as ws} {:keys [file-id] :as message}]
(let [local (swap! state update file-id dissoc user-id)
[{:keys [profile-id] :as ws} {:keys [file-id] :as message}]
(let [local (swap! state update file-id dissoc profile-id)
sessions (get local file-id)
message {:type :who :users (set (keys sessions))}]
(p/run! #(send! % message) (vals sessions))))
@ -69,14 +68,14 @@
(send! ws {:type :who :users (set users)})))
(defmethod handle-message :pointer-update
[{:keys [user-id file-id] :as ws} message]
[{:keys [profile-id file-id] :as ws} message]
(let [sessions (->> (vals (get @state file-id))
(remove #(= user-id (:user-id %))))
message (assoc message :user-id user-id)]
(remove #(= profile-id (:profile-id %))))
message (assoc message :profile-id profile-id)]
(p/run! #(send! % message) sessions)))
(defn- on-eventbus-message
[{:keys [file-id user-id] :as ws} {:keys [body] :as message}]
[{:keys [file-id profile-id] :as ws} {:keys [body] :as message}]
(send! ws body))
(defn- start-eventbus-consumer!
@ -90,9 +89,9 @@
[ws req]
(let [ctx (vu/current-context)
file-id (get-in req [:path-params :file-id])
user-id (:user req)
profile-id (:profile-id req)
ws (assoc ws
:user-id user-id
:profile-id profile-id
:file-id file-id)
send-ping #(send! ws {:type :ping})
sem1 (start-eventbus-consumer! ctx ws file-id)

View file

@ -35,6 +35,9 @@
{:desc "Initial icons tables"
:name "0006-icons"
:fn (mg/resource "migrations/0006.icons.sql")}
{:desc "Initial colors tables"
:name "0007-colors"
:fn (mg/resource "migrations/0007.colors.sql")}
]})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

View file

@ -16,22 +16,26 @@
[]
(require 'uxbox.services.queries.icons)
(require 'uxbox.services.queries.images)
(require 'uxbox.services.queries.colors)
(require 'uxbox.services.queries.projects)
(require 'uxbox.services.queries.project-files)
(require 'uxbox.services.queries.project-pages)
(require 'uxbox.services.queries.files)
(require 'uxbox.services.queries.pages)
(require 'uxbox.services.queries.profile)
(require 'uxbox.services.queries.user-attrs))
;; (require 'uxbox.services.queries.user-attrs)
)
(defn- load-mutation-services
[]
(require 'uxbox.services.mutations.demo)
(require 'uxbox.services.mutations.icons)
(require 'uxbox.services.mutations.images)
(require 'uxbox.services.mutations.colors)
(require 'uxbox.services.mutations.projects)
(require 'uxbox.services.mutations.project-files)
(require 'uxbox.services.mutations.project-pages)
(require 'uxbox.services.mutations.files)
(require 'uxbox.services.mutations.pages)
(require 'uxbox.services.mutations.profile)
(require 'uxbox.services.mutations.user-attrs))
;; (require 'uxbox.services.mutations.user-attrs)
)
(defstate query-services
:start (load-query-services))

View file

@ -0,0 +1,219 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.colors
(:require
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[datoteka.storages :as ds]
[promesa.core :as p]
[promesa.exec :as px]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.tasks :as tasks]
[uxbox.services.queries.colors :refer [decode-row]]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]
[vertx.util :as vu]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id ::us/uuid)
(s/def ::content ::us/string)
;; --- Mutation: Create Collection
(declare create-color-collection)
(s/def ::create-color-collection
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(sm/defmutation ::create-color-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(create-color-collection conn params)))
(def ^:private sql:create-color-collection
"insert into color_collection (id, profile_id, name)
values ($1, $2, $3)
returning *;")
(defn- create-color-collection
[conn {:keys [id profile-id name] :as params}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-color-collection id profile-id name])))
;; --- Collection Permissions Check
(def ^:private sql:select-collection
"select id, profile_id
from color_collection
where id=$1 and deleted_at is null
for update")
(defn- check-collection-edition-permissions!
[conn profile-id coll-id]
(p/let [coll (-> (db/query-one conn [sql:select-collection coll-id])
(p/then' su/raise-not-found-if-nil))]
(when (not= (:profile-id coll) profile-id)
(ex/raise :type :validation
:code :not-authorized))))
;; --- Mutation: Update Collection
(def ^:private sql:rename-collection
"update color_collection
set name = $2
where id = $1
returning *")
(s/def ::rename-color-collection
(s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-color-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id id)
(db/query-one conn [sql:rename-collection id name])))
;; --- Copy Color
;; (declare create-color)
;; (defn- retrieve-color
;; [conn {:keys [profile-id id]}]
;; (let [sql "select * from color
;; where id = $1
;; and deleted_at is null
;; and (profile_id = $2 or
;; profile_id = '00000000-0000-0000-0000-000000000000'::uuid)"]
;; (-> (db/query-one conn [sql id profile-id])
;; (p/then' su/raise-not-found-if-nil))))
;; (s/def ::copy-color
;; (s/keys :req-un [:us/id ::collection-id ::profile-id]))
;; (sm/defmutation ::copy-color
;; [{:keys [profile-id id collection-id] :as params}]
;; (db/with-atomic [conn db/pool]
;; (-> (retrieve-color conn {:profile-id profile-id :id id})
;; (p/then (fn [color]
;; (let [color (-> (dissoc color :id)
;; (assoc :collection-id collection-id))]
;; (create-color conn color)))))))
;; --- Delete Collection
(def ^:private sql:mark-collection-deleted
"update color_collection
set deleted_at = clock_timestamp()
where id = $1
returning id")
(s/def ::delete-color-collection
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-color-collection
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id id)
(-> (db/query-one conn [sql:mark-collection-deleted id])
(p/then' su/constantly-nil))))
;; --- Mutation: Create Color (Upload)
(declare create-color)
(s/def ::create-color
(s/keys :req-un [::profile-id ::name ::content ::collection-id]
:opt-un [::id]))
(sm/defmutation ::create-color
[{:keys [profile-id collection-id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id collection-id)
(create-color conn params)))
(def ^:private sql:create-color
"insert into color (id, profile_id, name, collection_id, content)
values ($1, $2, $3, $4, $5) returning *")
(defn create-color
[conn {:keys [id profile-id name collection-id content]}]
(let [id (or id (uuid/next))]
(-> (db/query-one conn [sql:create-color id profile-id name collection-id content])
(p/then' decode-row))))
;; --- Mutation: Update Color
(def ^:private sql:update-color
"update color
set name = $3,
collection_id = $4
where id = $1
and profile_id = $2
returning *")
(s/def ::update-color
(s/keys :req-un [::id ::profile-id ::name ::collection-id]))
(sm/defmutation ::update-color
[{:keys [id name profile-id collection-id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id collection-id)
(-> (db/query-one db/pool [sql:update-color id profile-id name collection-id])
(p/then' su/raise-not-found-if-nil))))
;; --- Mutation: Delete Color
(def ^:private sql:mark-color-deleted
"update color
set deleted_at = clock_timestamp()
where id = $1
and profile_id = $2
returning id")
(s/def ::delete-color
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-color
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (db/query-one conn [sql:mark-color-deleted id profile-id])
(p/then' su/raise-not-found-if-nil))
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :color}})
nil))

View file

@ -11,36 +11,16 @@
"A demo specific mutations."
(:require
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[datoteka.storages :as ds]
[promesa.core :as p]
[promesa.exec :as px]
[sodi.prng]
[sodi.pwhash]
[sodi.util]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.emails :as emails]
[uxbox.images :as images]
[uxbox.media :as media]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.services.mutations.profile :as profile]
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]
[uxbox.util.time :as tm]
[vertx.core :as vc]))
(def sql:insert-user
"insert into users (id, fullname, email, password, photo, is_demo)
values ($1, $2, $3, $4, '', true) returning *")
(def sql:insert-email
"insert into user_emails (user_id, email, is_main)
values ($1, $2, true)")
[uxbox.util.time :as tm]))
(sm/defmutation ::create-demo-profile
[_]
@ -49,15 +29,17 @@
email (str "demo-" sem ".demo@nodomain.com")
fullname (str "Demo User " sem)
password (-> (sodi.prng/random-bytes 12)
(sodi.util/bytes->b64s))
password' (sodi.pwhash/derive password)]
(sodi.util/bytes->b64s))]
(db/with-atomic [conn db/pool]
(db/query-one conn [sql:insert-user id fullname email password'])
(db/query-one conn [sql:insert-email id email])
(#'profile/register-profile conn {:id id
:email email
:fullname fullname
:demo? true
:password password})
;; Schedule deletion of the demo profile
(tasks/schedule! conn {:name "remove-demo-profile"
:delay (tm/duration {:hours 48})
:props {:id id}})
(tasks/schedule! conn {:name "delete-profile"
:delay cfg/default-deletion-delay
:props {:profile-id id}})
{:email email
:password password})))

View file

@ -0,0 +1,242 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.files
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.pages :as cp]
[uxbox.tasks :as tasks]
[uxbox.services.queries.files :as files]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.projects :as proj]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
;; --- Mutation: Create Project File
(declare create-file)
(declare create-page)
(s/def ::create-file
(s/keys :req-un [::profile-id ::name ::project-id]
:opt-un [::id]))
(sm/defmutation ::create-file
[{:keys [profile-id project-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [file (create-file conn params)
page (create-page conn (assoc params :file-id (:id file)))]
(assoc file :pages [(:id page)]))))
(def ^:private sql:create-file
"insert into file (id, project_id, name)
values ($1, $2, $3) returning *")
(def ^:private sql:create-file-profile
"insert into file_profile_rel (profile_id, file_id, is_owner, is_admin, can_edit)
values ($1, $2, true, true, true) returning *")
(def ^:private sql:create-page
"insert into page (id, file_id, name, ordering, data)
values ($1, $2, $3, $4, $5) returning id")
(defn- create-file-profile
[conn {:keys [profile-id file-id] :as params}]
(db/query-one conn [sql:create-file-profile profile-id file-id]))
(defn- create-file
[conn {:keys [id profile-id name project-id] :as params}]
(p/let [id (or id (uuid/next))
file (db/query-one conn [sql:create-file id project-id name])]
(->> (assoc params :file-id id)
(create-file-profile conn))
file))
(defn- create-page
[conn {:keys [file-id] :as params}]
(let [id (uuid/next)
name "Page 1"
data (blob/encode cp/default-page-data)]
(db/query-one conn [sql:create-page id file-id name 1 data])))
;; --- Mutation: Rename File
(declare rename-file)
(s/def ::rename-file
(s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-file
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id id)
(rename-file conn params)))
(def ^:private sql:rename-file
"update file
set name = $2
where id = $1
and deleted_at is null")
(defn- rename-file
[conn {:keys [id name] :as params}]
(-> (db/query-one conn [sql:rename-file id name])
(p/then' su/constantly-nil)))
;; --- Mutation: Delete Project File
(declare mark-file-deleted)
(s/def ::delete-file
(s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-file
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id id)
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :file}})
(mark-file-deleted conn params)))
(def ^:private sql:mark-file-deleted
"update file
set deleted_at = clock_timestamp()
where id = $1
and deleted_at is null")
(defn mark-file-deleted
[conn {:keys [id] :as params}]
(-> (db/query-one conn [sql:mark-file-deleted id])
(p/then' su/constantly-nil)))
;; --- Mutation: Upload File Image
(declare create-file-image)
(s/def ::file-id ::us/uuid)
(s/def ::content ::imgs/upload)
(s/def ::upload-file-image
(s/keys :req-un [::profile-id ::file-id ::name ::content]
:opt-un [::id]))
(sm/defmutation ::upload-file-image
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(create-file-image conn params)))
(def ^:private sql:insert-file-image
"insert into file_image
(file_id, name, path, width, height, mtype,
thumb_path, thumb_width, thumb_height,
thumb_quality, thumb_mtype)
values ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11)
returning *")
(defn- create-file-image
[conn {:keys [content file-id name] :as params}]
(when-not (imgs/valid-image-types? (:mtype content))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
(p/let [image-opts (vu/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
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)
(declare import-image-to-file)
(s/def ::import-image-to-file
(s/keys :req-un [::image-id ::file-id ::profile-id]))
(def ^:private sql:select-image-by-id
"select img.* from image as img where id=$1")
(sm/defmutation ::import-image-to-file
[{:keys [image-id file-id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(import-image-to-file conn params)))
(defn- import-image-to-file
[conn {:keys [image-id file-id] :as params}]
(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
(: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]
(vu/blocking
(let [image-path (ust/lookup media/media-storage path)]
(ust/save! media/media-storage (fs/name image-path) image-path))))

View file

@ -2,26 +2,40 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.icons
(:require
[clojure.spec.alpha :as s]
[datoteka.core :as fs]
[datoteka.storages :as ds]
[promesa.core :as p]
[uxbox.db :as db]
[promesa.exec :as px]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.tasks :as tasks]
[uxbox.services.queries.icons :refer [decode-row]]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.services.queries.icons :refer [decode-icon-row]]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]))
[uxbox.util.data :as data]
[uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id ::us/uuid)
(s/def ::width ::us/integer)
(s/def ::height ::us/integer)
@ -36,128 +50,188 @@
(s/def ::metadata
(s/keys :opt-un [::width ::height ::view-box ::mimetype]))
;; --- Mutation: Create Collection
(s/def ::create-icons-collection
(s/keys :req-un [::user ::name]
(declare create-icon-collection)
(s/def ::create-icon-collection
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(sm/defmutation ::create-icons-collection
[{:keys [id user name] :as params}]
(let [id (or id (uuid/next))
sql "insert into icon_collections (id, user_id, name)
values ($1, $2, $3) returning *"]
(db/query-one db/pool [sql id user name])))
(sm/defmutation ::create-icon-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(create-icon-collection conn params)))
(def ^:private sql:create-icon-collection
"insert into icon_collection (id, profile_id, name)
values ($1, $2, $3)
returning *;")
(defn- create-icon-collection
[conn {:keys [id profile-id name] :as params}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-icon-collection id profile-id name])))
;; --- Collection Permissions Check
(def ^:private sql:select-collection
"select id, profile_id
from icon_collection
where id=$1 and deleted_at is null
for update")
(defn- check-collection-edition-permissions!
[conn profile-id coll-id]
(p/let [coll (-> (db/query-one conn [sql:select-collection coll-id])
(p/then' su/raise-not-found-if-nil))]
(when (not= (:profile-id coll) profile-id)
(ex/raise :type :validation
:code :not-authorized))))
;; --- Mutation: Update Collection
(s/def ::update-icons-collection
(s/keys :req-un [::user ::name ::id]))
(def ^:private sql:rename-collection
"update icon_collection
set name = $2
where id = $1
returning *")
(sm/defmutation ::update-icons-collection
[{:keys [id user name] :as params}]
(let [sql "update icon_collections
set name = $3
where id = $1
and user_id = $2
returning *"]
(-> (db/query-one db/pool [sql id user name])
(p/then' su/raise-not-found-if-nil))))
(s/def ::rename-icon-collection
(s/keys :req-un [::profile-id ::name ::id]))
;; --- Copy Icon
(declare create-icon)
(defn- retrieve-icon
[conn {:keys [user id]}]
(let [sql "select * from icons
where id = $1
and deleted_at is null
and (user_id = $2 or
user_id = '00000000-0000-0000-0000-000000000000'::uuid)"]
(-> (db/query-one conn [sql id user])
(p/then' su/raise-not-found-if-nil))))
(s/def ::copy-icon
(s/keys :req-un [:us/id ::collection-id ::user]))
(sm/defmutation ::copy-icon
[{:keys [user id collection-id] :as params}]
(sm/defmutation ::rename-icon-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(-> (retrieve-icon conn {:user user :id id})
(p/then (fn [icon]
(let [icon (-> (dissoc icon :id)
(assoc :collection-id collection-id))]
(create-icon conn icon)))))))
(check-collection-edition-permissions! conn profile-id id)
(db/query-one conn [sql:rename-collection id name])))
;; ;; --- Copy Icon
;; (declare create-icon)
;; (defn- retrieve-icon
;; [conn {:keys [profile-id id]}]
;; (let [sql "select * from icon
;; where id = $1
;; and deleted_at is null
;; and (profile_id = $2 or
;; profile_id = '00000000-0000-0000-0000-000000000000'::uuid)"]
;; (-> (db/query-one conn [sql id profile-id])
;; (p/then' su/raise-not-found-if-nil))))
;; (s/def ::copy-icon
;; (s/keys :req-un [:us/id ::collection-id ::profile-id]))
;; (sm/defmutation ::copy-icon
;; [{:keys [profile-id id collection-id] :as params}]
;; (db/with-atomic [conn db/pool]
;; (-> (retrieve-icon conn {:profile-id profile-id :id id})
;; (p/then (fn [icon]
;; (let [icon (-> (dissoc icon :id)
;; (assoc :collection-id collection-id))]
;; (create-icon conn icon)))))))
;; --- Delete Collection
(s/def ::delete-icons-collection
(s/keys :req-un [::user ::id]))
(def ^:private sql:mark-collection-deleted
"update icon_collection
set deleted_at = clock_timestamp()
where id = $1
returning id")
(sm/defmutation ::delete-icons-collection
[{:keys [user id] :as params}]
(let [sql "update icon_collections
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning id"]
(-> (db/query-one db/pool [sql id user])
(p/then' su/raise-not-found-if-nil)
(s/def ::delete-icon-collection
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-icon-collection
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id id)
(-> (db/query-one conn [sql:mark-collection-deleted id])
(p/then' su/constantly-nil))))
;; --- Mutation: Create Icon (Upload)
(def ^:private create-icon-sql
"insert into icons (user_id, name, collection_id, content, metadata)
values ($1, $2, $3, $4, $5) returning *")
(defn create-icon
[conn {:keys [id user name collection-id metadata content]}]
(let [id (or id (uuid/next))
sqlv [create-icon-sql user name
collection-id
content
(blob/encode metadata)]]
(-> (db/query-one conn sqlv)
(p/then' decode-icon-row))))
(declare create-icon)
(s/def ::create-icon
(s/keys :req-un [::user ::name ::metadata ::content]
:opt-un [::id ::collection-id]))
(s/keys :req-un [::profile-id ::name ::metadata ::content ::collection-id]
:opt-un [::id]))
(sm/defmutation ::create-icon
[params]
(create-icon db/pool params))
[{:keys [profile-id collection-id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id collection-id)
(create-icon conn params)))
(def ^:private sql:create-icon
"insert into icon (id, profile_id, name, collection_id, content, metadata)
values ($1, $2, $3, $4, $5, $6) returning *")
(defn create-icon
[conn {:keys [id profile-id name collection-id metadata content]}]
(let [id (or id (uuid/next))]
(-> (db/query-one conn [sql:create-icon id profile-id name
collection-id content (blob/encode metadata)])
(p/then' decode-row))))
;; --- Mutation: Update Icon
(def ^:private sql:update-icon
"update icon
set name = $3,
collection_id = $4
where id = $1
and profile_id = $2
returning *")
(s/def ::update-icon
(s/keys :req-un [::id ::user ::name ::collection-id]))
(s/keys :req-un [::id ::profile-id ::name ::collection-id]))
(sm/defmutation ::update-icon
[{:keys [id name user collection-id] :as params}]
(let [sql "update icons
set name = $1,
collection_id = $2
where id = $3
and user_id = $4
returning *"]
(-> (db/query-one db/pool [sql name collection-id id user])
[{:keys [id name profile-id collection-id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id collection-id)
(-> (db/query-one db/pool [sql:update-icon id profile-id name collection-id])
(p/then' su/raise-not-found-if-nil))))
;; --- Mutation: Delete Icon
(def ^:private sql:mark-icon-deleted
"update icon
set deleted_at = clock_timestamp()
where id = $1
and profile_id = $2
returning id")
(s/def ::delete-icon
(s/keys :req-un [::user ::id]))
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-icon
[{:keys [id user] :as params}]
(let [sql "update icons
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning id"]
(-> (db/query-one db/pool [sql id user])
(p/then' su/raise-not-found-if-nil)
(p/then' su/constantly-nil))))
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (db/query-one conn [sql:mark-icon-deleted id profile-id])
(p/then' su/raise-not-found-if-nil))
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :icon}})
nil))

View file

@ -2,6 +2,9 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.images
@ -13,9 +16,11 @@
[promesa.exec :as px]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.tasks :as tasks]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
@ -32,69 +37,102 @@
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id ::us/uuid)
;; --- Create Collection
(declare create-images-collection)
(declare create-image-collection)
(s/def ::create-images-collection
(s/keys :req-un [::user ::us/name]
(s/def ::create-image-collection
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(sm/defmutation ::create-images-collection
[{:keys [id user name] :as params}]
(sm/defmutation ::create-image-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(create-images-collection conn params)))
(create-image-collection conn params)))
(defn create-images-collection
[conn {:keys [id user name] :as params}]
(let [id (or id (uuid/next))
sql "insert into image_collections (id, user_id, name)
values ($1, $2, $3)
on conflict (id) do nothing
returning *;"]
(db/query-one db/pool [sql id user name])))
;; --- Update Collection
(def ^:private
sql:rename-images-collection
"update image_collections
set name = $3
where id = $1
and user_id = $2
(def ^:private sql:create-image-collection
"insert into image_collection (id, profile_id, name)
values ($1, $2, $3)
returning *;")
(s/def ::rename-images-collection
(s/keys :req-un [::id ::user ::us/name]))
(defn- create-image-collection
[conn {:keys [id profile-id name] :as params}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-image-collection id profile-id name])))
(sm/defmutation ::rename-images-collection
[{:keys [id user name] :as params}]
;; --- Collection Permissions Check
(def ^:private sql:select-collection
"select id, profile_id
from image_collection
where id=$1 and deleted_at is null
for update")
(defn- check-collection-edition-permissions!
[conn profile-id coll-id]
(p/let [coll (-> (db/query-one conn [sql:select-collection coll-id])
(p/then' su/raise-not-found-if-nil))]
(when (not= (:profile-id coll) profile-id)
(ex/raise :type :validation
:code :not-authorized))))
;; --- Rename Collection
(def ^:private sql:rename-image-collection
"update image_collection
set name = $2
where id = $1
returning *;")
(s/def ::rename-image-collection
(s/keys :req-un [::id ::profile-id ::us/name]))
(sm/defmutation ::rename-image-collection
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(db/query-one conn [sql:rename-images-collection id user name])))
(check-collection-edition-permissions! conn profile-id id)
(db/query-one conn [sql:rename-image-collection id name])))
;; --- Delete Collection
(s/def ::delete-images-collection
(s/keys :req-un [::user ::id]))
(s/def ::delete-image-collection
(s/keys :req-un [::profile-id ::id]))
(def ^:private
sql:delete-images-collection
"update image_collections
(def ^:private sql:mark-image-collection-as-deleted
"update image_collection
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning id")
(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)))
(sm/defmutation ::delete-image-collection
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(check-collection-edition-permissions! conn profile-id id)
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :image-collection}})
(-> (db/query-one conn [sql:mark-image-collection-as-deleted id])
(p/then' su/raise-not-found-if-nil)
(p/then' su/constantly-nil))))
;; --- Create Image (Upload)
(declare select-collection-for-update)
(declare create-image)
(declare persist-image-on-fs)
(declare persist-image-thumbnail-on-fs)
@ -113,31 +151,27 @@
:uxbox$upload/path
:uxbox$upload/mtype]))
(s/def ::collection-id ::us/uuid)
(s/def ::content ::upload)
(s/def ::upload-image
(s/keys :req-un [::user ::name ::content ::collection-id]
(s/keys :req-un [::profile-id ::name ::content ::collection-id]
:opt-un [::id]))
(sm/defmutation ::upload-image
[{:keys [collection-id user] :as params}]
[{:keys [collection-id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [coll (select-collection-for-update conn collection-id)]
(when (not= (:user-id coll) user)
(ex/raise :type :validation
:code :not-authorized))
(create-image conn params))))
(check-collection-edition-permissions! conn profile-id collection-id)
(create-image conn params)))
(def ^:private sql:insert-image
"insert into images
(id, collection_id, user_id, name, path, width, height, mtype,
"insert into image
(id, collection_id, profile_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}]
[conn {:keys [id content collection-id profile-id name] :as params}]
(when-not (valid-image-types? (:mtype content))
(ex/raise :type :validation
:code :image-type-not-allowed
@ -151,7 +185,7 @@
sqlv [sql:insert-image
id
collection-id
user
profile-id
name
(str image-path)
(:width image-opts)
@ -167,16 +201,6 @@
(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}]
(vu/blocking
@ -193,32 +217,37 @@
(str "thumbnail-" filename))]
(ust/save! media/media-storage thumb-name thumb-data))))
;; --- Update Image
(s/def ::update-image
(s/keys :req-un [::id ::user ::name ::collection-id]))
(s/keys :req-un [::id ::profile-id ::name ::collection-id]))
(def ^:private sql:update-image
"update images
"update image
set name = $3,
collection_id = $2
where id = $1
and user_id = $4
and profile_id = $4
returning *;")
(sm/defmutation ::update-image
[{:keys [id name user collection-id] :as params}]
(db/query-one db/pool [sql:update-image id collection-id name user]))
[{:keys [id name profile-id collection-id] :as params}]
(-> (db/query-one db/pool [sql:update-image id
collection-id name profile-id])
(p/then' su/raise-not-found-if-nil)))
;; --- Copy Image
(declare retrieve-image)
;; (declare retrieve-image)
;; (s/def ::copy-image
;; (s/keys :req-un [::id ::collection-id ::user]))
;; (s/keys :req-un [::id ::collection-id ::profile-id]))
;; (sm/defmutation ::copy-image
;; [{:keys [user id collection-id] :as params}]
;; [{:keys [profile-id id collection-id] :as params}]
;; (letfn [(copy-image [conn {:keys [path] :as image}]
;; (-> (ds/lookup media/images-storage (:path image))
;; (p/then (fn [path] (ds/save media/images-storage (fs/name path) path)))
@ -229,28 +258,33 @@
;; (p/then (partial store-image-in-db conn))))]
;; (db/with-atomic [conn db/pool]
;; (-> (retrieve-image conn {:id id :user user})
;; (-> (retrieve-image conn {:id id :profile-id profile-id})
;; (p/then su/raise-not-found-if-nil)
;; (p/then (partial copy-image conn))))))
;; --- Delete Image
;; TODO: this need to be performed in the GC process
;; (defn- delete-image-from-storage
;; [{:keys [path] :as image}]
;; (when @(ds/exists? media/images-storage path)
;; @(ds/delete media/images-storage path))
;; (when @(ds/exists? media/thumbnails-storage path)
;; @(ds/delete media/thumbnails-storage path)))
(def ^:private sql:mark-image-deleted
"update image
set deleted_at = clock_timestamp()
where id = $1
and profile_id = $2
returning id")
(s/def ::delete-image
(s/keys :req-un [::id ::user]))
(s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-image
[{:keys [user id] :as params}]
(let [sql "update images
set deleted_at = clock_timestamp()
where id = $1
and user_id = $2
returning *"]
(db/query-one db/pool [sql id user])))
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(-> (db/query-one conn [sql:mark-image-deleted id profile-id])
(p/then' su/raise-not-found-if-nil))
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :image}})
nil))

View file

@ -0,0 +1,258 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.pages :as cp]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.services.queries.files :as files]
[uxbox.services.mutations :as sm]
[uxbox.services.queries.pages :refer [decode-row]]
[uxbox.services.util :as su]
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]
[uxbox.util.sql :as sql]
[uxbox.util.uuid :as uuid]
[vertx.eventbus :as ve]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::data ::cp/data)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::ordering ::us/number)
(s/def ::file-id ::us/uuid)
;; --- Mutation: Create Page
(declare create-page)
(s/def ::create-page
(s/keys :req-un [::profile-id ::file-id ::name ::ordering ::data]
:opt-un [::id]))
(sm/defmutation ::create-page
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(create-page conn params)))
(def ^:private sql:create-page
"insert into page (id, file_id, name, ordering, data)
values ($1, $2, $3, $4, $5)
returning *")
(defn- create-page
[conn {:keys [id file-id name ordering data] :as params}]
(let [id (or id (uuid/next))
data (blob/encode data)]
(-> (db/query-one conn [sql:create-page
id file-id name
ordering data])
(p/then' decode-row))))
;; --- Mutation: Rename Page
(declare rename-page)
(declare select-page-for-update)
(s/def ::rename-page
(s/keys :req-un [::id ::name ::profile-id]))
(sm/defmutation ::rename-page
[{:keys [id name profile-id]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
(rename-page conn (assoc page :name name)))))
(def ^:private sql:select-page-for-update
"select p.id, p.revn, p.file_id, p.data
from page as p
where p.id = $1
and deleted_at is null
for update;")
(defn- select-page-for-update
[conn id]
(-> (db/query-one conn [sql:select-page-for-update id])
(p/then' su/raise-not-found-if-nil)))
(def ^:private sql:rename-page
"update page
set name = $2
where id = $1
and deleted_at is null")
(defn- rename-page
[conn {:keys [id name] :as params}]
(-> (db/query-one conn [sql:rename-page id name])
(p/then su/constantly-nil)))
;; --- Mutation: Update Page
;; A generic, Changes based (granular) page update method.
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::revn ::us/integer)
(s/def ::update-page
(s/keys :req-un [::id ::profile-id ::revn ::changes]))
(declare update-page)
(declare retrieve-lagged-changes)
(declare update-page-data)
(declare insert-page-change)
(sm/defmutation ::update-page
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [{:keys [file-id] :as page} (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id file-id)
(update-page conn page params))))
(defn- update-page
[conn page params]
(when (> (:revn params)
(:revn page))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn page)}))
(let [changes (:changes params)
data (-> (:data page)
(blob/decode)
(cp/process-changes changes)
(blob/encode))
page (assoc page
:data data
:revn (inc (:revn page))
:changes (blob/encode changes))]
(-> (update-page-data conn page)
(p/then (fn [_] (insert-page-change conn page)))
(p/then (fn [s]
(let [topic (str "internal.uxbox.file." (:file-id page))]
(p/do! (ve/publish! uxbox.core/system topic
{:type :page-change
:profile-id (:profile-id params)
:page-id (:page-id s)
:revn (:revn s)
:changes changes})
(retrieve-lagged-changes conn s params))))))))
(def ^:private sql:update-page-data
"update page
set revn = $1,
data = $2
where id = $3")
(defn- update-page-data
[conn {:keys [id name revn data]}]
(-> (db/query-one conn [sql:update-page-data revn data id])
(p/then' su/constantly-nil)))
(def ^:private sql:insert-page-change
"insert into page_change (id, page_id, revn, data, changes)
values ($1, $2, $3, $4, $5)
returning id, page_id, revn, changes")
(defn- insert-page-change
[conn {:keys [revn data changes] :as page}]
(let [id (uuid/next)
page-id (:id page)]
(db/query-one conn [sql:insert-page-change id
page-id revn data changes])))
(def ^:private sql:lagged-changes
"select s.id, s.changes
from page_change as s
where s.page_id = $1
and s.revn > $2
order by s.created_at asc")
(defn- retrieve-lagged-changes
[conn snapshot params]
(-> (db/query conn [sql:lagged-changes (:id params) (:revn params)])
(p/then (fn [rows]
{:page-id (:id params)
:revn (:revn snapshot)
:changes (into [] (comp (map decode-row)
(map :changes)
(mapcat identity))
rows)}))))
;; --- Mutation: Delete Page
(declare mark-page-deleted)
(s/def ::delete-page
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-page
[{:keys [id profile-id]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :page}})
(mark-page-deleted conn id))))
(def ^:private sql:mark-page-deleted
"update page
set deleted_at = clock_timestamp()
where id = $1
and deleted_at is null")
(defn- mark-page-deleted
[conn id]
(-> (db/query-one conn [sql:mark-page-deleted id])
(p/then su/constantly-nil)))
;; --- Update Page History
;; (defn update-page-history
;; [conn {:keys [profile-id id label pinned]}]
;; (let [sqlv (sql/update-page-history {:profile-id profile-id
;; :id id
;; :label label
;; :pinned pinned})]
;; (some-> (db/fetch-one conn sqlv)
;; (decode-row))))
;; (s/def ::label ::us/string)
;; (s/def ::update-page-history
;; (s/keys :req-un [::profile-id ::id ::pinned ::label]))
;; (sm/defmutation :update-page-history
;; {:doc "Update page history"
;; :spec ::update-page-history}
;; [params]
;; (with-open [conn (db/connection)]
;; (update-page-history conn params)))

View file

@ -26,6 +26,8 @@
[uxbox.media :as media]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.mutations.teams :as mt.teams]
[uxbox.services.mutations.projects :as mt.projects]
[uxbox.services.queries.profile :as profile]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
@ -40,14 +42,14 @@
(s/def ::fullname ::us/string)
(s/def ::lang ::us/string)
(s/def ::path ::us/string)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::password ::us/string)
(s/def ::old-password ::us/string)
;; --- Mutation: Login
(declare retrieve-user-by-email)
(declare retrieve-profile-by-email)
(s/def ::email ::us/email)
(s/def ::scope ::us/string)
@ -58,31 +60,34 @@
(sm/defmutation ::login
[{:keys [email password scope] :as params}]
(letfn [(check-password [user password]
(let [result (sodi.pwhash/verify password (:password user))]
(letfn [(check-password [profile password]
(let [result (sodi.pwhash/verify password (:password profile))]
(:valid result)))
(check-user [user]
(when-not user
(check-profile [profile]
(when-not profile
(ex/raise :type :validation
:code ::wrong-credentials))
(when-not (check-password user password)
(when-not (check-password profile password)
(ex/raise :type :validation
:code ::wrong-credentials))
profile)]
(db/with-atomic [conn db/pool]
(p/let [prof (-> (retrieve-profile-by-email conn email)
(p/then' check-profile)
(p/then' profile/strip-private-attrs))
addt (profile/retrieve-additional-data conn (:id prof))]
(merge prof addt)))))
{:id (:id user)})]
(-> (retrieve-user-by-email db/pool email)
(p/then' check-user))))
(def sql:user-by-email
(def sql:profile-by-email
"select u.*
from users as u
from profile as u
where u.email=$1
and u.deleted_at is null")
(defn- retrieve-user-by-email
(defn- retrieve-profile-by-email
[conn email]
(db/query-one conn [sql:user-by-email email]))
(db/query-one conn [sql:profile-by-email email]))
;; --- Mutation: Add additional email
@ -97,7 +102,7 @@
;; --- Mutation: Update Profile (own)
(def ^:private sql:update-profile
"update users
"update profile
set fullname = $2,
lang = $3
where id = $1
@ -123,27 +128,27 @@
;; --- Mutation: Update Password
(defn- validate-password!
[conn {:keys [user old-password] :as params}]
(p/let [profile (profile/retrieve-profile conn user)
[conn {:keys [profile-id old-password] :as params}]
(p/let [profile (profile/retrieve-profile conn profile-id)
result (sodi.pwhash/verify old-password (:password profile))]
(when-not (:valid result)
(ex/raise :type :validation
:code ::old-password-not-match))))
(defn update-password
[conn {:keys [user password]}]
(let [sql "update users
[conn {:keys [profile-id password]}]
(let [sql "update profile
set password = $2
where id = $1
and deleted_at is null
returning id"
password (sodi.pwhash/derive password)]
(-> (db/query-one conn [sql user password])
(-> (db/query-one conn [sql profile-id password])
(p/then' su/raise-not-found-if-nil)
(p/then' su/constantly-nil))))
(s/def ::update-profile-password
(s/keys :req-un [::user ::password ::old-password]))
(s/keys :req-un [::profile-id ::password ::old-password]))
(sm/defmutation ::update-profile-password
[params]
@ -159,22 +164,22 @@
(s/def ::file ::imgs/upload)
(s/def ::update-profile-photo
(s/keys :req-un [::user ::file]))
(s/keys :req-un [::profile-id ::file]))
(sm/defmutation ::update-profile-photo
[{:keys [user file] :as params}]
[{:keys [profile-id file] :as params}]
(db/with-atomic [conn db/pool]
(p/let [profile (profile/retrieve-profile conn user)
(p/let [profile (profile/retrieve-profile conn profile-id)
photo (upload-photo conn params)]
;; Schedule deletion of old photo
(tasks/schedule! conn {:name "remove-media"
:props {:path (:photo profile)}})
;; Save new photo
(update-profile-photo conn user photo))))
(update-profile-photo conn profile-id photo))))
(defn- upload-photo
[conn {:keys [file user]}]
[conn {:keys [file profile-id]}]
(when-not (imgs/valid-image-types? (:mtype file))
(ex/raise :type :validation
:code :image-type-not-allowed
@ -191,12 +196,16 @@
(ust/save! media/media-storage name photo))))
(defn- update-profile-photo
[conn user path]
(let [sql "update users set photo=$1 where id=$2 and deleted_at is null returning id"]
(-> (db/query-one conn [sql (str path) user])
[conn profile-id path]
(let [sql "update profile set photo=$1
where id=$2
and deleted_at is null
returning id"]
(-> (db/query-one conn [sql (str path) profile-id])
(p/then' su/raise-not-found-if-nil))))
;; --- Mutation: Register Profile
(declare check-profile-existence!)
@ -212,18 +221,26 @@
:code :registration-disabled))
(db/with-atomic [conn db/pool]
(check-profile-existence! conn params)
(register-profile conn params)))
(-> (register-profile conn params)
(p/then (fn [profile]
;; TODO: send a correct link for email verification
(let [data {:to (:email params)
:name (:fullname params)}]
(p/do!
(emails/send! conn emails/register data)
profile)))))))
(def ^:private sql:insert-user
"insert into users (id, fullname, email, password, photo)
values ($1, $2, $3, $4, '') returning *")
(def ^:private sql:insert-profile
"insert into profile (id, fullname, email, password, photo, is_demo)
values ($1, $2, $3, $4, '', $5) returning *")
(def ^:private sql:insert-email
"insert into user_emails (user_id, email, is_main)
"insert into profile_email (profile_id, email, is_main)
values ($1, $2, true)")
(def ^:private sql:profile-existence
"select exists (select * from users
"select exists (select * from profile
where email = $1
and deleted_at is null) as val")
@ -236,33 +253,40 @@
:code ::email-already-exists))
params))))
(defn create-profile
"Create the user entry on the database with limited input
(defn- create-profile
"Create the profile entry on the database with limited input
filling all the other fields with defaults."
[conn {:keys [id fullname email password] :as params}]
[conn {:keys [id fullname email password demo?] :as params}]
(let [id (or id (uuid/next))
password (sodi.pwhash/derive password)
sqlv1 [sql:insert-user
id
fullname
email
password]
sqlv2 [sql:insert-email id email]]
(p/let [profile (db/query-one conn sqlv1)]
(db/query-one conn sqlv2)
profile)))
demo? (if (boolean? demo?) demo? false)
password (sodi.pwhash/derive password)]
(db/query-one conn [sql:insert-profile id fullname email password demo?])))
(defn- create-profile-email
[conn {:keys [id email] :as profile}]
(-> (db/query-one conn [sql:insert-email id email])
(p/then' su/constantly-nil)))
(defn register-profile
[conn params]
(-> (create-profile conn params)
(p/then' profile/strip-private-attrs)
(p/then (fn [profile]
;; TODO: send a correct link for email verification
(let [data {:to (:email params)
:name (:fullname params)}]
(p/do!
(emails/send! conn emails/register data)
profile))))))
(p/let [prof (create-profile conn params)
_ (create-profile-email conn prof)
team (mt.teams/create-team conn {:profile-id (:id prof)
:name "Default"
:default? true})
_ (mt.teams/create-team-profile conn {:team-id (:id team)
:profile-id (:id prof)})
proj (mt.projects/create-project conn {:profile-id (:id prof)
:team-id (:id team)
:name "Drafts"
:default? true})
_ (mt.projects/create-project-profile conn {:project-id (:id proj)
:profile-id (:id prof)})]
(merge (profile/strip-private-attrs prof)
{:default-team team
:default-project proj})))
;; --- Mutation: Request Profile Recovery
@ -270,24 +294,24 @@
(s/keys :req-un [::email]))
(def sql:insert-recovery-token
"insert into tokens (user_id, token) values ($1, $2)")
"insert into password_recovery_token (profile_id, token) values ($1, $2)")
(sm/defmutation ::request-profile-recovery
[{:keys [email] :as params}]
(letfn [(create-recovery-token [conn {:keys [id] :as user}]
(letfn [(create-recovery-token [conn {:keys [id] :as profile}]
(let [token (-> (sodi.prng/random-bytes 32)
(sodi.util/bytes->b64s))
sql sql:insert-recovery-token]
(-> (db/query-one conn [sql id token])
(p/then (constantly (assoc user :token token))))))
(send-email-notification [conn user]
(p/then (constantly (assoc profile :token token))))))
(send-email-notification [conn profile]
(emails/send! conn
emails/password-recovery
{:to (:email user)
:token (:token user)
:name (:fullname user)}))]
{:to (:email profile)
:token (:token profile)
:name (:fullname profile)}))]
(db/with-atomic [conn db/pool]
(-> (retrieve-user-by-email conn email)
(-> (retrieve-profile-by-email conn email)
(p/then' su/raise-not-found-if-nil)
(p/then #(create-recovery-token conn %))
(p/then #(send-email-notification conn %))
@ -300,23 +324,77 @@
(s/keys :req-un [::token ::password]))
(def sql:remove-recovery-token
"delete from tokenes where user_id=$1 and token=$2")
"delete from password_recovery_token where profile_id=$1 and token=$2")
(sm/defmutation ::recover-profile
[{:keys [token password]}]
(letfn [(validate-token [conn token]
(let [sql "delete from tokens where token=$1 returning *"
sql "select * from tokens where token=$1"]
(let [sql "delete from password_recovery_token
where token=$1 returning *"
sql "select * from password_recovery_token
where token=$1"]
(-> (db/query-one conn [sql token])
(p/then' :user-id)
(p/then' :profile-id)
(p/then' su/raise-not-found-if-nil))))
(update-password [conn user-id]
(let [sql "update users set password=$2 where id=$1"
(update-password [conn profile-id]
(let [sql "update profile set password=$2 where id=$1"
pwd (sodi.pwhash/derive password)]
(-> (db/query-one conn [sql user-id pwd])
(-> (db/query-one conn [sql profile-id pwd])
(p/then' (constantly nil)))))]
(db/with-atomic [conn db/pool]
(-> (validate-token conn token)
(p/then (fn [user-id] (update-password conn user-id)))))))
(p/then (fn [profile-id] (update-password conn profile-id)))))))
;; --- Mutation: Delete Profile
(declare check-teams-ownership!)
(declare mark-profile-as-deleted!)
(s/def ::delete-profile
(s/keys :req-un [::profile-id]))
(sm/defmutation ::delete-profile
[{:keys [profile-id] :as params}]
(db/with-atomic [conn db/pool]
(check-teams-ownership! conn profile-id)
;; Schedule a complete deletion of profile
(tasks/schedule! conn {:name "delete-profile"
:delay (tm/duration {:hours 48})
:props {:profile-id profile-id}})
(mark-profile-as-deleted! conn profile-id)))
(def ^:private sql:teams-ownership-check
"with teams as (
select tpr.team_id as id
from team_profile_rel as tpr
where tpr.profile_id = $1
and tpr.is_owner is true
)
select tpr.team_id,
count(tpr.profile_id) as num_profiles
from team_profile_rel as tpr
where tpr.team_id in (select id from teams)
group by tpr.team_id
having count(tpr.profile_id) > 1")
(defn- check-teams-ownership!
[conn profile-id]
(-> (db/query conn [sql:teams-ownership-check profile-id])
(p/then' (fn [rows]
(when-not (empty? rows)
(ex/raise :type :validation
:code :owner-teams-with-people
:hint "The user need to transfer ownership of owned teams."
:context {:teams (mapv :team-id rows)}))))))
(def ^:private sql:mark-profile-deleted
"update profile set deleted_at=now() where id=$1")
(defn- mark-profile-as-deleted!
[conn profile-id]
(-> (db/query-one conn [sql:mark-profile-deleted profile-id])
(p/then' su/constantly-nil)))

View file

@ -1,250 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.project-files
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.pages :as cp]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.projects :as proj]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::project-id ::us/uuid)
;; --- Permissions Checks
;; A query that returns all (not-equal) user assignations for a
;; requested file (project level and file level).
;; Is important having the condition of user_id in the join and not in
;; where clause because we need all results independently if value is
;; true, false or null; with that, the empty result means there are no
;; file found.
(def ^:private sql:file-permissions
"select pf.id,
pfu.can_edit as can_edit
from project_files as pf
left join project_file_users as pfu
on (pfu.file_id = pf.id and pfu.user_id = $1)
where pf.id = $2
union all
select pf.id,
pu.can_edit as can_edit
from project_files as pf
left join project_users as pu
on (pf.project_id = pu.project_id and pu.user_id = $1)
where pf.id = $2")
(defn check-edition-permissions!
[conn user file-id]
(-> (db/query conn [sql:file-permissions user file-id])
(p/then' seq)
(p/then' su/raise-not-found-if-nil)
(p/then' (fn [rows]
(when-not (some :can-edit rows)
(ex/raise :type :validation
:code :not-authorized))))))
;; --- Mutation: Create Project File
(declare create-file)
(declare create-page)
(s/def ::create-project-file
(s/keys :req-un [::user ::name ::project-id]
:opt-un [::id]))
(sm/defmutation ::create-project-file
[{:keys [user project-id] :as params}]
(db/with-atomic [conn db/pool]
(proj/check-edition-permissions! conn user project-id)
(p/let [file (create-file conn params)
page (create-page conn (assoc params :file-id (:id file)))]
(assoc file :pages [(:id page)]))))
(defn create-file
[conn {:keys [id user name project-id] :as params}]
(let [id (or id (uuid/next))
sql "insert into project_files (id, user_id, project_id, name)
values ($1, $2, $3, $4) returning *"]
(db/query-one conn [sql id user project-id name])))
(defn- create-page
"Creates an initial page for the file."
[conn {:keys [user file-id] :as params}]
(let [id (uuid/next)
name "Page 1"
data (blob/encode cp/default-page-data)
sql "insert into project_pages (id, user_id, file_id, name, version,
ordering, data)
values ($1, $2, $3, $4, 0, 1, $5) returning id"]
(db/query-one conn [sql id user file-id name data])))
;; --- Mutation: Rename File
(declare rename-file)
(s/def ::rename-project-file
(s/keys :req-un [::user ::name ::id]))
(sm/defmutation ::rename-project-file
[{:keys [id user] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user id)
(rename-file conn params)))
(def sql:rename-file
"update project_files
set name = $2
where id = $1
and deleted_at is null")
(defn- rename-file
[conn {:keys [id name] :as params}]
(let [sql sql:rename-file]
(-> (db/query-one conn [sql id name])
(p/then' su/constantly-nil))))
;; --- Mutation: Delete Project File
(declare delete-file)
(s/def ::delete-project-file
(s/keys :req-un [::id ::user]))
(sm/defmutation ::delete-project-file
[{:keys [id user] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user id)
(delete-file conn params)))
(def ^:private sql:delete-file
"update project_files
set deleted_at = clock_timestamp()
where id = $1
and deleted_at is null")
(defn delete-file
[conn {:keys [id] :as params}]
(let [sql sql:delete-file]
(-> (db/query-one conn [sql id])
(p/then' su/constantly-nil))))
;; --- Mutation: Upload File Image
(s/def ::file-id ::us/uuid)
(s/def ::content ::imgs/upload)
(s/def ::upload-project-file-image
(s/keys :req-un [::user ::file-id ::name ::content]
:opt-un [::id]))
(declare create-file-image)
(sm/defmutation ::upload-project-file-image
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user file-id)
(create-file-image conn params)))
(def ^:private
sql:insert-file-image
"insert into project_file_images
(file_id, user_id, name, path, width, height, mtype,
thumb_path, thumb_width, thumb_height, thumb_quality, thumb_mtype)
values ($1, $2, $3, $4, $5, $6, $7, $8, $9, $10, $11, $12)
returning *")
(defn- create-file-image
[conn {:keys [content file-id user name] :as params}]
(when-not (imgs/valid-image-types? (:mtype content))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
(p/let [image-opts (vu/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]
(vu/blocking
(let [image-path (ust/lookup media/media-storage path)]
(ust/save! media/media-storage (fs/name image-path) image-path))))

View file

@ -1,245 +0,0 @@
;; 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) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.project-pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.pages :as cp]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.project-files :as files]
[uxbox.services.queries.project-pages :refer [decode-row]]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.sql :as sql]
[uxbox.util.uuid :as uuid]
[vertx.eventbus :as ve]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::data ::cp/data)
(s/def ::user ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::ordering ::us/number)
;; --- Mutation: Create Page
(declare create-page)
(s/def ::create-project-page
(s/keys :req-un [::user ::file-id ::name ::ordering ::data]
:opt-un [::id]))
(sm/defmutation ::create-project-page
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn user file-id)
(create-page conn params)))
(defn create-page
[conn {:keys [id user file-id name ordering data] :as params}]
(let [sql "insert into project_pages (id, user_id, file_id, name,
ordering, data, version)
values ($1, $2, $3, $4, $5, $6, 0)
returning *"
id (or id (uuid/next))
data (blob/encode data)]
(-> (db/query-one conn [sql id user file-id name ordering data])
(p/then' decode-row))))
;; --- Mutation: Update Page Data
(declare select-page-for-update)
(declare update-page-data)
(declare insert-page-snapshot)
(s/def ::update-project-page-data
(s/keys :req-un [::id ::user ::data]))
(sm/defmutation ::update-project-page-data
[{:keys [id user data] :as params}]
(db/with-atomic [conn db/pool]
(p/let [{:keys [version file-id]} (select-page-for-update conn id)]
(files/check-edition-permissions! conn user file-id)
(let [data (blob/encode data)
version (inc version)
params (assoc params :id id :data data :version version)]
(p/do! (update-page-data conn params)
(insert-page-snapshot conn params)
(select-keys params [:id :version]))))))
(defn- select-page-for-update
[conn id]
(let [sql "select p.id, p.version, p.file_id, p.data
from project_pages as p
where p.id = $1
and deleted_at is null
for update;"]
(-> (db/query-one conn [sql id])
(p/then' su/raise-not-found-if-nil))))
(defn- update-page-data
[conn {:keys [id name version data]}]
(let [sql "update project_pages
set version = $1,
data = $2
where id = $3"]
(-> (db/query-one conn [sql version data id])
(p/then' su/constantly-nil))))
(defn- insert-page-snapshot
[conn {:keys [user-id id version data changes]}]
(let [sql "insert into project_page_snapshots (user_id, page_id, version, data, changes)
values ($1, $2, $3, $4, $5)
returning id, page_id, user_id, version, changes"]
(db/query-one conn [sql user-id id version data changes])))
;; --- Mutation: Rename Page
(declare rename-page)
(s/def ::rename-project-page
(s/keys :req-un [::id ::name ::user]))
(sm/defmutation ::rename-project-page
[{:keys [id name user]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn user (:file-id page))
(rename-page conn (assoc page :name name)))))
(defn- rename-page
[conn {:keys [id name] :as params}]
(let [sql "update project_pages
set name = $2
where id = $1
and deleted_at is null"]
(-> (db/query-one conn [sql id name])
(p/then su/constantly-nil))))
;; --- Mutation: Update Page
;; A generic, Changes based (granular) page update method.
(s/def ::changes
(s/coll-of map? :kind vector?))
(s/def ::update-project-page
(s/keys :opt-un [::id ::user ::version ::changes]))
(declare update-project-page)
(declare retrieve-lagged-changes)
(sm/defmutation ::update-project-page
[{:keys [id user] :as params}]
(db/with-atomic [conn db/pool]
(p/let [{:keys [file-id] :as page} (select-page-for-update conn id)]
(files/check-edition-permissions! conn user file-id)
(update-project-page conn page params))))
(defn- update-project-page
[conn page params]
(when (> (:version params)
(:version page))
(ex/raise :type :validation
:code :version-conflict
:hint "The incoming version is greater that stored version."
:context {:incoming-version (:version params)
:stored-version (:version page)}))
(let [changes (:changes params)
data (-> (:data page)
(blob/decode)
(cp/process-changes changes)
(blob/encode))
page (assoc page
:user-id (:user params)
:data data
:version (inc (:version page))
:changes (blob/encode changes))]
(-> (update-page-data conn page)
(p/then (fn [_] (insert-page-snapshot conn page)))
(p/then (fn [s]
(let [topic (str "internal.uxbox.file." (:file-id page))]
(p/do! (ve/publish! uxbox.core/system topic {:type :page-snapshot
:user-id (:user-id s)
:page-id (:page-id s)
:version (:version s)
:changes changes})
(retrieve-lagged-changes conn s params))))))))
(def sql:lagged-snapshots
"select s.id, s.changes
from project_page_snapshots as s
where s.page_id = $1
and s.version > $2
order by s.created_at asc")
(defn- retrieve-lagged-changes
[conn snapshot params]
(let [sql sql:lagged-snapshots]
(-> (db/query conn [sql (:id params) (:version params) #_(:id snapshot)])
(p/then (fn [rows]
{:page-id (:id params)
:version (:version snapshot)
:changes (into [] (comp (map decode-row)
(map :changes)
(mapcat identity))
rows)})))))
;; --- Mutation: Delete Page
(declare delete-page)
(s/def ::delete-project-page
(s/keys :req-un [::user ::id]))
(sm/defmutation ::delete-project-page
[{:keys [id user]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn user (:file-id page))
(delete-page conn id))))
(def sql:delete-page
"update project_pages
set deleted_at = clock_timestamp()
where id = $1
and deleted_at is null")
(defn- delete-page
[conn id]
(let [sql sql:delete-page]
(-> (db/query-one conn [sql id])
(p/then su/constantly-nil))))
;; --- Update Page History
;; (defn update-page-history
;; [conn {:keys [user id label pinned]}]
;; (let [sqlv (sql/update-page-history {:user user
;; :id id
;; :label label
;; :pinned pinned})]
;; (some-> (db/fetch-one conn sqlv)
;; (decode-row))))
;; (s/def ::label ::us/string)
;; (s/def ::update-page-history
;; (s/keys :req-un [::user ::id ::pinned ::label]))
;; (sm/defmutation :update-page-history
;; {:doc "Update page history"
;; :spec ::update-page-history}
;; [params]
;; (with-open [conn (db/connection)]
;; (update-page-history conn params)))

View file

@ -2,15 +2,20 @@
;; 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) 2019 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) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.projects
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.tasks :as tasks]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
@ -20,65 +25,95 @@
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::token ::us/string)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
;; --- Permissions Checks
(def ^:private sql:project-permissions
"select p.id,
pu.can_edit as can_edit
from projects as p
inner join project_users as pu
on (pu.project_id = p.id)
where pu.user_id = $1
and p.id = $2
for update of p;")
"select tpr.is_owner,
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
inner join project as p on (p.team_id = tpr.team_id)
where p.id = $1
and tpr.profile_id = $2
union all
select ppr.is_owner,
ppr.is_admin,
ppr.can_edit
from project_profile_rel as ppr
where ppr.project_id = $1
and ppr.profile_id = $2")
(defn check-edition-permissions!
[conn user project-id]
(-> (db/query-one conn [sql:project-permissions user project-id])
[conn profile-id project-id]
(-> (db/query conn [sql:project-permissions project-id profile-id])
(p/then' seq)
(p/then' su/raise-not-found-if-nil)
(p/then' (fn [{:keys [id can-edit] :as proj}]
(when-not can-edit
(p/then' (fn [rows]
(when-not (or (some :can-edit rows)
(some :is-admin rows)
(some :is-owner rows))
(ex/raise :type :validation
:code :not-authorized))))))
;; --- Mutation: Create Project
(declare create-project)
(declare create-project-profile)
(s/def ::team-id ::us/uuid)
(s/def ::create-project
(s/keys :req-un [::user ::name]
(s/keys :req-un [::profile-id ::team-id ::name]
:opt-un [::id]))
(sm/defmutation ::create-project
[params]
(db/with-atomic [conn db/pool]
(create-project conn params)))
(p/let [proj (create-project conn params)]
(create-project-profile conn (assoc params :project-id (:id proj)))
proj)))
(def ^:private sql:insert-project
"insert into project (id, team_id, name, is_default)
values ($1, $2, $3, $4)
returning *")
(defn create-project
[conn {:keys [id user name] :as params}]
[conn {:keys [id profile-id team-id name default?] :as params}]
(let [id (or id (uuid/next))
sql "insert into projects (id, user_id, name)
values ($1, $2, $3) returning *"]
(db/query-one conn [sql id user name])))
default? (if (boolean? default?) default? false)]
(db/query-one conn [sql:insert-project id team-id name default?])))
;; --- Mutation: Update Project
(def ^:private sql:create-project-profile
"insert into project_profile_rel (project_id, profile_id, is_owner, is_admin, can_edit)
values ($1, $2, true, true, true)
returning *")
(defn create-project-profile
[conn {:keys [project-id profile-id] :as params}]
(-> (db/query-one conn [sql:create-project-profile project-id profile-id])
(p/then' su/constantly-nil)))
;; --- Mutation: Rename Project
(declare rename-project)
(s/def ::rename-project
(s/keys :req-un [::user ::name ::id]))
(s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-project
[{:keys [id user] :as params}]
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user id)
(check-edition-permissions! conn profile-id id)
(rename-project conn params)))
(def sql:rename-project
"update projects
(def ^:private sql:rename-project
"update project
set name = $2
where id = $1
and deleted_at is null
@ -86,31 +121,36 @@
(defn rename-project
[conn {:keys [id name] :as params}]
(let [sql sql:rename-project]
(db/query-one conn [sql id name])))
(db/query-one conn [sql:rename-project id name]))
;; --- Mutation: Delete Project
(declare delete-project)
(declare mark-project-deleted)
(s/def ::delete-project
(s/keys :req-un [::id ::user]))
(s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-project
[{:keys [id user] :as params}]
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn user id)
(delete-project conn params)))
(check-edition-permissions! conn profile-id id)
(def ^:private sql:delete-project
"update projects
;; Schedule object deletion
(tasks/schedule! conn {:name "delete-object"
:delay cfg/default-deletion-delay
:props {:id id :type :project}})
(mark-project-deleted conn params)))
(def ^:private sql:mark-project-deleted
"update project
set deleted_at = clock_timestamp()
where id = $1
and deleted_at is null
returning id")
(defn delete-project
[conn {:keys [id user] :as params}]
(let [sql sql:delete-project]
(-> (db/query-one conn [sql id])
(p/then' su/constantly-nil))))
(defn mark-project-deleted
[conn {:keys [id profile-id] :as params}]
(-> (db/query-one conn [sql:mark-project-deleted id])
(p/then' su/constantly-nil)))

View file

@ -0,0 +1,65 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.mutations.teams
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.db :as db]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.uuid :as uuid]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::profile-id ::us/uuid)
;; --- Mutation: Create Team
(declare create-team)
(declare create-team-profile)
(s/def ::create-team
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
(sm/defmutation ::create-team
[params]
(db/with-atomic [conn db/pool]
(p/let [team (create-team conn params)]
(create-team-profile conn (assoc params :team-id (:id team)))
team)))
(def ^:private sql:insert-team
"insert into team (id, name, photo, is_default)
values ($1, $2, '', $3)
returning *")
(defn create-team
[conn {:keys [id profile-id name default?] :as params}]
(let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)]
(db/query-one conn [sql:insert-team id name default?])))
(def ^:private sql:create-team-profile
"insert into team_profile_rel (team_id, profile_id, is_owner, is_admin, can_edit)
values ($1, $2, true, true, true)
returning *")
(defn create-team-profile
[conn {:keys [team-id profile-id] :as params}]
(-> (db/query-one conn [sql:create-team-profile team-id profile-id])
(p/then' su/constantly-nil)))

View file

@ -0,0 +1,102 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.colors
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[promesa.exec :as px]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.util.uuid :as uuid]
[vertx.core :as vc]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
(defn decode-row
[{:keys [metadata] :as row}]
(when row
(cond-> row
metadata (assoc :metadata (blob/decode metadata)))))
;; --- Query: Collections
(def ^:private sql:collections
"select *,
(select count(*) from color where collection_id = ic.id) as num_colors
from color_collection as ic
where (ic.profile_id = $1 or
ic.profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and ic.deleted_at is null
order by ic.created_at desc")
(s/def ::color-collections
(s/keys :req-un [::profile-id]))
(sq/defquery ::color-collections
[{:keys [profile-id] :as params}]
(let [sqlv [sql:collections profile-id]]
(db/query db/pool sqlv)))
;; --- Colors By Collection ID
(def ^:private sql:colors
"select *
from color as i
where (i.profile_id = $1 or
i.profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and i.deleted_at is null
and i.collection_id = $2
order by i.created_at desc")
(s/def ::colors
(s/keys :req-un [::profile-id ::collection-id]))
(sq/defquery ::colors
[{:keys [profile-id collection-id] :as params}]
(-> (db/query db/pool [sql:colors profile-id collection-id])
(p/then' #(mapv decode-row %))))
;; --- Query: Color (by ID)
(declare retrieve-color)
(s/def ::id ::us/uuid)
(s/def ::color
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::color
[{:keys [id] :as params}]
(-> (retrieve-color db/pool id)
(p/then' su/raise-not-found-if-nil)))
(defn retrieve-color
[conn id]
(let [sql "select * from color
where id = $1
and deleted_at is null;"]
(-> (db/query-one conn [sql id])
(p/then' su/raise-not-found-if-nil))))

View file

@ -0,0 +1,203 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.files
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]))
(declare decode-row)
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
;; --- Query: Draft Files
(def ^:private sql:files
"select distinct
f.*,
array_agg(pg.id) over pages_w as pages,
first_value(pg.data) over pages_w as data
from file as f
inner join file_profile_rel as fp_r on (fp_r.file_id = f.id)
left join page as pg on (f.id = pg.file_id)
where fp_r.profile_id = $1
and f.project_id = $2
and f.deleted_at is null
and pg.deleted_at is null
and (fp_r.is_admin = true or
fp_r.is_owner = true or
fp_r.can_edit = true)
window pages_w as (partition by f.id order by pg.created_at
range between unbounded preceding
and unbounded following)
order by f.created_at")
(s/def ::project-id ::us/uuid)
(s/def ::files
(s/keys :req-un [::profile-id ::project-id]))
(sq/defquery ::files
[{:keys [profile-id project-id] :as params}]
(-> (db/query db/pool [sql:files profile-id project-id])
(p/then (partial mapv decode-row))))
;; --- Query: File Permissions
(def ^:private sql:file-permissions
"select fpr.is_owner,
fpr.is_admin,
fpr.can_edit
from file_profile_rel as fpr
where fpr.file_id = $1
and fpr.profile_id = $2
union all
select tpr.is_owner,
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
inner join project as p on (p.team_id = tpr.team_id)
inner join file as f on (p.id = f.project_id)
where f.id = $1
and tpr.profile_id = $2
union all
select ppr.is_owner,
ppr.is_admin,
ppr.can_edit
from project_profile_rel as ppr
inner join file as f on (f.project_id = ppr.project_id)
where f.id = $1
and ppr.profile_id = $2;")
(defn check-edition-permissions!
[conn profile-id file-id]
(-> (db/query conn [sql:file-permissions file-id profile-id])
(p/then' seq)
(p/then' su/raise-not-found-if-nil)
(p/then' (fn [rows]
(when-not (or (some :can-edit rows)
(some :is-admin rows)
(some :is-owner rows))
(ex/raise :type :validation
:code :not-authorized))))))
;; --- Query: Images of the File
(declare retrieve-file-images)
(s/def ::file-images
(s/keys :req-un [::profile-id ::file-id]))
(sq/defquery ::file-images
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id file-id)
(retrieve-file-images conn params)))
(def ^:private sql:file-images
"select fi.*
from file_image as fi
where fi.file_id = $1")
(defn retrieve-file-images
[conn {:keys [file-id] :as params}]
(let [sqlv [sql:file-images file-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 %)))))
;; --- Query: File (By ID)
(def ^:private sql:file
"select f.*,
array_agg(pg.id) over pages_w as pages
from file as f
left join page as pg on (f.id = pg.file_id)
where f.id = $1
and f.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by f.id order by pg.created_at
range between unbounded preceding
and unbounded following)")
(def ^:private sql:file-users
"select pf.id, pf.fullname, pf.photo
from profile as pf
inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
where fpr.file_id = $1
union
select pf.id, pf.fullname, pf.photo
from profile as pf
inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
inner join project as p on (tpr.team_id = p.team_id)
inner join file as f on (p.id = f.project_id)
where f.id = $1")
(s/def ::file-with-users
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::file-with-users
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id id)
(p/let [file (-> (db/query-one conn [sql:file id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row))
users (db/query conn [sql:file-users id])]
(assoc file :users users))))
(s/def ::file
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::file
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id id)
(-> (db/query-one conn [sql:file id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row))))
;; --- Query: Project Files
;; (declare retrieve-project-files)
;; (s/def ::project-files
;; (s/keys :req-un [::profile-id]
;; :opt-un [::project-id]))
;; (sq/defquery ::project-files
;; [{:keys [project-id] :as params}]
;; (retrieve-project-files db/pool params))
;; (defn retrieve-project-files
;; [conn {:keys [profile-id project-id]}]
;; (-> (db/query conn [sql:project-files profile-id project-id])
;; (p/then' (partial mapv decode-row))))
;; --- Helpers
(defn decode-row
[{:keys [pages data] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
pages (assoc :pages (vec (remove nil? pages))))))

View file

@ -2,68 +2,101 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.icons
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[promesa.exec :as px]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.images :as images]
[uxbox.services.queries :as sq]
[uxbox.util.blob :as blob]))
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.util.uuid :as uuid]
[vertx.core :as vc]))
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
(defn decode-icon-row
(defn decode-row
[{:keys [metadata] :as row}]
(when row
(cond-> row
metadata (assoc :metadata (blob/decode metadata)))))
;; --- Query: Collections
(def sql:icons-collections
(def ^:private sql:collections
"select *,
(select count(*) from icons where collection_id = ic.id) as num_icons
from icon_collections as ic
where (ic.user_id = $1 or
ic.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
(select count(*) from icon where collection_id = ic.id) as num_icons
from icon_collection as ic
where (ic.profile_id = $1 or
ic.profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and ic.deleted_at is null
order by ic.created_at desc")
(s/def ::icons-collections
(s/keys :req-un [::user]))
(s/def ::icon-collections
(s/keys :req-un [::profile-id]))
(sq/defquery ::icons-collections
[{:keys [user] :as params}]
(let [sqlv [sql:icons-collections user]]
(sq/defquery ::icon-collections
[{:keys [profile-id] :as params}]
(let [sqlv [sql:collections profile-id]]
(db/query db/pool sqlv)))
;; --- Icons By Collection ID
(def ^:private icons-by-collection-sql
(def ^:private sql:icons
"select *
from icons as i
where (i.user_id = $1 or
i.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
from icon as i
where (i.profile_id = $1 or
i.profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and i.deleted_at is null
and case when $2::uuid is null then i.collection_id is null
else i.collection_id = $2::uuid
end
and i.collection_id = $2
order by i.created_at desc")
(s/def ::icons-by-collection
(s/keys :req-un [::user]
:opt-un [::collection-id]))
(s/def ::icons
(s/keys :req-un [::profile-id ::collection-id]))
(sq/defquery ::icons
[{:keys [profile-id collection-id] :as params}]
(-> (db/query db/pool [sql:icons profile-id collection-id])
(p/then' #(mapv decode-row %))))
;; --- Query: Icon (by ID)
(declare retrieve-icon)
(s/def ::id ::us/uuid)
(s/def ::icon
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::icon
[{:keys [id] :as params}]
(-> (retrieve-icon db/pool id)
(p/then' su/raise-not-found-if-nil)))
(defn retrieve-icon
[conn id]
(let [sql "select * from icon
where id = $1
and deleted_at is null;"]
(-> (db/query-one conn [sql id])
(p/then' su/raise-not-found-if-nil))))
(sq/defquery ::icons-by-collection
[{:keys [user collection-id] :as params}]
(let [sqlv [icons-by-collection-sql user collection-id]]
(-> (db/query db/pool sqlv)
(p/then' #(mapv decode-icon-row %)))))

View file

@ -2,6 +2,9 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.images
@ -23,73 +26,74 @@
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::user ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::collection-id (s/nilable ::us/uuid))
;; --- Query: Images Collections
;; --- Query: Image Collections
(def ^:private sql:collections
"select *,
(select count(*) from images where collection_id = ic.id) as num_images
from image_collections as ic
where (ic.user_id = $1 or
ic.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
(select count(*) from image where collection_id = ic.id) as num_images
from image_collection as ic
where (ic.profile_id = $1 or
ic.profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and ic.deleted_at is null
order by ic.created_at desc;")
(s/def ::images-collections
(s/keys :req-un [::user]))
(s/def ::image-collections
(s/keys :req-un [::profile-id]))
(sq/defquery ::images-collections
[{:keys [user] :as params}]
(db/query db/pool [sql:collections user]))
(sq/defquery ::image-collections
[{:keys [profile-id] :as params}]
(db/query db/pool [sql:collections profile-id]))
;; --- Query: Image by ID
(defn retrieve-image
[conn id]
(let [sql "select * from images
where id = $1
and deleted_at is null;"]
(db/query-one conn [sql id])))
;; --- Query: Image (by ID)
(declare retrieve-image)
(s/def ::id ::us/uuid)
(s/def ::image-by-id
(s/keys :req-un [::user ::id]))
(s/def ::image
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::image-by-id
[params]
(-> (retrieve-image db/pool (:id params))
(sq/defquery ::image
[{:keys [id] :as params}]
(-> (retrieve-image db/pool id)
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri))))
;; --- Query: Images by collection ID
(defn retrieve-image
[conn id]
(let [sql "select * from image
where id = $1
and deleted_at is null;"]
(-> (db/query-one conn [sql id])
(p/then' su/raise-not-found-if-nil))))
(def sql:images-by-collection
"select * from images
where (user_id = $1 or
user_id = '00000000-0000-0000-0000-000000000000'::uuid)
;; --- Query: Images (by collection)
(def ^:private sql:images
"select *
from image
where (profile_id = $1 or
profile_id = '00000000-0000-0000-0000-000000000000'::uuid)
and deleted_at is null
and collection_id = $2
order by created_at desc")
(def sql:images-by-collection
(str "with images as (" sql:images-by-collection ")
select im.* from images as im
where im.collection_id = $2"))
(s/def ::images-by-collection
(s/keys :req-un [::user]
:opt-un [::collection-id]))
(s/def ::images
(s/keys :req-un [::profile-id ::collection-id]))
;; TODO: check if we can resolve url with transducer for reduce
;; garbage generation for each request
(sq/defquery ::images-by-collection
[{:keys [user collection-id] :as params}]
(let [sqlv [sql:images-by-collection user collection-id]]
(-> (db/query db/pool sqlv)
(p/then' (fn [rows]
(->> rows
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri))))))))
(sq/defquery ::images
[{:keys [profile-id collection-id] :as params}]
(-> (db/query db/pool [sql:images profile-id collection-id])
(p/then' (fn [rows]
(->> rows
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri)))))))

View file

@ -0,0 +1,138 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.services.queries.files :as files]
[uxbox.util.blob :as blob]
[uxbox.util.sql :as sql]))
;; --- Helpers & Specs
(declare decode-row)
(s/def ::id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
;; --- Query: Pages (By File ID)
(declare retrieve-pages)
(s/def ::pages
(s/keys :req-un [::profile-id ::file-id]))
(sq/defquery ::pages
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(files/check-edition-permissions! conn profile-id file-id)
(retrieve-pages conn params)))
(def ^:private sql:pages
"select p.*
from page as p
where p.file_id = $1
and p.deleted_at is null
order by p.created_at asc")
(defn- retrieve-pages
[conn {:keys [profile-id file-id] :as params}]
(-> (db/query conn [sql:pages file-id])
(p/then (partial mapv decode-row))))
;; --- Query: Single Page (By ID)
(declare retrieve-page)
(s/def ::page
(s/keys :req-un [::profile-id ::id]))
(sq/defquery ::page
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [page (retrieve-page conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
page)))
(def ^:private sql:page
"select p.* from page as p where id=$1")
(defn retrieve-page
[conn id]
(-> (db/query-one conn [sql:page id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row)))
;; --- Query: Project Page History (by Page ID)
;; (def ^:private sql:generic-page-history
;; "select pph.*
;; from project_page_history as pph
;; where pph.page_id = $2
;; and pph.version < $3
;; order by pph.version < desc")
;; (def ^:private sql:page-history
;; (str "with history as (" sql:generic-page-history ")"
;; " select * from history limit $4"))
;; (def ^:private sql:pinned-page-history
;; (str "with history as (" sql:generic-page-history ")"
;; " select * from history where pinned = true limit $4"))
;; (s/def ::page-id ::us/uuid)
;; (s/def ::max ::us/integer)
;; (s/def ::pinned ::us/boolean)
;; (s/def ::since ::us/integer)
;; (s/def ::project-page-snapshots
;; (s/keys :req-un [::page-id ::user]
;; :opt-un [::max ::pinned ::since]))
;; (defn retrieve-page-snapshots
;; [conn {:keys [page-id user since max pinned] :or {since Long/MAX_VALUE max 10}}]
;; (let [sql (-> (sql/from ["project_page_snapshots" "ph"])
;; (sql/select "ph.*")
;; (sql/where ["ph.user_id = ?" user]
;; ["ph.page_id = ?" page-id]
;; ["ph.version < ?" since]
;; (when pinned
;; ["ph.pinned = ?" true]))
;; (sql/order "ph.version desc")
;; (sql/limit max))]
;; (-> (db/query conn (sql/fmt sql))
;; (p/then (partial mapv decode-row)))))
;; (sq/defquery ::project-page-snapshots
;; [{:keys [page-id user] :as params}]
;; (db/with-atomic [conn db/pool]
;; (p/do! (retrieve-page conn {:id page-id :user user})
;; (retrieve-page-snapshots conn params))))
;; --- Helpers
(defn decode-row
[{:keys [data metadata changes] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
changes (assoc :changes (blob/decode changes)))))

View file

@ -28,27 +28,59 @@
(s/def ::password ::us/string)
(s/def ::path ::us/string)
(s/def ::user ::us/uuid)
(s/def ::username ::us/string)
(s/def ::profile-id ::us/uuid)
;; --- Query: Profile (own)
(defn retrieve-profile
[conn id]
(let [sql "select * from users where id=$1 and deleted_at is null"]
(let [sql "select * from profile where id=$1 and deleted_at is null"]
(db/query-one db/pool [sql id])))
;; NOTE: this query make the assumption that union all preserves the
;; order so the first id will always be the team id and the second the
;; project_id; this is a postgresql behavior because UNION ALL works
;; like APPEND operation.
(def ^:private sql:default-team-and-project
"select t.id
from team as t
inner join team_profile_rel as tpr on (tpr.team_id = t.id)
where tpr.profile_id = $1
and tpr.is_owner is true
and t.is_default is true
union all
select p.id
from project as p
inner join project_profile_rel as tpr on (tpr.project_id = p.id)
where tpr.profile_id = $1
and tpr.is_owner is true
and p.is_default is true")
(defn retrieve-additional-data
[conn id]
(-> (db/query conn [sql:default-team-and-project id])
(p/then' (fn [[team project]]
{:default-team-id (:id team)
:default-project-id (:id project)}))))
(s/def ::profile
(s/keys :req-un [::user]))
(s/keys :req-un [::profile-id]))
(sq/defquery ::profile
[{:keys [user] :as params}]
(-> (retrieve-profile db/pool user)
(p/then' strip-private-attrs)
(p/then' #(images/resolve-media-uris % [:photo :photo-uri]))))
[{:keys [profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [prof (-> (retrieve-profile conn profile-id)
(p/then' su/raise-not-found-if-nil)
(p/then' strip-private-attrs)
(p/then' #(images/resolve-media-uris % [:photo :photo-uri])))
addt (retrieve-additional-data conn profile-id)]
(merge prof addt))))
;; --- Attrs Helpers
(defn strip-private-attrs
"Only selects a publicy visible user attrs."
"Only selects a publicy visible profile attrs."
[profile]
(select-keys profile [:id :fullname :lang :email :created-at :photo]))

View file

@ -1,199 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2019-2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.project-files
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]))
(declare decode-row)
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::user ::us/uuid)
;; --- Query: Project Files
(declare retrieve-recent-files)
(declare retrieve-project-files)
(s/def ::project-files
(s/keys :req-un [::user]
:opt-un [::project-id]))
(sq/defquery ::project-files
[{:keys [project-id] :as params}]
(if (nil? project-id)
(retrieve-recent-files db/pool params)
(retrieve-project-files db/pool params)))
(def ^:private sql:generic-project-files
"select distinct
pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_users as pu
inner join project_files as pf on (pf.project_id = pu.project_id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pu.user_id = $1
and pu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following)
order by pf.created_at")
(def ^:private sql:project-files
(str "with files as (" sql:generic-project-files ") "
"select * from files where project_id = $2"))
(defn retrieve-project-files
[conn {:keys [user project-id]}]
(-> (db/query conn [sql:project-files user project-id])
(p/then' (partial mapv decode-row))))
(def ^:private sql:recent-files
"with project_files as (
(select pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_users as pu
inner join project_files as pf on (pf.project_id = pu.project_id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pu.user_id = $1
and pu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following))
union
(select pf.*,
array_agg(pp.id) over pages_w as pages,
first_value(pp.data) over pages_w as data,
p.name as project_name
from project_file_users as pfu
inner join project_files as pf on (pfu.file_id = pf.id)
inner join projects as p on (p.id = pf.project_id)
left join project_pages as pp on (pf.id = pp.file_id)
where pfu.user_id = $1
and pfu.can_edit = true
window pages_w as (partition by pf.id order by pp.created_at
range between unbounded preceding
and unbounded following))
) select pf1.*
from project_files as pf1
order by pf1.modified_at desc
limit $2;")
(defn retrieve-recent-files
[conn {:keys [user]}]
(-> (db/query conn [sql:recent-files user 20])
(p/then' (partial mapv decode-row))))
;; --- Query: Project File (By ID)
(def ^:private sql:project-file
(str "with files as (" sql:generic-project-files ") "
"select * from files where id = $2"))
(s/def ::project-file
(s/keys :req-un [::user ::id]))
(sq/defquery ::project-file
[{:keys [user id] :as params}]
(-> (db/query-one db/pool [sql:project-file user id])
(p/then' decode-row)))
;; --- Query: Users of the File
(declare retrieve-minimal-file)
(declare retrieve-file-users)
(s/def ::project-file-users
(s/keys :req-un [::user ::file-id]))
(sq/defquery ::project-file-users
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (retrieve-minimal-file conn user file-id)
(p/then #(retrieve-file-users conn %)))))
(def ^:private sql:minimal-file
(str "with files as (" sql:generic-project-files ") "
"select id, project_id from files where id = $2"))
(defn- retrieve-minimal-file
[conn user-id file-id]
(-> (db/query-one conn [sql:minimal-file user-id file-id])
(p/then' su/raise-not-found-if-nil)))
(def ^:private sql:file-users
"select u.id, u.fullname, u.photo
from users as u
join project_file_users as pfu on (pfu.user_id = u.id)
where pfu.file_id = $1
union all
select u.id, u.fullname, u.photo
from users as u
join project_users as pu on (pu.user_id = u.id)
where pu.project_id = $2")
(defn- retrieve-file-users
[conn {:keys [id project-id] :as file}]
(let [sqlv [sql:file-users id project-id]]
(db/query conn sqlv)))
;; --- Query: Images of the File
(declare retrieve-file-images)
(s/def ::project-file-images
(s/keys :req-un [::user ::file-id]))
(sq/defquery ::project-file-images
[{:keys [user file-id] :as params}]
(db/with-atomic [conn db/pool]
(-> (retrieve-minimal-file conn user file-id)
(p/then #(retrieve-file-images conn %)))))
(def ^:private sql:file-images
"select pfi.*
from project_file_images as pfi
where pfi.file_id = $1")
(defn retrieve-file-images
[conn {:keys [id] :as file}]
(let [sqlv [sql:file-images id]
xf (comp (map #(images/resolve-urls % :path :uri))
(map #(images/resolve-urls % :thumb-path :thumb-uri)))]
(-> (db/query conn sqlv)
(p/then' #(into [] xf %)))))
;; --- Helpers
(defn decode-row
[{:keys [pages data] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
pages (assoc :pages (vec (remove nil? pages))))))

View file

@ -1,128 +0,0 @@
;; 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) 2019 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.services.queries.project-pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.sql :as sql]))
;; --- Helpers & Specs
(declare decode-row)
(s/def ::id ::us/uuid)
(s/def ::user ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(def sql:generic-project-pages
"select pp.*
from project_pages as pp
inner join project_files as pf on (pf.id = pp.file_id)
inner join projects as p on (p.id = pf.project_id)
left join project_users as pu on (pu.project_id = p.id)
left join project_file_users as pfu on (pfu.file_id = pf.id)
where ((pfu.user_id = $1 and pfu.can_edit = true) or
(pu.user_id = $1 and pu.can_edit = true))
and pp.deleted_at is null
order by pp.created_at")
;; --- Query: Project Pages (By File ID)
(def sql:project-pages
(str "with pages as (" sql:generic-project-pages ")"
" select * from pages where file_id = $2"))
(s/def ::project-pages
(s/keys :req-un [::user ::file-id]))
(sq/defquery ::project-pages
[{:keys [user file-id] :as params}]
(let [sql sql:project-pages]
(-> (db/query db/pool [sql user file-id])
(p/then #(mapv decode-row %)))))
;; --- Query: Project Page (By ID)
(def ^:private sql:project-page
(str "with pages as (" sql:generic-project-pages ")"
" select * from pages where id = $2"))
(defn retrieve-page
[conn {:keys [user id] :as params}]
(let [sql sql:project-page]
(-> (db/query-one conn [sql user id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row))))
(s/def ::project-page
(s/keys :req-un [::user ::id]))
(sq/defquery ::project-page
[{:keys [user id] :as params}]
(retrieve-page db/pool params))
;; --- Query: Project Page History (by Page ID)
;; (def ^:private sql:generic-page-history
;; "select pph.*
;; from project_page_history as pph
;; where pph.page_id = $2
;; and pph.version < $3
;; order by pph.version < desc")
;; (def ^:private sql:page-history
;; (str "with history as (" sql:generic-page-history ")"
;; " select * from history limit $4"))
;; (def ^:private sql:pinned-page-history
;; (str "with history as (" sql:generic-page-history ")"
;; " select * from history where pinned = true limit $4"))
(s/def ::page-id ::us/uuid)
(s/def ::max ::us/integer)
(s/def ::pinned ::us/boolean)
(s/def ::since ::us/integer)
(s/def ::project-page-snapshots
(s/keys :req-un [::page-id ::user]
:opt-un [::max ::pinned ::since]))
(defn retrieve-page-snapshots
[conn {:keys [page-id user since max pinned] :or {since Long/MAX_VALUE max 10}}]
(let [sql (-> (sql/from ["project_page_snapshots" "ph"])
(sql/select "ph.*")
(sql/where ["ph.user_id = ?" user]
["ph.page_id = ?" page-id]
["ph.version < ?" since]
(when pinned
["ph.pinned = ?" true]))
(sql/order "ph.version desc")
(sql/limit max))]
(-> (db/query conn (sql/fmt sql))
(p/then (partial mapv decode-row)))))
(sq/defquery ::project-page-snapshots
[{:keys [page-id user] :as params}]
(db/with-atomic [conn db/pool]
(p/do! (retrieve-page conn {:id page-id :user user})
(retrieve-page-snapshots conn params))))
;; --- Helpers
(defn decode-row
[{:keys [data metadata changes] :as row}]
(when row
(cond-> row
data (assoc :data (blob/decode data))
metadata (assoc :metadata (blob/decode metadata))
changes (assoc :changes (blob/decode changes)))))

View file

@ -16,37 +16,38 @@
(declare decode-row)
;; --- Helpers & Specs
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
(s/def ::token ::us/string)
(s/def ::user ::us/uuid)
;; --- Query: Projects
(def sql:projects
"select p.*
from project_users as pu
inner join projects as p on (p.id = pu.project_id)
where pu.can_edit = true
and pu.user_id = $1
order by p.created_at asc")
(def ^:private sql:projects
"with projects as (
select p.*
from project as p
inner join team_profile_rel as tpr on (tpr.team_id = p.team_id)
where tpr.profile_id = $1
and (tpr.is_admin = true or
tpr.is_owner = true or
tpr.can_edit = true)
union
select p.*
from project as p
inner join project_profile_rel as ppr on (ppr.project_id = p.id)
where ppr.profile_id = $1
and (ppr.is_admin = true or
ppr.is_owner = true or
ppr.can_edit = true)
)
select *
from projects
where team_id = $2
order by created_at asc")
(s/def ::projects
(s/keys :req-un [::user]))
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(sq/defquery ::projects
[{:keys [user] :as params}]
(-> (db/query db/pool [sql:projects user])
(p/then' (partial mapv decode-row))))
(s/def ::projects-by-team
(s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::projects-by-team
[{:keys [profile-id team-id] :as params}]
(db/query db/pool [sql:projects profile-id team-id]))
;; --- Helpers
(defn decode-row
[{:keys [metadata] :as row}]
(when row
(cond-> row
metadata (assoc :metadata (blob/decode metadata)))))

View file

@ -14,17 +14,6 @@
[uxbox.util.uuid :as uuid]
[uxbox.util.dispatcher :as uds]))
;; (def logging-interceptor
;; {:enter (fn [data]
;; (let [type (get-in data [:request ::type])]
;; (assoc data ::start-time (System/nanoTime))))
;; :leave (fn [data]
;; (let [elapsed (- (System/nanoTime) (::start-time data))
;; elapsed (str (quot elapsed 1000000) "ms")
;; type (get-in data [:request ::type])]
;; (log/info "service" type "processed in" elapsed)
;; data))})
(defn raise-not-found-if-nil
[v]
(if (nil? v)

View file

@ -20,7 +20,8 @@
[uxbox.db :as db]
[uxbox.tasks.sendmail]
[uxbox.tasks.remove-media]
[uxbox.tasks.remove-demo-profile]
[uxbox.tasks.delete-profile]
[uxbox.tasks.delete-object]
[uxbox.tasks.impl :as impl]
[uxbox.util.time :as dt]
[vertx.core :as vc]
@ -42,7 +43,8 @@
;; need to perform a maintenance and delete some old tasks.
(def ^:private tasks
{"remove-demo-profile" #'uxbox.tasks.remove-demo-profile/handler
{"delete-profile" #'uxbox.tasks.delete-profile/handler
"delete-object" #'uxbox.tasks.delete-object/handler
"remove-media" #'uxbox.tasks.remove-media/handler
"sendmail" #'uxbox.tasks.sendmail/handler})
@ -54,7 +56,7 @@
;; (def ^:private schedule
;; [{:id "every 1 hour"
;; :cron (dt/cron "1 1 */1 * * ? *")
;; :fn #'uxbox.tasks.demo-gc/handler
;; :fn #'uxbox.tasks.gc/handler
;; :props {:foo 1}}])
;; (defstate scheduler

View file

@ -0,0 +1,81 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.tasks.delete-object
"Generic task for permanent deletion of objects."
(:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
(s/def ::type keyword?)
(s/def ::id ::us/uuid)
(s/def ::props
(s/keys :req-un [::id ::type]))
(defmulti handle-deletion (fn [conn props] (:type props)))
(defmethod handle-deletion :default
[conn {:keys [type id] :as props}]
(log/warn "no handler found for" type))
(defn handler
[{:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn db/pool]
(handle-deletion conn props)))
(defmethod handle-deletion :image
[conn {:keys [id] :as props}]
(let [sql "delete from image where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :image-collection
[conn {:keys [id] :as props}]
(let [sql "delete from image_collection
where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :icon
[conn {:keys [id] :as props}]
(let [sql "delete from icon where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :icon-collection
[conn {:keys [id] :as props}]
(let [sql "delete from icon_collection
where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :file
[conn {:keys [id] :as props}]
(let [sql "delete from file where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :file-image
[conn {:keys [id] :as props}]
(let [sql "delete from file_image where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :page
[conn {:keys [id] :as props}]
(let [sql "delete from page where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))
(defmethod handle-deletion :page-version
[conn {:keys [id] :as props}]
(let [sql "delete from page_version where id=$1 and deleted_at is not null"]
(db/query-one conn [sql id])))

View file

@ -0,0 +1,110 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.tasks.delete-profile
"Task for permanent deletion of profiles."
(:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
(declare select-profile)
(declare delete-profile-data)
(declare delete-teams)
(declare delete-files)
(declare delete-profile)
(s/def ::profile-id ::us/uuid)
(s/def ::props
(s/keys :req-un [::profile-id]))
(defn handler
[{:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn db/pool]
(-> (select-profile conn (:profile-id props))
(p/then (fn [profile]
(if (or (:is-demo profile)
(not (nil? (:deleted-at profile))))
(delete-profile-data conn (:id profile))
(log/warn "Profile " (:id profile)
"does not match constraints for deletion")))))))
(defn- delete-profile-data
[conn profile-id]
(log/info "Proceding to delete all data related to profile" profile-id)
(p/do!
(delete-teams conn profile-id)
(delete-files conn profile-id)
(delete-profile conn profile-id)))
(def ^:private sql:select-profile
"select id, is_demo, deleted_at
from profile
where id=$1 for update")
(defn- select-profile
[conn profile-id]
(db/query-one conn [sql:select-profile profile-id]))
(def ^:private sql:remove-owned-teams
"with teams as (
select distinct
tpr.team_id as id
from team_profile_rel as tpr
where tpr.profile_id = $1
and tpr.is_owner is true
), to_delete_teams as (
select tpr.team_id as id
from team_profile_rel as tpr
where tpr.team_id in (select id from teams)
group by tpr.team_id
having count(tpr.profile_id) = 1
)
delete from team
where id in (select id from to_delete_teams)
returning id")
(defn- delete-teams
[conn profile-id]
(-> (db/query-one conn [sql:remove-owned-teams profile-id])
(p/then' (constantly nil))))
(def ^:private sql:remove-owned-files
"with files_to_delete as (
select distinct
fpr.file_id as id
from file_profile_rel as fpr
inner join file as f on (fpr.file_id = f.id)
where fpr.profile_id = $1
and fpr.is_owner is true
and f.project_id is null
)
delete from file
where id in (select id from files_to_delete)
returning id")
(defn- delete-files
[conn profile-id]
(-> (db/query-one conn [sql:remove-owned-files profile-id])
(p/then' (constantly nil))))
(defn delete-profile
[conn profile-id]
(let [sql "delete from profile where id=$1"]
(-> (db/query conn [sql profile-id])
(p/then' (constantly profile-id)))))

View file

@ -20,31 +20,34 @@
[uxbox.db :as db]
[uxbox.util.blob :as blob]))
;; TODO: add images-gc with proper resource removal
;; TODO: add icons-gc
;; TODO: add pages-gc
;; TODO: test this
;; TODO: delete media referenced in pendint_to_delete table
;; --- Delete Projects
;; (def ^:private sql:delete-item
;; "with items_part as (
;; select i.id
;; from pending_to_delete as i
;; order by i.created_at
;; limit 1
;; for update skip locked
;; )
;; delete from pending_to_delete
;; where id in (select id from items_part)
;; returning *")
(def ^:private sql:delete-project
"delete from projects
where id = $1
and deleted_at is not null;")
;; (defn- remove-items
;; []
;; (vu/loop []
;; (db/with-atomic [conn db/pool]
;; (-> (db/query-one conn sql:delete-item)
;; (p/then decode-row)
;; (p/then (vu/wrap-blocking remove-media))
;; (p/then (fn [item]
;; (when (not (empty? items))
;; (p/recur))))))))
(s/def ::id ::us/uuid)
(s/def ::delete-project
(s/keys :req-un [::id]))
(defn- delete-project
"Clean deleted projects."
[{:keys [id] :as props}]
(us/verify ::delete-project props)
(db/with-atomic [conn db/pool]
(-> (db/query-one conn [sql:delete-project id])
(p/then (constantly nil)))))
(defn handler
{:uxbox.tasks/name "delete-project"}
[{:keys [props] :as task}]
(delete-project props))
;; (defn- remove-media
;; [{:keys
;; (doseq [item files]
;; (ust/delete! media/media-storage (:path item))
;; (ust/delete! media/media-storage (:thumb-path item)))
;; files)

View file

@ -38,7 +38,7 @@
(.printStackTrace err (java.io.PrintWriter. *out*))))
(def ^:private sql:mark-as-retry
"update tasks
"update task
set scheduled_at = clock_timestamp() + '5 seconds'::interval,
error = $1,
status = 'retry',
@ -53,7 +53,7 @@
(p/then' (constantly nil)))))
(def ^:private sql:mark-as-failed
"update tasks
"update task
set scheduled_at = clock_timestamp() + '5 seconds'::interval,
error = $1,
status = 'failed'
@ -67,7 +67,7 @@
(p/then' (constantly nil)))))
(def ^:private sql:mark-as-completed
"update tasks
"update task
set completed_at = clock_timestamp(),
status = 'completed'
where id = $1")
@ -87,7 +87,7 @@
nil))))
(def ^:private sql:select-next-task
"select * from tasks as t
"select * from task as t
where t.scheduled_at <= now()
and t.queue = $1
and (t.status = 'new' or (t.status = 'retry' and t.retry_num <= $2))
@ -141,7 +141,7 @@
(event-loop-handler (assoc options ::counter (inc counter)))))))))
(def ^:private sql:insert-new-task
"insert into tasks (name, props, queue, scheduled_at)
"insert into task (name, props, queue, scheduled_at)
values ($1, $2, $3, clock_timestamp()+cast($4::text as interval))
returning id")
@ -162,7 +162,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:privatr sql:upsert-scheduled-task
"insert into scheduled_tasks (id, cron_expr)
"insert into scheduled_task (id, cron_expr)
values ($1, $2)
on conflict (id)
do update set cron_expr=$2")
@ -178,7 +178,7 @@
(p/run! (partial synchronize-schedule-item conn) schedule)))
(def ^:private sql:lock-scheduled-task
"select id from scheduled_tasks where id=$1 for update skip locked")
"select id from scheduled_task where id=$1 for update skip locked")
(declare schedule-task)

View file

@ -1,93 +0,0 @@
;; 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/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns uxbox.tasks.remove-demo-profile
"Demo accounts garbage collector."
(:require
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
(declare remove-file-images)
(declare remove-images)
(declare remove-profile)
(s/def ::id ::us/uuid)
(s/def ::props
(s/keys :req-un [::id]))
(defn handler
[{:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn db/pool]
(remove-file-images conn (:id props))
(remove-images conn (:id props))
(remove-profile conn (:id props))))
(defn- remove-files
[files]
(doseq [item files]
(ust/delete! media/media-storage (:path item))
(ust/delete! media/media-storage (:thumb-path item)))
files)
(def ^:private sql:delete-file-images
"with images_part as (
select pfi.id
from project_file_images as pfi
inner join project_files as pf on (pf.id = pfi.file_id)
inner join projects as p on (p.id = pf.project_id)
where p.user_id = $1
limit 10
)
delete from project_file_images
where id in (select id from images_part)
returning id, path, thumb_path")
(defn remove-file-images
[conn id]
(vu/loop []
(-> (db/query conn [sql:delete-file-images id])
(p/then (vu/wrap-blocking remove-files))
(p/then (fn [images]
(when (not (empty? images))
(p/recur)))))))
(def ^:private sql:delete-images
"with images_part as (
select img.id
from images as img
where img.user_id = $1
limit 10
)
delete from images
where id in (select id from images_part)
returning id, path, thumb_path")
(defn- remove-images
[conn id]
(vu/loop []
(-> (db/query conn [sql:delete-images id])
(p/then (vu/wrap-blocking remove-files))
(p/then (fn [images]
(when (not (empty? images))
(p/recur)))))))
(defn remove-profile
[conn id]
(let [sql "delete from users where id=$1"]
(db/query conn [sql id])))

View file

@ -11,8 +11,6 @@
[clojure.spec.alpha :as s]
[promesa.core :as p]
[expound.alpha :as expound]
[sieppari.core :as sp]
[sieppari.context :as spx]
[uxbox.common.exceptions :as ex])
(:import
clojure.lang.IDeref
@ -45,8 +43,7 @@
(let [key (get params attr)
f (.get ^Map reg key)]
(when (nil? f)
(ex/raise :type :not-found
:code :method-not-found
(ex/raise :type :method-not-found
:hint "No method found for the current request."))
(f params))))