From aafbf6bc153c07134a50241964cc387064fff538 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 2 Mar 2023 16:57:28 +0100 Subject: [PATCH] :recycle: Refactor cocurrency model on backend Mainly the followin changes: - Pass majority of code to the old and plain synchronous style and start using virtual threads for the RPC (and partially some HTTP server middlewares). - Make some improvements on how CLIMIT is handled, simplifying code - Improve considerably performance reducing the reflection and unnecesary funcion calls on the whole stack-trace of an RPC call. - Improve efficiency reducing considerably the total threads number. --- backend/deps.edn | 13 +- backend/resources/climit.edn | 21 +- backend/resources/rlimit.edn | 9 +- backend/src/app/auth/oidc.clj | 265 ++++++++-------- backend/src/app/http.clj | 55 ++-- backend/src/app/http/access_token.clj | 66 ++-- backend/src/app/http/assets.clj | 38 +-- backend/src/app/http/awsns.clj | 4 +- backend/src/app/http/client.clj | 25 +- backend/src/app/http/debug.clj | 131 ++++---- backend/src/app/http/errors.clj | 103 +++--- backend/src/app/http/middleware.clj | 150 ++++----- backend/src/app/http/session.clj | 183 +++++------ backend/src/app/http/websocket.clj | 16 +- backend/src/app/loggers/audit.clj | 87 +++-- backend/src/app/loggers/database.clj | 8 +- backend/src/app/main.clj | 37 +-- backend/src/app/media.clj | 6 +- backend/src/app/redis.clj | 81 +++-- backend/src/app/rpc.clj | 204 ++++-------- backend/src/app/rpc/climit.clj | 298 ++++++++++-------- backend/src/app/rpc/commands/audit.clj | 18 +- backend/src/app/rpc/commands/auth.clj | 26 +- backend/src/app/rpc/commands/binfile.clj | 12 +- backend/src/app/rpc/commands/demo.clj | 3 +- backend/src/app/rpc/commands/files_update.clj | 53 ++-- backend/src/app/rpc/commands/fonts.clj | 94 +++--- backend/src/app/rpc/commands/media.clj | 166 +++++----- backend/src/app/rpc/commands/profile.clj | 131 ++++---- backend/src/app/rpc/commands/teams.clj | 43 ++- backend/src/app/rpc/commands/webhooks.clj | 50 ++- backend/src/app/rpc/cond.clj | 32 +- backend/src/app/rpc/doc.clj | 34 +- backend/src/app/rpc/helpers.clj | 9 +- backend/src/app/rpc/mutations/profile.clj | 11 +- backend/src/app/rpc/retry.clj | 27 +- backend/src/app/rpc/rlimit.clj | 247 +++++++-------- backend/src/app/util/services.clj | 6 +- backend/src/app/util/svg.clj | 11 +- backend/src/app/worker.clj | 25 +- backend/test/backend_tests/helpers.clj | 26 +- .../rpc_cond_middleware_test.clj | 2 +- backend/test/backend_tests/rpc_team_test.clj | 1 + common/src/app/common/logging.cljc | 42 +-- frontend/src/app/main/repo.cljs | 4 + frontend/src/app/main/store.cljs | 7 +- frontend/src/app/main/ui/auth/login.cljs | 6 +- 47 files changed, 1409 insertions(+), 1477 deletions(-) diff --git a/backend/deps.edn b/backend/deps.edn index 2a52c1930..06b4689b8 100644 --- a/backend/deps.edn +++ b/backend/deps.edn @@ -1,4 +1,7 @@ -{:deps +{:mvn/repos + {"sonatype" {:url "https://oss.sonatype.org/content/repositories/snapshots/"}} + + :deps {penpot/common {:local/root "../common"} org.clojure/clojure {:mvn/version "1.11.1"} org.clojure/core.async {:mvn/version "1.6.673"} @@ -19,14 +22,16 @@ java-http-clj/java-http-clj {:mvn/version "0.4.3"} funcool/yetti - {:git/tag "v9.13" - :git/sha "e2d25db" + {:git/tag "v9.15" + :git/sha "aa9b967" :git/url "https://github.com/funcool/yetti.git" :exclusions [org.slf4j/slf4j-api]} com.github.seancorfield/next.jdbc {:mvn/version "1.3.847"} metosin/reitit-core {:mvn/version "0.5.18"} - org.postgresql/postgresql {:mvn/version "42.5.2"} + + org.postgresql/postgresql {:mvn/version "42.6.0-SNAPSHOT"} + com.zaxxer/HikariCP {:mvn/version "5.0.1"} io.whitfin/siphash {:mvn/version "2.0.0"} diff --git a/backend/resources/climit.edn b/backend/resources/climit.edn index 755568713..5802af5e3 100644 --- a/backend/resources/climit.edn +++ b/backend/resources/climit.edn @@ -1,9 +1,14 @@ ;; Example climit.edn file -;; Required: concurrency -;; Optional: queue-size, ommited means Integer/MAX_VALUE -{:update-file {:concurrency 1 :queue-size 3} - :auth {:concurrency 128} - :process-font {:concurrency 4 :queue-size 32} - :process-image {:concurrency 8 :queue-size 32} - :push-audit-events - {:concurrency 1 :queue-size 3}} +;; Required: permits +;; Optional: queue, ommited means Integer/MAX_VALUE +;; Optional: timeout, ommited means no timeout +;; Note: queue and timeout are excluding +{:update-file-by-id {:permits 1 :queue 3} + :update-file {:permits 20} + + :derive-password {:permits 8} + :process-font {:permits 4 :queue 32} + :process-image {:permits 8 :queue 32} + + :submit-audit-events-by-profile + {:permits 1 :queue 3}} diff --git a/backend/resources/rlimit.edn b/backend/resources/rlimit.edn index acb131bf1..2574f60f9 100644 --- a/backend/resources/rlimit.edn +++ b/backend/resources/rlimit.edn @@ -3,8 +3,9 @@ {:default [[:default :window "200000/h"]] - #{:command/get-teams} - [[:burst :bucket "5/1/5s"]] + ;; #{:command/get-teams} + ;; [[:burst :bucket "5/5/5s"]] - #{:command/get-profile} - [[:burst :bucket "60/60/1m"]]} + ;; #{:command/get-profile} + ;; [[:burst :bucket "60/60/1m"]] + } diff --git a/backend/src/app/auth/oidc.clj b/backend/src/app/auth/oidc.clj index fa857d5d4..d8d6657cc 100644 --- a/backend/src/app/auth/oidc.clj +++ b/backend/src/app/auth/oidc.clj @@ -17,7 +17,6 @@ [app.config :as cf] [app.db :as db] [app.http.client :as http] - [app.http.middleware :as hmw] [app.http.session :as session] [app.loggers.audit :as audit] [app.main :as-alias main] @@ -25,14 +24,11 @@ [app.tokens :as tokens] [app.util.json :as json] [app.util.time :as dt] - [app.worker :as wrk] [clojure.set :as set] [clojure.spec.alpha :as s] [cuerdas.core :as str] [integrant.core :as ig] - [promesa.core :as p] - [promesa.exec :as px] - [yetti.response :as yrs])) + [yetti.response :as-alias yrs])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HELPERS @@ -166,20 +162,22 @@ (defn- retrieve-github-email [cfg tdata info] - (or (some-> info :email p/resolved) - (->> (http/req! cfg - {:uri "https://api.github.com/user/emails" - :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))} - :timeout 6000 - :method :get}) - (p/map (fn [{:keys [status body] :as response}] - (when-not (s/int-in-range? 200 300 status) - (ex/raise :type :internal - :code :unable-to-retrieve-github-emails - :hint "unable to retrieve github emails" - :http-status status - :http-body body)) - (->> response :body json/decode (filter :primary) first :email)))))) + (or (some-> info :email) + (let [params {:uri "https://api.github.com/user/emails" + :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))} + :timeout 6000 + :method :get} + + {:keys [status body]} (http/req! cfg params {:sync? true})] + + (when-not (s/int-in-range? 200 300 status) + (ex/raise :type :internal + :code :unable-to-retrieve-github-emails + :hint "unable to retrieve github emails" + :http-status status + :http-body body)) + + (->> body json/decode (filter :primary) first :email)))) (defmethod ig/pre-init-spec ::providers/github [_] (s/keys :req [::http/client])) @@ -290,80 +288,74 @@ :grant-type (:grant_type params) :redirect-uri (:redirect_uri params)) - (->> (http/req! cfg req) - (p/map (fn [{:keys [status body] :as res}] - (l/trace :hint "access token response" - :status status - :body body) - (if (= status 200) - (let [data (json/decode body)] - {:token (get data :access_token) - :type (get data :token_type)}) - (ex/raise :type :internal - :code :unable-to-retrieve-token - :http-status status - :http-body body))))))) + (let [{:keys [status body]} (http/req! cfg req {:sync? true})] + (l/trace :hint "access token response" :status status :body body) + (if (= status 200) + (let [data (json/decode body)] + {:token (get data :access_token) + :type (get data :token_type)}) + + (ex/raise :type :internal + :code :unable-to-retrieve-token + :hint "unable to retrieve token" + :http-status status + :http-body body))))) (defn- retrieve-user-info [{:keys [provider] :as cfg} tdata] - (letfn [(retrieve [] - (l/trace :hint "request user info" - :uri (:user-uri provider) - :token (obfuscate-string (:token tdata)) - :token-type (:type tdata)) - (http/req! cfg - {:uri (:user-uri provider) - :headers {"Authorization" (str (:type tdata) " " (:token tdata))} - :timeout 6000 - :method :get})) - (validate-response [response] - (l/trace :hint "user info response" - :status (:status response) - :body (:body response)) - (when-not (s/int-in-range? 200 300 (:status response)) - (ex/raise :type :internal - :code :unable-to-retrieve-user-info - :hint "unable to retrieve user info" - :http-status (:status response) - :http-body (:body response))) - response) - - (get-email [info] + (letfn [(get-email [info] ;; Allow providers hook into this for custom email ;; retrieval method. (if-let [get-email-fn (:get-email-fn provider)] (get-email-fn tdata info) (let [attr-kw (cf/get :oidc-email-attr :email)] - (p/resolved (get info attr-kw))))) + (get info attr-kw)))) (get-name [info] (let [attr-kw (cf/get :oidc-name-attr :name)] (get info attr-kw))) (process-response [response] - (p/let [info (-> response :body json/decode) - email (get-email info)] + (let [info (-> response :body json/decode) + email (get-email info)] {:backend (:name provider) :email email :fullname (or (get-name info) email) :props (->> (dissoc info :name :email) - (qualify-props provider))})) + (qualify-props provider))}))] - (validate-info [info] - (l/trace :hint "authentication info" :info info) - (when-not (s/valid? ::info info) - (l/warn :hint "received incomplete profile info object (please set correct scopes)" - :info (pr-str info)) - (ex/raise :type :internal - :code :incomplete-user-info - :hint "inconmplete user info" - :info info)) - info)] + (l/trace :hint "request user info" + :uri (:user-uri provider) + :token (obfuscate-string (:token tdata)) + :token-type (:type tdata)) - (->> (retrieve) - (p/fmap validate-response) - (p/mcat process-response) - (p/fmap validate-info)))) + (let [request {:uri (:user-uri provider) + :headers {"Authorization" (str (:type tdata) " " (:token tdata))} + :timeout 6000 + :method :get} + response (http/req! cfg request {:sync? true})] + + (l/trace :hint "user info response" + :status (:status response) + :body (:body response)) + + (when-not (s/int-in-range? 200 300 (:status response)) + (ex/raise :type :internal + :code :unable-to-retrieve-user-info + :hint "unable to retrieve user info" + :http-status (:status response) + :http-body (:body response))) + + (let [info (process-response response)] + (l/trace :hint "authentication info" :info info) + + (when-not (s/valid? ::info info) + (l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info) + (ex/raise :type :internal + :code :incomplete-user-info + :hint "inconmplete user info" + :info info)) + info)))) (s/def ::backend ::us/not-empty-string) (s/def ::email ::us/not-empty-string) @@ -377,61 +369,55 @@ (defn get-info [{:keys [provider] :as cfg} {:keys [params] :as request}] - (letfn [(validate-oidc [info] - ;; If the provider is OIDC, we can proceed to check - ;; roles if they are defined. - (when (and (= "oidc" (:name provider)) - (seq (:roles provider))) - (let [provider-roles (into #{} (:roles provider)) - profile-roles (let [attr (cf/get :oidc-roles-attr :roles) - roles (get info attr)] - (cond - (string? roles) (into #{} (str/words roles)) - (vector? roles) (into #{} roles) - :else #{}))] + (when-let [error (get params :error)] + (ex/raise :type :internal + :code :error-on-retrieving-code + :error-id error + :error-desc (get params :error_description))) - ;; check if profile has a configured set of roles - (when-not (set/subset? provider-roles profile-roles) - (ex/raise :type :internal - :code :unable-to-auth - :hint "not enough permissions")))) - info) + (let [state (get params :state) + code (get params :code) + state (tokens/verify (::main/props cfg) {:token state :iss :oauth}) + token (retrieve-access-token cfg code) + info (retrieve-user-info cfg token)] - (post-process [state info] - (cond-> info - (some? (:invitation-token state)) - (assoc :invitation-token (:invitation-token state)) + ;; If the provider is OIDC, we can proceed to check + ;; roles if they are defined. + (when (and (= "oidc" (:name provider)) + (seq (:roles provider))) + (let [provider-roles (into #{} (:roles provider)) + profile-roles (let [attr (cf/get :oidc-roles-attr :roles) + roles (get info attr)] + (cond + (string? roles) (into #{} (str/words roles)) + (vector? roles) (into #{} roles) + :else #{}))] - ;; If state token comes with props, merge them. The state token - ;; props can contain pm_ and utm_ prefixed query params. - (map? (:props state)) - (update :props merge (:props state))))] + ;; check if profile has a configured set of roles + (when-not (set/subset? provider-roles profile-roles) + (ex/raise :type :internal + :code :unable-to-auth + :hint "not enough permissions")))) - (when-let [error (get params :error)] - (ex/raise :type :internal - :code :error-on-retrieving-code - :error-id error - :error-desc (get params :error_description))) + (cond-> info + (some? (:invitation-token state)) + (assoc :invitation-token (:invitation-token state)) - (let [state (get params :state) - code (get params :code) - state (tokens/verify (::main/props cfg) {:token state :iss :oauth})] - (-> (p/resolved code) - (p/then #(retrieve-access-token cfg %)) - (p/then #(retrieve-user-info cfg %)) - (p/then' validate-oidc) - (p/then' (partial post-process state)))))) + ;; If state token comes with props, merge them. The state token + ;; props can contain pm_ and utm_ prefixed query params. + (map? (:props state)) + (update :props merge (:props state))))) (defn- get-profile - [{:keys [::db/pool ::wrk/executor] :as cfg} info] - (px/with-dispatch executor - (with-open [conn (db/open pool)] - (some->> (:email info) - (profile/get-profile-by-email conn))))) + [{:keys [::db/pool] :as cfg} info] + (dm/with-open [conn (db/open pool)] + (some->> (:email info) + (profile/get-profile-by-email conn)))) (defn- redirect-response [uri] - (yrs/response :status 302 :headers {"location" (str uri)})) + {::yrs/status 302 + ::yrs/headers {"location" (str uri)}}) (defn- generate-error-redirect [_ error] @@ -458,11 +444,11 @@ (ex/raise :type :restriction :code :profile-blocked)) - (audit/submit! cfg {:type "command" - :name "login-with-password" - :profile-id (:id profile) - :ip-addr (audit/parse-client-ip request) - :props (audit/profile->props profile)}) + (audit/submit! cfg {::audit/type "command" + ::audit/name "login-with-oidc" + ::audit/profile-id (:id profile) + ::audit/ip-addr (audit/parse-client-ip request) + ::audit/props (audit/profile->props profile)}) (->> (redirect-response uri) (sxf request))) @@ -478,6 +464,7 @@ uri (-> (u/uri (cf/get :public-uri)) (assoc :path "/#/auth/register/validate") (assoc :query (u/map->query-string params)))] + (redirect-response uri)))) (defn- auth-handler @@ -489,27 +476,24 @@ :props props :exp (dt/in-future "4h")}) uri (build-auth-uri cfg state)] - (yrs/response 200 {:redirect-uri uri}))) + {::yrs/status 200 + ::yrs/body {:redirect-uri uri}})) (defn- callback-handler [cfg request] - (letfn [(process-request [] - (p/let [info (get-info cfg request) - profile (get-profile cfg info)] - (generate-redirect cfg request info profile))) - - (handle-error [cause] - (l/error :hint "error on oauth process" :cause cause) - (generate-error-redirect cfg cause))] - - (-> (process-request) - (p/catch handle-error)))) + (try + (let [info (get-info cfg request) + profile (get-profile cfg info)] + (generate-redirect cfg request info profile)) + (catch Throwable cause + (l/error :hint "error on oauth process" :cause cause) + (generate-error-redirect cfg cause)))) (def provider-lookup {:compile (fn [& _] - (fn [handler] - (fn [{:keys [::providers] :as cfg} request] + (fn [handler {:keys [::providers] :as cfg}] + (fn [request] (let [provider (some-> request :path-params :provider keyword)] (if-let [provider (get providers provider)] (handler (assoc cfg :provider provider) request) @@ -553,18 +537,15 @@ [_] (s/keys :req [::session/manager ::http/client - ::wrk/executor ::main/props ::db/pool ::providers])) (defmethod ig/init-key ::routes - [_ {:keys [::wrk/executor] :as cfg}] + [_ cfg] (let [cfg (update cfg :provider d/without-nils)] ["" {:middleware [[session/authz cfg] - [hmw/with-dispatch executor] - [hmw/with-config cfg] - [provider-lookup]]} + [provider-lookup cfg]]} ["/auth/oauth" ["/:provider" {:handler auth-handler diff --git a/backend/src/app/http.clj b/backend/src/app/http.clj index 4c35c39c7..c51c253fc 100644 --- a/backend/src/app/http.clj +++ b/backend/src/app/http.clj @@ -19,19 +19,21 @@ [app.http.middleware :as mw] [app.http.session :as session] [app.http.websocket :as-alias ws] + [app.main :as-alias main] [app.metrics :as mtx] [app.rpc :as-alias rpc] [app.rpc.doc :as-alias rpc.doc] [app.worker :as wrk] [clojure.spec.alpha :as s] [integrant.core :as ig] + [promesa.exec :as px] [reitit.core :as r] [reitit.middleware :as rr] [yetti.adapter :as yt] [yetti.request :as yrq] - [yetti.response :as yrs])) + [yetti.response :as-alias yrs])) -(declare wrap-router) +(declare router-handler) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HTTP SERVER @@ -65,19 +67,22 @@ ::wrk/executor])) (defmethod ig/init-key ::server - [_ {:keys [::handler ::router ::host ::port ::wrk/executor] :as cfg}] + [_ {:keys [::handler ::router ::host ::port] :as cfg}] (l/info :hint "starting http server" :port port :host host) (let [options {:http/port port :http/host host :http/max-body-size (::max-body-size cfg) :http/max-multipart-body-size (::max-multipart-body-size cfg) - :xnio/io-threads (::io-threads cfg) - :xnio/dispatch executor + :xnio/io-threads (or (::io-threads cfg) + (max 3 (px/get-available-processors))) + :xnio/worker-threads (or (::worker-threads cfg) + (max 6 (px/get-available-processors))) + :xnio/dispatch true :ring/async true} handler (cond (some? router) - (wrap-router router) + (router-handler router) (some? handler) handler @@ -97,32 +102,35 @@ (defn- not-found-handler [_ respond _] - (respond (yrs/response 404))) + (respond {::yrs/status 404})) -(defn- wrap-router +(defn- router-handler [router] - (letfn [(handler [request respond raise] + (letfn [(resolve-handler [request] (if-let [match (r/match-by-path router (yrq/path request))] (let [params (:path-params match) result (:result match) handler (or (:handler result) not-found-handler) request (assoc request :path-params params)] - (handler request respond raise)) - (not-found-handler request respond raise))) + (partial handler request)) + (partial not-found-handler request))) - (on-error [cause request respond] + (on-error [cause request] (let [{:keys [body] :as response} (errors/handle cause request)] - (respond - (cond-> response - (map? body) - (-> (update :headers assoc "content-type" "application/transit+json") - (assoc :body (t/encode-str body {:type :json-verbose})))))))] + (cond-> response + (map? body) + (-> (update ::yrs/headers assoc "content-type" "application/transit+json") + (assoc ::yrs/body (t/encode-str body {:type :json-verbose}))))))] (fn [request respond _] - (try - (handler request respond #(on-error % request respond)) - (catch Throwable cause - (on-error cause request respond)))))) + (let [handler (resolve-handler request) + exchange (yrq/exchange request)] + (handler + (fn [response] + (yt/dispatch! exchange (partial respond response))) + (fn [cause] + (let [response (on-error cause request)] + (yt/dispatch! exchange (partial respond response))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HTTP ROUTER @@ -130,11 +138,11 @@ (defmethod ig/pre-init-spec ::router [_] (s/keys :req [::session/manager - ::actoken/manager ::ws/routes ::rpc/routes ::rpc.doc/routes ::oidc/routes + ::main/props ::assets/routes ::debug/routes ::db/pool @@ -151,7 +159,8 @@ [session/soft-auth cfg] [actoken/soft-auth cfg] [mw/errors errors/handle] - [mw/restrict-methods]]} + [mw/restrict-methods] + [mw/with-dispatch :vthread]]} (::mtx/routes cfg) (::assets/routes cfg) diff --git a/backend/src/app/http/access_token.clj b/backend/src/app/http/access_token.clj index 76cf07eef..35ef96ce2 100644 --- a/backend/src/app/http/access_token.clj +++ b/backend/src/app/http/access_token.clj @@ -7,26 +7,12 @@ (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 @@ -48,40 +34,32 @@ (db/decode-pgarray #{}))))) (defn- wrap-soft-auth - [handler {:keys [::manager]}] - (us/assert! ::manager manager) + "Soft Authentication, will be executed synchronously on the undertow + worker thread." + [handler {:keys [::main/props]}] + (letfn [(handle-request [request] + (try + (let [token (get-token request) + claims (decode-token props token)] + (cond-> request + (map? claims) + (assoc ::id (:tid claims)))) + (catch Throwable cause + (l/trace :hint "exception on decoding malformed token" :cause cause) + request)))] - (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))))))))) + (let [request (handle-request request)] + (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))))) + "Authorization middleware, will be executed synchronously on vthread." + [handler {:keys [::db/pool]}] + (fn [request] + (let [perms (some->> (::id request) (get-token-perms pool))] + (handler (cond-> request + (some? perms) + (assoc ::perms perms)))))) (def soft-auth {:name ::soft-auth diff --git a/backend/src/app/http/assets.clj b/backend/src/app/http/assets.clj index 56584e37f..7a318adf8 100644 --- a/backend/src/app/http/assets.clj +++ b/backend/src/app/http/assets.clj @@ -18,7 +18,7 @@ [clojure.spec.alpha :as s] [integrant.core :as ig] [promesa.core :as p] - [yetti.response :as yrs])) + [yetti.response :as-alias yrs])) (def ^:private cache-max-age (dt/duration {:hours 24})) @@ -28,10 +28,9 @@ (defn get-id [{:keys [path-params]}] - (if-let [id (some-> path-params :id d/parse-uuid)] - (p/resolved id) - (p/rejected (ex/error :type :not-found - :hunt "object not found")))) + (or (some-> path-params :id d/parse-uuid) + (ex/raise :type :not-found + :hunt "object not found"))) (defn- get-file-media-object [pool id] @@ -46,9 +45,8 @@ "x-host" (cond-> host port (str ":" port)) "x-mtype" (:content-type mdata) "cache-control" (str "max-age=" (inst-ms cache-max-age))}] - (yrs/response - :status 307 - :headers headers))))))) + {::yrs/status 307 + ::yrs/headers headers})))))) (defn- serve-object-from-fs [{:keys [::path]} obj] @@ -59,7 +57,8 @@ "content-type" (:content-type mdata) "cache-control" (str "max-age=" (inst-ms cache-max-age))}] (p/resolved - (yrs/response :status 204 :headers headers)))) + {::yrs/status 204 + ::yrs/headers headers}))) (defn- serve-object "Helper function that returns the appropriate response depending on @@ -72,15 +71,14 @@ (defn objects-handler "Handler that servers storage objects by id." - [{:keys [::sto/storage ::wrk/executor] :as cfg} request respond raise] + [{:keys [::sto/storage ::wrk/executor] :as cfg} request] (->> (get-id request) (p/mcat executor (fn [id] (sto/get-object storage id))) (p/mcat executor (fn [obj] (if (some? obj) (serve-object cfg obj) - (p/resolved (yrs/response 404))))) - (p/fnly executor (fn [result cause] - (if cause (raise cause) (respond result)))))) + (p/resolved {::yrs/status 404})))) + (p/await!))) (defn- generic-handler "A generic handler helper/common code for file-media based handlers." @@ -92,22 +90,18 @@ (p/mcat executor (fn [sobj] (if sobj (serve-object cfg sobj) - (p/resolved (yrs/response 404)))))))) + (p/resolved {::yrs/status 404}))))))) (defn file-objects-handler "Handler that serves storage objects by file media id." - [cfg request respond raise] - (->> (generic-handler cfg request :media-id) - (p/fnly (fn [result cause] - (if cause (raise cause) (respond result)))))) + [cfg request] + (p/await! (generic-handler cfg request :media-id))) (defn file-thumbnails-handler "Handler that serves storage objects by thumbnail-id and quick fallback to file-media-id if no thumbnail is available." - [cfg request respond raise] - (->> (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %))) - (p/fnly (fn [result cause] - (if cause (raise cause) (respond result)))))) + [cfg request] + (p/await! (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %))))) ;; --- Initialization diff --git a/backend/src/app/http/awsns.clj b/backend/src/app/http/awsns.clj index 7ae00779c..a761ad8d9 100644 --- a/backend/src/app/http/awsns.clj +++ b/backend/src/app/http/awsns.clj @@ -21,7 +21,7 @@ [jsonista.core :as j] [promesa.exec :as px] [yetti.request :as yrq] - [yetti.response :as yrs])) + [yetti.response :as-alias yrs])) (declare parse-json) (declare handle-request) @@ -39,7 +39,7 @@ (letfn [(handler [request respond _] (let [data (-> request yrq/body slurp)] (px/run! executor #(handle-request cfg data))) - (respond (yrs/response 200)))] + (respond {::yrs/status 200}))] ["/sns" {:handler handler :allowed-methods #{:post}}])) diff --git a/backend/src/app/http/client.clj b/backend/src/app/http/client.clj index f7bb86093..cf30dbb46 100644 --- a/backend/src/app/http/client.clj +++ b/backend/src/app/http/client.clj @@ -40,12 +40,25 @@ (catch Throwable cause (p/rejected cause)))))) +(defn- resolve-client + [params] + (cond + (instance? HttpClient params) + params + + (map? params) + (resolve-client (::client params)) + + :else + (throw (UnsupportedOperationException. "invalid arguments")))) + (defn req! "A convencience toplevel function for gradual migration to a new API convention." - ([{:keys [::client]} request] - (us/assert! ::client client) - (send! client request {})) - ([{:keys [::client]} request options] - (us/assert! ::client client) - (send! client request options))) + ([cfg-or-client request] + (let [client (resolve-client cfg-or-client)] + (send! client request {}))) + ([cfg-or-client request options] + (let [client (resolve-client cfg-or-client)] + (send! client request options)))) + diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index 5abfea32d..3f650973f 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -13,7 +13,6 @@ [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] - [app.http.middleware :as mw] [app.http.session :as session] [app.rpc.commands.binfile :as binf] [app.rpc.commands.files-create :refer [create-file]] @@ -21,7 +20,6 @@ [app.util.blob :as blob] [app.util.template :as tmpl] [app.util.time :as dt] - [app.worker :as wrk] [clojure.spec.alpha :as s] [cuerdas.core :as str] [datoteka.io :as io] @@ -48,13 +46,17 @@ (defn prepare-response [body] (let [headers {"content-type" "application/transit+json"}] - (yrs/response :status 200 :body body :headers headers))) + {::yrs/status 200 + ::yrs/body body + ::yrs/headers headers})) (defn prepare-download-response [body filename] (let [headers {"content-disposition" (str "attachment; filename=" filename) "content-type" "application/octet-stream"}] - (yrs/response :status 200 :body body :headers headers))) + {::yrs/status 200 + ::yrs/body body + ::yrs/headers headers})) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INDEX @@ -65,10 +67,10 @@ (when-not (authorized? pool request) (ex/raise :type :authentication :code :only-admins-allowed)) - (yrs/response :status 200 - :headers {"content-type" "text/html"} - :body (-> (io/resource "app/templates/debug.tmpl") - (tmpl/render {})))) + {::yrs/status 200 + ::yrs/headers {"content-type" "text/html"} + ::yrs/body (-> (io/resource "app/templates/debug.tmpl") + (tmpl/render {}))}) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE CHANGES @@ -115,7 +117,8 @@ :project-id project-id :profile-id profile-id :data data}) - (yrs/response 201 "OK CREATED")) + {::yrs/status 201 + ::yrs/body "OK CREATED"}) :else (prepare-response (blob/decode data)))))) @@ -143,7 +146,8 @@ (db/update! pool :file {:data (blob/encode data)} {:id file-id}) - (yrs/response 200 "OK UPDATED")) + {::yrs/status 200 + ::yrs/body "OK UPDATED"}) (do (create-file pool {:id file-id @@ -151,9 +155,11 @@ :project-id project-id :profile-id profile-id :data data}) - (yrs/response 201 "OK CREATED")))) + {::yrs/status 201 + ::yrs/body "OK CREATED"}))) - (yrs/response 500 "ERROR")))) + {::yrs/status 500 + ::yrs/body "ERROR"}))) (defn file-data-handler [cfg request] @@ -241,11 +247,12 @@ (let [result (if (= 1 (:version report)) (render-template-v1 report) (render-template-v2 report))] - (yrs/response :status 200 - :body result - :headers {"content-type" "text/html; charset=utf-8" - "x-robots-tag" "noindex"})) - (yrs/response 404 "not found")))) + {::yrs/status 200 + ::yrs/body result + ::yrs/headers {"content-type" "text/html; charset=utf-8" + "x-robots-tag" "noindex"}}) + {::yrs/status 404 + ::yrs/body "not found"}))) (def sql:error-reports "SELECT id, created_at, @@ -261,11 +268,11 @@ :code :only-admins-allowed)) (let [items (->> (db/exec! pool [sql:error-reports]) (map #(update % :created-at dt/format-instant :rfc1123)))] - (yrs/response :status 200 - :body (-> (io/resource "app/templates/error-list.tmpl") - (tmpl/render {:items items})) - :headers {"content-type" "text/html; charset=utf-8" - "x-robots-tag" "noindex"}))) + {::yrs/status 200 + ::yrs/body (-> (io/resource "app/templates/error-list.tmpl") + (tmpl/render {:items items})) + ::yrs/headers {"content-type" "text/html; charset=utf-8" + "x-robots-tag" "noindex"}})) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; EXPORT/IMPORT @@ -301,16 +308,15 @@ ::binf/profile-id profile-id ::binf/project-id project-id)) - (yrs/response - :status 200 - :headers {"content-type" "text/plain"} - :body "OK CLONED")) + {::yrs/status 200 + ::yrs/headers {"content-type" "text/plain"} + ::yrs/body "OK CLONED"}) + + {::yrs/status 200 + ::yrs/body (io/input-stream path) + ::yrs/headers {"content-type" "application/octet-stream" + "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}})))) - (yrs/response - :status 200 - :headers {"content-type" "application/octet-stream" - "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")} - :body (io/input-stream path)))))) (defn import-handler @@ -340,10 +346,9 @@ ::binf/profile-id profile-id ::binf/project-id project-id)) - (yrs/response - :status 200 - :headers {"content-type" "text/plain"} - :body "OK"))) + {::yrs/status 200 + ::yrs/headers {"content-type" "text/plain"} + ::yrs/body "OK"})) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; OTHER SMALL VIEWS/HANDLERS @@ -354,11 +359,13 @@ [{:keys [::db/pool]} _] (try (db/exec-one! pool ["select count(*) as count from server_prop;"]) - (yrs/response 200 "OK") + {::yrs/status 200 + ::yrs/body "OK"} (catch Throwable cause (l/warn :hint "unable to execute query on health handler" :cause cause) - (yrs/response 503 "KO")))) + {::yrs/status 503 + ::yrs/body "KO"}))) (defn changelog-handler [_ _] @@ -367,10 +374,11 @@ (md->html [text] (md/md-to-html-string text :replacement-transformers (into [transform-emoji] mdt/transformer-vector)))] (if-let [clog (io/resource "changelog.md")] - (yrs/response :status 200 - :headers {"content-type" "text/html; charset=utf-8"} - :body (-> clog slurp md->html)) - (yrs/response :status 404 :body "NOT FOUND")))) + {::yrs/status 200 + ::yrs/headers {"content-type" "text/html; charset=utf-8"} + ::yrs/body (-> clog slurp md->html)} + {::yrs/status 404 + ::yrs/body "NOT FOUND"}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INIT @@ -380,33 +388,26 @@ {:compile (fn [& _] (fn [handler pool] - (fn [request respond raise] + (fn [request] (if (authorized? pool request) - (handler request respond raise) - (raise (ex/error :type :authentication - :code :only-admins-allowed))))))}) + (handler request) + (ex/raise :type :authentication + :code :only-admins-allowed)))))}) (defmethod ig/pre-init-spec ::routes [_] - (s/keys :req [::db/pool - ::wrk/executor - ::session/manager])) + (s/keys :req [::db/pool ::session/manager])) (defmethod ig/init-key ::routes - [_ {:keys [::db/pool ::wrk/executor] :as cfg}] - [["/readyz" {:middleware [[mw/with-dispatch executor] - [mw/with-config cfg]] - :handler health-handler}] + [_ {:keys [::db/pool] :as cfg}] + [["/readyz" {:handler (partial health-handler cfg)}] ["/dbg" {:middleware [[session/authz cfg] - [with-authorization pool] - [mw/with-dispatch executor] - [mw/with-config cfg]]} - ["" {:handler index-handler}] - ["/health" {:handler health-handler}] - ["/changelog" {:handler changelog-handler}] - ;; ["/error-by-id/:id" {:handler error-handler}] - ["/error/:id" {:handler error-handler}] - ["/error" {:handler error-list-handler}] - ["/file/export" {:handler export-handler}] - ["/file/import" {:handler import-handler}] - ["/file/data" {:handler file-data-handler}] - ["/file/changes" {:handler file-changes-handler}]]]) + [with-authorization pool]]} + ["" {:handler (partial index-handler cfg)}] + ["/health" {:handler (partial health-handler cfg)}] + ["/changelog" {:handler (partial changelog-handler cfg)}] + ["/error/:id" {:handler (partial error-handler cfg)}] + ["/error" {:handler (partial error-list-handler cfg)}] + ["/file/export" {:handler (partial export-handler cfg)}] + ["/file/import" {:handler (partial import-handler cfg)}] + ["/file/data" {:handler (partial file-data-handler cfg)}] + ["/file/changes" {:handler (partial file-changes-handler cfg)}]]]) diff --git a/backend/src/app/http/errors.clj b/backend/src/app/http/errors.clj index dbdedcbaa..23aae0c39 100644 --- a/backend/src/app/http/errors.clj +++ b/backend/src/app/http/errors.clj @@ -46,20 +46,30 @@ (defmethod handle-exception :authentication [err _] - (yrs/response 401 (ex-data err))) + {::yrs/status 401 + ::yrs/body (ex-data err)}) (defmethod handle-exception :authorization [err _] - (yrs/response 403 (ex-data err))) + {::yrs/status 403 + ::yrs/body (ex-data err)}) (defmethod handle-exception :restriction [err _] - (yrs/response 400 (ex-data err))) + {::yrs/status 400 + ::yrs/body (ex-data err)}) (defmethod handle-exception :rate-limit [err _] (let [headers (-> err ex-data ::http/headers)] - (yrs/response :status 429 :body "" :headers headers))) + {::yrs/status 429 + ::yrs/headers headers})) + +(defmethod handle-exception :concurrency-limit + [err _] + (let [headers (-> err ex-data ::http/headers)] + {::yrs/status 429 + ::yrs/headers headers})) (defmethod handle-exception :validation [err _] @@ -67,16 +77,16 @@ (cond (= code :spec-validation) (let [explain (ex/explain data)] - (yrs/response :status 400 - :body (-> data - (dissoc ::s/problems ::s/value) - (cond-> explain (assoc :explain explain))))) + {::yrs/status 400 + ::yrs/body (-> data + (dissoc ::s/problems ::s/value) + (cond-> explain (assoc :explain explain)))}) (= code :request-body-too-large) - (yrs/response :status 413 :body data) + {::yrs/status 413 ::yrs/body data} :else - (yrs/response :status 400 :body data)))) + {::yrs/status 400 ::yrs/body data}))) (defmethod handle-exception :assertion [error request] @@ -84,31 +94,27 @@ explain (ex/explain edata)] (binding [l/*context* (request->context request)] (l/error :hint "Assertion error" :message (ex-message error) :cause error) - (yrs/response :status 500 - :body {:type :server-error - :code :assertion - :data (-> edata - (dissoc ::s/problems ::s/value ::s/spec) - (cond-> explain (assoc :explain explain)))})))) + {::yrs/status 500 + ::yrs/body {:type :server-error + :code :assertion + :data (-> edata + (dissoc ::s/problems ::s/value ::s/spec) + (cond-> explain (assoc :explain explain)))}}))) (defmethod handle-exception :not-found [err _] - (yrs/response 404 (ex-data err))) + {::yrs/status 404 + ::yrs/body (ex-data err)}) (defmethod handle-exception :internal [error request] - (let [{:keys [code] :as edata} (ex-data error)] - (cond - (= :concurrency-limit-reached code) - (yrs/response 429) - - :else - (binding [l/*context* (request->context request)] - (l/error :hint "Internal error" :message (ex-message error) :cause error) - (yrs/response 500 {:type :server-error - :code :unhandled - :hint (ex-message error) - :data edata}))))) + (binding [l/*context* (request->context request)] + (l/error :hint "Internal error" :message (ex-message error) :cause error) + {::yrs/status 500 + ::yrs/body {:type :server-error + :code :unhandloed + :hint (ex-message error) + :data (ex-data error)}})) (defmethod handle-exception org.postgresql.util.PSQLException [error request] @@ -117,20 +123,23 @@ (l/error :hint "PSQL error" :message (ex-message error) :cause error) (cond (= state "57014") - (yrs/response 504 {:type :server-error - :code :statement-timeout - :hint (ex-message error)}) + {::yrs/status 504 + ::yrs/body {:type :server-error + :code :statement-timeout + :hint (ex-message error)}} (= state "25P03") - (yrs/response 504 {:type :server-error - :code :idle-in-transaction-timeout - :hint (ex-message error)}) + {::yrs/status 504 + ::yrs/body {:type :server-error + :code :idle-in-transaction-timeout + :hint (ex-message error)}} :else - (yrs/response 500 {:type :server-error - :code :unexpected - :hint (ex-message error) - :state state}))))) + {::yrs/status 500 + ::yrs/body {:type :server-error + :code :unexpected + :hint (ex-message error) + :state state}})))) (defmethod handle-exception :default [error request] @@ -140,9 +149,10 @@ (nil? edata) (binding [l/*context* (request->context request)] (l/error :hint "Unexpected error" :message (ex-message error) :cause error) - (yrs/response 500 {:type :server-error - :code :unexpected - :hint (ex-message error)})) + {::yrs/status 500 + ::yrs/body {:type :server-error + :code :unexpected + :hint (ex-message error)}}) ;; This is a special case for the idle-in-transaction error; ;; when it happens, the connection is automatically closed and @@ -156,10 +166,11 @@ :else (binding [l/*context* (request->context request)] (l/error :hint "Unhandled error" :message (ex-message error) :cause error) - (yrs/response 500 {:type :server-error - :code :unhandled - :hint (ex-message error) - :data edata}))))) + {::yrs/status 500 + ::yrs/body {:type :server-error + :code :unhandled + :hint (ex-message error) + :data edata}})))) (defn handle [cause request] diff --git a/backend/src/app/http/middleware.clj b/backend/src/app/http/middleware.clj index 0d16ffe9d..7e5cdc7aa 100644 --- a/backend/src/app/http/middleware.clj +++ b/backend/src/app/http/middleware.clj @@ -14,6 +14,7 @@ [cuerdas.core :as str] [promesa.core :as p] [promesa.exec :as px] + [promesa.util :as pu] [yetti.adapter :as yt] [yetti.middleware :as ymw] [yetti.request :as yrq] @@ -22,7 +23,10 @@ com.fasterxml.jackson.core.JsonParseException com.fasterxml.jackson.core.io.JsonEOFException io.undertow.server.RequestTooBigException - java.io.OutputStream)) + java.io.OutputStream + java.io.InputStream)) + +(set! *warn-on-reflection* true) (def server-timing {:name ::server-timing @@ -44,14 +48,14 @@ (let [header (yrq/get-header request "content-type")] (cond (str/starts-with? header "application/transit+json") - (with-open [is (yrq/body request)] + (with-open [^InputStream is (yrq/body request)] (let [params (t/read! (t/reader is))] (-> request (assoc :body-params params) (update :params merge params)))) (str/starts-with? header "application/json") - (with-open [is (yrq/body request)] + (with-open [^InputStream is (yrq/body request)] (let [params (json/decode is json-mapper)] (-> request (assoc :body-params params) @@ -62,6 +66,11 @@ (handle-error [raise cause] (cond + (instance? RuntimeException cause) + (if-let [cause (ex-cause cause)] + (handle-error raise cause) + (raise cause)) + (instance? RequestTooBigException cause) (raise (ex/error :type :validation :code :request-body-too-large @@ -78,12 +87,12 @@ (raise cause)))] (fn [request respond raise] - (let [request (ex/try! (process-request request))] - (if (ex/exception? request) - (if (ex/runtime-exception? request) - (handle-error raise (or (ex-cause request) request)) - (handle-error raise request)) - (handler request respond raise)))))) + (if (= (yrq/method request) :post) + (let [request (ex/try! (process-request request))] + (if (ex/exception? request) + (handle-error raise request) + (handler request respond raise))) + (handler request respond raise))))) (def parse-request {:name ::parse-request @@ -94,12 +103,7 @@ needed because transit-java calls flush very aggresivelly on each object write." [^java.io.OutputStream os ^long chunk-size] - (proxy [java.io.BufferedOutputStream] [os (int chunk-size)] - ;; Explicitly do not forward flush - (flush []) - (close [] - (proxy-super flush) - (proxy-super close)))) + (yetti.util.BufferedOutputStream. os (int chunk-size))) (def ^:const buffer-size (:xnio/buffer-size yt/defaults)) @@ -109,13 +113,10 @@ (reify yrs/StreamableResponseBody (-write-body-to-stream [_ _ output-stream] (try - (with-open [bos (buffered-output-stream output-stream buffer-size)] + (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)] (let [tw (t/writer bos opts)] (t/write! tw data))) - - (catch java.io.IOException _cause - ;; Do nothing, EOF means client closes connection abruptly - nil) + (catch java.io.IOException _) (catch Throwable cause (l/warn :hint "unexpected error on encoding response" :cause cause)) @@ -126,13 +127,10 @@ (reify yrs/StreamableResponseBody (-write-body-to-stream [_ _ output-stream] (try - - (with-open [bos (buffered-output-stream output-stream buffer-size)] + (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)] (json/write! bos data json-mapper)) - (catch java.io.IOException _cause - ;; Do nothing, EOF means client closes connection abruptly - nil) + (catch java.io.IOException _) (catch Throwable cause (l/warn :hint "unexpected error on encoding response" :cause cause)) @@ -140,15 +138,15 @@ (.close ^OutputStream output-stream)))))) (format-response-with-json [response _] - (let [body (yrs/body response)] + (let [body (::yrs/body response)] (if (or (boolean? body) (coll? body)) (-> response - (update :headers assoc "content-type" "application/json") - (assoc :body (json-streamable-body body))) + (update ::yrs/headers assoc "content-type" "application/json") + (assoc ::yrs/body (json-streamable-body body))) response))) (format-response-with-transit [response request] - (let [body (yrs/body response)] + (let [body (::yrs/body response)] (if (or (boolean? body) (coll? body)) (let [qs (yrq/query request) opts (if (or (contains? cf/flags :transit-readable-response) @@ -156,8 +154,8 @@ {:type :json-verbose} {:type :json})] (-> response - (update :headers assoc "content-type" "application/transit+json") - (assoc :body (transit-streamable-body body opts)))) + (update ::yrs/headers assoc "content-type" "application/transit+json") + (assoc ::yrs/body (transit-streamable-body body opts)))) response))) (format-response [response request] @@ -181,8 +179,7 @@ (fn [request respond raise] (handler request (fn [response] - (let [response (process-response response request)] - (respond response))) + (respond (process-response response request))) raise)))) (def format-response @@ -191,74 +188,59 @@ (defn wrap-errors [handler on-error] - (fn [request respond _] + (fn [request respond raise] (handler request respond (fn [cause] - (-> cause (on-error request) respond))))) + (try + (respond (on-error cause request)) + (catch Throwable cause + (raise cause))))))) (def errors {:name ::errors :compile (constantly wrap-errors)}) +(defn- with-cors-headers + [headers origin] + (-> headers + (assoc "access-control-allow-origin" origin) + (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH") + (assoc "access-control-allow-credentials" "true") + (assoc "access-control-expose-headers" "x-requested-with, content-type, cookie") + (assoc "access-control-allow-headers" "x-frontend-version, content-type, accept, x-requested-width"))) + (defn wrap-cors [handler] - (if-not (contains? cf/flags :cors) - handler - (letfn [(add-headers [headers request] - (let [origin (yrq/get-header request "origin")] - (-> headers - (assoc "access-control-allow-origin" origin) - (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH") - (assoc "access-control-allow-credentials" "true") - (assoc "access-control-expose-headers" "x-requested-with, content-type, cookie") - (assoc "access-control-allow-headers" "x-frontend-version, content-type, accept, x-requested-width")))) - - (update-response [response request] - (update response :headers add-headers request))] - - (fn [request respond raise] - (if (= (yrq/method request) :options) - (-> (yrs/response 200) - (update-response request) - (respond)) - (handler request - (fn [response] - (respond (update-response response request))) - raise)))))) + (fn [request] + (let [response (if (= (yrq/method request) :options) + {::yrs/status 200} + (handler request)) + origin (yrq/get-header request "origin")] + (update response ::yrs/headers with-cors-headers origin)))) (def cors {:name ::cors - :compile (constantly wrap-cors)}) - -(defn compile-restrict-methods - [data _] - (when-let [allowed (:allowed-methods data)] - (fn [handler] - (fn [request respond raise] - (let [method (yrq/method request)] - (if (contains? allowed method) - (handler request respond raise) - (respond (yrs/response 405)))))))) + :compile (fn [& _] + (when (contains? cf/flags :cors) + wrap-cors))}) (def restrict-methods {:name ::restrict-methods - :compile compile-restrict-methods}) + :compile + (fn [data _] + (when-let [allowed (:allowed-methods data)] + (fn [handler] + (fn [request respond raise] + (let [method (yrq/method request)] + (if (contains? allowed method) + (handler request respond raise) + (respond {::yrs/status 405})))))))}) (def with-dispatch {:name ::with-dispatch :compile (fn [& _] (fn [handler executor] - (fn [request respond raise] - (-> (px/submit! executor #(handler request)) - (p/bind p/wrap) - (p/then respond) - (p/catch raise)))))}) - -(def with-config - {:name ::with-config - :compile - (fn [& _] - (fn [handler config] - (fn - ([request] (handler config request)) - ([request respond raise] (handler config request respond raise)))))}) + (let [executor (px/resolve-executor executor)] + (fn [request respond raise] + (->> (px/submit! executor (partial handler request)) + (p/fnly (pu/handler respond raise)))))))}) diff --git a/backend/src/app/http/session.clj b/backend/src/app/http/session.clj index 4d951f800..ea8002688 100644 --- a/backend/src/app/http/session.clj +++ b/backend/src/app/http/session.clj @@ -8,7 +8,6 @@ (:refer-clojure :exclude [read]) (:require [app.common.data :as d] - [app.common.exceptions :as ex] [app.common.logging :as l] [app.common.spec :as us] [app.config :as cf] @@ -18,12 +17,9 @@ [app.main :as-alias main] [app.tokens :as tokens] [app.util.time :as dt] - [app.worker :as wrk] [clojure.spec.alpha :as s] [cuerdas.core :as str] [integrant.core :as ig] - [promesa.core :as p] - [promesa.exec :as px] [yetti.request :as yrq])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -76,69 +72,56 @@ :id key}) (defn- database-manager - [{:keys [::db/pool ::wrk/executor ::main/props]}] - ^{::wrk/executor executor - ::db/pool pool - ::main/props props} + [pool] (reify ISessionManager (read [_ token] - (px/with-dispatch executor - (db/exec-one! pool (sql/select :http-session {:id token})))) + (db/exec-one! pool (sql/select :http-session {:id token}))) (write! [_ key params] - (px/with-dispatch executor - (let [params (prepare-session-params key params)] - (db/insert! pool :http-session params) - params))) + (let [params (prepare-session-params key params)] + (db/insert! pool :http-session params) + params)) (update! [_ params] (let [updated-at (dt/now)] - (px/with-dispatch executor - (db/update! pool :http-session - {:updated-at updated-at} - {:id (:id params)}) - (assoc params :updated-at updated-at)))) + (db/update! pool :http-session + {:updated-at updated-at} + {:id (:id params)}) + (assoc params :updated-at updated-at))) (delete! [_ token] - (px/with-dispatch executor - (db/delete! pool :http-session {:id token}) - nil)))) + (db/delete! pool :http-session {:id token}) + nil))) (defn inmemory-manager - [{:keys [::db/pool ::wrk/executor ::main/props]}] + [] (let [cache (atom {})] - ^{::main/props props - ::wrk/executor executor - ::db/pool pool} (reify ISessionManager (read [_ token] - (p/do (get @cache token))) + (get @cache token)) (write! [_ key params] - (p/do - (let [params (prepare-session-params key params)] - (swap! cache assoc key params) - params))) + (let [params (prepare-session-params key params)] + (swap! cache assoc key params) + params)) (update! [_ params] - (p/do - (let [updated-at (dt/now)] - (swap! cache update (:id params) assoc :updated-at updated-at) - (assoc params :updated-at updated-at)))) + (let [updated-at (dt/now)] + (swap! cache update (:id params) assoc :updated-at updated-at) + (assoc params :updated-at updated-at))) (delete! [_ token] - (p/do - (swap! cache dissoc token) - nil))))) + (swap! cache dissoc token) + nil)))) (defmethod ig/pre-init-spec ::manager [_] - (s/keys :req [::db/pool ::wrk/executor ::main/props])) + (s/keys :req [::db/pool])) (defmethod ig/init-key ::manager - [_ {:keys [::db/pool] :as cfg}] + [_ {:keys [::db/pool]}] (if (db/read-only? pool) - (inmemory-manager cfg) - (database-manager cfg))) + (inmemory-manager) + (database-manager pool))) (defmethod ig/halt-key! ::manager [_ _]) @@ -154,40 +137,35 @@ (declare ^:private gen-token) (defn create-fn - [{:keys [::manager]} profile-id] + [{:keys [::manager ::main/props]} profile-id] (us/assert! ::manager manager) (us/assert! ::us/uuid profile-id) - (let [props (-> manager meta ::main/props)] - (fn [request response] - (let [uagent (yrq/get-header request "user-agent") - params {:profile-id profile-id - :user-agent uagent - :created-at (dt/now)} - token (gen-token props params)] + (fn [request response] + (let [uagent (yrq/get-header request "user-agent") + params {:profile-id profile-id + :user-agent uagent + :created-at (dt/now)} + token (gen-token props params) + session (write! manager token params)] + (l/trace :hint "create" :profile-id (str profile-id)) + (-> response + (assign-auth-token-cookie session) + (assign-authenticated-cookie session))))) - (->> (write! manager token params) - (p/fmap (fn [session] - (l/trace :hint "create" :profile-id (str profile-id)) - (-> response - (assign-auth-token-cookie session) - (assign-authenticated-cookie session))))))))) (defn delete-fn [{:keys [::manager]}] (us/assert! ::manager manager) - (letfn [(delete [{:keys [profile-id] :as request}] - (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name) - cookie (yrq/get-cookie request cname)] - (l/trace :hint "delete" :profile-id profile-id) - (some->> (:value cookie) (delete! manager))))] - (fn [request response] - (p/do - (delete request) - (-> response - (assoc :status 204) - (assoc :body nil) - (clear-auth-token-cookie) - (clear-authenticated-cookie)))))) + (fn [request response] + (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name) + cookie (yrq/get-cookie request cname)] + (l/trace :hint "delete" :profile-id (:profile-id request)) + (some->> (:value cookie) (delete! manager)) + (-> response + (assoc :status 204) + (assoc :body nil) + (clear-auth-token-cookie) + (clear-authenticated-cookie))))) (defn- gen-token [props {:keys [profile-id created-at]}] @@ -216,58 +194,39 @@ (let [elapsed (dt/diff updated-at (dt/now))] (neg? (compare default-renewal-max-age elapsed))))) -(defn- wrap-reneval - [respond manager session] - (fn [response] - (p/let [session (update! manager session)] - (-> response - (assign-auth-token-cookie session) - (assign-authenticated-cookie session) - (respond))))) - (defn- wrap-soft-auth - [handler {:keys [::manager]}] + [handler {:keys [::manager ::main/props]}] (us/assert! ::manager manager) + (letfn [(handle-request [request] + (try + (let [token (get-token request) + claims (decode-token props token)] + (cond-> request + (map? claims) + (-> (assoc ::token-claims claims) + (assoc ::token token)))) + (catch Throwable cause + (l/trace :hint "exception on decoding malformed token" :cause cause) + request)))] - (let [{:keys [::wrk/executor ::main/props]} (meta manager)] (fn [request respond raise] - (let [token (ex/try! (get-token request))] - (if (ex/exception? token) - (raise token) - (->> (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 ::token-claims claims) - (assoc ::token token)))] - (handler request respond raise)))))))))) + (let [request (handle-request request)] + (handler request respond raise))))) (defn- wrap-authz [handler {:keys [::manager]}] (us/assert! ::manager manager) - (fn [request respond raise] - (if-let [token (::token request)] - (->> (get-session manager token) - (p/fnly (fn [session cause] - (cond - (some? cause) - (raise cause) + (fn [request] + (let [session (get-session manager (::token request)) + request (cond-> request + (some? session) + (assoc ::profile-id (:profile-id session) + ::id (:id session)))] - (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)))) + (cond-> (handler request) + (renew-session? session) + (-> (assign-auth-token-cookie session) + (assign-authenticated-cookie session)))))) (def soft-auth {:name ::soft-auth diff --git a/backend/src/app/http/websocket.clj b/backend/src/app/http/websocket.clj index 309458b7d..3351566ca 100644 --- a/backend/src/app/http/websocket.clj +++ b/backend/src/app/http/websocket.clj @@ -279,22 +279,21 @@ (s/keys :req-un [::session-id])) (defn- http-handler - [cfg {:keys [params ::session/profile-id] :as request} respond raise] + [cfg {:keys [params ::session/profile-id] :as request}] (let [{:keys [session-id]} (us/conform ::handler-params params)] (cond (not profile-id) - (raise (ex/error :type :authentication - :hint "Authentication required.")) + (ex/raise :type :authentication + :hint "Authentication required.") (not (yws/upgrade-request? request)) - (raise (ex/error :type :validation - :code :websocket-request-expected - :hint "this endpoint only accepts websocket connections")) + (ex/raise :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) @@ -302,8 +301,7 @@ ::ws/handler (partial handle-message cfg) ::profile-id profile-id ::session-id session-id) - (yws/upgrade request) - (respond)))))) + (yws/upgrade request)))))) (defmethod ig/pre-init-spec ::routes [_] (s/keys :req [::mbus/msgbus diff --git a/backend/src/app/loggers/audit.clj b/backend/src/app/loggers/audit.clj index 4ded05800..5846cc151 100644 --- a/backend/src/app/loggers/audit.clj +++ b/backend/src/app/loggers/audit.clj @@ -16,13 +16,15 @@ [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] - [app.http.client :as http] + [app.http :as-alias http] + [app.http.client :as http.client] [app.loggers.audit.tasks :as-alias tasks] [app.loggers.webhooks :as-alias webhooks] [app.main :as-alias main] [app.rpc :as-alias rpc] [app.tokens :as tokens] [app.util.retry :as rtry] + [app.util.services :as-alias sv] [app.util.time :as dt] [app.worker :as wrk] [clojure.spec.alpha :as s] @@ -92,6 +94,15 @@ ;; --- SPECS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; COLLECTOR +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Defines a service that collects the audit/activity log using +;; internal database. Later this audit log can be transferred to +;; an external storage and data cleared. + (s/def ::profile-id ::us/uuid) (s/def ::name ::us/string) (s/def ::type ::us/string) @@ -104,20 +115,13 @@ (s/or :fn fn? :str string? :kw keyword?)) (s/def ::event - (s/keys :req-un [::type ::name ::profile-id] - :opt-un [::ip-addr ::props] - :opt [::webhooks/event? + (s/keys :req [::type ::name ::profile-id] + :opt [::ip-addr + ::props + ::webhooks/event? ::webhooks/batch-timeout ::webhooks/batch-key])) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; COLLECTOR -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Defines a service that collects the audit/activity log using -;; internal database. Later this audit log can be transferred to -;; an external storage and data cleared. - (s/def ::collector (s/keys :req [::wrk/executor ::db/pool])) @@ -133,15 +137,58 @@ :else cfg)) +(defn prepare-event + [cfg mdata params result] + (let [resultm (meta result) + request (::http/request params) + profile-id (or (::profile-id resultm) + (:profile-id result) + (::rpc/profile-id params) + uuid/zero) + + props (-> (or (::replace-props resultm) + (-> params + (merge (::props resultm)) + (dissoc :profile-id) + (dissoc :type))) + + (clean-props))] + + {::type (or (::type resultm) + (::rpc/type cfg)) + ::name (or (::name resultm) + (::sv/name mdata)) + ::profile-id profile-id + ::ip-addr (some-> request parse-client-ip) + ::props props + + ;; NOTE: for batch-key lookup we need the params as-is + ;; because the rpc api does not need to know the + ;; audit/webhook specific object layout. + ::rpc/params (dissoc params ::http/request) + + ::webhooks/batch-key + (or (::webhooks/batch-key mdata) + (::webhooks/batch-key resultm)) + + ::webhooks/batch-timeout + (or (::webhooks/batch-timeout mdata) + (::webhooks/batch-timeout resultm)) + + ::webhooks/event? + (or (::webhooks/event? mdata) + (::webhooks/event? resultm) + false)})) + (defn- handle-event! [conn-or-pool event] (us/verify! ::event event) (let [params {:id (uuid/next) - :name (:name event) - :type (:type event) - :profile-id (:profile-id event) - :ip-addr (:ip-addr event) - :props (:props event)}] + :name (::name event) + :type (::type event) + :profile-id (::profile-id event) + :ip-addr (::ip-addr event) + :props (::props event)}] (when (contains? cf/flags :audit-log) ;; NOTE: this operation may cause primary key conflicts on inserts @@ -207,7 +254,7 @@ (s/def ::tasks/uri ::us/string) (defmethod ig/pre-init-spec ::tasks/archive-task [_] - (s/keys :req [::db/pool ::main/props ::http/client])) + (s/keys :req [::db/pool ::main/props ::http.client/client])) (defmethod ig/init-key ::tasks/archive [_ cfg] @@ -231,7 +278,7 @@ (if n (do (px/sleep 100) - (recur (+ total n))) + (recur (+ total ^long n))) (when (pos? total) (l/debug :hint "events archived" :total total))))))))) @@ -281,7 +328,7 @@ :method :post :headers headers :body body} - resp (http/req! cfg params {:sync? true})] + resp (http.client/req! cfg params {:sync? true})] (if (= (:status resp) 204) true (do diff --git a/backend/src/app/loggers/database.clj b/backend/src/app/loggers/database.clj index 566057a1c..1e9045de8 100644 --- a/backend/src/app/loggers/database.clj +++ b/backend/src/app/loggers/database.clj @@ -85,14 +85,10 @@ (defmethod ig/init-key ::reporter [_ cfg] (let [input (sp/chan :buf (sp/sliding-buffer 32) - :xf (filter error-record?))] + :xf (filter error-record?))] (add-watch l/log-record ::reporter #(sp/put! input %4)) - ;; FIXME: we don't use virtual threads here until JDBC is uptaded - ;; to >= 42.6.0 bacause it has the necessary fixes fro make the - ;; JDBC driver properly compatible with Virtual Threads. - - (px/thread {:name "penpot/database-reporter" :virtual false} + (px/thread {:name "penpot/database-reporter" :virtual true} (l/info :hint "initializing database error persistence") (try (loop [] diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index b2cbce8f7..29554232d 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -14,7 +14,6 @@ [app.db :as-alias db] [app.email :as-alias email] [app.http :as-alias http] - [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] @@ -37,7 +36,8 @@ [app.util.time :as dt] [app.worker :as-alias wrk] [cuerdas.core :as str] - [integrant.core :as ig]) + [integrant.core :as ig] + [promesa.exec :as px]) (:gen-class)) (def default-metrics @@ -102,15 +102,15 @@ ::mdef/labels ["name"] ::mdef/type :summary} - :rpc-climit-queue-size - {::mdef/name "penpot_rpc_climit_queue_size" - ::mdef/help "Current number of queued submissions on the CLIMIT." + :rpc-climit-queue + {::mdef/name "penpot_rpc_climit_queue" + ::mdef/help "Current number of queued submissions." ::mdef/labels ["name"] ::mdef/type :gauge} - :rpc-climit-concurrency - {::mdef/name "penpot_rpc_climit_concurrency" - ::mdef/help "Current number of used concurrency capacity on the CLIMIT" + :rpc-climit-permits + {::mdef/name "penpot_rpc_climit_permits" + ::mdef/help "Current number of available permits" ::mdef/labels ["name"] ::mdef/type :gauge} @@ -174,7 +174,8 @@ ;; Default thread pool for IO operations ::wrk/executor - {::wrk/parallelism (cf/get :default-executor-parallelism 100)} + {::wrk/parallelism (cf/get :default-executor-parallelism + (+ 3 (* (px/get-available-processors) 3)))} ::wrk/monitor {::mtx/metrics (ig/ref ::mtx/metrics) @@ -191,8 +192,9 @@ {::mtx/metrics (ig/ref ::mtx/metrics)} ::rds/redis - {::rds/uri (cf/get :redis-uri) - ::mtx/metrics (ig/ref ::mtx/metrics)} + {::rds/uri (cf/get :redis-uri) + ::mtx/metrics (ig/ref ::mtx/metrics) + ::wrk/executor (ig/ref ::wrk/executor)} ::mbus/msgbus {::wrk/executor (ig/ref ::wrk/executor) @@ -212,14 +214,7 @@ {::wrk/executor (ig/ref ::wrk/executor)} ::session/manager - {::db/pool (ig/ref ::db/pool) - ::wrk/executor (ig/ref ::wrk/executor) - ::props (ig/ref :app.setup/props)} - - ::actoken/manager - {::db/pool (ig/ref ::db/pool) - ::wrk/executor (ig/ref ::wrk/executor) - ::props (ig/ref :app.setup/props)} + {::db/pool (ig/ref ::db/pool)} ::session.tasks/gc {::db/pool (ig/ref ::db/pool)} @@ -269,7 +264,6 @@ {::http.client/client (ig/ref ::http.client/client) ::db/pool (ig/ref ::db/pool) ::props (ig/ref :app.setup/props) - ::wrk/executor (ig/ref ::wrk/executor) ::oidc/providers {:google (ig/ref ::oidc.providers/google) :github (ig/ref ::oidc.providers/github) :gitlab (ig/ref ::oidc.providers/gitlab) @@ -278,8 +272,6 @@ :app.http/router {::session/manager (ig/ref ::session/manager) - ::actoken/manager (ig/ref ::actoken/manager) - ::wrk/executor (ig/ref ::wrk/executor) ::db/pool (ig/ref ::db/pool) ::rpc/routes (ig/ref ::rpc/routes) ::rpc.doc/routes (ig/ref ::rpc.doc/routes) @@ -344,7 +336,6 @@ ::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 diff --git a/backend/src/app/media.clj b/backend/src/app/media.clj index 72dbb83d3..192aa2cb9 100644 --- a/backend/src/app/media.clj +++ b/backend/src/app/media.clj @@ -16,6 +16,7 @@ [app.storage :as-alias sto] [app.storage.tmp :as tmp] [app.util.svg :as svg] + [app.util.time :as dt] [buddy.core.bytes :as bb] [buddy.core.codecs :as bc] [clojure.java.shell :as sh] @@ -168,7 +169,7 @@ (ex/raise :type :validation :code :invalid-svg-file :hint "uploaded svg does not provides dimensions")) - (merge input info)) + (merge input info {:ts (dt/now)})) (let [instance (Info. (str path)) mtype' (.getProperty instance "Mime type")] @@ -183,7 +184,8 @@ ;; any frame. (assoc input :width (.getPageWidth instance) - :height (.getPageHeight instance)))))) + :height (.getPageHeight instance) + :ts (dt/now)))))) (defmethod process-error org.im4java.core.InfoException [error] diff --git a/backend/src/app/redis.clj b/backend/src/app/redis.clj index 4f7a8ed5a..c0436fb1d 100644 --- a/backend/src/app/redis.clj +++ b/backend/src/app/redis.clj @@ -8,11 +8,13 @@ "The msgbus abstraction implemented using redis as underlying backend." (:require [app.common.data :as d] + [app.common.exceptions :as ex] [app.common.logging :as l] [app.common.spec :as us] [app.metrics :as mtx] [app.redis.script :as-alias rscript] [app.util.time :as dt] + [app.worker :as-alias wrk] [clojure.core :as c] [clojure.java.io :as io] [clojure.spec.alpha :as s] @@ -45,6 +47,10 @@ io.lettuce.core.resource.DefaultClientResources io.netty.util.HashedWheelTimer io.netty.util.Timer + java.util.function.Function + com.github.benmanes.caffeine.cache.Cache + com.github.benmanes.caffeine.cache.Caffeine + com.github.benmanes.caffeine.cache.RemovalListener java.lang.AutoCloseable java.time.Duration)) @@ -88,7 +94,7 @@ (s/def ::connect? ::us/boolean) (s/def ::io-threads ::us/integer) (s/def ::worker-threads ::us/integer) -(s/def ::cache #(instance? clojure.lang.Atom %)) +(s/def ::cache some?) (s/def ::redis (s/keys :req [::resources @@ -130,6 +136,20 @@ (def string-codec (RedisCodec/of StringCodec/UTF8 StringCodec/UTF8)) +(defn- create-cache + [{:keys [::wrk/executor] :as cfg}] + (let [listener (reify RemovalListener + (onRemoval [_ key cache cause] + (l/trace :hint "cache: remove" :key key :reason (str cause) :repr (pr-str cache)) + (some-> cache d/close!))) + ] + + (.. (Caffeine/newBuilder) + (weakValues) + (executor executor) + (removalListener listener) + (build)))) + (defn- initialize-resources "Initialize redis connection resources" [{:keys [::uri ::io-threads ::worker-threads ::connect?] :as cfg}] @@ -146,17 +166,18 @@ (timer ^Timer timer) (build)) - redis-uri (RedisURI/create ^String uri)] + redis-uri (RedisURI/create ^String uri) + cfg (-> cfg + (assoc ::resources resources) + (assoc ::timer timer) + (assoc ::redis-uri redis-uri))] - (-> cfg - (assoc ::resources resources) - (assoc ::timer timer) - (assoc ::cache (atom {})) - (assoc ::redis-uri redis-uri)))) + (assoc cfg ::cache (create-cache cfg)))) (defn- shutdown-resources [{:keys [::resources ::cache ::timer]}] - (run! d/close! (vals @cache)) + (.invalidateAll ^Cache cache) + (when resources (.shutdown ^ClientResources resources)) (when timer @@ -174,6 +195,7 @@ :default (.connect ^RedisClient client ^RedisCodec codec) :pubsub (.connectPubSub ^RedisClient client ^RedisCodec codec))] + (l/trc :hint "connect" :hid (hash client)) (.setTimeout ^StatefulConnection conn ^Duration timeout) (reify IDeref @@ -181,8 +203,9 @@ AutoCloseable (close [_] - (.close ^StatefulConnection conn) - (.shutdown ^RedisClient client))))) + (ex/ignoring (.close ^StatefulConnection conn)) + (ex/ignoring (.shutdown ^RedisClient client)) + (l/trc :hint "disconnect" :hid (hash client)))))) (defn connect [state & {:as opts}] @@ -195,15 +218,16 @@ (defn get-or-connect [{:keys [::cache] :as state} key options] (us/assert! ::redis state) - (-> state - (assoc ::connection - (or (get @cache key) - (-> (swap! cache (fn [cache] - (when-let [prev (get cache key)] - (d/close! prev)) - (assoc cache key (connect* state options)))) - (get key)))) - (dissoc ::cache))) + ;; FIXME: the cache causes vthread pinning + (let [connection (.get ^Cache cache + ^Object key + ^Function (reify + Function + (apply [_ _key] + (connect* state options))))] + (-> state + (dissoc ::cache) + (assoc ::connection connection)))) (defn add-listener! [{:keys [::connection] :as conn} listener] @@ -345,7 +369,7 @@ (do (l/error :hint "no script found" :name sname :cause cause) (->> (load-script) - (p/mapcat eval-script))) + (p/mcat eval-script))) (if-let [on-error (::rscript/on-error script)] (on-error cause) (p/rejected cause)))) @@ -376,15 +400,16 @@ (load-script [] (l/trace :hint "load script" :name sname) (->> (.scriptLoad ^RedisScriptingAsyncCommands cmd - ^String (read-script)) - (p/map (fn [sha] - (swap! scripts-cache assoc sname sha) - sha))))] + ^String (read-script)) + (p/fmap (fn [sha] + (swap! scripts-cache assoc sname sha) + sha))))] - (if-let [sha (get @scripts-cache sname)] - (eval-script sha) - (->> (load-script) - (p/mapcat eval-script)))))) + (p/await! + (if-let [sha (get @scripts-cache sname)] + (eval-script sha) + (->> (load-script) + (p/mapcat eval-script))))))) (defn timeout-exception? [cause] diff --git a/backend/src/app/rpc.clj b/backend/src/app/rpc.clj index 617f0ea70..b276b40cc 100644 --- a/backend/src/app/rpc.clj +++ b/backend/src/app/rpc.clj @@ -11,7 +11,6 @@ [app.common.exceptions :as ex] [app.common.logging :as l] [app.common.spec :as us] - [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] [app.http :as-alias http] @@ -19,7 +18,6 @@ [app.http.client :as-alias http.client] [app.http.session :as session] [app.loggers.audit :as audit] - [app.loggers.webhooks :as-alias webhooks] [app.main :as-alias main] [app.metrics :as mtx] [app.msgbus :as-alias mbus] @@ -35,7 +33,6 @@ [clojure.spec.alpha :as s] [integrant.core :as ig] [promesa.core :as p] - [promesa.exec :as px] [yetti.request :as yrq] [yetti.response :as yrs])) @@ -47,12 +44,10 @@ (defn- handle-response-transformation [response request mdata] - (let [transform-fn (reduce (fn [res-fn transform-fn] - (fn [request response] - (p/then (res-fn request response) #(transform-fn request %)))) - (constantly response) - (::response-transform-fns mdata))] - (transform-fn request response))) + (reduce (fn [response transform-fn] + (transform-fn request response)) + response + (::response-transform-fns mdata))) (defn- handle-before-comple-hook [response mdata] @@ -63,18 +58,18 @@ (defn- handle-response [request result] (if (fn? result) - (p/wrap (result request)) + (result request) (let [mdata (meta result)] - (p/-> (yrs/response {:status (::http/status mdata 200) - :headers (::http/headers mdata {}) - :body (rph/unwrap result)}) - (handle-response-transformation request mdata) - (handle-before-comple-hook mdata))))) + (-> {::yrs/status (::http/status mdata 200) + ::yrs/headers (::http/headers mdata {}) + ::yrs/body (rph/unwrap result)} + (handle-response-transformation request mdata) + (handle-before-comple-hook mdata))))) (defn- rpc-query-handler "Ring handler that dispatches query requests and convert between internal async flow into ring async flow." - [methods {:keys [params path-params] :as request} respond raise] + [methods {:keys [params path-params] :as request}] (let [type (keyword (:type path-params)) profile-id (or (::session/profile-id request) (::actoken/profile-id request)) @@ -87,19 +82,14 @@ (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 cause) - (respond response))))))) + method (get methods type default-handler) + response (method data)] + (handle-response request response))) (defn- rpc-mutation-handler "Ring handler that dispatches mutation requests and convert between internal async flow into ring async flow." - [methods {:keys [params path-params] :as request} respond raise] + [methods {:keys [params path-params] :as request}] (let [type (keyword (:type path-params)) profile-id (or (::session/profile-id request) (::actoken/profile-id request)) @@ -111,24 +101,18 @@ (assoc :profile-id profile-id) (assoc ::profile-id profile-id)) (dissoc data :profile-id)) - method (get methods type default-handler)] - - (->> (method data) - (p/mcat (partial handle-response request)) - (p/fnly (fn [response cause] - (if cause - (raise cause) - (respond response))))))) + method (get methods type default-handler) + response (method data)] + (handle-response request response))) (defn- rpc-command-handler "Ring handler that dispatches cmd requests and convert between internal async flow into ring async flow." - [methods {:keys [params path-params] :as request} respond raise] + [methods {:keys [params path-params] :as request}] (let [type (keyword (:type path-params)) etag (yrq/get-header request "if-none-match") profile-id (or (::session/profile-id request) (::actoken/profile-id request)) - data (-> params (assoc ::request-at (dt/now)) (assoc ::session/id (::session/id request)) @@ -140,12 +124,8 @@ method (get methods type default-handler)] (binding [cond/*enabled* true] - (->> (method data) - (p/mcat (partial handle-response request)) - (p/fnly (fn [response cause] - (if cause - (raise cause) - (respond response)))))))) + (let [response (method data)] + (handle-response request response))))) (defn- wrap-metrics "Wrap service method with metrics measurement." @@ -153,23 +133,22 @@ (let [labels (into-array String [(::sv/name mdata)])] (fn [cfg params] (let [tp (dt/tpoint)] - (->> (f cfg params) - (p/fnly (fn [_ _] - (mtx/run! metrics - :id metrics-id - :val (inst-ms (tp)) - :labels labels)))))))) - + (try + (f cfg params) + (finally + (mtx/run! metrics + :id metrics-id + :val (inst-ms (tp)) + :labels labels))))))) (defn- wrap-authentication [_ f mdata] (fn [cfg params] (let [profile-id (::profile-id params)] (if (and (::auth mdata true) (not (uuid? profile-id))) - (p/rejected - (ex/error :type :authentication - :code :authentication-required - :hint "authentication required for this endpoint")) + (ex/raise :type :authentication + :code :authentication-required + :hint "authentication required for this endpoint") (f cfg params))))) (defn- wrap-access-token @@ -182,98 +161,34 @@ (let [perms (::actoken/perms request #{})] (if (contains? perms name) (f cfg params) - (p/rejected - (ex/error :type :authorization - :code :operation-not-allowed - :allowed perms)))) + (ex/raise :type :authorization + :code :operation-not-allowed + :allowed perms))) (f cfg params)))) f)) -(defn- wrap-dispatch - "Wraps service method into async flow, with the ability to dispatching - it to a preconfigured executor service." - [{:keys [::wrk/executor] :as cfg} f mdata] - (with-meta - (fn [cfg params] - (->> (px/submit! executor (px/wrap-bindings #(f cfg params))) - (p/mapcat p/wrap) - (p/map rph/wrap))) - mdata)) - (defn- wrap-audit - [cfg f mdata] + [_ f mdata] (if (or (contains? cf/flags :webhooks) (contains? cf/flags :audit-log)) - (letfn [(handle-audit [params result] - (let [resultm (meta result) - request (::http/request params) - - profile-id (or (::audit/profile-id resultm) - (:profile-id result) - (if (= (::type cfg) "command") - (::profile-id params) - (:profile-id params)) - uuid/zero) - - props (-> (or (::audit/replace-props resultm) - (-> params - (merge (::audit/props resultm)) - (dissoc :profile-id) - (dissoc :type))) - (audit/clean-props)) - - event {:type (or (::audit/type resultm) - (::type cfg)) - :name (or (::audit/name resultm) - (::sv/name mdata)) - :profile-id profile-id - :ip-addr (some-> request audit/parse-client-ip) - :props props - - ;; NOTE: for batch-key lookup we need the params as-is - ;; because the rpc api does not need to know the - ;; audit/webhook specific object layout. - ::params (dissoc params ::http/request) - - ::webhooks/batch-key - (or (::webhooks/batch-key mdata) - (::webhooks/batch-key resultm)) - - ::webhooks/batch-timeout - (or (::webhooks/batch-timeout mdata) - (::webhooks/batch-timeout resultm)) - - ::webhooks/event? - (or (::webhooks/event? mdata) - (::webhooks/event? resultm) - false)}] - - (audit/submit! cfg event))) - - (handle-request [cfg params] - (->> (f cfg params) - (p/fnly (fn [result cause] - (when-not cause - (handle-audit params result))))))] - - (if-not (::audit/skip mdata) - (with-meta handle-request mdata) - f)) + (if-not (::audit/skip mdata) + (fn [cfg params] + (let [result (f cfg params)] + (->> (audit/prepare-event cfg mdata params result) + (audit/submit! cfg)) + result)) + 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)))))) + (f cfg (us/conform spec 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) @@ -288,13 +203,11 @@ [cfg f mdata] (l/debug :hint "register method" :name (::sv/name mdata)) (let [f (wrap-all cfg f mdata)] - (with-meta #(f cfg %) mdata))) + (partial f cfg))) (defn- process-method - [cfg vfn] - (let [mdata (meta vfn)] - [(keyword (::sv/name mdata)) - (wrap cfg vfn mdata)])) + [cfg [vfn mdata]] + [(keyword (::sv/name mdata)) [mdata (wrap cfg vfn mdata)]]) (defn- resolve-query-methods [cfg] @@ -371,13 +284,13 @@ :commands (resolve-command-methods cfg)})) (s/def ::mutations - (s/map-of keyword? fn?)) + (s/map-of keyword? (s/tuple map? fn?))) (s/def ::queries - (s/map-of keyword? fn?)) + (s/map-of keyword? (s/tuple map? fn?))) (s/def ::commands - (s/map-of keyword? fn?)) + (s/map-of keyword? (s/tuple map? fn?))) (s/def ::methods (s/keys :req-un [::mutations @@ -391,15 +304,18 @@ ::db/pool ::main/props ::wrk/executor - ::session/manager - ::actoken/manager])) + ::session/manager])) (defmethod ig/init-key ::routes [_ {:keys [::methods] :as cfg}] - [["/rpc" {:middleware [[session/authz cfg] - [actoken/authz cfg]]} - ["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}] - ["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}] - ["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods)) - :allowed-methods #{:post}}]]]) + (let [methods (-> methods + (update :commands update-vals peek) + (update :queries update-vals peek) + (update :mutations update-vals peek))] + [["/rpc" {:middleware [[session/authz cfg] + [actoken/authz cfg]]} + ["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}] + ["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}] + ["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods)) + :allowed-methods #{:post}}]]])) diff --git a/backend/src/app/rpc/climit.clj b/backend/src/app/rpc/climit.clj index 4985f6f25..8314469ec 100644 --- a/backend/src/app/rpc/climit.clj +++ b/backend/src/app/rpc/climit.clj @@ -6,14 +6,15 @@ (ns app.rpc.climit "Concurrencly limiter for RPC." + (:refer-clojure :exclude [run!]) (:require - [app.common.data :as d] [app.common.exceptions :as ex] [app.common.logging :as l] [app.common.spec :as us] [app.config :as cf] [app.metrics :as mtx] [app.rpc :as-alias rpc] + [app.rpc.climit.config :as-alias config] [app.util.services :as-alias sv] [app.util.time :as dt] [app.worker :as-alias wrk] @@ -23,84 +24,15 @@ [integrant.core :as ig] [promesa.core :as p] [promesa.exec :as px] - [promesa.exec.bulkhead :as pxb]) + [promesa.exec.bulkhead :as pbh]) (:import - com.github.benmanes.caffeine.cache.Cache + clojure.lang.ExceptionInfo + com.github.benmanes.caffeine.cache.LoadingCache com.github.benmanes.caffeine.cache.CacheLoader com.github.benmanes.caffeine.cache.Caffeine com.github.benmanes.caffeine.cache.RemovalListener)) -(defn- capacity-exception? - [o] - (and (ex/error? o) - (let [data (ex-data o)] - (and (= :bulkhead-error (:type data)) - (= :capacity-limit-reached (:code data)))))) - -(defn invoke! - [limiter f] - (->> (px/submit! limiter f) - (p/hcat (fn [result cause] - (cond - (capacity-exception? cause) - (p/rejected - (ex/error :type :internal - :code :concurrency-limit-reached - :queue (-> limiter meta ::bkey name) - :cause cause)) - - (some? cause) - (p/rejected cause) - - :else - (p/resolved result)))))) - -(defn- create-limiter - [{:keys [::wrk/executor ::mtx/metrics ::bkey ::skey concurrency queue-size]}] - (let [labels (into-array String [(name bkey)]) - on-queue (fn [instance] - (l/trace :hint "enqueued" - :key (name bkey) - :skey (str skey) - :queue-size (get instance ::pxb/current-queue-size) - :concurrency (get instance ::pxb/current-concurrency)) - (mtx/run! metrics - :id :rpc-climit-queue-size - :val (get instance ::pxb/current-queue-size) - :labels labels) - (mtx/run! metrics - :id :rpc-climit-concurrency - :val (get instance ::pxb/current-concurrency) - :labels labels)) - - on-run (fn [instance task] - (let [elapsed (- (inst-ms (dt/now)) - (inst-ms task))] - (l/trace :hint "execute" - :key (name bkey) - :skey (str skey) - :elapsed (str elapsed "ms")) - (mtx/run! metrics - :id :rpc-climit-timing - :val elapsed - :labels labels) - (mtx/run! metrics - :id :rpc-climit-queue-size - :val (get instance ::pxb/current-queue-size) - :labels labels) - (mtx/run! metrics - :id :rpc-climit-concurrency - :val (get instance ::pxb/current-concurrency) - :labels labels))) - - options {:executor executor - :concurrency concurrency - :queue-size (or queue-size Integer/MAX_VALUE) - :on-queue on-queue - :on-run on-run}] - - (-> (pxb/create options) - (vary-meta assoc ::bkey bkey ::skey skey)))) +(set! *warn-on-reflection* true) (defn- create-cache [{:keys [::wrk/executor] :as params} config] @@ -110,97 +42,187 @@ loader (reify CacheLoader (load [_ key] - (let [[bkey skey] key] - (when-let [config (get config bkey)] - (-> (merge params config) - (assoc ::bkey bkey) - (assoc ::skey skey) - (create-limiter))))))] + (let [config (get config (nth key 0))] + (pbh/create :permits (or (:permits config) (:concurrency config)) + :queue (or (:queue config) (:queue-size config)) + :timeout (:timeout config) + :executor executor + :type (:type config :semaphore)))))] + (.. (Caffeine/newBuilder) + (weakValues) + (executor executor) + (removalListener listener) + (build loader)))) - (.. (Caffeine/newBuilder) - (weakValues) - (executor executor) - (removalListener listener) - (build loader)))) - -(defprotocol IConcurrencyManager) - -(s/def ::concurrency ::us/integer) -(s/def ::queue-size ::us/integer) +(s/def ::config/permits ::us/integer) +(s/def ::config/queue ::us/integer) +(s/def ::config/timeout ::us/integer) (s/def ::config (s/map-of keyword? - (s/keys :req-un [::concurrency] - :opt-un [::queue-size]))) + (s/keys :opt-un [::config/permits + ::config/queue + ::config/timeout]))) (defmethod ig/prep-key ::rpc/climit [_ cfg] - (merge {::path (cf/get :rpc-climit-config)} - (d/without-nils cfg))) + (assoc cfg ::path (cf/get :rpc-climit-config))) (s/def ::path ::fs/path) - (defmethod ig/pre-init-spec ::rpc/climit [_] (s/keys :req [::wrk/executor ::mtx/metrics ::path])) (defmethod ig/init-key ::rpc/climit - [_ {:keys [::path] :as params}] + [_ {:keys [::path ::mtx/metrics ::wrk/executor] :as cfg}] (when (contains? cf/flags :rpc-climit) - (if-let [config (some->> path slurp edn/read-string)] - (do - (l/info :hint "initializing concurrency limit" :config (str path)) - (us/verify! ::config config) - - (let [cache (create-cache params config)] - ^{::cache cache} - (reify - IConcurrencyManager - clojure.lang.IDeref - (deref [_] config) - - clojure.lang.ILookup - (valAt [_ key] - (let [key (if (vector? key) key [key])] - (.get ^Cache cache key)))))) - - (l/warn :hint "unable to load configuration" :config (str path))))) + (when-let [params (some->> path slurp edn/read-string)] + (l/info :hint "initializing concurrency limit" :config (str path)) + (us/verify! ::config params) + {::cache (create-cache cfg params) + ::config params + ::wrk/executor executor + ::mtx/metrics metrics}))) +(s/def ::cache #(instance? LoadingCache %)) +(s/def ::instance + (s/keys :req [::cache ::config ::wrk/executor])) (s/def ::rpc/climit - (s/nilable #(satisfies? IConcurrencyManager %))) + (s/nilable ::instance)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PUBLIC API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defn invoke! + [cache metrics id key f] + (let [limiter (.get ^LoadingCache cache [id key]) + tpoint (dt/tpoint) + labels (into-array String [(name id)]) + + wrapped + (fn [] + (let [elapsed (tpoint) + stats (pbh/get-stats limiter)] + (l/trace :hint "executed" + :id (name id) + :key key + :fnh (hash f) + :permits (:permits stats) + :queue (:queue stats) + :max-permits (:max-permits stats) + :max-queue (:max-queue stats) + :elapsed (dt/format-duration elapsed)) + (mtx/run! metrics + :id :rpc-climit-timing + :val (inst-ms elapsed) + :labels labels) + (try + (f) + (finally + (let [elapsed (tpoint)] + (l/trace :hint "finished" + :id (name id) + :key key + :fnh (hash f) + :permits (:permits stats) + :queue (:queue stats) + :max-permits (:max-permits stats) + :max-queue (:max-queue stats) + :elapsed (dt/format-duration elapsed))))))) + measure! + (fn [stats] + (mtx/run! metrics + :id :rpc-climit-queue + :val (:queue stats) + :labels labels) + (mtx/run! metrics + :id :rpc-climit-permits + :val (:permits stats) + :labels labels))] + + (try + (let [stats (pbh/get-stats limiter)] + (measure! stats) + (l/trace :hint "enqueued" + :id (name id) + :key key + :fnh (hash f) + :permits (:permits stats) + :queue (:queue stats) + :max-permits (:max-permits stats) + :max-queue (:max-queue stats)) + (pbh/invoke! limiter wrapped)) + (catch ExceptionInfo cause + (let [{:keys [type code]} (ex-data cause)] + (if (= :bulkhead-error type) + (ex/raise :type :concurrency-limit + :code code + :hint "concurrency limit reached") + (throw cause)))) + + (finally + (measure! (pbh/get-stats limiter)))))) + + +(defn run! + [{:keys [::id ::cache ::mtx/metrics]} f] + (if (and cache id) + (invoke! cache metrics id nil f) + (f))) + +(defn submit! + [{:keys [::id ::cache ::wrk/executor ::mtx/metrics]} f] + (let [f (partial px/submit! executor f)] + (if (and cache id) + (p/await! (invoke! cache metrics id nil f)) + (p/await! (f))))) + +(defn configure + ([{:keys [::rpc/climit]} id] + (us/assert! ::rpc/climit climit) + (assoc climit ::id id)) + ([{:keys [::rpc/climit]} id executor] + (us/assert! ::rpc/climit climit) + (-> climit + (assoc ::id id) + (assoc ::wrk/executor executor)))) + +(defmacro with-dispatch! + "Dispatch blocking operation to a separated thread protected with the + specified concurrency limiter. If climit is not active, the function + will be scheduled to execute without concurrency monitoring." + [instance & body] + (if (vector? instance) + `(-> (app.rpc.climit/configure ~@instance) + (app.rpc.climit/run! (^:once fn* [] ~@body))) + `(run! ~instance (^:once fn* [] ~@body)))) + (defmacro with-dispatch - [lim & body] - `(if ~lim - (invoke! ~lim (^:once fn [] (p/wrap (do ~@body)))) - (p/wrap (do ~@body)))) + "Dispatch blocking operation to a separated thread protected with + the specified semaphore. + DEPRECATED" + [& params] + `(with-dispatch! ~@params)) + +(def noop-fn (constantly nil)) (defn wrap - [{:keys [::rpc/climit]} f {:keys [::queue ::key-fn] :as mdata}] - (if (and (some? climit) - (some? queue)) - (if-let [config (get @climit queue)] - (do + [{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}] + (if (and (some? climit) (some? id)) + (if-let [config (get-in climit [::config id])] + (let [cache (::cache climit)] (l/debug :hint "wrap: instrumenting method" - :limit-name (name queue) + :limit (name id) :service-name (::sv/name mdata) - :queue-size (or (:queue-size config) Integer/MAX_VALUE) - :concurrency (:concurrency config) + :timeout (:timeout config) + :permits (:permits config) + :queue (:queue config) :keyed? (some? key-fn)) - (if (some? key-fn) - (fn [cfg params] - (let [key [queue (key-fn params)] - lim (get climit key)] - (invoke! lim (partial f cfg params)))) - (let [lim (get climit queue)] - (fn [cfg params] - (invoke! lim (partial f cfg params)))))) + (fn [cfg params] + (invoke! cache metrics id (key-fn params) (partial f cfg params)))) + (do - (l/warn :hint "wrap: no config found" - :queue (name queue) - :service (::sv/name mdata)) + (l/warn :hint "no config found for specified queue" :id id) f)) + f)) diff --git a/backend/src/app/rpc/commands/audit.clj b/backend/src/app/rpc/commands/audit.clj index 9e5e4c76a..b094cbb67 100644 --- a/backend/src/app/rpc/commands/audit.clj +++ b/backend/src/app/rpc/commands/audit.clj @@ -21,10 +21,7 @@ [app.rpc.helpers :as rph] [app.util.services :as sv] [app.util.time :as dt] - [app.worker :as wrk] - [clojure.spec.alpha :as s] - [promesa.core :as p] - [promesa.exec :as px])) + [clojure.spec.alpha :as s])) (defn- event->row [event] [(uuid/next) @@ -71,17 +68,22 @@ :req-un [::events])) (sv/defmethod ::push-audit-events - {::climit/queue :push-audit-events + {::climit/id :submit-audit-events-by-profile ::climit/key-fn ::rpc/profile-id ::audit/skip true ::doc/added "1.17"} - [{:keys [::db/pool ::wrk/executor] :as cfg} params] + [{:keys [::db/pool] :as cfg} params] (if (or (db/read-only? pool) (not (contains? cf/flags :audit-log))) (do (l/warn :hint "audit: http handler disabled or db is read-only") (rph/wrap nil)) - (->> (px/submit! executor #(handle-events cfg params)) - (p/fmap (constantly nil))))) + (do + (try + (handle-events cfg params) + (catch Throwable cause + (l/error :hint "unexpected error on persisting audit events from frontend" + :cause cause))) + (rph/wrap nil)))) diff --git a/backend/src/app/rpc/commands/auth.clj b/backend/src/app/rpc/commands/auth.clj index aaeb4835b..f9ba7e87b 100644 --- a/backend/src/app/rpc/commands/auth.clj +++ b/backend/src/app/rpc/commands/auth.clj @@ -6,7 +6,6 @@ (ns app.rpc.commands.auth (:require - [app.auth :as auth] [app.common.data :as d] [app.common.exceptions :as ex] [app.common.spec :as us] @@ -18,7 +17,6 @@ [app.loggers.audit :as audit] [app.main :as-alias main] [app.rpc :as-alias rpc] - [app.rpc.climit :as climit] [app.rpc.commands.profile :as profile] [app.rpc.commands.teams :as teams] [app.rpc.doc :as-alias doc] @@ -68,7 +66,7 @@ (ex/raise :type :validation :code :account-without-password :hint "the current account does not have password")) - (:valid (auth/verify-password password (:password profile)))) + (:valid (profile/verify-password cfg password (:password profile)))) (validate-profile [profile] (when-not profile @@ -118,7 +116,6 @@ (sv/defmethod ::login-with-password "Performs authentication using penpot password." {::rpc/auth false - ::climit/queue :auth ::doc/added "1.15"} [cfg params] (login-with-password cfg params)) @@ -144,7 +141,7 @@ (:profile-id tdata))) (update-password [conn profile-id] - (let [pwd (auth/derive-password password)] + (let [pwd (profile/derive-password cfg password)] (db/update! conn :profile {:password pwd} {:id profile-id})))] (db/with-atomic [conn pool] @@ -158,7 +155,6 @@ (sv/defmethod ::recover-profile {::rpc/auth false - ::climit/queue :auth ::doc/added "1.15"} [cfg params] (recover-profile cfg params)) @@ -264,9 +260,7 @@ :nudge {:big 10 :small 1}}) (db/tjson)) - password (if-let [password (:password params)] - (auth/derive-password password) - "!") + password (or (:password params) "!") locale (:locale params) locale (when (and (string? locale) (not (str/blank? locale))) @@ -344,8 +338,11 @@ profile (if-let [profile-id (:profile-id claims)] (profile/get-profile conn profile-id) - (->> (create-profile! conn (assoc params :is-active is-active)) - (create-profile-rels! conn))) + (let [params (-> params + (assoc :is-active is-active) + (update :password #(profile/derive-password cfg %)))] + (->> (create-profile! conn params) + (create-profile-rels! conn)))) invitation (when-let [token (:invitation-token params)] (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))] @@ -356,9 +353,9 @@ (when-let [id (:profile-id claims)] (db/update! conn :profile {:modified-at (dt/now)} {:id id}) (audit/submit! cfg - {:type "fact" - :name "register-profile-retry" - :profile-id id})) + {::audit/type "fact" + ::audit/name "register-profile-retry" + ::audit/profile-id id})) (cond ;; If invitation token comes in params, this is because the @@ -406,7 +403,6 @@ (sv/defmethod ::register-profile {::rpc/auth false - ::climit/queue :auth ::doc/added "1.15"} [{:keys [::db/pool] :as cfg} params] (db/with-atomic [conn pool] diff --git a/backend/src/app/rpc/commands/binfile.clj b/backend/src/app/rpc/commands/binfile.clj index 3fefa9109..c34331b7a 100644 --- a/backend/src/app/rpc/commands/binfile.clj +++ b/backend/src/app/rpc/commands/binfile.clj @@ -37,6 +37,7 @@ [clojure.walk :as walk] [cuerdas.core :as str] [datoteka.io :as io] + [promesa.core :as p] [yetti.adapter :as yt] [yetti.response :as yrs]) (:import @@ -354,7 +355,6 @@ (with-open [^AutoCloseable conn (db/open pool)] (db/exec! conn [sql:file-library-rels (db/create-array conn "uuid" ids)]))) - (defn- create-or-update-file [conn params] (let [sql (str "INSERT INTO file (id, project_id, name, revn, is_shared, data, created_at, modified_at) " @@ -527,13 +527,13 @@ (write-obj! output sids) (doseq [id sids] - (let [{:keys [size] :as obj} @(sto/get-object storage id)] + (let [{:keys [size] :as obj} (p/await! (sto/get-object storage id))] (l/debug :hint "write sobject" :id id ::l/sync? true) (doto output (write-uuid! id) (write-obj! (meta obj))) - (with-open [^InputStream stream @(sto/get-object-data storage obj)] + (with-open [^InputStream stream (p/await! (sto/get-object-data storage obj))] (let [written (write-stream! output stream size)] (when (not= written size) (ex/raise :type :validation @@ -719,7 +719,7 @@ (assoc ::sto/touched-at (dt/now)) (assoc :bucket "file-media-object")) - sobject @(sto/put-object! storage params)] + sobject (p/await! (sto/put-object! storage params))] (l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true) (vswap! *state* update :index assoc id (:id sobject))))) @@ -910,7 +910,9 @@ (export! output-stream))))] (fn [_] - (yrs/response 200 body {"content-type" "application/octet-stream"})))) + {::yrs/status 200 + ::yrs/body body + ::yrs/headers {"content-type" "application/octet-stream"}}))) (s/def ::file ::media/upload) (s/def ::import-binfile diff --git a/backend/src/app/rpc/commands/demo.clj b/backend/src/app/rpc/commands/demo.clj index 32897de92..3dabb96fb 100644 --- a/backend/src/app/rpc/commands/demo.clj +++ b/backend/src/app/rpc/commands/demo.clj @@ -13,6 +13,7 @@ [app.loggers.audit :as audit] [app.rpc :as-alias rpc] [app.rpc.commands.auth :as auth] + [app.rpc.commands.profile :as profile] [app.rpc.doc :as-alias doc] [app.util.services :as sv] [app.util.time :as dt] @@ -48,7 +49,7 @@ :fullname fullname :is-active true :deleted-at (dt/in-future cf/deletion-delay) - :password password + :password (profile/derive-password cfg password) :props {}}] (db/with-atomic [conn pool] diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index d767499a0..c31ea398a 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -101,7 +101,7 @@ (defn- wrap-with-pointer-map-context [f] - (fn [{:keys [conn] :as cfg} {:keys [id] :as file}] + (fn [{:keys [::db/conn] :as cfg} {:keys [id] :as file}] (binding [pmap/*tracked* (atom {}) pmap/*load-fn* (partial files/load-pointer conn id) ffeat/*wrap-with-pointer-map-fn* pmap/wrap] @@ -126,7 +126,7 @@ ;; database. (sv/defmethod ::update-file - {::climit/queue :update-file + {::climit/id :update-file-by-id ::climit/key-fn :id ::webhooks/event? true ::webhooks/batch-timeout (dt/duration "2m") @@ -136,8 +136,7 @@ (db/with-atomic [conn pool] (files/check-edition-permissions! conn profile-id id) (db/xact-lock! conn id) - - (let [cfg (assoc cfg :conn conn) + (let [cfg (assoc cfg ::db/conn conn) params (assoc params :profile-id profile-id) tpoint (dt/tpoint)] (-> (update-file cfg params) @@ -145,7 +144,7 @@ (l/trace :hint "update-file" :time (dt/format-duration elapsed)))))))) (defn update-file - [{:keys [conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}] + [{:keys [::db/conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}] (let [file (get-file conn id) features (->> (concat (:features file) (:features params)) @@ -197,24 +196,34 @@ :project-id (:project-id file) :team-id (:team-id file)})))))) +(defn- update-file-data + [file changes] + (-> file + (update :revn inc) + (update :data (fn [data] + (cond-> data + :always + (-> (blob/decode) + (assoc :id (:id file)) + (pmg/migrate-data)) + + (and (contains? ffeat/*current* "components/v2") + (not (contains? ffeat/*previous* "components/v2"))) + (ctf/migrate-to-components-v2) + + :always + (-> (cp/process-changes changes) + (blob/encode))))))) + + (defn- update-file* - [{:keys [conn] :as cfg} {:keys [profile-id file changes session-id ::created-at] :as params}] - (let [file (-> file - (update :revn inc) - (update :data (fn [data] - (cond-> data - :always - (-> (blob/decode) - (assoc :id (:id file)) - (pmg/migrate-data)) + [{:keys [::db/conn] :as cfg} {:keys [profile-id file changes session-id ::created-at] :as params}] + (let [;; Process the file data in the CLIMIT context; scheduling it + ;; to be executed on a separated executor for avoid to do the + ;; CPU intensive operation on vthread. + file (-> (climit/configure cfg :update-file) + (climit/submit! (partial update-file-data file changes)))] - (and (contains? ffeat/*current* "components/v2") - (not (contains? ffeat/*previous* "components/v2"))) - (ctf/migrate-to-components-v2) - - :always - (-> (cp/process-changes changes) - (blob/encode))))))] (db/insert! conn :file-change {:id (uuid/next) :session-id session-id @@ -273,7 +282,7 @@ (vec))) (defn- send-notifications! - [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}] + [{:keys [::db/conn] :as cfg} {:keys [file changes session-id] :as params}] (let [lchanges (filter library-change? changes) msgbus (::mbus/msgbus cfg)] diff --git a/backend/src/app/rpc/commands/fonts.clj b/backend/src/app/rpc/commands/fonts.clj index 67be5f526..c52dcc613 100644 --- a/backend/src/app/rpc/commands/fonts.clj +++ b/backend/src/app/rpc/commands/fonts.clj @@ -6,7 +6,6 @@ (ns app.rpc.commands.fonts (:require - [app.common.data :as d] [app.common.exceptions :as ex] [app.common.spec :as us] [app.common.uuid :as uuid] @@ -15,7 +14,7 @@ [app.loggers.webhooks :as-alias webhooks] [app.media :as media] [app.rpc :as-alias rpc] - [app.rpc.climit :as-alias climit] + [app.rpc.climit :as climit] [app.rpc.commands.files :as files] [app.rpc.commands.projects :as projects] [app.rpc.commands.teams :as teams] @@ -25,10 +24,8 @@ [app.storage :as sto] [app.util.services :as sv] [app.util.time :as dt] - [app.worker :as-alias wrk] [clojure.spec.alpha :as s] - [promesa.core :as p] - [promesa.exec :as px])) + [promesa.core :as p])) (def valid-weight #{100 200 300 400 500 600 700 800 900 950}) (def valid-style #{"normal" "italic"}) @@ -107,50 +104,45 @@ (create-font-variant cfg (assoc params :profile-id profile-id)))) (defn create-font-variant - [{:keys [::sto/storage ::db/pool ::wrk/executor ::rpc/climit]} {:keys [data] :as params}] - (letfn [(generate-fonts [data] - (climit/with-dispatch (:process-font climit) - (media/run {:cmd :generate-fonts :input data}))) + [{:keys [::sto/storage ::db/pool] :as cfg} {:keys [data] :as params}] + (letfn [(generate-missing! [data] + (let [data (media/run {:cmd :generate-fonts :input data})] + (when (and (not (contains? data "font/otf")) + (not (contains? data "font/ttf")) + (not (contains? data "font/woff")) + (not (contains? data "font/woff2"))) + (ex/raise :type :validation + :code :invalid-font-upload + :hint "invalid font upload, unable to generate missing font assets")) + data)) - ;; Function responsible of calculating cryptographyc hash of - ;; the provided data. - (calculate-hash [data] - (px/with-dispatch executor - (sto/calculate-hash data))) - - (validate-data [data] - (when (and (not (contains? data "font/otf")) - (not (contains? data "font/ttf")) - (not (contains? data "font/woff")) - (not (contains? data "font/woff2"))) - (ex/raise :type :validation - :code :invalid-font-upload)) - data) - - (persist-font-object [data mtype] + (prepare-font [data mtype] (when-let [resource (get data mtype)] - (p/let [hash (calculate-hash resource) - content (-> (sto/content resource) - (sto/wrap-with-hash hash))] - (sto/put-object! storage {::sto/content content - ::sto/touched-at (dt/now) - ::sto/deduplicate? true - :content-type mtype - :bucket "team-font-variant"})))) + (let [hash (sto/calculate-hash resource) + content (-> (sto/content resource) + (sto/wrap-with-hash hash))] + {::sto/content content + ::sto/touched-at (dt/now) + ::sto/deduplicate? true + :content-type mtype + :bucket "team-font-variant"}))) - (persist-fonts [data] - (p/let [otf (persist-font-object data "font/otf") - ttf (persist-font-object data "font/ttf") - woff1 (persist-font-object data "font/woff") - woff2 (persist-font-object data "font/woff2")] + (persist-fonts-files! [data] + (let [otf-params (prepare-font data "font/otf") + ttf-params (prepare-font data "font/ttf") + wf1-params (prepare-font data "font/woff") + wf2-params (prepare-font data "font/woff2")] + (cond-> {} + (some? otf-params) + (assoc :otf (p/await! (sto/put-object! storage otf-params))) + (some? ttf-params) + (assoc :ttf (p/await! (sto/put-object! storage ttf-params))) + (some? wf1-params) + (assoc :woff1 (p/await! (sto/put-object! storage wf1-params))) + (some? wf2-params) + (assoc :woff2 (p/await! (sto/put-object! storage wf2-params)))))) - (d/without-nils - {:otf otf - :ttf ttf - :woff1 woff1 - :woff2 woff2}))) - - (insert-into-db [{:keys [woff1 woff2 otf ttf]}] + (insert-font-variant! [{:keys [woff1 woff2 otf ttf]}] (db/insert! pool :team-font-variant {:id (uuid/next) :team-id (:team-id params) @@ -164,13 +156,11 @@ :ttf-file-id (:id ttf)})) ] - (->> (generate-fonts data) - (p/fmap validate-data) - (p/mcat executor persist-fonts) - (p/fmap executor insert-into-db) - (p/fmap (fn [result] - (let [params (update params :data (comp vec keys))] - (rph/with-meta result {::audit/replace-props params}))))))) + (let [data (-> (climit/configure cfg :process-font) + (climit/submit! (partial generate-missing! data))) + assets (persist-fonts-files! data) + result (insert-font-variant! assets)] + (vary-meta result assoc ::audit/replace-props (update params :data (comp vec keys)))))) ;; --- UPDATE FONT FAMILY diff --git a/backend/src/app/rpc/commands/media.clj b/backend/src/app/rpc/commands/media.clj index 168a78538..ccd2981cc 100644 --- a/backend/src/app/rpc/commands/media.clj +++ b/backend/src/app/rpc/commands/media.clj @@ -22,13 +22,10 @@ [app.storage :as sto] [app.storage.tmp :as tmp] [app.util.services :as sv] - [app.util.time :as dt] - [app.worker :as-alias wrk] [clojure.spec.alpha :as s] [cuerdas.core :as str] [datoteka.io :as io] - [promesa.core :as p] - [promesa.exec :as px])) + [promesa.core :as p])) (def default-max-file-size (* 1024 1024 10)) ; 10 MiB @@ -110,71 +107,62 @@ ;; witch holds the reference to storage object (it some kind of ;; inverse, soft referential integrity). +(defn- process-main-image + [info] + (let [hash (sto/calculate-hash (:path info)) + data (-> (sto/content (:path info)) + (sto/wrap-with-hash hash))] + {::sto/content data + ::sto/deduplicate? true + ::sto/touched-at (:ts info) + :content-type (:mtype info) + :bucket "file-media-object"})) + +(defn- process-thumb-image + [info] + (let [thumb (-> thumbnail-options + (assoc :cmd :generic-thumbnail) + (assoc :input info) + (media/run)) + hash (sto/calculate-hash (:data thumb)) + data (-> (sto/content (:data thumb) (:size thumb)) + (sto/wrap-with-hash hash))] + {::sto/content data + ::sto/deduplicate? true + ::sto/touched-at (:ts info) + :content-type (:mtype thumb) + :bucket "file-media-object"})) + +(defn- process-image + [content] + (let [info (media/run {:cmd :info :input content})] + (cond-> info + (and (not (svg-image? info)) + (big-enough-for-thumbnail? info)) + (assoc ::thumb (process-thumb-image info)) + + :always + (assoc ::image (process-main-image info))))) + (defn create-file-media-object - [{:keys [::sto/storage ::db/pool climit ::wrk/executor]} + [{:keys [::sto/storage ::db/pool] :as cfg} {:keys [id file-id is-local name content]}] - (letfn [;; Function responsible to retrieve the file information, as - ;; it is synchronous operation it should be wrapped into - ;; with-dispatch macro. - (get-info [content] - (climit/with-dispatch (:process-image climit) - (media/run {:cmd :info :input content}))) - ;; Function responsible of calculating cryptographyc hash of - ;; the provided data. - (calculate-hash [data] - (px/with-dispatch executor - (sto/calculate-hash data))) + (let [result (-> (climit/configure cfg :process-image) + (climit/submit! (partial process-image content))) - ;; Function responsible of generating thumnail. As it is synchronous - ;; opetation, it should be wrapped into with-dispatch macro - (generate-thumbnail [info] - (climit/with-dispatch (:process-image climit) - (media/run (assoc thumbnail-options - :cmd :generic-thumbnail - :input info)))) + image (p/await! (sto/put-object! storage (::image result))) + thumb (when-let [params (::thumb result)] + (p/await! (sto/put-object! storage params)))] - (create-thumbnail [info] - (when (and (not (svg-image? info)) - (big-enough-for-thumbnail? info)) - (p/let [thumb (generate-thumbnail info) - hash (calculate-hash (:data thumb)) - content (-> (sto/content (:data thumb) (:size thumb)) - (sto/wrap-with-hash hash))] - (sto/put-object! storage - {::sto/content content - ::sto/deduplicate? true - ::sto/touched-at (dt/now) - :content-type (:mtype thumb) - :bucket "file-media-object"})))) - - (create-image [info] - (p/let [data (:path info) - hash (calculate-hash data) - content (-> (sto/content data) - (sto/wrap-with-hash hash))] - (sto/put-object! storage - {::sto/content content - ::sto/deduplicate? true - ::sto/touched-at (dt/now) - :content-type (:mtype info) - :bucket "file-media-object"}))) - - (insert-into-database [info image thumb] - (px/with-dispatch executor - (db/exec-one! pool [sql:create-file-media-object - (or id (uuid/next)) - file-id is-local name - (:id image) - (:id thumb) - (:width info) - (:height info) - (:mtype info)])))] - - (p/let [info (get-info content) - thumb (create-thumbnail info) - image (create-image info)] - (insert-into-database info image thumb)))) + (db/exec-one! pool [sql:create-file-media-object + (or id (uuid/next)) + file-id is-local name + (:id image) + (:id thumb) + (:width result) + (:height result) + (:mtype result)]))) ;; --- Create File Media Object (from URL) @@ -192,9 +180,9 @@ (files/check-edition-permissions! pool profile-id file-id) (create-file-media-object-from-url cfg params))) -(defn- create-file-media-object-from-url - [cfg {:keys [url name] :as params}] - (letfn [(parse-and-validate-size [headers] +(defn- download-image + [{:keys [::http/client]} uri] + (letfn [(parse-and-validate [{:keys [headers] :as response}] (let [size (some-> (get headers "content-length") d/parse-integer) mtype (get headers "content-type") format (cm/mtype->format mtype) @@ -217,32 +205,34 @@ :code :media-type-not-allowed :hint "seems like the url points to an invalid media object")) - {:size size - :mtype mtype - :format format})) + {:size size :mtype mtype :format format}))] - (download-media [uri] - (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream}) - (p/then process-response))) + (let [{:keys [body] :as response} (http/req! client + {:method :get :uri uri} + {:response-type :input-stream :sync? true}) + {:keys [size mtype]} (parse-and-validate response) - (process-response [{:keys [body headers] :as response}] - (let [{:keys [size mtype]} (parse-and-validate-size headers) - path (tmp/tempfile :prefix "penpot.media.download.") - written (io/write-to-file! body path :size size)] + path (tmp/tempfile :prefix "penpot.media.download.") + written (io/write-to-file! body path :size size)] - (when (not= written size) - (ex/raise :type :internal - :code :mismatch-write-size - :hint "unexpected state: unable to write to file")) + (when (not= written size) + (ex/raise :type :internal + :code :mismatch-write-size + :hint "unexpected state: unable to write to file")) - {:filename "tempfile" - :size size - :path path - :mtype mtype}))] + {:filename "tempfile" + :size size + :path path + :mtype mtype}))) - (p/let [content (download-media url)] - (->> (merge params {:content content :name (or name (:filename content))}) - (create-file-media-object cfg))))) + +(defn- create-file-media-object-from-url + [cfg {:keys [url name] :as params}] + (let [content (download-image cfg url) + params (-> params + (assoc :content content) + (assoc :name (or name (:filename content))))] + (create-file-media-object cfg params))) ;; --- Clone File Media object (Upload and create from url) diff --git a/backend/src/app/rpc/commands/profile.clj b/backend/src/app/rpc/commands/profile.clj index acdb2584b..3d75e3e95 100644 --- a/backend/src/app/rpc/commands/profile.clj +++ b/backend/src/app/rpc/commands/profile.clj @@ -26,17 +26,17 @@ [app.tokens :as tokens] [app.util.services :as sv] [app.util.time :as dt] - [app.worker :as-alias wrk] [clojure.spec.alpha :as s] [cuerdas.core :as str] - [promesa.core :as p] - [promesa.exec :as px])) + [promesa.core :as p])) +(declare check-profile-existence!) (declare decode-row) +(declare derive-password) +(declare filter-props) (declare get-profile) (declare strip-private-attrs) -(declare filter-props) -(declare check-profile-existence!) +(declare verify-password) ;; --- QUERY: Get profile (own) @@ -50,6 +50,7 @@ ;; 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 ;; cases we need to reraise the exception. + (try (-> (get-profile pool profile-id) (strip-private-attrs) @@ -120,10 +121,10 @@ :req-un [::password ::old-password])) (sv/defmethod ::update-profile-password - {::climit/queue :auth} [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}] (db/with-atomic [conn pool] - (let [profile (validate-password! conn (assoc params :profile-id profile-id)) + (let [cfg (assoc cfg ::db/conn conn) + profile (validate-password! cfg (assoc params :profile-id profile-id)) session-id (::session/id params)] (when (= (str/lower (:email profile)) @@ -132,29 +133,30 @@ :code :email-as-password :hint "you can't use your email as password")) - (update-profile-password! conn (assoc profile :password password)) - (invalidate-profile-session! conn profile-id session-id) + (update-profile-password! cfg (assoc profile :password password)) + (invalidate-profile-session! cfg profile-id session-id) nil))) (defn- invalidate-profile-session! "Removes all sessions except the current one." - [conn profile-id session-id] + [{:keys [::db/conn]} profile-id session-id] (let [sql "delete from http_session where profile_id = ? and id != ?"] (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id])))) (defn- validate-password! - [conn {:keys [profile-id old-password] :as params}] + [{:keys [::db/conn] :as cfg} {:keys [profile-id old-password] :as params}] (let [profile (db/get-by-id conn :profile profile-id ::db/for-update? true)] - (when-not (:valid (auth/verify-password old-password (:password profile))) + (when-not (:valid (verify-password cfg old-password (:password profile))) (ex/raise :type :validation :code :old-password-not-match)) profile)) (defn update-profile-password! - [conn {:keys [id password] :as profile}] - (db/update! conn :profile - {:password (auth/derive-password password)} - {:id id})) + [{:keys [::db/conn] :as cfg} {:keys [id password] :as profile}] + (let [password (derive-password cfg password)] + (db/update! conn :profile + {:password password} + {:id id}))) ;; --- MUTATION: Update Photo @@ -173,61 +175,49 @@ (let [cfg (update cfg ::sto/storage media/configure-assets-storage)] (update-profile-photo cfg (assoc params :profile-id profile-id)))) -;; TODO: reimplement it without p/let - (defn update-profile-photo - [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}] - (letfn [(on-uploaded [photo] - (let [profile (db/get-by-id pool :profile profile-id ::db/for-update? true)] + [{:keys [::db/pool ::sto/storage] :as cfg} {:keys [profile-id file] :as params}] + (let [photo (upload-photo cfg params) + profile (db/get-by-id pool :profile profile-id ::db/for-update? true)] - ;; Schedule deletion of old photo - (when-let [id (:photo-id profile)] - (sto/touch-object! storage id)) + ;; Schedule deletion of old photo + (when-let [id (:photo-id profile)] + (p/await! (sto/touch-object! storage id))) - ;; Save new photo - (db/update! pool :profile - {:photo-id (:id photo)} - {:id profile-id}) + ;; Save new photo + (db/update! pool :profile + {:photo-id (:id photo)} + {:id profile-id}) - (-> (rph/wrap) - (rph/with-meta {::audit/replace-props - {:file-name (:filename file) - :file-size (:size file) - :file-path (str (:path file)) - :file-mtype (:mtype file)}}))))] - (->> (upload-photo cfg params) - (p/fmap executor on-uploaded)))) + (-> (rph/wrap) + (rph/with-meta {::audit/replace-props + {:file-name (:filename file) + :file-size (:size file) + :file-path (str (:path file)) + :file-mtype (:mtype file)}})))) + +(defn- generate-thumbnail! + [file] + (let [input (media/run {:cmd :info :input file}) + thumb (media/run {:cmd :profile-thumbnail + :format :jpeg + :quality 85 + :width 256 + :height 256 + :input input}) + hash (sto/calculate-hash (:data thumb)) + content (-> (sto/content (:data thumb) (:size thumb)) + (sto/wrap-with-hash hash))] + {::sto/content content + ::sto/deduplicate? true + :bucket "profile" + :content-type (:mtype thumb)})) (defn upload-photo - [{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}] - (letfn [(get-info [content] - (climit/with-dispatch (:process-image climit) - (media/run {:cmd :info :input content}))) - - (generate-thumbnail [info] - (climit/with-dispatch (:process-image climit) - (media/run {:cmd :profile-thumbnail - :format :jpeg - :quality 85 - :width 256 - :height 256 - :input info}))) - - ;; Function responsible of calculating cryptographyc hash of - ;; the provided data. - (calculate-hash [data] - (px/with-dispatch executor - (sto/calculate-hash data)))] - - (p/let [info (get-info file) - thumb (generate-thumbnail info) - hash (calculate-hash (:data thumb)) - content (-> (sto/content (:data thumb) (:size thumb)) - (sto/wrap-with-hash hash))] - (sto/put-object! storage {::sto/content content - ::sto/deduplicate? true - :bucket "profile" - :content-type (:mtype thumb)})))) + [{:keys [::sto/storage] :as cfg} {:keys [file]}] + (let [params (-> (climit/configure cfg :process-image) + (climit/submit! (partial generate-thumbnail! file)))] + (p/await! (sto/put-object! storage params)))) ;; --- MUTATION: Request Email Change @@ -417,6 +407,17 @@ [props] (into {} (filter (fn [[k _]] (simple-ident? k))) props)) +(defn derive-password + [cfg password] + (when password + (-> (climit/configure cfg :derive-password) + (climit/submit! (partial auth/derive-password password))))) + +(defn verify-password + [cfg password password-data] + (-> (climit/configure cfg :derive-password) + (climit/submit! (partial auth/verify-password password password-data)))) + (defn decode-row [{:keys [props] :as row}] (cond-> row diff --git a/backend/src/app/rpc/commands/teams.clj b/backend/src/app/rpc/commands/teams.clj index 2d6f6e22e..483f20741 100644 --- a/backend/src/app/rpc/commands/teams.clj +++ b/backend/src/app/rpc/commands/teams.clj @@ -27,11 +27,9 @@ [app.tokens :as tokens] [app.util.services :as sv] [app.util.time :as dt] - [app.worker :as-alias wrk] [clojure.spec.alpha :as s] [cuerdas.core :as str] - [promesa.core :as p] - [promesa.exec :as px])) + [promesa.core :as p])) ;; --- Helpers & Specs @@ -78,6 +76,8 @@ (declare retrieve-teams) +(def counter (volatile! 0)) + (s/def ::get-teams (s/keys :req [::rpc/profile-id])) @@ -588,15 +588,14 @@ (update-team-photo cfg (assoc params :profile-id profile-id)))) (defn update-team-photo - [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}] - (p/let [team (px/with-dispatch executor - (retrieve-team pool profile-id team-id)) - photo (profile/upload-photo cfg params)] + [{:keys [::db/pool ::sto/storage] :as cfg} {:keys [profile-id team-id] :as params}] + (let [team (retrieve-team pool profile-id team-id) + photo (profile/upload-photo cfg params)] ;; Mark object as touched for make it ellegible for tentative ;; garbage collection. (when-let [id (:photo-id team)] - (sto/touch-object! storage id)) + (p/await! (sto/touch-object! storage id))) ;; Save new photo (db/update! pool :team @@ -694,13 +693,13 @@ (l/info :hint "invitation token" :token itoken)) (audit/submit! cfg - {:type "action" - :name (if updated? - "update-team-invitation" - "create-team-invitation") - :profile-id (:id profile) - :props (-> (dissoc tprops :profile-id) - (d/without-nils))}) + {::audit/type "action" + ::audit/name (if updated? + "update-team-invitation" + "create-team-invitation") + ::audit/profile-id (:id profile) + ::audit/props (-> (dissoc tprops :profile-id) + (d/without-nils))}) (eml/send! {::eml/conn conn ::eml/factory eml/invite-to-team @@ -802,13 +801,13 @@ ::quotes/incr (count emails)})) (audit/submit! cfg - {:type "command" - :name "create-team-invitations" - :profile-id profile-id - :props {:emails emails - :role role - :profile-id profile-id - :invitations (count emails)}}) + {::audit/type "command" + ::audit/name "create-team-invitations" + ::audit/profile-id profile-id + ::audit/props {:emails emails + :role role + :profile-id profile-id + :invitations (count emails)}}) (vary-meta team assoc ::audit/props {:invitations (count emails)})))) diff --git a/backend/src/app/rpc/commands/webhooks.clj b/backend/src/app/rpc/commands/webhooks.clj index 0d072c92a..14d452540 100644 --- a/backend/src/app/rpc/commands/webhooks.clj +++ b/backend/src/app/rpc/commands/webhooks.clj @@ -48,30 +48,26 @@ (defn- validate-webhook! [cfg whook params] - (letfn [(handle-exception [exception] - (if-let [hint (webhooks/interpret-exception exception)] - (ex/raise :type :validation - :code :webhook-validation - :hint hint) - (ex/raise :type :internal - :code :webhook-validation - :cause exception))) + (when (not= (:uri whook) (:uri params)) + (try + (let [response (http/req! cfg + {:method :head + :uri (str (:uri params)) + :timeout (dt/duration "3s")} + {:sync? true})] + (when-let [hint (webhooks/interpret-response response)] + (ex/raise :type :validation + :code :webhook-validation + :hint hint))) - (handle-response [response] - (when-let [hint (webhooks/interpret-response response)] - (ex/raise :type :validation - :code :webhook-validation - :hint hint)))] - - (if (not= (:uri whook) (:uri params)) - (->> (http/req! cfg {:method :head - :uri (str (:uri params)) - :timeout (dt/duration "3s")}) - (p/hmap (fn [response exception] - (if exception - (handle-exception exception) - (handle-response response))))) - (p/resolved nil)))) + (catch Throwable cause + (if-let [hint (webhooks/interpret-exception cause)] + (ex/raise :type :validation + :code :webhook-validation + :hint hint) + (ex/raise :type :internal + :code :webhook-validation + :cause cause)))))) (defn- validate-quotes! [{:keys [::db/pool]} {:keys [team-id]}] @@ -109,8 +105,8 @@ [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [::rpc/profile-id team-id] :as params}] (check-edition-permissions! pool profile-id team-id) (validate-quotes! cfg params) - (->> (validate-webhook! cfg nil params) - (p/fmap executor (fn [_] (insert-webhook! cfg params))))) + (validate-webhook! cfg nil params) + (insert-webhook! cfg params)) (s/def ::update-webhook (s/keys :req-un [::id ::uri ::mtype ::is-active])) @@ -120,8 +116,8 @@ [{:keys [::db/pool ::wrk/executor] :as cfg} {:keys [::rpc/profile-id id] :as params}] (let [whook (-> (db/get pool :webhook {:id id}) (decode-row))] (check-edition-permissions! pool profile-id (:team-id whook)) - (->> (validate-webhook! cfg whook params) - (p/fmap executor (fn [_] (update-webhook! cfg whook params)))))) + (validate-webhook! cfg whook params) + (update-webhook! cfg whook params))) (s/def ::delete-webhook (s/keys :req [::rpc/profile-id] diff --git a/backend/src/app/rpc/cond.clj b/backend/src/app/rpc/cond.clj index 58440ad4b..3cee44e3f 100644 --- a/backend/src/app/rpc/cond.clj +++ b/backend/src/app/rpc/cond.clj @@ -27,8 +27,6 @@ [app.common.logging :as l] [app.rpc.helpers :as rph] [app.util.services :as-alias sv] - [promesa.core :as p] - [promesa.exec :as px] [yetti.response :as yrs])) (def @@ -38,30 +36,24 @@ (defn- fmt-key [s] - (when s - (str "W/\"" s "\""))) + (str "W/\"" s "\"")) (defn wrap - [{:keys [executor]} f {:keys [::get-object ::key-fn ::reuse-key?] :as mdata}] + [_ f {:keys [::get-object ::key-fn ::reuse-key?] :as mdata}] (if (and (ifn? get-object) (ifn? key-fn)) (do (l/debug :hint "instrumenting method" :service (::sv/name mdata)) (fn [cfg {:keys [::key] :as params}] (if *enabled* - (->> (if (or key reuse-key?) - (->> (px/submit! executor (partial get-object cfg params)) - (p/map key-fn) - (p/map fmt-key)) - (p/resolved nil)) - (p/mapcat (fn [key'] - (if (and (some? key) - (= key key')) - (p/resolved (fn [_] (yrs/response 304))) - (->> (f cfg params) - (p/map (fn [result] - (->> (or (and reuse-key? key') - (-> result meta ::key fmt-key) - (-> result key-fn fmt-key)) - (rph/with-header result "etag"))))))))) + (let [key' (when (or key reuse-key?) + (some-> (get-object cfg params) key-fn fmt-key))] + (if (and (some? key) + (= key key')) + (fn [_] {::yrs/status 304}) + (let [result (f cfg params) + etag (or (and reuse-key? key') + (some-> result meta ::key fmt-key) + (some-> result key-fn fmt-key))] + (rph/with-header result "etag" etag)))) (f cfg params)))) f)) diff --git a/backend/src/app/rpc/doc.clj b/backend/src/app/rpc/doc.clj index 32889c9b7..2e10de4a3 100644 --- a/backend/src/app/rpc/doc.clj +++ b/backend/src/app/rpc/doc.clj @@ -30,32 +30,34 @@ (defn- prepare-context [methods] - (letfn [(gen-doc [type [name f]] - (let [mdata (meta f)] - {:type (d/name type) - :name (d/name name) - :module (-> (:ns mdata) (str/split ".") last) - :auth (:auth mdata true) - :webhook (::webhooks/event? mdata false) - :docs (::sv/docstring mdata) - :deprecated (::deprecated mdata) - :added (::added mdata) - :changes (some->> (::changes mdata) (partition-all 2) (map vec)) - :spec (get-spec-str (::sv/spec mdata))}))] + (letfn [(gen-doc [type [{:keys [::sv/name] :as mdata} _f]] + {:type (d/name type) + :name (d/name name) + :module (-> (:ns mdata) (str/split ".") last) + :auth (:auth mdata true) + :webhook (::webhooks/event? mdata false) + :docs (::sv/docstring mdata) + :deprecated (::deprecated mdata) + :added (::added mdata) + :changes (some->> (::changes mdata) (partition-all 2) (map vec)) + :spec (get-spec-str (::sv/spec mdata))})] {:version (:main cf/version) :command-methods (->> (:commands methods) + (map val) (map (partial gen-doc :command)) (sort-by (juxt :module :name))) :query-methods (->> (:queries methods) + (map val) (map (partial gen-doc :query)) (sort-by (juxt :module :name))) :mutation-methods (->> (:mutations methods) + (map val) (map (partial gen-doc :query)) (sort-by (juxt :module :name)))})) @@ -64,11 +66,11 @@ (if (contains? cf/flags :backend-api-doc) (let [context (prepare-context methods)] (fn [_ respond _] - (respond (yrs/response 200 (-> (io/resource "app/templates/api-doc.tmpl") - (tmpl/render context)))))) + (respond {::yrs/status 200 + ::yrs/body (-> (io/resource "app/templates/api-doc.tmpl") + (tmpl/render context))}))) (fn [_ respond _] - (respond (yrs/response 404))))) - + (respond {::yrs/status 404})))) (s/def ::routes vector?) diff --git a/backend/src/app/rpc/helpers.clj b/backend/src/app/rpc/helpers.clj index 1f4d7bbf9..69d1a2d71 100644 --- a/backend/src/app/rpc/helpers.clj +++ b/backend/src/app/rpc/helpers.clj @@ -10,7 +10,8 @@ (:require [app.common.data.macros :as dm] [app.http :as-alias http] - [app.rpc :as-alias rpc])) + [app.rpc :as-alias rpc] + [yetti.response :as-alias yrs])) ;; A utilty wrapper object for wrap service responses that does not ;; implements the IObj interface that make possible attach metadata to @@ -35,7 +36,9 @@ o (MetadataWrapper. o {}))) ([o m] - (MetadataWrapper. o m))) + (if (instance? clojure.lang.IObj o) + (vary-meta o merge m) + (MetadataWrapper. o m)))) (defn wrapped? [o] @@ -74,4 +77,4 @@ (fn [_ response] (let [exp (if (integer? max-age) max-age (inst-ms max-age)) val (dm/fmt "max-age=%" (int (/ exp 1000.0)))] - (update response :headers assoc "cache-control" val))))) + (update response ::yrs/headers assoc "cache-control" val))))) diff --git a/backend/src/app/rpc/mutations/profile.clj b/backend/src/app/rpc/mutations/profile.clj index 406e029cb..424c93536 100644 --- a/backend/src/app/rpc/mutations/profile.clj +++ b/backend/src/app/rpc/mutations/profile.clj @@ -14,7 +14,6 @@ [app.http.session :as session] [app.loggers.audit :as audit] [app.media :as media] - [app.rpc.climit :as-alias climit] [app.rpc.commands.profile :as profile] [app.rpc.doc :as-alias doc] [app.rpc.helpers :as rph] @@ -78,20 +77,20 @@ (s/keys :req-un [::profile-id ::password ::old-password])) (sv/defmethod ::update-profile-password - {::climit/queue :auth - ::doc/added "1.0" + {::doc/added "1.0" ::doc/deprecated "1.18"} [{:keys [::db/pool] :as cfg} {:keys [password] :as params}] (db/with-atomic [conn pool] - (let [profile (#'profile/validate-password! conn params) + (let [cfg (assoc cfg ::db/conn conn) + profile (#'profile/validate-password! cfg params) session-id (::session/id params)] (when (= (str/lower (:email profile)) (str/lower (:password params))) (ex/raise :type :validation :code :email-as-password :hint "you can't use your email as password")) - (profile/update-profile-password! conn (assoc profile :password password)) - (#'profile/invalidate-profile-session! conn (:id profile) session-id) + (profile/update-profile-password! cfg (assoc profile :password password)) + (#'profile/invalidate-profile-session! cfg (:id profile) session-id) nil))) diff --git a/backend/src/app/rpc/retry.clj b/backend/src/app/rpc/retry.clj index 450ab4e9c..f0dab0f67 100644 --- a/backend/src/app/rpc/retry.clj +++ b/backend/src/app/rpc/retry.clj @@ -10,8 +10,7 @@ (:require [app.common.logging :as l] [app.util.retry :refer [conflict-exception?]] - [app.util.services :as sv] - [promesa.core :as p])) + [app.util.services :as sv])) (defn conflict-db-insert? "Check if exception matches a insertion conflict on postgresql." @@ -28,18 +27,16 @@ (if-let [max-retries (::max-retries mdata)] (fn [cfg params] - (letfn [(run [retry] - (->> (f cfg params) - (p/merr (partial handle-error retry)))) - - (handle-error [retry cause] - (if (matches cause) - (let [current-retry (inc retry)] - (l/trace :hint "running retry algorithm" :retry current-retry) - (if (<= current-retry max-retries) - (run current-retry) - (throw cause))) - (throw cause)))] - (run 1))) + ((fn run [retry] + (try + (f cfg params) + (catch Throwable cause + (if (matches cause) + (let [current-retry (inc retry)] + (l/trace :hint "running retry algorithm" :retry current-retry) + (if (<= current-retry max-retries) + (run current-retry) + (throw cause))) + (throw cause))))) 1)) f)) diff --git a/backend/src/app/rpc/rlimit.clj b/backend/src/app/rpc/rlimit.clj index 4966cf979..eb48482bb 100644 --- a/backend/src/app/rpc/rlimit.clj +++ b/backend/src/app/rpc/rlimit.clj @@ -55,6 +55,7 @@ [app.redis :as rds] [app.redis.script :as-alias rscript] [app.rpc :as-alias rpc] + [app.rpc.helpers :as rph] [app.rpc.rlimit.result :as-alias lresult] [app.util.services :as-alias sv] [app.util.time :as dt] @@ -64,7 +65,6 @@ [cuerdas.core :as str] [datoteka.fs :as fs] [integrant.core :as ig] - [promesa.core :as p] [promesa.exec :as px])) (def ^:private default-timeout @@ -82,7 +82,7 @@ {::rscript/name ::window-rate-limit ::rscript/path "app/rpc/rlimit/window.lua"}) -(def enabled? +(def enabled "Allows on runtime completely disable rate limiting." (atom true)) @@ -119,116 +119,97 @@ (defmethod parse-limit :bucket [[name strategy opts :as vlimit]] (us/assert! ::limit-tuple vlimit) - (merge - {::name name - ::strategy strategy} - (if-let [[_ capacity rate interval] (re-find bucket-opts-re opts)] - (let [interval (dt/duration interval) - rate (parse-long rate) - capacity (parse-long capacity)] - {::capacity capacity - ::rate rate - ::interval interval - ::opts opts - ::params [(dt/->seconds interval) rate capacity] - ::key (str "ratelimit.bucket." (d/name name))}) - (ex/raise :type :validation - :code :invalid-bucket-limit-opts - :hint (str/ffmt "looks like '%' does not have a valid format" opts))))) + (if-let [[_ capacity rate interval] (re-find bucket-opts-re opts)] + (let [interval (dt/duration interval) + rate (parse-long rate) + capacity (parse-long capacity)] + {::name name + ::strategy strategy + ::capacity capacity + ::rate rate + ::interval interval + ::opts opts + ::params [(dt/->seconds interval) rate capacity] + ::key (str "ratelimit.bucket." (d/name name))}) + (ex/raise :type :validation + :code :invalid-bucket-limit-opts + :hint (str/ffmt "looks like '%' does not have a valid format" opts)))) (defmethod process-limit :bucket [redis user-id now {:keys [::key ::params ::service ::capacity ::interval ::rate] :as limit}] - (let [script (-> bucket-rate-limit-script - (assoc ::rscript/keys [(str key "." service "." user-id)]) - (assoc ::rscript/vals (conj params (dt/->seconds now))))] - (->> (rds/eval! redis script) - (p/fmap (fn [result] - (let [allowed? (boolean (nth result 0)) - remaining (nth result 1) - reset (* (/ (inst-ms interval) rate) - (- capacity remaining))] - (l/trace :hint "limit processed" - :service service - :limit (name (::name limit)) - :strategy (name (::strategy limit)) - :opts (::opts limit) - :allowed? allowed? - :remaining remaining) - (-> limit - (assoc ::lresult/allowed? allowed?) - (assoc ::lresult/reset (dt/plus now reset)) - (assoc ::lresult/remaining remaining)))))))) + (let [script (-> bucket-rate-limit-script + (assoc ::rscript/keys [(str key "." service "." user-id)]) + (assoc ::rscript/vals (conj params (dt/->seconds now)))) + result (rds/eval! redis script) + allowed? (boolean (nth result 0)) + remaining (nth result 1) + reset (* (/ (inst-ms interval) rate) + (- capacity remaining))] + (l/trace :hint "limit processed" + :service service + :limit (name (::name limit)) + :strategy (name (::strategy limit)) + :opts (::opts limit) + :allowed allowed? + :remaining remaining) + (-> limit + (assoc ::lresult/allowed allowed?) + (assoc ::lresult/reset (dt/plus now reset)) + (assoc ::lresult/remaining remaining)))) (defmethod process-limit :window [redis user-id now {:keys [::nreq ::unit ::key ::service] :as limit}] - (let [ts (dt/truncate now unit) - ttl (dt/diff now (dt/plus ts {unit 1})) - script (-> window-rate-limit-script - (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))]) - (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))] - (->> (rds/eval! redis script) - (p/fmap (fn [result] - (let [allowed? (boolean (nth result 0)) - remaining (nth result 1)] - (l/trace :hint "limit processed" - :service service - :limit (name (::name limit)) - :strategy (name (::strategy limit)) - :opts (::opts limit) - :allowed? allowed? - :remaining remaining) - (-> limit - (assoc ::lresult/allowed? allowed?) - (assoc ::lresult/remaining remaining) - (assoc ::lresult/reset (dt/plus ts {unit 1}))))))))) + (let [ts (dt/truncate now unit) + ttl (dt/diff now (dt/plus ts {unit 1})) + script (-> window-rate-limit-script + (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))]) + (assoc ::rscript/vals [nreq (dt/->seconds ttl)])) + result (rds/eval! redis script) + allowed? (boolean (nth result 0)) + remaining (nth result 1)] + (l/trace :hint "limit processed" + :service service + :limit (name (::name limit)) + :strategy (name (::strategy limit)) + :opts (::opts limit) + :allowed allowed? + :remaining remaining) + (-> limit + (assoc ::lresult/allowed allowed?) + (assoc ::lresult/remaining remaining) + (assoc ::lresult/reset (dt/plus ts {unit 1}))))) (defn- process-limits! [redis user-id limits now] - (->> (p/all (map (partial process-limit redis user-id now) limits)) - (p/fmap (fn [results] - (let [remaining (->> results - (d/index-by ::name ::lresult/remaining) - (uri/map->query-string)) - reset (->> results - (d/index-by ::name (comp dt/->seconds ::lresult/reset)) - (uri/map->query-string)) - rejected (->> results - (filter (complement ::lresult/allowed?)) - (first))] + (let [results (into [] (map (partial process-limit redis user-id now)) limits) + remaining (->> results + (d/index-by ::name ::lresult/remaining) + (uri/map->query-string)) + reset (->> results + (d/index-by ::name (comp dt/->seconds ::lresult/reset)) + (uri/map->query-string)) - (when rejected - (l/warn :hint "rejected rate limit" - :user-id (str user-id) - :limit-service (-> rejected ::service name) - :limit-name (-> rejected ::name name) - :limit-strategy (-> rejected ::strategy name))) + rejected (d/seek (complement ::lresult/allowed) results)] - {:enabled? true - :allowed? (not (some? rejected)) - :headers {"x-rate-limit-remaining" remaining - "x-rate-limit-reset" reset}}))))) + (when rejected + (l/warn :hint "rejected rate limit" + :user-id (str user-id) + :limit-service (-> rejected ::service name) + :limit-name (-> rejected ::name name) + :limit-strategy (-> rejected ::strategy name))) -(defn- handle-response - [f cfg params result] - (if (:enabled? result) - (let [headers (:headers result)] - (if (:allowed? result) - (->> (f cfg params) - (p/fmap (fn [response] - (vary-meta response update ::http/headers merge headers)))) - (p/rejected - (ex/error :type :rate-limit - :code :request-blocked - :hint "rate limit reached" - ::http/headers headers)))) - (f cfg params))) + {::enabled true + ::allowed (not (some? rejected)) + ::remaingin remaining + ::reset reset + ::headers {"x-rate-limit-remaining" remaining + "x-rate-limit-reset" reset}})) (defn- get-limits [state skey sname] - (some->> (or (get-in @state [::limits skey]) - (get-in @state [::limits :default])) - (map #(assoc % ::service sname)) - (seq))) + (when-let [limits (or (get-in @state [::limits skey]) + (get-in @state [::limits :default]))] + (into [] (map #(assoc % ::service sname)) limits))) (defn- get-uid [{:keys [::http/request] :as params}] @@ -236,6 +217,31 @@ (some-> request parse-client-ip) uuid/zero)) +(defn process-request! + [{:keys [::rpc/rlimit ::rds/redis ::skey ::sname] :as cfg} params] + (when-let [limits (get-limits rlimit skey sname)] + (let [redis (rds/get-or-connect redis ::rpc/rlimit default-options) + uid (get-uid params) + ;; FIXME: why not clasic try/catch? + result (ex/try! (process-limits! redis uid limits (dt/now)))] + + (l/trc :hint "process-limits" + :service sname + :remaining (::remaingin result) + :reset (::reset result)) + + (cond + (ex/exception? result) + (do + (l/error :hint "error on processing rate-limit" :cause result) + {::enabled false}) + + (contains? cf/flags :soft-rpc-rlimit) + {::enabled false} + + :else + result)))) + (defn wrap [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata] (us/assert! ::rpc/rlimit rlimit) @@ -243,36 +249,25 @@ (if rlimit (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)) + cfg (-> cfg + (assoc ::skey skey) + (assoc ::sname sname))] - (fn [cfg params] - (if @enabled? - (try - (let [uid (get-uid params) - rsp (when-let [limits (get-limits rlimit skey sname)] - (let [redis (rds/get-or-connect redis ::rpc/rlimit default-options) - rsp (->> (process-limits! redis uid limits (dt/now)) - (p/merr (fn [cause] - ;; If we have an error on processing the rate-limit we just skip - ;; it for do not cause service interruption because of redis - ;; downtime or similar situation. - (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 - ;; response. - (if (contains? cf/flags :soft-rpc-rlimit) - {:enabled? false} - rsp)))] - - (->> (p/promise rsp) - (p/fmap #(or % {:enabled? false})) - (p/mcat #(handle-response f cfg params %)))) - - (catch Throwable cause - (p/rejected cause))) - - (f cfg params)))) + (fn [hcfg params] + (if @enabled + (let [result (process-request! cfg params)] + (if (::enabled result) + (if (::allowed result) + (-> (f hcfg params) + (rph/wrap) + (vary-meta update ::http/headers merge (::headers result))) + (ex/raise :type :rate-limit + :code :request-blocked + :hint "rate limit reached" + ::http/headers (::headers result))) + (f hcfg params))) + (f hcfg params)))) f)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/backend/src/app/util/services.clj b/backend/src/app/util/services.clj index 66f9fc8db..b7d2159ea 100644 --- a/backend/src/app/util/services.clj +++ b/backend/src/app/util/services.clj @@ -45,9 +45,9 @@ (map second) (filter #(::spec (meta %))) (map (fn [fvar] - (with-meta (deref fvar) - (-> (meta fvar) - (assoc :ns (-> ns ns-name str))))))))))) + [(deref fvar) + (-> (meta fvar) + (assoc :ns (-> ns ns-name str)))]))))))) (defn scan-ns [& nsyms] diff --git a/backend/src/app/util/svg.clj b/backend/src/app/util/svg.clj index 2c189ce13..5647b1662 100644 --- a/backend/src/app/util/svg.clj +++ b/backend/src/app/util/svg.clj @@ -6,27 +6,30 @@ (ns app.util.svg (:require + [app.common.data.macros :as dm] [app.common.exceptions :as ex] [app.common.logging :as l] [clojure.xml :as xml] [cuerdas.core :as str]) (:import javax.xml.XMLConstants + java.io.InputStream javax.xml.parsers.SAXParserFactory + clojure.lang.XMLHandler org.apache.commons.io.IOUtils)) (defn- secure-parser-factory - [s ch] + [^InputStream input ^XMLHandler handler] (.. (doto (SAXParserFactory/newInstance) (.setFeature XMLConstants/FEATURE_SECURE_PROCESSING true) (.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true)) (newSAXParser) - (parse s ch))) + (parse input handler))) (defn parse - [data] + [^String data] (try - (with-open [istream (IOUtils/toInputStream data "UTF-8")] + (dm/with-open [istream (IOUtils/toInputStream data "UTF-8")] (xml/parse istream secure-parser-factory)) (catch Exception e (l/warn :hint "error on processing svg" diff --git a/backend/src/app/worker.clj b/backend/src/app/worker.clj index 337136cea..e11c68d2a 100644 --- a/backend/src/app/worker.clj +++ b/backend/src/app/worker.clj @@ -46,10 +46,18 @@ [skey {:keys [::parallelism]}] (let [prefix (if (vector? skey) (-> skey first name) "default") tname (str "penpot/" prefix "/%s") - factory (px/forkjoin-thread-factory :name tname)] - (px/forkjoin-executor {:factory factory - :parallelism parallelism - :async true}))) + ttype (cf/get :worker-executor-type :fjoin)] + (case ttype + :fjoin + (let [factory (px/forkjoin-thread-factory :name tname)] + (px/forkjoin-executor {:factory factory + :core-size (px/get-available-processors) + :parallelism parallelism + :async true})) + + :cached + (let [factory (px/thread-factory :name tname)] + (px/cached-executor :factory factory))))) (defmethod ig/halt-key! ::executor [_ instance] @@ -246,11 +254,7 @@ (if (db/read-only? pool) (l/warn :hint "dispatcher: not started (db is read-only)") - - ;; FIXME: we don't use virtual threads here until JDBC is uptaded to >= 42.6.0 - ;; bacause it has the necessary fixes fro make the JDBC driver properly compatible - ;; with Virtual Threads. - (px/fn->thread dispatcher :name "penpot/worker/dispatcher" :virtual false)))) + (px/fn->thread dispatcher :name "penpot/worker/dispatcher" :virtual true)))) (defmethod ig/halt-key! ::dispatcher [_ thread] @@ -446,7 +450,8 @@ (case status :retry (handle-task-retry result) :failed (handle-task-failure result) - :completed (handle-task-completion result)))) + :completed (handle-task-completion result) + nil))) (run-task-loop [task-id] (loop [result (run-task task-id)] diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index cdc933651..51ab55e3b 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -138,9 +138,7 @@ :app.http.oauth/handler :app.notifications/handler :app.loggers.mattermost/reporter - :app.loggers.loki/reporter :app.loggers.database/reporter - :app.loggers.zmq/receiver :app.worker/cron :app.worker/worker)) _ (ig/load-namespaces system) @@ -164,11 +162,15 @@ " AND table_name != 'migrations';")] (db/with-atomic [conn *pool*] (let [result (->> (db/exec! conn [sql]) - (map :table-name))] - (db/exec! conn [(str "TRUNCATE " - (apply str (interpose ", " result)) - " CASCADE;")])))) - (next)) + (map :table-name) + (remove #(= "task" %))) + sql (str "TRUNCATE " + (apply str (interpose ", " result)) + " CASCADE;")] + (doseq [table result] + (db/exec! conn [(str "delete from " table ";")])))) + + (next))) (defn clean-storage [next] @@ -321,7 +323,7 @@ (with-open [conn (db/open pool)] (let [features #{"components/v2"} cfg (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics]) - (assoc :conn conn))] + (assoc ::db/conn conn))] (files.update/update-file cfg {:id file-id :revn revn @@ -354,7 +356,7 @@ (defmacro try-on! [expr] `(try - (let [result# (deref ~expr) + (let [result# ~expr result# (cond-> result# (rph/wrapped? result#) deref)] {:error nil :result result#}) @@ -364,7 +366,7 @@ (defn command! [{:keys [::type] :as data}] - (let [method-fn (get-in *system* [:app.rpc/methods :commands type])] + (let [[mdata method-fn] (get-in *system* [:app.rpc/methods :commands type])] (when-not method-fn (ex/raise :type :assertion :code :rpc-method-not-found @@ -377,7 +379,7 @@ (defn mutation! [{:keys [::type profile-id] :as data}] - (let [method-fn (get-in *system* [:app.rpc/methods :mutations type])] + (let [[mdata method-fn] (get-in *system* [:app.rpc/methods :mutations type])] (try-on! (method-fn (-> data (dissoc ::type) (assoc ::rpc/profile-id profile-id) @@ -385,7 +387,7 @@ (defn query! [{:keys [::type profile-id] :as data}] - (let [method-fn (get-in *system* [:app.rpc/methods :queries type])] + (let [[mdata method-fn] (get-in *system* [:app.rpc/methods :queries type])] (try-on! (method-fn (-> data (dissoc ::type) (assoc ::rpc/profile-id profile-id) diff --git a/backend/test/backend_tests/rpc_cond_middleware_test.clj b/backend/test/backend_tests/rpc_cond_middleware_test.clj index 58978e3bc..dfbee87d8 100644 --- a/backend/test/backend_tests/rpc_cond_middleware_test.clj +++ b/backend/test/backend_tests/rpc_cond_middleware_test.clj @@ -40,6 +40,6 @@ {:keys [error result]} (th/command! (assoc params ::cond/key etag))] (t/is (nil? error)) (t/is (fn? result)) - (t/is (= 304 (-> (result nil) :status)))) + (t/is (= 304 (-> (result nil) :yetti.response/status)))) )))) diff --git a/backend/test/backend_tests/rpc_team_test.clj b/backend/test/backend_tests/rpc_team_test.clj index 3d304ab89..b19dd76a2 100644 --- a/backend/test/backend_tests/rpc_team_test.clj +++ b/backend/test/backend_tests/rpc_team_test.clj @@ -6,6 +6,7 @@ (ns backend-tests.rpc-team-test (:require + [app.common.logging :as l] [app.common.uuid :as uuid] [app.db :as db] [app.http :as http] diff --git a/common/src/app/common/logging.cljc b/common/src/app/common/logging.cljc index dd5706455..cc67daf1d 100644 --- a/common/src/app/common/logging.cljc +++ b/common/src/app/common/logging.cljc @@ -213,26 +213,28 @@ `(when (enabled? ~logger ~level) (let [props# (cond-> (delay ~props) ~sync? deref) ts# (current-timestamp) - context# *context*] - (px/run! *default-executor* - (fn [] - (let [props# (if ~sync? props# (deref props#)) - props# (into (d/ordered-map) props#) - cause# ~cause - context# (d/without-nils - (merge context# ~context)) - lrecord# {::id (uuid/next) - ::timestamp ts# - ::message (delay (build-message props#)) - ::props props# - ::context context# - ::level ~level - ::logger ~logger} - lrecord# (cond-> lrecord# - (some? cause#) - (assoc ::cause cause# - ::trace (delay (build-stack-trace cause#))))] - (swap! log-record (constantly lrecord#))))))))) + context# *context* + logfn# (fn [] + (let [props# (if ~sync? props# (deref props#)) + props# (into (d/ordered-map) props#) + cause# ~cause + context# (d/without-nils + (merge context# ~context)) + lrecord# {::id (uuid/next) + ::timestamp ts# + ::message (delay (build-message props#)) + ::props props# + ::context context# + ::level ~level + ::logger ~logger} + lrecord# (cond-> lrecord# + (some? cause#) + (assoc ::cause cause# + ::trace (delay (build-stack-trace cause#))))] + (swap! log-record (constantly lrecord#))))] + (if ~sync? + (logfn#) + (px/exec! *default-executor* logfn#)))))) #?(:clj (defn slf4j-log-handler diff --git a/frontend/src/app/main/repo.cljs b/frontend/src/app/main/repo.cljs index 320f5a682..3a68825c7 100644 --- a/frontend/src/app/main/repo.cljs +++ b/frontend/src/app/main/repo.cljs @@ -21,6 +21,7 @@ (derive :get-font-variants ::query) (derive :get-profile ::query) (derive :get-project ::query) +(derive :get-projects ::query) (derive :get-team-invitations ::query) (derive :get-team-members ::query) (derive :get-team-shared-files ::query) @@ -29,6 +30,9 @@ (derive :get-teams ::query) (derive :get-view-only-bundle ::query) (derive :search-files ::query) +(derive :retrieve-list-of-builtin-templates ::query) +(derive :get-unread-comment-threads ::query) +(derive :get-team-recent-files ::query) (defn handle-response [{:keys [status body] :as response}] diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs index 87fa4a050..e2c80b107 100644 --- a/frontend/src/app/main/store.cljs +++ b/frontend/src/app/main/store.cljs @@ -46,9 +46,10 @@ (defonce state (ptk/store {:resolve ptk/resolve :on-event on-event - :on-error (fn [e] - (.log js/console "ERROR!!" e) - (@on-error e))})) + :on-error (fn [cause] + (when cause + (log/error :hint "unexpected exception on store" :cause cause) + (@on-error cause)))})) (defonce stream (ptk/input-stream state)) diff --git a/frontend/src/app/main/ui/auth/login.cljs b/frontend/src/app/main/ui/auth/login.cljs index 583520c5f..18a6405bf 100644 --- a/frontend/src/app/main/ui/auth/login.cljs +++ b/frontend/src/app/main/ui/auth/login.cljs @@ -7,6 +7,7 @@ (ns app.main.ui.auth.login (:require [app.common.data :as d] + [app.common.logging :as log] [app.common.spec :as us] [app.config :as cf] [app.main.data.messages :as dm] @@ -38,7 +39,10 @@ (dom/prevent-default event) (->> (rp/command! :login-with-oidc (assoc params :provider provider)) (rx/subs (fn [{:keys [redirect-uri] :as rsp}] - (.replace js/location redirect-uri)) + (if redirect-uri + (.replace js/location redirect-uri) + (log/error :hint "unexpected response from OIDC method" + :resp (pr-str rsp)))) (fn [{:keys [type code] :as error}] (cond (and (= type :restriction)