Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-28 15:41:25 -05:00
Code Issues Activity

♻️ Refactor backend.

Browse source 
Move from custom vertx to jetty9.
This commit is contained in:
Andrey Antukh 2020-05-14 13:49:11 +02:00 • committed by Alonso Torres
parent 1639e15975
commit 5a03c13731
82 changed files with 1763 additions and 4667 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
backend/deps.edn
View file

@ -5,11 +5,13 @@
:deps
{org.clojure/clojure {:mvn/version "1.10.1"}
org.clojure/data.json {:mvn/version "1.0.0"}
org.clojure/core.async {:mvn/version "1.2.603"}
;; Logging
org.clojure/tools.logging {:mvn/version "1.1.0"}
org.apache.logging.log4j/log4j-api {:mvn/version "2.13.2"}
org.apache.logging.log4j/log4j-core {:mvn/version "2.13.2"}
org.apache.logging.log4j/log4j-web {:mvn/version "2.13.2"}
org.apache.logging.log4j/log4j-jul {:mvn/version "2.13.2"}
org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.13.2"}
@ -17,14 +19,14 @@
instaparse/instaparse {:mvn/version "1.4.10"}
com.cognitect/transit-clj {:mvn/version "1.0.324"}
;; TODO: vendorize pgclient under `vertx-clojure/vertx-pgclient`
io.vertx/vertx-pg-client {:mvn/version "4.0.0-milestone4"}
io.lettuce/lettuce-core {:mvn/version "5.2.2.RELEASE"}
java-http-clj/java-http-clj {:mvn/version "0.4.1"}
vertx-clojure/vertx
{:local/root "vendor/vertx"
:deps/manifest :pom}
info.sunng/ring-jetty9-adapter {:mvn/version "0.12.8"}
seancorfield/next.jdbc {:mvn/version "1.0.424"}
metosin/reitit-ring {:mvn/version "0.4.2"}
org.postgresql/postgresql {:mvn/version "42.2.12"}
com.zaxxer/HikariCP {:mvn/version "3.4.3"}
funcool/datoteka {:mvn/version "1.2.0"}
funcool/promesa {:mvn/version "5.1.0"}

18
backend/src/uxbox/core.clj
View file

@ -1,18 +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.core
(:require
[vertx.core :as vc]
[vertx.timers :as vt]
[mount.core :as mount :refer [defstate]]))
(defstate system
:start (vc/system)
:stop (vc/stop system))

126
backend/src/uxbox/db.clj
View file

@ -6,49 +6,109 @@
(ns uxbox.db
(:require
[clojure.string :as str]
[clojure.tools.logging :as log]
[lambdaisland.uri :refer [uri]]
[mount.core :as mount :refer [defstate]]
[promesa.core :as p]
[next.jdbc :as jdbc]
[next.jdbc.date-time :as jdbc-dt]
[next.jdbc.optional :as jdbc-opt]
[next.jdbc.result-set :as jdbc-rs]
[next.jdbc.sql :as jdbc-sql]
[next.jdbc.sql.builder :as jdbc-bld]
[uxbox.common.exceptions :as ex]
[uxbox.config :as cfg]
[uxbox.core :refer [system]]
[uxbox.util.data :as data]
[uxbox.util.pgsql :as pg]
[vertx.core :as vx]))
[uxbox.util.data :as data])
(:import
com.zaxxer.hikari.HikariConfig
com.zaxxer.hikari.HikariDataSource))
(defn- create-datasource-config
[cfg]
(let [dburi (:database-uri cfg)
username (:database-username cfg)
password (:database-password cfg)
config (HikariConfig.)]
(doto config
(.setJdbcUrl (str "jdbc:" dburi))
(.setAutoCommit true)
(.setReadOnly false)
(.setConnectionTimeout 30000)
(.setValidationTimeout 5000)
(.setIdleTimeout 600000)
(.setMaxLifetime 1800000)
(.setMinimumIdle 10)
(.setMaximumPoolSize 20))
(when username (.setUsername config username))
(when password (.setPassword config password))
config))
(defn- create-pool
[config system]
(let [dburi (:database-uri config)
username (:database-username config)
password (:database-password config)
dburi (-> (uri dburi)
(assoc :user username)
(assoc :password password)
(str))]
(log/info "creating connection pool with" dburi)
(pg/pool dburi {:system system :max-size 8})))
[cfg]
(let [dsc (create-datasource-config cfg)]
(jdbc-dt/read-as-instant)
(HikariDataSource. dsc)))
(defstate pool
:start (create-pool cfg/config system))
:start (create-pool cfg/config)
:stop (.close pool))
(defmacro with-atomic
[bindings & args]
`(pg/with-atomic ~bindings (p/do! ~@args)))
[& args]
`(jdbc/with-transaction ~@args))
(def row-xfm
(comp (map pg/row->map)
(map data/normalize-attrs)))
(defn- kebab-case [s] (str/replace s #"_" "-"))
(defn- snake-case [s] (str/replace s #"-" "_"))
(defn- as-kebab-maps
[rs opts]
(jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case)))
(defmacro query
[conn sql]
`(-> (pg/query ~conn ~sql {:xfm row-xfm})
(p/catch' (fn [err#]
(ex/raise :type :database-error
:cause err#)))))
(defmacro query-one
[conn sql]
`(-> (pg/query-one ~conn ~sql {:xfm row-xfm})
(p/catch' (fn [err#]
(ex/raise :type :database-error
:cause err#)))))
(defn open
[]
(jdbc/get-connection pool))
(defn exec!
[ds sv]
(jdbc/execute! ds sv {:builder-fn as-kebab-maps}))
(defn exec-one!
([ds sv] (exec-one! ds sv {}))
([ds sv opts]
(jdbc/execute-one! ds sv (assoc opts :builder-fn as-kebab-maps))))
(def ^:private default-options
{:table-fn snake-case
:column-fn snake-case
:builder-fn as-kebab-maps})
(defn insert!
[ds table params]
(jdbc-sql/insert! ds table params default-options))
(defn update!
[ds table params where]
(let [opts (assoc default-options :return-keys true)]
(jdbc-sql/update! ds table params where opts)))
(defn delete!
[ds table params]
(let [opts (assoc default-options :return-keys true)]
(jdbc-sql/delete! ds table params opts)))
(defn get-by-params
([ds table params]
(get-by-params ds table params nil))
([ds table params opts]
(let [opts (cond-> (merge default-options opts)
(:for-update opts)
(assoc :suffix "for update"))
res (exec-one! ds (jdbc-bld/for-query table params opts) opts)]
(when (:deleted-at res)
(ex/raise :type :not-found))
res)))
(defn get-by-id
([ds table id]
(get-by-params ds table {:id id} nil))
([ds table id opts]
(get-by-params ds table {:id id} opts)))

4
backend/src/uxbox/emails.clj
View file

@ -27,8 +27,8 @@
(defn render
[email context]
(let [defaults {:from (:email-from cfg/config)
:reply-to (:email-reply-to cfg/config)}]
(let [defaults {:from (:sendmail-from cfg/config)
:reply-to (:sendmail-reply-to cfg/config)}]
(email (merge defaults context))))
(defn send!

218
backend/src/uxbox/fixtures.clj
View file

@ -8,20 +8,17 @@
"A initial fixtures."
(:require
[clojure.tools.logging :as log]
[sodi.pwhash :as pwhash]
[mount.core :as mount]
[promesa.core :as p]
[uxbox.config :as cfg]
[uxbox.common.pages :as cp]
[sodi.pwhash :as pwhash]
[uxbox.common.data :as d]
[uxbox.core]
[uxbox.common.pages :as cp]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.migrations]
[uxbox.services.mutations.profile :as mt.profile]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]
[vertx.util :as vu]))
[uxbox.util.blob :as blob]))
(defn- mk-uuid
[prefix & args]
@ -31,52 +28,6 @@
(def password (pwhash/derive "123123"))
(def sql:create-team
"insert into team (id, name, photo)
values ($1, $2, $3)
returning *;")
(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 *;")
(def sql:create-project
"insert into project (id, team_id, name)
values ($1, $2, $3)
returning *;")
(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 *")
(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 *")
(def sql:create-file
"insert into file (id, project_id, name)
values ($1, $2, $3 ) returning *")
(def sql:create-page
"insert into page (id, file_id, name,
version, ordering, data)
values ($1, $2, $3, $4, $5, $6)
returning id;")
(def sql:create-icon-library
"insert into icon_library (team_id, name)
values ($1, $2)
returning id;")
(def sql:create-icon
"insert into icon_library (library_id, name, content, metadata)
values ($1, $2, $3, $4)
returning id;")
(def preset-small
{:num-teams 5
:num-profiles 5
@ -113,13 +64,7 @@
(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))
(reduce #(conj %1 (f %2)) [] items))
(defn impl-run
[opts]
@ -144,13 +89,13 @@
create-team
(fn [conn index]
(let [sql sql:create-team
id (mk-uuid "team" index)
(let [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)))))
(db/insert! conn :team {:id id
:name name
:photo ""})
id))
create-teams
(fn [conn]
@ -160,114 +105,143 @@
create-page
(fn [conn owner-id project-id file-id index]
(p/let [id (mk-uuid "page" project-id file-id index)
data cp/default-page-data
name (str "page " index)
version 0
ordering index
data (blob/encode data)]
(let [id (mk-uuid "page" project-id file-id index)
data cp/default-page-data
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])))
(db/insert! conn :page
{:id id
:file-id file-id
:name name
:version version
:ordering ordering
:data 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))))
(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)]
(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])
(db/insert! conn :file
{:id id
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit 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)))
(let [file-ids (collect (partial create-file conn owner-id project-id)
(range (:num-files-per-project opts)))]
(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)]
(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])
(db/insert! conn :project
{:id id
:team-id team-id
:name name})
(db/insert! conn :project-profile-rel
{:project-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit 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)))
(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)))]
(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])))
(db/insert! conn :team-profile-rel
{:team-id team-id
:profile-id profile-id
:is-owner owner?
:is-admin true
:can-edit 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-profile-to-team conn team-id true (first profile-ids))
(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)]
(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)]
(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))))))
(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))))
(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))]
(let [owner-id (:id owner)
id (mk-uuid "file" "draft" owner-id index)
name (str "file" index)
project-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])
(db/insert! conn :file
{:id id
:project-id project-id
:name name})
(db/insert! conn :file-profile-rel
{:file-id id
:profile-id owner-id
:is-owner true
:is-admin true
:can-edit true})
id))
create-draft-files
(fn [conn profile]
(p/let [file-ids (collect (partial create-draft-file conn profile)
(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)))
(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)]
(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)))))
(run! (partial create-draft-files conn) profiles)))))
(defn run
[preset]
@ -278,17 +252,15 @@
;; "medium" preset-medium
;; "big" preset-big
preset-small))]
(deref (impl-run preset))))
(impl-run preset)))
(defn -main
[& args]
(try
(-> (mount/only #{#'uxbox.config/config
#'uxbox.core/system
#'uxbox.db/pool
#'uxbox.migrations/migrations})
(mount/start))
(run (first args))
(finally
(mount/stop))))

95
backend/src/uxbox/http.clj
View file

@ -8,70 +8,57 @@
(:require
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[promesa.core :as p]
[uxbox.core :refer [system]]
[reitit.ring :as rring]
[ring.adapter.jetty9 :as jetty]
[uxbox.config :as cfg]
[uxbox.http.debug :as debug]
[uxbox.http.errors :as errors]
[uxbox.http.handlers :as handlers]
[uxbox.http.middleware :as middleware]
[uxbox.http.session :as session]
[uxbox.http.handlers :as handlers]
[uxbox.http.debug :as debug]
[uxbox.http.ws :as ws]
[vertx.core :as vc]
[vertx.http :as vh]
[vertx.web :as vw]
[vertx.web.middleware :as vwm]))
[uxbox.services.notifications :as usn]))
(defn- on-start
[ctx]
(let [cors-opts {:origin (:http-server-cors cfg/config "http://localhost:3449")
:max-age 3600
:allow-credentials true
:allow-methods #{:post :get :patch :head :options :put}
:allow-headers #{:x-requested-with :content-type :cookie}}
(defn- create-router
[]
(rring/router
[["/api" {:middleware [[middleware/format-response-body]
[middleware/errors errors/handle]
[middleware/parse-request-body]
[middleware/params]
[middleware/multipart-params]
[middleware/keyword-params]
[middleware/cookies]]}
["/echo" {:get handlers/echo-handler
:post handlers/echo-handler}]
routes [["/notifications/:file-id/:session-id"
{:middleware [[vwm/cookies]
[vwm/cors cors-opts]
[middleware/format-response-body]
[session/auth]]
:handler ws/handler
:method :get}]
["/login" {:handler handlers/login-handler
:method :post}]
["/logout" {:handler handlers/logout-handler
:method :post}]
["/api" {:middleware [[vwm/cookies]
[vwm/params]
[vwm/cors cors-opts]
[middleware/parse-request-body]
[middleware/format-response-body]
[middleware/method-match]
[vwm/errors errors/handle]]}
["/echo" {:handler handlers/echo-handler}]
["/login" {:handler handlers/login-handler
:method :post}]
["/logout" {:handler handlers/logout-handler
:method :post}]
["/w" {:middleware [session/auth]}
["/mutation/:type" {:middleware [vwm/uploads]
:handler handlers/mutation-handler
:method :post}]
["/query/:type" {:handler handlers/query-handler
:method :get}]]]]
["/w" {:middleware [session/auth]}
["/query/:type" {:get handlers/query-handler}]
["/mutation/:type" {:post handlers/mutation-handler}]]]]))
handler (vw/handler ctx
(vw/assets "/media/*" {:root "resources/public/media"})
(vw/assets "/static/*" {:root "resources/public/static"})
(vw/router routes))]
(defstate app
:start (rring/ring-handler
(create-router)
(constantly {:status 404, :body ""})
{:middleware [middleware/development-resources
middleware/development-cors]}))
(log/info "Starting http server on" (:http-server-port cfg/config) "port.")
(vh/server ctx {:handler handler
:port (:http-server-port cfg/config)})))
(def num-cpus
(delay (.availableProcessors (Runtime/getRuntime))))
(defn start-server
[cfg app]
(let [wsockets {"/ws/notifications" ws/handler}
options {:port (:http-server-port cfg)
:h2c? true
:join? false
:allow-null-path-info true
:websockets wsockets}]
(jetty/run-jetty app options)))
(defstate server
:start (let [vf (vc/verticle {:on-start on-start})]
@(vc/deploy! system vf {:instances @num-cpus})))
:start (start-server cfg/config app)
:stop (.stop server))

39
backend/src/uxbox/http/handlers.clj
View file

@ -6,16 +6,13 @@
(ns uxbox.http.handlers
(:require
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.uuid :as uuid]
[uxbox.emails :as emails]
[uxbox.http.session :as session]
[uxbox.services.init]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.common.uuid :as uuid]
[vertx.web :as vw]
[vertx.eventbus :as ve]))
[uxbox.services.queries :as sq]))
(def unauthorized-services
#{:create-demo-profile
@ -36,10 +33,8 @@
(:profile-id req) (assoc :profile-id (:profile-id req)))]
(if (or (:profile-id req)
(contains? unauthorized-services type))
(-> (sq/handle (with-meta data {:req req}))
(p/then' (fn [result]
{:status 200
:body result})))
{:status 200
:body (sq/handle (with-meta data {:req req}))}
{:status 403
:body {:type :authentication
:code :unauthorized}})))
@ -55,9 +50,8 @@
(:profile-id req) (assoc :profile-id (:profile-id req)))]
(if (or (:profile-id req)
(contains? unauthorized-services type))
(-> (sm/handle (with-meta data {:req req}))
(p/then' (fn [result]
{:status 200 :body result})))
{:status 200
:body (sm/handle (with-meta data {:req req}))}
{:status 403
:body {:type :authentication
:code :unauthorized}})))
@ -66,8 +60,8 @@
[req]
(let [data (:body-params req)
user-agent (get-in req [:headers "user-agent"])]
(p/let [profile (sm/handle (assoc data ::sm/type :login))
token (session/create (:id profile) user-agent)]
(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})))
@ -76,16 +70,15 @@
[req]
(some-> (get-in req [:cookies "auth-token"])
(uuid/uuid)
(session/delete)
(p/then' (fn [token]
{:status 204
:cookies {"auth-token" nil}
:body ""}))))
(session/delete))
{:status 204
:cookies {"auth-token" nil}
:body ""})
(defn echo-handler
[req]
(p/promise {:status 200
:body {:params (:params req)
:cookies (:cookies req)
:headers (:headers req)}}))
{:status 200
:body {:params (:params req)
:cookies (:cookies req)
:headers (:headers req)}})

117
backend/src/uxbox/http/middleware.clj
View file

@ -9,30 +9,32 @@
(ns uxbox.http.middleware
(:require
[promesa.core :as p]
[vertx.web :as vw]
[uxbox.config :as cfg]
[clojure.tools.logging :as log]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.multipart-params :refer [wrap-multipart-params]]
[ring.middleware.params :refer [wrap-params]]
[ring.middleware.resource :refer [wrap-resource]]
[uxbox.common.exceptions :as ex]
[uxbox.util.transit :as t])
(:import
io.vertx.ext.web.RoutingContext
io.vertx.ext.web.FileUpload
io.vertx.core.buffer.Buffer))
[uxbox.config :as cfg]
[uxbox.util.transit :as t]))
(defn- wrap-parse-request-body
[handler]
(fn [{:keys [headers body method] :as request}]
(let [mtype (get headers "content-type")]
(if (and (= "application/transit+json" mtype)
(not= method :get))
(try
(let [params (t/decode (t/buffer->bytes body))]
(handler (assoc request :body-params params)))
(catch Exception e
(ex/raise :type :parse
:message "Unable to parse transit from request body."
:cause e)))
(handler request)))))
(letfn [(parse-body [body]
(try
(let [reader (t/reader body)]
(t/read! reader))
(catch Exception e
(ex/raise :type :parse
:message "Unable to parse transit from request body."
:cause e))))]
(fn [{:keys [headers body request-method] :as request}]
(handler
(cond-> request
(and (= "application/transit+json" (get headers "content-type"))
(not= request-method :get))
(assoc :body-params (parse-body body)))))))
(def parse-request-body
{:name ::parse-request-body
@ -47,7 +49,7 @@
(cond
(coll? body)
(-> response
(assoc :body (t/bytes->buffer (t/encode body {:type type})))
(assoc :body (t/encode body {:type type}))
(update :headers assoc
"content-type"
"application/transit+json"))
@ -61,26 +63,69 @@
(defn- wrap-format-response-body
[handler]
(fn [request]
(-> (p/do! (handler request))
(p/then' (fn [response]
(cond-> response
(map? response) (impl-format-response-body)))))))
(let [response (handler request)]
(cond-> response
(map? response) (impl-format-response-body)))))
(def format-response-body
{:name ::format-response-body
:compile (constantly wrap-format-response-body)})
(defn- wrap-errors
[handler on-error]
(fn [request]
(try
(handler request)
(catch Throwable e
(on-error e request)))))
(defn- wrap-method-match
(def errors
{:name ::errors
:compile (constantly wrap-errors)})
(def cookies
{:name ::cookies
:compile (constantly wrap-cookies)})
(def params
{:name ::params
:compile (constantly wrap-params)})
(def multipart-params
{:name ::multipart-params
:compile (constantly wrap-multipart-params)})
(def keyword-params
{:name ::keyword-params
:compile (constantly wrap-keyword-params)})
(defn- wrap-development-cors
[handler]
(fn [request]))
(letfn [(add-cors-headers [response]
(update response :headers
(fn [headers]
(-> headers
(assoc "access-control-allow-origin" "http://localhost:3449")
(assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH")
(assoc "access-control-allow-credentials" "true")
(assoc "access-control-expose-headers" "x-requested-with, content-type, cookie")
(assoc "access-control-allow-headers" "content-type")))))]
(fn [request]
(if (= (:request-method request) :options)
(-> {:status 200 :body ""}
(add-cors-headers))
(let [response (handler request)]
(add-cors-headers response))))))
(def development-cors
{:name ::development-cors
:compile (fn [& args]
(when *assert*
wrap-development-cors))})
(def development-resources
{:name ::development-resources
:compile (fn [& args]
(when *assert*
#(wrap-resource % "public")))})
(def method-match
{:name ::method-match
:compile (fn [data opts]
(when-let [method (:method data)]
(fn [handler]
(fn [request]
(if (= (:method request) method)
(handler request)
{:status 405 :body ""})))))})

36
backend/src/uxbox/http/session.clj
View file

@ -6,8 +6,6 @@
(ns uxbox.http.session
(:require
[promesa.core :as p]
[vertx.core :as vc]
[uxbox.db :as db]
[uxbox.common.uuid :as uuid]))
@ -17,22 +15,21 @@
"Retrieves a user id associated with the provided auth token."
[token]
(when token
(let [sql "select profile_id from session where id = $1"]
(-> (db/query-one db/pool [sql token])
(p/then' (fn [row] (when row (:profile-id row))))))))
(let [row (db/get-by-params db/pool :session {:id token})]
(:profile-id row))))
(defn create
[user-id user-agent]
(let [id (uuid/random)
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))))))
(let [id (uuid/random)]
(db/insert! db/pool :session {:id id
:profile-id user-id
:user-agent user-agent})
(str id)))
(defn delete
[token]
(let [sql "delete from session where id = $1"]
(-> (db/query-one db/pool [sql token])
(p/then' (constantly nil)))))
(db/delete! db/pool :session {:id token})
nil)
;; --- Interceptor
@ -40,19 +37,18 @@
[request]
(try
(when-let [token (get-in request [:cookies "auth-token"])]
(uuid/uuid token))
(uuid/uuid (:value token)))
(catch java.lang.IllegalArgumentException e
nil)))
(defn- wrap-auth
(defn wrap-auth
[handler]
(fn [request]
(let [token (parse-token request)]
(-> (p/do! (retrieve token))
(p/then (fn [profile-id]
(if profile-id
(handler (assoc request :profile-id profile-id))
(handler request))))))))
(let [token (parse-token request)
profile-id (retrieve token)]
(if profile-id
(handler (assoc request :profile-id profile-id))
(handler request)))))
(def auth
{:nane ::auth

41
backend/src/uxbox/http/ws.clj
View file

@ -7,12 +7,37 @@
(ns uxbox.http.ws
"Web Socket handlers"
(:require
[uxbox.services.notifications :as nf]
[vertx.web.websockets :as ws]))
[clojure.core.async :as a]
[ring.middleware.cookies :refer [wrap-cookies]]
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
[ring.middleware.params :refer [wrap-params]]
[uxbox.http.session :refer [wrap-auth]]
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[promesa.core :as p]
[ring.adapter.jetty9 :as jetty]
[uxbox.common.exceptions :as ex]
[uxbox.common.uuid :as uuid]
[uxbox.common.spec :as us]
[uxbox.redis :as redis]
[ring.util.codec :as codec]
[uxbox.util.transit :as t]
[uxbox.services.notifications :as nf]))
(defn handler
[{:keys [user] :as req}]
(ws/websocket
{:handler #(nf/websocket req %)
:input-buffer-size 64
:output-buffer-size 64}))
(s/def ::file-id ::us/uuid)
(s/def ::session-id ::us/uuid)
(s/def ::websocket-params
(s/keys :req-un [::file-id ::session-id]))
(defn websocket
[req]
(let [params (us/conform ::websocket-params (:params req))
params (assoc params :profile-id (:profile-id req))]
(nf/websocket params)))
(def handler
(-> websocket
(wrap-auth)
(wrap-keyword-params)
(wrap-cookies)
(wrap-params)))

154
backend/src/uxbox/media_loader.clj
View file

@ -15,7 +15,6 @@
[clojure.pprint :refer [pprint]]
[clojure.java.io :as io]
[clojure.edn :as edn]
[promesa.core :as p]
[mount.core :as mount]
[datoteka.core :as fs]
[cuerdas.core :as str]
@ -63,7 +62,6 @@
([code]
(System/exit code)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Icons Libraries Importer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -71,10 +69,8 @@
(defn- icon-library-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id from icon_library where id = $1"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(let [row (db/get-by-id conn :icon-library id)]
(if row true false)))
(defn- create-icons-library
[conn {:keys [name] :as item}]
@ -87,11 +83,9 @@
(defn- create-icons-library-if-not-exists
[conn {:keys [name] :as item}]
(let [id (uuid/namespaced +icons-uuid-ns+ name)]
(-> (icon-library-exists? conn id)
(p/then (fn [exists?]
(when-not exists?
(create-icons-library conn item))))
(p/then (constantly id)))))
(when-not (icon-library-exists? conn id)
(create-icons-library conn item))
id))
(defn- create-icon
[conn library-id icon-id localpath]
@ -113,36 +107,32 @@
(defn- icon-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id from icon where id = $1"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(let [row (db/get-by-id conn :icon id)]
(if row true false)))
(defn- import-icon-if-not-exists
[conn library-id fpath]
(s/assert ::us/uuid library-id)
(s/assert fs/path? fpath)
(let [icon-id (uuid/namespaced +icons-uuid-ns+ (str library-id (fs/name fpath)))]
(-> (icon-exists? conn icon-id)
(p/then (fn [exists?]
(when-not exists?
(create-icon conn library-id icon-id fpath))))
(p/then (constantly icon-id)))))
(when-not (icon-exists? conn icon-id)
(create-icon conn library-id icon-id fpath))
icon-id))
(defn- import-icons
[conn library-id {:keys [path regex] :as item}]
(p/run! (fn [fpath]
(when (re-matches regex (str fpath))
(import-icon-if-not-exists conn library-id fpath)))
(->> (fs/list-dir path)
(filter fs/regular-file?))))
(run! (fn [fpath]
(when (re-matches regex (str fpath))
(import-icon-if-not-exists conn library-id fpath)))
(->> (fs/list-dir path)
(filter fs/regular-file?))))
(defn- process-icons-library
[conn basedir {:keys [path regex] :as item}]
(s/assert ::import-item-media item)
(-> (create-icons-library-if-not-exists conn item)
(p/then (fn [library-id]
(->> (assoc item :path (fs/join basedir path))
(import-icons conn library-id))))))
(let [library-id (create-icons-library-if-not-exists conn item)]
(->> (assoc item :path (fs/join basedir path))
(import-icons conn library-id))))
;; --- Images Libraries Importer
@ -150,9 +140,8 @@
(defn- image-library-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id from image_library where id = $1"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(let [row (db/get-by-id conn :image-library id)]
(if row true false)))
(defn- create-images-library
[conn {:keys [name] :as item}]
@ -162,16 +151,12 @@
:team-id uuid/zero
:name name})))
(defn- create-images-library-if-not-exists
[conn {:keys [name] :as item}]
(let [id (uuid/namespaced +images-uuid-ns+ name)]
(-> (image-library-exists? conn id)
(p/then (fn [exists?]
(when-not exists?
(create-images-library conn item))))
(p/then (constantly id)))))
(when-not (image-library-exists? conn id)
(create-images-library conn item)
id)))
(defn- create-image
[conn library-id image-id localpath]
@ -186,9 +171,9 @@
".png" "image/png"
".webp" "image/webp")]
(log/info "Creating image" filename image-id)
(images/create-image conn {:content {:path localpath
:name filename
:mtype mtype
(images/create-image conn {:content {:tempfile localpath
:filename filename
:content-type mtype
:size (.length file)}
:id image-id
:library-id library-id
@ -198,36 +183,32 @@
(defn- image-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id from image where id = $1"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(let [row (db/get-by-id conn :image id)]
(if row true false)))
(defn- import-image-if-not-exists
[conn library-id fpath]
(s/assert ::us/uuid library-id)
(s/assert fs/path? fpath)
(let [image-id (uuid/namespaced +images-uuid-ns+ (str library-id (fs/name fpath)))]
(-> (image-exists? conn image-id)
(p/then (fn [exists?]
(when-not exists?
(create-image conn library-id image-id fpath))))
(p/then (constantly image-id)))))
(when-not (image-exists? conn image-id)
(create-image conn library-id image-id fpath))
image-id))
(defn- import-images
[conn library-id {:keys [path regex] :as item}]
(p/run! (fn [fpath]
(when (re-matches regex (str fpath))
(import-image-if-not-exists conn library-id fpath)))
(->> (fs/list-dir path)
(filter fs/regular-file?))))
(run! (fn [fpath]
(when (re-matches regex (str fpath))
(import-image-if-not-exists conn library-id fpath)))
(->> (fs/list-dir path)
(filter fs/regular-file?))))
(defn- process-images-library
[conn basedir {:keys [path regex] :as item}]
(s/assert ::import-item-media item)
(-> (create-images-library-if-not-exists conn item)
(p/then (fn [library-id]
(->> (assoc item :path (fs/join basedir path))
(import-images conn library-id))))))
(let [library-id (create-images-library-if-not-exists conn item)]
(->> (assoc item :path (fs/join basedir path))
(import-images conn library-id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -237,9 +218,8 @@
(defn- color-library-exists?
[conn id]
(s/assert ::us/uuid id)
(let [sql "select id from color_library where id = $1"]
(-> (db/query-one conn [sql id])
(p/then (fn [row] (if row true false))))))
(let [row (db/get-by-id conn :color-library id)]
(if row true false)))
(defn- create-colors-library
[conn {:keys [name] :as item}]
@ -253,43 +233,33 @@
(defn- create-colors-library-if-not-exists
[conn {:keys [name] :as item}]
(let [id (uuid/namespaced +colors-uuid-ns+ name)]
(-> (color-library-exists? conn id)
(p/then (fn [exists?]
(when-not exists?
(create-colors-library conn item))))
(p/then (constantly id)))))
(when-not (color-library-exists? conn id)
(create-colors-library conn item))
id))
(defn- create-color
[conn library-id content]
(s/assert ::us/uuid library-id)
(s/assert ::us/color content)
(let [color-id (uuid/namespaced +colors-uuid-ns+ (str library-id content))]
(log/info "Creating color" content color-id)
(-> (colors/create-color conn {:id color-id
:library-id library-id
:name content
:content content})
(p/then' (constantly color-id)))))
(defn- prune-colors
[conn library-id]
(-> (db/query-one conn ["delete from color where library_id=$1" library-id])
(p/then (constantly nil))))
(colors/create-color conn {:id color-id
:library-id library-id
:name content
:content content})
color-id))
(defn- import-colors
[conn library-id {:keys [colors] :as item}]
(us/verify ::import-item-color item)
(p/do!
(prune-colors conn library-id)
(p/run! #(create-color conn library-id %) colors)))
(db/delete! conn :color {:library-id library-id})
(run! #(create-color conn library-id %) colors))
(defn- process-colors-library
[conn {:keys [name id colors] :as item}]
(us/verify ::import-item-color item)
(-> (create-colors-library-if-not-exists conn item)
(p/then #(import-colors conn % item))))
(let [library-id (create-colors-library-if-not-exists conn item)]
(import-colors conn library-id item)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point
@ -328,22 +298,22 @@
(let [images (:images data)
icons (:icons data)
colors (:colors data)]
(p/do!
(p/run! #(process-images-library conn basedir %) images)
(p/run! #(process-icons-library conn basedir %) icons)
(p/run! #(process-colors-library conn %) colors)
nil)))
(run! #(process-images-library conn basedir %) images)
(run! #(process-icons-library conn basedir %) icons)
(run! #(process-colors-library conn %) colors)))
(defn run
[path]
(p/let [[basedir data] (read-file path)]
(let [[basedir data] (read-file path)]
(db/with-atomic [conn db/pool]
(importer conn basedir data))))
(defn -main
[& [path]]
(let [path (validate-path path)]
(start-system)
(-> (run path)
(p/finally (fn [_ _] (stop-system))))))
(try
(start-system)
(run path)
(finally
(stop-system)))))

5
backend/src/uxbox/migrations.clj
View file

@ -37,8 +37,9 @@
(defn migrate
[]
(with-open [ctx (mg/context db/pool)]
@(mg/migrate ctx +migrations+)))
(with-open [conn (db/open)]
(mg/setup! conn)
(mg/migrate! conn +migrations+)))
(defstate migrations
:start (migrate))

17
backend/src/uxbox/redis.clj
View file

@ -10,13 +10,10 @@
[clojure.tools.logging :as log]
[lambdaisland.uri :refer [uri]]
[mount.core :as mount :refer [defstate]]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.config :as cfg]
[uxbox.core :refer [system]]
[uxbox.util.redis :as redis]
[uxbox.util.data :as data]
[vertx.util :as vu])
[uxbox.util.redis :as redis])
(:import
java.lang.AutoCloseable))
@ -33,20 +30,20 @@
:stop (.close ^AutoCloseable client))
(defstate conn
:start @(redis/connect client)
:start (redis/connect client)
:stop (.close ^AutoCloseable conn))
;; --- API FORWARD
(defn subscribe
[topic]
(redis/subscribe client topic))
([topic]
(redis/subscribe client topic))
([topic xf]
(redis/subscribe client topic xf)))
(defn run!
[cmd params]
(let [ctx (vu/get-or-create-context system)]
(-> (redis/run! conn cmd params)
(vu/handle-on-context ctx))))
(redis/run! conn cmd params))
(defn run
[cmd params]

128
backend/src/uxbox/services/mutations/colors.clj
View file

@ -10,15 +10,15 @@
(ns uxbox.services.mutations.colors
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.tasks :as tasks]
[uxbox.services.queries.teams :as teams]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.common.uuid :as uuid]))
[uxbox.services.queries.teams :as teams]
[uxbox.tasks :as tasks]
[uxbox.util.time :as dt]))
;; --- Helpers & Specs
@ -44,15 +44,13 @@
(teams/check-edition-permissions! conn profile-id team-id)
(create-library conn params)))
(def ^:private sql:create-library
"insert into color_library (id, team_id, name)
values ($1, $2, $3)
returning *;")
(defn create-library
[conn {:keys [id team-id name]}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-library id team-id name])))
(db/insert! conn :color-library
{:id id
:team-id team-id
:name name})))
;; --- Mutation: Rename Library
@ -66,7 +64,7 @@
(sm/defmutation ::rename-color-library
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(rename-library conn id name))))
@ -83,42 +81,13 @@
(defn- select-library-for-update
[conn id]
(-> (db/query-one conn [sql:select-library-for-update id])
(p/then' su/raise-not-found-if-nil)))
(db/get-by-id conn :color-library id {:for-update true}))
(defn- rename-library
[conn id name]
(-> (db/query-one conn [sql:rename-library id name])
(p/then' su/constantly-nil)))
;; --- 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 ::library-id ::profile-id]))
;; (sm/defmutation ::copy-color
;; [{:keys [profile-id id library-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 :library-id library-id))]
;; (create-color conn color)))))))
(db/update! conn :color-library
{:name name}
{:id id}))
;; --- Delete Library
@ -131,7 +100,7 @@
(sm/defmutation ::delete-color-library
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
;; Schedule object deletion
@ -139,18 +108,10 @@
:delay cfg/default-deletion-delay
:props {:id id :type :color-library}})
(delete-library conn id))))
(def ^:private sql:mark-library-deleted
"update color_library
set deleted_at = clock_timestamp()
where id = $1")
(defn- delete-library
[conn id]
(-> (db/query-one conn [sql:mark-library-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :color-library
{:deleted-at (dt/now)}
{:id id})
nil)))
;; --- Mutation: Create Color (Upload)
@ -164,7 +125,7 @@
(sm/defmutation ::create-color
[{:keys [profile-id library-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn library-id)]
(let [lib (select-library-for-update conn library-id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(create-color conn params))))
@ -175,14 +136,15 @@
(defn create-color
[conn {:keys [id name library-id content]}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-color id name library-id content])))
(db/insert! conn :color {:id id
:name name
:library-id library-id
:content content})))
;; --- Mutation: Rename Color
(declare select-color-for-update)
(declare rename-color)
(s/def ::rename-color
(s/keys :req-un [::id ::profile-id ::name]))
@ -190,33 +152,26 @@
(sm/defmutation ::rename-color
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [clr (select-color-for-update conn id)]
(let [clr (select-color-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id clr))
(rename-color conn id name))))
(db/update! conn :color
{:name name}
{:id id}))))
(def ^:private sql:select-color-for-update
"select c.*,
lib.team_id as team_id
from color as c
inner join color_library as lib on (lib.id = c.library_id)
where c.id = $1
where c.id = ?
for update of c")
(def ^:private sql:rename-color
"update color
set name = $2
where id = $1")
(defn- select-color-for-update
[conn id]
(-> (db/query-one conn [sql:select-color-for-update id])
(p/then' su/raise-not-found-if-nil)))
(defn- rename-color
[conn id name]
(-> (db/query-one conn [sql:rename-color id name])
(p/then' su/constantly-nil)))
(let [row (db/exec-one! conn [sql:select-color-for-update id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Delete Color
@ -229,7 +184,7 @@
(sm/defmutation ::delete-color
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [clr (select-color-for-update conn id)]
(let [clr (select-color-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id clr))
;; Schedule object deletion
@ -237,14 +192,7 @@
:delay cfg/default-deletion-delay
:props {:id id :type :color}})
(delete-color conn id))))
(def ^:private sql:mark-color-deleted
"update color
set deleted_at = clock_timestamp()
where id = $1")
(defn- delete-color
[conn id]
(-> (db/query-one conn [sql:mark-color-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :color
{:deleted-at (dt/now)}
{:id id})
nil)))

161
backend/src/uxbox/services/mutations/files.clj
View file

@ -10,25 +10,24 @@
(ns uxbox.services.mutations.files
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.pages :as cp]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[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.media :as media]
[uxbox.services.mutations :as sm]
[uxbox.services.mutations.projects :as proj]
[uxbox.services.mutations.images :as imgs]
[uxbox.services.util :as su]
[uxbox.services.mutations.projects :as proj]
[uxbox.services.queries.files :as files]
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
[uxbox.util.time :as dt]))
;; --- Helpers & Specs
@ -49,41 +48,36 @@
(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)))]
(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]))
(db/insert! conn :file-profile-rel
{:profile-id profile-id
:file-id file-id
:is-owner true
:is-admin true
:can-edit true}))
(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])]
(let [id (or id (uuid/next))
file (db/insert! conn :file {:id id :project-id project-id :name 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])))
(let [id (uuid/next)]
(db/insert! conn :page
{:id id
:file-id file-id
:name "Page 1"
:ordering 1
:data (blob/encode cp/default-page-data)})))
;; --- Mutation: Rename File
@ -99,16 +93,11 @@
(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
returning *")
(defn- rename-file
[conn {:keys [id name] :as params}]
(db/query-one conn [sql:rename-file id name]))
(db/update! conn :file
{:name name}
{:id id}))
;; --- Mutation: Delete Project File
@ -133,13 +122,15 @@
(def ^:private sql:mark-file-deleted
"update file
set deleted_at = clock_timestamp()
where id = $1
where id = ?
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)))
(db/update! conn :file
{:deleted-at (dt/now)}
{:id id})
nil)
;; --- Mutation: Upload File Image
@ -169,31 +160,29 @@
(defn- create-file-image
[conn {:keys [content file-id name] :as params}]
(when-not (imgs/valid-image-types? (:mtype content))
(when-not (imgs/valid-image-types? (:content-type 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)))))
(let [image-opts (images/info (:tempfile content))
image-path (imgs/persist-image-on-fs content)
thumb-opts imgs/thumbnail-options
thumb-path (imgs/persist-image-thumbnail-on-fs thumb-opts image-path)]
(-> (db/insert! conn :file-image
{:file-id file-id
:name name
:path (str image-path)
:width (:width image-opts)
:height (:height image-opts)
:mtype (:content-type content)
:thumb-path (str thumb-path)
:thumb-width (:width thumb-opts)
:thumb-height (:height thumb-opts)
:thumb-quality (:quality thumb-opts)
:thumb-mtype (images/format->mtype (:format thumb-opts))})
(images/resolve-urls :path :uri)
(images/resolve-urls :thumb-path :thumb-uri))))
;; --- Mutation: Import from collection
@ -215,28 +204,26 @@
(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)))))
(let [image (db/get-by-id conn :image image-id)
image-path (copy-image (:path image))
thumb-path (copy-image (:thumb-path image))]
(-> (db/insert! conn :file-image
{:file-id file-id
:name (:name image)
:path (str image-path)
:width (:width image)
:height (:height image)
:mtype (:mtype image)
:thumb-path (str thumb-path)
:thumb-width (:thumb-width image)
:thumb-height (:thumb-height image)
:thumb-quality (:thumb-quality image)
:thumb-mtype (:thumb-mtype image)})
(images/resolve-urls :path :uri)
(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))))
(let [image-path (ust/lookup media/media-storage path)]
(ust/save! media/media-storage (fs/name image-path) image-path)))

146
backend/src/uxbox/services/mutations/icons.clj
View file

@ -10,17 +10,17 @@
(ns uxbox.services.mutations.icons
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.services.mutations :as sm]
[uxbox.services.queries.icons :refer [decode-row]]
[uxbox.services.queries.teams :as teams]
[uxbox.services.util :as su]
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]))
[uxbox.util.time :as dt]))
;; --- Helpers & Specs
@ -44,7 +44,6 @@
(s/keys :opt-un [::width ::height ::view-box ::mimetype]))
;; --- Mutation: Create Library
(declare create-library)
@ -67,8 +66,10 @@
(defn create-library
[conn {:keys [team-id id name] :as params}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-library id team-id name])))
(db/insert! conn :icon-library
{:id id
:team-id team-id
:name name})))
;; --- Mutation: Rename Library
@ -82,59 +83,19 @@
(sm/defmutation ::rename-icon-library
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(rename-library conn id name))))
(def ^:private sql:select-library-for-update
"select l.*
from icon_library as l
where l.id = $1
for update")
(def ^:private sql:rename-library
"update icon_library
set name = $2
where id = $1")
(defn- select-library-for-update
[conn id]
(-> (db/query-one conn [sql:select-library-for-update id])
(p/then' su/raise-not-found-if-nil)))
(db/get-by-id conn :icon-library id {:for-update true}))
(defn- rename-library
[conn id name]
(-> (db/query-one conn [sql:rename-library id name])
(p/then' su/constantly-nil)))
;; ;; --- 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 ::library-id ::profile-id]))
;; (sm/defmutation ::copy-icon
;; [{:keys [profile-id id library-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 :library-id library-id))]
;; (create-icon conn icon)))))))
(db/update! conn :icon-library
{:name name}
{:id id}))
;; --- Mutation: Delete Library
@ -146,7 +107,7 @@
(sm/defmutation ::delete-icon-library
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
;; Schedule object deletion
@ -154,19 +115,10 @@
:delay cfg/default-deletion-delay
:props {:id id :type :icon-library}})
(delete-library conn id))))
(def ^:private sql:mark-library-deleted
"update icon_library
set deleted_at = clock_timestamp()
where id = $1
returning id")
(defn- delete-library
[conn id]
(-> (db/query-one conn [sql:mark-library-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :icon-library
{:deleted-at (dt/now)}
{:id id})
nil)))
;; --- Mutation: Create Icon (Upload)
@ -180,21 +132,20 @@
(sm/defmutation ::create-icon
[{:keys [profile-id library-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn library-id)]
(let [lib (select-library-for-update conn library-id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(create-icon conn params))))
(def ^:private sql:create-icon
"insert into icon (id, name, library_id, content, metadata)
values ($1, $2, $3, $4, $5) returning *")
(defn create-icon
[conn {:keys [id name library-id metadata content]}]
(let [id (or id (uuid/next))]
(-> (db/query-one conn [sql:create-icon id name library-id
content (blob/encode metadata)])
(p/then' decode-row))))
(-> (db/insert! conn :icon
{:id id
:name name
:library-id library-id
:content content
:metadata (blob/encode metadata)})
(decode-row))))
;; --- Mutation: Rename Icon
@ -208,33 +159,27 @@
(sm/defmutation ::rename-icon
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [clr (select-icon-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id clr))
(rename-icon conn id name))))
(let [icon (select-icon-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id icon))
(db/update! conn :icon
{:name name}
{:id id}))))
(def ^:private sql:select-icon-for-update
(def ^:private
sql:select-icon-for-update
"select i.*,
lib.team_id as team_id
from icon as i
inner join icon_library as lib on (lib.id = i.library_id)
where i.id = $1
where i.id = ?
for update")
(def ^:private sql:rename-icon
"update icon
set name = $2
where id = $1")
(defn- select-icon-for-update
[conn id]
(-> (db/query-one conn [sql:select-icon-for-update id])
(p/then' su/raise-not-found-if-nil)))
(defn- rename-icon
[conn id name]
(-> (db/query-one conn [sql:rename-icon id name])
(p/then' su/constantly-nil)))
(let [row (db/exec-one! conn [sql:select-icon-for-update id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Mutation: Delete Icon
@ -247,7 +192,7 @@
(sm/defmutation ::delete-icon
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [icn (select-icon-for-update conn id)]
(let [icn (select-icon-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id icn))
;; Schedule object deletion
@ -255,14 +200,7 @@
:delay cfg/default-deletion-delay
:props {:id id :type :icon}})
(delete-icon conn id))))
(def ^:private sql:mark-icon-deleted
"update icon
set deleted_at = clock_timestamp()
where id = $1")
(defn- delete-icon
[conn id]
(-> (db/query-one conn [sql:mark-icon-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :icon
{:deleted-at (dt/now)}
{:id id})
nil)))

209
backend/src/uxbox/services/mutations/images.clj
View file

@ -21,10 +21,9 @@
[uxbox.tasks :as tasks]
[uxbox.services.queries.teams :as teams]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.common.uuid :as uuid]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
[uxbox.util.time :as dt]))
(def thumbnail-options
{:width 800
@ -53,21 +52,18 @@
(teams/check-edition-permissions! conn profile-id team-id)
(create-library conn params)))
(def ^:private sql:create-library
"insert into image_library (id, team_id, name)
values ($1, $2, $3)
returning *;")
(defn create-library
[conn {:keys [id team-id name]}]
(let [id (or id (uuid/next))]
(db/query-one conn [sql:create-library id team-id name])))
(db/insert! conn :image-library
{:id id
:team-id team-id
:name name})))
;; --- Rename Library
(declare select-library-for-update)
(declare rename-library)
(s/def ::rename-image-library
(s/keys :req-un [::id ::profile-id ::name]))
@ -75,31 +71,15 @@
(sm/defmutation ::rename-image-library
[{:keys [profile-id id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(rename-library conn id name))))
(def ^:private sql:select-library-for-update
"select l.*
from image_library as l
where l.id = $1
for update")
(def ^:private sql:rename-library
"update image_library
set name = $2
where id = $1")
(db/update! conn :image-library
{:name name}
{:id id}))))
(defn- select-library-for-update
[conn id]
(-> (db/query-one conn [sql:select-library-for-update id])
(p/then' su/raise-not-found-if-nil)))
(defn- rename-library
[conn id name]
(-> (db/query-one conn [sql:rename-library id name])
(p/then' su/constantly-nil)))
(db/get-by-id conn :image-library id {:for-update true}))
;; --- Delete Library
@ -112,7 +92,7 @@
(sm/defmutation ::delete-image-library
[{:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn id)]
(let [lib (select-library-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
;; Schedule object deletion
@ -120,17 +100,10 @@
:delay cfg/default-deletion-delay
:props {:id id :type :image-library}})
(delete-library conn id))))
(def ^:private sql:mark-library-deleted
"update image_library
set deleted_at = clock_timestamp()
where id = $1")
(defn- delete-library
[conn id]
(-> (db/query-one conn [sql:mark-library-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :image-library
{:deleted-at (dt/now)}
{:id id})
nil)))
@ -143,16 +116,16 @@
(def valid-image-types?
#{"image/jpeg", "image/png", "image/webp"})
(s/def :uxbox$upload/name ::us/string)
(s/def :uxbox$upload/filename ::us/string)
(s/def :uxbox$upload/size ::us/integer)
(s/def :uxbox$upload/mtype valid-image-types?)
(s/def :uxbox$upload/path ::us/string)
(s/def :uxbox$upload/content-type valid-image-types?)
(s/def :uxbox$upload/tempfile any?)
(s/def ::upload
(s/keys :req-un [:uxbox$upload/name
(s/keys :req-un [:uxbox$upload/filename
:uxbox$upload/size
:uxbox$upload/path
:uxbox$upload/mtype]))
:uxbox$upload/tempfile
:uxbox$upload/content-type]))
(s/def ::content ::upload)
@ -163,69 +136,54 @@
(sm/defmutation ::upload-image
[{:keys [library-id profile-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (select-library-for-update conn library-id)]
(let [lib (select-library-for-update conn library-id)]
(teams/check-edition-permissions! conn profile-id (:team-id lib))
(create-image conn params))))
(def ^:private sql:insert-image
"insert into image
(id, library_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-image
[conn {:keys [id content library-id name]}]
(when-not (valid-image-types? (:mtype content))
(when-not (valid-image-types? (:content-type 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 (persist-image-on-fs content)
thumb-opts thumbnail-options
thumb-path (persist-image-thumbnail-on-fs thumb-opts image-path)
id (or id (uuid/next))
sqlv [sql:insert-image
id
library-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 conn sqlv)
(p/then' #(images/resolve-urls % :path :uri))
(p/then' #(images/resolve-urls % :thumb-path :thumb-uri)))))
(let [image-opts (images/info (:tempfile content))
image-path (persist-image-on-fs content)
thumb-opts thumbnail-options
thumb-path (persist-image-thumbnail-on-fs thumb-opts image-path)]
(-> (db/insert! conn :image
{:id (or id (uuid/next))
:library-id library-id
:name name
:path (str image-path)
:width (:width image-opts)
:height (:height image-opts)
:mtype (:content-type content)
:thumb-path (str thumb-path)
:thumb-width (:width thumb-opts)
:thumb-height (:height thumb-opts)
:thumb-quality (:quality thumb-opts)
:thumb-mtype (images/format->mtype (:format thumb-opts))})
(images/resolve-urls :path :uri)
(images/resolve-urls :thumb-path :thumb-uri))))
(defn persist-image-on-fs
[{:keys [name path]}]
(vu/blocking
(let [filename (fs/name name)]
(ust/save! media/media-storage filename path))))
[{:keys [filename tempfile]}]
(let [filename (fs/name filename)]
(ust/save! media/media-storage filename tempfile)))
(defn persist-image-thumbnail-on-fs
[thumb-opts input-path]
(vu/blocking
(let [input-path (ust/lookup media/media-storage input-path)
thumb-data (images/generate-thumbnail input-path thumb-opts)
[filename _] (fs/split-ext (fs/name input-path))
thumb-name (->> (images/format->extension (:format thumb-opts))
(let [input-path (ust/lookup media/media-storage input-path)
thumb-data (images/generate-thumbnail input-path thumb-opts)
[filename _] (fs/split-ext (fs/name input-path))
thumb-name (->> (images/format->extension (:format thumb-opts))
(str "thumbnail-" filename))]
(ust/save! media/media-storage thumb-name thumb-data))))
(ust/save! media/media-storage thumb-name thumb-data)))
;; --- Mutation: Rename Image
(declare select-image-for-update)
(declare rename-image)
(s/def ::rename-image
(s/keys :req-un [::id ::profile-id ::name]))
@ -233,70 +191,38 @@
(sm/defmutation ::rename-image
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(p/let [img (select-image-for-update conn id)]
(let [img (select-image-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id img))
(rename-image conn id name))))
(db/update! conn :image
{:name name}
{:id id}))))
(def ^:private sql:select-image-for-update
"select img.*,
lib.team_id as team_id
from image as img
inner join image_library as lib on (lib.id = img.library_id)
where img.id = $1
where img.id = ?
for update of img")
(def ^:private sql:rename-image
"update image
set name = $2
where id = $1")
(defn- select-image-for-update
[conn id]
(-> (db/query-one conn [sql:select-image-for-update id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:select-image-for-update id])]
(when-not row
(ex/raise :type :not-found))
row))
(defn- rename-image
[conn id name]
(-> (db/query-one conn [sql:rename-image id name])
(p/then' su/constantly-nil)))
;; --- Copy Image
;; (declare retrieve-image)
;; (s/def ::copy-image
;; (s/keys :req-un [::id ::library-id ::profile-id]))
;; (sm/defmutation ::copy-image
;; [{:keys [profile-id id library-id] :as params}]
;; (letfn [(copy-image [conn {:keys [path] :as image}]
;; (-> (ds/lookup media/images-storage (:path image))
;; (p/then (fn [path] (ds/save media/images-storage (fs/name path) path)))
;; (p/then (fn [path]
;; (-> image
;; (assoc :path (str path) :library-id library-id)
;; (dissoc :id))))
;; (p/then (partial store-image-in-db conn))))]
;; (db/with-atomic [conn db/pool]
;; (-> (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
(declare delete-image)
(s/def ::delete-image
(s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-image
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [img (select-image-for-update conn id)]
(let [img (select-image-for-update conn id)]
(teams/check-edition-permissions! conn profile-id (:team-id img))
;; Schedule object deletion
@ -304,14 +230,7 @@
:delay cfg/default-deletion-delay
:props {:id id :type :image}})
(delete-image conn id))))
(def ^:private sql:mark-image-deleted
"update image
set deleted_at = clock_timestamp()
where id = $1")
(defn- delete-image
[conn id]
(-> (db/query-one conn [sql:mark-image-deleted id])
(p/then' su/constantly-nil)))
(db/update! conn :image
{:deleted-at (dt/now)}
{:id id})
nil)))

179
backend/src/uxbox/services/mutations/pages.clj
View file

@ -10,22 +10,19 @@
(ns uxbox.services.mutations.pages
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.data :as d]
[uxbox.common.pages :as cp]
[uxbox.common.exceptions :as ex]
[uxbox.common.pages :as cp]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.services.queries.files :as files]
[uxbox.services.mutations :as sm]
[uxbox.services.queries.files :as files]
[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.common.uuid :as uuid]
[vertx.eventbus :as ve]))
[uxbox.util.time :as dt]))
;; --- Helpers & Specs
@ -51,20 +48,17 @@
(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))))
(-> (db/insert! conn :page
{:id id
:file-id file-id
:name name
:ordering ordering
:data data})
(decode-row))))
;; --- Mutation: Rename Page
@ -78,33 +72,19 @@
(sm/defmutation ::rename-page
[{:keys [id name profile-id]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(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")
(db/get-by-id conn :page id {:for-update true}))
(defn- rename-page
[conn {:keys [id name] :as params}]
(-> (db/query-one conn [sql:rename-page id name])
(p/then su/constantly-nil)))
(db/update! conn :page
{:name name}
{:id id}))
;; --- Mutation: Sort Pages
@ -118,20 +98,16 @@
(sm/defmutation ::reorder-pages
[{:keys [profile-id file-id page-ids]}]
(db/with-atomic [conn db/pool]
(p/run! #(update-page-ordering conn file-id %)
(d/enumerate page-ids))
(run! #(update-page-ordering conn file-id %)
(d/enumerate page-ids))
nil))
(def ^:private sql:update-page-ordering
"update page
set ordering = $1
where id = $2 and file_id = $3")
(defn- update-page-ordering
[conn file-id [ordering page-id]]
(-> (db/query-one conn [sql:update-page-ordering ordering page-id file-id])
(p/then su/constantly-nil)))
(db/update! conn :page
{:ordering ordering}
{:file-id file-id
:id page-id}))
;; --- Mutation: Generate Share Token
@ -146,16 +122,9 @@
(let [token (-> (sodi.prng/random-bytes 16)
(sodi.util/bytes->b64s))]
(db/with-atomic [conn db/pool]
(assign-page-share-token conn id token))))
(def ^:private sql:update-page-share-token
"update page set share_token = $2 where id = $1")
(defn- assign-page-share-token
[conn id token]
(-> (db/query-one conn [sql:update-page-share-token id token])
(p/then (fn [_] {:id id :share-token token}))))
(db/update! conn :page
{:share-token token}
{:id id}))))
;; --- Mutation: Clear Share Token
@ -166,7 +135,9 @@
(sm/defmutation ::clear-page-share-token
[{:keys [id] :as params}]
(db/with-atomic [conn db/pool]
(assign-page-share-token conn id nil)))
(db/update! conn :page
{:share-token nil}
{:id id})))
@ -183,13 +154,12 @@
(declare update-page)
(declare retrieve-lagged-changes)
(declare update-page-data)
(declare insert-page-change)
(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)]
(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))))
@ -211,61 +181,52 @@
page (assoc page
:data data
:revn (inc (:revn page))
:changes (blob/encode changes))]
: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))))))))
chng (insert-page-change! conn page)]
(def ^:private sql:update-page-data
"update page
set revn = $1,
data = $2
where id = $3")
(db/update! conn :page
{:revn (:revn page)
:data data}
{:id (:id page)})
(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)))
(retrieve-lagged-changes conn chng params)))
(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")
;; (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})
(defn- insert-page-change
(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])))
(db/insert! conn :page-change
{:id id
:page-id page-id
:revn revn
:data data
:changes changes})))
(def ^:private sql:lagged-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
where s.page_id = ?
and s.revn > ?
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)}))))
(let [rows (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])]
{:page-id (:id params)
:revn (:revn snapshot)
:changes (into [] (comp (map decode-row)
(map :changes)
(mapcat identity))
rows)}))
;; --- Mutation: Delete Page
@ -277,7 +238,7 @@
(sm/defmutation ::delete-page
[{:keys [id profile-id]}]
(db/with-atomic [conn db/pool]
(p/let [page (select-page-for-update conn id)]
(let [page (select-page-for-update conn id)]
(files/check-edition-permissions! conn profile-id (:file-id page))
;; Schedule object deletion
@ -285,15 +246,7 @@
: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)))
(db/update! conn :page
{:deleted-at (dt/now)}
{:id id})
nil)))

236
backend/src/uxbox/services/mutations/profile.clj
View file

@ -19,23 +19,21 @@
[sodi.util]
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.emails :as emails]
[uxbox.images :as images]
[uxbox.tasks :as tasks]
[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.mutations.teams :as mt.teams]
[uxbox.services.queries.profile :as profile]
[uxbox.services.util :as su]
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[uxbox.util.time :as tm]
[vertx.util :as vu]))
[uxbox.util.time :as dt]))
;; --- Helpers & Specs
@ -75,22 +73,15 @@
: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))]
(let [prof (-> (retrieve-profile-by-email conn email)
(check-profile)
(profile/strip-private-attrs))
addt (profile/retrieve-additional-data conn (:id prof))]
(merge prof addt)))))
(def sql:profile-by-email
"select u.*
from profile as u
where u.email=$1
and u.deleted_at is null")
(defn- retrieve-profile-by-email
[conn email]
(-> (db/query-one conn [sql:profile-by-email email])
(p/then #(images/resolve-media-uris % [:photo :photo-uri]))))
(db/get-by-params conn :profile {:email email} {:for-update true}))
;; --- Mutation: Update Profile (own)
@ -106,10 +97,11 @@
(defn- update-profile
[conn {:keys [id fullname lang theme] :as params}]
(let [sqlv [sql:update-profile id fullname lang theme]]
(-> (db/query-one conn sqlv)
(p/then' su/raise-not-found-if-nil)
(p/then' profile/strip-private-attrs))))
(db/update! conn :profile
{:fullname fullname
:lang lang
:theme theme}
{:id id}))
(s/def ::update-profile
(s/keys :req-un [::id ::fullname ::lang ::theme]))
@ -117,39 +109,31 @@
(sm/defmutation ::update-profile
[params]
(db/with-atomic [conn db/pool]
(update-profile conn params)))
(update-profile conn params)
nil))
;; --- Mutation: Update Password
(defn- validate-password!
[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))]
(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 [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 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 [::profile-id ::password ::old-password]))
(sm/defmutation ::update-profile-password
[params]
[{:keys [password profile-id] :as params}]
(db/with-atomic [conn db/pool]
(validate-password! conn params)
(update-password conn params)))
(db/update! conn :profile
{:password (sodi.pwhash/derive password)}
{:id profile-id})
nil))
@ -165,8 +149,8 @@
(sm/defmutation ::update-profile-photo
[{:keys [profile-id file] :as params}]
(db/with-atomic [conn db/pool]
(p/let [profile (profile/retrieve-profile conn profile-id)
photo (upload-photo conn params)]
(let [profile (profile/retrieve-profile conn profile-id)
photo (upload-photo conn params)]
;; Schedule deletion of old photo
(when (and (string? (:photo profile))
@ -178,20 +162,20 @@
(defn- upload-photo
[conn {:keys [file profile-id]}]
(when-not (imgs/valid-image-types? (:mtype file))
(when-not (imgs/valid-image-types? (:content-type file))
(ex/raise :type :validation
:code :image-type-not-allowed
:hint "Seems like you are uploading an invalid image."))
(vu/blocking
(let [thumb-opts {:width 256
:height 256
:quality 75
:format "webp"}
prefix (-> (sodi.prng/random-bytes 8)
(sodi.util/bytes->b64s))
name (str prefix ".webp")
photo (images/generate-thumbnail2 (fs/path (:path file)) thumb-opts)]
(ust/save! media/media-storage name photo))))
(let [thumb-opts {:width 256
:height 256
:quality 75
:format "webp"}
prefix (-> (sodi.prng/random-bytes 8)
(sodi.util/bytes->b64s))
name (str prefix ".webp")
path (fs/path (:tempfile file))
photo (images/generate-thumbnail2 path thumb-opts)]
(ust/save! media/media-storage name photo)))
(defn- update-profile-photo
[conn profile-id path]
@ -199,9 +183,10 @@
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))))
(db/update! conn :profile
{:photo (str path)}
{:id profile-id})
nil))
;; --- Mutation: Register Profile
@ -213,7 +198,8 @@
(s/keys :req-un [::email ::password ::fullname]))
(defn email-domain-in-whitelist?
"Returns true if email's domain is in the given whitelist or if given whitelist is an empty string."
"Returns true if email's domain is in the given whitelist or if given
whitelist is an empty string."
[whitelist email]
(if (str/blank? whitelist)
true
@ -226,20 +212,18 @@
(when-not (:registration-enabled cfg/config)
(ex/raise :type :restriction
:code :registration-disabled))
(when-not (email-domain-in-whitelist? (:registration-domain-whitelist cfg/config) (:email params))
(when-not (email-domain-in-whitelist? (:registration-domain-whitelist cfg/config)
(:email params))
(ex/raise :type :validation
:code ::email-domain-is-not-allowed))
(db/with-atomic [conn db/pool]
(check-profile-existence! 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)))))))
(let [profile (register-profile conn params)]
;; TODO: send a correct link for email verification
(let [data {:to (:email params)
:name (:fullname params)}]
(emails/send! conn emails/register data)
profile))))
(def ^:private sql:insert-profile
"insert into profile (id, fullname, email, password, photo, is_demo)
@ -256,12 +240,11 @@
(defn- check-profile-existence!
[conn {:keys [email] :as params}]
(-> (db/query-one conn [sql:profile-existence email])
(p/then' (fn [result]
(when (:val result)
(ex/raise :type :validation
:code ::email-already-exists))
params))))
(let [result (db/exec-one! conn [sql:profile-existence email])]
(when (:val result)
(ex/raise :type :validation
:code ::email-already-exists))
params))
(defn- create-profile
"Create the profile entry on the database with limited input
@ -270,33 +253,42 @@
(let [id (or id (uuid/next))
demo? (if (boolean? demo?) demo? false)
password (sodi.pwhash/derive password)]
(db/query-one conn [sql:insert-profile id fullname email password demo?])))
(db/insert! conn :profile
{:id id
:fullname fullname
:email email
:photo ""
:password password
:is-demo 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)))
(db/insert! conn :profile-email
{:profile-id id
:email email
:is-main true}))
(defn register-profile
[conn params]
(p/let [prof (create-profile conn params)
_ (create-profile-email conn prof)
(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)})
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)})]
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})))
{:default-team (:id team)
:default-project (:id proj)})))
;; --- Mutation: Request Profile Recovery
@ -312,20 +304,21 @@
(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 profile :token token))))))
(db/insert! conn :password-recovery-token
{:profile-id id
:token token})
(assoc profile :token token)))
(send-email-notification [conn profile]
(emails/send! conn
emails/password-recovery
(emails/send! conn emails/password-recovery
{:to (:email profile)
:token (:token profile)
:name (:fullname profile)}))]
:name (:fullname profile)})
nil)]
(db/with-atomic [conn db/pool]
(-> (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 %))
(p/then (constantly nil))))))
(let [profile (->> (retrieve-profile-by-email conn email)
(create-recovery-token conn))]
(send-email-notification conn profile)))))
;; --- Mutation: Recover Profile
@ -343,18 +336,17 @@
where token=$1 returning *"
sql "select * from password_recovery_token
where token=$1"]
(-> (db/query-one conn [sql token])
(p/then' :profile-id)
(p/then' su/raise-not-found-if-nil))))
(-> {:token token}
(db/get-by-params conn :password-recovery-token)
(:profile-id))))
(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 profile-id pwd])
(p/then' (constantly nil)))))]
(db/update! conn :profile {:password pwd} {:id profile-id})
nil))]
(db/with-atomic [conn db/pool]
(-> (validate-token conn token)
(p/then (fn [profile-id] (update-password conn profile-id)))))))
(update-password conn)))))
;; --- Mutation: Delete Profile
@ -372,16 +364,19 @@
;; Schedule a complete deletion of profile
(tasks/schedule! conn {:name "delete-profile"
:delay (tm/duration {:hours 48})
:delay (dt/duration {:hours 48})
:props {:profile-id profile-id}})
(mark-profile-as-deleted! conn profile-id)))
(db/update! conn :profile
{:deleted-at (dt/now)}
{:id profile-id})
nil))
(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
where tpr.profile_id = ?
and tpr.is_owner is true
)
select tpr.team_id,
@ -393,18 +388,9 @@
(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)))
(let [rows (db/exec! conn [sql:teams-ownership-check profile-id])]
(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)}))))

94
backend/src/uxbox/services/mutations/projects.clj
View file

@ -10,16 +10,14 @@
(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.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.db :as db]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]))
[uxbox.tasks :as tasks]
[uxbox.util.blob :as blob]))
;; --- Helpers & Specs
@ -35,28 +33,28 @@
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
where p.id = ?
and tpr.profile_id = ?
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")
where ppr.project_id = ?
and ppr.profile_id = ?")
(defn check-edition-permissions!
[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 [rows]
(when-not (or (some :can-edit rows)
(some :is-admin rows)
(some :is-owner rows))
(ex/raise :type :validation
:code :not-authorized))))))
(let [rows (db/exec! conn [sql:project-permissions
project-id profile-id
project-id profile-id])]
(when (empty? rows)
(ex/raise :type :not-found))
(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
@ -72,30 +70,28 @@
(sm/defmutation ::create-project
[params]
(db/with-atomic [conn db/pool]
(p/let [proj (create-project conn params)]
(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 profile-id team-id name default?] :as params}]
(let [id (or id (uuid/next))
default? (if (boolean? default?) default? false)]
(db/query-one conn [sql:insert-project id team-id name default?])))
(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 *")
(db/insert! conn :project
{:id id
:team-id team-id
:name name
:is-default default?})))
(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)))
(db/insert! conn :project-profile-rel
{:project-id project-id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true}))
@ -107,23 +103,13 @@
(s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-project
[{:keys [id profile-id] :as params}]
[{:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool]
(check-edition-permissions! conn profile-id id)
(rename-project conn params)))
(def ^:private sql:rename-project
"update project
set name = $2
where id = $1
and deleted_at is null
returning *")
(defn rename-project
[conn {:keys [id name] :as params}]
(db/query-one conn [sql:rename-project id name]))
(let [project (db/get-by-id conn :project id {:for-update true})]
(check-edition-permissions! conn profile-id id)
(db/update! conn :project
{:name name}
{:id id}))))
;; --- Mutation: Delete Project
@ -147,10 +133,10 @@
(def ^:private sql:mark-project-deleted
"update project
set deleted_at = clock_timestamp()
where id = $1
where id = ?
returning id")
(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)))
(db/exec! conn [sql:mark-project-deleted id])
nil)

56
backend/src/uxbox/services/mutations/teams.clj
View file

@ -10,14 +10,12 @@
(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.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]))
[uxbox.util.blob :as blob]))
;; --- Helpers & Specs
@ -37,32 +35,28 @@
(sm/defmutation ::create-team
[params]
(db/with-atomic [conn db/pool]
(p/let [team (create-team conn params)]
(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 *")
(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
[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?])))
(db/insert! conn :team
{:id id
:name name
:photo ""
:is-default default?})))
(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)))
(db/insert! conn :team-profile-rel
{:team-id team-id
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true}))
;; --- Mutation: Team Edition Permissions
@ -71,18 +65,14 @@
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
where tpr.profile_id = $1
and tpr.team_id = $2")
where tpr.profile_id = ?
and tpr.team_id = ?")
(defn check-edition-permissions!
[conn profile-id team-id]
(-> (db/query-one conn [sql:team-permissions profile-id team-id])
(p/then' (fn [row]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row))
(ex/raise :type :validation
:code :not-authorized))))))
(let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row))
(ex/raise :type :validation
:code :not-authorized))))

48
backend/src/uxbox/services/mutations/user_attrs.clj
View file

@ -1,48 +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.user-attrs
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.db :as db]
[uxbox.common.spec :as us]
[uxbox.services.mutations :as sm]
[uxbox.services.util :as su]
[uxbox.services.queries.user-attrs :refer [decode-row]]
[uxbox.util.blob :as blob]))
;; --- Update
(s/def ::user ::us/uuid)
(s/def ::key ::us/string)
(s/def ::val any?)
(s/def ::upsert-user-attr
(s/keys :req-un [::key ::val ::user]))
(sm/defmutation ::upsert-user-attr
[{:keys [key val user] :as params}]
(let [sql "insert into user_attrs (key, val, user_id)
values ($1, $2, $3)
on conflict (user_id, key)
do update set val = $2"
val (blob/encode val)]
(-> (db/query-one db/pool [sql key val user])
(p/then' su/constantly-nil))))
;; --- Delete KVStore
(s/def ::delete-user-attr
(s/keys :req-un [::key ::user]))
(sm/defmutation ::delete-user-attr
[{:keys [user key] :as params}]
(let [sql "delete from user_attrs
where user_id = $2
and key = $1"]
(-> (db/query-one db/pool [sql key user])
(p/then' su/constantly-nil))))

155
backend/src/uxbox/services/notifications.clj
View file

@ -7,14 +7,29 @@
(ns uxbox.services.notifications
"A websocket based notifications mechanism."
(:require
[clojure.tools.logging :as log]
[clojure.core.async :as a :refer [>! <!]]
[clojure.tools.logging :as log]
[promesa.core :as p]
[ring.adapter.jetty9 :as jetty]
[uxbox.common.exceptions :as ex]
[uxbox.util.transit :as t]
[uxbox.redis :as redis]
[uxbox.common.uuid :as uuid]
[vertx.util :as vu :refer [<?]]))
[uxbox.redis :as redis]
[ring.util.codec :as codec]
[uxbox.util.transit :as t]))
(defmacro go-try
[& body]
`(a/go
(try
~@body
(catch Throwable e# e#))))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Throwable r#)
(throw r#)
r#)))
(defn- decode-message
[message]
@ -30,14 +45,14 @@
(defn- publish
[channel message]
(vu/go-try
(go-try
(let [message (encode-message message)]
(<? (redis/run :publish {:channel (str channel)
:message message})))))
(defn- retrieve-presence
[key]
(vu/go-try
(go-try
(let [data (<? (redis/run :hgetall {:key key}))]
(into [] (map (fn [[k v]] [(uuid/uuid k) (uuid/uuid v)])) data))))
@ -46,7 +61,7 @@
(let [key (str file-id)
field (str session-id)
value (str profile-id)]
(vu/go-try
(go-try
(<? (redis/run :hset {:key key :field field :value value}))
(<? (retrieve-presence key)))))
@ -54,7 +69,7 @@
[file-id session-id profile-id]
(let [key (str file-id)
field (str session-id)]
(vu/go-try
(go-try
(<? (redis/run :hdel {:key key :field field}))
(<? (retrieve-presence key)))))
@ -69,14 +84,14 @@
(defmethod handle-message :connect
[{:keys [file-id profile-id session-id output] :as ws} message]
(log/info (str "profile " profile-id " is connected to " file-id))
(vu/go-try
(go-try
(let [members (<? (join-room file-id session-id profile-id))]
(<? (publish file-id {:type :presence :sessions members})))))
(defmethod handle-message :disconnect
[{:keys [profile-id file-id session-id] :as ws} message]
(log/info (str "profile " profile-id " is disconnected from " file-id))
(vu/go-try
(go-try
(let [members (<? (leave-room file-id session-id profile-id))]
(<? (publish file-id {:type :presence :sessions members})))))
@ -87,7 +102,7 @@
(defmethod handle-message :pointer-update
[{:keys [profile-id file-id session-id] :as ws} message]
(vu/go-try
(go-try
(let [message (assoc message
:profile-id profile-id
:session-id session-id)]
@ -97,43 +112,31 @@
;; WebSocket Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- process-message
[ws message]
(vu/go-try
(let [message (decode-message message)]
(<? (handle-message ws message)))))
(defn- forward-message
[{:keys [output session-id profile-id] :as ws} message]
(vu/go-try
(let [message' (decode-message message)]
(when-not (= (:session-id message') session-id)
(>! output message)))))
(defn- close-all!
[{:keys [sch] :as ws}]
(a/close! sch)
(.close ^java.lang.AutoCloseable ws))
[{:keys [out session-id profile-id] :as ws} message]
(go-try
(when-not (= (:session-id message) session-id)
(>! out message))))
(defn start-loop!
[{:keys [input output sch on-error] :as ws}]
(vu/go-try
[{:keys [in out sub] :as ws}]
(go-try
(loop []
(let [timeout (a/timeout 30000)
[val port] (a/alts! [input sch timeout])]
;; (prn "alts" val "from" (cond (= port input) "input"
;; (= port sch) "redis"
[val port] (a/alts! [in sub timeout])]
;; (prn "alts" val "from" (cond (= port in) "input"
;; (= port sub) "redis"
;; :else "timeout"))
(cond
;; Process message coming from connected client
(and (= port input) (not (nil? val)))
(and (= port in) (not (nil? val)))
(do
(<? (process-message ws val))
(<? (handle-message ws val))
(recur))
;; Forward message to the websocket
(and (= port sch) (not (nil? val)))
(and (= port sub) (not (nil? val)))
(do
(<? (forward-message ws val))
(recur))
@ -141,36 +144,68 @@
;; Timeout channel signaling
(= port timeout)
(do
(>! output (encode-message {:type :ping}))
(>! out {:type :ping})
(recur))
:else
nil)))))
(defn disconnect!
[conn]
(.. conn (getSession) (disconnect)))
(defn- on-subscribed
[{:keys [on-error] :as ws} sch]
(let [ws (assoc ws :sch sch)]
(a/go
(try
(<? (handle-message ws {:type :connect}))
(<? (start-loop! ws))
(<? (handle-message ws {:type :disconnect}))
(close-all! ws)
(catch Throwable e
(on-error e)
(close-all! ws))))))
[{:keys [conn] :as ws}]
(a/go
(try
(<? (handle-message ws {:type :connect}))
(<? (start-loop! ws))
(<? (handle-message ws {:type :disconnect}))
(catch Throwable err
(log/error "Unexpected exception on websocket handler:\n"
(with-out-str
(.printStackTrace err (java.io.PrintWriter. *out*))))
(disconnect! conn)))))
(defrecord WebSocket [conn in out sub])
(defn- start-rcv-loop!
[{:keys [conn out] :as ws}]
(a/go-loop []
(let [val (a/<! out)]
(when-not (nil? val)
(jetty/send! conn (encode-message val))
(recur)))))
(defn websocket
[req {:keys [input on-error] :as ws}]
(let [fid (uuid/uuid (get-in req [:path-params :file-id]))
sid (uuid/uuid (get-in req [:path-params :session-id]))
pid (:profile-id req)
ws (assoc ws
:profile-id pid
:file-id fid
:session-id sid)]
(-> (redis/subscribe (str fid))
(p/finally (fn [sch error]
(if error
(on-error error)
(on-subscribed ws sch)))))))
[{:keys [file-id] :as params}]
(let [in (a/chan 32)
out (a/chan 32)]
{:on-connect (fn [conn]
(let [xf (map decode-message)
sub (redis/subscribe (str file-id) xf)
ws (WebSocket. conn in out sub nil params)]
(start-rcv-loop! ws)
(a/go
(a/<! (on-subscribed ws))
(a/close! sub))))
:on-error (fn [conn e]
;; (prn "websocket" :on-error e)
(a/close! out)
(a/close! in))
:on-close (fn [conn status-code reason]
;; (prn "websocket" :on-close status-code reason)
(a/close! out)
(a/close! in))
:on-text (fn [ws message]
(let [message (decode-message message)]
;; (prn "websocket" :on-text message)
(a/>!! in message)))
:on-bytes (fn [ws bytes offset len]
#_(prn "websocket" :on-bytes bytes))}))

52
backend/src/uxbox/services/queries/colors.clj
View file

@ -14,16 +14,14 @@
[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.teams :as teams]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.common.uuid :as uuid]
[vertx.core :as vc]))
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.media :as media]
[uxbox.services.queries :as sq]
[uxbox.services.queries.teams :as teams]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]))
;; --- Helpers & Specs
@ -32,15 +30,13 @@
(s/def ::team-id ::us/uuid)
(s/def ::library-id (s/nilable ::us/uuid))
;; --- Query: Colors Librarys
(def ^:private sql:libraries
"select lib.*,
(select count(*) from color where library_id = lib.id) as num_colors
from color_library as lib
where lib.team_id = $1
where lib.team_id = ?
and lib.deleted_at is null
order by lib.created_at desc")
@ -51,8 +47,7 @@
[{:keys [profile-id team-id]}]
(db/with-atomic [conn db/pool]
(teams/check-read-permissions! conn profile-id team-id)
(db/query conn [sql:libraries team-id])))
(db/exec! conn [sql:libraries team-id])))
;; --- Query: Color Library
@ -65,7 +60,7 @@
(sq/defquery ::color-library
[{:keys [profile-id id]}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn id)]
(let [lib (retrieve-library conn id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
lib)))
@ -74,14 +69,14 @@
(select count(*) from color where library_id = lib.id) as num_colors
from color_library as lib
where lib.deleted_at is null
and lib.id = $1")
and lib.id = ?")
(defn- retrieve-library
[conn id]
(-> (db/query-one conn [sql:single-library id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-library id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Query: Colors (by library)
@ -93,7 +88,7 @@
(sq/defquery ::colors
[{:keys [profile-id library-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn library-id)]
(let [lib (retrieve-library conn library-id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
(retrieve-colors conn library-id))))
@ -102,13 +97,12 @@
from color as color
inner join color_library as lib on (lib.id = color.library_id)
where color.deleted_at is null
and color.library_id = $1
and color.library_id = ?
order by created_at desc")
(defn- retrieve-colors
[conn library-id]
(db/query conn [sql:colors library-id]))
(db/exec! conn [sql:colors library-id]))
;; --- Query: Color (by ID)
@ -122,7 +116,7 @@
(sq/defquery ::color
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [color (retrieve-color conn id)]
(let [color (retrieve-color conn id)]
(teams/check-read-permissions! conn profile-id (:team-id color))
color)))
@ -132,10 +126,12 @@
from color as color
inner join color_library as lib on (lib.id = color.library_id)
where color.deleted_at is null
and color.id = $1
and color.id = ?
order by created_at desc")
(defn retrieve-color
[conn id]
(-> (db/query-one conn [sql:single-color id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-color id])]
(when-not row
(ex/raise :type :not-found))
row))

88
backend/src/uxbox/services/queries/files.clj
View file

@ -16,7 +16,6 @@
[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)
@ -38,8 +37,8 @@
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 p.team_id = $2
where tpr.profile_id = ?
and p.team_id = ?
and p.deleted_at is null
and (tpr.is_admin = true or
tpr.is_owner = true or
@ -48,8 +47,8 @@
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 p.team_id = $2
where ppr.profile_id = ?
and p.team_id = ?
and p.deleted_at is null
and (ppr.is_admin = true or
ppr.is_owner = true or
@ -62,7 +61,7 @@
from file
inner join projects as pr on (file.project_id = pr.id)
left join page on (file.id = page.file_id)
where file.name ilike ('%' || $3 || '%')
where file.name ilike ('%' || ? || '%')
window pages_w as (partition by file.id order by page.created_at
range between unbounded preceding
and unbounded following)
@ -73,8 +72,12 @@
(sq/defquery ::search-files
[{:keys [profile-id team-id search-term] :as params}]
(-> (db/query db/pool [sql:search-files profile-id team-id search-term])
(p/then (partial mapv decode-row))))
(let [rows (db/exec! db/pool [sql:search-files
profile-id team-id
profile-id team-id
search-term])]
(mapv decode-row rows)))
;; --- Query: Draft Files
@ -86,8 +89,8 @@
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
where fp_r.profile_id = ?
and f.project_id = ?
and f.deleted_at is null
and pg.deleted_at is null
and (fp_r.is_admin = true or
@ -104,8 +107,8 @@
(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))))
(->> (db/exec! db/pool [sql:files profile-id project-id])
(mapv decode-row)))
;; --- Query: File Permissions
@ -114,8 +117,8 @@
fpr.is_admin,
fpr.can_edit
from file_profile_rel as fpr
where fpr.file_id = $1
and fpr.profile_id = $2
where fpr.file_id = ?
and fpr.profile_id = ?
union all
select tpr.is_owner,
tpr.is_admin,
@ -123,28 +126,31 @@
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
where f.id = ?
and tpr.profile_id = ?
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;")
where f.id = ?
and ppr.profile_id = ?;")
(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))))))
(let [rows (db/exec! conn [sql:file-permissions
file-id profile-id
file-id profile-id
file-id profile-id])]
(when (empty? rows)
(ex/raise :type :not-found))
(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
@ -162,15 +168,15 @@
(def ^:private sql:file-images
"select fi.*
from file_image as fi
where fi.file_id = $1")
where fi.file_id = ?")
(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 %)))))
(->> (db/exec! conn sqlv)
(into [] xf))))
;; --- Query: File (By ID)
@ -179,7 +185,7 @@
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
where f.id = ?
and f.deleted_at is null
and pg.deleted_at is null
window pages_w as (partition by f.id order by pg.ordering
@ -190,27 +196,26 @@
"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
where fpr.file_id = ?
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")
where f.id = ?")
(defn retrieve-file
[conn id]
(-> (db/query-one conn [sql:file id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row)))
(let [row (db/exec-one! conn [sql:file id])]
(when-not row
(ex/raise :type :not-found))
(decode-row row)))
(defn retrieve-file-users
[conn id]
(-> (db/query conn [sql:file-users id])
(p/then (fn [rows]
(mapv #(images/resolve-media-uris % [:photo :photo-uri]) rows)))))
(->> (db/exec! conn [sql:file-users id id])
(mapv #(images/resolve-media-uris % [:photo :photo-uri]))))
(s/def ::file-users
(s/keys :req-un [::profile-id ::id]))
@ -230,7 +235,6 @@
(check-edition-permissions! conn profile-id id)
(retrieve-file conn id)))
;; --- Helpers
(defn decode-row
@ -238,4 +242,4 @@
(when row
(cond-> row
data (assoc :data (blob/decode data))
pages (assoc :pages (vec (remove nil? pages))))))
pages (assoc :pages (vec (.getArray pages))))))

52
backend/src/uxbox/services/queries/icons.clj
View file

@ -14,16 +14,14 @@
[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.teams :as teams]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.common.uuid :as uuid]
[vertx.core :as vc]))
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.media :as media]
[uxbox.services.queries :as sq]
[uxbox.services.queries.teams :as teams]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]))
;; --- Helpers & Specs
@ -39,15 +37,13 @@
(cond-> row
metadata (assoc :metadata (blob/decode metadata)))))
;; --- Query: Icons Librarys
(def ^:private sql:libraries
"select lib.*,
(select count(*) from icon where library_id = lib.id) as num_icons
from icon_library as lib
where lib.team_id = $1
where lib.team_id = ?
and lib.deleted_at is null
order by lib.created_at desc")
@ -58,7 +54,7 @@
[{:keys [profile-id team-id]}]
(db/with-atomic [conn db/pool]
(teams/check-read-permissions! conn profile-id team-id)
(db/query conn [sql:libraries team-id])))
(db/exec! conn [sql:libraries team-id])))
@ -72,7 +68,7 @@
(sq/defquery ::icon-library
[{:keys [profile-id id]}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn id)]
(let [lib (retrieve-library conn id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
lib)))
@ -81,12 +77,14 @@
(select count(*) from icon where library_id = lib.id) as num_icons
from icon_library as lib
where lib.deleted_at is null
and lib.id = $1")
and lib.id = ?")
(defn- retrieve-library
[conn id]
(-> (db/query-one conn [sql:single-library id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-library id])]
(when-not row
(ex/raise :type :not-found))
row))
@ -100,22 +98,22 @@
(sq/defquery ::icons
[{:keys [profile-id library-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn library-id)]
(let [lib (retrieve-library conn library-id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
(-> (retrieve-icons conn library-id)
(p/then' (fn [rows] (mapv decode-row rows)))))))
(->> (retrieve-icons conn library-id)
(mapv decode-row)))))
(def ^:private sql:icons
"select icon.*
from icon as icon
inner join icon_library as lib on (lib.id = icon.library_id)
where icon.deleted_at is null
and icon.library_id = $1
and icon.library_id = ?
order by created_at desc")
(defn- retrieve-icons
[conn library-id]
(db/query conn [sql:icons library-id]))
(db/exec! conn [sql:icons library-id]))
@ -130,7 +128,7 @@
(sq/defquery ::icon
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [icon (retrieve-icon conn id)]
(let [icon (retrieve-icon conn id)]
(teams/check-read-permissions! conn profile-id (:team-id icon))
(decode-row icon))))
@ -140,11 +138,13 @@
from icon as icon
inner join icon_library as lib on (lib.id = icon.library_id)
where icon.deleted_at is null
and icon.id = $1
and icon.id = ?
order by created_at desc")
(defn retrieve-icon
[conn id]
(-> (db/query-one conn [sql:single-icon id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-icon id])]
(when-not row
(ex/raise :type :not-found))
row))

44
backend/src/uxbox/services/queries/images.clj
View file

@ -11,12 +11,12 @@
(: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.teams :as teams]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]))
[uxbox.services.queries :as sq]))
(s/def ::id ::us/uuid)
(s/def ::name ::us/string)
@ -30,7 +30,7 @@
"select lib.*,
(select count(*) from image where library_id = lib.id) as num_images
from image_library as lib
where lib.team_id = $1
where lib.team_id = ?
and lib.deleted_at is null
order by lib.created_at desc")
@ -41,7 +41,7 @@
[{:keys [profile-id team-id]}]
(db/with-atomic [conn db/pool]
(teams/check-read-permissions! conn profile-id team-id)
(db/query conn [sql:libraries team-id])))
(db/exec! conn [sql:libraries team-id])))
;; --- Query: Image Library
@ -54,7 +54,7 @@
(sq/defquery ::image-library
[{:keys [profile-id id]}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn id)]
(let [lib (retrieve-library conn id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
lib)))
@ -63,13 +63,14 @@
(select count(*) from image where library_id = lib.id) as num_images
from image_library as lib
where lib.deleted_at is null
and lib.id = $1")
and lib.id = ?")
(defn- retrieve-library
[conn id]
(-> (db/query-one conn [sql:single-library id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-library id])]
(when-not row
(ex/raise :type :not-found))
row))
;; --- Query: Images (by library)
@ -85,13 +86,11 @@
(sq/defquery ::images
[{:keys [profile-id library-id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [lib (retrieve-library conn library-id)]
(let [lib (retrieve-library conn library-id)]
(teams/check-read-permissions! conn profile-id (:team-id lib))
(-> (retrieve-images conn library-id)
(p/then' (fn [rows]
(->> rows
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri)))))))))
(->> (retrieve-images conn library-id)
(mapv #(images/resolve-urls % :path :uri))
(mapv #(images/resolve-urls % :thumb-path :thumb-uri))))))
(def ^:private sql:images
@ -99,12 +98,12 @@
from image as img
inner join image_library as lib on (lib.id = img.library_id)
where img.deleted_at is null
and img.library_id = $1
and img.library_id = ?
order by created_at desc")
(defn- retrieve-images
[conn library-id]
(db/query conn [sql:images library-id]))
(db/exec! conn [sql:images library-id]))
@ -119,7 +118,7 @@
(sq/defquery ::image
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [img (retrieve-image conn id)]
(let [img (retrieve-image conn id)]
(teams/check-read-permissions! conn profile-id (:team-id img))
(-> img
(images/resolve-urls :path :uri)
@ -131,13 +130,14 @@
from image as img
inner join image_library as lib on (lib.id = img.library_id)
where img.deleted_at is null
and img.id = $1
and img.id = ?
order by created_at desc")
(defn retrieve-image
[conn id]
(-> (db/query-one conn [sql:single-image id])
(p/then' su/raise-not-found-if-nil)))
(let [row (db/exec-one! conn [sql:single-image id])]
(when-not row
(ex/raise :type :not-found))
row))

43
backend/src/uxbox/services/queries/pages.clj
View file

@ -12,12 +12,11 @@
[clojure.spec.alpha :as s]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.common.exceptions :as ex]
[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]))
[uxbox.util.blob :as blob]))
;; --- Helpers & Specs
@ -28,8 +27,6 @@
(s/def ::project-id ::us/uuid)
(s/def ::file-id ::us/uuid)
;; --- Query: Pages (By File ID)
(declare retrieve-pages)
@ -46,16 +43,14 @@
(def ^:private sql:pages
"select p.*
from page as p
where p.file_id = $1
where p.file_id = ?
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))))
(->> (db/exec! conn [sql:pages file-id])
(mapv decode-row)))
;; --- Query: Single Page (By ID)
@ -66,20 +61,20 @@
(sq/defquery ::page
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(p/let [page (retrieve-page conn id)]
(with-open [conn (db/open)]
(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")
"select p.* from page as p where id=?")
(defn retrieve-page
[conn id]
(-> (db/query-one conn [sql:page id])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row)))
(let [row (db/exec-one! conn [sql:page id])]
(when-not row
(ex/raise :type :not-found))
(decode-row row)))
;; --- Query: Page Changes
@ -90,10 +85,10 @@
pc.changes,
pc.revn
from page_change as pc
where pc.page_id=$1
where pc.page_id=?
order by pc.revn asc
limit $2
offset $3")
limit ?
offset ?")
(s/def ::skip ::us/integer)
@ -104,14 +99,14 @@
(defn retrieve-page-changes
[conn id skip limit]
(-> (db/query conn [sql:page-changes id limit skip])
(p/then' #(mapv decode-row %))))
(->> (db/exec! conn [sql:page-changes id limit skip])
(mapv decode-row)))
(sq/defquery ::page-changes
[{:keys [profile-id id skip limit]}]
(when *assert*
(-> (db/query db/pool [sql:page-changes id limit skip])
(p/then' #(mapv decode-row %)))))
(-> (db/exec! db/pool [sql:page-changes id limit skip])
(mapv decode-row))))
;; --- Helpers

39
backend/src/uxbox/services/queries/profile.clj
View file

@ -7,14 +7,11 @@
(ns uxbox.services.queries.profile
(: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.images :as images]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.common.uuid :as uuid]
[uxbox.util.blob :as blob]))
@ -43,7 +40,7 @@
(sq/defquery ::profile
[{:keys [profile-id] :as params}]
(if profile-id
(db/with-atomic [conn db/pool]
(with-open [conn (db/open)]
(retrieve-profile conn profile-id))
{:id uuid/zero
:fullname "Anonymous User"}))
@ -57,41 +54,43 @@
"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
where tpr.profile_id = ?
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
where tpr.profile_id = ?
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)}))))
(let [[team project] (db/exec! conn [sql:default-team-and-project id id])]
{:default-team-id (:id team)
:default-project-id (:id project)}))
(defn retrieve-profile-data
[conn id]
(let [sql "select * from profile where id=$1 and deleted_at is null"]
(db/query-one conn [sql id])))
(let [sql "select * from profile where id=? and deleted_at is null"]
(db/exec-one! conn [sql id])))
(defn retrieve-profile
[conn id]
(p/let [prof (-> (retrieve-profile-data conn 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 id)]
(merge prof addt)))
(let [profile (some-> (retrieve-profile-data conn id)
(images/resolve-urls :photo :photo-uri)
(strip-private-attrs)
(merge (retrieve-additional-data conn id)))]
(when (nil? profile)
(ex/raise :type :not-found
:hint "Object doest not exists."))
profile))
;; --- Attrs Helpers
(defn strip-private-attrs
"Only selects a publicy visible profile attrs."
[profile]
(select-keys profile [:id :fullname :lang :email :created-at :photo :theme :photo-uri]))
[o]
(select-keys o [:id :fullname :lang :email :created-at :photo :theme :photo-uri]))

15
backend/src/uxbox/services/queries/projects.clj
View file

@ -11,7 +11,6 @@
[uxbox.common.spec :as us]
[uxbox.db :as db]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]))
(declare decode-row)
@ -32,7 +31,7 @@
and deleted_at is null) as file_count
from project as p
inner join team_profile_rel as tpr on (tpr.team_id = p.team_id)
where tpr.profile_id = $1
where tpr.profile_id = ?
and p.deleted_at is null
and (tpr.is_admin = true or
tpr.is_owner = true or
@ -44,7 +43,7 @@
and deleted_at is null)
from project as p
inner join project_profile_rel as ppr on (ppr.project_id = p.id)
where ppr.profile_id = $1
where ppr.profile_id = ?
and p.deleted_at is null
and (ppr.is_admin = true or
ppr.is_owner = true or
@ -52,15 +51,15 @@
)
select *
from projects
where team_id = $2
where team_id = ?
order by modified_at desc")
(def ^:private sql:project-by-id
"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 p.id = $2
where ppr.profile_id = ?
and p.id = ?
and p.deleted_at is null
and (ppr.is_admin = true or
ppr.is_owner = true or
@ -78,11 +77,11 @@
(defn retrieve-projects
[conn profile-id team-id]
(db/query conn [sql:projects profile-id team-id]))
(db/exec! conn [sql:projects profile-id profile-id team-id]))
(defn retrieve-project
[conn profile-id id]
(db/query-one conn [sql:project-by-id profile-id id]))
(db/exec-one! conn [sql:project-by-id profile-id id]))
(sq/defquery ::projects-by-team
[{:keys [profile-id team-id]}]

22
backend/src/uxbox/services/queries/recent_files.clj
View file

@ -25,8 +25,8 @@
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
where fp_r.profile_id = ?
and f.project_id = ?
and f.deleted_at is null
and pg.deleted_at is null
and (fp_r.is_admin = true or
@ -38,10 +38,11 @@
order by f.modified_at desc
limit 5")
(defn recent-by-project [profile-id project]
(defn recent-by-project
[profile-id project]
(let [project-id (:id project)]
(-> (db/query db/pool [sql:project-files-recent profile-id project-id])
(p/then (partial mapv decode-row)))))
(->> (db/exec! db/pool [sql:project-files-recent profile-id project-id])
(mapv decode-row))))
(s/def ::team-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
@ -51,8 +52,9 @@
(sq/defquery ::recent-files
[{:keys [profile-id team-id]}]
(-> (retrieve-projects db/pool profile-id team-id)
;; Retrieve for each proyect the 5 more recent files
(p/then #(p/all (map (partial recent-by-project profile-id) %)))
;; Change the structure so it's a map with project-id as keys
(p/then #(->> % (flatten) (group-by :project-id)))))
(->> (retrieve-projects db/pool profile-id team-id)
;; Retrieve for each proyect the 5 more recent files
(map (partial recent-by-project profile-id))
;; Change the structure so it's a map with project-id as keys
(flatten)
(group-by :project-id)))

43
backend/src/uxbox/services/queries/teams.clj
View file

@ -10,15 +10,12 @@
(ns uxbox.services.queries.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.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]))
[uxbox.util.blob :as blob]))
;; --- Team Edition Permissions
@ -27,27 +24,25 @@
tpr.is_admin,
tpr.can_edit
from team_profile_rel as tpr
where tpr.profile_id = $1
and tpr.team_id = $2")
where tpr.profile_id = ?
and tpr.team_id = ?")
(defn check-edition-permissions!
[conn profile-id team-id]
(-> (db/query-one conn [sql:team-permissions profile-id team-id])
(p/then' (fn [row]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row))
(ex/raise :type :validation
:code :not-authorized))))))
(let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row))
(ex/raise :type :validation
:code :not-authorized))))
(defn check-read-permissions!
[conn profile-id team-id]
(-> (db/query-one conn [sql:team-permissions profile-id team-id])
(p/then' (fn [row]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row)
;; We can read global-project owned items
(= team-id #uuid "00000000-0000-0000-0000-000000000000"))
(ex/raise :type :validation
:code :not-authorized))))))
(let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
(when-not (or (:can-edit row)
(:is-admin row)
(:is-owner row)
;; We can read global-project owned items
(= team-id #uuid "00000000-0000-0000-0000-000000000000"))
(ex/raise :type :validation
:code :not-authorized))))

37
backend/src/uxbox/services/queries/user_attrs.clj
View file

@ -1,37 +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.user-attrs
(: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]))
(defn decode-row
[{:keys [val] :as row}]
(when row
(cond-> row
val (assoc :val (blob/decode val)))))
(s/def ::key ::us/string)
(s/def ::user ::us/uuid)
(s/def ::user-attr
(s/keys :req-un [::key ::user]))
(sq/defquery ::user-attr
[{:keys [key user]}]
(let [sql "select kv.*
from user_attrs as kv
where kv.user_id = $2
and kv.key = $1"]
(-> (db/query-one db/pool [sql key user])
(p/then' su/raise-not-found-if-nil)
(p/then' decode-row))))

30
backend/src/uxbox/services/queries/viewer.clj
View file

@ -14,17 +14,15 @@
[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.pages :as pages]
[uxbox.services.queries.files :as files]
[uxbox.services.queries :as sq]
[uxbox.services.util :as su]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]
[uxbox.common.uuid :as uuid]
[vertx.core :as vc]))
[uxbox.db :as db]
[uxbox.images :as images]
[uxbox.media :as media]
[uxbox.services.queries :as sq]
[uxbox.services.queries.files :as files]
[uxbox.services.queries.pages :as pages]
[uxbox.util.blob :as blob]
[uxbox.util.data :as data]))
;; --- Helpers & Specs
@ -37,12 +35,12 @@
sql:project
"select p.id, p.name
from project as p
where p.id = $1
where p.id = ?
and p.deleted_at is null")
(defn- retrieve-project
[conn id]
(db/query-one conn [sql:project id]))
(db/exec-one! conn [sql:project id]))
(s/def ::share-token ::us/string)
(s/def ::viewer-bundle
@ -52,10 +50,10 @@
(sq/defquery ::viewer-bundle
[{:keys [profile-id page-id share-token] :as params}]
(db/with-atomic [conn db/pool]
(p/let [page (pages/retrieve-page conn page-id)
file (files/retrieve-file conn (:file-id page))
images (files/retrieve-file-images conn page)
project (retrieve-project conn (:project-id file))]
(let [page (pages/retrieve-page conn page-id)
file (files/retrieve-file conn (:file-id page))
images (files/retrieve-file-images conn page)
project (retrieve-project conn (:project-id file))]
(if (string? share-token)
(when (not= share-token (:share-token page))
(ex/raise :type :validation

29
backend/src/uxbox/services/util.clj
View file

@ -1,29 +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.util
(:require
[clojure.tools.logging :as log]
[cuerdas.core :as str]
[vertx.util :as vu]
[uxbox.core :refer [system]]
[uxbox.common.exceptions :as ex]
[uxbox.common.uuid :as uuid]
[uxbox.util.dispatcher :as uds]))
(defn raise-not-found-if-nil
[v]
(if (nil? v)
(ex/raise :type :not-found
:hint "Object doest not exists.")
v))
(def constantly-nil (constantly nil))
(defn handle-on-context
[p]
(->> (vu/current-context system)
(vu/handle-on-context p)))

21
backend/src/uxbox/tasks.clj
View file

@ -13,19 +13,15 @@
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.config :as cfg]
[uxbox.core :refer [system]]
[uxbox.db :as db]
[uxbox.tasks.sendmail]
[uxbox.tasks.remove-media]
[uxbox.tasks.delete-profile]
[uxbox.tasks.delete-object]
[uxbox.tasks.impl :as impl]
[uxbox.util.time :as dt]
[vertx.core :as vc]
[vertx.timers :as vt]))
[uxbox.util.time :as dt]))
;; --- Public API
@ -48,10 +44,17 @@
"remove-media" #'uxbox.tasks.remove-media/handler
"sendmail" #'uxbox.tasks.sendmail/handler})
(defstate tasks-worker
:start (as-> (impl/worker-verticle {:tasks tasks}) $$
(vc/deploy! system $$ {:instances 1})
(deref $$)))
(defstate worker
:start (impl/start-worker! {:tasks tasks})
:stop (impl/stop! worker))
;; (defstate scheduler
;; :start (impl/start-scheduler! tasks)
;; :stop (impl/stop! tasks-worker))
;; :start (as-> (impl/worker-verticle {:tasks tasks}) $$
;; (vc/deploy! system $$ {:instances 1})
;; (deref $$)))
;; (def ^:private schedule
;; [{:id "every 1 hour"

36
backend/src/uxbox/tasks/delete_object.clj
View file

@ -12,13 +12,11 @@
(: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]))
[uxbox.util.storage :as ust]))
(s/def ::type keyword?)
(s/def ::id ::us/uuid)
@ -40,42 +38,42 @@
(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])))
(let [sql "delete from image where id=? and deleted_at is not null"]
(db/exec-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])))
where id=? and deleted_at is not null"]
(db/exec-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])))
(let [sql "delete from icon where id=? and deleted_at is not null"]
(db/exec-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])))
where id=? and deleted_at is not null"]
(db/exec-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])))
(let [sql "delete from file where id=? and deleted_at is not null"]
(db/exec-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])))
(let [sql "delete from file_image where id=? and deleted_at is not null"]
(db/exec-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])))
(let [sql "delete from page where id=? and deleted_at is not null"]
(db/exec-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])))
(let [sql "delete from page_version where id=? and deleted_at is not null"]
(db/exec-one! conn [sql id])))

48
backend/src/uxbox/tasks/delete_profile.clj
View file

@ -12,15 +12,12 @@
(: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]))
[uxbox.util.storage :as ust]))
(declare select-profile)
(declare delete-profile-data)
(declare delete-teams)
(declare delete-files)
@ -34,38 +31,32 @@
[{: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")))))))
(let [id (:profile-id props)
profile (db/get-by-id conn :profile id {:for-update true})]
(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)))
(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]))
where id=? for update")
(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
where tpr.profile_id = ?
and tpr.is_owner is true
), to_delete_teams as (
select tpr.team_id as id
@ -80,8 +71,7 @@
(defn- delete-teams
[conn profile-id]
(-> (db/query-one conn [sql:remove-owned-teams profile-id])
(p/then' (constantly nil))))
(db/exec-one! conn [sql:remove-owned-teams profile-id]))
(def ^:private sql:remove-owned-files
"with files_to_delete as (
@ -89,7 +79,7 @@
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
where fpr.profile_id = ?
and fpr.is_owner is true
and f.project_id is null
)
@ -99,12 +89,8 @@
(defn- delete-files
[conn profile-id]
(-> (db/query-one conn [sql:remove-owned-files profile-id])
(p/then' (constantly nil))))
(db/exec-one! conn [sql:remove-owned-files profile-id]))
(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)))))
(db/delete! conn :profile {:id profile-id}))

303
backend/src/uxbox/tasks/impl.clj
View file

@ -10,24 +10,24 @@
(ns uxbox.tasks.impl
"Async tasks implementation."
(:require
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[promesa.core :as p]
[uxbox.common.spec :as us]
[uxbox.common.uuid :as uuid]
[uxbox.config :as cfg]
[uxbox.core :refer [system]]
[uxbox.db :as db]
[uxbox.util.blob :as blob]
[uxbox.util.time :as tm]
[vertx.core :as vc]
[vertx.util :as vu]
[vertx.timers :as vt])
[uxbox.util.time :as dt])
(:import
java.time.Duration
java.time.Instant
java.util.Date))
(defrecord Worker [stop]
java.lang.AutoCloseable
(close [_] (a/close! stop)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tasks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -40,42 +40,42 @@
(def ^:private sql:mark-as-retry
"update task
set scheduled_at = clock_timestamp() + '5 seconds'::interval,
error = $1,
error = ?,
status = 'retry',
retry_num = retry_num + 1
where id = $2;")
where id = ?")
(defn- reschedule
[conn task error]
(let [explain (ex-message error)
sqlv [sql:mark-as-retry explain (:id task)]]
(-> (db/query-one conn sqlv)
(p/then' (constantly nil)))))
(db/exec-one! conn sqlv)
nil))
(def ^:private sql:mark-as-failed
"update task
set scheduled_at = clock_timestamp() + '5 seconds'::interval,
error = $1,
error = ?,
status = 'failed'
where id = $2;")
where id = ?;")
(defn- mark-as-failed
[conn task error]
(let [explain (ex-message error)
sqlv [sql:mark-as-failed explain (:id task)]]
(-> (db/query-one conn sqlv)
(p/then' (constantly nil)))))
(db/exec-one! conn sqlv)
nil))
(def ^:private sql:mark-as-completed
"update task
set completed_at = clock_timestamp(),
status = 'completed'
where id = $1")
where id = ?")
(defn- mark-as-completed
[conn task]
(-> (db/query-one conn [sql:mark-as-completed (:id task)])
(p/then' (constantly nil))))
(db/exec-one! conn [sql:mark-as-completed (:id task)])
nil)
(defn- handle-task
[tasks {:keys [name] :as item}]
@ -89,8 +89,8 @@
(def ^:private sql:select-next-task
"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))
and t.queue = ?
and (t.status = 'new' or (t.status = 'retry' and t.retry_num <= ?))
order by t.scheduled_at
limit 1
for update skip locked")
@ -108,124 +108,130 @@
(with-out-str
(.printStackTrace ^Throwable err (java.io.PrintWriter. *out*)))))
(defn- event-loop
(defn- event-loop-fn
[{:keys [tasks] :as options}]
(let [queue (:queue options "default")
max-retries (:max-retries options 3)]
(db/with-atomic [conn db/pool]
(-> (db/query-one conn [sql:select-next-task queue max-retries])
(p/then decode-task-row)
(p/then (fn [item]
(when item
(log/info "Execute task" (:name item))
(-> (p/do! (handle-task tasks item))
(p/handle (fn [v e]
(if e
(do
(log-task-error item e)
(if (>= (:retry-num item) max-retries)
(mark-as-failed conn item e)
(reschedule conn item e)))
(mark-as-completed conn item))))
(p/then' (constantly ::handled))))))))))
(let [item (-> (db/exec-one! conn [sql:select-next-task queue max-retries])
(decode-task-row))]
(when item
(log/info "Execute task" (:name item))
(try
(handle-task tasks item)
(mark-as-completed conn item)
::handled
(catch Throwable e
(log-task-error item e)
(if (>= (:retry-num item) max-retries)
(mark-as-failed conn item e)
(reschedule conn item e)))))))))
(defn- event-loop-handler
(defn- start-worker-eventloop!
[options]
(let [counter (::counter options 1)
mbs (:max-batch-size options 10)]
(-> (event-loop options)
(p/then (fn [result]
(when (and (= result ::handled)
(> mbs counter))
(event-loop-handler (assoc options ::counter (inc counter)))))))))
(def ^:private sql:insert-new-task
"insert into task (name, props, queue, scheduled_at)
values ($1, $2, $3, clock_timestamp()+cast($4::text as interval))
returning id")
(let [stop (::stop options)
mbs (:max-batch-size options 10)]
(a/go-loop []
(let [timeout (a/timeout 5000)
[val port] (a/alts! [stop timeout])]
(when (= port timeout)
(a/<! (a/thread
;; Tasks batching in one event loop execution.
(loop [cnt 1
res (event-loop-fn options)]
(when (and (= res ::handled)
(> mbs cnt))
(recur (inc 1)
(event-loop-fn options))))))
(recur))))))
(defn- duration->pginterval
[^Duration d]
(->> (/ (.toMillis d) 1000.0)
(format "%s seconds")))
(defn- on-worker-start
[ctx {:keys [tasks] :as options}]
(vt/schedule! ctx (assoc options
::vt/fn #'event-loop-handler
::vt/delay 5000
::vt/repeat true)))
(defn start-worker!
[options]
(let [stop (a/chan)]
(a/go
(a/<! (start-worker-eventloop! (assoc options ::stop stop)))
(log/info "STOPING"))
(->Worker stop)))
(defn stop!
[worker]
(.close ^java.lang.AutoCloseable worker))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Scheduled Tasks
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:privatr sql:upsert-scheduled-task
"insert into scheduled_task (id, cron_expr)
values ($1, $2)
on conflict (id)
do update set cron_expr=$2")
;; (def ^:privatr sql:upsert-scheduled-task
;; "insert into scheduled_task (id, cron_expr)
;; values ($1, $2)
;; on conflict (id)
;; do update set cron_expr=$2")
(defn- synchronize-schedule-item
[conn {:keys [id cron]}]
(-> (db/query-one conn [sql:upsert-scheduled-task id (str cron)])
(p/then' (constantly nil))))
;; (defn- synchronize-schedule-item
;; [conn {:keys [id cron]}]
;; (-> (db/query-one conn [sql:upsert-scheduled-task id (str cron)])
;; (p/then' (constantly nil))))
(defn- synchronize-schedule
[schedule]
(db/with-atomic [conn db/pool]
(p/run! (partial synchronize-schedule-item conn) schedule)))
;; (defn- synchronize-schedule
;; [schedule]
;; (db/with-atomic [conn db/pool]
;; (p/run! (partial synchronize-schedule-item conn) schedule)))
(def ^:private sql:lock-scheduled-task
"select id from scheduled_task where id=$1 for update skip locked")
;; (def ^:private sql:lock-scheduled-task
;; "select id from scheduled_task where id=$1 for update skip locked")
(declare schedule-task)
;; (declare schedule-task)
(defn- log-scheduled-task-error
[item err]
(log/error "Unhandled exception on scheduled task '" (:id item) "' \n"
(with-out-str
(.printStackTrace ^Throwable err (java.io.PrintWriter. *out*)))))
;; (defn- log-scheduled-task-error
;; [item err]
;; (log/error "Unhandled exception on scheduled task '" (:id item) "' \n"
;; (with-out-str
;; (.printStackTrace ^Throwable err (java.io.PrintWriter. *out*)))))
(defn- execute-scheduled-task
[{:keys [id cron] :as stask}]
(db/with-atomic [conn db/pool]
;; First we try to lock the task in the database, if locking us
;; successful, then we execute the scheduled task; if locking is
;; not possible (because other instance is already locked id) we
;; just skip it and schedule to be executed in the next slot.
(-> (db/query-one conn [sql:lock-scheduled-task id])
(p/then (fn [result]
(when result
(-> (p/do! ((:fn stask) stask))
(p/catch (fn [e]
(log-scheduled-task-error stask e)
nil))))))
(p/finally (fn [v e]
(-> (vu/current-context)
(schedule-task stask)))))))
(defn ms-until-valid
[cron]
(s/assert tm/cron? cron)
(let [^Instant now (tm/now)
^Instant next (tm/next-valid-instant-from cron now)
^Duration duration (Duration/between now next)]
(.toMillis duration)))
;; (defn- execute-scheduled-task
;; [{:keys [id cron] :as stask}]
;; (db/with-atomic [conn db/pool]
;; ;; First we try to lock the task in the database, if locking us
;; ;; successful, then we execute the scheduled task; if locking is
;; ;; not possible (because other instance is already locked id) we
;; ;; just skip it and schedule to be executed in the next slot.
;; (-> (db/query-one conn [sql:lock-scheduled-task id])
;; (p/then (fn [result]
;; (when result
;; (-> (p/do! ((:fn stask) stask))
;; (p/catch (fn [e]
;; (log-scheduled-task-error stask e)
;; nil))))))
;; (p/finally (fn [v e]
;; (-> (vu/current-context)
;; (schedule-task stask)))))))
;; (defn ms-until-valid
;; [cron]
;; (s/assert dt/cron? cron)
;; (let [^Instant now (dt/now)
;; ^Instant next (dt/next-valid-instant-from cron now)
;; ^Duration duration (Duration/between now next)]
;; (.toMillis duration)))
(defn- schedule-task
[ctx {:keys [cron] :as stask}]
(let [ms (ms-until-valid cron)]
(vt/schedule! ctx (assoc stask
:ctx ctx
::vt/once true
::vt/delay ms
::vt/fn execute-scheduled-task))))
;; (defn- schedule-task
;; [ctx {:keys [cron] :as stask}]
;; (let [ms (ms-until-valid cron)]
;; (vt/schedule! ctx (assoc stask
;; :ctx ctx
;; ::vt/once true
;; ::vt/delay ms
;; ::vt/fn execute-scheduled-task))))
(defn- on-scheduler-start
[ctx {:keys [schedule] :as options}]
(-> (synchronize-schedule schedule)
(p/then' (fn [_]
(run! #(schedule-task ctx %) schedule)))))
;; (defn- on-scheduler-start
;; [ctx {:keys [schedule] :as options}]
;; (-> (synchronize-schedule schedule)
;; (p/then' (fn [_]
;; (run! #(schedule-task ctx %) schedule)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
@ -233,64 +239,71 @@
;; --- Worker Verticle
(s/def ::callable (s/or :fn fn? :var var?))
(s/def ::max-batch-size ::us/integer)
(s/def ::max-retries ::us/integer)
(s/def ::tasks (s/map-of string? ::callable))
;; (s/def ::callable (s/or :fn fn? :var var?))
;; (s/def ::max-batch-size ::us/integer)
;; (s/def ::max-retries ::us/integer)
;; (s/def ::tasks (s/map-of string? ::callable))
(s/def ::worker-verticle-options
(s/keys :req-un [::tasks]
:opt-un [::queue ::max-batch-size]))
;; (s/def ::worker-verticle-options
;; (s/keys :req-un [::tasks]
;; :opt-un [::queue ::max-batch-size]))
(defn worker-verticle
[options]
(s/assert ::worker-verticle-options options)
(let [on-start #(on-worker-start % options)]
(vc/verticle {:on-start on-start})))
;; (defn worker-verticle
;; [options]
;; (s/assert ::worker-verticle-options options)
;; (let [on-start #(on-worker-start % options)]
;; (vc/verticle {:on-start on-start})))
;; --- Scheduler Verticle
(s/def ::id string?)
(s/def ::cron tm/cron?)
(s/def ::fn ::callable)
(s/def ::props (s/nilable map?))
;; (s/def ::id string?)
;; (s/def ::cron dt/cron?)
;; (s/def ::fn ::callable)
;; (s/def ::props (s/nilable map?))
(s/def ::scheduled-task
(s/keys :req-un [::id ::cron ::fn]
:opt-un [::props]))
;; (s/def ::scheduled-task
;; (s/keys :req-un [::id ::cron ::fn]
;; :opt-un [::props]))
(s/def ::schedule (s/coll-of ::scheduled-task))
;; (s/def ::schedule (s/coll-of ::scheduled-task))
(s/def ::scheduler-verticle-options
(s/keys :opt-un [::schedule]))
;; (s/def ::scheduler-verticle-options
;; (s/keys :opt-un [::schedule]))
(defn scheduler-verticle
[options]
(s/assert ::scheduler-verticle-options options)
(let [on-start #(on-scheduler-start % options)]
(vc/verticle {:on-start on-start})))
;; (defn scheduler-verticle
;; [options]
;; (s/assert ::scheduler-verticle-options options)
;; (let [on-start #(on-scheduler-start % options)]
;; (vc/verticle {:on-start on-start})))
;; --- Schedule API
(s/def ::name ::us/string)
(s/def ::delay
(s/or :int ::us/integer
:duration tm/duration?))
:duration dt/duration?))
(s/def ::queue ::us/string)
(s/def ::task-options
(s/keys :req-un [::name]
:opt-un [::delay ::props ::queue]))
(def ^:private sql:insert-new-task
"insert into task (id, name, props, queue, scheduled_at)
values (?, ?, ?, ?, clock_timestamp()+cast(?::text as interval))
returning id")
(defn schedule!
[conn {:keys [name delay props queue key]
:or {delay 0 props {} queue "default"}
:as options}]
(us/verify ::task-options options)
(let [duration (tm/duration delay)
(let [duration (dt/duration delay)
pginterval (duration->pginterval duration)
props (blob/encode props)]
props (blob/encode props)
id (uuid/next)]
(log/info "Schedule task" name
;; "with props" (pr-str props)
"to be executed in" (str duration))
(-> (db/query-one conn [sql:insert-new-task name props queue pginterval])
(p/then' (fn [task] (:id task))))))
(db/exec-one! conn [sql:insert-new-task
id name props queue pginterval])
id))

10
backend/src/uxbox/tasks/remove_media.clj
View file

@ -15,8 +15,7 @@
[uxbox.common.exceptions :as ex]
[uxbox.common.spec :as us]
[uxbox.media :as media]
[uxbox.util.storage :as ust]
[vertx.util :as vu]))
[uxbox.util.storage :as ust]))
(s/def ::path ::us/not-empty-string)
(s/def ::props
@ -25,8 +24,7 @@
(defn handler
[{:keys [props] :as task}]
(us/verify ::props props)
(vu/blocking
(when (ust/exists? media/media-storage (:path props))
(ust/delete! media/media-storage (:path props))
(log/debug "Media " (:path props) " removed."))))
(when (ust/exists? media/media-storage (:path props))
(ust/delete! media/media-storage (:path props))
(log/debug "Media " (:path props) " removed.")))

41
backend/src/uxbox/tasks/sendmail.clj
View file

@ -12,12 +12,10 @@
[clojure.data.json :as json]
[clojure.tools.logging :as log]
[postal.core :as postal]
[promesa.core :as p]
[uxbox.common.data :as d]
[uxbox.common.exceptions :as ex]
[uxbox.config :as cfg]
[uxbox.util.http :as http]
[vertx.util :as vu]))
[uxbox.util.http :as http]))
(defmulti sendmail (fn [config email] (:sendmail-backend config)))
@ -49,21 +47,17 @@
headers {"Authorization" (str "Bearer " apikey)
"Content-Type" "application/json"}
body (json/write-str params)]
(-> (http/send! {:method :post
:headers headers
:uri "https://api.sendgrid.com/v3/mail/send"
:body body})
(p/handle
(fn [response error]
(cond
error
(log/error "Error on sending email to sendgrid:" (pr-str error))
(= 202 (:status response))
nil
:else
(log/error "Unexpected status from sendgrid:" (pr-str response))))))))
(try
(let [response (http/send! {:method :post
:headers headers
:uri "https://api.sendgrid.com/v3/mail/send"
:body body})]
(when-not (= 202 (:status response))
(log/error "Unexpected status from sendgrid:" (pr-str response))))
(catch Throwable error
(log/error "Error on sending email to sendgrid:" (pr-str error))))))
(defn- get-smtp-config
[config]
@ -87,14 +81,13 @@
(defmethod sendmail "smtp"
[config email]
(vu/blocking
(let [config (get-smtp-config config)
email (email->postal email)
result (postal/send-message config email)]
(when (not= (:error result) :SUCCESS)
(ex/raise :type :sendmail-error
:code :email-not-sent
:context result)))))
(let [config (get-smtp-config config)
email (email->postal email)
result (postal/send-message config email)]
(when (not= (:error result) :SUCCESS)
(ex/raise :type :sendmail-error
:code :email-not-sent
:context result))))
(defn handler
{:uxbox.tasks/name "sendmail"}

7
backend/src/uxbox/util/blob.clj
View file

@ -12,7 +12,6 @@
page data, page options and txlog payload storage."
(:require [uxbox.util.transit :as t])
(:import
io.vertx.core.buffer.Buffer
java.io.ByteArrayInputStream
java.io.ByteArrayOutputStream
java.io.DataInputStream
@ -28,9 +27,6 @@
(Class/forName "[B")
(->bytes [data] data)
Buffer
(->bytes [data] (.getBytes ^Buffer data))
String
(->bytes [data] (.getBytes ^String data "UTF-8")))
@ -49,8 +45,7 @@
(.writeShort dos (short 1)) ;; version number
(.writeInt dos (int data-len))
(.write dos ^bytes cdata (int 0) clen)
(-> (.toByteArray baos)
(t/bytes->buffer)))))
(.toByteArray baos))))
(declare decode-v1)

13
backend/src/uxbox/util/dispatcher.clj
View file

@ -9,7 +9,6 @@
(:refer-clojure :exclude [defmethod])
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[expound.alpha :as expound]
[uxbox.common.exceptions :as ex])
(:import
@ -127,14 +126,10 @@
(with-meta
(fn [params]
(try
(-> (handler params)
(p/catch' (fn [error]
(ex/raise :type :service-error
:name (:spec mdata)
:cause error))))
(handler params)
(catch Throwable error
(p/rejected (ex/error :type :service-error
:name (:spec mdata)
:cause error)))))
(ex/raise :type :service-error
:name (:spec mdata)
:cause error))))
(assoc mdata ::wrap-error true))))

2
backend/src/uxbox/util/http.clj
View file

@ -16,4 +16,4 @@
(defn send!
[req]
(http/send-async req {:client @default-client :as :string}))
(http/send req {:client @default-client :as :string}))

98
backend/src/uxbox/util/migrations.clj
View file

@ -10,8 +10,8 @@
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[promesa.core :as p]
[uxbox.util.pgsql :as pg]))
[next.jdbc :as jdbc]))
(s/def ::name string?)
(s/def ::step (s/keys :req-un [::name ::desc ::fn]))
@ -24,75 +24,57 @@
(defn- registered?
"Check if concrete migration is already registred."
[pool modname stepname]
(let [sql "select * from migrations where module=$1 and step=$2"]
(-> (pg/query pool [sql modname stepname])
(p/then' (fn [rows]
(pos? (count rows)))))))
(let [sql "select * from migrations where module=? and step=?"
rows (jdbc/execute! pool [sql modname stepname])]
(pos? (count rows))))
(defn- register!
"Register a concrete migration into local migrations database."
[pool modname stepname]
(let [sql "insert into migrations (module, step) values ($1, $2)"]
(-> (pg/query pool [sql modname stepname])
(p/then' (constantly nil)))))
(let [sql "insert into migrations (module, step) values (?, ?)"]
(jdbc/execute! pool [sql modname stepname])
nil))
(defn- impl-migrate-single
[pool modname {:keys [name] :as migration}]
(letfn [(execute []
(register! pool modname name)
((:fn migration) pool))]
(when-not (registered? pool modname (:name migration))
(log/info (str/format "applying migration %s/%s" modname name))
(register! pool modname name)
((:fn migration) pool))))
(defn- setup!
(defn- impl-migrate
[conn migrations {:keys [fake] :or {fake false}}]
(s/assert ::migrations migrations)
(let [mname (:name migrations)
steps (:steps migrations)]
(jdbc/with-transaction [conn conn]
(run! #(impl-migrate-single conn mname %) steps))))
(defprotocol IMigrationContext
(-migrate [_ migration options]))
;; --- Public Api
(defn setup!
"Initialize the database if it is not initialized."
[pool]
[conn]
(let [sql (str "create table if not exists migrations ("
" module text,"
" step text,"
" created_at timestamp DEFAULT current_timestamp,"
" unique(module, step)"
");")]
(-> (pg/query pool sql)
(p/then' (constantly nil)))))
(jdbc/execute! conn [sql])
nil))
(defn- impl-migrate-single
[pool modname {:keys [name] :as migration}]
(letfn [(execute []
(p/do! (register! pool modname name)
((:fn migration) pool)))]
(-> (registered? pool modname (:name migration))
(p/then (fn [registered?]
(when-not registered?
(log/info (str/format "applying migration %s/%s" modname name))
(execute)))))))
(defn- impl-migrate
[pool migrations {:keys [fake] :or {fake false}}]
(s/assert ::migrations migrations)
(let [mname (:name migrations)
steps (:steps migrations)]
;; (println (str/format "Applying migrations for `%s`:" mname))
(pg/with-atomic [conn pool]
(p/run! #(impl-migrate-single conn mname %) steps))))
(defprotocol IMigrationContext
(-migrate [_ migration options]))
;; --- Public Api
(defn context
"Create new instance of migration context."
([pool] (context pool nil))
([pool opts]
@(setup! pool)
(reify
java.lang.AutoCloseable
(close [_] #_(.close pool))
IMigrationContext
(-migrate [_ migration options]
(impl-migrate pool migration options)))))
(defn migrate
(defn migrate!
"Main entry point for apply a migration."
([ctx migrations]
(migrate ctx migrations nil))
([ctx migrations options]
(-migrate ctx migrations options)))
([conn migrations]
(migrate! conn migrations nil))
([conn migrations options]
(impl-migrate conn migrations options)))
(defn resource
"Helper for setup migration functions
@ -101,5 +83,5 @@
[path]
(fn [pool]
(let [sql (slurp (io/resource path))]
(-> (pg/query pool sql)
(p/then' (constantly true))))))
(jdbc/execute! pool [sql])
true)))

162
backend/src/uxbox/util/pgsql.clj
View file

@ -1,162 +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.util.pgsql
"Asynchronous posgresql client."
(:require
[promesa.core :as p])
(:import
clojure.lang.IDeref
java.util.function.Supplier
java.lang.ThreadLocal
io.vertx.core.Vertx
io.vertx.core.Handler
io.vertx.core.AsyncResult
io.vertx.core.buffer.Buffer
io.vertx.pgclient.PgPool
io.vertx.pgclient.PgConnection
io.vertx.sqlclient.impl.ArrayTuple
io.vertx.sqlclient.SqlClient
io.vertx.sqlclient.RowSet
io.vertx.sqlclient.Row
io.vertx.sqlclient.Tuple
io.vertx.sqlclient.Transaction
io.vertx.sqlclient.PoolOptions))
(declare impl-execute)
(declare impl-query)
(declare impl-handler)
(declare impl-transact)
(declare seqable->tuple)
;; --- Public Api
(defn vertx?
[v]
(instance? Vertx v))
(defn pool?
[v]
(instance? PgPool v))
(defn bytes->buffer
[data]
(Buffer/buffer ^bytes data))
(defn pool
([uri] (pool uri {}))
([uri {:keys [system max-size] :or {max-size 5}}]
(let [^PoolOptions poptions (PoolOptions.)]
(when max-size (.setMaxSize poptions max-size))
(if (vertx? system)
(PgPool/pool ^Vertx system ^String uri poptions)
(PgPool/pool ^String uri poptions)))))
(defn tl-pool
"Thread local based connection pool."
([uri] (tl-pool uri {}))
([uri options]
(let [state (ThreadLocal/withInitial (reify Supplier
(get [_]
(pool uri options))))]
(reify IDeref
(deref [_]
(.get state))))))
(defn query
([conn sqlv] (query conn sqlv {}))
([conn sqlv opts]
(cond
(vector? sqlv)
(impl-query conn (first sqlv) (rest sqlv) opts)
(string? sqlv)
(impl-query conn sqlv nil opts)
:else
(throw (ex-info "Invalid arguments" {:sqlv sqlv})))))
(defn query-one
[& args]
(p/map first (apply query args)))
(defn row->map
[^Row row]
(reduce (fn [acc index]
(let [cname (.getColumnName row index)]
(if-some [value (.getValue row ^int index)]
(assoc acc cname value)
acc)))
{}
(range (.size row))))
(defmacro with-atomic
[[bsym psym] & body]
`(impl-transact ~psym (fn [c#] (let [~bsym c#] ~@body))))
;; --- Implementation
(defn- seqable->tuple
[v]
(let [res (ArrayTuple. (count v))]
(run! #(.addValue res %) v)
res))
(defn- impl-handler
[resolve reject]
(reify Handler
(handle [_ ar]
(if (.failed ^AsyncResult ar)
(reject (.cause ^AsyncResult ar))
(resolve (.result ^AsyncResult ar))))))
(defn- impl-execute
[^SqlClient conn ^String sql params]
(if (seq params)
(p/create #(.preparedQuery conn sql
^Tuple (seqable->tuple params)
^Handler (impl-handler %1 %2)))
(p/create #(.query conn sql
^Handler (impl-handler %1 %2)))))
(defn- impl-query
[^SqlClient conn ^String sql params {:keys [xfm] :as opts}]
(let [conn (if (instance? IDeref conn) @conn conn)]
(-> (impl-execute conn sql params)
(p/catch (fn [err]
(p/rejected err)))
(p/then' (fn [rows]
(if xfm
(into [] xfm rows)
(into [] (map vec) rows)))))))
(defn impl-transact
[pool f]
(let [pool (if (instance? IDeref pool) @pool pool)]
(letfn [(commit [^Transaction tx]
(p/create #(.commit tx (impl-handler %1 %2))))
(rollback [^Transaction tx]
(p/create #(.rollback tx (impl-handler %1 %2))))
(on-connect [^PgConnection conn]
(let [tx (.begin conn)
df (p/deferred)]
(-> (f conn)
(p/finally (fn [v e]
(if e
(-> (rollback tx)
(p/finally (fn [& args]
(.close conn)
(p/reject! df e))))
(-> (commit tx)
(p/finally (fn [_ e']
(.close conn)
(if e'
(p/reject! df e')
(p/resolve! df v)))))))))
df))]
(-> (p/create #(.getConnection ^PgPool pool (impl-handler %1 %2)))
(p/bind on-connect)))))

29
backend/src/uxbox/util/redis.clj
View file

@ -40,15 +40,14 @@
(defn connect
[client]
(let [^RedisURI uri (:uri client)
^RedisClient client (:client client)]
(-> (.connectAsync client StringCodec/UTF8 uri)
(p/then' (fn [^StatefulRedisConnection conn]
(->Connection (.async conn)))))))
^RedisClient client (:client client)
^StatefulRedisConnection conn (.connect client StringCodec/UTF8 uri)]
(->Connection (.async conn))))
(defn- impl-subscribe
[^String topic ^StatefulRedisPubSubConnection conn]
(let [cmd (.async conn)
output (a/chan 1 (filter string?))
[^String topic xf ^StatefulRedisPubSubConnection conn]
(let [cmd (.sync conn)
output (a/chan 1 (comp (filter string?) xf))
buffer (a/chan (a/sliding-buffer 64))
sub (reify RedisPubSubListener
(message [it pattern channel message])
@ -74,15 +73,17 @@
(when (.isOpen conn)
(.close conn))))))
(-> (.subscribe ^RedisPubSubAsyncCommands cmd (into-array String [topic]))
(p/then' (constantly output)))))
(.subscribe ^RedisPubSubCommands cmd (into-array String [topic]))
output))
(defn subscribe
[client topic]
(let [^RedisURI uri (:uri client)
^RedisClient client (:client client)]
(-> (.connectPubSubAsync client StringCodec/UTF8 uri)
(p/then (partial impl-subscribe topic)))))
([client topic]
(subscribe client topic (map identity)))
([client topic xf]
(let [^RedisURI uri (:uri client)
^RedisClient client (:client client)]
(->> (.connectPubSub client StringCodec/UTF8 uri)
(impl-subscribe topic xf)))))
(defn- resolve-to-bool
[v]

10
backend/src/uxbox/util/transit.clj
View file

@ -11,7 +11,6 @@
[uxbox.util.time :as dt]
[uxbox.util.data :as data])
(:import
io.vertx.core.buffer.Buffer
java.io.ByteArrayInputStream
java.io.ByteArrayOutputStream
java.io.File))
@ -85,12 +84,3 @@
([^bytes data, ^String encoding]
(String. data encoding)))
(defn bytes->buffer
[^bytes data]
(Buffer/buffer data))
(defn buffer->bytes
[^Buffer data]
(.getBytes data))

72
backend/tests/uxbox/tests/helpers.clj
View file

@ -1,7 +1,9 @@
(ns uxbox.tests.helpers
(:require
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[cuerdas.core :as str]
[mount.core :as mount]
[environ.core :refer [env]]
@ -21,27 +23,34 @@
[uxbox.util.blob :as blob]
[uxbox.common.uuid :as uuid]
[uxbox.util.storage :as ust]
[uxbox.config :as cfg]
[vertx.util :as vu]))
[uxbox.config :as cfg])
(:import org.postgresql.ds.PGSimpleDataSource))
(def ^:dynamic *context* nil)
(defn testing-datasource
[]
(doto (PGSimpleDataSource.)
(.setServerName "postgres")
(.setDatabaseName "uxbox_test")
(.setUser "uxbox")
(.setPassword "uxbox")))
(defn state-init
[next]
(let [config (cfg/read-test-config env)]
(-> (mount/only #{#'uxbox.config/config
#'uxbox.core/system
#'uxbox.db/pool
#'uxbox.services.init/query-services
#'uxbox.services.init/mutation-services
#'uxbox.migrations/migrations
#'uxbox.media/assets-storage
#'uxbox.media/media-storage})
(mount/swap {#'uxbox.config/config config})
(mount/start))
(try
(binding [*context* (vu/get-or-create-context uxbox.core/system)]
(next))
;; (Class/forName "org.postgresql.Driver")
(let [pool (testing-datasource)]
(-> (mount/only #{#'uxbox.config/config
#'uxbox.db/pool
#'uxbox.services.init/query-services
#'uxbox.services.init/mutation-services
#'uxbox.migrations/migrations
#'uxbox.media/assets-storage
#'uxbox.media/media-storage})
(mount/swap {#'uxbox.config/config config
#'uxbox.db/pool pool})
(mount/start)))
(next)
(finally
(mount/stop)))))
@ -51,14 +60,12 @@
" FROM information_schema.tables "
" WHERE table_schema = 'public' "
" AND table_name != 'migrations';")]
@(db/with-atomic [conn db/pool]
(-> (db/query conn sql)
(p/then #(map :table-name %))
(p/then (fn [result]
(db/query-one conn (str "TRUNCATE "
(apply str (interpose ", " result))
" CASCADE;")))))))
(db/with-atomic [conn db/pool]
(let [result (->> (db/exec! conn [sql])
(map :table-name))]
(db/exec! conn [(str "TRUNCATE "
(apply str (interpose ", " result))
" CASCADE;")]))))
(try
(next)
(finally
@ -142,15 +149,8 @@
(defmacro try-on!
[expr]
`(try
(let [d# (p/deferred)]
(->> #(p/finally (p/do! ~expr)
(fn [v# e#]
(if e#
(p/reject! d# e#)
(p/resolve! d# v#))))
(vu/run-on-context! *context*))
(array-map :error nil
:result (deref d#)))
{:error nil
:result ~expr}
(catch Exception e#
{:error (handle-error e#)
:result nil})))
@ -211,3 +211,11 @@
[e code]
(let [data (ex-data e)]
(= code (:code data))))
(defn tempfile
[source]
(let [rsc (io/resource source)
tmp (fs/create-tempfile)]
(io/copy (io/file rsc)
(io/file tmp))
tmp))

4
backend/tests/uxbox/tests/test_emails.clj
View file

@ -20,10 +20,10 @@
(let [result (emails/render emails/register {:to "example@uxbox.io" :name "foo"})]
(t/is (map? result))
(t/is (contains? result :subject))
(t/is (contains? result :body))
(t/is (contains? result :content))
(t/is (contains? result :to))
(t/is (contains? result :reply-to))
(t/is (vector? (:body result)))))
(t/is (vector? (:content result)))))
;; (t/deftest email-sending-and-sendmail-job
;; (let [res @(emails/send! emails/register {:to "example@uxbox.io" :name "foo"})]

37
backend/tests/uxbox/tests/test_services_colors.clj
View file

@ -1,31 +1,28 @@
(ns uxbox.tests.test-services-colors
(:require
[clojure.test :as t]
[promesa.core :as p]
[datoteka.core :as fs]
[clojure.java.io :as io]
[uxbox.db :as db]
[uxbox.core :refer [system]]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[uxbox.tests.helpers :as th]
[vertx.core :as vc]))
[uxbox.tests.helpers :as th]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest color-libraries-crud
(let [id (uuid/next)
prof @(th/create-profile db/pool 2)
team (:default-team prof)]
(let [id (uuid/next)
prof (th/create-profile db/pool 2)
team-id (:default-team prof)]
(t/testing "create library"
(let [data {::sm/type :create-color-library
:name "sample library"
:profile-id (:id prof)
:team-id (:id team)
:team-id team-id
:id id}
out (th/try-on! (sm/handle data))]
@ -34,7 +31,7 @@
(let [result (:result out)]
(t/is (= id (:id result)))
(t/is (= (:id team) (:team-id result)))
(t/is (= team-id (:team-id result)))
(t/is (= (:name data) (:name result))))))
(t/testing "update library"
@ -44,23 +41,11 @@
:id id}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query libraries"
(let [data {::sq/type :color-libraries
:profile-id (:id prof)
:team-id (:id team)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:id team) (get-in result [0 :team-id])))
(t/is (= "renamed" (get-in result [0 :name]))))))
(t/is (= "renamed" (get-in result [:name]))))))
(t/testing "delete library"
(let [data {::sm/type :delete-color-library
@ -76,7 +61,7 @@
(t/testing "query libraries after delete"
(let [data {::sq/type :color-libraries
:profile-id (:id prof)
:team-id (:id team)}
:team-id team-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
@ -86,9 +71,9 @@
))
(t/deftest colors-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
coll @(th/create-color-library db/pool (:id team) 1)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
coll (th/create-color-library db/pool team-id 1)
color-id (uuid/next)]
(t/testing "upload color to library"

65
backend/tests/uxbox/tests/test_services_files.clj
View file

@ -1,42 +1,40 @@
(ns uxbox.tests.test-services-files
(:require
[clojure.test :as t]
[promesa.core :as p]
[datoteka.core :as fs]
[uxbox.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.core :refer [system]]
[uxbox.http :as http]
[uxbox.media :as media]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.tests.helpers :as th]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[vertx.util :as vu]))
[uxbox.util.storage :as ust]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest files-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
proj-id (:default-project prof)
file-id (uuid/next)
page-id (uuid/next)]
(t/testing "create file"
(let [data {::sm/type :create-file
:profile-id (:id prof)
:project-id (:id proj)
:project-id proj-id
:id file-id
:name "test file"}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:name data) (:name result)))
(t/is (= (:id proj) (:project-id result))))))
(t/is (= proj-id (:project-id result))))))
(t/testing "rename file"
(let [data {::sm/type :rename-file
@ -52,7 +50,7 @@
(t/testing "query files"
(let [data {::sq/type :files
:project-id (:id proj)
:project-id proj-id
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
@ -65,23 +63,6 @@
(t/is (= "new name" (get-in result [0 :name])))
(t/is (= 1 (count (get-in result [0 :pages])))))))
(t/testing "query single file with users"
(let [data {::sq/type :file-with-users
:profile-id (:id prof)
:id file-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= file-id (:id result)))
(t/is (= "new name" (:name result)))
(t/is (vector? (:pages result)))
(t/is (= 1 (count (:pages result))))
(t/is (vector? (:users result)))
(t/is (= (:id prof) (get-in result [:users 0 :id]))))))
(t/testing "query single file without users"
(let [data {::sq/type :file
:profile-id (:id prof)
@ -128,7 +109,7 @@
(t/testing "query list files after delete"
(let [data {::sq/type :files
:project-id (:id proj)
:project-id proj-id
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
@ -140,15 +121,15 @@
))
(t/deftest file-images-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)]
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
proj-id (:default-project prof)
file (th/create-file db/pool (:id prof) proj-id 1)]
(t/testing "upload file image"
(let [content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
(let [content {:filename "sample.jpg"
:tempfile (th/tempfile "uxbox/tests/_files/sample.jpg")
:content-type "image/jpeg"
:size 312043}
data {::sm/type :upload-file-image
:profile-id (:id prof)
@ -168,7 +149,7 @@
(t/is (= (:name data) (:name result)))
(t/is (= (:width data) (:width result)))
(t/is (= (:height data) (:height result)))
(t/is (= (:mtype content) (:mtype result)))
(t/is (= (:content-type content) (:mtype result)))
(t/is (string? (:path result)))
(t/is (string? (:uri result)))
@ -176,12 +157,12 @@
(t/is (string? (:thumb-uri result))))))
(t/testing "import from library"
(let [lib @(th/create-image-library db/pool (:id team) 1)
(let [lib (th/create-image-library db/pool team-id 1)
image-id (uuid/next)
content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
content {:filename "sample.jpg"
:tempfile (th/tempfile "uxbox/tests/_files/sample.jpg")
:content-type "image/jpeg"
:size 312043}
data {::sm/type :upload-image

38
backend/tests/uxbox/tests/test_services_icons.clj
View file

@ -1,31 +1,28 @@
(ns uxbox.tests.test-services-icons
(:require
[clojure.test :as t]
[promesa.core :as p]
[datoteka.core :as fs]
[clojure.java.io :as io]
[clojure.test :as t]
[datoteka.core :as fs]
[uxbox.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.core :refer [system]]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[uxbox.tests.helpers :as th]
[vertx.core :as vc]))
[uxbox.util.storage :as ust]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest icon-libraries-crud
(let [id (uuid/next)
prof @(th/create-profile db/pool 2)
team (:default-team prof)]
(let [id (uuid/next)
prof (th/create-profile db/pool 2)
team-id (:default-team prof)]
(t/testing "create library"
(let [data {::sm/type :create-icon-library
:name "sample library"
:profile-id (:id prof)
:team-id (:id team)
:team-id team-id
:id id}
out (th/try-on! (sm/handle data))]
@ -34,25 +31,28 @@
(let [result (:result out)]
(t/is (= id (:id result)))
(t/is (= (:id team) (:team-id result)))
(t/is (= team-id (:team-id result)))
(t/is (= (:name data) (:name result))))))
(t/testing "rename library"
(let [data {::sm/type :rename-icon-library
:name "renamed"
:profile-id (:id prof)
:team-id (:id team)
:team-id team-id
:id id}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(let [result (:result out)]
(t/is (= id (:id result)))
(t/is (= "renamed" (:name result))))))
(t/testing "query libraries"
(let [data {::sq/type :icon-libraries
:profile-id (:id prof)
:team-id (:id team)}
:team-id team-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
@ -77,7 +77,7 @@
(t/testing "query libraries after delete"
(let [data {::sq/type :icon-libraries
:profile-id (:id prof)
:team-id (:id team)}
:team-id team-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
@ -88,9 +88,9 @@
))
(t/deftest icons-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
coll @(th/create-icon-library db/pool (:id team) 1)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
coll (th/create-icon-library db/pool team-id 1)
icon-id (uuid/next)]
(t/testing "upload icon to library"

40
backend/tests/uxbox/tests/test_services_images.clj
View file

@ -1,31 +1,27 @@
(ns uxbox.tests.test-services-images
(:require
[clojure.test :as t]
[promesa.core :as p]
[datoteka.core :as fs]
[clojure.java.io :as io]
[uxbox.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.core :refer [system]]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[uxbox.tests.helpers :as th]
[vertx.core :as vc]))
[uxbox.util.storage :as ust]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest image-libraries-crud
(let [id (uuid/next)
prof @(th/create-profile db/pool 2)
team (:default-team prof)]
prof (th/create-profile db/pool 2)
team-id (:default-team prof)]
(t/testing "create library"
(let [data {::sm/type :create-image-library
:name "sample library"
:profile-id (:id prof)
:team-id (:id team)
:team-id team-id
:id id}
out (th/try-on! (sm/handle data))]
@ -33,7 +29,7 @@
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:id team) (:team-id result)))
(t/is (= team-id (:team-id result)))
(t/is (= (:name data) (:name result))))))
(t/testing "rename library"
@ -45,7 +41,10 @@
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(let [result (:result out)]
(t/is (= id (:id result)))
(t/is (= "renamed" (:name result))))))
(t/testing "query single library"
(let [data {::sq/type :image-library
@ -62,7 +61,7 @@
(t/testing "query libraries"
(let [data {::sq/type :image-libraries
:team-id (:id team)
:team-id team-id
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
@ -87,7 +86,7 @@
(t/testing "query libraries after delete"
(let [data {::sq/type :image-libraries
:profile-id (:id prof)
:team-id (:id team)}
:team-id team-id}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
@ -96,15 +95,15 @@
))
(t/deftest images-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
lib @(th/create-image-library db/pool (:id team) 1)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
lib (th/create-image-library db/pool team-id 1)
image-id (uuid/next)]
(t/testing "upload image to library"
(let [content {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:mtype "image/jpeg"
(let [content {:filename "sample.jpg"
:tempfile (th/tempfile "uxbox/tests/_files/sample.jpg")
:content-type "image/jpeg"
:size 312043}
data {::sm/type :upload-image
:id image-id
@ -127,7 +126,8 @@
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))
(t/is (string? (get-in out [:result :uri])))
(t/is (string? (get-in out [:result :thumb-uri])))))
(t/is (string? (get-in out [:result :thumb-uri])))
))
(t/testing "list images by library"
(let [data {::sq/type :images

28
backend/tests/uxbox/tests/test_services_pages.clj
View file

@ -15,10 +15,10 @@
(t/use-fixtures :each th/database-reset)
(t/deftest pages-crud
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
proj-id (:default-project prof)
file (th/create-file db/pool (:id prof) proj-id 1)
page-id (uuid/next)]
(t/testing "create page"
@ -48,7 +48,7 @@
:id page-id}
out (th/try-on! (sm/handle data))]
(th/print-result! out)
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (string? (:share-token result))))))
@ -93,10 +93,10 @@
))
(t/deftest update-page-data
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
proj-id (:default-project prof)
file (th/create-file db/pool (:id prof) proj-id 1)
page-id (uuid/next)]
(t/testing "create empty page"
@ -167,11 +167,11 @@
(t/deftest update-page-data-2
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)
page @(th/create-page db/pool (:id prof) (:id file) 1)]
(let [prof (th/create-profile db/pool 1)
team-id (:default-team prof)
proj-id (:default-project prof)
file (th/create-file db/pool (:id prof) proj-id 1)
page (th/create-page db/pool (:id prof) (:id file) 1)]
(t/testing "lagging changes"
(let [sid (uuid/next)
data {::sm/type :update-page

199
backend/tests/uxbox/tests/test_services_profile.clj
View file

@ -12,7 +12,6 @@
[clojure.test :as t]
[clojure.java.io :as io]
[mockery.core :refer [with-mocks]]
[promesa.core :as p]
[cuerdas.core :as str]
[datoteka.core :as fs]
[uxbox.db :as db]
@ -25,7 +24,7 @@
(t/use-fixtures :each th/database-reset)
(t/deftest profile-login
(let [profile @(th/create-profile db/pool 1)]
(let [profile (th/create-profile db/pool 1)]
(t/testing "failed"
(let [event {::sm/type :login
:email "profile1.test@nodomain.com"
@ -55,8 +54,7 @@
(t/deftest profile-query-and-manipulation
(let [profile @(th/create-profile db/pool 1)]
(let [profile (th/create-profile db/pool 1)]
(t/testing "query profile"
(let [data {::sq/type :profile
:profile-id (:id profile)}
@ -74,124 +72,133 @@
(let [data (assoc profile
::sm/type :update-profile
:fullname "Full Name"
:name "profile222"
:lang "en"
:theme "dark")
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:fullname data) (:fullname result)))
(t/is (= (:email data) (:email result)))
(t/is (= (:theme data) (:theme result)))
(t/is (not (contains? result :password))))))
(t/testing "update photo"
(let [data {::sm/type :update-profile-photo
:profile-id (:id profile)
:file {:name "sample.jpg"
:path "tests/uxbox/tests/_files/sample.jpg"
:size 123123
:mtype "image/jpeg"}}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:id profile) (:id result))))))))
(t/deftest profile-deletion
(let [prof @(th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)
page @(th/create-page db/pool (:id prof) (:id file) 1)]
(t/testing "try to delete profile not marked for deletion"
(let [params {:props {:profile-id (:id prof)}}
out (th/try-on! (uxbox.tasks.delete-profile/handler params))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query profile after delete"
(t/testing "query profile after update"
(let [data {::sq/type :profile
:profile-id (:id prof)}
:profile-id (:id profile)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:fullname prof) (:fullname result))))))
(t/is (= "Full Name" (:fullname result)))
(t/is (= "en" (:lang result)))
(t/is (= "dark" (:theme result))))))
(t/testing "mark profile for deletion"
(with-mocks
[mock {:target 'uxbox.tasks/schedule! :return nil}]
;; (t/testing "update photo"
;; (let [data {::sm/type :update-profile-photo
;; :profile-id (:id profile)
;; :file {:name "sample.jpg"
;; :path "tests/uxbox/tests/_files/sample.jpg"
;; :size 123123
;; :mtype "image/jpeg"}}
;; out (th/try-on! (sm/handle data))]
(let [data {::sm/type :delete-profile
:profile-id (:id prof)}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; check the mock
(let [mock (deref mock)
mock-params (second (:call-args mock))]
(t/is (true? (:called? mock)))
(t/is (= 1 (:call-count mock)))
(t/is (= "delete-profile" (:name mock-params)))
(t/is (= (:id prof) (get-in mock-params [:props :profile-id]))))))
;; (let [result (:result out)]
;; (t/is (= (:id profile) (:id result))))))
))
(t/testing "query files after profile soft deletion"
(let [data {::sq/type :files
:project-id (:id proj)
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= 1 (count (:result out))))))
(t/testing "try to delete profile marked for deletion"
(let [params {:props {:profile-id (:id prof)}}
out (th/try-on! (uxbox.tasks.delete-profile/handler params))]
#_(t/deftest profile-deletion
(let [prof (th/create-profile db/pool 1)
team (:default-team prof)
proj (:default-project prof)
file (th/create-file db/pool (:id prof) (:id proj) 1)
page (th/create-page db/pool (:id prof) (:id file) 1)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= (:id prof) (:result out)))))
;; (t/testing "try to delete profile not marked for deletion"
;; (let [params {:props {:profile-id (:id prof)}}
;; out (th/try-on! (uxbox.tasks.delete-profile/handler params))]
(t/testing "query profile after delete"
(let [data {::sq/type :profile
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (nil? (:result out)))))
;; (th/print-result! out)
;; (t/testing "query profile after delete"
;; (let [data {::sq/type :profile
;; :profile-id (:id prof)}
;; out (th/try-on! (sq/handle data))]
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :service-error))
(t/is (= (:name error-data) :uxbox.services.queries.profile/profile)))
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
(let [error (ex-cause (:error out))
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found)))))
;; (let [result (:result out)]
;; (t/is (= (:fullname prof) (:fullname result))))))
(t/testing "query files after profile permanent deletion"
(let [data {::sq/type :files
:project-id (:id proj)
:profile-id (:id prof)}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= 0 (count (:result out))))))))
;; (t/testing "mark profile for deletion"
;; (with-mocks
;; [mock {:target 'uxbox.tasks/schedule! :return nil}]
;; (let [data {::sm/type :delete-profile
;; :profile-id (:id prof)}
;; out (th/try-on! (sm/handle data))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (nil? (:result out))))
;; ;; check the mock
;; (let [mock (deref mock)
;; mock-params (second (:call-args mock))]
;; (t/is (true? (:called? mock)))
;; (t/is (= 1 (:call-count mock)))
;; (t/is (= "delete-profile" (:name mock-params)))
;; (t/is (= (:id prof) (get-in mock-params [:props :profile-id]))))))
;; (t/testing "query files after profile soft deletion"
;; (let [data {::sq/type :files
;; :project-id (:id proj)
;; :profile-id (:id prof)}
;; out (th/try-on! (sq/handle data))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (= 1 (count (:result out))))))
;; (t/testing "try to delete profile marked for deletion"
;; (let [params {:props {:profile-id (:id prof)}}
;; out (th/try-on! (uxbox.tasks.delete-profile/handler params))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (= (:id prof) (:result out)))))
;; (t/testing "query profile after delete"
;; (let [data {::sq/type :profile
;; :profile-id (:id prof)}
;; out (th/try-on! (sq/handle data))]
;; ;; (th/print-result! out)
;; (let [error (:error out)
;; error-data (ex-data error)]
;; (t/is (th/ex-info? error))
;; (t/is (= (:type error-data) :service-error))
;; (t/is (= (:name error-data) :uxbox.services.queries.profile/profile)))
;; (let [error (ex-cause (:error out))
;; error-data (ex-data error)]
;; (t/is (th/ex-info? error))
;; (t/is (= (:type error-data) :not-found)))))
;; (t/testing "query files after profile permanent deletion"
;; (let [data {::sq/type :files
;; :project-id (:id proj)
;; :profile-id (:id prof)}
;; out (th/try-on! (sq/handle data))]
;; ;; (th/print-result! out)
;; (t/is (nil? (:error out)))
;; (t/is (= 0 (count (:result out))))))
))
(t/deftest registration-domain-whitelist

5
backend/tests/uxbox/tests/test_services_projects.clj
View file

@ -13,8 +13,8 @@
(t/use-fixtures :each th/database-reset)
(t/deftest projects-crud
(let [prof @(th/create-profile db/pool 1)
team @(th/create-team db/pool (:id prof) 1)
(let [prof (th/create-profile db/pool 1)
team (th/create-team db/pool (:id prof) 1)
project-id (uuid/next)]
(t/testing "create a project"
@ -51,7 +51,6 @@
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result)))

21
backend/tests/uxbox/tests/test_services_viewer.clj
View file

@ -1,30 +1,27 @@
(ns uxbox.tests.test-services-viewer
(:require
[clojure.test :as t]
[promesa.core :as p]
[datoteka.core :as fs]
[uxbox.common.uuid :as uuid]
[uxbox.db :as db]
[uxbox.media :as media]
[uxbox.core :refer [system]]
[uxbox.http :as http]
[uxbox.media :as media]
[uxbox.services.mutations :as sm]
[uxbox.services.queries :as sq]
[uxbox.tests.helpers :as th]
[uxbox.util.storage :as ust]
[uxbox.common.uuid :as uuid]
[vertx.util :as vu]))
[uxbox.util.storage :as ust]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest retrieve-bundle
(let [prof @(th/create-profile db/pool 1)
prof2 @(th/create-profile db/pool 2)
team (:default-team prof)
proj (:default-project prof)
(let [prof (th/create-profile db/pool 1)
prof2 (th/create-profile db/pool 2)
team-id (:default-team prof)
proj-id (:default-project prof)
file @(th/create-file db/pool (:id prof) (:id proj) 1)
page @(th/create-page db/pool (:id prof) (:id file) 1)
file (th/create-file db/pool (:id prof) proj-id 1)
page (th/create-page db/pool (:id prof) (:id file) 1)
token (atom nil)]

13
backend/vendor/vertx/.gitignore vendored
View file

@ -1,13 +0,0 @@
/target
/classes
/checkouts
pom.xml.asc
*.jar
*.class
/.lein-*
/.nrepl-port
/*-init.clj
/out
/repl
/.cpcache
/.rebel*

373
backend/vendor/vertx/LICENSE vendored
View file

@ -1,373 +0,0 @@
Mozilla Public License Version 2.0
==================================
1. Definitions
--------------
1.1. "Contributor"
means each individual or legal entity that creates, contributes to
the creation of, or owns Covered Software.
1.2. "Contributor Version"
means the combination of the Contributions of others (if any) used
by a Contributor and that particular Contributor's Contribution.
1.3. "Contribution"
means Covered Software of a particular Contributor.
1.4. "Covered Software"
means Source Code Form to which the initial Contributor has attached
the notice in Exhibit A, the Executable Form of such Source Code
Form, and Modifications of such Source Code Form, in each case
including portions thereof.
1.5. "Incompatible With Secondary Licenses"
means
(a) that the initial Contributor has attached the notice described
in Exhibit B to the Covered Software; or
(b) that the Covered Software was made available under the terms of
version 1.1 or earlier of the License, but not also under the
terms of a Secondary License.
1.6. "Executable Form"
means any form of the work other than Source Code Form.
1.7. "Larger Work"
means a work that combines Covered Software with other material, in
a separate file or files, that is not Covered Software.
1.8. "License"
means this document.
1.9. "Licensable"
means having the right to grant, to the maximum extent possible,
whether at the time of the initial grant or subsequently, any and
all of the rights conveyed by this License.
1.10. "Modifications"
means any of the following:
(a) any file in Source Code Form that results from an addition to,
deletion from, or modification of the contents of Covered
Software; or
(b) any new file in Source Code Form that contains any Covered
Software.
1.11. "Patent Claims" of a Contributor
means any patent claim(s), including without limitation, method,
process, and apparatus claims, in any patent Licensable by such
Contributor that would be infringed, but for the grant of the
License, by the making, using, selling, offering for sale, having
made, import, or transfer of either its Contributions or its
Contributor Version.
1.12. "Secondary License"
means either the GNU General Public License, Version 2.0, the GNU
Lesser General Public License, Version 2.1, the GNU Affero General
Public License, Version 3.0, or any later versions of those
licenses.
1.13. "Source Code Form"
means the form of the work preferred for making modifications.
1.14. "You" (or "Your")
means an individual or a legal entity exercising rights under this
License. For legal entities, "You" includes any entity that
controls, is controlled by, or is under common control with You. For
purposes of this definition, "control" means (a) the power, direct
or indirect, to cause the direction or management of such entity,
whether by contract or otherwise, or (b) ownership of more than
fifty percent (50%) of the outstanding shares or beneficial
ownership of such entity.
2. License Grants and Conditions
--------------------------------
2.1. Grants
Each Contributor hereby grants You a world-wide, royalty-free,
non-exclusive license:
(a) under intellectual property rights (other than patent or trademark)
Licensable by such Contributor to use, reproduce, make available,
modify, display, perform, distribute, and otherwise exploit its
Contributions, either on an unmodified basis, with Modifications, or
as part of a Larger Work; and
(b) under Patent Claims of such Contributor to make, use, sell, offer
for sale, have made, import, and otherwise transfer either its
Contributions or its Contributor Version.
2.2. Effective Date
The licenses granted in Section 2.1 with respect to any Contribution
become effective for each Contribution on the date the Contributor first
distributes such Contribution.
2.3. Limitations on Grant Scope
The licenses granted in this Section 2 are the only rights granted under
this License. No additional rights or licenses will be implied from the
distribution or licensing of Covered Software under this License.
Notwithstanding Section 2.1(b) above, no patent license is granted by a
Contributor:
(a) for any code that a Contributor has removed from Covered Software;
or
(b) for infringements caused by: (i) Your and any other third party's
modifications of Covered Software, or (ii) the combination of its
Contributions with other software (except as part of its Contributor
Version); or
(c) under Patent Claims infringed by Covered Software in the absence of
its Contributions.
This License does not grant any rights in the trademarks, service marks,
or logos of any Contributor (except as may be necessary to comply with
the notice requirements in Section 3.4).
2.4. Subsequent Licenses
No Contributor makes additional grants as a result of Your choice to
distribute the Covered Software under a subsequent version of this
License (see Section 10.2) or under the terms of a Secondary License (if
permitted under the terms of Section 3.3).
2.5. Representation
Each Contributor represents that the Contributor believes its
Contributions are its original creation(s) or it has sufficient rights
to grant the rights to its Contributions conveyed by this License.
2.6. Fair Use
This License is not intended to limit any rights You have under
applicable copyright doctrines of fair use, fair dealing, or other
equivalents.
2.7. Conditions
Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
in Section 2.1.
3. Responsibilities
-------------------
3.1. Distribution of Source Form
All distribution of Covered Software in Source Code Form, including any
Modifications that You create or to which You contribute, must be under
the terms of this License. You must inform recipients that the Source
Code Form of the Covered Software is governed by the terms of this
License, and how they can obtain a copy of this License. You may not
attempt to alter or restrict the recipients' rights in the Source Code
Form.
3.2. Distribution of Executable Form
If You distribute Covered Software in Executable Form then:
(a) such Covered Software must also be made available in Source Code
Form, as described in Section 3.1, and You must inform recipients of
the Executable Form how they can obtain a copy of such Source Code
Form by reasonable means in a timely manner, at a charge no more
than the cost of distribution to the recipient; and
(b) You may distribute such Executable Form under the terms of this
License, or sublicense it under different terms, provided that the
license for the Executable Form does not attempt to limit or alter
the recipients' rights in the Source Code Form under this License.
3.3. Distribution of a Larger Work
You may create and distribute a Larger Work under terms of Your choice,
provided that You also comply with the requirements of this License for
the Covered Software. If the Larger Work is a combination of Covered
Software with a work governed by one or more Secondary Licenses, and the
Covered Software is not Incompatible With Secondary Licenses, this
License permits You to additionally distribute such Covered Software
under the terms of such Secondary License(s), so that the recipient of
the Larger Work may, at their option, further distribute the Covered
Software under the terms of either this License or such Secondary
License(s).
3.4. Notices
You may not remove or alter the substance of any license notices
(including copyright notices, patent notices, disclaimers of warranty,
or limitations of liability) contained within the Source Code Form of
the Covered Software, except that You may alter any license notices to
the extent required to remedy known factual inaccuracies.
3.5. Application of Additional Terms
You may choose to offer, and to charge a fee for, warranty, support,
indemnity or liability obligations to one or more recipients of Covered
Software. However, You may do so only on Your own behalf, and not on
behalf of any Contributor. You must make it absolutely clear that any
such warranty, support, indemnity, or liability obligation is offered by
You alone, and You hereby agree to indemnify every Contributor for any
liability incurred by such Contributor as a result of warranty, support,
indemnity or liability terms You offer. You may include additional
disclaimers of warranty and limitations of liability specific to any
jurisdiction.
4. Inability to Comply Due to Statute or Regulation
---------------------------------------------------
If it is impossible for You to comply with any of the terms of this
License with respect to some or all of the Covered Software due to
statute, judicial order, or regulation then You must: (a) comply with
the terms of this License to the maximum extent possible; and (b)
describe the limitations and the code they affect. Such description must
be placed in a text file included with all distributions of the Covered
Software under this License. Except to the extent prohibited by statute
or regulation, such description must be sufficiently detailed for a
recipient of ordinary skill to be able to understand it.
5. Termination
--------------
5.1. The rights granted under this License will terminate automatically
if You fail to comply with any of its terms. However, if You become
compliant, then the rights granted under this License from a particular
Contributor are reinstated (a) provisionally, unless and until such
Contributor explicitly and finally terminates Your grants, and (b) on an
ongoing basis, if such Contributor fails to notify You of the
non-compliance by some reasonable means prior to 60 days after You have
come back into compliance. Moreover, Your grants from a particular
Contributor are reinstated on an ongoing basis if such Contributor
notifies You of the non-compliance by some reasonable means, this is the
first time You have received notice of non-compliance with this License
from such Contributor, and You become compliant prior to 30 days after
Your receipt of the notice.
5.2. If You initiate litigation against any entity by asserting a patent
infringement claim (excluding declaratory judgment actions,
counter-claims, and cross-claims) alleging that a Contributor Version
directly or indirectly infringes any patent, then the rights granted to
You by any and all Contributors for the Covered Software under Section
2.1 of this License shall terminate.
5.3. In the event of termination under Sections 5.1 or 5.2 above, all
end user license agreements (excluding distributors and resellers) which
have been validly granted by You or Your distributors under this License
prior to termination shall survive termination.
************************************************************************
* *
* 6. Disclaimer of Warranty *
* ------------------------- *
* *
* Covered Software is provided under this License on an "as is" *
* basis, without warranty of any kind, either expressed, implied, or *
* statutory, including, without limitation, warranties that the *
* Covered Software is free of defects, merchantable, fit for a *
* particular purpose or non-infringing. The entire risk as to the *
* quality and performance of the Covered Software is with You. *
* Should any Covered Software prove defective in any respect, You *
* (not any Contributor) assume the cost of any necessary servicing, *
* repair, or correction. This disclaimer of warranty constitutes an *
* essential part of this License. No use of any Covered Software is *
* authorized under this License except under this disclaimer. *
* *
************************************************************************
************************************************************************
* *
* 7. Limitation of Liability *
* -------------------------- *
* *
* Under no circumstances and under no legal theory, whether tort *
* (including negligence), contract, or otherwise, shall any *
* Contributor, or anyone who distributes Covered Software as *
* permitted above, be liable to You for any direct, indirect, *
* special, incidental, or consequential damages of any character *
* including, without limitation, damages for lost profits, loss of *
* goodwill, work stoppage, computer failure or malfunction, or any *
* and all other commercial damages or losses, even if such party *
* shall have been informed of the possibility of such damages. This *
* limitation of liability shall not apply to liability for death or *
* personal injury resulting from such party's negligence to the *
* extent applicable law prohibits such limitation. Some *
* jurisdictions do not allow the exclusion or limitation of *
* incidental or consequential damages, so this exclusion and *
* limitation may not apply to You. *
* *
************************************************************************
8. Litigation
-------------
Any litigation relating to this License may be brought only in the
courts of a jurisdiction where the defendant maintains its principal
place of business and such litigation shall be governed by laws of that
jurisdiction, without reference to its conflict-of-law provisions.
Nothing in this Section shall prevent a party's ability to bring
cross-claims or counter-claims.
9. Miscellaneous
----------------
This License represents the complete agreement concerning the subject
matter hereof. If any provision of this License is held to be
unenforceable, such provision shall be reformed only to the extent
necessary to make it enforceable. Any law or regulation which provides
that the language of a contract shall be construed against the drafter
shall not be used to construe this License against a Contributor.
10. Versions of the License
---------------------------
10.1. New Versions
Mozilla Foundation is the license steward. Except as provided in Section
10.3, no one other than the license steward has the right to modify or
publish new versions of this License. Each version will be given a
distinguishing version number.
10.2. Effect of New Versions
You may distribute the Covered Software under the terms of the version
of the License under which You originally received the Covered Software,
or under the terms of any subsequent version published by the license
steward.
10.3. Modified Versions
If you create software not governed by this License, and you want to
create a new license for such software, you may create and use a
modified version of this License if you rename the license and remove
any references to the name of the license steward (except to note that
such modified license differs from this License).
10.4. Distributing Source Code Form that is Incompatible With Secondary
Licenses
If You choose to distribute Source Code Form that is Incompatible With
Secondary Licenses under the terms of this version of the License, the
notice described in Exhibit B of this License must be attached.
Exhibit A - Source Code Form License Notice
-------------------------------------------
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/.
If it is not possible or desirable to put the notice in a particular
file, then You may include the notice in a location (such as a LICENSE
file in a relevant directory) where a recipient would be likely to look
for such a notice.
You may add additional accurate notices of copyright ownership.
Exhibit B - "Incompatible With Secondary Licenses" Notice
---------------------------------------------------------
This Source Code Form is "Incompatible With Secondary Licenses", as
defined by the Mozilla Public License, v. 2.0.

250
backend/vendor/vertx/README.md vendored
View file

@ -1,250 +0,0 @@
# vertx-clojure
A lightweight clojure adapter for vertx toolkit.
- **STATUS**: *alpha*, in design and prototyping phase.
- **AUDIENCE**: this is not a vertx documentation, this readme intends
to explain only the clojure api
Example code on `resources/user.clj` file.
## Install
Using `deps.edn`:
```clojure
vertx-clojure/vertx {:mvn/version "0.0.0-SNAPSHOT"}
```
Using Leiningen:
```clojure
[vertx-clojure/vertx "0.0.0-SNAPSHOT"]
```
## User Guide
### Verticles
Verticles is the basic "unit of execution" in the vertx toolkit. The
concept is very simular to actors with the exception that a verticle
does not have a inbox, and verticles communicates with other verticles
or with the rest of the world using **eventbus**.
For create a verticle, you will need to create first a system instance
(a name that we give to the `Vertx` instance):
```clojure
(require '[vertx.core :as vc])
(def system (vc/system))
```
Then, you can proceed to create a verticle. A verticle concist on
three functions: `on-start`, `on-stop` and `on-error` (where the
`on-start` is mandatory the rest optional).
Lets define a dummy verticle that just prints hello world on start
callback:
```clojure
(defn on-start
[ctx]
(println "Hello world"))
(def dummy-verticle
(vc/verticle {:on-start on-start}))
```
The `dummy-verticle` is a verticle factory, nothing is running at this
momment. For run the verticle we need to deploy it using the
previously created `system` instance:
```clojure
(vc/deploy! system dummy-verticle)
```
The `deploy!` return value is a `CompletionStage` so you can deref it
like a regular `Future` or use **funcool/promesa** for chain more
complex transformations. The return value implements `AutoCloseable`
that will allow to undeploy the verticle.
The `deploy!` function also accepts an additional parameter for
options, and at this momment it only accepts as single option:
- `:instances` - number of instances to launch of the same verticle.
- `:worker` - use worker thread pool or the default event-loop.
### Event Bus
The **eventbus** is the central communication system for verticles. It
has different patterns of communication. On this documentation we will
cover the: `publish/subscribe` and `request/reply`.
Lets define a simple echo verticle:
```clojure
(require '[vertx.eventbus :as ve])
(defn on-message
[msg]
(:body msg))
(defn on-start
[ctx]
(vc/consumer ctx "test.echo" on-message))
(def echo-verticle
(vc/verticle {:on-start on-start}))
```
And then, lets deploy 4 instances of it:
```clojure
(vc/deploy! system echo-verticle {:instances 4})
```
Now, depending on how you send the messages to the "test.echo" topic,
the message will be send to a single instance of will be broadcasted
to all verticle instances subscribed to it.
To send a message and expect a response we need to use the
`ve/request!` function:
```clojure
@(ve/request! system {:foo "bar"})
;; => #vertx.eventbus.Msg{:body {:foo "bar"}}
```
The return value of `on-message` callback will be used as a reply and
it can be any plain value or a `CompletionStage`.
When you want to send a message but you don't need the return value,
there is the `ve/send!` function. And finally, if you want to send a
message to all instances subscribed to a topic, you will need to use
the `ve/publish!` function.
### Http Server (vertx.http)
**STATUS**: pre-alpha: experimental & incomplete
This part will explain the low-level api for the http server. It is
intended to be used as a building block for a more higher-level api or
when you know that you exactly need for a performance sensitive
applications.
The `vertx.http` exposes two main functions `handler` and
`server`. Lets start creating a simple "hello world" http server:
```
(require '[vertx.http :as vh])
(defn hello-world-handler
[req]
{:status 200
:body "Hello world\n"})
(defn on-start
[ctx]
(vh/server {:handler (vh/handler hello-world-handler)
:port 2021}))
(->> (vc/verticle {:on-start on-start})
(vc/deploy! system))
```
NOTE: you can start the server without creating a verticle but you
will loss the advantage of scaling (using verticle instances
parameter).
The `req` object is a plain map with the following keys:
- `:method` the HTTP method.
- `:path` the PATH of the requested URI.
- `:headers` a map with string lower-cased keys of headers.
- `:vertx.http/request` the underlying vertx request instance.
- `:vertx.http/response` the underlying vertx response instance.
And the response object to the ring response, it can contain
`:status`, `:body` and `:headers`.
**WARNING:** at this moment there are no way to obtain directly the
body of request using clojure api, this is in **design** phase and we
need to think how to expose it correctly without constraint too much
the user code (if you have suggestions, please open an issue).
**NOTE**: If you want completly bypass the clojure api, pass a vertx
`Handler` instance to server instead of using
`vertx.http/handler`. There is the `vertx.util/fn->handler` helper
that converts a plain clojure function into raw `Handler` instance.
### Web Server (vertx.web)
**STATUS**: alpha
This part will explain the higher-level http/web server api. It is a
general purpose with more clojure friendly api. It uses
`reitit-core`for the routing and `sieppari` for interceptors.
Lets start with a complete example:
```clojure
(require '[vertx.http :as vh])
(require '[vertx.web :as vw])
(require '[vertx.web.middleware :as vwm])
(defn hello-world-handler
[req]
{:status 200
:body "Hello world!\n"})
(defn on-start
[ctx]
(let [routes [["/" {:middleware [vwm/cookies]
:handler hello-world-handler
:method :get}]]
handler (vw/handler ctx
(vw/assets "/static/*" {:root "resources/public/static"})
(vw/router routes))]
(vh/server {:handler handler
:port 2022})))
(->> (vc/verticle {:on-start on-start})
(vc/deploy! system))
```
The routes are defined using `reitit-core`. The request object is very
similar to the one explained in `vertx.http`.
The main difference with `vertx.http` is that the handler is called
when the body is ready to be used and is available under `:body`
keyword on the request.
All additional features such that reading the query/form params,
parse/write cookies, cors and file uploads are provided with additional middleware
wrappers:
- `vertx.web.middleware/uploads` parses the vertx uploaded file data
structure and expose it as clojure maps under `:uploads` key.
- `vertx.web.middleware/params` parses the query string and form
params in the body if the content-type is appropriate and exposes
them under `:params`.
- `vertx.web.middleware/cors` properly sets the CORS headers.
- `vertx.web.middleware/cookies` handles the cookies reading from
the request and cookies writing from the response.
## License ##
```
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/.
```

35
backend/vendor/vertx/deps.edn vendored
View file

@ -1,35 +0,0 @@
{:deps
{org.clojure/tools.logging {:mvn/version "0.5.0"}
funcool/promesa {:mvn/version "5.0.0"}
metosin/reitit-core {:mvn/version "0.3.10"}
org.clojure/core.async {:mvn/version "1.1.587"}
io.vertx/vertx-core {:mvn/version "4.0.0-milestone4"}
io.vertx/vertx-web {:mvn/version "4.0.0-milestone4"}
io.vertx/vertx-web-client {:mvn/version "4.0.0-milestone4"}}
:paths ["src" "resources"]
:aliases
{:dev
{:extra-deps
{com.bhauman/rebel-readline {:mvn/version "0.1.4"}
metosin/jsonista {:mvn/version "0.2.5"}
mount/mount {:mvn/version "0.1.16"}
org.clojure/clojure {:mvn/version "1.10.1"}
io.netty/netty-transport-native-epoll {:mvn/version "4.1.39.Final"}
environ/environ {:mvn/version "1.1.0"}
metosin/pohjavirta {:mvn/version "0.0.1-alpha5"}
org.clojure/tools.namespace {:mvn/version "0.3.1"}}
:extra-paths ["test"]}
:repl
{:main-opts ["-m" "rebel-readline.main"]}
:jar
{:extra-deps {seancorfield/depstar {:mvn/version "0.3.4"}}
:main-opts ["-m" "hf.depstar.jar", "target/vertx.jar"]}
:ancient
{:main-opts ["-m" "deps-ancient.deps-ancient"]
:extra-deps {deps-ancient {:mvn/version "RELEASE"}}}
}}

2
backend/vendor/vertx/mvn-upload.sh vendored
View file

@ -1,2 +0,0 @@
#!/bin/sh
mvn deploy:deploy-file -Dfile=target/vertx.jar -DpomFile=pom.xml -DrepositoryId=clojars -Durl=https://clojars.org/repo/

67
backend/vendor/vertx/pom.xml vendored
View file

@ -1,67 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<project xmlns="http://maven.apache.org/POM/4.0.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 http://maven.apache.org/xsd/maven-4.0.0.xsd">
<modelVersion>4.0.0</modelVersion>
<groupId>vertx-clojure</groupId>
<artifactId>vertx</artifactId>
<version>0.0.0-SNAPSHOT</version>
<name>vertx-clojure</name>
<description>Vert.x adapter for Clojure</description>
<url>https://github.com/funcool/vertx-clojure</url>
<scm>
<connection>scm:git:git://github.com/vertx-clojure/vertx.git</connection>
<developerConnection>scm:git:ssh://git@github.com/vertx-clojure/vertx.git</developerConnection>
<url>https://github.com/vertx-clojure/vertx</url>
<tag>master</tag>
</scm>
<build>
<sourceDirectory>src</sourceDirectory>
</build>
<dependencies>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>clojure</artifactId>
<version>1.10.1</version>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>tools.logging</artifactId>
<version>0.5.0</version>
</dependency>
<dependency>
<groupId>io.vertx</groupId>
<artifactId>vertx-core</artifactId>
<version>4.0.0-milestone4</version>
</dependency>
<dependency>
<groupId>metosin</groupId>
<artifactId>reitit-core</artifactId>
<version>0.3.10</version>
</dependency>
<dependency>
<groupId>io.vertx</groupId>
<artifactId>vertx-web</artifactId>
<version>4.0.0-milestone4</version>
</dependency>
<dependency>
<groupId>funcool</groupId>
<artifactId>promesa</artifactId>
<version>5.0.0</version>
</dependency>
<dependency>
<groupId>io.vertx</groupId>
<artifactId>vertx-web-client</artifactId>
<version>4.0.0-milestone4</version>
</dependency>
<dependency>
<groupId>org.clojure</groupId>
<artifactId>core.async</artifactId>
<version>0.7.559</version>
</dependency>
</dependencies>
<repositories>
<repository>
<id>clojars</id>
<url>https://repo.clojars.org/</url>
</repository>
</repositories>
</project>

201
backend/vendor/vertx/src/vertx/core.clj vendored
View file

@ -1,201 +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 vertx.core
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[vertx.eventbus :as vxe]
[vertx.impl :as impl])
(:import
io.vertx.core.AsyncResult
io.vertx.core.Context
io.vertx.core.DeploymentOptions
io.vertx.core.Handler
io.vertx.core.Promise
io.vertx.core.Verticle
io.vertx.core.Vertx
io.vertx.core.VertxOptions
java.util.function.Supplier))
(declare opts->deployment-options)
(declare opts->vertx-options)
(declare build-verticle)
(declare build-actor)
(declare build-disposable)
;; --- Public Api
(s/def :vertx.core$system/threads pos?)
(s/def :vertx.core$system/on-error fn?)
(s/def ::system-options
(s/keys :opt-un [:vertx.core$system/threads
:vertx.core$system/on-error]))
(defn system
"Creates a new vertx actor system instance."
([] (system {}))
([options]
(s/assert ::system-options options)
(let [^VertxOptions opts (opts->vertx-options options)
^Vertx vsm (Vertx/vertx opts)]
(vxe/configure! vsm opts)
vsm)))
(defn stop
[^Vertx o]
(.close o))
(s/def :vertx.core$verticle/on-start fn?)
(s/def :vertx.core$verticle/on-stop fn?)
(s/def :vertx.core$verticle/on-error fn?)
(s/def ::verticle-options
(s/keys :req-un [:vertx.core$verticle/on-start]
:opt-un [:vertx.core$verticle/on-stop
:vertx.core$verticle/on-error]))
(defn verticle
"Creates a verticle instance (factory)."
[options]
(s/assert ::verticle-options options)
^{::verticle true ::options options}
(reify
Supplier
(get [_] (build-verticle options))))
(defn verticle?
"Return `true` if `v` is instance of `IVerticleFactory`."
[v]
(true? (::verticle (meta v))))
(s/def :vertx.core$actor/on-message fn?)
(s/def ::actor-options
(s/keys :req-un [:vertx.core$actor/on-message]
:opt-un [:vertx.core$verticle/on-start
:vertx.core$verticle/on-error
:vertx.core$verticle/on-stop]))
(defn actor
"A shortcut for create a verticle instance (factory) that consumes a
specific topic."
[topic options]
(s/assert string? topic)
(s/assert ::actor-options options)
^{::verticle true ::options options ::topic topic}
(reify
Supplier
(get [_] (build-actor topic options))))
(s/def :vertx.core$deploy/instances pos?)
(s/def :vertx.core$deploy/worker boolean?)
(s/def ::deploy-options
(s/keys :opt-un [:vertx.core$deploy/worker
:vertx.core$deploy/instances]))
(defn deploy!
"Deploy a verticle."
([vsm supplier] (deploy! vsm supplier nil))
([vsm supplier options]
(s/assert verticle? supplier)
(s/assert ::deploy-options options)
(let [d (p/deferred)
o (opts->deployment-options options)]
(.deployVerticle ^Vertx vsm
^Supplier supplier
^DeploymentOptions o
^Handler (impl/deferred->handler d))
(p/then' d (fn [id] (build-disposable vsm id))))))
(defn undeploy!
"Undeploy the verticle, this function should be rarelly used because
the easiest way to undeplo is executin the callable returned by
`deploy!` function."
[vsm id]
(s/assert string? id)
(let [d (p/deferred)]
(.undeploy ^Vertx (impl/resolve-system vsm)
^String id
^Handler (impl/deferred->handler d))
d))
;; --- Impl
(defn- build-verticle
[{:keys [on-start on-stop on-error]
:or {on-error (constantly nil)
on-stop (constantly nil)}
:as options}]
(let [vsm (volatile! nil)
ctx (volatile! nil)
lst (volatile! nil)]
(reify Verticle
(init [_ instance context]
(vreset! vsm instance)
(vreset! ctx context))
(getVertx [_] @vsm)
(^void start [_ ^Promise o]
(-> (p/do! (on-start @ctx))
(p/handle (fn [state error]
(if error
(do
(.fail o ^Throwable error)
(on-error @ctx error))
(do
(when (map? state)
(vswap! lst merge state))
(.complete o)))))))
(^void stop [_ ^Promise o]
(p/handle (p/do! (on-stop @ctx @lst))
(fn [_ err]
(if err
(do (on-error err)
(.fail o ^Throwable err))
(.complete o))))))))
(defn- build-actor
[topic {:keys [on-message on-error on-stop on-start]
:or {on-error (constantly nil)
on-start (constantly {})
on-stop (constantly nil)}}]
(letfn [(-on-start [ctx]
(let [state (on-start ctx)
state (if (map? state) state {})
consumer (vxe/consumer ctx topic on-message)]
(assoc state ::consumer consumer)))]
(build-verticle {:on-error on-error
:on-stop on-stop
:on-start -on-start})))
(defn- build-disposable
[vsm id]
(reify
clojure.lang.IDeref
(deref [_] id)
clojure.lang.IFn
(invoke [_] (undeploy! vsm id))
java.io.Closeable
(close [_]
@(undeploy! vsm id))))
(defn- opts->deployment-options
[{:keys [instances worker]}]
(let [opts (DeploymentOptions.)]
(when instances (.setInstances opts (int instances)))
(when worker (.setWorker opts worker))
opts))
(defn- opts->vertx-options
[{:keys [threads worker-threads on-error]}]
(let [opts (VertxOptions.)]
(when threads (.setEventLoopPoolSize opts (int threads)))
(when worker-threads (.setWorkerPoolSize opts (int worker-threads)))
#_(when on-error (.exceptionHandler opts (impl/fn->handler on-error)))
opts))

125
backend/vendor/vertx/src/vertx/eventbus.clj vendored
View file

@ -1,125 +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 vertx.eventbus
(:require [promesa.core :as p]
[vertx.impl :as impl])
(:import
io.vertx.core.Vertx
io.vertx.core.Handler
io.vertx.core.Context
io.vertx.core.eventbus.Message
io.vertx.core.eventbus.MessageConsumer
io.vertx.core.eventbus.DeliveryOptions
io.vertx.core.eventbus.EventBus
io.vertx.core.eventbus.MessageCodec
java.util.function.Supplier))
(declare opts->delivery-opts)
(declare resolve-eventbus)
(declare build-message-codec)
(declare build-message)
;; --- Public Api
(defn consumer
[vsm topic f]
(let [^EventBus bus (resolve-eventbus vsm)
^MessageConsumer consumer (.consumer bus ^String topic)]
(.handler consumer (reify Handler
(handle [_ msg]
(.pause consumer)
(-> (p/do! (f vsm (build-message msg)))
(p/handle (fn [res err]
(.resume consumer)
(.reply msg (or res err)
(opts->delivery-opts {}))))))))
(reify java.lang.AutoCloseable
(close [it]
(.unregister consumer)))))
(defn publish!
([vsm topic msg] (publish! vsm topic msg {}))
([vsm topic msg opts]
(let [bus (resolve-eventbus vsm)
opts (opts->delivery-opts opts)]
(.publish ^EventBus bus
^String topic
^Object msg
^DeliveryOptions opts)
nil)))
(defn send!
([vsm topic msg] (send! vsm topic msg {}))
([vsm topic msg opts]
(let [bus (resolve-eventbus vsm)
opts (opts->delivery-opts opts)]
(.send ^EventBus bus
^String topic
^Object msg
^DeliveryOptions opts)
nil)))
(defn request!
([vsm topic msg] (request! vsm topic msg {}))
([vsm topic msg opts]
(let [bus (resolve-eventbus vsm)
opts (opts->delivery-opts opts)
d (p/deferred)]
(.request ^EventBus bus
^String topic
^Object msg
^DeliveryOptions opts
^Handler (impl/deferred->handler d))
(p/then' d build-message))))
(defn configure!
[vsm opts]
(let [^EventBus bus (resolve-eventbus vsm)]
(.registerCodec bus (build-message-codec))))
(defrecord Msg [body])
(defn message?
[v]
(instance? Msg v))
;; --- Impl
(defn- resolve-eventbus
[o]
(cond
(instance? Vertx o) (.eventBus ^Vertx o)
(instance? Context o) (resolve-eventbus (.owner ^Context o))
(instance? EventBus o) o
:else (throw (ex-info "unexpected argument" {}))))
(defn- build-message-codec
[]
;; TODO: implement the wire encode/decode using transit+msgpack
(reify MessageCodec
(encodeToWire [_ buffer data])
(decodeFromWire [_ pos buffer])
(transform [_ data] data)
(name [_] "clj:msgpack")
(^byte systemCodecID [_] (byte -1))))
(defn- build-message
[^Message msg]
(let [metadata {::reply-to (.replyAddress msg)
::send? (.isSend msg)
::address (.address msg)}
body (.body msg)]
(Msg. body metadata nil)))
(defn- opts->delivery-opts
[{:keys [codec local?]}]
(let [^DeliveryOptions opts (DeliveryOptions.)]
(.setCodecName opts (or codec "clj:msgpack"))
(when local? (.setLocalOnly opts true))
opts))

154
backend/vendor/vertx/src/vertx/http.clj vendored
View file

@ -1,154 +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 vertx.http
"Enables `raw` access to the http facilites of vertx. If you want more
clojure idiomatic api, refer to the `vertx.web` namespace."
(:require [clojure.spec.alpha :as s]
[promesa.core :as p]
[vertx.util :as util]
[vertx.impl :as impl])
(:import
java.util.Map$Entry
clojure.lang.MapEntry
io.vertx.core.Vertx
io.vertx.core.Verticle
io.vertx.core.Handler
io.vertx.core.Future
io.vertx.core.MultiMap
io.vertx.core.Context
io.vertx.core.buffer.Buffer
io.vertx.core.http.HttpServer
io.vertx.core.http.HttpServerRequest
io.vertx.core.http.HttpServerResponse
io.vertx.core.http.HttpServerOptions
io.vertx.core.http.ServerWebSocket))
(declare opts->http-server-options)
(declare resolve-handler)
;; --- Public Api
(declare -handle-response)
(declare -handle-body)
(defn ->headers
[^MultiMap headers]
(let [it (.iterator ^MultiMap headers)]
(loop [m (transient {})]
(if (.hasNext it)
(let [^Map$Entry me (.next it)
key (.toLowerCase ^String (.getKey me))
val (.getValue me)]
(recur (assoc! m key val)))
(persistent! m)))))
(defn- ->request
[^HttpServerRequest request]
{:method (-> request .rawMethod .toLowerCase keyword)
:path (.path request)
:headers (->headers (.headers request))
::request request
::response (.response request)})
(defn handler
[vsm f]
(reify Handler
(handle [this request]
(let [ctx (->request request)]
(-handle-response (f ctx) ctx)))))
(s/def :vertx.http/handler
(s/or :fn fn? :handler #(instance? Handler %)))
(s/def :vertx.http/host string?)
(s/def :vertx.http/port pos?)
(s/def ::server-options
(s/keys :req-un [:vertx.http/handler]
:opt-un [:vertx.http/host
:vertx.http/port]))
(defn server
"Starts a vertx http server."
[vsm {:keys [handler] :as options}]
(s/assert ::server-options options)
(let [^Vertx vsm (impl/resolve-system vsm)
^HttpServerOptions opts (opts->http-server-options options)
^HttpServer srv (.createHttpServer vsm opts)
^Handler handler (resolve-handler handler)]
(doto srv
(.requestHandler handler)
(.listen))
srv))
;; --- Impl
(defn- opts->http-server-options
[{:keys [host port]}]
(let [opts (HttpServerOptions.)]
(.setReuseAddress opts true)
(.setReusePort opts true)
(.setTcpNoDelay opts true)
(.setTcpFastOpen opts true)
(when host (.setHost opts ^String host))
(when port (.setPort opts ^int port))
opts))
(defn- resolve-handler
[handler]
(cond
(fn? handler) (impl/fn->handler handler)
(instance? Handler handler) handler
:else (throw (ex-info "invalid handler" {}))))
(defn- assign-status-and-headers!
[^HttpServerResponse res response]
(let [headers (:headers response)
status (:status response 200)]
(when (map? headers)
(util/doseq [[key val] headers]
(.putHeader res ^String (name key) ^String (str val))))
(.setStatusCode res status)))
(defprotocol IAsyncResponse
(-handle-response [_ _]))
(defprotocol IAsyncBody
(-handle-body [_ _]))
(extend-protocol IAsyncResponse
java.util.concurrent.CompletionStage
(-handle-response [data ctx]
(p/then' data #(-handle-response % ctx)))
clojure.lang.IPersistentMap
(-handle-response [data ctx]
(let [body (:body data)
res (::response ctx)]
(assign-status-and-headers! res data)
(-handle-body body res)))
nil
(-handle-response [sws ctx]))
(extend-protocol IAsyncBody
(Class/forName "[B")
(-handle-body [data res]
(.end ^HttpServerResponse res (Buffer/buffer ^bytes data)))
Buffer
(-handle-body [data res]
(.end ^HttpServerResponse res ^Buffer data))
nil
(-handle-body [data res]
(.putHeader ^HttpServerResponse res "content-length" "0")
(.end ^HttpServerResponse res))
String
(-handle-body [data res]
(let [length (count data)]
(.putHeader ^HttpServerResponse res "content-length" (str length))
(.end ^HttpServerResponse res data))))

55
backend/vendor/vertx/src/vertx/impl.clj vendored
View file

@ -1,55 +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 vertx.impl
"Implementation helpers."
(:refer-clojure :exclude [doseq])
(:require [promesa.core :as p])
(:import
io.vertx.core.Vertx
io.vertx.core.Handler
io.vertx.core.Context
io.vertx.core.AsyncResult
java.util.function.Supplier))
(defn resolve-system
[o]
(cond
(instance? Vertx o) o
(instance? Context o) (.owner ^Context o)
:else (throw (ex-info "unexpected parameters" {:o o}))))
(defn fn->supplier
[f]
(reify Supplier
(get [_] (f))))
(defn fn->handler
[f]
(reify Handler
(handle [_ v]
(f v))))
(defn deferred->handler
[d]
(reify Handler
(handle [_ ar]
(if (.failed ^AsyncResult ar)
(p/reject! d (.cause ^AsyncResult ar))
(p/resolve! d (.result ^AsyncResult ar))))))
(defmacro doseq
"A faster version of doseq."
[[bsym csym] & body]
(let [itsym (gensym "iterator")]
`(let [~itsym (.iterator ~(with-meta csym {:tag 'java.lang.Iterable}))]
(loop []
(when (.hasNext ~(with-meta itsym {:tag 'java.util.Iterator}))
(let [~bsym (.next ~itsym)]
~@body
(recur)))))))

70
backend/vendor/vertx/src/vertx/stream.clj vendored
View file

@ -1,70 +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-2020 Andrey Antukh <niwi@niwi.nz>
(ns vertx.stream
"A stream abstraction on top of core.async with awareness of vertx
execution context."
(:refer-clojure :exclude [loop])
(:require
[clojure.spec.alpha :as s]
[clojure.core.async :as a]
[clojure.core :as c]
[promesa.core :as p]
[vertx.impl :as impl]
[vertx.util :as vu]))
;; --- Streams
(defmacro loop
[& args]
`(let [ctx# (vu/current-context)]
(binding [p/*loop-run-fn* #(vu/run-on-context! ctx# %)]
(p/loop ~@args))))
(defn stream
([] (a/chan))
([b] (a/chan b))
([b c] (a/chan b c))
([b c e] (a/chan b c e)))
(defn take!
[c]
(let [d (p/deferred)
ctx (vu/current-context)]
(a/take! c (fn [res]
(vu/run-on-context! ctx #(p/resolve! d res))))
d))
(defn poll!
[c]
(a/poll! c))
(defn put!
[c v]
(let [d (p/deferred)
ctx (vu/current-context)]
(a/put! c v (fn [res]
(vu/run-on-context! ctx #(p/resolve! d res))))
d))
(defn offer!
[c v]
(a/offer! c v))
(defn alts!
([ports] (alts! ports {}))
([ports opts]
(let [d (p/deferred)
ctx (vu/current-context)
deliver #(vu/run-on-context! ctx (fn [] (p/resolve! d %)))
ret (a/do-alts deliver ports opts)]
(if ret
(p/resolved @ret)
d))))
(defn close!
[c]
(a/close! c))

76
backend/vendor/vertx/src/vertx/timers.clj vendored
View file

@ -1,76 +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 vertx.timers
"The timers and async scheduled tasks."
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[vertx.impl :as impl])
(:import
io.vertx.core.Vertx
io.vertx.core.Handler))
;; --- Low Level API
(defn schedule-once!
[vsm ms f]
(let [^Vertx system (impl/resolve-system vsm)
^Handler handler (impl/fn->handler (fn [v] (f)))
timer-id (.setTimer system ms handler)]
(reify
java.lang.AutoCloseable
(close [_]
(.cancelTimer system timer-id)))))
(defn schedule-periodic!
[vsm ms f]
(let [^Vertx system (impl/resolve-system vsm)
^Handler handler (impl/fn->handler (fn [v] (f)))
timer-id (.setPeriodic system ms handler)]
(reify
java.lang.AutoCloseable
(close [_]
(.cancelTimer system timer-id)))))
;; --- High Level API
(s/def ::once boolean?)
(s/def ::repeat boolean?)
(s/def ::delay integer?)
(s/def ::fn (s/or :fn fn? :var var?))
(s/def ::schedule-opts
(s/keys :req [::fn ::delay] :opt [::once ::repeat]))
(defn schedule!
"High level schedule function."
[vsm {:keys [::once ::repeat ::delay] :as opts}]
(s/assert ::schedule-opts opts)
(when (and (not once) (not repeat))
(throw (IllegalArgumentException. "you should specify `once` or `repeat` params")))
(let [system (impl/resolve-system vsm)
state (atom nil)
taskfn (fn wrapped-task []
(-> (p/do! ((::fn opts) opts))
(p/catch' (constantly nil)) ; explicitly ignore all errors
(p/then' (fn [_] ; the user needs to catch errors
(if repeat
(let [tid (schedule-once! vsm delay wrapped-task)]
(reset! state tid)
nil))
(do
(reset! state nil)
nil)))))
tid (reset! state (schedule-once! vsm delay taskfn))]
(reify
java.lang.AutoCloseable
(close [this]
(when (compare-and-set! state tid nil)
(.cancelTimer ^Vertx system tid))))))

139
backend/vendor/vertx/src/vertx/util.clj vendored
View file

@ -1,139 +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-2020 Andrey Antukh <niwi@niwi.nz>
(ns vertx.util
(:refer-clojure :exclude [loop doseq])
(:require
[clojure.spec.alpha :as s]
[clojure.core.async :as a]
[clojure.core :as c]
[promesa.core :as p]
[vertx.impl :as impl])
(:import
io.vertx.core.AsyncResult
io.vertx.core.Context
io.vertx.core.Handler
io.vertx.core.Promise
io.vertx.core.Vertx))
(defn get-or-create-context
[vsm]
(.getOrCreateContext ^Vertx (impl/resolve-system vsm)))
(defn current-context
"Returns the current context or nil."
[]
(Vertx/currentContext))
(defmacro blocking
[& body]
(let [sym-vsm (with-meta (gensym "blocking")
{:tag 'io.vertx.core.Vertx})
sym-e (with-meta (gensym "blocking")
{:tag 'java.lang.Throwable})
sym-prm (gensym "blocking")
sym-ar (gensym "blocking")]
`(let [~sym-vsm (-> (current-context)
(impl/resolve-system))
d# (p/deferred)]
(.executeBlocking
~sym-vsm
(reify Handler
(handle [_ ~sym-prm]
(let [prm# ~(with-meta sym-prm {:tag 'io.vertx.core.Promise})]
(try
(.complete prm# (do ~@body))
(catch Throwable ~sym-e
(.fail prm# ~sym-e))))))
true
(reify Handler
(handle [_ ~sym-ar]
(let [ar# ~(with-meta sym-ar {:tag 'io.vertx.core.AsyncResult})]
(if (.failed ar#)
(p/reject! d# (.cause ar#))
(p/resolve! d# (.result ar#)))))))
d#)))
(defn wrap-blocking
([f] (wrap-blocking (current-context) f))
([ctx f]
(let [^Vertx vsm (impl/resolve-system ctx)]
(fn [& args]
(let [d (p/deferred)]
(.executeBlocking
vsm
(reify Handler
(handle [_ prm]
(try
(.complete ^Promise prm (apply f args))
(catch Throwable e
(.fail ^Promise prm e)))))
true
(reify Handler
(handle [_ ar]
(if (.failed ^AsyncResult ar)
(p/reject! d (.cause ^AsyncResult ar))
(p/resolve! d (.result ^AsyncResult ar))))))
d)))))
(defn handle-on-context
"Attaches the context (current if not explicitly provided) to the
promise execution chain."
([prm] (handle-on-context prm (current-context)))
([prm ctx]
(assert (instance? Context ctx) "`ctx` should be a valid Context instance")
(let [d (p/deferred)]
(p/finally prm (fn [v e]
(.runOnContext
^Context ctx
^Handler (reify Handler
(handle [_ v']
(if e
(p/reject! d e)
(p/resolve! d v)))))))
d)))
(defn run-on-context!
"Run callbale on context."
[ctx f]
(.runOnContext ^Context ctx
^Handler (reify Handler
(handle [_ v']
(f)))))
(defmacro loop
[& args]
`(let [ctx# (current-context)]
(binding [p/*loop-run-fn* #(run-on-context! ctx# %)]
(p/loop ~@args))))
(defmacro doseq
"A faster version of doseq."
[[bsym csym] & body]
(let [itsym (gensym "iterator")]
`(let [~itsym (.iterator ~(with-meta csym {:tag 'java.lang.Iterable}))]
(c/loop []
(when (.hasNext ~(with-meta itsym {:tag 'java.util.Iterator}))
(let [~bsym (.next ~itsym)]
~@body
(recur)))))))
(defmacro go-try
[& body]
`(a/go
(try
~@body
(catch Throwable e# e#))))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Throwable r#)
(throw r#)
r#)))

151
backend/vendor/vertx/src/vertx/web.clj vendored
View file

@ -1,151 +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 vertx.web
"High level api for http servers."
(:require
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[promesa.core :as p]
[reitit.core :as rt]
[reitit.middleware :as rmw]
[vertx.http :as http]
[vertx.impl :as impl])
(:import
clojure.lang.IPersistentMap
clojure.lang.Keyword
io.vertx.core.Future
io.vertx.core.Handler
io.vertx.core.Vertx
io.vertx.core.buffer.Buffer
io.vertx.core.http.Cookie
io.vertx.core.http.HttpServer
io.vertx.core.http.HttpServerOptions
io.vertx.core.http.HttpServerRequest
io.vertx.core.http.HttpServerResponse
io.vertx.core.http.ServerWebSocket
io.vertx.ext.web.Route
io.vertx.ext.web.Router
io.vertx.ext.web.RoutingContext
io.vertx.ext.web.handler.BodyHandler
io.vertx.ext.web.handler.LoggerHandler
io.vertx.ext.web.handler.ResponseTimeHandler
io.vertx.ext.web.handler.StaticHandler))
;; --- Public Api
(s/def ::wrap-handler
(s/or :fn fn?
:vec (s/every fn? :kind vector?)))
(defn- ->request
[^RoutingContext routing-context]
(let [^HttpServerRequest request (.request ^RoutingContext routing-context)
^HttpServerResponse response (.response ^RoutingContext routing-context)
^Vertx system (.vertx routing-context)]
{:body (.getBody routing-context)
:path (.path request)
:headers (http/->headers (.headers request))
:method (-> request .rawMethod .toLowerCase keyword)
::http/request request
::http/response response
;; ::execution-context (.getContext system)
::routing-context routing-context}))
(defn handler
"Wraps a user defined funcion based handler into a vertx-web aware
handler (with support for multipart uploads)."
[vsm & handlers]
(let [^Vertx vsm (impl/resolve-system vsm)
^Router router (Router/router vsm)]
(reduce #(%2 %1) router handlers)))
(defn assets
([path] (assets path {}))
([path {:keys [root] :or {root "public"} :as options}]
(fn [^Router router]
(let [^Route route (.route router path)
^Handler handler (doto (StaticHandler/create)
(.setCachingEnabled false)
(.setWebRoot root)
(.setDirectoryListing true))]
(.handler route handler)
;; A hack for lie to body handler that request is already handled.
(.handler route
(reify Handler
(handle [_ rc]
(.put ^RoutingContext rc "__body-handled" true)
(.next ^RoutingContext rc))))
router))))
(defn- default-handler
[ctx]
(if (::match ctx)
{:status 405}
{:status 404}))
(defn- default-on-error
[err req]
(log/error err)
{:status 500
:body "Internal server error!\n"})
(defn- router-handler
[router {:keys [path method] :as ctx}]
(if-let [{:keys [result path-params] :as match} (rt/match-by-path router path)]
(let [handler-fn (:handler result)
ctx (assoc ctx ::match match :path-params path-params)]
(handler-fn ctx))
(default-handler ctx)))
(defn router
([routes] (router routes {}))
([routes {:keys [delete-uploads?
upload-dir
on-error
log-requests?
time-response?]
:or {delete-uploads? true
upload-dir "/tmp/vertx.uploads"
on-error default-on-error
log-requests? false
time-response? true}
:as options}]
(let [rtr (rt/router routes {:compile rmw/compile-result})
rtf #(router-handler rtr %)]
(fn [^Router router]
(let [^Route route (.route router)]
(when time-response? (.handler route (ResponseTimeHandler/create)))
(when log-requests? (.handler route (LoggerHandler/create)))
(doto route
(.failureHandler
(reify Handler
(handle [_ rc]
(let [err (.failure ^RoutingContext rc)
req (.get ^RoutingContext rc "vertx$clj$req")]
(-> (p/do! (on-error err req))
(http/-handle-response req))))))
(.handler
(doto (BodyHandler/create true)
(.setDeleteUploadedFilesOnEnd delete-uploads?)
(.setUploadsDirectory upload-dir)))
(.handler
(reify Handler
(handle [_ rc]
(let [req (->request rc)
efn (fn [err]
(.put ^RoutingContext rc "vertx$clj$req" req)
(.fail ^RoutingContext rc ^Throwable err))]
(try
(let [result (rtf req)]
(-> (http/-handle-response result req)
(p/catch' efn)))
(catch Exception err
(efn err)))))))))
router))))

51
backend/vendor/vertx/src/vertx/web/client.clj vendored
View file

@ -1,51 +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 vertx.web.client
"High level http client."
(:refer-clojure :exclude [get])
(:require
[clojure.spec.alpha :as s]
[promesa.core :as p]
[reitit.core :as rt]
[vertx.http :as http]
[vertx.impl :as impl])
(:import
clojure.lang.IPersistentMap
clojure.lang.Keyword
io.vertx.core.Future
io.vertx.core.Handler
io.vertx.core.Vertx
io.vertx.core.buffer.Buffer
io.vertx.core.http.HttpMethod
io.vertx.ext.web.client.HttpRequest
io.vertx.ext.web.client.HttpResponse
io.vertx.ext.web.client.WebClientSession
io.vertx.ext.web.client.WebClient))
;; TODO: accept options
(defn create
([vsm] (create vsm {}))
([vsm opts]
(let [^Vertx system (impl/resolve-system vsm)]
(WebClient/create system))))
(defn session
[client]
(WebClientSession/create client))
(defn get
([session url] (get session url {}))
([session url opts]
(let [^HttpRequest req (.getAbs ^WebClientSession session url)
d (p/deferred)]
(.send req (impl/deferred->handler d))
(p/then d (fn [^HttpResponse res]
{:body (.bodyAsBuffer res)
:status (.statusCode res)
:headers (http/->headers (.headers res))})))))

217
backend/vendor/vertx/src/vertx/web/middleware.clj vendored
View file

@ -1,217 +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 vertx.web.middleware
"Common middleware's."
(:require
[clojure.spec.alpha :as s]
[clojure.string :as str]
[promesa.core :as p]
[reitit.core :as r]
[vertx.http :as http]
[vertx.web :as web]
[vertx.util :as util])
(:import
clojure.lang.Keyword
clojure.lang.MapEntry
io.vertx.core.Future
io.vertx.core.Handler
io.vertx.core.MultiMap
io.vertx.core.Vertx
io.vertx.core.http.Cookie
io.vertx.core.http.HttpServerRequest
io.vertx.core.http.HttpServerResponse
io.vertx.ext.web.FileUpload
io.vertx.ext.web.RoutingContext
java.util.Map
java.util.Map$Entry))
;; --- Cookies
(defn- build-cookie
[name data]
(cond-> (Cookie/cookie ^String name ^String (:value data))
(:http-only data) (.setHttpOnly true)
(:domain data) (.setDomain (:domain data))
(:path data) (.setPath (:path data))
(:secure data) (.setSecure true)))
(defn- handle-cookies-response
[request {:keys [cookies] :as response}]
(let [^HttpServerResponse res (::http/response request)]
(util/doseq [[key val] cookies]
(if (nil? val)
(.removeCookie res key)
(.addCookie res (build-cookie key val))))))
(defn- cookie->vector
[^Cookie item]
[(.getName item) (.getValue item)])
(defn- wrap-cookies
[handler]
(let [xf (map cookie->vector)]
(fn [request]
(let [req (::http/request request)
cookies (.cookieMap ^HttpServerRequest req)
cookies (into {} xf (vals cookies))]
(-> (p/do! (handler (assoc request :cookies cookies)))
(p/then' (fn [response]
(when (and (map? response)
(map? (:cookies response)))
(handle-cookies-response request response))
response)))))))
(def cookies
{:name ::cookies
:compile (constantly wrap-cookies)})
;; --- Params
(defn- parse-params
[^HttpServerRequest request]
(let [params (.params request)
it (.iterator ^MultiMap params)]
(loop [m (transient {})]
(if (.hasNext it)
(let [^Map$Entry o (.next it)
key (keyword (.toLowerCase ^String (.getKey o)))
prv (get m key ::default)
val (.getValue o)]
(cond
(= prv ::default)
(recur (assoc! m key val))
(vector? prv)
(recur (assoc! m key (conj prv val)))
:else
(recur (assoc! m key [prv val]))))
(persistent! m)))))
(defn- wrap-params
[handler]
(fn [request]
(let [req (::http/request request)
params (parse-params req)]
(handler (assoc request :params params)))))
(def params
{:name ::params
:compile (constantly wrap-params)})
;; --- Uploads
(defn- wrap-uploads
[handler]
(fn [request]
(let [rctx (::web/routing-context request)
uploads (.fileUploads ^RoutingContext rctx)
uploads (reduce (fn [acc ^FileUpload upload]
(assoc acc
(keyword (.name upload))
{:type :uploaded-file
:mtype (.contentType upload)
:path (.uploadedFileName upload)
:name (.fileName upload)
:size (.size upload)}))
{}
uploads)]
(handler (assoc request :uploads uploads)))))
(def uploads
{:name ::uploads
:compile (constantly wrap-uploads)})
;; --- Errors
(defn- wrap-errors
[handler on-error]
(fn [request]
(-> (p/do! (handler request))
(p/catch (fn [error]
(on-error error request))))))
(def errors
{:name ::errors
:compile (constantly wrap-errors)})
;; --- CORS
(s/def ::origin string?)
(s/def ::allow-credentials boolean?)
(s/def ::allow-methods (s/every keyword? :kind set?))
(s/def ::allow-headers (s/every keyword? :kind set?))
(s/def ::expose-headers (s/every keyword? :kind set?))
(s/def ::max-age number?)
(s/def ::cors-opts
(s/keys :req-un [::origin]
:opt-un [::allow-headers
::allow-methods
::expose-headers
::max-age]))
(defn wrap-cors
[handler opts]
(s/assert ::cors-opts opts)
(letfn [(preflight? [{:keys [method headers] :as ctx}]
(and (= method :options)
(contains? headers "origin")
(contains? headers "access-control-request-method")))
(normalize [data]
(str/join ", " (map name data)))
(allow-origin? [headers]
(let [origin (:origin opts)
value (get headers "origin")]
(cond
(nil? value) value
(= origin "*") origin
(set? origin) (origin value)
(= origin value) origin)))
(get-headers [{:keys [headers] :as ctx}]
(when-let [origin (allow-origin? headers)]
(cond-> {"access-control-allow-origin" origin
"access-control-allow-methods" "GET, OPTIONS, HEAD"}
(:allow-methods opts)
(assoc "access-control-allow-methods"
(-> (normalize (:allow-methods opts))
(str/upper-case)))
(:allow-credentials opts)
(assoc "access-control-allow-credentials" "true")
(:expose-headers opts)
(assoc "access-control-expose-headers"
(-> (normalize (:expose-headers opts))
(str/lower-case)))
(:max-age opts)
(assoc "access-control-max-age" (:max-age opts))
(:allow-headers opts)
(assoc "access-control-allow-headers"
(-> (normalize (:allow-headers opts))
(str/lower-case))))))]
(fn [request]
(if (preflight? request)
{:status 204 :headers (get-headers request)}
(-> (p/do! (handler request))
(p/then (fn [response]
(if (map? response)
(update response :headers merge (get-headers request))
response))))))))
(def cors
{:name ::cors
:compile (constantly wrap-cors)})

116
backend/vendor/vertx/src/vertx/web/websockets.clj vendored
View file

@ -1,116 +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-2020 Andrey Antukh <niwi@niwi.nz>
(ns vertx.web.websockets
"Web Sockets."
(:require
[clojure.tools.logging :as log]
[clojure.core.async :as a]
[promesa.core :as p]
[vertx.http :as vh]
[vertx.web :as vw]
[vertx.impl :as vi]
[vertx.util :as vu]
[vertx.eventbus :as ve])
(:import
java.lang.AutoCloseable
io.vertx.core.AsyncResult
io.vertx.core.Promise
io.vertx.core.Handler
io.vertx.core.Vertx
io.vertx.core.buffer.Buffer
io.vertx.core.http.HttpServerRequest
io.vertx.core.http.HttpServerResponse
io.vertx.core.http.ServerWebSocket))
(defrecord WebSocket [conn input output on-error]
AutoCloseable
(close [it]
(a/close! input)
(a/close! output)
(.close ^ServerWebSocket conn (short 403))))
(defn- write-to-websocket
[conn on-error message]
(let [r (a/chan 1)
h (reify Handler
(handle [_ ar]
(if (.failed ^AsyncResult ar)
(a/put! r (.cause ^AsyncResult ar))
(a/close! r))))]
(cond
(string? message)
(.writeTextMessage ^ServerWebSocket conn
^String message
^Handler h)
(instance? Buffer message)
(.writeBinaryMessage ^ServerWebSocket conn
^Buffer message
^Handler h)
:else
(a/put! r (ex-info "invalid message type" {:message message})))
r))
(defn- default-on-error
[^Throwable err]
(log/error "Unexpected exception on websocket handler:\n"
(with-out-str
(.printStackTrace err (java.io.PrintWriter. *out*)))))
(defn websocket
[{:keys [handler on-error
input-buffer-size
output-buffer-size]
:or {on-error default-on-error
input-buffer-size 64
output-buffer-size 64}}]
(reify
vh/IAsyncResponse
(-handle-response [it request]
(let [^HttpServerRequest req (::vh/request request)
^ServerWebSocket conn (.upgrade req)
inp-s (a/chan input-buffer-size)
out-s (a/chan output-buffer-size)
ctx (vu/current-context)
ws (->WebSocket conn inp-s out-s on-error)
impl-on-error
(fn [err]
(.close ^AutoCloseable ws)
(on-error err))
impl-on-close
(fn [_]
(a/close! inp-s)
(a/close! out-s))
impl-on-message
(fn [message]
(when-not (a/offer! inp-s message)
(.pause conn)
(a/put! inp-s message
(fn [res]
(when-not (false? res)
(.resume conn))))))]
(.exceptionHandler conn ^Handler (vi/fn->handler impl-on-error))
(.textMessageHandler conn ^Handler (vi/fn->handler impl-on-message))
(.closeHandler conn ^Handler (vi/fn->handler impl-on-close))
(a/go-loop []
(let [msg (a/<! out-s)]
(when-not (nil? msg)
(let [res (a/<! (write-to-websocket conn on-error msg))]
(if (instance? Throwable res)
(impl-on-error res)
(recur))))))
(vu/run-on-context! ctx #(handler ws))))))

146
backend/vendor/vertx/test/user.clj vendored
View file

@ -1,146 +0,0 @@
(ns user
(:require
[clojure.pprint :refer [pprint]]
[clojure.test :as test]
[clojure.tools.namespace.repl :as r]
[clojure.walk :refer [macroexpand-all]]
[mount.core :as mount :refer [defstate]]
[pohjavirta.server :as pohjavirta]
[promesa.core :as p]
[reitit.core :as rt]
[jsonista.core :as j]
[vertx.core :as vc]
[vertx.eventbus :as ve]
[vertx.http :as vh]
[vertx.web :as vw])
(:import
io.vertx.core.http.HttpServerRequest
io.vertx.core.http.HttpServerResponse))
(declare thr-name)
;; --- System
(defstate system
:start (vc/system)
:stop (.close system))
;; --- Echo Verticle (using eventbus)
(def echo-verticle*
(letfn [(on-message [ctx message]
(println (pr-str "received:" message
"on" (thr-name)
"with ctx" ctx))
(:body message))
(on-start [ctx]
(ve/consumer ctx "test.echo" on-message))]
(vc/verticle {:on-start on-start})))
(defstate echo-verticle
:start @(vc/deploy! system echo-verticle* {:instances 4}))
;; --- Echo Verticle Actor (using eventbus)
;; This is the same as the previous echo verticle, it just reduces the
;; boilerplate of creating the consumer.
;; (def echo-actor-verticle
;; (letfn [(on-message [message]
;; (println (pr-str "received:" (.body message)
;; "on" (thr-name)))
;; (.body message))]
;; (vc/actor "test.echo2" {:on-message on-message})))
;; (defstate echo-actor-verticle
;; :start @(vc/deploy! system echo-actor-verticle options))
;; --- Http Server Verticle
(def http-verticle
(letfn [(simple-handler [req]
;; (prn req)
{:status 200
:body (j/write-value-as-string
{:method (:method req)
:headers (:headers req)
:path (:path req)})})
(on-start [ctx]
(let [handler (vh/handler ctx simple-handler)]
(vh/server ctx {:handler handler :port 2020})))]
(vc/verticle {:on-start on-start})))
(defstate http-server-verticle
:start @(vc/deploy! system http-verticle {:instances 2}))
;; --- Web Router Verticle
(def web-router-verticle
(letfn [(simple-handler [req]
{:status 200
:body (j/write-value-as-string
{:method (:method req)
:path (:path req)})})
(on-start [ctx]
(let [routes [["/" {:all simple-handler}]]
handler (vw/handler ctx (vw/router routes))]
(vh/server ctx {:handler handler :port 2021})))]
(vc/verticle {:on-start on-start})))
(defstate web-server-with-router-verticle
:start @(vc/deploy! system web-router-verticle {:instances 2}))
;; --- pohjavirta
(defn handler
[req]
{:status 200
:body (j/write-value-as-string
{:method (:request-method req)
:headers (:headers req)
:path (:uri req)})})
(defstate pohjavirta-server
:start (let [instance (pohjavirta/create #'handler {:port 2022 :io-threads 2})]
(pohjavirta/start instance)
instance)
:stop (pohjavirta/stop pohjavirta-server))
;; --- Repl
(defn start
[]
(mount/start))
(defn stop
[]
(mount/stop))
(defn restart
[]
(stop)
(r/refresh :after 'user/start))
(defn- run-test
([] (run-test #"^vertx-tests.*"))
([o]
(r/refresh)
(cond
(instance? java.util.regex.Pattern o)
(test/run-all-tests o)
(symbol? o)
(if-let [sns (namespace o)]
(do (require (symbol sns))
(test/test-vars [(resolve o)]))
(test/test-ns o)))))
;; --- Helpers
(defn thr-name
[]
(.getName (Thread/currentThread)))

15
backend/vendor/vertx/test/vertx_tests/main.clj vendored
View file

@ -1,15 +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 vertx-tests.main
(:require [clojure.test :as t]))
(defn -main
[& args]
(let [{:keys [fail]} (t/run-all-tests #"^vertx-tests.*")]
(if (pos? fail)
(System/exit fail)
(System/exit 0))))

53
backend/vendor/vertx/test/vertx_tests/test_core.clj vendored
View file

@ -1,53 +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 vertx-tests.test-core
(:require [clojure.test :as t]
[vertx.core :as vx]
[vertx.eventbus :as vxe]))
(def sleep #(Thread/sleep %))
(t/deftest start-stop-verticle
(with-open [vsm (vx/system)]
(let [state (atom {})]
(let [on-start (fn [_] (swap! state assoc :start true) {:a 1})
on-stop (fn [_ s] (swap! state assoc :stop true :inner (:a s)))
verticle (vx/verticle {:on-start on-start :on-stop on-stop})]
;; Start and stop verticle
(.close @(vx/deploy! vsm verticle))
;; Checks
(t/is (:start @state))
(t/is (:stop @state))
(t/is (= (:inner @state) 1))))))
(t/deftest start-stop-actor
(with-open [vsm (vx/system)]
(let [state (atom {})]
(let [on-start (fn [_] (swap! state assoc :start true) {:a 1})
on-stop (fn [_ s] (swap! state assoc :stop true :inner (:a s)))
rcvlock (promise)
on-message #(deliver rcvlock %2)
verticle (vx/actor "test.topic" {:on-message on-message
:on-start on-start
:on-stop on-stop})]
(with-open [vid @(vx/deploy! vsm verticle)]
;; Checks
(t/is (true? (:start @state)))
(t/is (nil? (:stop @state)))
(vxe/send! vsm "test.topic" {:num 1})
;; Checks
(t/is (vxe/message? @rcvlock))
(t/is (= {:num 1} (:body @rcvlock))))
(t/is (= (:inner @state) 1))
(t/is (true? (:stop @state)))))))

17
backend/vendor/vertx/tools.clj vendored
View file

@ -1,17 +0,0 @@
(require '[clojure.java.shell :as shell]
'[clojure.main])
(require '[rebel-readline.core]
'[rebel-readline.clojure.main]
'[rebel-readline.clojure.line-reader]
'[rebel-readline.clojure.service.local])
(defmulti task first)
(defmethod task :default
[args]
(let [all-tasks (-> task methods (dissoc :default) keys sort)
interposed (->> all-tasks (interpose ", ") (apply str))]
(println "Unknown or missing task. Choose one of:" interposed)
(System/exit 1)))
(task *command-line-args*)

3
frontend/src/uxbox/main/data/workspace/notifications.cljs
View file

@ -39,7 +39,8 @@
ptk/UpdateEvent
(update [_ state]
(let [sid (:session-id state)
url (ws/url (str "/notifications/" file-id "/" sid))]
url (ws/url "/ws/notifications" {:file-id file-id
:session-id sid})]
(assoc-in state [:ws file-id] (ws/open url))))
ptk/WatchEvent

6
frontend/src/uxbox/util/http_api.cljs
View file

@ -35,13 +35,15 @@
[{:keys [body headers auth method query url response-type]
:or {auth true response-type :text}}]
(let [headers (merge {"Accept" "application/transit+json,*/*"}
default-headers
(when (map? body) default-headers)
headers)
request {:method method
:url url
:headers headers
:query query
:body (when (not= :get method) (t/encode body))}
:body (if (map? body)
(t/encode body)
body)}
options {:response-type response-type
:credentials? auth}]
(http/send! request options)))

18
frontend/src/uxbox/util/websockets.cljs
View file

@ -25,13 +25,17 @@
(-close [_] "close websocket"))
(defn url
[path]
(let [url (.parse Uri cfg/url)]
(.setPath url path)
(if (= (.getScheme url) "http")
(.setScheme url "ws")
(.setScheme url "wss"))
(.toString url)))
([path] (url path {}))
([path params]
(let [uri (.parse Uri cfg/url)]
(.setPath uri path)
(if (= (.getScheme uri) "http")
(.setScheme uri "ws")
(.setScheme uri "wss"))
(run! (fn [[k v]]
(.setParameterValue uri (name k) (str v)))
params)
(.toString uri))))
(defn open
[uri]