3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-11 21:26:37 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor profile and session handling

Browse source 
- makes the profile access more efficient (replace in-app joins to a
  simple select query on profile table
- add partial support for access-tokens (still missing some RPC methods)
- move router definitions to specific modules and simplify the main http
  module definitions to simple includes
- simplifiy authentication code related to access-tokens and sessions
- normalize db parameters with proper namespaced props
- more work on convert all modules initialization to use proper specs
  with fully-qualified keyword config props
This commit is contained in:
Andrey Antukh 2023-01-02 22:56:24 +01:00
parent a7ec9d7d1f
commit db689d151e
58 changed files with 1285 additions and 963 deletions
Download patch file Download diff file Expand all files Collapse all files

6
backend/resources/rlimit.edn
View file

@ -3,8 +3,8 @@
{:default {:default
[[:default :window "200000/h"]] [[:default :window "200000/h"]]
#{:query/teams} #{:command/get-teams}
[[:burst :bucket "5/1/5s"]] [[:burst :bucket "5/1/5s"]]
#{:query/profile} #{:command/get-profile}
[[:burst :bucket "100/60/1m"]]} [[:burst :bucket "60/60/1m"]]}

34
backend/src/app/auth/oidc.clj
View file

@ -349,7 +349,7 @@
::fullname ::fullname
::props])) ::props]))
(defn retrieve-info (defn get-info
[{:keys [provider] :as cfg} {:keys [params] :as request}] [{:keys [provider] :as cfg} {:keys [params] :as request}]
(letfn [(validate-oidc [info] (letfn [(validate-oidc [info]
;; If the provider is OIDC, we can proceed to check ;; If the provider is OIDC, we can proceed to check
@ -396,14 +396,12 @@
(p/then' validate-oidc) (p/then' validate-oidc)
(p/then' (partial post-process state)))))) (p/then' (partial post-process state))))))
(defn- retrieve-profile (defn- get-profile
[{:keys [::db/pool ::wrk/executor] :as cfg} info] [{:keys [::db/pool ::wrk/executor] :as cfg} info]
(px/with-dispatch executor (px/with-dispatch executor
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(some->> (:email info) (some->> (:email info)
(profile/retrieve-profile-data-by-email conn) (profile/get-profile-by-email conn)))))
(profile/populate-additional-data conn)
(profile/decode-profile-row)))))
(defn- redirect-response (defn- redirect-response
[uri] [uri]
@ -417,9 +415,9 @@
(redirect-response uri))) (redirect-response uri)))
(defn- generate-redirect (defn- generate-redirect
[{:keys [::session/session] :as cfg} request info profile] [cfg request info profile]
(if profile (if profile
(let [sxf (session/create-fn session (:id profile)) (let [sxf (session/create-fn cfg (:id profile))
token (or (:invitation-token info) token (or (:invitation-token info)
(tokens/generate (::main/props cfg) (tokens/generate (::main/props cfg)
{:iss :auth {:iss :auth
@ -436,7 +434,7 @@
(when-let [collector (::audit/collector cfg)] (when-let [collector (::audit/collector cfg)]
(audit/submit! collector {:type "command" (audit/submit! collector {:type "command"
:name "login" :name "login-with-password"
:profile-id (:id profile) :profile-id (:id profile)
:ip-addr (audit/parse-client-ip request) :ip-addr (audit/parse-client-ip request)
:props (audit/profile->props profile)})) :props (audit/profile->props profile)}))
@ -471,8 +469,8 @@
(defn- callback-handler (defn- callback-handler
[cfg request] [cfg request]
(letfn [(process-request [] (letfn [(process-request []
(p/let [info (retrieve-info cfg request) (p/let [info (get-info cfg request)
profile (retrieve-profile cfg info)] profile (get-profile cfg info)]
(generate-redirect cfg request info profile))) (generate-redirect cfg request info profile)))
(handle-error [cause] (handle-error [cause]
@ -524,23 +522,24 @@
(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider))) (s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
(s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes (defmethod ig/pre-init-spec ::routes
[_] [_]
(s/keys :req [::http/client (s/keys :req [::session/manager
::http/client
::wrk/executor ::wrk/executor
::main/props ::main/props
::db/pool ::db/pool
::providers ::providers]))
::session/session]))
(defmethod ig/init-key ::routes (defmethod ig/init-key ::routes
[_ {:keys [::wrk/executor ::session/session] :as cfg}] [_ {:keys [::wrk/executor] :as cfg}]
(let [cfg (update cfg :provider d/without-nils)] (let [cfg (update cfg :provider d/without-nils)]
["" {:middleware [[(:middleware session)] ["" {:middleware [[session/authz cfg]
[hmw/with-dispatch executor] [hmw/with-dispatch executor]
[hmw/with-config cfg] [hmw/with-config cfg]
[provider-lookup] [provider-lookup]]}
]}
["/auth/oauth" ["/auth/oauth"
["/:provider" ["/:provider"
{:handler auth-handler {:handler auth-handler
@ -548,4 +547,3 @@
["/:provider/callback" ["/:provider/callback"
{:handler callback-handler {:handler callback-handler
:allowed-methods #{:get}}]]])) :allowed-methods #{:get}}]]]))

21
backend/src/app/cli/manage.clj
View file

@ -10,9 +10,9 @@
[app.common.logging :as l] [app.common.logging :as l]
[app.db :as db] [app.db :as db]
[app.main :as main] [app.main :as main]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as auth]
[app.rpc.mutations.profile :as profile] [app.rpc.mutations.profile :as profile]
[app.rpc.queries.profile :refer [retrieve-profile-data-by-email]] [app.rpc.queries.profile :refer [get-profile-by-email]]
[clojure.string :as str] [clojure.string :as str]
[clojure.tools.cli :refer [parse-opts]] [clojure.tools.cli :refer [parse-opts]]
[integrant.core :as ig]) [integrant.core :as ig])
@ -55,16 +55,17 @@
:type :password}))] :type :password}))]
(try (try
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(->> (cmd.auth/create-profile conn (->> (auth/create-profile! conn
{:fullname fullname {:fullname fullname
:email email :email email
:password password :password password
:is-active true :is-active true
:is-demo false}) :is-demo false})
(cmd.auth/create-profile-relations conn))) (auth/create-profile-rels! conn)))
(when (pos? (:verbosity options)) (when (pos? (:verbosity options))
(println "User created successfully.")) (println "User created successfully."))
(System/exit 0) (System/exit 0)
(catch Exception _e (catch Exception _e
@ -79,7 +80,7 @@
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(let [email (or (:email options) (let [email (or (:email options)
(read-from-console {:label "Email:"})) (read-from-console {:label "Email:"}))
profile (retrieve-profile-data-by-email conn email)] profile (get-profile-by-email conn email)]
(when-not profile (when-not profile
(when (pos? (:verbosity options)) (when (pos? (:verbosity options))
(println "Profile does not exists.")) (println "Profile does not exists."))

2
backend/src/app/config.clj
View file

@ -128,6 +128,7 @@
(s/def ::database-max-pool-size ::us/integer) (s/def ::database-max-pool-size ::us/integer)
(s/def ::quotes-teams-per-profile ::us/integer) (s/def ::quotes-teams-per-profile ::us/integer)
(s/def ::quotes-access-tokens-per-profile ::us/integer)
(s/def ::quotes-projects-per-team ::us/integer) (s/def ::quotes-projects-per-team ::us/integer)
(s/def ::quotes-invitations-per-team ::us/integer) (s/def ::quotes-invitations-per-team ::us/integer)
(s/def ::quotes-profiles-per-team ::us/integer) (s/def ::quotes-profiles-per-team ::us/integer)
@ -281,6 +282,7 @@
::public-uri ::public-uri
::quotes-teams-per-profile ::quotes-teams-per-profile
::quotes-access-tokens-per-profile
::quotes-projects-per-team ::quotes-projects-per-team
::quotes-invitations-per-team ::quotes-invitations-per-team
::quotes-profiles-per-team ::quotes-profiles-per-team

116
backend/src/app/db.clj
View file

@ -233,44 +233,46 @@
[pool] [pool]
(jdbc/get-connection pool)) (jdbc/get-connection pool))
(def ^:private default-opts
{:builder-fn sql/as-kebab-maps})
(defn exec! (defn exec!
([ds sv] ([ds sv]
(exec! ds sv {})) (jdbc/execute! ds sv default-opts))
([ds sv opts] ([ds sv opts]
(jdbc/execute! ds sv (assoc opts :builder-fn sql/as-kebab-maps)))) (jdbc/execute! ds sv (merge default-opts opts))))
(defn exec-one! (defn exec-one!
([ds sv] (exec-one! ds sv {})) ([ds sv]
(jdbc/execute-one! ds sv default-opts))
([ds sv opts] ([ds sv opts]
(jdbc/execute-one! ds sv (assoc opts :builder-fn sql/as-kebab-maps)))) (jdbc/execute-one! ds sv
(-> (merge default-opts opts)
(assoc :return-keys (::return-keys? opts false))))))
(defn insert! (defn insert!
([ds table params] (insert! ds table params nil)) [ds table params & {:as opts}]
([ds table params opts] (exec-one! ds
(exec-one! ds (sql/insert table params opts)
(sql/insert table params opts) (merge {::return-keys? true} opts)))
(merge {:return-keys true} opts))))
(defn insert-multi! (defn insert-multi!
([ds table cols rows] (insert-multi! ds table cols rows nil)) [ds table cols rows & {:as opts}]
([ds table cols rows opts] (exec! ds
(exec! ds (sql/insert-multi table cols rows opts)
(sql/insert-multi table cols rows opts) (merge {::return-keys? true} opts)))
(merge {:return-keys true} opts))))
(defn update! (defn update!
([ds table params where] (update! ds table params where nil)) [ds table params where & {:as opts}]
([ds table params where opts] (exec-one! ds
(exec-one! ds (sql/update table params where opts)
(sql/update table params where opts) (merge {::return-keys? true} opts)))
(merge {:return-keys true} opts))))
(defn delete! (defn delete!
([ds table params] (delete! ds table params nil)) [ds table params & {:as opts}]
([ds table params opts] (exec-one! ds
(exec-one! ds (sql/delete table params opts)
(sql/delete table params opts) (merge {::return-keys? true} opts)))
(assoc opts :return-keys true))))
(defn is-row-deleted? (defn is-row-deleted?
[{:keys [deleted-at]}] [{:keys [deleted-at]}]
@ -279,56 +281,34 @@
(inst-ms (dt/now))))) (inst-ms (dt/now)))))
(defn get* (defn get*
"Internal function for retrieve a single row from database that "Retrieve a single row from database that matches a simple filters. Do
matches a simple filters." not raises exceptions."
([ds table params] [ds table params & {:as opts}]
(get* ds table params nil)) (let [rows (exec! ds (sql/select table params opts))
([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}] rows (cond->> rows
(let [rows (exec! ds (sql/select table params opts)) (::remove-deleted? opts true)
rows (cond->> rows (remove is-row-deleted?))]
check-deleted? (first rows)))
(remove is-row-deleted?))]
(first rows))))
(defn get (defn get
([ds table params] "Retrieve a single row from database that matches a simple
(get ds table params nil)) filters. Raises :not-found exception if no object is found."
([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}] [ds table params & {:as opts}]
(let [row (get* ds table params opts)] (let [row (get* ds table params opts)]
(when (and (not row) check-deleted?) (when (and (not row) (::check-deleted? opts true))
(ex/raise :type :not-found (ex/raise :type :not-found
:code :object-not-found :code :object-not-found
:table table :table table
:hint "database object not found")) :hint "database object not found"))
row))) row))
(defn get-by-params
"DEPRECATED"
([ds table params]
(get-by-params ds table params nil))
([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
(let [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
(when (and (not row) check-not-found)
(ex/raise :type :not-found
:code :object-not-found
:table table
:hint "database object not found"))
row)))
(defn get-by-id (defn get-by-id
([ds table id] [ds table id & {:as opts}]
(get ds table {:id id} nil)) (get ds table {:id id} opts))
([ds table id opts]
(let [opts (cond-> opts
(contains? opts :check-not-found)
(assoc :check-deleted? (:check-not-found opts)))]
(get ds table {:id id} opts))))
(defn query (defn query
([ds table params] [ds table params & {:as opts}]
(query ds table params nil)) (exec! ds (sql/select table params opts)))
([ds table params opts]
(exec! ds (sql/select table params opts))))
(defn pgobject? (defn pgobject?
([v] ([v]

7
backend/src/app/db/sql.clj
View file

@ -7,6 +7,7 @@
(ns app.db.sql (ns app.db.sql
(:refer-clojure :exclude [update]) (:refer-clojure :exclude [update])
(:require (:require
[app.db :as-alias db]
[clojure.string :as str] [clojure.string :as str]
[next.jdbc.optional :as jdbc-opt] [next.jdbc.optional :as jdbc-opt]
[next.jdbc.sql.builder :as sql])) [next.jdbc.sql.builder :as sql]))
@ -43,8 +44,10 @@
([table where-params opts] ([table where-params opts]
(let [opts (merge default-opts opts) (let [opts (merge default-opts opts)
opts (cond-> opts opts (cond-> opts
(:for-update opts) (assoc :suffix "FOR UPDATE") (::db/for-update? opts) (assoc :suffix "FOR UPDATE")
(:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))] (::db/for-share? opts) (assoc :suffix "FOR KEY SHARE")
(:for-update opts) (assoc :suffix "FOR UPDATE")
(:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))]
(sql/for-query table where-params opts)))) (sql/for-query table where-params opts))))
(defn update (defn update

79
backend/src/app/http.clj
View file

@ -6,13 +6,22 @@
(ns app.http (ns app.http
(:require (:require
[app.auth.oidc :as-alias oidc]
[app.common.data :as d] [app.common.data :as d]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.transit :as t] [app.common.transit :as t]
[app.db :as-alias db]
[app.http.access-token :as actoken]
[app.http.assets :as-alias assets]
[app.http.awsns :as-alias awsns]
[app.http.debug :as-alias debug]
[app.http.errors :as errors] [app.http.errors :as errors]
[app.http.middleware :as mw] [app.http.middleware :as mw]
[app.http.session :as session] [app.http.session :as session]
[app.http.websocket :as-alias ws]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.rpc :as-alias rpc]
[app.rpc.doc :as-alias rpc.doc]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig] [integrant.core :as ig]
@ -64,7 +73,6 @@
:http/max-body-size (:max-body-size cfg) :http/max-body-size (:max-body-size cfg)
:http/max-multipart-body-size (:max-multipart-body-size cfg) :http/max-multipart-body-size (:max-multipart-body-size cfg)
:xnio/io-threads (:io-threads cfg) :xnio/io-threads (:io-threads cfg)
:xnio/worker-threads (:worker-threads cfg)
:xnio/dispatch (:executor cfg) :xnio/dispatch (:executor cfg)
:ring/async true} :ring/async true}
@ -113,64 +121,41 @@
;; HTTP ROUTER ;; HTTP ROUTER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::assets map?)
(s/def ::awsns-handler fn?)
(s/def ::debug-routes (s/nilable vector?))
(s/def ::doc-routes (s/nilable vector?))
(s/def ::feedback fn?)
(s/def ::oauth map?)
(s/def ::oidc-routes (s/nilable vector?))
(s/def ::rpc-routes (s/nilable vector?))
(s/def ::session ::session/session)
(s/def ::storage map?)
(s/def ::ws fn?)
(defmethod ig/pre-init-spec ::router [_] (defmethod ig/pre-init-spec ::router [_]
(s/keys :req-un [::mtx/metrics (s/keys :req [::session/manager
::ws ::actoken/manager
::storage ::ws/routes
::assets ::rpc/routes
::session ::rpc.doc/routes
::feedback ::oidc/routes
::awsns-handler ::assets/routes
::debug-routes ::debug/routes
::oidc-routes ::db/pool
::rpc-routes ::mtx/routes
::doc-routes])) ::awsns/routes]))
(defmethod ig/init-key ::router (defmethod ig/init-key ::router
[_ {:keys [ws session metrics assets feedback] :as cfg}] [_ cfg]
(rr/router (rr/router
[["" {:middleware [[mw/server-timing] [["" {:middleware [[mw/server-timing]
[mw/format-response] [mw/format-response]
[mw/params] [mw/params]
[mw/parse-request] [mw/parse-request]
[session/middleware-1 session] [session/soft-auth cfg]
[actoken/soft-auth cfg]
[mw/errors errors/handle] [mw/errors errors/handle]
[mw/restrict-methods]]} [mw/restrict-methods]]}
["/metrics" {:handler (::mtx/handler metrics) (::mtx/routes cfg)
:allowed-methods #{:get}}] (::assets/routes cfg)
(::debug/routes cfg)
["/assets" {:middleware [[session/middleware-2 session]]}
["/by-id/:id" {:handler (:objects-handler assets)}]
["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]
["/by-file-media-id/:id/thumbnail" {:handler (:file-thumbnails-handler assets)}]]
(:debug-routes cfg)
["/webhooks" ["/webhooks"
["/sns" {:handler (:awsns-handler cfg) (::awsns/routes cfg)]
:allowed-methods #{:post}}]]
["/ws/notifications" {:middleware [[session/middleware-2 session]] (::ws/routes cfg)
:handler ws
:allowed-methods #{:get}}]
["/api" {:middleware [[mw/cors] ["/api" {:middleware [[mw/cors]]}
[session/middleware-2 session]]} (::oidc/routes cfg)
["/feedback" {:handler feedback (::rpc.doc/routes cfg)
:allowed-methods #{:post}}] (::rpc/routes cfg)]]]))
(:doc-routes cfg)
(:oidc-routes cfg)
(:rpc-routes cfg)]]]))

96
backend/src/app/http/access_token.clj Normal file
View file

@ -0,0 +1,96 @@
;; 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) KALEIDOS INC
(ns app.http.access-token
(:require
[app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
[app.main :as-alias main]
[app.tokens :as tokens]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[promesa.core :as p]
[promesa.exec :as px]
[yetti.request :as yrq]))
(s/def ::manager
(s/keys :req [::db/pool ::wrk/executor ::main/props]))
(defmethod ig/pre-init-spec ::manager [_] ::manager)
(defmethod ig/init-key ::manager [_ cfg] cfg)
(defmethod ig/halt-key! ::manager [_ _])
(def header-re #"^Token\s+(.*)")
(defn- get-token
[request]
(some->> (yrq/get-header request "authorization")
(re-matches header-re)
(second)))
(defn- decode-token
[props token]
(when token
(tokens/verify props {:token token :iss "access-token"})))
(defn- get-token-perms
[pool token-id]
(when-not (db/read-only? pool)
(when-let [token (db/get* pool :access-token {:id token-id} {:columns [:perms]})]
(some-> (:perms token)
(db/decode-pgarray #{})))))
(defn- wrap-soft-auth
[handler {:keys [::manager]}]
(us/assert! ::manager manager)
(let [{:keys [::wrk/executor ::main/props]} manager]
(fn [request respond raise]
(let [token (get-token request)]
(->> (px/submit! executor (partial decode-token props token))
(p/fnly (fn [claims cause]
(when cause
(l/trace :hint "exception on decoding malformed token" :cause cause))
(let [request (cond-> request
(map? claims)
(assoc ::id (:tid claims)))]
(handler request respond raise)))))))))
(defn- wrap-authz
[handler {:keys [::manager]}]
(us/assert! ::manager manager)
(let [{:keys [::wrk/executor ::db/pool]} manager]
(fn [request respond raise]
(if-let [token-id (::id request)]
(->> (px/submit! executor (partial get-token-perms pool token-id))
(p/fnly (fn [perms cause]
(cond
(some? cause)
(raise cause)
(nil? perms)
(handler request respond raise)
:else
(let [request (assoc request ::perms perms)]
(handler request respond raise))))))
(handler request respond raise)))))
(def soft-auth
{:name ::soft-auth
:compile (fn [& _]
(when (contains? cf/flags :access-tokens)
wrap-soft-auth))})
(def authz
{:name ::authz
:compile (fn [& _]
(when (contains? cf/flags :access-tokens)
wrap-authz))})

15
backend/src/app/http/assets.clj
View file

@ -115,7 +115,10 @@
(s/def ::cache-max-age ::dt/duration) (s/def ::cache-max-age ::dt/duration)
(s/def ::signature-max-age ::dt/duration) (s/def ::signature-max-age ::dt/duration)
(defmethod ig/pre-init-spec ::handlers [_] (s/def ::routes vector?)
;; FIXME: namespace qualified params
(defmethod ig/pre-init-spec ::routes [_]
(s/keys :req-un [::storage (s/keys :req-un [::storage
::wrk/executor ::wrk/executor
::mtx/metrics ::mtx/metrics
@ -123,9 +126,9 @@
::cache-max-age ::cache-max-age
::signature-max-age])) ::signature-max-age]))
(defmethod ig/init-key ::handlers (defmethod ig/init-key ::routes
[_ cfg] [_ cfg]
{:objects-handler (partial objects-handler cfg) ["/assets"
:file-objects-handler (partial file-objects-handler cfg) ["/by-id/:id" {:handler (partial objects-handler cfg)}]
:file-thumbnails-handler (partial file-thumbnails-handler cfg)}) ["/by-file-media-id/:id" {:handler (partial file-objects-handler cfg)}]
["/by-file-media-id/:id/thumbnail" {:handler (partial file-thumbnails-handler cfg)}]])

17
backend/src/app/http/awsns.clj
View file

@ -28,18 +28,20 @@
(declare parse-notification) (declare parse-notification)
(declare process-report) (declare process-report)
(defmethod ig/pre-init-spec ::handler [_] (defmethod ig/pre-init-spec ::routes [_]
(s/keys :req [::http/client (s/keys :req [::http/client
::main/props ::main/props
::db/pool ::db/pool
::wrk/executor])) ::wrk/executor]))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::routes
[_ {:keys [::wrk/executor] :as cfg}] [_ {:keys [::wrk/executor] :as cfg}]
(fn [request respond _] (letfn [(handler [request respond _]
(let [data (-> request yrq/body slurp)] (let [data (-> request yrq/body slurp)]
(px/run! executor #(handle-request cfg data))) (px/run! executor #(handle-request cfg data)))
(respond (yrs/response 200)))) (respond (yrs/response 200)))]
["/sns" {:handler handler
:allowed-methods #{:post}}]))
(defn handle-request (defn handle-request
[cfg data] [cfg data]
@ -105,8 +107,7 @@
[cfg headers] [cfg headers]
(let [tdata (get headers "x-penpot-data")] (let [tdata (get headers "x-penpot-data")]
(when-not (str/empty? tdata) (when-not (str/empty? tdata)
(let [sprops (::main/props cfg) (let [result (tokens/verify (::main/props cfg) {:token tdata :iss :profile-identity})]
result (tokens/verify sprops {:token tdata :iss :profile-identity})]
(:profile-id result))))) (:profile-id result)))))
(defn- parse-notification (defn- parse-notification

47
backend/src/app/http/debug.clj
View file

@ -39,9 +39,9 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn authorized? (defn authorized?
[pool {:keys [profile-id]}] [pool {:keys [::session/profile-id]}]
(or (= "devenv" (cf/get :host)) (or (= "devenv" (cf/get :host))
(let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id)) (let [profile (ex/ignoring (profile/get-profile pool profile-id))
admins (or (cf/get :admins) #{})] admins (or (cf/get :admins) #{})]
(contains? admins (:email profile))))) (contains? admins (:email profile)))))
@ -61,7 +61,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn index-handler (defn index-handler
[{:keys [pool]} request] [{:keys [::db/pool]} request]
(when-not (authorized? pool request) (when-not (authorized? pool request)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :only-admins-allowed)) :code :only-admins-allowed))
@ -81,7 +81,7 @@
"select revn, changes, data from file_change where file_id=? and revn = ?") "select revn, changes, data from file_change where file_id=? and revn = ?")
(defn- retrieve-file-data (defn- retrieve-file-data
[{:keys [pool]} {:keys [params profile-id] :as request}] [{:keys [::db/pool]} {:keys [params ::session/profile-id] :as request}]
(when-not (authorized? pool request) (when-not (authorized? pool request)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :only-admins-allowed)) :code :only-admins-allowed))
@ -107,8 +107,9 @@
(prepare-download-response data filename) (prepare-download-response data filename)
(contains? params :clone) (contains? params :clone)
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id) (let [profile (profile/get-profile pool profile-id)
data (some-> data blob/decode)] project-id (:default-project-id profile)
data (blob/decode data)]
(create-file pool {:id (uuid/next) (create-file pool {:id (uuid/next)
:name (str "Cloned file: " filename) :name (str "Cloned file: " filename)
:project-id project-id :project-id project-id
@ -117,7 +118,7 @@
(yrs/response 201 "OK CREATED")) (yrs/response 201 "OK CREATED"))
:else :else
(prepare-response (some-> data blob/decode)))))) (prepare-response (blob/decode data))))))
(defn- is-file-exists? (defn- is-file-exists?
[pool id] [pool id]
@ -125,8 +126,9 @@
(-> (db/exec-one! pool [sql id]) :exists))) (-> (db/exec-one! pool [sql id]) :exists)))
(defn- upload-file-data (defn- upload-file-data
[{:keys [pool]} {:keys [profile-id params] :as request}] [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id) (let [profile (profile/get-profile pool profile-id)
project-id (:default-project-id profile)
data (some-> params :file :path io/read-as-bytes blob/decode)] data (some-> params :file :path io/read-as-bytes blob/decode)]
(if (and data project-id) (if (and data project-id)
@ -162,7 +164,7 @@
:code :method-not-found))) :code :method-not-found)))
(defn file-changes-handler (defn file-changes-handler
[{:keys [pool]} {:keys [params] :as request}] [{:keys [::db/pool]} {:keys [params] :as request}]
(when-not (authorized? pool request) (when-not (authorized? pool request)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :only-admins-allowed)) :code :only-admins-allowed))
@ -202,7 +204,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn error-handler (defn error-handler
[{:keys [pool]} request] [{:keys [::db/pool]} request]
(letfn [(parse-id [request] (letfn [(parse-id [request]
(let [id (get-in request [:path-params :id]) (let [id (get-in request [:path-params :id])
id (parse-uuid id)] id (parse-uuid id)]
@ -251,7 +253,7 @@
LIMIT 100") LIMIT 100")
(defn error-list-handler (defn error-list-handler
[{:keys [pool]} request] [{:keys [::db/pool]} request]
(when-not (authorized? pool request) (when-not (authorized? pool request)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :only-admins-allowed)) :code :only-admins-allowed))
@ -268,7 +270,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn export-handler (defn export-handler
[{:keys [pool] :as cfg} {:keys [params profile-id] :as request}] [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
(let [file-ids (->> (:file-ids params) (let [file-ids (->> (:file-ids params)
(remove empty?) (remove empty?)
@ -287,7 +289,8 @@
(assoc ::binf/include-libraries? libs?) (assoc ::binf/include-libraries? libs?)
(binf/export-to-tmpfile!))] (binf/export-to-tmpfile!))]
(if clone? (if clone?
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)] (let [profile (profile/get-profile pool profile-id)
project-id (:default-project-id profile)]
(binf/import! (binf/import!
(assoc cfg (assoc cfg
::binf/input path ::binf/input path
@ -309,15 +312,16 @@
(defn import-handler (defn import-handler
[{:keys [pool] :as cfg} {:keys [params profile-id] :as request}] [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
(when-not (contains? params :file) (when-not (contains? params :file)
(ex/raise :type :validation (ex/raise :type :validation
:code :missing-upload-file :code :missing-upload-file
:hint "missing upload file")) :hint "missing upload file"))
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id) (let [profile (profile/get-profile pool profile-id)
project-id (:default-project-id profile)
overwrite? (contains? params :overwrite) overwrite? (contains? params :overwrite)
migrate? (contains? params :migrate) migrate? (contains? params :migrate)
ignore-index-errors? (contains? params :ignore-index-errors)] ignore-index-errors? (contains? params :ignore-index-errors)]
(when-not project-id (when-not project-id
@ -381,16 +385,17 @@
(raise (ex/error :type :authentication (raise (ex/error :type :authentication
:code :only-admins-allowed))))))}) :code :only-admins-allowed))))))})
(defmethod ig/pre-init-spec ::routes [_] (defmethod ig/pre-init-spec ::routes [_]
(s/keys :req-un [::db/pool ::wrk/executor ::session/session])) (s/keys :req [::db/pool
::wrk/executor
::session/manager]))
(defmethod ig/init-key ::routes (defmethod ig/init-key ::routes
[_ {:keys [session pool executor] :as cfg}] [_ {:keys [::db/pool ::wrk/executor] :as cfg}]
[["/readyz" {:middleware [[mw/with-dispatch executor] [["/readyz" {:middleware [[mw/with-dispatch executor]
[mw/with-config cfg]] [mw/with-config cfg]]
:handler health-handler}] :handler health-handler}]
["/dbg" {:middleware [[session/middleware-2 session] ["/dbg" {:middleware [[session/authz cfg]
[with-authorization pool] [with-authorization pool]
[mw/with-dispatch executor] [mw/with-dispatch executor]
[mw/with-config cfg]]} [mw/with-config cfg]]}

10
backend/src/app/http/errors.clj
View file

@ -11,6 +11,8 @@
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.http :as-alias http] [app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.http.session :as-alias session]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[yetti.request :as yrq] [yetti.request :as yrq]
@ -26,7 +28,9 @@
(defn get-context (defn get-context
[request] [request]
(let [claims (:session-token-claims request)] (let [claims (-> {}
(into (::session/token-claims request))
(into (::actoken/token-claims request)))]
(merge (merge
*context* *context*
{:path (:path request) {:path (:path request)
@ -49,6 +53,10 @@
[err _] [err _]
(yrs/response 401 (ex-data err))) (yrs/response 401 (ex-data err)))
(defmethod handle-exception :authorization
[err _]
(yrs/response 403 (ex-data err)))
(defmethod handle-exception :restriction (defmethod handle-exception :restriction
[err _] [err _]
(yrs/response 400 (ex-data err))) (yrs/response 400 (ex-data err)))

3
backend/src/app/http/feedback.clj
View file

@ -13,6 +13,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.emails :as eml] [app.emails :as eml]
[app.http.session :as-alias session]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -42,7 +43,7 @@
:hint "feedback module is disabled")))))) :hint "feedback module is disabled"))))))
(defn- handler (defn- handler
[{:keys [pool] :as cfg} {:keys [profile-id] :as request}] [{:keys [pool] :as cfg} {:keys [::session/profile-id] :as request}]
(let [ftoken (cf/get :feedback-token ::no-token) (let [ftoken (cf/get :feedback-token ::no-token)
token (yrq/get-header request "x-feedback-token") token (yrq/get-header request "x-feedback-token")
params (d/merge (:params request) params (d/merge (:params request)

276
backend/src/app/http/session.clj
View file

@ -9,14 +9,17 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
[app.http.session.tasks :as-alias tasks]
[app.main :as-alias main] [app.main :as-alias main]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.core :as p] [promesa.core :as p]
[promesa.exec :as px] [promesa.exec :as px]
@ -45,55 +48,55 @@
(defprotocol ISessionManager (defprotocol ISessionManager
(read [_ key]) (read [_ key])
(decode [_ key])
(write! [_ key data]) (write! [_ key data])
(update! [_ data]) (update! [_ data])
(delete! [_ key])) (delete! [_ key]))
(s/def ::session #(satisfies? ISessionManager %)) (s/def ::manager #(satisfies? ISessionManager %))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; STORAGE IMPL ;; STORAGE IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::session-params
(s/keys :req-un [::user-agent
::profile-id
::created-at]))
(defn- prepare-session-params (defn- prepare-session-params
[props data] [key params]
(let [profile-id (:profile-id data) (us/assert! ::us/not-empty-string key)
user-agent (:user-agent data) (us/assert! ::session-params params)
created-at (or (:created-at data) (dt/now))
token (tokens/generate props {:iss "authentication" {:user-agent (:user-agent params)
:iat created-at :profile-id (:profile-id params)
:uid profile-id})] :created-at (:created-at params)
{:user-agent user-agent :updated-at (:created-at params)
:profile-id profile-id :id key})
:created-at created-at
:updated-at created-at
:id token}))
(defn- database-manager (defn- database-manager
[{:keys [::db/pool ::wrk/executor ::main/props]}] [{:keys [::db/pool ::wrk/executor ::main/props]}]
^{::wrk/executor executor
::db/pool pool
::main/props props}
(reify ISessionManager (reify ISessionManager
(read [_ token] (read [_ token]
(px/with-dispatch executor (px/with-dispatch executor
(db/exec-one! pool (sql/select :http-session {:id token})))) (db/exec-one! pool (sql/select :http-session {:id token}))))
(decode [_ token] (write! [_ key params]
(px/with-dispatch executor (px/with-dispatch executor
(tokens/verify props {:token token :iss "authentication"}))) (let [params (prepare-session-params key params)]
(write! [_ _ data]
(px/with-dispatch executor
(let [params (prepare-session-params props data)]
(db/insert! pool :http-session params) (db/insert! pool :http-session params)
params))) params)))
(update! [_ data] (update! [_ params]
(let [updated-at (dt/now)] (let [updated-at (dt/now)]
(px/with-dispatch executor (px/with-dispatch executor
(db/update! pool :http-session (db/update! pool :http-session
{:updated-at updated-at} {:updated-at updated-at}
{:id (:id data)}) {:id (:id params)})
(assoc data :updated-at updated-at)))) (assoc params :updated-at updated-at))))
(delete! [_ token] (delete! [_ token]
(px/with-dispatch executor (px/with-dispatch executor
@ -101,27 +104,26 @@
nil)))) nil))))
(defn inmemory-manager (defn inmemory-manager
[{:keys [::wrk/executor ::main/props]}] [{:keys [::db/pool ::wrk/executor ::main/props]}]
(let [cache (atom {})] (let [cache (atom {})]
^{::main/props props
::wrk/executor executor
::db/pool pool}
(reify ISessionManager (reify ISessionManager
(read [_ token] (read [_ token]
(p/do (get @cache token))) (p/do (get @cache token)))
(decode [_ token] (write! [_ key params]
(px/with-dispatch executor
(tokens/verify props {:token token :iss "authentication"})))
(write! [_ _ data]
(p/do (p/do
(let [{:keys [token] :as params} (prepare-session-params props data)] (let [params (prepare-session-params key params)]
(swap! cache assoc token params) (swap! cache assoc key params)
params))) params)))
(update! [_ data] (update! [_ params]
(p/do (p/do
(let [updated-at (dt/now)] (let [updated-at (dt/now)]
(swap! cache update (:id data) assoc :updated-at updated-at) (swap! cache update (:id params) assoc :updated-at updated-at)
(assoc data :updated-at updated-at)))) (assoc params :updated-at updated-at))))
(delete! [_ token] (delete! [_ token]
(p/do (p/do
@ -144,25 +146,34 @@
;; MANAGER IMPL ;; MANAGER IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare assign-auth-token-cookie) (declare ^:private assign-auth-token-cookie)
(declare assign-authenticated-cookie) (declare ^:private assign-authenticated-cookie)
(declare clear-auth-token-cookie) (declare ^:private clear-auth-token-cookie)
(declare clear-authenticated-cookie) (declare ^:private clear-authenticated-cookie)
(declare ^:private gen-token)
(defn create-fn (defn create-fn
[manager profile-id] [{:keys [::manager]} profile-id]
(fn [request response] (us/assert! ::manager manager)
(let [uagent (yrq/get-header request "user-agent") (us/assert! ::us/uuid profile-id)
params {:profile-id profile-id
:user-agent uagent}] (let [props (-> manager meta ::main/props)]
(-> (write! manager nil params) (fn [request response]
(p/then (fn [session] (let [uagent (yrq/get-header request "user-agent")
(l/trace :hint "create" :profile-id profile-id) params {:profile-id profile-id
(-> response :user-agent uagent
(assign-auth-token-cookie session) :created-at (dt/now)}
(assign-authenticated-cookie session)))))))) token (gen-token props params)]
(->> (write! manager token params)
(p/fmap (fn [session]
(l/trace :hint "create" :profile-id profile-id)
(-> response
(assign-auth-token-cookie session)
(assign-authenticated-cookie session)))))))))
(defn delete-fn (defn delete-fn
[manager] [{:keys [::manager]}]
(us/assert! ::manager manager)
(letfn [(delete [{:keys [profile-id] :as request}] (letfn [(delete [{:keys [profile-id] :as request}]
(let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name) (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
cookie (yrq/get-cookie request cname)] cookie (yrq/get-cookie request cname)]
@ -177,68 +188,92 @@
(clear-auth-token-cookie) (clear-auth-token-cookie)
(clear-authenticated-cookie)))))) (clear-authenticated-cookie))))))
(def middleware-1 (defn- gen-token
(letfn [(decode-cookie [manager cookie] [props {:keys [profile-id created-at]}]
(if-let [value (:value cookie)] (tokens/generate props {:iss "authentication"
(decode manager value) :iat created-at
(p/resolved nil))) :uid profile-id}))
(defn- decode-token
[props token]
(when token
(tokens/verify props {:token token :iss "authentication"})))
(wrap-handler [manager handler request respond raise] (defn- get-token
(let [cookie (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name) [request]
(yrq/get-cookie request))] (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
(->> (decode-cookie manager cookie) cookie (some-> (yrq/get-cookie request cname) :value)]
(p/fnly (fn [claims _] (when-not (str/empty? cookie)
(cond-> request cookie)))
(some? claims) (assoc :session-token-claims claims)
:always (handler respond raise)))))))]
{:name :session-1
:compile (fn [& _]
(fn [handler manager]
(partial wrap-handler manager handler)))}))
(def middleware-2 (defn- get-session
(letfn [(wrap-handler [manager handler request respond raise] [manager token]
(-> (retrieve-session manager request) (some->> token (read manager)))
(p/finally (fn [session cause]
(cond
(some? cause)
(raise cause)
(nil? session) (defn- renew-session?
(handler request respond raise) [{:keys [updated-at] :as session}]
(and (dt/instant? updated-at)
(let [elapsed (dt/diff updated-at (dt/now))]
(neg? (compare default-renewal-max-age elapsed)))))
:else (defn- wrap-reneval
(let [request (-> request [respond manager session]
(assoc :profile-id (:profile-id session)) (fn [response]
(assoc :session-id (:id session))) (p/let [session (update! manager session)]
respond (cond-> respond (-> response
(renew-session? session) (assign-auth-token-cookie session)
(wrap-respond manager session))] (assign-authenticated-cookie session)
(handler request respond raise))))))) (respond)))))
(retrieve-session [manager request] (defn- wrap-soft-auth
(let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name) [handler {:keys [::manager]}]
cookie (yrq/get-cookie request cname)] (us/assert! ::manager manager)
(some->> (:value cookie) (read manager))))
(renew-session? [{:keys [updated-at] :as session}] (let [{:keys [::wrk/executor ::main/props]} (meta manager)]
(and (dt/instant? updated-at) (fn [request respond raise]
(let [elapsed (dt/diff updated-at (dt/now))] (let [token (get-token request)]
(neg? (compare default-renewal-max-age elapsed))))) (->> (px/submit! executor (partial decode-token props token))
(p/fnly (fn [claims cause]
(when cause
(l/trace :hint "exception on decoding malformed token" :cause cause))
;; Wrap respond with session renewal code (let [request (cond-> request
(wrap-respond [respond manager session] (map? claims)
(fn [response] (-> (assoc ::token-claims claims)
(p/let [session (update! manager session)] (assoc ::token token)))]
(-> response (handler request respond raise)))))))))
(assign-auth-token-cookie session)
(assign-authenticated-cookie session)
(respond)))))]
{:name :session-2 (defn- wrap-authz
:compile (fn [& _] [handler {:keys [::manager]}]
(fn [handler manager] (us/assert! ::manager manager)
(partial wrap-handler manager handler)))})) (fn [request respond raise]
(if-let [token (::token request)]
(->> (get-session manager token)
(p/fnly (fn [session cause]
(cond
(some? cause)
(raise cause)
(nil? session)
(handler request respond raise)
:else
(let [request (-> request
(assoc ::profile-id (:profile-id session))
(assoc ::id (:id session)))
respond (cond-> respond
(renew-session? session)
(wrap-reneval manager session))]
(handler request respond raise))))))
(handler request respond raise))))
(def soft-auth
{:name ::soft-auth
:compile (constantly wrap-soft-auth)})
(def authz
{:name ::authz
:compile (constantly wrap-authz)})
;; --- IMPL ;; --- IMPL
@ -300,21 +335,26 @@
;; TASK: SESSION GC ;; TASK: SESSION GC
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare sql:delete-expired) (s/def ::tasks/max-age ::dt/duration)
(s/def ::max-age ::dt/duration) (defmethod ig/pre-init-spec ::tasks/gc [_]
(s/keys :req [::db/pool]
:opt [::tasks/max-age]))
(defmethod ig/pre-init-spec ::gc-task [_] (defmethod ig/prep-key ::tasks/gc
(s/keys :req-un [::db/pool]
:opt-un [::max-age]))
(defmethod ig/prep-key ::gc-task
[_ cfg] [_ cfg]
(merge {:max-age default-cookie-max-age} (let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
(d/without-nils cfg))) (merge {::tasks/max-age max-age} (d/without-nils cfg))))
(defmethod ig/init-key ::gc-task (def ^:private
[_ {:keys [pool max-age] :as cfg}] sql:delete-expired
"delete from http_session
where updated_at < now() - ?::interval
or (updated_at is null and
created_at < now() - ?::interval)")
(defmethod ig/init-key ::tasks/gc
[_ {:keys [::db/pool ::tasks/max-age] :as cfg}]
(l/debug :hint "initializing session gc task" :max-age max-age) (l/debug :hint "initializing session gc task" :max-age max-age)
(fn [_] (fn [_]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
@ -326,9 +366,3 @@
:deleted result) :deleted result)
result)))) result))))
(def ^:private
sql:delete-expired
"delete from http_session
where updated_at < now() - ?::interval
or (updated_at is null and
created_at < now() - ?::interval)")

88
backend/src/app/http/websocket.clj
View file

@ -12,6 +12,7 @@
[app.common.pprint :as pp] [app.common.pprint :as pp]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.http.session :as session]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.msgbus :as mbus] [app.msgbus :as mbus]
[app.util.time :as dt] [app.util.time :as dt]
@ -34,7 +35,7 @@
(def state (atom {})) (def state (atom {}))
(defn- on-connect (defn- on-connect
[{:keys [metrics]} wsp] [{:keys [::mtx/metrics]} wsp]
(let [created-at (dt/now)] (let [created-at (dt/now)]
(swap! state assoc (::ws/id @wsp) wsp) (swap! state assoc (::ws/id @wsp) wsp)
(mtx/run! metrics (mtx/run! metrics
@ -48,7 +49,7 @@
:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0))))) :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)))))
(defn- on-rcv-message (defn- on-rcv-message
[{:keys [metrics]} _ message] [{:keys [::mtx/metrics]} _ message]
(mtx/run! metrics (mtx/run! metrics
:id :websocket-messages-total :id :websocket-messages-total
:labels recv-labels :labels recv-labels
@ -56,7 +57,7 @@
message) message)
(defn- on-snd-message (defn- on-snd-message
[{:keys [metrics]} _ message] [{:keys [::mtx/metrics]} _ message]
(mtx/run! metrics (mtx/run! metrics
:id :websocket-messages-total :id :websocket-messages-total
:labels send-labels :labels send-labels
@ -95,7 +96,6 @@
:user-agent (::ws/user-agent @wsp) :user-agent (::ws/user-agent @wsp)
:ip-addr (::ws/remote-addr @wsp) :ip-addr (::ws/remote-addr @wsp)
:last-activity-at (::ws/last-activity-at @wsp) :last-activity-at (::ws/last-activity-at @wsp)
:http-session-id (::ws/http-session-id @wsp)
:subscribed-file (-> wsp deref ::file-subscription :file-id) :subscribed-file (-> wsp deref ::file-subscription :file-id)
:subscribed-team (-> wsp deref ::team-subscription :team-id)})) :subscribed-team (-> wsp deref ::team-subscription :team-id)}))
@ -120,7 +120,7 @@
(defmethod handle-message :connect (defmethod handle-message :connect
[cfg wsp _] [cfg wsp _]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
conn-id (::ws/id @wsp) conn-id (::ws/id @wsp)
profile-id (::profile-id @wsp) profile-id (::profile-id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
@ -139,7 +139,7 @@
(defmethod handle-message :disconnect (defmethod handle-message :disconnect
[cfg wsp _] [cfg wsp _]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
conn-id (::ws/id @wsp) conn-id (::ws/id @wsp)
profile-id (::profile-id @wsp) profile-id (::profile-id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
@ -173,7 +173,7 @@
(defmethod handle-message :subscribe-team (defmethod handle-message :subscribe-team
[cfg wsp {:keys [team-id] :as params}] [cfg wsp {:keys [team-id] :as params}]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
conn-id (::ws/id @wsp) conn-id (::ws/id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
output-ch (::ws/output-ch @wsp) output-ch (::ws/output-ch @wsp)
@ -205,7 +205,7 @@
(defmethod handle-message :subscribe-file (defmethod handle-message :subscribe-file
[cfg wsp {:keys [file-id] :as params}] [cfg wsp {:keys [file-id] :as params}]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
conn-id (::ws/id @wsp) conn-id (::ws/id @wsp)
profile-id (::profile-id @wsp) profile-id (::profile-id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
@ -258,7 +258,7 @@
(defmethod handle-message :unsubscribe-file (defmethod handle-message :unsubscribe-file
[cfg wsp {:keys [file-id] :as params}] [cfg wsp {:keys [file-id] :as params}]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
conn-id (::ws/id @wsp) conn-id (::ws/id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
profile-id (::profile-id @wsp) profile-id (::profile-id @wsp)
@ -288,7 +288,7 @@
(defmethod handle-message :pointer-update (defmethod handle-message :pointer-update
[cfg wsp {:keys [file-id] :as message}] [cfg wsp {:keys [file-id] :as message}]
(let [msgbus (:msgbus cfg) (let [msgbus (::mbus/msgbus cfg)
profile-id (::profile-id @wsp) profile-id (::profile-id @wsp)
session-id (::session-id @wsp) session-id (::session-id @wsp)
subs (::file-subscription @wsp) subs (::file-subscription @wsp)
@ -313,39 +313,47 @@
;; HTTP HANDLER ;; HTTP HANDLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::msgbus ::mbus/msgbus)
(s/def ::session-id ::us/uuid) (s/def ::session-id ::us/uuid)
(s/def ::handler-params (s/def ::handler-params
(s/keys :req-un [::session-id])) (s/keys :req-un [::session-id]))
(defmethod ig/pre-init-spec ::handler [_] (defn- http-handler
(s/keys :req-un [::msgbus ::db/pool ::mtx/metrics])) [cfg {:keys [params ::session/profile-id] :as request} respond raise]
(let [{:keys [session-id]} (us/conform ::handler-params params)]
(cond
(not profile-id)
(raise (ex/error :type :authentication
:hint "Authentication required."))
(defmethod ig/init-key ::handler (not (yws/upgrade-request? request))
(raise (ex/error :type :validation
:code :websocket-request-expected
:hint "this endpoint only accepts websocket connections"))
:else
(do
(l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
(->> (ws/handler
::ws/on-rcv-message (partial on-rcv-message cfg)
::ws/on-snd-message (partial on-snd-message cfg)
::ws/on-connect (partial on-connect cfg)
::ws/handler (partial handle-message cfg)
::profile-id profile-id
::session-id session-id)
(yws/upgrade request)
(respond))))))
(defmethod ig/pre-init-spec ::routes [_]
(s/keys :req [::mbus/msgbus
::mtx/metrics
::db/pool
::session/manager]))
(s/def ::routes vector?)
(defmethod ig/init-key ::routes
[_ cfg] [_ cfg]
(fn [{:keys [profile-id params] :as req} respond raise] ["/ws/notifications" {:middleware [[session/authz cfg]]
(let [{:keys [session-id]} (us/conform ::handler-params params)] :handler (partial http-handler cfg)
(cond :allowed-methods #{:get}}])
(not profile-id)
(raise (ex/error :type :authentication
:hint "Authentication required."))
(not (yws/upgrade-request? req))
(raise (ex/error :type :validation
:code :websocket-request-expected
:hint "this endpoint only accepts websocket connections"))
:else
(do
(l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
(->> (ws/handler
::ws/on-rcv-message (partial on-rcv-message cfg)
::ws/on-snd-message (partial on-snd-message cfg)
::ws/on-connect (partial on-connect cfg)
::ws/handler (partial handle-message cfg)
::profile-id profile-id
::session-id session-id)
(yws/upgrade req)
(respond)))))))

2
backend/src/app/loggers/audit.clj
View file

@ -159,7 +159,7 @@
;; this case we just retry the operation. ;; this case we just retry the operation.
(rtry/with-retry {::rtry/when rtry/conflict-exception? (rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 6 ::rtry/max-retries 6
::rtry/label "persist-audit-log-event"} ::rtry/label "persist-audit-log"}
(let [now (dt/now)] (let [now (dt/now)]
(db/insert! pool :audit-log (db/insert! pool :audit-log
(-> params (-> params

2
backend/src/app/loggers/webhooks.clj
View file

@ -111,7 +111,7 @@
" where id=?") " where id=?")
err err
(:id whook)] (:id whook)]
res (db/exec-one! pool sql {:return-keys true})] res (db/exec-one! pool sql {::db/return-keys? true})]
(when (>= (:error-count res) max-errors) (when (>= (:error-count res) max-errors)
(db/update! pool :webhook {:is-active false} {:id (:id whook)}))) (db/update! pool :webhook {:is-active false} {:id (:id whook)})))

144
backend/src/app/main.clj
View file

@ -12,15 +12,24 @@
[app.common.logging :as l] [app.common.logging :as l]
[app.config :as cf] [app.config :as cf]
[app.db :as-alias db] [app.db :as-alias db]
[app.http.access-token :as-alias actoken]
[app.http.assets :as-alias http.assets]
[app.http.awsns :as http.awsns]
[app.http.client :as-alias http.client] [app.http.client :as-alias http.client]
[app.http.session :as-alias http.session] [app.http.debug :as-alias http.debug]
[app.http.session :as-alias session]
[app.http.session.tasks :as-alias session.tasks]
[app.http.websocket :as http.ws]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.loggers.audit.tasks :as-alias audit.tasks] [app.loggers.audit.tasks :as-alias audit.tasks]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.loggers.zmq :as-alias lzmq] [app.loggers.zmq :as-alias lzmq]
[app.metrics :as-alias mtx] [app.metrics :as-alias mtx]
[app.metrics.definition :as-alias mdef] [app.metrics.definition :as-alias mdef]
[app.msgbus :as-alias mbus]
[app.redis :as-alias rds] [app.redis :as-alias rds]
[app.rpc :as-alias rpc]
[app.rpc.doc :as-alias rpc.doc]
[app.storage :as-alias sto] [app.storage :as-alias sto]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
@ -180,6 +189,9 @@
::mtx/metrics ::mtx/metrics
{:default default-metrics} {:default default-metrics}
::mtx/routes
{::mtx/metrics (ig/ref ::mtx/metrics)}
:app.migrations/all :app.migrations/all
{:main (ig/ref :app.migrations/migrations)} {:main (ig/ref :app.migrations/migrations)}
@ -187,7 +199,7 @@
{::rds/uri (cf/get :redis-uri) {::rds/uri (cf/get :redis-uri)
::mtx/metrics (ig/ref ::mtx/metrics)} ::mtx/metrics (ig/ref ::mtx/metrics)}
:app.msgbus/msgbus ::mbus/msgbus
{:backend (cf/get :msgbus-backend :redis) {:backend (cf/get :msgbus-backend :redis)
:executor (ig/ref ::wrk/executor) :executor (ig/ref ::wrk/executor)
:redis (ig/ref ::rds/redis)} :redis (ig/ref ::rds/redis)}
@ -207,16 +219,20 @@
::http.client/client ::http.client/client
{::wrk/executor (ig/ref ::wrk/executor)} {::wrk/executor (ig/ref ::wrk/executor)}
:app.http.session/manager ::session/manager
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props)} ::props (ig/ref :app.setup/props)}
:app.http.session/gc-task ::actoken/manager
{:pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
:max-age (cf/get :auth-token-cookie-max-age)} ::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props)}
:app.http.awsns/handler ::session.tasks/gc
{::db/pool (ig/ref ::db/pool)}
::http.awsns/routes
{::props (ig/ref :app.setup/props) {::props (ig/ref :app.setup/props)
::db/pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)
::http.client/client (ig/ref ::http.client/client) ::http.client/client (ig/ref ::http.client/client)
@ -259,50 +275,44 @@
{::http.client/client (ig/ref ::http.client/client)} {::http.client/client (ig/ref ::http.client/client)}
::oidc/routes ::oidc/routes
{::http.client/client (ig/ref ::http.client/client) {::http.client/client (ig/ref ::http.client/client)
::db/pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)
::props (ig/ref :app.setup/props) ::props (ig/ref :app.setup/props)
::wrk/executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
::oidc/providers {:google (ig/ref ::oidc.providers/google) ::oidc/providers {:google (ig/ref ::oidc.providers/google)
:github (ig/ref ::oidc.providers/github) :github (ig/ref ::oidc.providers/github)
:gitlab (ig/ref ::oidc.providers/gitlab) :gitlab (ig/ref ::oidc.providers/gitlab)
:oidc (ig/ref ::oidc.providers/generic)} :oidc (ig/ref ::oidc.providers/generic)}
::audit/collector (ig/ref ::audit/collector) ::audit/collector (ig/ref ::audit/collector)
::http.session/session (ig/ref :app.http.session/manager)} ::session/manager (ig/ref ::session/manager)}
;; TODO: revisit the dependencies of this service, looks they are too much unused of them
:app.http/router :app.http/router
{:assets (ig/ref :app.http.assets/handlers) {::session/manager (ig/ref ::session/manager)
:feedback (ig/ref :app.http.feedback/handler) ::actoken/manager (ig/ref ::actoken/manager)
:session (ig/ref :app.http.session/manager) ::wrk/executor (ig/ref ::wrk/executor)
:awsns-handler (ig/ref :app.http.awsns/handler) ::db/pool (ig/ref ::db/pool)
:debug-routes (ig/ref :app.http.debug/routes) ::rpc/routes (ig/ref ::rpc/routes)
:oidc-routes (ig/ref ::oidc/routes) ::rpc.doc/routes (ig/ref ::rpc.doc/routes)
:ws (ig/ref :app.http.websocket/handler) ::props (ig/ref :app.setup/props)
:metrics (ig/ref ::mtx/metrics) ::mtx/routes (ig/ref ::mtx/routes)
:public-uri (cf/get :public-uri) ::oidc/routes (ig/ref ::oidc/routes)
:storage (ig/ref ::sto/storage) ::http.debug/routes (ig/ref ::http.debug/routes)
:rpc-routes (ig/ref :app.rpc/routes) ::http.assets/routes (ig/ref ::http.assets/routes)
:doc-routes (ig/ref :app.rpc.doc/routes) ::http.ws/routes (ig/ref ::http.ws/routes)
:executor (ig/ref ::wrk/executor)} ::http.awsns/routes (ig/ref ::http.awsns/routes)}
:app.http.debug/routes :app.http.debug/routes
{:pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
:storage (ig/ref ::sto/storage) ::session/manager (ig/ref ::session/manager)}
:session (ig/ref :app.http.session/manager)
::db/pool (ig/ref ::db/pool) :app.http.websocket/routes
::wrk/executor (ig/ref ::wrk/executor) {::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)} ::mtx/metrics (ig/ref ::mtx/metrics)
::mbus/msgbus (ig/ref :app.msgbus/msgbus)
::session/manager (ig/ref ::session/manager)}
:app.http.websocket/handler :app.http.assets/routes
{:pool (ig/ref ::db/pool)
:metrics (ig/ref ::mtx/metrics)
:msgbus (ig/ref :app.msgbus/msgbus)}
:app.http.assets/handlers
{:metrics (ig/ref ::mtx/metrics) {:metrics (ig/ref ::mtx/metrics)
:assets-path (cf/get :assets-path) :assets-path (cf/get :assets-path)
:storage (ig/ref ::sto/storage) :storage (ig/ref ::sto/storage)
@ -310,37 +320,32 @@
:cache-max-age (dt/duration {:hours 24}) :cache-max-age (dt/duration {:hours 24})
:signature-max-age (dt/duration {:hours 24 :minutes 5})} :signature-max-age (dt/duration {:hours 24 :minutes 5})}
:app.http.feedback/handler
{:pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor)}
:app.rpc/climit :app.rpc/climit
{:metrics (ig/ref ::mtx/metrics) {::mtx/metrics (ig/ref ::mtx/metrics)
:executor (ig/ref ::wrk/executor)} ::wrk/executor (ig/ref ::wrk/executor)}
:app.rpc/rlimit :app.rpc/rlimit
{:executor (ig/ref ::wrk/executor) {::wrk/executor (ig/ref ::wrk/executor)
:scheduled-executor (ig/ref ::wrk/scheduled-executor)} ::wrk/scheduled-executor (ig/ref ::wrk/scheduled-executor)}
:app.rpc/methods :app.rpc/methods
{::audit/collector (ig/ref ::audit/collector) {::audit/collector (ig/ref ::audit/collector)
::http.client/client (ig/ref ::http.client/client) ::http.client/client (ig/ref ::http.client/client)
::db/pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor) ::wrk/executor (ig/ref ::wrk/executor)
::props (ig/ref :app.setup/props) ::session/manager (ig/ref ::session/manager)
::ldap/provider (ig/ref ::ldap/provider) ::ldap/provider (ig/ref ::ldap/provider)
::sto/storage (ig/ref ::sto/storage)
::mtx/metrics (ig/ref ::mtx/metrics)
::mbus/msgbus (ig/ref ::mbus/msgbus)
::rds/redis (ig/ref ::rds/redis)
::rpc/climit (ig/ref ::rpc/climit)
::rpc/rlimit (ig/ref ::rpc/rlimit)
::props (ig/ref :app.setup/props)
:pool (ig/ref ::db/pool) :pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager)
:sprops (ig/ref :app.setup/props)
:metrics (ig/ref ::mtx/metrics)
:storage (ig/ref ::sto/storage)
:msgbus (ig/ref :app.msgbus/msgbus)
:public-uri (cf/get :public-uri)
:redis (ig/ref ::rds/redis)
:http-client (ig/ref ::http.client/client)
:climit (ig/ref :app.rpc/climit)
:rlimit (ig/ref :app.rpc/rlimit)
:executor (ig/ref ::wrk/executor)
:templates (ig/ref :app.setup/builtin-templates) :templates (ig/ref :app.setup/builtin-templates)
} }
@ -348,7 +353,12 @@
{:methods (ig/ref :app.rpc/methods)} {:methods (ig/ref :app.rpc/methods)}
:app.rpc/routes :app.rpc/routes
{:methods (ig/ref :app.rpc/methods)} {::rpc/methods (ig/ref :app.rpc/methods)
::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor)
::session/manager (ig/ref ::session/manager)
::actoken/manager (ig/ref ::actoken/manager)
::props (ig/ref :app.setup/props)}
::wrk/registry ::wrk/registry
{:metrics (ig/ref ::mtx/metrics) {:metrics (ig/ref ::mtx/metrics)
@ -361,7 +371,7 @@
:storage-gc-touched (ig/ref ::sto/gc-touched-task) :storage-gc-touched (ig/ref ::sto/gc-touched-task)
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler) :tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
:telemetry (ig/ref :app.tasks.telemetry/handler) :telemetry (ig/ref :app.tasks.telemetry/handler)
:session-gc (ig/ref :app.http.session/gc-task) :session-gc (ig/ref ::session.tasks/gc)
:audit-log-archive (ig/ref ::audit.tasks/archive) :audit-log-archive (ig/ref ::audit.tasks/archive)
:audit-log-gc (ig/ref ::audit.tasks/gc) :audit-log-gc (ig/ref ::audit.tasks/gc)

13
backend/src/app/metrics.clj
View file

@ -87,6 +87,7 @@
::definitions definitions ::definitions definitions
::registry registry})) ::registry registry}))
(defn- handler (defn- handler
[registry _ respond _] [registry _ respond _]
(let [samples (.metricFamilySamples ^CollectorRegistry registry) (let [samples (.metricFamilySamples ^CollectorRegistry registry)
@ -95,6 +96,18 @@
(respond {:headers {"content-type" TextFormat/CONTENT_TYPE_004} (respond {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))) :body (.toString writer)})))
(s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes [_]
(s/keys :req [::metrics]))
(defmethod ig/init-key ::routes
[_ {:keys [::metrics]}]
(let [registry (::registry metrics)]
["/metrics" {:handler (partial handler registry)
:allowed-methods #{:get}}]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation ;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

6
backend/src/app/migrations.clj
View file

@ -302,6 +302,12 @@
{:name "0098-add-quotes-table" {:name "0098-add-quotes-table"
:fn (mg/resource "app/migrations/sql/0098-add-quotes-table.sql")} :fn (mg/resource "app/migrations/sql/0098-add-quotes-table.sql")}
{:name "0099-add-access-token-table"
:fn (mg/resource "app/migrations/sql/0099-add-access-token-table.sql")}
{:name "0100-mod-profile-indexes"
:fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")}
]) ])

19
backend/src/app/migrations/sql/0099-add-access-token-table.sql Normal file
View file

@ -0,0 +1,19 @@
DROP TABLE IF EXISTS access_token;
CREATE TABLE access_token (
id uuid NOT NULL DEFAULT uuid_generate_v4() PRIMARY KEY,
profile_id uuid NOT NULL REFERENCES profile(id) ON DELETE CASCADE DEFERRABLE,
created_at timestamptz NOT NULL DEFAULT now(),
updated_at timestamptz NOT NULL DEFAULT now(),
name text NOT NULL,
token text NOT NULL,
perms text[] NULL
);
ALTER TABLE access_token
ALTER COLUMN name SET STORAGE external,
ALTER COLUMN token SET STORAGE external,
ALTER COLUMN perms SET STORAGE external;
CREATE INDEX access_token__profile_id__idx ON access_token(profile_id);

34
backend/src/app/migrations/sql/0100-mod-profile-indexes.sql Normal file
View file

@ -0,0 +1,34 @@
DROP INDEX profile__email__idx;
CREATE INDEX profile__email__idx ON profile(email);
ALTER TABLE profile
ADD COLUMN default_project_id uuid NULL REFERENCES project(id) ON DELETE SET NULL DEFERRABLE,
ADD COLUMN default_team_id uuid NULL REFERENCES team(id) ON DELETE SET NULL DEFERRABLE;
CREATE INDEX profile__default_project__idx ON profile(default_project_id);
CREATE INDEX profile__default_team__idx ON profile(default_team_id);
with profiles as (
select p.id,
tpr.team_id as default_team_id,
ppr.project_id as default_project_id
from profile as p
join team_profile_rel as tpr
on (tpr.profile_id = p.id and
tpr.is_owner is true)
join project_profile_rel as ppr
on (ppr.profile_id = p.id and
ppr.is_owner is true)
join project as pj
on (pj.id = ppr.project_id)
join team as tm
on (tm.id = tpr.team_id)
where pj.is_default is true
and tm.is_default is true
and pj.team_id = tm.id
)
update profile
set default_team_id = p.default_team_id,
default_project_id = p.default_project_id
from profiles as p
where profile.id = p.id;

24
backend/src/app/redis.clj
View file

@ -193,6 +193,7 @@
(defn get-or-connect (defn get-or-connect
[{:keys [::cache] :as state} key options] [{:keys [::cache] :as state} key options]
(us/assert! ::redis state)
(-> state (-> state
(assoc ::connection (assoc ::connection
(or (get @cache key) (or (get @cache key)
@ -205,7 +206,6 @@
(defn add-listener! (defn add-listener!
[{:keys [::connection] :as conn} listener] [{:keys [::connection] :as conn} listener]
(us/assert! ::connection-holder conn)
(us/assert! ::pubsub-connection connection) (us/assert! ::pubsub-connection connection)
(us/assert! ::pubsub-listener listener) (us/assert! ::pubsub-listener listener)
(.addListener ^StatefulRedisPubSubConnection @connection (.addListener ^StatefulRedisPubSubConnection @connection
@ -213,10 +213,9 @@
conn) conn)
(defn publish! (defn publish!
[{:keys [::connection] :as conn} topic message] [{:keys [::connection]} topic message]
(us/assert! ::us/string topic) (us/assert! ::us/string topic)
(us/assert! ::us/bytes message) (us/assert! ::us/bytes message)
(us/assert! ::connection-holder conn)
(us/assert! ::default-connection connection) (us/assert! ::default-connection connection)
(let [pcomm (.async ^StatefulRedisConnection @connection)] (let [pcomm (.async ^StatefulRedisConnection @connection)]
@ -224,8 +223,7 @@
(defn subscribe! (defn subscribe!
"Blocking operation, intended to be used on a thread/agent thread." "Blocking operation, intended to be used on a thread/agent thread."
[{:keys [::connection] :as conn} & topics] [{:keys [::connection]} & topics]
(us/assert! ::connection-holder conn)
(us/assert! ::pubsub-connection connection) (us/assert! ::pubsub-connection connection)
(try (try
(let [topics (into-array String (map str topics)) (let [topics (into-array String (map str topics))
@ -236,8 +234,7 @@
(defn unsubscribe! (defn unsubscribe!
"Blocking operation, intended to be used on a thread/agent thread." "Blocking operation, intended to be used on a thread/agent thread."
[{:keys [::connection] :as conn} & topics] [{:keys [::connection]} & topics]
(us/assert! ::connection-holder conn)
(us/assert! ::pubsub-connection connection) (us/assert! ::pubsub-connection connection)
(try (try
(let [topics (into-array String (map str topics)) (let [topics (into-array String (map str topics))
@ -247,8 +244,8 @@
(throw (InterruptedException. (ex-message cause)))))) (throw (InterruptedException. (ex-message cause))))))
(defn rpush! (defn rpush!
[{:keys [::connection] :as conn} key payload] [{:keys [::connection]} key payload]
(us/assert! ::connection-holder conn) (us/assert! ::default-connection connection)
(us/assert! (or (and (vector? payload) (us/assert! (or (and (vector? payload)
(every? bytes? payload)) (every? bytes? payload))
(bytes? payload))) (bytes? payload)))
@ -270,8 +267,8 @@
(throw (InterruptedException. (ex-message cause)))))) (throw (InterruptedException. (ex-message cause))))))
(defn blpop! (defn blpop!
[{:keys [::connection] :as conn} timeout & keys] [{:keys [::connection]} timeout & keys]
(us/assert! ::connection-holder conn) (us/assert! ::default-connection connection)
(try (try
(let [keys (into-array Object (map str keys)) (let [keys (into-array Object (map str keys))
cmd (.sync ^StatefulRedisConnection @connection) cmd (.sync ^StatefulRedisConnection @connection)
@ -286,8 +283,7 @@
(throw (InterruptedException. (ex-message cause)))))) (throw (InterruptedException. (ex-message cause))))))
(defn open? (defn open?
[{:keys [::connection] :as conn}] [{:keys [::connection]}]
(us/assert! ::connection-holder conn)
(us/assert! ::pubsub-connection connection) (us/assert! ::pubsub-connection connection)
(.isOpen ^StatefulConnection @connection)) (.isOpen ^StatefulConnection @connection))
@ -335,7 +331,7 @@
(defn eval! (defn eval!
[{:keys [::mtx/metrics ::connection] :as state} script] [{:keys [::mtx/metrics ::connection] :as state} script]
(us/assert! ::redis state) (us/assert! ::redis state)
(us/assert! ::connection-holder state) (us/assert! ::default-connection connection)
(us/assert! ::rscript/script script) (us/assert! ::rscript/script script)
(let [cmd (.async ^StatefulRedisConnection @connection) (let [cmd (.async ^StatefulRedisConnection @connection)

322
backend/src/app/rpc.clj
View file

@ -12,12 +12,15 @@
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http :as-alias http] [app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.http.client :as-alias http.client] [app.http.client :as-alias http.client]
[app.http.session :as-alias http.session] [app.http.session :as-alias session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.main :as-alias main]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.msgbus :as-alias mbus] [app.msgbus :as-alias mbus]
[app.rpc.climit :as climit] [app.rpc.climit :as climit]
@ -71,71 +74,77 @@
(defn- rpc-query-handler (defn- rpc-query-handler
"Ring handler that dispatches query requests and convert between "Ring handler that dispatches query requests and convert between
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id path-params params] :as request} respond raise] [methods {:keys [params path-params] :as request} respond raise]
(let [type (keyword (:type path-params)) (let [type (keyword (:type path-params))
data (-> params profile-id (or (::session/profile-id request)
(assoc ::request-at (dt/now)) (::actoken/profile-id request))
(assoc ::http/request request))
data (if profile-id
(-> data
(assoc :profile-id profile-id)
(assoc ::profile-id profile-id)
(assoc ::session-id session-id))
(dissoc data :profile-id ::profile-id))
method (get methods type default-handler)]
(-> (method data) data (-> params
(p/then (partial handle-response request)) (assoc ::request-at (dt/now))
(p/then respond) (assoc ::http/request request))
(p/catch (fn [cause] data (if profile-id
(let [context {:profile-id profile-id}] (-> data
(raise (ex/wrap-with-context cause context)))))))) (assoc :profile-id profile-id)
(assoc ::profile-id profile-id))
(dissoc data :profile-id ::profile-id))
method (get methods type default-handler)]
(->> (method data)
(p/mcat (partial handle-response request))
(p/fnly (fn [response cause]
(if cause
(raise (ex/wrap-with-context cause {:profile-id profile-id}))
(respond response)))))))
(defn- rpc-mutation-handler (defn- rpc-mutation-handler
"Ring handler that dispatches mutation requests and convert between "Ring handler that dispatches mutation requests and convert between
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id path-params params] :as request} respond raise] [methods {:keys [params path-params] :as request} respond raise]
(let [type (keyword (:type path-params)) (let [type (keyword (:type path-params))
data (-> params profile-id (or (::session/profile-id request)
(assoc ::request-at (dt/now)) (::actoken/profile-id request))
(assoc ::http/request request)) data (-> params
data (if profile-id (assoc ::request-at (dt/now))
(-> data (assoc ::http/request request))
(assoc :profile-id profile-id) data (if profile-id
(assoc ::profile-id profile-id) (-> data
(assoc ::session-id session-id)) (assoc :profile-id profile-id)
(dissoc data :profile-id ::profile-id)) (assoc ::profile-id profile-id))
method (get methods type default-handler)] (dissoc data :profile-id))
(-> (method data) method (get methods type default-handler)]
(p/then (partial handle-response request))
(p/then respond) (->> (method data)
(p/catch (fn [cause] (p/mcat (partial handle-response request))
(let [context {:profile-id profile-id}] (p/fnly (fn [response cause]
(raise (ex/wrap-with-context cause context)))))))) (if cause
(raise (ex/wrap-with-context cause {:profile-id profile-id}))
(respond response)))))))
(defn- rpc-command-handler (defn- rpc-command-handler
"Ring handler that dispatches cmd requests and convert between "Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id path-params params] :as request} respond raise] [methods {:keys [params path-params] :as request} respond raise]
(let [cmd (keyword (:type path-params)) (let [type (keyword (:type path-params))
etag (yrq/get-header request "if-none-match") etag (yrq/get-header request "if-none-match")
profile-id (or (::session/profile-id request)
(::actoken/profile-id request))
data (-> params data (-> params
(assoc ::request-at (dt/now)) (assoc ::request-at (dt/now))
(assoc ::http/request request) (assoc ::http/request request)
(assoc ::cond/key etag) (assoc ::cond/key etag)
(cond-> (uuid? profile-id) (cond-> (uuid? profile-id)
(-> (assoc ::profile-id profile-id) (assoc ::profile-id profile-id)))
(assoc ::session-id session-id))))
method (get methods type default-handler)]
method (get methods cmd default-handler)]
(binding [cond/*enabled* true] (binding [cond/*enabled* true]
(-> (method data) (->> (method data)
(p/then (partial handle-response request)) (p/mcat (partial handle-response request))
(p/then respond) (p/fnly (fn [response cause]
(p/catch (fn [cause] (if cause
(let [context {:profile-id profile-id}] (raise (ex/wrap-with-context cause {:profile-id profile-id}))
(raise (ex/wrap-with-context cause context))))))))) (respond response))))))))
(defn- wrap-metrics (defn- wrap-metrics
"Wrap service method with metrics measurement." "Wrap service method with metrics measurement."
@ -143,18 +152,46 @@
(let [labels (into-array String [(::sv/name mdata)])] (let [labels (into-array String [(::sv/name mdata)])]
(fn [cfg params] (fn [cfg params]
(let [tp (dt/tpoint)] (let [tp (dt/tpoint)]
(p/finally (->> (f cfg params)
(f cfg params) (p/fnly (fn [_ _]
(fn [_ _] (mtx/run! metrics
(mtx/run! metrics :id metrics-id
:id metrics-id :val (inst-ms (tp))
:val (inst-ms (tp)) :labels labels))))))))
:labels labels)))))))
(defn- wrap-authentication
[_ f {:keys [::auth] :as mdata}]
(fn [cfg params]
(let [profile-id (::profile-id params)]
(if (and auth (not (uuid? profile-id)))
(p/rejected
(ex/error :type :authentication
:code :authentication-required
:hint "authentication required for this endpoint"))
(f cfg params)))))
(defn- wrap-access-token
"Wraps service method with access token validation."
[_ f {:keys [::sv/name] :as mdata}]
(if (contains? cf/flags :access-tokens)
(fn [cfg params]
(let [request (::http/request params)]
(if (contains? request ::actoken/id)
(let [perms (::actoken/perms request #{})]
(if (contains? perms name)
(f cfg params)
(p/rejected
(ex/error :type :authorization
:code :operation-not-allowed
:allowed perms))))
(f cfg params))))
f))
(defn- wrap-dispatch (defn- wrap-dispatch
"Wraps service method into async flow, with the ability to dispatching "Wraps service method into async flow, with the ability to dispatching
it to a preconfigured executor service." it to a preconfigured executor service."
[{:keys [executor] :as cfg} f mdata] [{:keys [::wrk/executor] :as cfg} f mdata]
(with-meta (with-meta
(fn [cfg params] (fn [cfg params]
(->> (px/submit! executor (px/wrap-bindings #(f cfg params))) (->> (px/submit! executor (px/wrap-bindings #(f cfg params)))
@ -222,37 +259,34 @@
f)) f))
f)) f))
(defn- wrap-spec-conform
[_ f mdata]
(let [spec (or (::sv/spec mdata) (s/spec any?))]
(fn [cfg params]
(let [params (ex/try! (us/conform spec params))]
(if (ex/exception? params)
(p/rejected params)
(f cfg params))))))
(defn- wrap-all
[cfg f mdata]
(as-> f $
(wrap-dispatch cfg $ mdata)
(wrap-metrics cfg $ mdata)
(cond/wrap cfg $ mdata)
(retry/wrap-retry cfg $ mdata)
(climit/wrap cfg $ mdata)
(rlimit/wrap cfg $ mdata)
(wrap-audit cfg $ mdata)
(wrap-spec-conform cfg $ mdata)
(wrap-authentication cfg $ mdata)
(wrap-access-token cfg $ mdata)))
(defn- wrap (defn- wrap
[cfg f mdata] [cfg f mdata]
(let [f (as-> f $ (l/debug :hint "register method" :name (::sv/name mdata))
(wrap-dispatch cfg $ mdata) (let [f (wrap-all cfg f mdata)]
(cond/wrap cfg $ mdata) (with-meta #(f cfg %) mdata)))
(retry/wrap-retry cfg $ mdata)
(wrap-metrics cfg $ mdata)
(climit/wrap cfg $ mdata)
(rlimit/wrap cfg $ mdata)
(wrap-audit cfg $ mdata))
spec (or (::sv/spec mdata) (s/spec any?))
auth? (::auth mdata true)]
(l/debug :hint "register method" :name (::sv/name mdata))
(with-meta
(fn [params]
;; Raise authentication error when rpc method requires auth but
;; no profile-id is found in the request.
(let [profile-id (if (= "command" (::type cfg))
(::profile-id params)
(:profile-id params))]
(p/do!
(if (and auth? (not (uuid? profile-id)))
(ex/raise :type :authentication
:code :authentication-required
:hint "authentication required for this endpoint")
(let [params (us/conform spec params)]
(f cfg params))))))
mdata)))
(defn- process-method (defn- process-method
[cfg vfn] [cfg vfn]
@ -263,74 +297,70 @@
(defn- resolve-query-methods (defn- resolve-query-methods
[cfg] [cfg]
(let [cfg (assoc cfg ::type "query" ::metrics-id :rpc-query-timing)] (let [cfg (assoc cfg ::type "query" ::metrics-id :rpc-query-timing)]
(->> (sv/scan-ns 'app.rpc.queries.projects (->> (sv/scan-ns
'app.rpc.queries.files 'app.rpc.queries.projects
'app.rpc.queries.teams 'app.rpc.queries.files
'app.rpc.queries.profile 'app.rpc.queries.teams
'app.rpc.queries.viewer 'app.rpc.queries.profile
'app.rpc.queries.fonts) 'app.rpc.queries.viewer
'app.rpc.queries.fonts)
(map (partial process-method cfg)) (map (partial process-method cfg))
(into {})))) (into {}))))
(defn- resolve-mutation-methods (defn- resolve-mutation-methods
[cfg] [cfg]
(let [cfg (assoc cfg ::type "mutation" ::metrics-id :rpc-mutation-timing)] (let [cfg (assoc cfg ::type "mutation" ::metrics-id :rpc-mutation-timing)]
(->> (sv/scan-ns 'app.rpc.mutations.media (->> (sv/scan-ns
'app.rpc.mutations.profile 'app.rpc.mutations.media
'app.rpc.mutations.files 'app.rpc.mutations.profile
'app.rpc.mutations.projects 'app.rpc.mutations.files
'app.rpc.mutations.teams 'app.rpc.mutations.projects
'app.rpc.mutations.fonts 'app.rpc.mutations.teams
'app.rpc.mutations.share-link) 'app.rpc.mutations.fonts
'app.rpc.mutations.share-link)
(map (partial process-method cfg)) (map (partial process-method cfg))
(into {})))) (into {}))))
(defn- resolve-command-methods (defn- resolve-command-methods
[cfg] [cfg]
(let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)] (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
(->> (sv/scan-ns 'app.rpc.commands.binfile (->> (sv/scan-ns
'app.rpc.commands.comments 'app.rpc.commands.access-token
'app.rpc.commands.management 'app.rpc.commands.audit
'app.rpc.commands.verify-token 'app.rpc.commands.auth
'app.rpc.commands.search 'app.rpc.commands.binfile
'app.rpc.commands.media 'app.rpc.commands.comments
'app.rpc.commands.teams 'app.rpc.commands.demo
'app.rpc.commands.auth 'app.rpc.commands.files
'app.rpc.commands.ldap 'app.rpc.commands.files.create
'app.rpc.commands.demo 'app.rpc.commands.files.temp
'app.rpc.commands.webhooks 'app.rpc.commands.files.update
'app.rpc.commands.audit 'app.rpc.commands.ldap
'app.rpc.commands.files 'app.rpc.commands.management
'app.rpc.commands.files.update 'app.rpc.commands.media
'app.rpc.commands.files.create 'app.rpc.commands.profile
'app.rpc.commands.files.temp) 'app.rpc.commands.search
'app.rpc.commands.teams
'app.rpc.commands.verify-token
'app.rpc.commands.webhooks)
(map (partial process-method cfg)) (map (partial process-method cfg))
(into {})))) (into {}))))
(s/def ::ldap (s/nilable map?))
(s/def ::msgbus ::mbus/msgbus)
(s/def ::climit (s/nilable ::climit/climit))
(s/def ::rlimit (s/nilable ::rlimit/rlimit))
(s/def ::public-uri ::us/not-empty-string)
(s/def ::sprops map?)
(defmethod ig/pre-init-spec ::methods [_] (defmethod ig/pre-init-spec ::methods [_]
(s/keys :req [::audit/collector (s/keys :req [::audit/collector
::session/manager
::http.client/client ::http.client/client
::db/pool ::db/pool
::mbus/msgbus
::ldap/provider ::ldap/provider
::wrk/executor] ::sto/storage
:req-un [::sto/storage ::mtx/metrics
::http.session/session ::main/props
::sprops ::wrk/executor
::public-uri ]
::msgbus :opt [::climit
::rlimit ::rlimit]
::climit :req-un [::db/pool]))
::wrk/executor
::mtx/metrics
::db/pool]))
(defmethod ig/init-key ::methods (defmethod ig/init-key ::methods
[_ cfg] [_ cfg]
@ -352,12 +382,20 @@
::queries ::queries
::commands])) ::commands]))
(s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes [_] (defmethod ig/pre-init-spec ::routes [_]
(s/keys :req-un [::methods])) (s/keys :req [::methods
::db/pool
::main/props
::wrk/executor
::session/manager
::actoken/manager]))
(defmethod ig/init-key ::routes (defmethod ig/init-key ::routes
[_ {:keys [methods] :as cfg}] [_ {:keys [::methods] :as cfg}]
[["/rpc" [["/rpc" {:middleware [[session/authz cfg]
[actoken/authz cfg]]}
["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}] ["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}]
["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}] ["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}]
["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods)) ["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods))

26
backend/src/app/rpc/climit.clj
View file

@ -46,7 +46,7 @@
(p/rejected (p/rejected
(ex/error :type :internal (ex/error :type :internal
:code :concurrency-limit-reached :code :concurrency-limit-reached
:queue (-> limiter meta :bkey name) :queue (-> limiter meta ::bkey name)
:cause cause)) :cause cause))
(some? cause) (some? cause)
@ -56,7 +56,7 @@
(p/resolved result)))))) (p/resolved result))))))
(defn- create-limiter (defn- create-limiter
[{:keys [executor metrics concurrency queue-size bkey skey]}] [{:keys [::wrk/executor ::mtx/metrics ::bkey ::skey concurrency queue-size]}]
(let [labels (into-array String [(name bkey)]) (let [labels (into-array String [(name bkey)])
on-queue (fn [instance] on-queue (fn [instance]
(l/trace :hint "enqueued" (l/trace :hint "enqueued"
@ -100,10 +100,10 @@
:on-run on-run}] :on-run on-run}]
(-> (pxb/create options) (-> (pxb/create options)
(vary-meta assoc :bkey bkey :skey skey)))) (vary-meta assoc ::bkey bkey ::skey skey))))
(defn- create-cache (defn- create-cache
[{:keys [executor] :as params} config] [{:keys [::wrk/executor] :as params} config]
(let [listener (reify RemovalListener (let [listener (reify RemovalListener
(onRemoval [_ key _val cause] (onRemoval [_ key _val cause]
(l/trace :hint "cache: remove" :key key :reason (str cause)))) (l/trace :hint "cache: remove" :key key :reason (str cause))))
@ -113,8 +113,8 @@
(let [[bkey skey] key] (let [[bkey skey] key]
(when-let [config (get config bkey)] (when-let [config (get config bkey)]
(-> (merge params config) (-> (merge params config)
(assoc :bkey bkey) (assoc ::bkey bkey)
(assoc :skey skey) (assoc ::skey skey)
(create-limiter))))))] (create-limiter))))))]
(.. (Caffeine/newBuilder) (.. (Caffeine/newBuilder)
@ -134,14 +134,16 @@
(defmethod ig/prep-key ::rpc/climit (defmethod ig/prep-key ::rpc/climit
[_ cfg] [_ cfg]
(merge {:path (cf/get :rpc-climit-config)} (merge {::path (cf/get :rpc-climit-config)}
(d/without-nils cfg))) (d/without-nils cfg)))
(s/def ::path ::fs/path)
(defmethod ig/pre-init-spec ::rpc/climit [_] (defmethod ig/pre-init-spec ::rpc/climit [_]
(s/keys :req-un [::wrk/executor ::mtx/metrics ::fs/path])) (s/keys :req [::wrk/executor ::mtx/metrics ::path]))
(defmethod ig/init-key ::rpc/climit (defmethod ig/init-key ::rpc/climit
[_ {:keys [path] :as params}] [_ {:keys [::path] :as params}]
(when (contains? cf/flags :rpc-climit) (when (contains? cf/flags :rpc-climit)
(if-let [config (some->> path slurp edn/read-string)] (if-let [config (some->> path slurp edn/read-string)]
(do (do
@ -163,7 +165,8 @@
(l/warn :hint "unable to load configuration" :config (str path))))) (l/warn :hint "unable to load configuration" :config (str path)))))
(s/def ::climit #(satisfies? IConcurrencyManager %)) (s/def ::rpc/climit
(s/nilable #(satisfies? IConcurrencyManager %)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API ;; PUBLIC API
@ -176,7 +179,7 @@
(p/wrap (do ~@body)))) (p/wrap (do ~@body))))
(defn wrap (defn wrap
[{:keys [climit]} f {:keys [::queue ::key-fn] :as mdata}] [{:keys [::rpc/climit]} f {:keys [::queue ::key-fn] :as mdata}]
(if (and (some? climit) (if (and (some? climit)
(some? queue)) (some? queue))
(if-let [config (get @climit queue)] (if-let [config (get @climit queue)]
@ -192,7 +195,6 @@
(let [key [queue (key-fn params)] (let [key [queue (key-fn params)]
lim (get climit key)] lim (get climit key)]
(invoke! lim (partial f cfg params)))) (invoke! lim (partial f cfg params))))
(let [lim (get climit queue)] (let [lim (get climit queue)]
(fn [cfg params] (fn [cfg params]
(invoke! lim (partial f cfg params)))))) (invoke! lim (partial f cfg params))))))

64
backend/src/app/rpc/commands/access_token.clj Normal file
View file

@ -0,0 +1,64 @@
;; 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) KALEIDOS INC
(ns app.rpc.commands.access-token
(:require
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.main :as-alias main]
[app.rpc :as-alias rpc]
[app.rpc.doc :as-alias doc]
[app.rpc.quotes :as quotes]
[app.tokens :as tokens]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
(defn- create-access-token
[{:keys [::conn ::main/props]} profile-id name perms]
(let [created-at (dt/now)
token-id (uuid/next)
token (tokens/generate props {:iss "access-token"
:tid token-id
:iat created-at})]
(db/insert! conn :access-token
{:id token-id
:name name
:token token
:profile-id profile-id
:created-at created-at
:updated-at created-at
:perms (db/create-array conn "text" perms)})))
(defn repl-create-access-token
[{:keys [::db/pool] :as system} profile-id name perms]
(db/with-atomic [conn pool]
(let [props (:app.setup/props system)]
(create-access-token {::conn conn ::main/props props}
profile-id
name
perms))))
(s/def ::name ::us/not-empty-string)
(s/def ::perms ::us/set-of-strings)
(s/def ::create-access-token
(s/keys :req [::rpc/profile-id]
:req-un [::name ::perms]))
(sv/defmethod ::create-access-token
{::doc/added "1.18"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name perms]}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg ::conn conn)]
(quotes/check-quote! conn
{::quotes/id ::quotes/access-tokens-per-profile
::quotes/profile-id profile-id})
(create-access-token cfg profile-id name perms))))

2
backend/src/app/rpc/commands/audit.clj
View file

@ -42,7 +42,7 @@
:profile-id :ip-addr :props :context]) :profile-id :ip-addr :props :context])
(defn- handle-events (defn- handle-events
[{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request] :as params}] [{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request]}]
(let [ip-addr (audit/parse-client-ip request) (let [ip-addr (audit/parse-client-ip request)
xform (comp xform (comp
(map #(assoc % :profile-id profile-id)) (map #(assoc % :profile-id profile-id))

71
backend/src/app/rpc/commands/auth.clj
View file

@ -69,7 +69,7 @@
;; ---- COMMAND: login with password ;; ---- COMMAND: login with password
(defn login-with-password (defn login-with-password
[{:keys [::db/pool session] :as cfg} {:keys [email password] :as params}] [{:keys [::db/pool] :as cfg} {:keys [email password] :as params}]
(when-not (or (contains? cf/flags :login) (when-not (or (contains? cf/flags :login)
(contains? cf/flags :login-with-password)) (contains? cf/flags :login-with-password))
@ -105,11 +105,10 @@
profile)] profile)]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [profile (->> (profile/retrieve-profile-data-by-email conn email) (let [profile (->> (profile/get-profile-by-email conn email)
(validate-profile) (validate-profile)
(profile/strip-private-attrs) (profile/decode-row)
(profile/populate-additional-data conn) (profile/strip-private-attrs))
(profile/decode-profile-row))
invitation (when-let [token (:invitation-token params)] invitation (when-let [token (:invitation-token params)]
(tokens/verify (::main/props cfg) {:token token :iss :team-invitation})) (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))
@ -122,14 +121,13 @@
(assoc profile :is-admin (let [admins (cf/get :admins)] (assoc profile :is-admin (let [admins (cf/get :admins)]
(contains? admins (:email profile)))))] (contains? admins (:email profile)))))]
(-> response (-> response
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/props (audit/profile->props profile) (rph/with-meta {::audit/props (audit/profile->props profile)
::audit/profile-id (:id profile)})))))) ::audit/profile-id (:id profile)}))))))
(s/def ::scope ::us/string)
(s/def ::login-with-password (s/def ::login-with-password
(s/keys :req-un [::email ::password] (s/keys :req-un [::email ::password]
:opt-un [::invitation-token ::scope])) :opt-un [::invitation-token]))
(sv/defmethod ::login-with-password (sv/defmethod ::login-with-password
"Performs authentication using penpot password." "Performs authentication using penpot password."
@ -148,8 +146,8 @@
"Clears the authentication cookie and logout the current session." "Clears the authentication cookie and logout the current session."
{::rpc/auth false {::rpc/auth false
::doc/added "1.15"} ::doc/added "1.15"}
[{:keys [session] :as cfg} _] [cfg _]
(rph/with-transform {} (session/delete-fn session))) (rph/with-transform {} (session/delete-fn cfg)))
;; ---- COMMAND: Recover Profile ;; ---- COMMAND: Recover Profile
@ -226,7 +224,7 @@
(validate-register-attempt! cfg params) (validate-register-attempt! cfg params)
(let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))] (let [profile (when-let [profile (profile/get-profile-by-email pool (:email params))]
(cond (cond
(:is-blocked profile) (:is-blocked profile)
(ex/raise :type :restriction (ex/raise :type :restriction
@ -267,10 +265,11 @@
;; ---- COMMAND: Register Profile ;; ---- COMMAND: Register Profile
(defn create-profile (defn create-profile!
"Create the profile entry on the database with limited set of input "Create the profile entry on the database with limited set of input
attrs (all the other attrs are filled with default values)." attrs (all the other attrs are filled with default values)."
[conn params] [conn {:keys [email] :as params}]
(us/assert! ::us/email email)
(let [id (or (:id params) (uuid/next)) (let [id (or (:id params) (uuid/next))
props (-> (audit/extract-utm-params params) props (-> (audit/extract-utm-params params)
(merge (:props params)) (merge (:props params))
@ -291,7 +290,7 @@
is-demo (:is-demo params false) is-demo (:is-demo params false)
is-muted (:is-muted params false) is-muted (:is-muted params false)
is-active (:is-active params false) is-active (:is-active params false)
email (str/lower (:email params)) email (str/lower email)
params {:id id params {:id id
:fullname (:fullname params) :fullname (:fullname params)
@ -306,7 +305,7 @@
:is-demo is-demo}] :is-demo is-demo}]
(try (try
(-> (db/insert! conn :profile params) (-> (db/insert! conn :profile params)
(profile/decode-profile-row)) (profile/decode-row))
(catch org.postgresql.util.PSQLException e (catch org.postgresql.util.PSQLException e
(let [state (.getSQLState e)] (let [state (.getSQLState e)]
(if (not= state "23505") (if (not= state "23505")
@ -315,15 +314,17 @@
:code :email-already-exists :code :email-already-exists
:cause e))))))) :cause e)))))))
(defn create-profile-relations (defn create-profile-rels!
[conn profile] [conn {:keys [id] :as profile}]
(let [team (teams/create-team conn {:profile-id (:id profile) (let [team (teams/create-team conn {:profile-id id
:name "Default" :name "Default"
:is-default true})] :is-default true})]
(-> profile (-> (db/update! conn :profile
(profile/strip-private-attrs) {:default-team-id (:id team)
(assoc :default-team-id (:id team)) :default-project-id (:default-project-id team)}
(assoc :default-project-id (:default-project-id team))))) {:id id})
(profile/decode-row))))
(defn send-email-verification! (defn send-email-verification!
[conn props profile] [conn props profile]
@ -347,22 +348,18 @@
:extra-data ptoken}))) :extra-data ptoken})))
(defn register-profile (defn register-profile
[{:keys [conn session] :as cfg} {:keys [token] :as params}] [{:keys [conn] :as cfg} {:keys [token] :as params}]
(let [claims (tokens/verify (::main/props cfg) {:token token :iss :prepared-register}) (let [claims (tokens/verify (::main/props cfg) {:token token :iss :prepared-register})
params (merge params claims) params (merge params claims)
is-active (or (:is-active params) is-active (or (:is-active params)
(not (contains? cf/flags :email-verification)) (not (contains? cf/flags :email-verification)))
;; DEPRECATED: v1.15
(contains? cf/flags :insecure-register))
profile (if-let [profile-id (:profile-id claims)] profile (if-let [profile-id (:profile-id claims)]
(profile/retrieve-profile conn profile-id) (profile/get-profile conn profile-id)
(->> (assoc params :is-active is-active) (->> (create-profile! conn (assoc params :is-active is-active))
(create-profile conn) (create-profile-rels! conn)))
(create-profile-relations conn)
(profile/decode-profile-row)))
invitation (when-let [token (:invitation-token params)] invitation (when-let [token (:invitation-token params)]
(tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))] (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))]
@ -389,7 +386,7 @@
token (tokens/generate (::main/props cfg) claims) token (tokens/generate (::main/props cfg) claims)
resp {:invitation-token token}] resp {:invitation-token token}]
(-> resp (-> resp
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}))) ::audit/profile-id (:id profile)})))
@ -398,7 +395,7 @@
;; we need to mark this session as logged. ;; we need to mark this session as logged.
(not= "penpot" (:auth-backend profile)) (not= "penpot" (:auth-backend profile))
(-> (profile/strip-private-attrs profile) (-> (profile/strip-private-attrs profile)
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)})) ::audit/profile-id (:id profile)}))
@ -406,7 +403,7 @@
;; to sign in the user directly, without email verification. ;; to sign in the user directly, without email verification.
(true? is-active) (true? is-active)
(-> (profile/strip-private-attrs profile) (-> (profile/strip-private-attrs profile)
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)})) ::audit/profile-id (:id profile)}))
@ -448,7 +445,7 @@
:exp (dt/in-future {:days 30})})] :exp (dt/in-future {:days 30})})]
(eml/send! {::eml/conn conn (eml/send! {::eml/conn conn
::eml/factory eml/password-recovery ::eml/factory eml/password-recovery
:public-uri (:public-uri cfg) :public-uri (cf/get :public-uri)
:to (:email profile) :to (:email profile)
:token (:token profile) :token (:token profile)
:name (:fullname profile) :name (:fullname profile)
@ -456,7 +453,7 @@
nil))] nil))]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(when-let [profile (profile/retrieve-profile-data-by-email conn email)] (when-let [profile (profile/get-profile-by-email conn email)]
(when-not (eml/allow-send-emails? conn profile) (when-not (eml/allow-send-emails? conn profile)
(ex/raise :type :validation (ex/raise :type :validation
:code :profile-is-muted :code :profile-is-muted

22
backend/src/app/rpc/commands/binfile.clj
View file

@ -436,9 +436,8 @@
(s/def ::embed-assets? (s/nilable ::us/boolean)) (s/def ::embed-assets? (s/nilable ::us/boolean))
(s/def ::write-export-options (s/def ::write-export-options
(s/keys :req-un [::db/pool ::sto/storage] (s/keys :req [::db/pool ::sto/storage ::output ::file-ids]
:req [::output ::file-ids] :opt [::include-libraries? ::embed-assets?]))
:opt [::include-libraries? ::embed-assets?]))
(defn write-export! (defn write-export!
"Do the exportation of a specified file in custom penpot binary "Do the exportation of a specified file in custom penpot binary
@ -555,9 +554,8 @@
(s/def ::ignore-index-errors? (s/nilable ::us/boolean)) (s/def ::ignore-index-errors? (s/nilable ::us/boolean))
(s/def ::read-import-options (s/def ::read-import-options
(s/keys :req-un [::db/pool ::sto/storage] (s/keys :req [::db/pool ::sto/storage ::project-id ::input]
:req [::project-id ::input] :opt [::overwrite? ::migrate? ::ignore-index-errors?]))
:opt [::overwrite? ::migrate? ::ignore-index-errors?]))
(defn read-import! (defn read-import!
"Do the importation of the specified resource in penpot custom binary "Do the importation of the specified resource in penpot custom binary
@ -580,7 +578,7 @@
(read-import (assoc options ::version version ::timestamp timestamp)))) (read-import (assoc options ::version version ::timestamp timestamp))))
(defmethod read-import :v1 (defmethod read-import :v1
[{:keys [pool ::input] :as options}] [{:keys [::db/pool ::input] :as options}]
(with-open [input (zstd-input-stream input)] (with-open [input (zstd-input-stream input)]
(with-open [input (io/data-input-stream input)] (with-open [input (io/data-input-stream input)]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
@ -673,7 +671,7 @@
(db/insert! conn :file-library-rel rel))))) (db/insert! conn :file-library-rel rel)))))
(defmethod read-section :v1/sobjects (defmethod read-section :v1/sobjects
[{:keys [storage conn ::input ::overwrite?]}] [{:keys [::sto/storage conn ::input ::overwrite?]}]
(let [storage (media/configure-assets-storage storage) (let [storage (media/configure-assets-storage storage)
ids (read-obj! input)] ids (read-obj! input)]
@ -871,13 +869,14 @@
(s/def ::embed-assets? ::us/boolean) (s/def ::embed-assets? ::us/boolean)
(s/def ::export-binfile (s/def ::export-binfile
(s/keys :req [::rpc/profile-id] :req-un [::file-id ::include-libraries? ::embed-assets?])) (s/keys :req [::rpc/profile-id]
:req-un [::file-id ::include-libraries? ::embed-assets?]))
(sv/defmethod ::export-binfile (sv/defmethod ::export-binfile
"Export a penpot file in a binary format." "Export a penpot file in a binary format."
{::doc/added "1.15" {::doc/added "1.15"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries? embed-assets?] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries? embed-assets?] :as params}]
(files/check-read-permissions! pool profile-id file-id) (files/check-read-permissions! pool profile-id file-id)
(let [body (reify yrs/StreamableResponseBody (let [body (reify yrs/StreamableResponseBody
(-write-body-to-stream [_ _ output-stream] (-write-body-to-stream [_ _ output-stream]
@ -892,7 +891,8 @@
(s/def ::file ::media/upload) (s/def ::file ::media/upload)
(s/def ::import-binfile (s/def ::import-binfile
(s/keys :req [::rpc/profile-id] :req-un [::project-id ::file])) (s/keys :req [::rpc/profile-id]
:req-un [::project-id ::file]))
(sv/defmethod ::import-binfile (sv/defmethod ::import-binfile
"Import a penpot file in a binary format." "Import a penpot file in a binary format."

22
backend/src/app/rpc/commands/comments.clj
View file

@ -54,8 +54,8 @@
:hint "file not found")))) :hint "file not found"))))
(defn- get-comment-thread (defn- get-comment-thread
[conn thread-id & {:keys [for-update?]}] [conn thread-id & {:as opts}]
(-> (db/get-by-id conn :comment-thread thread-id {:for-update for-update?}) (-> (db/get-by-id conn :comment-thread thread-id opts)
(decode-row))) (decode-row)))
(defn- get-comment (defn- get-comment
@ -374,7 +374,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)] (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(upsert-comment-thread-status! conn profile-id id)))) (upsert-comment-thread-status! conn profile-id id))))
@ -391,7 +391,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)] (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread (db/update! conn :comment-thread
{:is-resolved is-resolved} {:is-resolved is-resolved}
@ -414,7 +414,7 @@
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id :for-update? true) (let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)
{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)] {:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
(files/check-comment-permissions! conn profile-id (:id file) share-id) (files/check-comment-permissions! conn profile-id (:id file) share-id)
@ -467,8 +467,8 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [thread-id] :as comment} (get-comment conn id :for-update? true) (let [{:keys [thread-id] :as comment} (get-comment conn id ::db/for-update? true)
{:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id :for-update? true)] {:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
@ -500,7 +500,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id :for-update? true)] (let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(when-not (= owner-id profile-id) (when-not (= owner-id profile-id)
(ex/raise :type :validation (ex/raise :type :validation
@ -520,7 +520,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [owner-id thread-id] :as comment} (get-comment conn id :for-update? true) (let [{:keys [owner-id thread-id] :as comment} (get-comment conn id ::db/for-update? true)
{:keys [file-id] :as thread} (get-comment-thread conn thread-id)] {:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(when-not (= owner-id profile-id) (when-not (= owner-id profile-id)
@ -540,7 +540,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)] (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread (db/update! conn :comment-thread
{:modified-at (::rpc/request-at params) {:modified-at (::rpc/request-at params)
@ -560,7 +560,7 @@
{::doc/added "1.15"} {::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)] (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread (db/update! conn :comment-thread
{:modified-at (::rpc/request-at params) {:modified-at (::rpc/request-at params)

36
backend/src/app/rpc/commands/demo.clj
View file

@ -8,12 +8,11 @@
"A demo specific mutations." "A demo specific mutations."
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as auth]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
@ -31,31 +30,30 @@
::doc/added "1.15" ::doc/added "1.15"
::doc/changes ["1.15" "This method is migrated from mutations to commands."]} ::doc/changes ["1.15" "This method is migrated from mutations to commands."]}
[{:keys [pool] :as cfg} _] [{:keys [pool] :as cfg} _]
(let [id (uuid/next)
sem (System/currentTimeMillis) (when-not (contains? cf/flags :demo-users)
(ex/raise :type :validation
:code :demo-users-not-allowed
:hint "Demo users are disabled by config."))
(let [sem (System/currentTimeMillis)
email (str "demo-" sem ".demo@example.com") email (str "demo-" sem ".demo@example.com")
fullname (str "Demo User " sem) fullname (str "Demo User " sem)
password (-> (bn/random-bytes 16) password (-> (bn/random-bytes 16)
(bc/bytes->b64u) (bc/bytes->b64u)
(bc/bytes->str)) (bc/bytes->str))
params {:id id
:email email params {:email email
:fullname fullname :fullname fullname
:is-active true :is-active true
:deleted-at (dt/in-future cf/deletion-delay) :deleted-at (dt/in-future cf/deletion-delay)
:password password :password password
:props {} :props {}}]
}]
(when-not (contains? cf/flags :demo-users)
(ex/raise :type :validation
:code :demo-users-not-allowed
:hint "Demo users are disabled by config."))
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(->> (cmd.auth/create-profile conn params) (let [profile (->> (auth/create-profile! conn params)
(cmd.auth/create-profile-relations conn)) (auth/create-profile-rels! conn))]
(with-meta {:email email
(with-meta {:email email :password password}
:password password} {::audit/profile-id (:id profile)})))))
{::audit/profile-id id}))))

4
backend/src/app/rpc/commands/files.clj
View file

@ -189,7 +189,7 @@
(let [row (db/get conn :file-data-fragment (let [row (db/get conn :file-data-fragment
{:id id :file-id file-id} {:id id :file-id file-id}
{:columns [:content] {:columns [:content]
:check-deleted? false})] ::db/check-deleted? false})]
(blob/decode (:content row)))) (blob/decode (:content row))))
(defn persist-pointers! (defn persist-pointers!
@ -811,7 +811,7 @@
(let [ldata (-> library decode-row pmg/migrate-file :data)] (let [ldata (-> library decode-row pmg/migrate-file :data)]
(->> (db/query conn :file-library-rel {:library-file-id id}) (->> (db/query conn :file-library-rel {:library-file-id id})
(map :file-id) (map :file-id)
(keep #(db/get-by-id conn :file % {:check-deleted? false})) (keep #(db/get-by-id conn :file % ::db/check-deleted? false))
(map decode-row) (map decode-row)
(map pmg/migrate-file) (map pmg/migrate-file)
(run! (fn [{:keys [id data revn] :as file}] (run! (fn [{:keys [id data revn] :as file}]

9
backend/src/app/rpc/commands/files/temp.clj
View file

@ -45,7 +45,7 @@
;; --- MUTATION COMMAND: update-temp-file ;; --- MUTATION COMMAND: update-temp-file
(defn update-temp-file (defn update-temp-file
[conn {:keys [::rpc/profile-id session-id id revn changes] :as params}] [conn {:keys [profile-id session-id id revn changes] :as params}]
(db/insert! conn :file-change (db/insert! conn :file-change
{:id (uuid/next) {:id (uuid/next)
:session-id session-id :session-id session-id
@ -57,16 +57,17 @@
:changes (blob/encode changes)})) :changes (blob/encode changes)}))
(s/def ::update-temp-file (s/def ::update-temp-file
(s/keys :req-un [::files.update/changes (s/keys :req [::rpc/profile-id]
:req-un [::files.update/changes
::files.update/revn ::files.update/revn
::files.update/session-id ::files.update/session-id
::files/id])) ::files/id]))
(sv/defmethod ::update-temp-file (sv/defmethod ::update-temp-file
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} params] [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(update-temp-file conn params) (update-temp-file conn (assoc params :profile-id profile-id))
nil)) nil))
;; --- MUTATION COMMAND: persist-temp-file ;; --- MUTATION COMMAND: persist-temp-file

4
backend/src/app/rpc/commands/files/update.clj
View file

@ -145,7 +145,7 @@
(l/trace :hint "update-file" :time (dt/format-duration elapsed)))))))) (l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
(defn update-file (defn update-file
[{:keys [conn metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}] [{:keys [conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}]
(let [file (get-file conn id) (let [file (get-file conn id)
features (->> (concat (:features file) features (->> (concat (:features file)
(:features params)) (:features params))
@ -275,7 +275,7 @@
(defn- send-notifications! (defn- send-notifications!
[{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}] [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}]
(let [lchanges (filter library-change? changes) (let [lchanges (filter library-change? changes)
msgbus (:msgbus cfg)] msgbus (::mbus/msgbus cfg)]
;; Asynchronously publish message to the msgbus ;; Asynchronously publish message to the msgbus
(mbus/pub! msgbus (mbus/pub! msgbus

17
backend/src/app/rpc/commands/ldap.clj
View file

@ -14,7 +14,7 @@
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.main :as-alias main] [app.main :as-alias main]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as auth]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph] [app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
@ -39,7 +39,7 @@
is properly configured and enabled with `login-with-ldap` flag." is properly configured and enabled with `login-with-ldap` flag."
{::rpc/auth false {::rpc/auth false
::doc/added "1.15"} ::doc/added "1.15"}
[{:keys [::main/props ::ldap/provider session] :as cfg} params] [{:keys [::main/props ::ldap/provider] :as cfg} params]
(when-not provider (when-not provider
(ex/raise :type :restriction (ex/raise :type :restriction
:code :ldap-not-initialized :code :ldap-not-initialized
@ -67,12 +67,12 @@
:member-email (:email profile)) :member-email (:email profile))
token (tokens/generate props claims)] token (tokens/generate props claims)]
(-> {:invitation-token token} (-> {:invitation-token token}
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/props (:props profile) (rph/with-meta {::audit/props (:props profile)
::audit/profile-id (:id profile)}))) ::audit/profile-id (:id profile)})))
(-> profile (-> profile
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/props (:props profile) (rph/with-meta {::audit/props (:props profile)
::audit/profile-id (:id profile)})))))) ::audit/profile-id (:id profile)}))))))
@ -80,11 +80,10 @@
[{:keys [pool] :as cfg} info] [{:keys [pool] :as cfg} info]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(or (some->> (:email info) (or (some->> (:email info)
(profile/retrieve-profile-data-by-email conn) (profile/get-profile-by-email conn)
(profile/populate-additional-data conn) (profile/decode-row))
(profile/decode-profile-row))
(->> (assoc info :is-active true :is-demo false) (->> (assoc info :is-active true :is-demo false)
(cmd.auth/create-profile conn) (auth/create-profile! conn)
(cmd.auth/create-profile-relations conn) (auth/create-profile-rels! conn)
(profile/strip-private-attrs))))) (profile/strip-private-attrs)))))

11
backend/src/app/rpc/commands/media.clj
View file

@ -23,6 +23,7 @@
[app.storage.tmp :as tmp] [app.storage.tmp :as tmp]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.io :as io] [datoteka.io :as io]
@ -66,8 +67,8 @@
(sv/defmethod ::upload-file-media-object (sv/defmethod ::upload-file-media-object
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(media/validate-media-type! content) (media/validate-media-type! content)
(validate-content-size! content) (validate-content-size! content)
@ -110,7 +111,7 @@
;; inverse, soft referential integrity). ;; inverse, soft referential integrity).
(defn create-file-media-object (defn create-file-media-object
[{:keys [storage pool climit executor]} [{:keys [::sto/storage ::db/pool climit ::wrk/executor]}
{:keys [id file-id is-local name content]}] {:keys [id file-id is-local name content]}]
(letfn [;; Function responsible to retrieve the file information, as (letfn [;; Function responsible to retrieve the file information, as
;; it is synchronous operation it should be wrapped into ;; it is synchronous operation it should be wrapped into
@ -186,8 +187,8 @@
(sv/defmethod ::create-file-media-object-from-url (sv/defmethod ::create-file-media-object-from-url
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(create-file-media-object-from-url cfg params))) (create-file-media-object-from-url cfg params)))

24
backend/src/app/rpc/commands/teams.clj
View file

@ -28,6 +28,7 @@
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p] [promesa.core :as p]
@ -114,8 +115,8 @@
(defn retrieve-teams (defn retrieve-teams
[conn profile-id] [conn profile-id]
(let [defaults (profile/retrieve-additional-data conn profile-id)] (let [profile (profile/get-profile conn profile-id)]
(->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id]) (->> (db/exec! conn [sql:teams (:default-team-id profile) profile-id])
(mapv process-permissions)))) (mapv process-permissions))))
;; --- Query: Team (by ID) ;; --- Query: Team (by ID)
@ -134,14 +135,15 @@
(defn retrieve-team (defn retrieve-team
[conn profile-id team-id] [conn profile-id team-id]
(let [defaults (profile/retrieve-additional-data conn profile-id) (let [profile (profile/get-profile conn profile-id)
sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?") sql (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
result (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])] result (db/exec-one! conn [sql (:default-team-id profile) profile-id team-id])]
(when-not result (when-not result
(ex/raise :type :not-found (ex/raise :type :not-found
:code :team-does-not-exist)) :code :team-does-not-exist))
(process-permissions result)))
(process-permissions result)))
;; --- Query: Team Members ;; --- Query: Team Members
@ -583,11 +585,11 @@
[cfg {:keys [::rpc/profile-id file] :as params}] [cfg {:keys [::rpc/profile-id file] :as params}]
;; Validate incoming mime type ;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"}) (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(update-team-photo cfg (assoc params :profile-id profile-id)))) (update-team-photo cfg (assoc params :profile-id profile-id))))
(defn update-team-photo (defn update-team-photo
[{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}] [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
(p/let [team (px/with-dispatch executor (p/let [team (px/with-dispatch executor
(retrieve-team pool profile-id team-id)) (retrieve-team pool profile-id team-id))
photo (upload-photo cfg params)] photo (upload-photo cfg params)]
@ -605,7 +607,7 @@
(assoc team :photo-id (:id photo)))) (assoc team :photo-id (:id photo))))
(defn upload-photo (defn upload-photo
[{:keys [storage executor climit] :as cfg} {:keys [file]}] [{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
(letfn [(get-info [content] (letfn [(get-info [content]
(climit/with-dispatch (:process-image climit) (climit/with-dispatch (:process-image climit)
(media/run {:cmd :info :input content}))) (media/run {:cmd :info :input content})))
@ -663,7 +665,7 @@
(defn- create-invitation (defn- create-invitation
[{:keys [::conn] :as cfg} {:keys [team profile role email] :as params}] [{:keys [::conn] :as cfg} {:keys [team profile role email] :as params}]
(let [member (profile/retrieve-profile-data-by-email conn email) (let [member (profile/get-profile-by-email conn email)
expire (dt/in-future "168h") ;; 7 days expire (dt/in-future "168h") ;; 7 days
itoken (create-invitation-token cfg {:profile-id (:id profile) itoken (create-invitation-token cfg {:profile-id (:id profile)
:valid-until expire :valid-until expire
@ -838,7 +840,7 @@
{:team-id team-id {:team-id team-id
:email-to (str/lower email)}) :email-to (str/lower email)})
(update :role keyword)) (update :role keyword))
member (profile/retrieve-profile-data-by-email pool (:email invit)) member (profile/get-profile-by-email pool (:email invit))
token (create-invitation-token cfg {:team-id (:team-id invit) token (create-invitation-token cfg {:team-id (:team-id invit)
:profile-id profile-id :profile-id profile-id
:valid-until (:valid-until invit) :valid-until (:valid-until invit)

19
backend/src/app/rpc/commands/verify_token.clj
View file

@ -11,6 +11,7 @@
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.teams :as teams] [app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
@ -34,15 +35,15 @@
(sv/defmethod ::verify-token (sv/defmethod ::verify-token
{::rpc/auth false {::rpc/auth false
::doc/added "1.15"} ::doc/added "1.15"}
[{:keys [pool sprops] :as cfg} {:keys [token] :as params}] [{:keys [pool] :as cfg} {:keys [token] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [claims (tokens/verify sprops {:token token}) (let [claims (tokens/verify (::main/props cfg) {:token token})
cfg (assoc cfg :conn conn)] cfg (assoc cfg :conn conn)]
(process-token cfg params claims)))) (process-token cfg params claims))))
(defmethod process-token :change-email (defmethod process-token :change-email
[{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}] [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
(when (profile/retrieve-profile-data-by-email conn email) (when (profile/get-profile-by-email conn email)
(ex/raise :type :validation (ex/raise :type :validation
:code :email-already-exists)) :code :email-already-exists))
@ -56,8 +57,8 @@
::audit/profile-id profile-id})) ::audit/profile-id profile-id}))
(defmethod process-token :verify-email (defmethod process-token :verify-email
[{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}] [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}]
(let [profile (profile/retrieve-profile conn profile-id) (let [profile (profile/get-profile conn profile-id)
claims (assoc claims :profile profile)] claims (assoc claims :profile profile)]
(when-not (:is-active profile) (when-not (:is-active profile)
@ -71,14 +72,14 @@
{:id (:id profile)})) {:id (:id profile)}))
(-> claims (-> claims
(rph/with-transform (session/create-fn session profile-id)) (rph/with-transform (session/create-fn cfg profile-id))
(rph/with-meta {::audit/name "verify-profile-email" (rph/with-meta {::audit/name "verify-profile-email"
::audit/props (audit/profile->props profile) ::audit/props (audit/profile->props profile)
::audit/profile-id (:id profile)})))) ::audit/profile-id (:id profile)}))))
(defmethod process-token :auth (defmethod process-token :auth
[{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}] [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
(let [profile (profile/retrieve-profile conn profile-id)] (let [profile (profile/get-profile conn profile-id)]
(assoc claims :profile profile))) (assoc claims :profile profile)))
;; --- Team Invitation ;; --- Team Invitation
@ -133,7 +134,7 @@
:opt-un [::spec.team-invitation/member-id])) :opt-un [::spec.team-invitation/member-id]))
(defmethod process-token :team-invitation (defmethod process-token :team-invitation
[{:keys [conn session] :as cfg} [{:keys [conn] :as cfg}
{:keys [::rpc/profile-id token]} {:keys [::rpc/profile-id token]}
{:keys [member-id team-id member-email] :as claims}] {:keys [member-id team-id member-email] :as claims}]
@ -179,7 +180,7 @@
{:columns [:id :email]})] {:columns [:id :email]})]
(let [profile (accept-invitation cfg claims invitation member)] (let [profile (accept-invitation cfg claims invitation member)]
(-> (assoc claims :state :created) (-> (assoc claims :state :created)
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/name "accept-team-invitation" (rph/with-meta {::audit/name "accept-team-invitation"
::audit/props (merge ::audit/props (merge
(audit/profile->props profile) (audit/profile->props profile)

2
backend/src/app/rpc/doc.clj
View file

@ -70,6 +70,8 @@
(respond (yrs/response 404))))) (respond (yrs/response 404)))))
(s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes [_] (defmethod ig/pre-init-spec ::routes [_]
(s/keys :req-un [::rpc/methods])) (s/keys :req-un [::rpc/methods]))

5
backend/src/app/rpc/mutations/fonts.clj
View file

@ -22,6 +22,7 @@
[app.storage :as sto] [app.storage :as sto]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[promesa.core :as p] [promesa.core :as p]
[promesa.exec :as px])) [promesa.exec :as px]))
@ -48,7 +49,7 @@
{::doc/added "1.3" {::doc/added "1.3"
::webhooks/event? true} ::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(teams/check-edition-permissions! pool profile-id team-id) (teams/check-edition-permissions! pool profile-id team-id)
(quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team (quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team
::quotes/profile-id profile-id ::quotes/profile-id profile-id
@ -56,7 +57,7 @@
(create-font-variant cfg params))) (create-font-variant cfg params)))
(defn create-font-variant (defn create-font-variant
[{:keys [storage pool executor climit] :as cfg} {:keys [data] :as params}] [{:keys [::sto/storage ::db/pool ::wrk/executor climit] :as cfg} {:keys [data] :as params}]
(letfn [(generate-fonts [data] (letfn [(generate-fonts [data]
(climit/with-dispatch (:process-font climit) (climit/with-dispatch (:process-font climit)
(media/run {:cmd :generate-fonts :input data}))) (media/run {:cmd :generate-fonts :input data})))

5
backend/src/app/rpc/mutations/media.clj
View file

@ -11,6 +11,7 @@
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
[app.rpc.commands.media :as cmd.media] [app.rpc.commands.media :as cmd.media]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.storage :as-alias sto]
[app.util.services :as sv] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -22,7 +23,7 @@
{::doc/added "1.2" {::doc/added "1.2"
::doc/deprecated "1.17"} ::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(media/validate-media-type! content) (media/validate-media-type! content)
(cmd.media/validate-content-size! content) (cmd.media/validate-content-size! content)
@ -36,7 +37,7 @@
{::doc/added "1.3" {::doc/added "1.3"
::doc/deprecated "1.17"} ::doc/deprecated "1.17"}
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(#'cmd.media/create-file-media-object-from-url cfg params))) (#'cmd.media/create-file-media-object-from-url cfg params)))

39
backend/src/app/rpc/mutations/profile.clj
View file

@ -15,6 +15,7 @@
[app.emails :as eml] [app.emails :as eml]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main]
[app.media :as media] [app.media :as media]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit] [app.rpc.climit :as-alias climit]
@ -27,6 +28,7 @@
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p] [promesa.core :as p]
@ -51,13 +53,13 @@
(sv/defmethod ::update-profile (sv/defmethod ::update-profile
{::doc/added "1.0"} {::doc/added "1.0"}
[{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}] [{:keys [::db/pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use ;; NOTE: we need to retrieve the profile independently if we use
;; it or not for explicit locking and avoid concurrent updates of ;; it or not for explicit locking and avoid concurrent updates of
;; the same row/object. ;; the same row/object.
(let [profile (-> (db/get-by-id conn :profile profile-id {:for-update true}) (let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
(profile/decode-profile-row)) (profile/decode-row))
;; Update the profile map with direct params ;; Update the profile map with direct params
profile (-> profile profile (-> profile
@ -90,7 +92,7 @@
(sv/defmethod ::update-profile-password (sv/defmethod ::update-profile-password
{::climit/queue :auth} {::climit/queue :auth}
[{:keys [pool] :as cfg} {:keys [password] :as params}] [{:keys [::db/pool] :as cfg} {:keys [password] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [profile (validate-password! conn params) (let [profile (validate-password! conn params)
session-id (::rpc/session-id params)] session-id (::rpc/session-id params)]
@ -135,11 +137,11 @@
[cfg {:keys [file] :as params}] [cfg {:keys [file] :as params}]
;; Validate incoming mime type ;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"}) (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(update-profile-photo cfg params))) (update-profile-photo cfg params)))
(defn update-profile-photo (defn update-profile-photo
[{:keys [pool storage executor] :as cfg} {:keys [profile-id file] :as params}] [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
(p/let [profile (px/with-dispatch executor (p/let [profile (px/with-dispatch executor
(db/get-by-id pool :profile profile-id)) (db/get-by-id pool :profile profile-id))
photo (teams/upload-photo cfg params)] photo (teams/upload-photo cfg params)]
@ -169,7 +171,7 @@
(s/keys :req-un [::email])) (s/keys :req-un [::email]))
(sv/defmethod ::request-email-change (sv/defmethod ::request-email-change
[{:keys [pool] :as cfg} {:keys [profile-id email] :as params}] [{:keys [::db/pool] :as cfg} {:keys [profile-id email] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [profile (db/get-by-id conn :profile profile-id) (let [profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg :conn conn) cfg (assoc cfg :conn conn)
@ -190,13 +192,13 @@
{:changed true}) {:changed true})
(defn- request-email-change (defn- request-email-change
[{:keys [conn sprops] :as cfg} {:keys [profile email] :as params}] [{:keys [conn] :as cfg} {:keys [profile email] :as params}]
(let [token (tokens/generate sprops (let [token (tokens/generate (::main/props cfg)
{:iss :change-email {:iss :change-email
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
:profile-id (:id profile) :profile-id (:id profile)
:email email}) :email email})
ptoken (tokens/generate sprops ptoken (tokens/generate (::main/props cfg)
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile) :profile-id (:id profile)
:exp (dt/in-future {:days 30})})] :exp (dt/in-future {:days 30})})]
@ -216,7 +218,7 @@
(eml/send! {::eml/conn conn (eml/send! {::eml/conn conn
::eml/factory eml/change-email ::eml/factory eml/change-email
:public-uri (:public-uri cfg) :public-uri (cf/get :public-uri)
:to (:email profile) :to (:email profile)
:name (:fullname profile) :name (:fullname profile)
:pending-email email :pending-email email
@ -225,11 +227,6 @@
nil)) nil))
(defn select-profile-for-update
[conn id]
(db/get-by-id conn :profile id {:for-update true}))
;; --- MUTATION: Update Profile Props ;; --- MUTATION: Update Profile Props
(s/def ::props map?) (s/def ::props map?)
@ -237,9 +234,9 @@
(s/keys :req-un [::profile-id ::props])) (s/keys :req-un [::profile-id ::props]))
(sv/defmethod ::update-profile-props (sv/defmethod ::update-profile-props
[{:keys [pool] :as cfg} {:keys [profile-id props]}] [{:keys [::db/pool] :as cfg} {:keys [profile-id props]}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [profile (profile/retrieve-profile-data conn profile-id) (let [profile (profile/get-profile conn profile-id ::db/for-update? true)
props (reduce-kv (fn [props k v] props (reduce-kv (fn [props k v]
;; We don't accept namespaced keys ;; We don't accept namespaced keys
(if (simple-ident? k) (if (simple-ident? k)
@ -254,7 +251,7 @@
{:props (db/tjson props)} {:props (db/tjson props)}
{:id profile-id}) {:id profile-id})
(profile/filter-profile-props props)))) (profile/filter-props props))))
;; --- MUTATION: Delete Profile ;; --- MUTATION: Delete Profile
@ -267,7 +264,7 @@
(s/keys :req-un [::profile-id])) (s/keys :req-un [::profile-id]))
(sv/defmethod ::delete-profile (sv/defmethod ::delete-profile
[{:keys [pool session] :as cfg} {:keys [profile-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [profile-id] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [teams (get-owned-teams-with-participants conn profile-id) (let [teams (get-owned-teams-with-participants conn profile-id)
deleted-at (dt/now)] deleted-at (dt/now)]
@ -290,7 +287,7 @@
{:deleted-at deleted-at} {:deleted-at deleted-at}
{:id profile-id}) {:id profile-id})
(rph/with-transform {} (session/delete-fn session))))) (rph/with-transform {} (session/delete-fn cfg)))))
(def sql:owned-teams (def sql:owned-teams
"with owner_teams as ( "with owner_teams as (

3
backend/src/app/rpc/mutations/teams.clj
View file

@ -15,6 +15,7 @@
[app.rpc.commands.teams :as cmd.teams] [app.rpc.commands.teams :as cmd.teams]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph] [app.rpc.helpers :as rph]
[app.storage :as-alias sto]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
@ -126,7 +127,7 @@
[cfg {:keys [file] :as params}] [cfg {:keys [file] :as params}]
;; Validate incoming mime type ;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"}) (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
(let [cfg (update cfg :storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(cmd.teams/update-team-photo cfg params))) (cmd.teams/update-team-photo cfg params)))
;; --- Mutation: Invite Member ;; --- Mutation: Invite Member

97
backend/src/app/rpc/queries/profile.clj
View file

@ -6,7 +6,6 @@
(ns app.rpc.queries.profile (ns app.rpc.queries.profile
(:require (:require
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
@ -17,8 +16,6 @@
;; --- Helpers & Specs ;; --- Helpers & Specs
(declare strip-private-attrs)
(s/def ::email ::us/email) (s/def ::email ::us/email)
(s/def ::fullname ::us/string) (s/def ::fullname ::us/string)
(s/def ::old-password ::us/string) (s/def ::old-password ::us/string)
@ -30,73 +27,32 @@
;; --- Query: Profile (own) ;; --- Query: Profile (own)
(declare retrieve-profile) (declare decode-row)
(declare retrieve-additional-data) (declare get-profile)
(declare strip-private-attrs)
(declare filter-props)
(s/def ::profile (s/def ::profile
(s/keys :opt-un [::profile-id])) (s/keys :opt-un [::profile-id]))
(sv/defmethod ::profile (sv/defmethod ::profile
{::rpc/auth false} {::rpc/auth false}
[{:keys [pool] :as cfg} {:keys [profile-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [profile-id]}]
;; We need to return the anonymous profile object in two cases, when ;; We need to return the anonymous profile object in two cases, when
;; no profile-id is in session, and when db call raises not found. In all other ;; no profile-id is in session, and when db call raises not found. In all other
;; cases we need to reraise the exception. ;; cases we need to reraise the exception.
(or (ex/try* (try
#(some->> profile-id (retrieve-profile pool)) (-> (get-profile pool profile-id)
#(when (not= :not-found (:type (ex-data %))) (throw %))) (strip-private-attrs)
{:id uuid/zero (update :props filter-props))
:fullname "Anonymous User"})) (catch Throwable _
{:id uuid/zero :fullname "Anonymous User"})))
(def ^:private sql:default-profile-team (defn get-profile
"select t.id, name "Get profile by id. Throws not-found exception if no profile found."
from team as t [conn id & {:as attrs}]
inner join team_profile_rel as tp on (tp.team_id = t.id) (-> (db/get-by-id conn :profile id attrs)
where tp.profile_id = ? (decode-row)))
and tp.is_owner is true
and t.is_default is true")
(def ^:private sql:default-profile-project
"select p.id, name
from project as p
inner join project_profile_rel as tp on (tp.project_id = p.id)
where tp.profile_id = ?
and tp.is_owner is true
and p.is_default is true
and p.team_id = ?")
(defn retrieve-additional-data
[conn id]
(let [team (db/exec-one! conn [sql:default-profile-team id])
project (db/exec-one! conn [sql:default-profile-project id (:id team)])]
{:default-team-id (:id team)
:default-project-id (:id project)}))
(defn populate-additional-data
[conn profile]
(merge profile (retrieve-additional-data conn (:id profile))))
(defn filter-profile-props
[props]
(into {} (filter (fn [[k _]] (simple-ident? k))) props))
(defn decode-profile-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props "jsonb")
(assoc :props (db/decode-transit-pgobject props))))
(defn retrieve-profile-data
[conn id]
(-> (db/get-by-id conn :profile id)
(decode-profile-row)))
(defn retrieve-profile
[conn id]
(let [profile (->> (retrieve-profile-data conn id)
(strip-private-attrs)
(populate-additional-data conn))]
(update profile :props filter-profile-props)))
(def ^:private sql:profile-by-email (def ^:private sql:profile-by-email
"select p.* from profile as p "select p.* from profile as p
@ -104,14 +60,27 @@
and (p.deleted_at is null or and (p.deleted_at is null or
p.deleted_at > now())") p.deleted_at > now())")
(defn retrieve-profile-data-by-email (defn get-profile-by-email
"Returns a profile looked up by email or `nil` if not match found."
[conn email] [conn email]
(ex/ignoring (->> (db/exec! conn [sql:profile-by-email (str/lower email)])
(db/exec-one! conn [sql:profile-by-email (str/lower email)]))) (map decode-row)
(first)))
;; --- Attrs Helpers ;; --- HELPERS
(defn strip-private-attrs (defn strip-private-attrs
"Only selects a publicly visible profile attrs." "Only selects a publicly visible profile attrs."
[row] [row]
(dissoc row :password :deleted-at)) (dissoc row :password :deleted-at))
(defn filter-props
"Removes all namespace qualified props from `props` attr."
[props]
(into {} (filter (fn [[k _]] (simple-ident? k))) props))
(defn decode-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props "jsonb")
(assoc :props (db/decode-transit-pgobject props))))

5
backend/src/app/rpc/queries/share_link.clj
View file

@ -16,8 +16,7 @@
(defn retrieve-share-link (defn retrieve-share-link
[conn file-id share-id] [conn file-id share-id]
(some-> (db/get-by-params conn :share-link (some-> (db/get* conn :share-link
{:id share-id :file-id file-id} {:id share-id :file-id file-id})
{:check-not-found false})
(decode-share-link-row))) (decode-share-link-row)))

23
backend/src/app/rpc/quotes.clj
View file

@ -160,6 +160,28 @@
(assoc ::count-sql [sql:get-teams-per-profile profile-id]) (assoc ::count-sql [sql:get-teams-per-profile profile-id])
(generic-check!))) (generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: ACCESS-TOKENS-PER-PROFILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-access-tokens-per-profile
"select count(*) as total
from access_token
where profile_id = ?")
(s/def ::access-tokens-per-profile
(s/keys :req [::profile-id ::target]))
(defmethod check-quote ::access-tokens-per-profile
[{:keys [::profile-id ::target] :as quote}]
(us/assert! ::access-tokens-per-profile quote)
(-> quote
(assoc ::default (cf/get :quotes-access-tokens-per-profile Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-1 target profile-id])
(assoc ::count-sql [sql:get-access-tokens-per-profile profile-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: PROJECTS-PER-TEAM ;; QUOTE: PROJECTS-PER-TEAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -279,7 +301,6 @@
(assoc ::count-sql [sql:get-files-per-project project-id]) (assoc ::count-sql [sql:get-files-per-project project-id])
(generic-check!))) (generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: COMMENT-THREADS-PER-FILE ;; QUOTE: COMMENT-THREADS-PER-FILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

205
backend/src/app/rpc/rlimit.clj
View file

@ -52,7 +52,7 @@
[app.config :as cf] [app.config :as cf]
[app.http :as-alias http] [app.http :as-alias http]
[app.loggers.audit :refer [parse-client-ip]] [app.loggers.audit :refer [parse-client-ip]]
[app.redis :as redis] [app.redis :as rds]
[app.redis.script :as-alias rscript] [app.redis.script :as-alias rscript]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.rlimit.result :as-alias lresult] [app.rpc.rlimit.result :as-alias lresult]
@ -71,7 +71,7 @@
(dt/duration 400)) (dt/duration 400))
(def ^:private default-options (def ^:private default-options
{:codec redis/string-codec {:codec rds/string-codec
:timeout default-timeout}) :timeout default-timeout})
(def ^:private bucket-rate-limit-script (def ^:private bucket-rate-limit-script
@ -141,23 +141,23 @@
(let [script (-> bucket-rate-limit-script (let [script (-> bucket-rate-limit-script
(assoc ::rscript/keys [(str key "." service "." user-id)]) (assoc ::rscript/keys [(str key "." service "." user-id)])
(assoc ::rscript/vals (conj params (dt/->seconds now))))] (assoc ::rscript/vals (conj params (dt/->seconds now))))]
(-> (redis/eval! redis script) (->> (rds/eval! redis script)
(p/then (fn [result] (p/fmap (fn [result]
(let [allowed? (boolean (nth result 0)) (let [allowed? (boolean (nth result 0))
remaining (nth result 1) remaining (nth result 1)
reset (* (/ (inst-ms interval) rate) reset (* (/ (inst-ms interval) rate)
(- capacity remaining))] (- capacity remaining))]
(l/trace :hint "limit processed" (l/trace :hint "limit processed"
:service service :service service
:limit (name (::name limit)) :limit (name (::name limit))
:strategy (name (::strategy limit)) :strategy (name (::strategy limit))
:opts (::opts limit) :opts (::opts limit)
:allowed? allowed? :allowed? allowed?
:remaining remaining) :remaining remaining)
(-> limit (-> limit
(assoc ::lresult/allowed? allowed?) (assoc ::lresult/allowed? allowed?)
(assoc ::lresult/reset (dt/plus now reset)) (assoc ::lresult/reset (dt/plus now reset))
(assoc ::lresult/remaining remaining)))))))) (assoc ::lresult/remaining remaining))))))))
(defmethod process-limit :window (defmethod process-limit :window
[redis user-id now {:keys [::nreq ::unit ::key ::service] :as limit}] [redis user-id now {:keys [::nreq ::unit ::key ::service] :as limit}]
@ -166,94 +166,113 @@
script (-> window-rate-limit-script script (-> window-rate-limit-script
(assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))]) (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
(assoc ::rscript/vals [nreq (dt/->seconds ttl)]))] (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))]
(-> (redis/eval! redis script) (->> (rds/eval! redis script)
(p/then (fn [result] (p/fmap (fn [result]
(let [allowed? (boolean (nth result 0)) (let [allowed? (boolean (nth result 0))
remaining (nth result 1)] remaining (nth result 1)]
(l/trace :hint "limit processed" (l/trace :hint "limit processed"
:service service :service service
:limit (name (::name limit)) :limit (name (::name limit))
:strategy (name (::strategy limit)) :strategy (name (::strategy limit))
:opts (::opts limit) :opts (::opts limit)
:allowed? allowed? :allowed? allowed?
:remaining remaining) :remaining remaining)
(-> limit (-> limit
(assoc ::lresult/allowed? allowed?) (assoc ::lresult/allowed? allowed?)
(assoc ::lresult/remaining remaining) (assoc ::lresult/remaining remaining)
(assoc ::lresult/reset (dt/plus ts {unit 1}))))))))) (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
(defn- process-limits (defn- process-limits!
[redis user-id limits now] [redis user-id limits now]
(-> (p/all (map (partial process-limit redis user-id now) limits)) (->> (p/all (map (partial process-limit redis user-id now) limits))
(p/then (fn [results] (p/fmap (fn [results]
(let [remaining (->> results (let [remaining (->> results
(d/index-by ::name ::lresult/remaining) (d/index-by ::name ::lresult/remaining)
(uri/map->query-string)) (uri/map->query-string))
reset (->> results reset (->> results
(d/index-by ::name (comp dt/->seconds ::lresult/reset)) (d/index-by ::name (comp dt/->seconds ::lresult/reset))
(uri/map->query-string)) (uri/map->query-string))
rejected (->> results rejected (->> results
(filter (complement ::lresult/allowed?)) (filter (complement ::lresult/allowed?))
(first))] (first))]
(when rejected (when rejected
(l/warn :hint "rejected rate limit" (l/warn :hint "rejected rate limit"
:user-id (str user-id) :user-id (str user-id)
:limit-service (-> rejected ::service name) :limit-service (-> rejected ::service name)
:limit-name (-> rejected ::name name) :limit-name (-> rejected ::name name)
:limit-strategy (-> rejected ::strategy name))) :limit-strategy (-> rejected ::strategy name)))
{:enabled? true {:enabled? true
:allowed? (not (some? rejected)) :allowed? (not (some? rejected))
:headers {"x-rate-limit-remaining" remaining :headers {"x-rate-limit-remaining" remaining
"x-rate-limit-reset" reset}}))))) "x-rate-limit-reset" reset}})))))
(defn- handle-response (defn- handle-response
[f cfg params result] [f cfg params result]
(if (:enabled? result) (if (:enabled? result)
(let [headers (:headers result)] (let [headers (:headers result)]
(when-not (:allowed? result) (if (:allowed? result)
(ex/raise :type :rate-limit (->> (f cfg params)
:code :request-blocked (p/fmap (fn [response]
:hint "rate limit reached" (vary-meta response update ::http/headers merge headers))))
::http/headers headers)) (p/rejected
(-> (f cfg params) (ex/error :type :rate-limit
(p/then (fn [response] :code :request-blocked
(vary-meta response update ::http/headers merge headers))))) :hint "rate limit reached"
::http/headers headers))))
(f cfg params))) (f cfg params)))
(defn- get-limits
[state skey sname]
(some->> (or (get-in @state [::limits skey])
(get-in @state [::limits :default]))
(map #(assoc % ::service sname))
(seq)))
(defn- get-uid
[{:keys [::http/request] :as params}]
(or (::rpc/profile-id params)
(some-> request parse-client-ip)
uuid/zero))
(defn wrap (defn wrap
[{:keys [rlimit redis] :as cfg} f mdata] [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
(us/assert! ::rpc/rlimit rlimit)
(us/assert! ::rds/redis redis)
(if rlimit (if rlimit
(let [skey (keyword (::rpc/type cfg) (->> mdata ::sv/spec name)) (let [skey (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
sname (str (::rpc/type cfg) "." (->> mdata ::sv/spec name))] sname (str (::rpc/type cfg) "." (->> mdata ::sv/spec name))]
(fn [cfg {:keys [::http/request] :as params}]
(let [uid (or (:profile-id params)
(some-> request parse-client-ip)
uuid/zero)
rsp (when (and uid @enabled?) (fn [cfg params]
(when-let [limits (or (get-in @rlimit [::limits skey]) (if @enabled?
(get-in @rlimit [::limits :default]))] (try
(let [redis (redis/get-or-connect redis ::rlimit default-options) (let [uid (get-uid params)
limits (map #(assoc % ::service sname) limits) rsp (when-let [limits (get-limits rlimit skey sname)]
resp (-> (process-limits redis uid limits (dt/now)) (let [redis (rds/get-or-connect redis ::rpc/rlimit default-options)
(p/catch (fn [cause] rsp (->> (process-limits! redis uid limits (dt/now))
;; If we have an error on processing the rate-limit we just skip (p/merr (fn [cause]
;; it for do not cause service interruption because of redis ;; If we have an error on processing the rate-limit we just skip
;; downtime or similar situation. ;; it for do not cause service interruption because of redis
(l/error :hint "error on processing rate-limit" :cause cause) ;; downtime or similar situation.
{:enabled? false})))] (l/error :hint "error on processing rate-limit" :cause cause)
(p/resolved {:enabled? false}))))]
;; If soft rate are enabled, we process the rate-limit but return unprotected ;; If soft rate are enabled, we process the rate-limit but return unprotected
;; response. ;; response.
(if (contains? cf/flags :soft-rpc-rlimit) (if (contains? cf/flags :soft-rpc-rlimit)
(p/resolved {:enabled? false}) {:enabled? false}
resp)))) rsp)))]
rsp (or rsp (p/resolved {:enabled? false}))] (->> (p/promise rsp)
(p/fmap #(or % {:enabled? false}))
(p/mcat #(handle-response f cfg params %))))
(p/then rsp (partial handle-response f cfg params))))) (catch Throwable cause
(p/rejected cause)))
(f cfg params))))
f)) f))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -289,8 +308,9 @@
(s/keys :req [::nreq (s/keys :req [::nreq
::unit])))) ::unit]))))
(s/def ::rlimit (s/def ::rpc/rlimit
#(instance? clojure.lang.Agent %)) (s/nilable
#(instance? clojure.lang.Agent %)))
(s/def ::config (s/def ::config
(s/map-of (s/or :kw keyword? :set set?) (s/map-of (s/or :kw keyword? :set set?)
@ -332,7 +352,7 @@
::limits limits})))) ::limits limits}))))
(defn- refresh-config (defn- refresh-config
[{:keys [state path executor scheduled-executor] :as params}] [{:keys [::state ::path ::wrk/executor ::wrk/scheduled-executor] :as cfg}]
(letfn [(update-config [{:keys [::updated-at] :as state}] (letfn [(update-config [{:keys [::updated-at] :as state}]
(let [updated-at' (fs/last-modified-time path)] (let [updated-at' (fs/last-modified-time path)]
(merge state (merge state
@ -349,7 +369,7 @@
(schedule-next [state] (schedule-next [state]
(px/schedule! scheduled-executor (px/schedule! scheduled-executor
(inst-ms (::refresh state)) (inst-ms (::refresh state))
(partial refresh-config params)) (partial refresh-config cfg))
state)] state)]
(send-via executor state update-config) (send-via executor state update-config)
@ -371,10 +391,11 @@
(and (fs/exists? path) (fs/regular-file? path) path))) (and (fs/exists? path) (fs/regular-file? path) path)))
(defmethod ig/pre-init-spec :app.rpc/rlimit [_] (defmethod ig/pre-init-spec :app.rpc/rlimit [_]
(s/keys :req-un [::wrk/executor ::wrk/scheduled-executor])) (s/keys :req [::wrk/executor
::wrk/scheduled-executor]))
(defmethod ig/init-key ::rpc/rlimit (defmethod ig/init-key ::rpc/rlimit
[_ {:keys [executor] :as params}] [_ {:keys [::wrk/executor] :as cfg}]
(when (contains? cf/flags :rpc-rlimit) (when (contains? cf/flags :rpc-rlimit)
(let [state (agent {})] (let [state (agent {})]
(set-error-handler! state on-refresh-error) (set-error-handler! state on-refresh-error)
@ -387,6 +408,6 @@
(send-via executor state (constantly {::refresh (dt/duration "5s")})) (send-via executor state (constantly {::refresh (dt/duration "5s")}))
;; Force a refresh ;; Force a refresh
(refresh-config (assoc params :path path :state state))) (refresh-config (assoc cfg ::path path ::state state)))
state))) state)))

2
backend/src/app/srepl/helpers.clj
View file

@ -70,7 +70,7 @@
[system & {:keys [update-fn id save? migrate? inc-revn?] [system & {:keys [update-fn id save? migrate? inc-revn?]
:or {save? false migrate? true inc-revn? true}}] :or {save? false migrate? true inc-revn? true}}]
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(let [file (-> (db/get-by-id conn :file id {:for-update true}) (let [file (-> (db/get-by-id conn :file id {::db/for-update? true})
(update :features db/decode-pgarray #{}))] (update :features db/decode-pgarray #{}))]
(binding [*conn* conn (binding [*conn* conn
pmap/*tracked* (atom {}) pmap/*tracked* (atom {})

16
backend/src/app/srepl/main.clj
View file

@ -71,7 +71,7 @@
(let [sprops (:app.setup/props system) (let [sprops (:app.setup/props system)
pool (:app.db/pool system) pool (:app.db/pool system)
profile (profile/retrieve-profile-data-by-email pool email)] profile (profile/get-profile-by-email pool email)]
(cmd.auth/send-email-verification! pool sprops profile) (cmd.auth/send-email-verification! pool sprops profile)
:email-sent)) :email-sent))
@ -81,10 +81,9 @@
associated with the profile-id." associated with the profile-id."
[system email] [system email]
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(when-let [profile (db/get-by-params conn :profile (when-let [profile (db/get* conn :profile
{:email (str/lower email)} {:email (str/lower email)}
{:columns [:id :email] {:columns [:id :email]})]
:check-not-found false})]
(when-not (:is-blocked profile) (when-not (:is-blocked profile)
(db/update! conn :profile {:is-active true} {:id (:id profile)}) (db/update! conn :profile {:is-active true} {:id (:id profile)})
:activated)))) :activated))))
@ -94,10 +93,9 @@
associated with the profile-id." associated with the profile-id."
[system email] [system email]
(db/with-atomic [conn (:app.db/pool system)] (db/with-atomic [conn (:app.db/pool system)]
(when-let [profile (db/get-by-params conn :profile (when-let [profile (db/get* conn :profile
{:email (str/lower email)} {:email (str/lower email)}
{:columns [:id :email] {:columns [:id :email]})]
:check-not-found false})]
(when-not (:is-blocked profile) (when-not (:is-blocked profile)
(db/update! conn :profile {:is-blocked true} {:id (:id profile)}) (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
(db/delete! conn :http-session {:profile-id (:id profile)}) (db/delete! conn :http-session {:profile-id (:id profile)})

4
backend/src/app/storage.clj
View file

@ -188,7 +188,7 @@
res (db/update! (or conn pool) :storage-object res (db/update! (or conn pool) :storage-object
{:touched-at (dt/now)} {:touched-at (dt/now)}
{:id id} {:id id}
{:return-keys false})] {::db/return-keys? false})]
(pos? (:next.jdbc/update-count res))))) (pos? (:next.jdbc/update-count res)))))
(defn get-object-data (defn get-object-data
@ -247,7 +247,7 @@
res (db/update! (or conn pool) :storage-object res (db/update! (or conn pool) :storage-object
{:deleted-at (dt/now)} {:deleted-at (dt/now)}
{:id id} {:id id}
{:return-keys false})] {::db/return-keys? false})]
(pos? (:next.jdbc/update-count res))))) (pos? (:next.jdbc/update-count res)))))
(dm/export impl/resolve-backend) (dm/export impl/resolve-backend)

2
backend/src/app/util/retry.clj
View file

@ -29,6 +29,6 @@
(throw cause#))))] (throw cause#))))]
(if (= ::retry result#) (if (= ::retry result#)
(do (do
(l/warn :hint "retrying operation" :label ~label) (l/warn :hint "retrying operation" :label ~label :retry tnum#)
(recur (inc tnum#))) (recur (inc tnum#)))
result#)))) result#))))

3
backend/src/app/util/websocket.clj
View file

@ -60,7 +60,7 @@
(assert (fn? on-snd-message) "'on-snd-message' should be a function") (assert (fn? on-snd-message) "'on-snd-message' should be a function")
(assert (fn? on-connect) "'on-connect' should be a function") (assert (fn? on-connect) "'on-connect' should be a function")
(fn [{:keys [::yws/channel session-id] :as request}] (fn [{:keys [::yws/channel] :as request}]
(let [input-ch (a/chan input-buff-size) (let [input-ch (a/chan input-buff-size)
output-ch (a/chan output-buff-size) output-ch (a/chan output-buff-size)
hbeat-ch (a/chan (a/sliding-buffer 6)) hbeat-ch (a/chan (a/sliding-buffer 6))
@ -81,7 +81,6 @@
::stop-ch stop-ch ::stop-ch stop-ch
::channel channel ::channel channel
::remote-addr ip-addr ::remote-addr ip-addr
::http-session-id session-id
::user-agent uagent}) ::user-agent uagent})
(atom)) (atom))

2
backend/src/app/worker.clj
View file

@ -45,7 +45,7 @@
(defmethod ig/init-key ::executor (defmethod ig/init-key ::executor
[skey {:keys [::parallelism]}] [skey {:keys [::parallelism]}]
(let [prefix (if (vector? skey) (-> skey first name keyword) :default) (let [prefix (if (vector? skey) (-> skey first name keyword) "default")
tname (str "penpot/" prefix "/%s") tname (str "penpot/" prefix "/%s")
factory (px/forkjoin-thread-factory :name tname)] factory (px/forkjoin-thread-factory :name tname)]
(px/forkjoin-executor (px/forkjoin-executor

2
backend/test/backend_tests/bounce_handling_test.clj
View file

@ -6,12 +6,12 @@
(ns backend-tests.bounce-handling-test (ns backend-tests.bounce-handling-test
(:require (:require
[backend-tests.helpers :as th]
[app.db :as db] [app.db :as db]
[app.emails :as emails] [app.emails :as emails]
[app.http.awsns :as awsns] [app.http.awsns :as awsns]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.time :as dt] [app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.pprint :refer [pprint]] [clojure.pprint :refer [pprint]]
[clojure.test :as t] [clojure.test :as t]
[mockery.core :refer [with-mocks]])) [mockery.core :refer [with-mocks]]))

106
backend/test/backend_tests/helpers.clj
View file

@ -16,8 +16,10 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.main :as main] [app.main :as main]
[app.media :as-alias mtx]
[app.media] [app.media]
[app.migrations] [app.migrations]
[app.msgbus :as-alias mbus]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
@ -64,52 +66,50 @@
(defn state-init (defn state-init
[next] [next]
(let [templates [{:id "test" (with-redefs [app.config/flags (flags/parse flags/default default-flags)
:name "test" app.config/config config
:file-uri "test" app.loggers.audit/submit! (constantly nil)
:thumbnail-uri "test" app.auth/derive-password identity
:path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}] app.auth/verify-password (fn [a b] {:valid (= a b)})]
system (-> (merge main/system-config main/worker-config)
(assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config)) (let [templates [{:id "test"
(assoc-in [:app.db/pool :uri] (:database-uri config)) :name "test"
(assoc-in [:app.db/pool :username] (:database-username config)) :file-uri "test"
(assoc-in [:app.db/pool :password] (:database-password config)) :thumbnail-uri "test"
(assoc-in [:app.rpc/methods :templates] templates) :path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
(dissoc :app.srepl/server system (-> (merge main/system-config main/worker-config)
:app.http/server (assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config))
:app.http/router (assoc-in [:app.db/pool :uri] (:database-uri config))
:app.http.awsns/handler (assoc-in [:app.db/pool :username] (:database-username config))
:app.http.session/updater (assoc-in [:app.db/pool :password] (:database-password config))
:app.auth.oidc/google-provider (assoc-in [:app.rpc/methods :templates] templates)
:app.auth.oidc/gitlab-provider (dissoc :app.srepl/server
:app.auth.oidc/github-provider :app.http/server
:app.auth.oidc/generic-provider :app.http/router
:app.setup/builtin-templates :app.auth.oidc/google-provider
:app.auth.oidc/routes :app.auth.oidc/gitlab-provider
:app.worker/executors-monitor :app.auth.oidc/github-provider
:app.http.oauth/handler :app.auth.oidc/generic-provider
:app.notifications/handler :app.setup/builtin-templates
:app.loggers.sentry/reporter :app.auth.oidc/routes
:app.loggers.mattermost/reporter :app.worker/executors-monitor
:app.loggers.loki/reporter :app.http.oauth/handler
:app.loggers.database/reporter :app.notifications/handler
:app.loggers.zmq/receiver :app.loggers.mattermost/reporter
:app.worker/cron :app.loggers.loki/reporter
:app.worker/worker)) :app.loggers.database/reporter
_ (ig/load-namespaces system) :app.loggers.zmq/receiver
system (-> (ig/prep system) :app.worker/cron
(ig/init))] :app.worker/worker))
(try _ (ig/load-namespaces system)
(binding [*system* system system (-> (ig/prep system)
*pool* (:app.db/pool system)] (ig/init))]
(with-redefs [app.config/flags (flags/parse flags/default default-flags (:flags config)) (try
app.config/config config (binding [*system* system
app.loggers.audit/submit! (constantly nil) *pool* (:app.db/pool system)]
app.auth/derive-password identity (next))
app.auth/verify-password (fn [a b] {:valid (= a b)})] (finally
(next))) (ig/halt! system))))))
(finally
(ig/halt! system)))))
(defn database-reset (defn database-reset
[next] [next]
@ -163,8 +163,8 @@
params)] params)]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(->> params (->> params
(cmd.auth/create-profile conn) (cmd.auth/create-profile! conn)
(cmd.auth/create-profile-relations conn)))))) (cmd.auth/create-profile-rels! conn))))))
(defn create-project* (defn create-project*
([i params] (create-project* *pool* i params)) ([i params] (create-project* *pool* i params))
@ -274,12 +274,10 @@
([pool {:keys [file-id changes session-id profile-id revn] ([pool {:keys [file-id changes session-id profile-id revn]
:or {session-id (uuid/next) revn 0}}] :or {session-id (uuid/next) revn 0}}]
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(let [msgbus (:app.msgbus/msgbus *system*) (let [features #{"components/v2"}
metrics (:app.metrics/metrics *system*) cfg (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics])
features #{"components/v2"}] (assoc :conn conn))]
(files.update/update-file {:conn conn (files.update/update-file cfg
:msgbus msgbus
:metrics metrics}
{:id file-id {:id file-id
:revn revn :revn revn
:features features :features features

4
backend/test/backend_tests/rpc_file_test.clj
View file

@ -652,7 +652,9 @@
;; check that the unknown frame thumbnail is deleted ;; check that the unknown frame thumbnail is deleted
(let [res (th/db-exec! ["select * from file_object_thumbnail"])] (let [res (th/db-exec! ["select * from file_object_thumbnail"])]
(t/is (= 1 (count res))) (t/is (= 1 (count res)))
(t/is (= "new-data" (get-in res [0 :data]))))))) (t/is (= "new-data" (get-in res [0 :data])))))
))
(t/deftest file-thumbnail-ops (t/deftest file-thumbnail-ops

2
backend/test/backend_tests/rpc_profile_test.clj
View file

@ -150,7 +150,7 @@
(let [row (th/db-get :team (let [row (th/db-get :team
{:id (:default-team-id prof)} {:id (:default-team-id prof)}
{:check-deleted? false})] {::db/remove-deleted? false})]
(t/is (dt/instant? (:deleted-at row)))) (t/is (dt/instant? (:deleted-at row))))
;; query profile after delete ;; query profile after delete

7
common/src/app/common/uuid.cljc
View file

@ -59,3 +59,10 @@
(.putLong buf (.getMostSignificantBits o)) (.putLong buf (.getMostSignificantBits o))
(.putLong buf (.getLeastSignificantBits o)) (.putLong buf (.getLeastSignificantBits o))
(.array buf)))) (.array buf))))
#?(:clj
(defn from-bytes
[^bytes o]
(let [buf (ByteBuffer/wrap o)]
(UUID. ^long (.getLong buf)
^long (.getLong buf)))))