mirror of
https://github.com/penpot/penpot.git
synced 2025-03-14 16:51:18 -05:00
♻️ Refactor general resource and concurrency model on backend
This commit is contained in:
parent
d24f16563f
commit
7cf27ac86d
32 changed files with 917 additions and 797 deletions
|
@ -41,9 +41,7 @@
|
|||
data))
|
||||
|
||||
(def defaults
|
||||
{:http-server-port 6060
|
||||
:http-server-host "0.0.0.0"
|
||||
:host "devenv"
|
||||
{:host "devenv"
|
||||
:tenant "dev"
|
||||
:database-uri "postgresql://postgres/penpot"
|
||||
:database-username "penpot"
|
||||
|
@ -106,6 +104,10 @@
|
|||
(s/def ::file-change-snapshot-every ::us/integer)
|
||||
(s/def ::file-change-snapshot-timeout ::dt/duration)
|
||||
|
||||
(s/def ::default-executor-parallelism ::us/integer)
|
||||
(s/def ::blocking-executor-parallelism ::us/integer)
|
||||
(s/def ::worker-executor-parallelism ::us/integer)
|
||||
|
||||
(s/def ::secret-key ::us/string)
|
||||
(s/def ::allow-demo-users ::us/boolean)
|
||||
(s/def ::assets-path ::us/string)
|
||||
|
@ -114,6 +116,9 @@
|
|||
(s/def ::database-uri ::us/string)
|
||||
(s/def ::database-username (s/nilable ::us/string))
|
||||
(s/def ::database-readonly ::us/boolean)
|
||||
(s/def ::database-min-pool-size ::us/integer)
|
||||
(s/def ::database-max-pool-size ::us/integer)
|
||||
|
||||
(s/def ::default-blob-version ::us/integer)
|
||||
(s/def ::error-report-webhook ::us/string)
|
||||
(s/def ::user-feedback-destination ::us/string)
|
||||
|
@ -136,6 +141,8 @@
|
|||
(s/def ::host ::us/string)
|
||||
(s/def ::http-server-port ::us/integer)
|
||||
(s/def ::http-server-host ::us/string)
|
||||
(s/def ::http-server-min-threads ::us/integer)
|
||||
(s/def ::http-server-max-threads ::us/integer)
|
||||
(s/def ::http-session-idle-max-age ::dt/duration)
|
||||
(s/def ::http-session-updater-batch-max-age ::dt/duration)
|
||||
(s/def ::http-session-updater-batch-max-size ::us/integer)
|
||||
|
@ -207,8 +214,13 @@
|
|||
::database-uri
|
||||
::database-username
|
||||
::database-readonly
|
||||
::database-min-pool-size
|
||||
::database-max-pool-size
|
||||
::default-blob-version
|
||||
::error-report-webhook
|
||||
::default-executor-parallelism
|
||||
::blocking-executor-parallelism
|
||||
::worker-executor-parallelism
|
||||
::file-change-snapshot-every
|
||||
::file-change-snapshot-timeout
|
||||
::user-feedback-destination
|
||||
|
@ -231,6 +243,8 @@
|
|||
::host
|
||||
::http-server-host
|
||||
::http-server-port
|
||||
::http-server-max-threads
|
||||
::http-server-min-threads
|
||||
::http-session-idle-max-age
|
||||
::http-session-updater-batch-max-age
|
||||
::http-session-updater-batch-max-size
|
||||
|
|
|
@ -47,13 +47,12 @@
|
|||
;; Initialization
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare instrument-jdbc!)
|
||||
(declare apply-migrations!)
|
||||
|
||||
(s/def ::connection-timeout ::us/integer)
|
||||
(s/def ::max-pool-size ::us/integer)
|
||||
(s/def ::max-size ::us/integer)
|
||||
(s/def ::min-size ::us/integer)
|
||||
(s/def ::migrations map?)
|
||||
(s/def ::min-pool-size ::us/integer)
|
||||
(s/def ::name keyword?)
|
||||
(s/def ::password ::us/string)
|
||||
(s/def ::read-only ::us/boolean)
|
||||
|
@ -62,19 +61,39 @@
|
|||
(s/def ::validation-timeout ::us/integer)
|
||||
|
||||
(defmethod ig/pre-init-spec ::pool [_]
|
||||
(s/keys :req-un [::uri ::name ::username ::password]
|
||||
:opt-un [::min-pool-size
|
||||
::max-pool-size
|
||||
(s/keys :req-un [::uri ::name
|
||||
::min-size
|
||||
::max-size
|
||||
::connection-timeout
|
||||
::validation-timeout
|
||||
::migrations
|
||||
::validation-timeout]
|
||||
:opt-un [::migrations
|
||||
::username
|
||||
::password
|
||||
::mtx/metrics
|
||||
::read-only]))
|
||||
|
||||
(defmethod ig/prep-key ::pool
|
||||
[_ cfg]
|
||||
(merge {:name :main
|
||||
:min-size 0
|
||||
:max-size 30
|
||||
:connection-timeout 10000
|
||||
:validation-timeout 10000
|
||||
:idle-timeout 120000 ; 2min
|
||||
:max-lifetime 1800000 ; 30m
|
||||
:read-only false}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::pool
|
||||
[_ {:keys [migrations metrics name read-only] :as cfg}]
|
||||
(l/info :action "initialize connection pool" :name (d/name name) :uri (:uri cfg))
|
||||
(some-> metrics :registry instrument-jdbc!)
|
||||
[_ {:keys [migrations name read-only] :as cfg}]
|
||||
(l/info :hint "initialize connection pool"
|
||||
:name (d/name name)
|
||||
:uri (:uri cfg)
|
||||
:read-only read-only
|
||||
:with-credentials (and (contains? cfg :username)
|
||||
(contains? cfg :password))
|
||||
:min-size (:min-size cfg)
|
||||
:max-size (:max-size cfg))
|
||||
|
||||
(let [pool (create-pool cfg)]
|
||||
(when-not read-only
|
||||
|
@ -85,16 +104,6 @@
|
|||
[_ pool]
|
||||
(.close ^HikariDataSource pool))
|
||||
|
||||
(defn- instrument-jdbc!
|
||||
[registry]
|
||||
(mtx/instrument-vars!
|
||||
[#'next.jdbc/execute-one!
|
||||
#'next.jdbc/execute!]
|
||||
{:registry registry
|
||||
:type :counter
|
||||
:name "database_query_total"
|
||||
:help "An absolute counter of database queries."}))
|
||||
|
||||
(defn- apply-migrations!
|
||||
[pool migrations]
|
||||
(with-open [conn ^AutoCloseable (open pool)]
|
||||
|
@ -111,22 +120,19 @@
|
|||
"SET idle_in_transaction_session_timeout = 300000;"))
|
||||
|
||||
(defn- create-datasource-config
|
||||
[{:keys [metrics read-only] :or {read-only false} :as cfg}]
|
||||
(let [dburi (:uri cfg)
|
||||
username (:username cfg)
|
||||
password (:password cfg)
|
||||
config (HikariConfig.)]
|
||||
[{:keys [metrics uri] :as cfg}]
|
||||
(let [config (HikariConfig.)]
|
||||
(doto config
|
||||
(.setJdbcUrl (str "jdbc:" dburi))
|
||||
(.setJdbcUrl (str "jdbc:" uri))
|
||||
(.setPoolName (d/name (:name cfg)))
|
||||
(.setAutoCommit true)
|
||||
(.setReadOnly read-only)
|
||||
(.setConnectionTimeout (:connection-timeout cfg 10000)) ;; 10seg
|
||||
(.setValidationTimeout (:validation-timeout cfg 10000)) ;; 10seg
|
||||
(.setIdleTimeout 120000) ;; 2min
|
||||
(.setMaxLifetime 1800000) ;; 30min
|
||||
(.setMinimumIdle (:min-pool-size cfg 0))
|
||||
(.setMaximumPoolSize (:max-pool-size cfg 50))
|
||||
(.setReadOnly (:read-only cfg))
|
||||
(.setConnectionTimeout (:connection-timeout cfg))
|
||||
(.setValidationTimeout (:validation-timeout cfg))
|
||||
(.setIdleTimeout (:idle-timeout cfg))
|
||||
(.setMaxLifetime (:max-lifetime cfg))
|
||||
(.setMinimumIdle (:min-size cfg))
|
||||
(.setMaximumPoolSize (:max-size cfg))
|
||||
(.setConnectionInitSql initsql)
|
||||
(.setInitializationFailTimeout -1))
|
||||
|
||||
|
@ -136,8 +142,8 @@
|
|||
(PrometheusMetricsTrackerFactory.)
|
||||
(.setMetricsTrackerFactory config)))
|
||||
|
||||
(when username (.setUsername config username))
|
||||
(when password (.setPassword config password))
|
||||
(some->> ^String (:username cfg) (.setUsername config))
|
||||
(some->> ^String (:password cfg) (.setPassword config))
|
||||
|
||||
config))
|
||||
|
||||
|
|
|
@ -10,6 +10,7 @@
|
|||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.config :as cf]
|
||||
[app.http.doc :as doc]
|
||||
[app.http.errors :as errors]
|
||||
[app.http.middleware :as middleware]
|
||||
|
@ -24,19 +25,30 @@
|
|||
|
||||
(declare wrap-router)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HTTP SERVER
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(s/def ::handler fn?)
|
||||
(s/def ::router some?)
|
||||
(s/def ::port ::us/integer)
|
||||
(s/def ::host ::us/string)
|
||||
(s/def ::name ::us/string)
|
||||
|
||||
(defmethod ig/pre-init-spec ::server [_]
|
||||
(s/keys :req-un [::port]
|
||||
:opt-un [::name ::mtx/metrics ::router ::handler ::host]))
|
||||
(s/def ::max-threads ::cf/http-server-max-threads)
|
||||
(s/def ::min-threads ::cf/http-server-min-threads)
|
||||
|
||||
(defmethod ig/prep-key ::server
|
||||
[_ cfg]
|
||||
(merge {:name "http"} (d/without-nils cfg)))
|
||||
(merge {:name "http"
|
||||
:min-threads 4
|
||||
:max-threads 60
|
||||
:port 6060
|
||||
:host "0.0.0.0"}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/pre-init-spec ::server [_]
|
||||
(s/keys :req-un [::port ::host ::name ::min-threads ::max-threads]
|
||||
:opt-un [::mtx/metrics ::router ::handler]))
|
||||
|
||||
(defn- instrument-metrics
|
||||
[^Server server metrics]
|
||||
|
@ -48,15 +60,22 @@
|
|||
|
||||
(defmethod ig/init-key ::server
|
||||
[_ {:keys [handler router port name metrics host] :as opts}]
|
||||
(l/info :msg "starting http server" :port port :host host :name name)
|
||||
(let [options {:http/port port :http/host host}
|
||||
(l/info :hint "starting http server"
|
||||
:port port :host host :name name
|
||||
:min-threads (:min-threads opts)
|
||||
:max-threads (:max-threads opts))
|
||||
(let [options {:http/port port
|
||||
:http/host host
|
||||
:thread-pool/max-threads (:max-threads opts)
|
||||
:thread-pool/min-threads (:min-threads opts)
|
||||
:ring/async true}
|
||||
handler (cond
|
||||
(fn? handler) handler
|
||||
(some? router) (wrap-router router)
|
||||
:else (ex/raise :type :internal
|
||||
:code :invalid-argument
|
||||
:hint "Missing `handler` or `router` option."))
|
||||
server (-> (yt/server handler options)
|
||||
server (-> (yt/server handler (d/without-nils options))
|
||||
(cond-> metrics (instrument-metrics metrics)))]
|
||||
(assoc opts :server (yt/start! server))))
|
||||
|
||||
|
@ -70,20 +89,20 @@
|
|||
(let [default (rr/routes
|
||||
(rr/create-resource-handler {:path "/"})
|
||||
(rr/create-default-handler))
|
||||
options {:middleware [middleware/server-timing]}
|
||||
options {:middleware [middleware/wrap-server-timing]
|
||||
:inject-match? false
|
||||
:inject-router? false}
|
||||
handler (rr/ring-handler router default options)]
|
||||
(fn [request]
|
||||
(try
|
||||
(handler request)
|
||||
(catch Throwable e
|
||||
(fn [request respond _]
|
||||
(handler request respond (fn [cause]
|
||||
(l/error :hint "unexpected error processing request"
|
||||
::l/context (errors/get-error-context request e)
|
||||
::l/context (errors/get-error-context request cause)
|
||||
:query-string (:query-string request)
|
||||
:cause e)
|
||||
{:status 500 :body "internal server error"})))))
|
||||
:cause cause)
|
||||
(respond {:status 500 :body "internal server error"}))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Http Router
|
||||
;; HTTP ROUTER
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(s/def ::rpc map?)
|
||||
|
@ -145,7 +164,6 @@
|
|||
[middleware/multipart-params]
|
||||
[middleware/keyword-params]
|
||||
[middleware/format-response-body]
|
||||
[middleware/etag]
|
||||
[middleware/parse-request-body]
|
||||
[middleware/errors errors/handle]
|
||||
[middleware/cookies]]}
|
||||
|
|
|
@ -13,9 +13,12 @@
|
|||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.storage :as sto]
|
||||
[app.util.async :as async]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
[integrant.core :as ig]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def ^:private cache-max-age
|
||||
(dt/duration {:hours 24}))
|
||||
|
@ -69,29 +72,38 @@
|
|||
:body ""}))))
|
||||
|
||||
(defn- generic-handler
|
||||
[{:keys [storage] :as cfg} _request id]
|
||||
(let [obj (sto/get-object storage id)]
|
||||
[{:keys [storage executor] :as cfg} request kf]
|
||||
(async/with-dispatch executor
|
||||
(let [id (get-in request [:path-params :id])
|
||||
mobj (get-file-media-object storage id)
|
||||
obj (sto/get-object storage (kf mobj))]
|
||||
(if obj
|
||||
(serve-object cfg obj)
|
||||
{:status 404 :body ""}))))
|
||||
|
||||
(defn objects-handler
|
||||
[{:keys [storage executor] :as cfg} request respond raise]
|
||||
(-> (async/with-dispatch executor
|
||||
(let [id (get-in request [:path-params :id])
|
||||
id (coerce-id id)
|
||||
obj (sto/get-object storage id)]
|
||||
(if obj
|
||||
(serve-object cfg obj)
|
||||
{:status 404 :body ""})))
|
||||
|
||||
(defn objects-handler
|
||||
[cfg request]
|
||||
(let [id (get-in request [:path-params :id])]
|
||||
(generic-handler cfg request (coerce-id id))))
|
||||
(p/then respond)
|
||||
(p/catch raise)))
|
||||
|
||||
(defn file-objects-handler
|
||||
[{:keys [storage] :as cfg} request]
|
||||
(let [id (get-in request [:path-params :id])
|
||||
mobj (get-file-media-object storage id)]
|
||||
(generic-handler cfg request (:media-id mobj))))
|
||||
[cfg request respond raise]
|
||||
(-> (generic-handler cfg request :media-id)
|
||||
(p/then respond)
|
||||
(p/catch raise)))
|
||||
|
||||
(defn file-thumbnails-handler
|
||||
[{:keys [storage] :as cfg} request]
|
||||
(let [id (get-in request [:path-params :id])
|
||||
mobj (get-file-media-object storage id)]
|
||||
(generic-handler cfg request (or (:thumbnail-id mobj) (:media-id mobj)))))
|
||||
|
||||
[cfg request respond raise]
|
||||
(-> (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %)))
|
||||
(p/then respond)
|
||||
(p/catch raise)))
|
||||
|
||||
;; --- Initialization
|
||||
|
||||
|
@ -101,10 +113,16 @@
|
|||
(s/def ::signature-max-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handlers [_]
|
||||
(s/keys :req-un [::storage ::mtx/metrics ::assets-path ::cache-max-age ::signature-max-age]))
|
||||
(s/keys :req-un [::storage
|
||||
::wrk/executor
|
||||
::mtx/metrics
|
||||
::assets-path
|
||||
::cache-max-age
|
||||
::signature-max-age]))
|
||||
|
||||
(defmethod ig/init-key ::handlers
|
||||
[_ cfg]
|
||||
{:objects-handler #(objects-handler cfg %)
|
||||
:file-objects-handler #(file-objects-handler cfg %)
|
||||
:file-thumbnails-handler #(file-thumbnails-handler cfg %)})
|
||||
{:objects-handler (partial objects-handler cfg)
|
||||
:file-objects-handler (partial file-objects-handler cfg)
|
||||
:file-thumbnails-handler (partial file-thumbnails-handler cfg)})
|
||||
|
||||
|
|
|
@ -14,14 +14,18 @@
|
|||
[app.db :as db]
|
||||
[app.rpc.mutations.files :as m.files]
|
||||
[app.rpc.queries.profile :as profile]
|
||||
[app.util.async :as async]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.template :as tmpl]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.core :as fs]
|
||||
[fipp.edn :as fpp]
|
||||
[integrant.core :as ig]))
|
||||
[integrant.core :as ig]
|
||||
[promesa.core :as p]))
|
||||
|
||||
;; (selmer.parser/cache-off!)
|
||||
|
||||
|
@ -201,12 +205,23 @@
|
|||
(db/exec-one! conn ["select count(*) as count from server_prop;"])
|
||||
{:status 200 :body "Ok"}))
|
||||
|
||||
(defn- wrap-async
|
||||
[{:keys [executor] :as cfg} f]
|
||||
(fn [request respond raise]
|
||||
(-> (async/with-dispatch executor
|
||||
(f cfg request))
|
||||
(p/then respond)
|
||||
(p/catch raise))))
|
||||
|
||||
(defmethod ig/pre-init-spec ::handlers [_]
|
||||
(s/keys :req-un [::db/pool ::wrk/executor]))
|
||||
|
||||
(defmethod ig/init-key ::handlers
|
||||
[_ cfg]
|
||||
{:index (partial index cfg)
|
||||
:health-check (partial health-check cfg)
|
||||
:retrieve-file-data (partial retrieve-file-data cfg)
|
||||
:retrieve-file-changes (partial retrieve-file-changes cfg)
|
||||
:retrieve-error (partial retrieve-error cfg)
|
||||
:retrieve-error-list (partial retrieve-error-list cfg)
|
||||
:upload-file-data (partial upload-file-data cfg)})
|
||||
{:index (wrap-async cfg index)
|
||||
:health-check (wrap-async cfg health-check)
|
||||
:retrieve-file-data (wrap-async cfg retrieve-file-data)
|
||||
:retrieve-file-changes (wrap-async cfg retrieve-file-changes)
|
||||
:retrieve-error (wrap-async cfg retrieve-error)
|
||||
:retrieve-error-list (wrap-async cfg retrieve-error-list)
|
||||
:upload-file-data (wrap-async cfg upload-file-data)})
|
||||
|
|
|
@ -46,8 +46,9 @@
|
|||
[rpc]
|
||||
(let [context (prepare-context rpc)]
|
||||
(if (contains? cf/flags :backend-api-doc)
|
||||
(fn [_]
|
||||
{:status 200
|
||||
(fn [_ respond _]
|
||||
(respond {:status 200
|
||||
:body (-> (io/resource "api-doc.tmpl")
|
||||
(tmpl/render context))})
|
||||
(constantly {:status 404 :body ""}))))
|
||||
(tmpl/render context))}))
|
||||
(fn [_ respond _]
|
||||
(respond {:status 404 :body ""})))))
|
||||
|
|
|
@ -10,8 +10,6 @@
|
|||
[app.common.transit :as t]
|
||||
[app.config :as cf]
|
||||
[app.util.json :as json]
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.hash :as bh]
|
||||
[ring.core.protocols :as rp]
|
||||
[ring.middleware.cookies :refer [wrap-cookies]]
|
||||
[ring.middleware.keyword-params :refer [wrap-keyword-params]]
|
||||
|
@ -21,13 +19,15 @@
|
|||
|
||||
(defn wrap-server-timing
|
||||
[handler]
|
||||
(let [seconds-from #(float (/ (- (System/nanoTime) %) 1000000000))]
|
||||
(fn [request]
|
||||
(let [start (System/nanoTime)
|
||||
response (handler request)]
|
||||
(update response :headers
|
||||
(fn [headers]
|
||||
(assoc headers "Server-Timing" (str "total;dur=" (seconds-from start)))))))))
|
||||
(letfn [(get-age [start]
|
||||
(float (/ (- (System/nanoTime) start) 1000000000)))
|
||||
|
||||
(update-headers [headers start]
|
||||
(assoc headers "Server-Timing" (str "total;dur=" (get-age start))))]
|
||||
|
||||
(fn [request respond raise]
|
||||
(let [start (System/nanoTime)]
|
||||
(handler request #(respond (update % :headers update-headers start)) raise)))))
|
||||
|
||||
(defn wrap-parse-request-body
|
||||
[handler]
|
||||
|
@ -36,11 +36,11 @@
|
|||
(t/read! reader)))
|
||||
|
||||
(parse-json [body]
|
||||
(json/read body))]
|
||||
(fn [{:keys [headers body] :as request}]
|
||||
(try
|
||||
(json/read body))
|
||||
|
||||
(handle-request [{:keys [headers body] :as request}]
|
||||
(let [ctype (get headers "content-type")]
|
||||
(handler (case ctype
|
||||
(case ctype
|
||||
"application/transit+json"
|
||||
(let [params (parse-transit body)]
|
||||
(-> request
|
||||
|
@ -54,14 +54,22 @@
|
|||
(update :params merge params)))
|
||||
|
||||
request)))
|
||||
(catch Exception e
|
||||
|
||||
(handle-exception [cause]
|
||||
(let [data {:type :validation
|
||||
:code :unable-to-parse-request-body
|
||||
:hint "malformed params"}]
|
||||
(l/error :hint (ex-message e) :cause e)
|
||||
(l/error :hint (ex-message cause) :cause cause)
|
||||
{:status 400
|
||||
:headers {"content-type" "application/transit+json"}
|
||||
:body (t/encode-str data {:type :json-verbose})}))))))
|
||||
:body (t/encode-str data {:type :json-verbose})}))]
|
||||
|
||||
(fn [request respond raise]
|
||||
(try
|
||||
(let [request (handle-request request)]
|
||||
(handler request respond raise))
|
||||
(catch Exception cause
|
||||
(respond (handle-exception cause)))))))
|
||||
|
||||
(def parse-request-body
|
||||
{:name ::parse-request-body
|
||||
|
@ -81,8 +89,9 @@
|
|||
|
||||
(def ^:const buffer-size (:http/output-buffer-size yt/base-defaults))
|
||||
|
||||
(defn- transit-streamable-body
|
||||
[data opts]
|
||||
(defn wrap-format-response-body
|
||||
[handler]
|
||||
(letfn [(transit-streamable-body [data opts]
|
||||
(reify rp/StreamableResponseBody
|
||||
(write-body-to-stream [_ _ output-stream]
|
||||
;; Use the same buffer as jetty output buffer size
|
||||
|
@ -97,11 +106,9 @@
|
|||
(l/warn :hint "unexpected error on encoding response"
|
||||
:cause cause))))))
|
||||
|
||||
(defn- impl-format-response-body
|
||||
[response {:keys [query-params] :as request}]
|
||||
(impl-format-response-body [response {:keys [query-params] :as request}]
|
||||
(let [body (:body response)
|
||||
opts {:type (if (contains? query-params "transit_verbose") :json-verbose :json)}]
|
||||
|
||||
(cond
|
||||
(:ws response)
|
||||
response
|
||||
|
@ -117,12 +124,15 @@
|
|||
:else
|
||||
response)))
|
||||
|
||||
(defn- wrap-format-response-body
|
||||
[handler]
|
||||
(fn [request]
|
||||
(let [response (handler request)]
|
||||
(handle-response [response request]
|
||||
(cond-> response
|
||||
(map? response) (impl-format-response-body request)))))
|
||||
(map? response) (impl-format-response-body request)))]
|
||||
|
||||
(fn [request respond raise]
|
||||
(handler request
|
||||
(fn [response]
|
||||
(respond (handle-response response request)))
|
||||
raise))))
|
||||
|
||||
(def format-response-body
|
||||
{:name ::format-response-body
|
||||
|
@ -130,11 +140,9 @@
|
|||
|
||||
(defn wrap-errors
|
||||
[handler on-error]
|
||||
(fn [request]
|
||||
(try
|
||||
(handler request)
|
||||
(catch Throwable e
|
||||
(on-error e request)))))
|
||||
(fn [request respond _]
|
||||
(handler request respond (fn [cause]
|
||||
(-> cause (on-error request) respond)))))
|
||||
|
||||
(def errors
|
||||
{:name ::errors
|
||||
|
@ -160,41 +168,7 @@
|
|||
{:name ::server-timing
|
||||
:compile (constantly wrap-server-timing)})
|
||||
|
||||
(defn wrap-etag
|
||||
[handler]
|
||||
(letfn [(encode [data]
|
||||
(when (string? data)
|
||||
(str "W/\"" (-> data bh/blake2b-128 bc/bytes->hex) "\"")))]
|
||||
(fn [{method :request-method headers :headers :as request}]
|
||||
(cond-> (handler request)
|
||||
(= :get method)
|
||||
(as-> $ (if-let [etag (-> $ :body meta :etag encode)]
|
||||
(cond-> (update $ :headers assoc "etag" etag)
|
||||
(= etag (get headers "if-none-match"))
|
||||
(-> (assoc :body "")
|
||||
(assoc :status 304)))
|
||||
$))))))
|
||||
|
||||
(def etag
|
||||
{:name ::etag
|
||||
:compile (constantly wrap-etag)})
|
||||
|
||||
(defn activity-logger
|
||||
[handler]
|
||||
(let [logger "penpot.profile-activity"]
|
||||
(fn [{:keys [headers] :as request}]
|
||||
(let [ip-addr (get headers "x-forwarded-for")
|
||||
profile-id (:profile-id request)
|
||||
qstring (:query-string request)]
|
||||
(l/info ::l/async true
|
||||
::l/logger logger
|
||||
:ip-addr ip-addr
|
||||
:profile-id profile-id
|
||||
:uri (str (:uri request) (when qstring (str "?" qstring)))
|
||||
:method (name (:request-method request)))
|
||||
(handler request)))))
|
||||
|
||||
(defn- wrap-cors
|
||||
(defn wrap-cors
|
||||
[handler]
|
||||
(if-not (contains? cf/flags :cors)
|
||||
handler
|
||||
|
@ -209,12 +183,15 @@
|
|||
(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"))))))]
|
||||
(fn [request]
|
||||
(fn [request respond raise]
|
||||
(if (= (:request-method request) :options)
|
||||
(-> {:status 200 :body ""}
|
||||
(add-cors-headers request))
|
||||
(let [response (handler request)]
|
||||
(add-cors-headers response request)))))))
|
||||
(add-cors-headers request)
|
||||
(respond))
|
||||
(handler request
|
||||
(fn [response]
|
||||
(respond (add-cors-headers response request)))
|
||||
raise))))))
|
||||
|
||||
(def cors
|
||||
{:name ::cors
|
||||
|
|
|
@ -21,7 +21,8 @@
|
|||
[clojure.set :as set]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[integrant.core :as ig]))
|
||||
[integrant.core :as ig]
|
||||
[promesa.exec :as px]))
|
||||
|
||||
(defn- build-redirect-uri
|
||||
[{:keys [provider] :as cfg}]
|
||||
|
@ -213,7 +214,10 @@
|
|||
(redirect-response uri))))
|
||||
|
||||
(defn- auth-handler
|
||||
[{:keys [tokens] :as cfg} {:keys [params] :as request}]
|
||||
[{:keys [tokens executors] :as cfg} {:keys [params] :as request} respond _]
|
||||
(px/run!
|
||||
(:default executors)
|
||||
(fn []
|
||||
(let [invitation (:invitation-token params)
|
||||
props (extract-utm-props params)
|
||||
state (tokens :generate
|
||||
|
@ -222,19 +226,23 @@
|
|||
:props props
|
||||
:exp (dt/in-future "15m")})
|
||||
uri (build-auth-uri cfg state)]
|
||||
|
||||
(respond
|
||||
{:status 200
|
||||
:body {:redirect-uri uri}}))
|
||||
:body {:redirect-uri uri}})))))
|
||||
|
||||
(defn- callback-handler
|
||||
[cfg request]
|
||||
[{:keys [executors] :as cfg} request respond _]
|
||||
(px/run!
|
||||
(:default executors)
|
||||
(fn []
|
||||
(try
|
||||
(let [info (retrieve-info cfg request)
|
||||
profile (retrieve-profile cfg info)]
|
||||
(generate-redirect cfg request info profile))
|
||||
(catch Exception e
|
||||
(l/warn :hint "error on oauth process"
|
||||
:cause e)
|
||||
(generate-error-redirect cfg e))))
|
||||
(respond (generate-redirect cfg request info profile)))
|
||||
(catch Exception cause
|
||||
(l/warn :hint "error on oauth process" :cause cause)
|
||||
(respond (generate-error-redirect cfg cause)))))))
|
||||
|
||||
;; --- INIT
|
||||
|
||||
|
@ -250,15 +258,19 @@
|
|||
|
||||
(defn wrap-handler
|
||||
[cfg handler]
|
||||
(fn [request]
|
||||
(fn [request respond raise]
|
||||
(let [provider (get-in request [:path-params :provider])
|
||||
provider (get-in @cfg [:providers provider])]
|
||||
(when-not provider
|
||||
(ex/raise :type :not-found
|
||||
:context {:provider provider}
|
||||
:hint "provider not configured"))
|
||||
(-> (assoc @cfg :provider provider)
|
||||
(handler request)))))
|
||||
(if provider
|
||||
(handler (assoc @cfg :provider provider)
|
||||
request
|
||||
respond
|
||||
raise)
|
||||
(raise
|
||||
(ex/error
|
||||
:type :not-found
|
||||
:provider provider
|
||||
:hint "provider not configured"))))))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ cfg]
|
||||
|
|
|
@ -134,13 +134,13 @@
|
|||
|
||||
(defn- middleware
|
||||
[events-ch store handler]
|
||||
(fn [request]
|
||||
(fn [request respond raise]
|
||||
(if-let [{:keys [id profile-id] :as session} (retrieve-from-request store request)]
|
||||
(do
|
||||
(a/>!! events-ch id)
|
||||
(l/set-context! {:profile-id profile-id})
|
||||
(handler (assoc request :profile-id profile-id :session-id id)))
|
||||
(handler request))))
|
||||
(handler (assoc request :profile-id profile-id :session-id id) respond raise))
|
||||
(handler request respond raise))))
|
||||
|
||||
;; --- STATE INIT: SESSION
|
||||
|
||||
|
@ -150,7 +150,8 @@
|
|||
|
||||
(defmethod ig/prep-key ::session
|
||||
[_ cfg]
|
||||
(d/merge {:buffer-size 128} (d/without-nils cfg)))
|
||||
(d/merge {:buffer-size 128}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::session
|
||||
[_ {:keys [pool tokens] :as cfg}]
|
||||
|
@ -164,7 +165,7 @@
|
|||
|
||||
(-> cfg
|
||||
(assoc ::events-ch events-ch)
|
||||
(assoc :middleware #(middleware events-ch store %))
|
||||
(assoc :middleware (partial middleware events-ch store))
|
||||
(assoc :create (fn [profile-id]
|
||||
(fn [request response]
|
||||
(let [token (create-session store request profile-id)]
|
||||
|
@ -207,16 +208,11 @@
|
|||
:max-batch-size (str (:max-batch-size cfg)))
|
||||
(let [input (aa/batch (::events-ch session)
|
||||
{:max-batch-size (:max-batch-size cfg)
|
||||
:max-batch-age (inst-ms (:max-batch-age cfg))})
|
||||
mcnt (mtx/create
|
||||
{:name "http_session_update_total"
|
||||
:help "A counter of session update batch events."
|
||||
:registry (:registry metrics)
|
||||
:type :counter})]
|
||||
:max-batch-age (inst-ms (:max-batch-age cfg))})]
|
||||
(a/go-loop []
|
||||
(when-let [[reason batch] (a/<! input)]
|
||||
(let [result (a/<! (update-sessions cfg batch))]
|
||||
(mcnt :inc)
|
||||
(mtx/run! metrics {:id :session-update-total :inc 1})
|
||||
(cond
|
||||
(ex/exception? result)
|
||||
(l/error :task "updater"
|
||||
|
@ -228,6 +224,7 @@
|
|||
:hint "update sessions"
|
||||
:reason (name reason)
|
||||
:count result))
|
||||
|
||||
(recur))))))
|
||||
|
||||
(defn- update-sessions
|
||||
|
|
|
@ -13,7 +13,6 @@
|
|||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.websocket :as ws]
|
||||
[app.worker :as wrk]
|
||||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]
|
||||
|
@ -100,36 +99,36 @@
|
|||
(s/keys :req-un [::file-id ::session-id]))
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::msgbus ::db/pool ::mtx/metrics ::wrk/executor]))
|
||||
(s/keys :req-un [::msgbus ::db/pool ::mtx/metrics]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics pool] :as cfg}]
|
||||
(let [metrics {:connections (get-in metrics [:definitions :websocket-active-connections])
|
||||
:messages (get-in metrics [:definitions :websocket-messages-total])
|
||||
:sessions (get-in metrics [:definitions :websocket-session-timing])}]
|
||||
(fn [{:keys [profile-id params] :as req}]
|
||||
[_ {:keys [pool] :as cfg}]
|
||||
(fn [{:keys [profile-id params] :as req} respond raise]
|
||||
(let [params (us/conform ::handler-params params)
|
||||
file (retrieve-file pool (:file-id params))
|
||||
cfg (-> (merge cfg params)
|
||||
(assoc :profile-id profile-id)
|
||||
(assoc :team-id (:team-id file))
|
||||
(assoc ::ws/metrics metrics))]
|
||||
(assoc :team-id (:team-id file)))]
|
||||
|
||||
(when-not profile-id
|
||||
(ex/raise :type :authentication
|
||||
(cond
|
||||
(not profile-id)
|
||||
(raise (ex/error :type :authentication
|
||||
:hint "Authentication required."))
|
||||
|
||||
(when-not file
|
||||
(ex/raise :type :not-found
|
||||
(not file)
|
||||
(raise (ex/error :type :not-found
|
||||
:code :object-not-found))
|
||||
|
||||
(when-not (yws/upgrade-request? req)
|
||||
(ex/raise :type :validation
|
||||
|
||||
(not (yws/upgrade-request? req))
|
||||
(raise (ex/error :type :validation
|
||||
:code :websocket-request-expected
|
||||
:hint "this endpoint only accepts websocket connections"))
|
||||
|
||||
:else
|
||||
(->> (ws/handler handle-message cfg)
|
||||
(yws/upgrade req))))))
|
||||
(yws/upgrade req)
|
||||
(respond))))))
|
||||
|
||||
(def ^:private
|
||||
sql:retrieve-file
|
||||
|
|
|
@ -21,8 +21,32 @@
|
|||
:metrics (ig/ref :app.metrics/metrics)
|
||||
:migrations (ig/ref :app.migrations/all)
|
||||
:name :main
|
||||
:min-pool-size 0
|
||||
:max-pool-size 60}
|
||||
:min-size (cf/get :database-min-pool-size 0)
|
||||
:max-size (cf/get :database-max-pool-size 30)}
|
||||
|
||||
;; Default thread pool for IO operations
|
||||
[::default :app.worker/executor]
|
||||
{:parallelism (cf/get :default-executor-parallelism 120)
|
||||
:prefix :default}
|
||||
|
||||
;; Constrained thread pool. Should only be used from high demand
|
||||
;; RPC methods.
|
||||
[::blocking :app.worker/executor]
|
||||
{:parallelism (cf/get :blocking-executor-parallelism 20)
|
||||
:prefix :blocking}
|
||||
|
||||
;; Dedicated thread pool for backround tasks execution.
|
||||
[::worker :app.worker/executor]
|
||||
{:parallelism (cf/get :worker-executor-parallelism 10)
|
||||
:prefix :worker}
|
||||
|
||||
:app.worker/executors-monitor
|
||||
{:executors
|
||||
{:default (ig/ref [::default :app.worker/executor])
|
||||
:blocking (ig/ref [::blocking :app.worker/executor])
|
||||
:worker (ig/ref [::worker :app.worker/executor])}
|
||||
|
||||
:metrics (ig/ref :app.metrics/metrics)}
|
||||
|
||||
:app.migrations/migrations
|
||||
{}
|
||||
|
@ -60,7 +84,7 @@
|
|||
:app.http.session/updater
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:metrics (ig/ref :app.metrics/metrics)
|
||||
:executor (ig/ref :app.worker/executor)
|
||||
:executor (ig/ref [::worker :app.worker/executor])
|
||||
:session (ig/ref :app.http.session/session)
|
||||
:max-batch-age (cf/get :http-session-updater-batch-max-age)
|
||||
:max-batch-size (cf/get :http-session-updater-batch-max-size)}
|
||||
|
@ -73,7 +97,10 @@
|
|||
{:port (cf/get :http-server-port)
|
||||
:host (cf/get :http-server-host)
|
||||
:router (ig/ref :app.http/router)
|
||||
:metrics (ig/ref :app.metrics/metrics)}
|
||||
:metrics (ig/ref :app.metrics/metrics)
|
||||
|
||||
:max-threads (cf/get :http-server-max-threads)
|
||||
:min-threads (cf/get :http-server-min-threads)}
|
||||
|
||||
:app.http/router
|
||||
{:assets (ig/ref :app.http.assets/handlers)
|
||||
|
@ -91,11 +118,11 @@
|
|||
:rpc (ig/ref :app.rpc/rpc)}
|
||||
|
||||
:app.http.debug/handlers
|
||||
{:pool (ig/ref :app.db/pool)}
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref [::default :app.worker/executor])}
|
||||
|
||||
:app.http.websocket/handler
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)
|
||||
:metrics (ig/ref :app.metrics/metrics)
|
||||
:msgbus (ig/ref :app.msgbus/msgbus)}
|
||||
|
||||
|
@ -103,6 +130,7 @@
|
|||
{:metrics (ig/ref :app.metrics/metrics)
|
||||
:assets-path (cf/get :assets-path)
|
||||
:storage (ig/ref :app.storage/storage)
|
||||
:executor (ig/ref [::default :app.worker/executor])
|
||||
:cache-max-age (dt/duration {:hours 24})
|
||||
:signature-max-age (dt/duration {:hours 24 :minutes 5})}
|
||||
|
||||
|
@ -125,22 +153,19 @@
|
|||
:storage (ig/ref :app.storage/storage)
|
||||
:msgbus (ig/ref :app.msgbus/msgbus)
|
||||
:public-uri (cf/get :public-uri)
|
||||
:audit (ig/ref :app.loggers.audit/collector)}
|
||||
|
||||
:app.worker/executor
|
||||
{:min-threads 0
|
||||
:max-threads 256
|
||||
:idle-timeout 60000
|
||||
:name :worker}
|
||||
:audit (ig/ref :app.loggers.audit/collector)
|
||||
:executors
|
||||
{:default (ig/ref [::default :app.worker/executor])
|
||||
:blocking (ig/ref [::blocking :app.worker/executor])}}
|
||||
|
||||
:app.worker/worker
|
||||
{:executor (ig/ref :app.worker/executor)
|
||||
{:executor (ig/ref [::worker :app.worker/executor])
|
||||
:tasks (ig/ref :app.worker/registry)
|
||||
:metrics (ig/ref :app.metrics/metrics)
|
||||
:pool (ig/ref :app.db/pool)}
|
||||
|
||||
:app.worker/scheduler
|
||||
{:executor (ig/ref :app.worker/executor)
|
||||
{:executor (ig/ref [::worker :app.worker/executor])
|
||||
:tasks (ig/ref :app.worker/registry)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:schedule
|
||||
|
@ -254,11 +279,11 @@
|
|||
|
||||
:app.loggers.audit/http-handler
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
:executor (ig/ref [::default :app.worker/executor])}
|
||||
|
||||
:app.loggers.audit/collector
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
:executor (ig/ref [::worker :app.worker/executor])}
|
||||
|
||||
:app.loggers.audit/archive-task
|
||||
{:uri (cf/get :audit-log-archive-uri)
|
||||
|
@ -272,27 +297,18 @@
|
|||
:app.loggers.loki/reporter
|
||||
{:uri (cf/get :loggers-loki-uri)
|
||||
:receiver (ig/ref :app.loggers.zmq/receiver)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
:executor (ig/ref [::worker :app.worker/executor])}
|
||||
|
||||
:app.loggers.mattermost/reporter
|
||||
{:uri (cf/get :error-report-webhook)
|
||||
:receiver (ig/ref :app.loggers.zmq/receiver)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
:executor (ig/ref [::worker :app.worker/executor])}
|
||||
|
||||
:app.loggers.database/reporter
|
||||
{:receiver (ig/ref :app.loggers.zmq/receiver)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
|
||||
:app.loggers.sentry/reporter
|
||||
{:dsn (cf/get :sentry-dsn)
|
||||
:trace-sample-rate (cf/get :sentry-trace-sample-rate 1.0)
|
||||
:attach-stack-trace (cf/get :sentry-attach-stack-trace false)
|
||||
:debug (cf/get :sentry-debug false)
|
||||
:receiver (ig/ref :app.loggers.zmq/receiver)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:executor (ig/ref :app.worker/executor)}
|
||||
:executor (ig/ref [::worker :app.worker/executor])}
|
||||
|
||||
:app.storage/storage
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
|
|
|
@ -5,46 +5,40 @@
|
|||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.metrics
|
||||
(:refer-clojure :exclude [run!])
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig])
|
||||
(:import
|
||||
io.prometheus.client.CollectorRegistry
|
||||
io.prometheus.client.Counter
|
||||
io.prometheus.client.Counter$Child
|
||||
io.prometheus.client.Gauge
|
||||
io.prometheus.client.Gauge$Child
|
||||
io.prometheus.client.Summary
|
||||
io.prometheus.client.Summary$Child
|
||||
io.prometheus.client.Summary$Builder
|
||||
io.prometheus.client.Histogram
|
||||
io.prometheus.client.Histogram$Child
|
||||
io.prometheus.client.exporter.common.TextFormat
|
||||
io.prometheus.client.hotspot.DefaultExports
|
||||
io.prometheus.client.jetty.JettyStatisticsCollector
|
||||
org.eclipse.jetty.server.handler.StatisticsHandler
|
||||
java.io.StringWriter))
|
||||
|
||||
(declare instrument-vars!)
|
||||
(declare instrument)
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(declare create-registry)
|
||||
(declare create)
|
||||
(declare handler)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Defaults
|
||||
;; METRICS SERVICE PROVIDER
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(def default-metrics
|
||||
{:profile-register
|
||||
{:name "actions_profile_register_count"
|
||||
:help "A global counter of user registrations."
|
||||
:type :counter}
|
||||
|
||||
:profile-activation
|
||||
{:name "actions_profile_activation_count"
|
||||
:help "A global counter of profile activations"
|
||||
:type :counter}
|
||||
|
||||
:update-file-changes
|
||||
{:update-file-changes
|
||||
{:name "rpc_update_file_changes_total"
|
||||
:help "A total number of changes submitted to update-file."
|
||||
:type :counter}
|
||||
|
@ -54,6 +48,18 @@
|
|||
:help "A total number of bytes processed by update-file."
|
||||
:type :counter}
|
||||
|
||||
:rpc-mutation-timing
|
||||
{:name "rpc_mutation_timing"
|
||||
:help "RPC mutation method call timming."
|
||||
:labels ["name"]
|
||||
:type :histogram}
|
||||
|
||||
:rpc-query-timing
|
||||
{:name "rpc_query_timing"
|
||||
:help "RPC query method call timing."
|
||||
:labels ["name"]
|
||||
:type :histogram}
|
||||
|
||||
:websocket-active-connections
|
||||
{:name "websocket_active_connections"
|
||||
:help "Active websocket connections gauge"
|
||||
|
@ -68,12 +74,54 @@
|
|||
:websocket-session-timing
|
||||
{:name "websocket_session_timing"
|
||||
:help "Websocket session timing (seconds)."
|
||||
:quantiles []
|
||||
:type :summary}})
|
||||
:type :summary}
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Entry Point
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
:session-update-total
|
||||
{:name "http_session_update_total"
|
||||
:help "A counter of session update batch events."
|
||||
:type :counter}
|
||||
|
||||
:tasks-timing
|
||||
{:name "penpot_tasks_timing"
|
||||
:help "Background tasks timing (milliseconds)."
|
||||
:labels ["name"]
|
||||
:type :summary}
|
||||
|
||||
:rlimit-queued-submissions
|
||||
{:name "penpot_rlimit_queued_submissions"
|
||||
:help "Current number of queued submissions on RLIMIT."
|
||||
:labels ["name"]
|
||||
:type :gauge}
|
||||
|
||||
:rlimit-used-permits
|
||||
{:name "penpot_rlimit_used_permits"
|
||||
:help "Current number of used permits on RLIMIT."
|
||||
:labels ["name"]
|
||||
:type :gauge}
|
||||
|
||||
:rlimit-acquires-total
|
||||
{:name "penpot_rlimit_acquires_total"
|
||||
:help "Total number of acquire operations on RLIMIT."
|
||||
:labels ["name"]
|
||||
:type :counter}
|
||||
|
||||
:executors-active-threads
|
||||
{:name "penpot_executors_active_threads"
|
||||
:help "Current number of threads available in the executor service."
|
||||
:labels ["name"]
|
||||
:type :gauge}
|
||||
|
||||
:executors-running-threads
|
||||
{:name "penpot_executors_running_threads"
|
||||
:help "Current number of threads with state RUNNING."
|
||||
:labels ["name"]
|
||||
:type :gauge}
|
||||
|
||||
:executors-queued-submissions
|
||||
{:name "penpot_executors_queued_submissions"
|
||||
:help "Current number of queued submissions."
|
||||
:labels ["name"]
|
||||
:type :gauge}})
|
||||
|
||||
(defmethod ig/init-key ::metrics
|
||||
[_ _]
|
||||
|
@ -95,31 +143,44 @@
|
|||
(s/keys :req-un [::registry ::handler]))
|
||||
|
||||
(defn- handler
|
||||
[registry _request]
|
||||
[registry _ respond _]
|
||||
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
|
||||
writer (StringWriter.)]
|
||||
(TextFormat/write004 writer samples)
|
||||
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
||||
:body (.toString writer)}))
|
||||
(respond {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
||||
:body (.toString writer)})))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def default-empty-labels (into-array String []))
|
||||
|
||||
(def default-quantiles
|
||||
[[0.5 0.01]
|
||||
[0.90 0.01]
|
||||
[0.99 0.001]])
|
||||
|
||||
(def default-histogram-buckets
|
||||
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
|
||||
|
||||
(defn run!
|
||||
[{:keys [definitions]} {:keys [id] :as params}]
|
||||
(when-let [mobj (get definitions id)]
|
||||
((::fn mobj) params)
|
||||
true))
|
||||
|
||||
(defn create-registry
|
||||
[]
|
||||
(let [registry (CollectorRegistry.)]
|
||||
(DefaultExports/register registry)
|
||||
registry))
|
||||
|
||||
(defmacro with-measure
|
||||
[& {:keys [expr cb]}]
|
||||
`(let [start# (System/nanoTime)
|
||||
tdown# ~cb]
|
||||
(try
|
||||
~expr
|
||||
(finally
|
||||
(tdown# (/ (- (System/nanoTime) start#) 1000000))))))
|
||||
(defn- is-array?
|
||||
[o]
|
||||
(let [oc (class o)]
|
||||
(and (.isArray ^Class oc)
|
||||
(= (.getComponentType oc) String))))
|
||||
|
||||
(defn make-counter
|
||||
[{:keys [name help registry reg labels] :as props}]
|
||||
|
@ -132,12 +193,9 @@
|
|||
instance (.register instance registry)]
|
||||
|
||||
{::instance instance
|
||||
::fn (fn [{:keys [by labels] :or {by 1}}]
|
||||
(if labels
|
||||
(.. ^Counter instance
|
||||
(labels (into-array String labels))
|
||||
(inc by))
|
||||
(.inc ^Counter instance by)))}))
|
||||
::fn (fn [{:keys [inc labels] :or {inc 1 labels default-empty-labels}}]
|
||||
(let [instance (.labels instance (if (is-array? labels) labels (into-array String labels)))]
|
||||
(.inc ^Counter$Child instance (double inc))))}))
|
||||
|
||||
(defn make-gauge
|
||||
[{:keys [name help registry reg labels] :as props}]
|
||||
|
@ -148,48 +206,33 @@
|
|||
_ (when (seq labels)
|
||||
(.labelNames instance (into-array String labels)))
|
||||
instance (.register instance registry)]
|
||||
|
||||
{::instance instance
|
||||
::fn (fn [{:keys [cmd by labels] :or {by 1}}]
|
||||
(if labels
|
||||
(let [labels (into-array String [labels])]
|
||||
(case cmd
|
||||
:inc (.. ^Gauge instance (labels labels) (inc by))
|
||||
:dec (.. ^Gauge instance (labels labels) (dec by))))
|
||||
(case cmd
|
||||
:inc (.inc ^Gauge instance by)
|
||||
:dec (.dec ^Gauge instance by))))}))
|
||||
|
||||
(def default-quantiles
|
||||
[[0.75 0.02]
|
||||
[0.99 0.001]])
|
||||
::fn (fn [{:keys [inc dec labels val] :or {labels default-empty-labels}}]
|
||||
(let [instance (.labels ^Gauge instance (if (is-array? labels) labels (into-array String labels)))]
|
||||
(cond (number? inc) (.inc ^Gauge$Child instance (double inc))
|
||||
(number? dec) (.dec ^Gauge$Child instance (double dec))
|
||||
(number? val) (.set ^Gauge$Child instance (double val)))))}))
|
||||
|
||||
(defn make-summary
|
||||
[{:keys [name help registry reg labels max-age quantiles buckets]
|
||||
:or {max-age 3600 buckets 6 quantiles default-quantiles} :as props}]
|
||||
:or {max-age 3600 buckets 12 quantiles default-quantiles} :as props}]
|
||||
(let [registry (or registry reg)
|
||||
instance (doto (Summary/build)
|
||||
builder (doto (Summary/build)
|
||||
(.name name)
|
||||
(.help help))
|
||||
_ (when (seq quantiles)
|
||||
(.maxAgeSeconds ^Summary instance max-age)
|
||||
(.ageBuckets ^Summary instance buckets))
|
||||
(.maxAgeSeconds ^Summary$Builder builder ^long max-age)
|
||||
(.ageBuckets ^Summary$Builder builder buckets))
|
||||
_ (doseq [[q e] quantiles]
|
||||
(.quantile ^Summary instance q e))
|
||||
(.quantile ^Summary$Builder builder q e))
|
||||
_ (when (seq labels)
|
||||
(.labelNames instance (into-array String labels)))
|
||||
instance (.register instance registry)]
|
||||
(.labelNames ^Summary$Builder builder (into-array String labels)))
|
||||
instance (.register ^Summary$Builder builder registry)]
|
||||
|
||||
{::instance instance
|
||||
::fn (fn [{:keys [val labels]}]
|
||||
(if labels
|
||||
(.. ^Summary instance
|
||||
(labels (into-array String labels))
|
||||
(observe val))
|
||||
(.observe ^Summary instance val)))}))
|
||||
|
||||
(def default-histogram-buckets
|
||||
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
|
||||
::fn (fn [{:keys [val labels] :or {labels default-empty-labels}}]
|
||||
(let [instance (.labels ^Summary instance (if (is-array? labels) labels (into-array String labels)))]
|
||||
(.observe ^Summary$Child instance val)))}))
|
||||
|
||||
(defn make-histogram
|
||||
[{:keys [name help registry reg labels buckets]
|
||||
|
@ -204,12 +247,9 @@
|
|||
instance (.register instance registry)]
|
||||
|
||||
{::instance instance
|
||||
::fn (fn [{:keys [val labels]}]
|
||||
(if labels
|
||||
(.. ^Histogram instance
|
||||
(labels (into-array String labels))
|
||||
(observe val))
|
||||
(.observe ^Histogram instance val)))}))
|
||||
::fn (fn [{:keys [val labels] :or {labels default-empty-labels}}]
|
||||
(let [instance (.labels ^Histogram instance (if (is-array? labels) labels (into-array String labels)))]
|
||||
(.observe ^Histogram$Child instance val)))}))
|
||||
|
||||
(defn create
|
||||
[{:keys [type] :as props}]
|
||||
|
@ -219,114 +259,6 @@
|
|||
:summary (make-summary props)
|
||||
:histogram (make-histogram props)))
|
||||
|
||||
(defn wrap-counter
|
||||
([rootf mobj]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
([a]
|
||||
((::fn mobj) nil)
|
||||
(origf a))
|
||||
([a b]
|
||||
((::fn mobj) nil)
|
||||
(origf a b))
|
||||
([a b c]
|
||||
((::fn mobj) nil)
|
||||
(origf a b c))
|
||||
([a b c d]
|
||||
((::fn mobj) nil)
|
||||
(origf a b c d))
|
||||
([a b c d & more]
|
||||
((::fn mobj) nil)
|
||||
(apply origf a b c d more)))
|
||||
(assoc mdata ::original origf))))
|
||||
([rootf mobj labels]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
([a]
|
||||
((::fn mobj) {:labels labels})
|
||||
(origf a))
|
||||
([a b]
|
||||
((::fn mobj) {:labels labels})
|
||||
(origf a b))
|
||||
([a b & more]
|
||||
((::fn mobj) {:labels labels})
|
||||
(apply origf a b more)))
|
||||
(assoc mdata ::original origf)))))
|
||||
|
||||
(defn wrap-summary
|
||||
([rootf mobj]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
([a]
|
||||
(with-measure
|
||||
:expr (origf a)
|
||||
:cb #((::fn mobj) {:val %})))
|
||||
([a b]
|
||||
(with-measure
|
||||
:expr (origf a b)
|
||||
:cb #((::fn mobj) {:val %})))
|
||||
([a b & more]
|
||||
(with-measure
|
||||
:expr (apply origf a b more)
|
||||
:cb #((::fn mobj) {:val %}))))
|
||||
(assoc mdata ::original origf))))
|
||||
|
||||
([rootf mobj labels]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
([a]
|
||||
(with-measure
|
||||
:expr (origf a)
|
||||
:cb #((::fn mobj) {:val % :labels labels})))
|
||||
([a b]
|
||||
(with-measure
|
||||
:expr (origf a b)
|
||||
:cb #((::fn mobj) {:val % :labels labels})))
|
||||
([a b & more]
|
||||
(with-measure
|
||||
:expr (apply origf a b more)
|
||||
:cb #((::fn mobj) {:val % :labels labels}))))
|
||||
(assoc mdata ::original origf)))))
|
||||
|
||||
(defn instrument-vars!
|
||||
[vars {:keys [wrap] :as props}]
|
||||
(let [obj (create props)]
|
||||
(cond
|
||||
(instance? Counter (::instance obj))
|
||||
(doseq [var vars]
|
||||
(alter-var-root var (or wrap wrap-counter) obj))
|
||||
|
||||
(instance? Summary (::instance obj))
|
||||
(doseq [var vars]
|
||||
(alter-var-root var (or wrap wrap-summary) obj))
|
||||
|
||||
:else
|
||||
(ex/raise :type :not-implemented))))
|
||||
|
||||
(defn instrument
|
||||
[f {:keys [wrap] :as props}]
|
||||
(let [obj (create props)]
|
||||
(cond
|
||||
(instance? Counter (::instance obj))
|
||||
((or wrap wrap-counter) f obj)
|
||||
|
||||
(instance? Summary (::instance obj))
|
||||
((or wrap wrap-summary) f obj)
|
||||
|
||||
(instance? Histogram (::instance obj))
|
||||
((or wrap wrap-summary) f obj)
|
||||
|
||||
:else
|
||||
(ex/raise :type :not-implemented))))
|
||||
|
||||
(defn instrument-jetty!
|
||||
[^CollectorRegistry registry ^StatisticsHandler handler]
|
||||
(doto (JettyStatisticsCollector. handler)
|
||||
|
|
|
@ -18,7 +18,6 @@
|
|||
[integrant.core :as ig]
|
||||
[promesa.core :as p])
|
||||
(:import
|
||||
java.time.Duration
|
||||
io.lettuce.core.RedisClient
|
||||
io.lettuce.core.RedisURI
|
||||
io.lettuce.core.api.StatefulConnection
|
||||
|
@ -29,7 +28,10 @@
|
|||
io.lettuce.core.codec.StringCodec
|
||||
io.lettuce.core.pubsub.RedisPubSubListener
|
||||
io.lettuce.core.pubsub.StatefulRedisPubSubConnection
|
||||
io.lettuce.core.pubsub.api.async.RedisPubSubAsyncCommands))
|
||||
io.lettuce.core.pubsub.api.async.RedisPubSubAsyncCommands
|
||||
io.lettuce.core.resource.ClientResources
|
||||
io.lettuce.core.resource.DefaultClientResources
|
||||
java.time.Duration))
|
||||
|
||||
(def ^:private prefix (cfg/get :tenant))
|
||||
|
||||
|
@ -136,12 +138,18 @@
|
|||
(declare impl-redis-sub)
|
||||
(declare impl-redis-unsub)
|
||||
|
||||
|
||||
(defmethod init-backend :redis
|
||||
[{:keys [redis-uri] :as cfg}]
|
||||
(let [codec (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
|
||||
|
||||
resources (.. (DefaultClientResources/builder)
|
||||
(ioThreadPoolSize 4)
|
||||
(computationThreadPoolSize 4)
|
||||
(build))
|
||||
|
||||
uri (RedisURI/create redis-uri)
|
||||
rclient (RedisClient/create ^RedisURI uri)
|
||||
rclient (RedisClient/create ^ClientResources resources ^RedisURI uri)
|
||||
|
||||
pub-conn (.connect ^RedisClient rclient ^RedisCodec codec)
|
||||
sub-conn (.connectPubSub ^RedisClient rclient ^RedisCodec codec)]
|
||||
|
@ -150,13 +158,15 @@
|
|||
(.setTimeout ^StatefulRedisPubSubConnection sub-conn ^Duration (dt/duration {:seconds 10}))
|
||||
|
||||
(-> cfg
|
||||
(assoc ::resources resources)
|
||||
(assoc ::pub-conn pub-conn)
|
||||
(assoc ::sub-conn sub-conn))))
|
||||
|
||||
(defmethod stop-backend :redis
|
||||
[{:keys [::pub-conn ::sub-conn] :as cfg}]
|
||||
[{:keys [::pub-conn ::sub-conn ::resources] :as cfg}]
|
||||
(.close ^StatefulRedisConnection pub-conn)
|
||||
(.close ^StatefulRedisPubSubConnection sub-conn))
|
||||
(.close ^StatefulRedisPubSubConnection sub-conn)
|
||||
(.shutdown ^ClientResources resources))
|
||||
|
||||
(defmethod init-pub-loop :redis
|
||||
[{:keys [::pub-conn ::pub-ch]}]
|
||||
|
|
|
@ -13,25 +13,42 @@
|
|||
[app.db :as db]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.retry :as retry]
|
||||
[app.util.rlimit :as rlimit]
|
||||
[app.rpc.retry :as retry]
|
||||
[app.rpc.rlimit :as rlimit]
|
||||
[app.util.async :as async]
|
||||
[app.util.services :as sv]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
[integrant.core :as ig]
|
||||
[promesa.core :as p]
|
||||
[promesa.exec :as px]))
|
||||
|
||||
(defn- default-handler
|
||||
[_]
|
||||
(ex/raise :type :not-found))
|
||||
(p/rejected (ex/error :type :not-found)))
|
||||
|
||||
(defn- run-hook
|
||||
[hook-fn response]
|
||||
(ex/ignoring (hook-fn))
|
||||
(defn- handle-response-transformation
|
||||
[response request mdata]
|
||||
(if-let [transform-fn (:transform-response mdata)]
|
||||
(transform-fn request response)
|
||||
response))
|
||||
|
||||
(defn- handle-before-comple-hook
|
||||
[response mdata]
|
||||
(when-let [hook-fn (:before-complete mdata)]
|
||||
(ex/ignoring (hook-fn)))
|
||||
response)
|
||||
|
||||
(defn- rpc-query-handler
|
||||
[methods {:keys [profile-id session-id] :as request}]
|
||||
(let [type (keyword (get-in request [:path-params :type]))
|
||||
"Ring handler that dispatches query requests and convert between
|
||||
internal async flow into ring async flow."
|
||||
[methods {:keys [profile-id session-id] :as request} respond raise]
|
||||
(letfn [(handle-response [result]
|
||||
(let [mdata (meta result)]
|
||||
(-> {:status 200 :body result}
|
||||
(handle-response-transformation request mdata))))]
|
||||
|
||||
(let [type (keyword (get-in request [:path-params :type]))
|
||||
data (merge (:params request)
|
||||
(:body-params request)
|
||||
(:uploads request)
|
||||
|
@ -41,15 +58,24 @@
|
|||
(assoc data :profile-id profile-id ::session-id session-id)
|
||||
(dissoc data :profile-id))
|
||||
|
||||
result ((get methods type default-handler) data)
|
||||
mdata (meta result)]
|
||||
;; Get the method from methods registry and if method does
|
||||
;; not exists asigns it to the default handler.
|
||||
method (get methods type default-handler)]
|
||||
|
||||
(cond->> {:status 200 :body result}
|
||||
(fn? (:transform-response mdata))
|
||||
((:transform-response mdata) request))))
|
||||
(-> (method data)
|
||||
(p/then #(respond (handle-response %)))
|
||||
(p/catch raise)))))
|
||||
|
||||
(defn- rpc-mutation-handler
|
||||
[methods {:keys [profile-id session-id] :as request}]
|
||||
"Ring handler that dispatches mutation requests and convert between
|
||||
internal async flow into ring async flow."
|
||||
[methods {:keys [profile-id session-id] :as request} respond raise]
|
||||
(letfn [(handle-response [result]
|
||||
(let [mdata (meta result)]
|
||||
(-> {:status 200 :body result}
|
||||
(handle-response-transformation request mdata)
|
||||
(handle-before-comple-hook mdata))))]
|
||||
|
||||
(let [type (keyword (get-in request [:path-params :type]))
|
||||
data (merge (:params request)
|
||||
(:body-params request)
|
||||
|
@ -60,51 +86,64 @@
|
|||
(assoc data :profile-id profile-id ::session-id session-id)
|
||||
(dissoc data :profile-id))
|
||||
|
||||
result ((get methods type default-handler) data)
|
||||
mdata (meta result)]
|
||||
(cond->> {:status 200 :body result}
|
||||
(fn? (:transform-response mdata))
|
||||
((:transform-response mdata) request)
|
||||
method (get methods type default-handler)]
|
||||
|
||||
(fn? (:before-complete mdata))
|
||||
(run-hook (:before-complete mdata)))))
|
||||
(-> (method data)
|
||||
(p/then #(respond (handle-response %)))
|
||||
(p/catch raise)))))
|
||||
|
||||
(defn- wrap-with-metrics
|
||||
[cfg f mdata]
|
||||
(mtx/wrap-summary f (::mobj cfg) [(::sv/name mdata)]))
|
||||
(defn- wrap-metrics
|
||||
"Wrap service method with metrics measurement."
|
||||
[{:keys [metrics ::metrics-id]} f mdata]
|
||||
(let [labels (into-array String [(::sv/name mdata)])]
|
||||
(fn [cfg params]
|
||||
(let [start (System/nanoTime)]
|
||||
(p/finally
|
||||
(f cfg params)
|
||||
(fn [_ _]
|
||||
(mtx/run! metrics
|
||||
{:id metrics-id
|
||||
:val (/ (- (System/nanoTime) start) 1000000)
|
||||
:labels labels})))))))
|
||||
|
||||
(defn- wrap-impl
|
||||
[{:keys [audit] :as cfg} f mdata]
|
||||
(let [f (as-> f $
|
||||
(rlimit/wrap-rlimit cfg $ mdata)
|
||||
(retry/wrap-retry cfg $ mdata)
|
||||
(wrap-with-metrics cfg $ mdata))
|
||||
|
||||
spec (or (::sv/spec mdata) (s/spec any?))
|
||||
auth? (:auth mdata true)]
|
||||
|
||||
(l/trace :action "register" :name (::sv/name mdata))
|
||||
(defn- wrap-dispatch
|
||||
"Wraps service method into async flow, with the ability to dispatching
|
||||
it to a preconfigured executor service."
|
||||
[{:keys [executors] :as cfg} f mdata]
|
||||
(let [dname (::async/dispatch mdata :none)]
|
||||
(if (= :none dname)
|
||||
(with-meta
|
||||
(fn [params]
|
||||
;; Raise authentication error when rpc method requires auth but
|
||||
;; no profile-id is found in the request.
|
||||
(when (and auth? (not (uuid? (:profile-id params))))
|
||||
(ex/raise :type :authentication
|
||||
:code :authentication-required
|
||||
:hint "authentication required for this endpoint"))
|
||||
(fn [cfg params]
|
||||
(try
|
||||
(p/wrap (f cfg params))
|
||||
(catch Throwable cause
|
||||
(p/rejected cause))))
|
||||
mdata)
|
||||
|
||||
(let [params' (dissoc params ::request)
|
||||
params' (us/conform spec params')
|
||||
result (f cfg params')]
|
||||
(let [executor (get executors dname)]
|
||||
(when-not executor
|
||||
(ex/raise :type :internal
|
||||
:code :executor-not-configured
|
||||
:hint (format "executor %s not configured" dname)))
|
||||
(with-meta
|
||||
(fn [cfg params]
|
||||
(-> (px/submit! executor #(f cfg params))
|
||||
(p/bind p/wrap)))
|
||||
mdata)))))
|
||||
|
||||
;; When audit log is enabled (default false).
|
||||
(when (fn? audit)
|
||||
(defn- wrap-audit
|
||||
[{:keys [audit] :as cfg} f mdata]
|
||||
(if audit
|
||||
(with-meta
|
||||
(fn [cfg {:keys [::request] :as params}]
|
||||
(p/finally (f cfg params)
|
||||
(fn [result _]
|
||||
(when result
|
||||
(let [resultm (meta result)
|
||||
request (::request params)
|
||||
profile-id (or (:profile-id params')
|
||||
profile-id (or (:profile-id params)
|
||||
(:profile-id result)
|
||||
(::audit/profile-id resultm))
|
||||
props (d/merge params' (::audit/props resultm))]
|
||||
props (d/merge params (::audit/props resultm))]
|
||||
(audit :cmd :submit
|
||||
:type (or (::audit/type resultm)
|
||||
(::type cfg))
|
||||
|
@ -112,25 +151,46 @@
|
|||
(::sv/name mdata))
|
||||
:profile-id profile-id
|
||||
:ip-addr (audit/parse-client-ip request)
|
||||
:props props)))
|
||||
result))
|
||||
:props (dissoc props ::request)))))))
|
||||
mdata)
|
||||
f))
|
||||
|
||||
(defn- wrap
|
||||
[cfg f mdata]
|
||||
(let [f (as-> f $
|
||||
(wrap-dispatch cfg $ mdata)
|
||||
(rlimit/wrap-rlimit cfg $ mdata)
|
||||
(retry/wrap-retry cfg $ mdata)
|
||||
(wrap-audit cfg $ mdata)
|
||||
(wrap-metrics cfg $ mdata)
|
||||
)
|
||||
|
||||
spec (or (::sv/spec mdata) (s/spec any?))
|
||||
auth? (:auth mdata true)]
|
||||
|
||||
(l/trace :action "register" :name (::sv/name mdata))
|
||||
(with-meta
|
||||
(fn [{:keys [::request] :as params}]
|
||||
;; Raise authentication error when rpc method requires auth but
|
||||
;; no profile-id is found in the request.
|
||||
(when (and auth? (not (uuid? (:profile-id params))))
|
||||
(ex/raise :type :authentication
|
||||
:code :authentication-required
|
||||
:hint "authentication required for this endpoint"))
|
||||
|
||||
(let [params (us/conform spec (dissoc params ::request))]
|
||||
(f cfg (assoc params ::request request))))
|
||||
mdata)))
|
||||
|
||||
(defn- process-method
|
||||
[cfg vfn]
|
||||
(let [mdata (meta vfn)]
|
||||
[(keyword (::sv/name mdata))
|
||||
(wrap-impl cfg (deref vfn) mdata)]))
|
||||
(wrap cfg (deref vfn) mdata)]))
|
||||
|
||||
(defn- resolve-query-methods
|
||||
[cfg]
|
||||
(let [mobj (mtx/create
|
||||
{:name "rpc_query_timing"
|
||||
:labels ["name"]
|
||||
:registry (get-in cfg [:metrics :registry])
|
||||
:type :histogram
|
||||
:help "Timing of query services."})
|
||||
cfg (assoc cfg ::mobj mobj ::type "query")]
|
||||
(let [cfg (assoc cfg ::type "query" ::metrics-id :rpc-query-timing)]
|
||||
(->> (sv/scan-ns 'app.rpc.queries.projects
|
||||
'app.rpc.queries.files
|
||||
'app.rpc.queries.teams
|
||||
|
@ -143,13 +203,7 @@
|
|||
|
||||
(defn- resolve-mutation-methods
|
||||
[cfg]
|
||||
(let [mobj (mtx/create
|
||||
{:name "rpc_mutation_timing"
|
||||
:labels ["name"]
|
||||
:registry (get-in cfg [:metrics :registry])
|
||||
:type :histogram
|
||||
:help "Timing of mutation services."})
|
||||
cfg (assoc cfg ::mobj mobj ::type "mutation")]
|
||||
(let [cfg (assoc cfg ::type "mutation" ::metrics-id :rpc-mutation-timing)]
|
||||
(->> (sv/scan-ns 'app.rpc.mutations.demo
|
||||
'app.rpc.mutations.media
|
||||
'app.rpc.mutations.profile
|
||||
|
@ -169,15 +223,16 @@
|
|||
(s/def ::session map?)
|
||||
(s/def ::tokens fn?)
|
||||
(s/def ::audit (s/nilable fn?))
|
||||
(s/def ::executors (s/map-of keyword? ::wrk/executor))
|
||||
|
||||
(defmethod ig/pre-init-spec ::rpc [_]
|
||||
(s/keys :req-un [::storage ::session ::tokens ::audit
|
||||
::mtx/metrics ::db/pool]))
|
||||
::executors ::mtx/metrics ::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::rpc
|
||||
[_ cfg]
|
||||
(let [mq (resolve-query-methods cfg)
|
||||
mm (resolve-mutation-methods cfg)]
|
||||
{:methods {:query mq :mutation mm}
|
||||
:query-handler #(rpc-query-handler mq %)
|
||||
:mutation-handler #(rpc-mutation-handler mm %)}))
|
||||
:query-handler (partial rpc-query-handler mq)
|
||||
:mutation-handler (partial rpc-mutation-handler mm)}))
|
||||
|
|
|
@ -12,8 +12,8 @@
|
|||
[app.db :as db]
|
||||
[app.rpc.queries.comments :as comments]
|
||||
[app.rpc.queries.files :as files]
|
||||
[app.rpc.retry :as retry]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.retry :as retry]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]))
|
||||
|
@ -34,8 +34,7 @@
|
|||
(s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
|
||||
|
||||
(sv/defmethod ::create-comment-thread
|
||||
{::retry/enabled true
|
||||
::retry/max-retries 3
|
||||
{::retry/max-retries 3
|
||||
::retry/matches retry/conflict-db-insert?}
|
||||
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
|
|
|
@ -18,6 +18,7 @@
|
|||
[app.rpc.queries.files :as files]
|
||||
[app.rpc.queries.projects :as proj]
|
||||
[app.storage.impl :as simpl]
|
||||
[app.util.async :as async]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
|
@ -272,6 +273,7 @@
|
|||
(contains? o :changes-with-metadata)))))
|
||||
|
||||
(sv/defmethod ::update-file
|
||||
{::async/dispatch :blocking}
|
||||
[{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(db/xact-lock! conn id)
|
||||
|
@ -307,24 +309,21 @@
|
|||
:context {:incoming-revn (:revn params)
|
||||
:stored-revn (:revn file)}))
|
||||
|
||||
(let [mtx1 (get-in metrics [:definitions :update-file-changes])
|
||||
mtx2 (get-in metrics [:definitions :update-file-bytes-processed])
|
||||
|
||||
changes (if changes-with-metadata
|
||||
(let [changes (if changes-with-metadata
|
||||
(mapcat :changes changes-with-metadata)
|
||||
changes)
|
||||
|
||||
changes (vec changes)
|
||||
|
||||
;; Trace the number of changes processed
|
||||
_ ((::mtx/fn mtx1) {:by (count changes)})
|
||||
_ (mtx/run! metrics {:id :update-file-changes :inc (count changes)})
|
||||
|
||||
ts (dt/now)
|
||||
file (-> (files/retrieve-data cfg file)
|
||||
(update :revn inc)
|
||||
(update :data (fn [data]
|
||||
;; Trace the length of bytes of processed data
|
||||
((::mtx/fn mtx2) {:by (alength data)})
|
||||
(mtx/run! metrics {:id :update-file-bytes-processed :inc (alength data)})
|
||||
(-> data
|
||||
(blob/decode)
|
||||
(assoc :id (:id file))
|
||||
|
|
|
@ -56,7 +56,7 @@
|
|||
(s/keys :req-un [::email ::password]
|
||||
:opt-un [::invitation-token]))
|
||||
|
||||
(sv/defmethod ::login-with-ldap {:auth false :rlimit :password}
|
||||
(sv/defmethod ::login-with-ldap {:auth false}
|
||||
[{:keys [pool session tokens] :as cfg} params]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [info (authenticate params)
|
||||
|
|
|
@ -10,10 +10,13 @@
|
|||
[app.common.media :as cm]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.media :as media]
|
||||
[app.rpc.queries.teams :as teams]
|
||||
[app.rpc.rlimit :as rlimit]
|
||||
[app.storage :as sto]
|
||||
[app.util.async :as async]
|
||||
[app.util.http :as http]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
|
@ -47,6 +50,8 @@
|
|||
:opt-un [::id]))
|
||||
|
||||
(sv/defmethod ::upload-file-media-object
|
||||
{::rlimit/permits (cf/get :rlimit-image)
|
||||
::async/dispatch :default}
|
||||
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
|
||||
(let [file (select-file pool file-id)]
|
||||
(teams/check-edition-permissions! pool profile-id (:team-id file))
|
||||
|
@ -167,6 +172,8 @@
|
|||
:opt-un [::id ::name]))
|
||||
|
||||
(sv/defmethod ::create-file-media-object-from-url
|
||||
{::rlimit/permits (cf/get :rlimit-image)
|
||||
::async/dispatch :default}
|
||||
[{:keys [pool storage] :as cfg} {:keys [profile-id file-id url name] :as params}]
|
||||
(let [file (select-file pool file-id)]
|
||||
(teams/check-edition-permissions! pool profile-id (:team-id file))
|
||||
|
|
|
@ -15,11 +15,11 @@
|
|||
[app.http.oauth :refer [extract-utm-props]]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.media :as media]
|
||||
[app.metrics :as mtx]
|
||||
[app.rpc.mutations.teams :as teams]
|
||||
[app.rpc.queries.profile :as profile]
|
||||
[app.rpc.rlimit :as rlimit]
|
||||
[app.storage :as sto]
|
||||
[app.util.rlimit :as rlimit]
|
||||
[app.util.async :as async]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[buddy.hashers :as hashers]
|
||||
|
@ -38,7 +38,6 @@
|
|||
(s/def ::theme ::us/string)
|
||||
(s/def ::invitation-token ::us/not-empty-string)
|
||||
|
||||
(declare annotate-profile-register)
|
||||
(declare check-profile-existence!)
|
||||
(declare create-profile)
|
||||
(declare create-profile-relations)
|
||||
|
@ -102,6 +101,7 @@
|
|||
(when-not (contains? cf/flags :registration)
|
||||
(ex/raise :type :restriction
|
||||
:code :registration-disabled))
|
||||
|
||||
(when-let [domains (cf/get :registration-domain-whitelist)]
|
||||
(when-not (email-domain-in-whitelist? domains (:email params))
|
||||
(ex/raise :type :validation
|
||||
|
@ -122,10 +122,11 @@
|
|||
:code :email-as-password
|
||||
:hint "you can't use your email as password"))
|
||||
|
||||
(let [params (assoc params
|
||||
(let [params {:email (:email params)
|
||||
:invitation-token (:invitation-token params)
|
||||
:backend "penpot"
|
||||
:iss :prepared-register
|
||||
:exp (dt/in-future "48h"))
|
||||
:exp (dt/in-future "48h")}
|
||||
token (tokens :generate params)]
|
||||
{:token token}))
|
||||
|
||||
|
@ -142,16 +143,8 @@
|
|||
(-> (assoc cfg :conn conn)
|
||||
(register-profile params))))
|
||||
|
||||
(defn- annotate-profile-register
|
||||
"A helper for properly increase the profile-register metric once the
|
||||
transaction is completed."
|
||||
[metrics]
|
||||
(fn []
|
||||
(let [mobj (get-in metrics [:definitions :profile-register])]
|
||||
((::mtx/fn mobj) {:by 1}))))
|
||||
|
||||
(defn register-profile
|
||||
[{:keys [conn tokens session metrics] :as cfg} {:keys [token] :as params}]
|
||||
[{:keys [conn tokens session] :as cfg} {:keys [token] :as params}]
|
||||
(let [claims (tokens :verify {:token token :iss :prepared-register})
|
||||
params (merge params claims)]
|
||||
|
||||
|
@ -177,7 +170,6 @@
|
|||
resp {:invitation-token token}]
|
||||
(with-meta resp
|
||||
{:transform-response ((:create session) (:id profile))
|
||||
:before-complete (annotate-profile-register metrics)
|
||||
::audit/props (audit/profile->props profile)
|
||||
::audit/profile-id (:id profile)}))
|
||||
|
||||
|
@ -187,7 +179,6 @@
|
|||
(not= "penpot" (:auth-backend profile))
|
||||
(with-meta (profile/strip-private-attrs profile)
|
||||
{:transform-response ((:create session) (:id profile))
|
||||
:before-complete (annotate-profile-register metrics)
|
||||
::audit/props (audit/profile->props profile)
|
||||
::audit/profile-id (:id profile)})
|
||||
|
||||
|
@ -196,7 +187,6 @@
|
|||
(true? is-active)
|
||||
(with-meta (profile/strip-private-attrs profile)
|
||||
{:transform-response ((:create session) (:id profile))
|
||||
:before-complete (annotate-profile-register metrics)
|
||||
::audit/props (audit/profile->props profile)
|
||||
::audit/profile-id (:id profile)})
|
||||
|
||||
|
@ -219,8 +209,7 @@
|
|||
:extra-data ptoken})
|
||||
|
||||
(with-meta profile
|
||||
{:before-complete (annotate-profile-register metrics)
|
||||
::audit/props (audit/profile->props profile)
|
||||
{::audit/props (audit/profile->props profile)
|
||||
::audit/profile-id (:id profile)}))))))
|
||||
|
||||
(defn create-profile
|
||||
|
@ -359,6 +348,7 @@
|
|||
:opt-un [::lang ::theme]))
|
||||
|
||||
(sv/defmethod ::update-profile
|
||||
{::async/dispatch :default}
|
||||
[{:keys [pool] :as cfg} params]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [profile (update-profile conn params)]
|
||||
|
|
|
@ -18,8 +18,8 @@
|
|||
[app.rpc.permissions :as perms]
|
||||
[app.rpc.queries.profile :as profile]
|
||||
[app.rpc.queries.teams :as teams]
|
||||
[app.rpc.rlimit :as rlimit]
|
||||
[app.storage :as sto]
|
||||
[app.util.rlimit :as rlimit]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
|
|
|
@ -10,7 +10,6 @@
|
|||
[app.common.spec :as us]
|
||||
[app.db :as db]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.metrics :as mtx]
|
||||
[app.rpc.mutations.teams :as teams]
|
||||
[app.rpc.queries.profile :as profile]
|
||||
[app.util.services :as sv]
|
||||
|
@ -44,16 +43,8 @@
|
|||
::audit/props {:email email}
|
||||
::audit/profile-id profile-id}))
|
||||
|
||||
(defn- annotate-profile-activation
|
||||
"A helper for properly increase the profile-activation metric once the
|
||||
transaction is completed."
|
||||
[metrics]
|
||||
(fn []
|
||||
(let [mobj (get-in metrics [:definitions :profile-activation])]
|
||||
((::mtx/fn mobj) {:by 1}))))
|
||||
|
||||
(defmethod process-token :verify-email
|
||||
[{:keys [conn session metrics] :as cfg} _ {:keys [profile-id] :as claims}]
|
||||
[{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
|
||||
(let [profile (profile/retrieve-profile conn profile-id)
|
||||
claims (assoc claims :profile profile)]
|
||||
|
||||
|
@ -69,7 +60,6 @@
|
|||
|
||||
(with-meta claims
|
||||
{:transform-response ((:create session) profile-id)
|
||||
:before-complete (annotate-profile-activation metrics)
|
||||
::audit/name "verify-profile-email"
|
||||
::audit/props (audit/profile->props profile)
|
||||
::audit/profile-id (:id profile)})))
|
||||
|
|
|
@ -35,7 +35,8 @@
|
|||
(s/def ::profile
|
||||
(s/keys :opt-un [::profile-id]))
|
||||
|
||||
(sv/defmethod ::profile {:auth false}
|
||||
(sv/defmethod ::profile
|
||||
{:auth false}
|
||||
[{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
|
||||
;; 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
|
||||
|
|
52
backend/src/app/rpc/retry.clj
Normal file
52
backend/src/app/rpc/retry.clj
Normal file
|
@ -0,0 +1,52 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.rpc.retry
|
||||
"A fault tolerance helpers. Allow retry some operations that we know
|
||||
we can retry."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.util.services :as sv]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defn conflict-db-insert?
|
||||
"Check if exception matches a insertion conflict on postgresql."
|
||||
[e]
|
||||
(and (instance? org.postgresql.util.PSQLException e)
|
||||
(= "23505" (.getSQLState e))))
|
||||
|
||||
(defn wrap-retry
|
||||
[_ f {:keys [::matches ::sv/name]
|
||||
:or {matches (constantly false)}
|
||||
:as mdata}]
|
||||
|
||||
(when (::enabled mdata)
|
||||
(l/debug :hint "wrapping retry" :name name))
|
||||
|
||||
(if-let [max-retries (::max-retries mdata)]
|
||||
(fn [cfg params]
|
||||
(letfn [(run [retry]
|
||||
(prn "wrap-retry" "run" retry)
|
||||
(try
|
||||
(-> (f cfg params)
|
||||
(p/catch (partial handle-error retry)))
|
||||
(catch Throwable cause
|
||||
(prn cause)
|
||||
(throw cause))))
|
||||
|
||||
|
||||
(handle-error [retry cause]
|
||||
(prn "FOOFOFOF" retry (matches 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 0)))
|
||||
f))
|
||||
|
67
backend/src/app/rpc/rlimit.clj
Normal file
67
backend/src/app/rpc/rlimit.clj
Normal file
|
@ -0,0 +1,67 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.rpc.rlimit
|
||||
"Resource usage limits (in other words: semaphores)."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.logging :as l]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.services :as sv]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(defprotocol IAsyncSemaphore
|
||||
(acquire! [_])
|
||||
(release! [_]))
|
||||
|
||||
(defn semaphore
|
||||
[{:keys [permits metrics name]}]
|
||||
(let [name (d/name name)
|
||||
used (volatile! 0)
|
||||
queue (volatile! (d/queue))
|
||||
labels (into-array String [name])]
|
||||
(reify IAsyncSemaphore
|
||||
(acquire! [this]
|
||||
(let [d (p/deferred)]
|
||||
(locking this
|
||||
(if (< @used permits)
|
||||
(do
|
||||
(vswap! used inc)
|
||||
(p/resolve! d))
|
||||
(vswap! queue conj d)))
|
||||
|
||||
(mtx/run! metrics {:id :rlimit-used-permits :val @used :labels labels })
|
||||
(mtx/run! metrics {:id :rlimit-queued-submissions :val (count @queue) :labels labels})
|
||||
(mtx/run! metrics {:id :rlimit-acquires-total :inc 1 :labels labels})
|
||||
d))
|
||||
|
||||
(release! [this]
|
||||
(locking this
|
||||
(if-let [item (peek @queue)]
|
||||
(do
|
||||
(vswap! queue pop)
|
||||
(p/resolve! item))
|
||||
(when (pos? @used)
|
||||
(vswap! used dec))))
|
||||
|
||||
(mtx/run! metrics {:id :rlimit-used-permits :val @used :labels labels})
|
||||
(mtx/run! metrics {:id :rlimit-queued-submissions :val (count @queue) :labels labels})
|
||||
))))
|
||||
|
||||
(defn wrap-rlimit
|
||||
[{:keys [metrics] :as cfg} f mdata]
|
||||
(if-let [permits (::permits mdata)]
|
||||
(let [sem (semaphore {:permits permits
|
||||
:metrics metrics
|
||||
:name (::sv/name mdata)})]
|
||||
(l/debug :hint "wrapping rlimit" :handler (::sv/name mdata) :permits permits)
|
||||
(fn [cfg params]
|
||||
(-> (acquire! sem)
|
||||
(p/then (fn [_] (f cfg params)))
|
||||
(p/finally (fn [_ _] (release! sem))))))
|
||||
f))
|
||||
|
||||
|
|
@ -7,7 +7,8 @@
|
|||
(ns app.util.async
|
||||
(:require
|
||||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s])
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.exec :as px])
|
||||
(:import
|
||||
java.util.concurrent.Executor))
|
||||
|
||||
|
@ -54,13 +55,16 @@
|
|||
(a/close! c)
|
||||
c))))
|
||||
|
||||
|
||||
(defmacro with-thread
|
||||
[executor & body]
|
||||
(if (= executor ::default)
|
||||
`(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
|
||||
`(thread-call ~executor (^:once fn* [] ~@body))))
|
||||
|
||||
(defmacro with-dispatch
|
||||
[executor & body]
|
||||
`(px/submit! ~executor (^:once fn* [] ~@body)))
|
||||
|
||||
(defn batch
|
||||
[in {:keys [max-batch-size
|
||||
max-batch-age
|
||||
|
|
|
@ -1,43 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.util.retry
|
||||
"A fault tolerance helpers. Allow retry some operations that we know
|
||||
we can retry."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.util.async :as aa]
|
||||
[app.util.services :as sv]))
|
||||
|
||||
(defn conflict-db-insert?
|
||||
"Check if exception matches a insertion conflict on postgresql."
|
||||
[e]
|
||||
(and (instance? org.postgresql.util.PSQLException e)
|
||||
(= "23505" (.getSQLState e))))
|
||||
|
||||
(defn wrap-retry
|
||||
[_ f {:keys [::max-retries ::matches ::sv/name]
|
||||
:or {max-retries 3
|
||||
matches (constantly false)}
|
||||
:as mdata}]
|
||||
(when (::enabled mdata)
|
||||
(l/debug :hint "wrapping retry" :name name))
|
||||
(if (::enabled mdata)
|
||||
(fn [cfg params]
|
||||
(loop [retry 1]
|
||||
(when (> retry 1)
|
||||
(l/debug :hint "retrying controlled function" :retry retry :name name))
|
||||
(let [res (ex/try (f cfg params))]
|
||||
(if (ex/exception? res)
|
||||
(if (and (matches res) (< retry max-retries))
|
||||
(do
|
||||
(aa/thread-sleep (* 100 retry))
|
||||
(recur (inc retry)))
|
||||
(throw res))
|
||||
res))))
|
||||
f))
|
||||
|
|
@ -1,36 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) UXBOX Labs SL
|
||||
|
||||
(ns app.util.rlimit
|
||||
"Resource usage limits (in other words: semaphores)."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[app.util.services :as sv])
|
||||
(:import
|
||||
java.util.concurrent.Semaphore))
|
||||
|
||||
(defn acquire!
|
||||
[sem]
|
||||
(.acquire ^Semaphore sem))
|
||||
|
||||
(defn release!
|
||||
[sem]
|
||||
(.release ^Semaphore sem))
|
||||
|
||||
(defn wrap-rlimit
|
||||
[_cfg f mdata]
|
||||
(if-let [permits (::permits mdata)]
|
||||
(let [sem (Semaphore. permits)]
|
||||
(l/debug :hint "wrapping rlimit" :handler (::sv/name mdata) :permits permits)
|
||||
(fn [cfg params]
|
||||
(try
|
||||
(acquire! sem)
|
||||
(f cfg params)
|
||||
(finally
|
||||
(release! sem)))))
|
||||
f))
|
||||
|
||||
|
|
@ -27,11 +27,6 @@
|
|||
(declare ws-ping!)
|
||||
(declare ws-send!)
|
||||
|
||||
(defmacro call-mtx
|
||||
[definitions name & args]
|
||||
`(when-let [mtx-fn# (some-> ~definitions ~name ::mtx/fn)]
|
||||
(mtx-fn# ~@args)))
|
||||
|
||||
(def noop (constantly nil))
|
||||
|
||||
(defn handler
|
||||
|
@ -49,7 +44,7 @@
|
|||
([handle-message {:keys [::input-buff-size
|
||||
::output-buff-size
|
||||
::idle-timeout
|
||||
::metrics]
|
||||
metrics]
|
||||
:or {input-buff-size 64
|
||||
output-buff-size 64
|
||||
idle-timeout 30000}
|
||||
|
@ -71,8 +66,8 @@
|
|||
on-terminate
|
||||
(fn [& _args]
|
||||
(when (compare-and-set! terminated false true)
|
||||
(call-mtx metrics :connections {:cmd :dec :by 1})
|
||||
(call-mtx metrics :sessions {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
|
||||
(mtx/run! metrics {:id :websocket-active-connections :dec 1})
|
||||
(mtx/run! metrics {:id :websocket-session-timing :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
|
||||
|
||||
(a/close! close-ch)
|
||||
(a/close! pong-ch)
|
||||
|
@ -88,7 +83,7 @@
|
|||
|
||||
on-connect
|
||||
(fn [conn]
|
||||
(call-mtx metrics :connections {:cmd :inc :by 1})
|
||||
(mtx/run! metrics {:id :websocket-active-connections :inc 1})
|
||||
|
||||
(let [wsp (atom (assoc options ::conn conn))]
|
||||
;; Handle heartbeat
|
||||
|
@ -102,7 +97,7 @@
|
|||
;; connection
|
||||
(a/go-loop []
|
||||
(when-let [val (a/<! output-ch)]
|
||||
(call-mtx metrics :messages {:labels ["send"]})
|
||||
(mtx/run! metrics {:id :websocket-messages-total :labels ["send"] :inc 1})
|
||||
(a/<! (ws-send! conn (t/encode-str val)))
|
||||
(recur)))
|
||||
|
||||
|
@ -111,7 +106,7 @@
|
|||
|
||||
on-message
|
||||
(fn [_ message]
|
||||
(call-mtx metrics :messages {:labels ["recv"]})
|
||||
(mtx/run! metrics {:id :websocket-messages-total :labels ["send"] :inc 1})
|
||||
(try
|
||||
(let [message (t/decode-str message)]
|
||||
(a/offer! input-ch message))
|
||||
|
|
|
@ -22,37 +22,83 @@
|
|||
[integrant.core :as ig]
|
||||
[promesa.exec :as px])
|
||||
(:import
|
||||
org.eclipse.jetty.util.thread.QueuedThreadPool
|
||||
java.util.concurrent.ExecutorService
|
||||
java.util.concurrent.Executors
|
||||
java.util.concurrent.Executor))
|
||||
java.util.concurrent.ForkJoinPool
|
||||
java.util.concurrent.ForkJoinWorkerThread
|
||||
java.util.concurrent.ForkJoinPool$ForkJoinWorkerThreadFactory
|
||||
java.util.concurrent.atomic.AtomicLong
|
||||
java.util.concurrent.Executors))
|
||||
|
||||
(s/def ::executor #(instance? Executor %))
|
||||
(set! *warn-on-reflection* true)
|
||||
|
||||
(s/def ::executor #(instance? ExecutorService %))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Executor
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(s/def ::name keyword?)
|
||||
(s/def ::prefix keyword?)
|
||||
(s/def ::parallelism ::us/integer)
|
||||
(s/def ::min-threads ::us/integer)
|
||||
(s/def ::max-threads ::us/integer)
|
||||
(s/def ::idle-timeout ::us/integer)
|
||||
|
||||
(defmethod ig/pre-init-spec ::executor [_]
|
||||
(s/keys :req-un [::min-threads ::max-threads ::idle-timeout ::name]))
|
||||
(s/keys :req-un [::prefix ::parallelism]))
|
||||
|
||||
(defn- get-thread-factory
|
||||
^ForkJoinPool$ForkJoinWorkerThreadFactory
|
||||
[prefix counter]
|
||||
(reify ForkJoinPool$ForkJoinWorkerThreadFactory
|
||||
(newThread [_ pool]
|
||||
(let [^ForkJoinWorkerThread thread (.newThread ForkJoinPool/defaultForkJoinWorkerThreadFactory pool)
|
||||
^String thread-name (str (name prefix) "-" (.getAndIncrement ^AtomicLong counter))]
|
||||
(.setName thread thread-name)
|
||||
thread))))
|
||||
|
||||
(defmethod ig/init-key ::executor
|
||||
[_ {:keys [min-threads max-threads idle-timeout name]}]
|
||||
(doto (QueuedThreadPool. (int max-threads)
|
||||
(int min-threads)
|
||||
(int idle-timeout))
|
||||
(.setStopTimeout 500)
|
||||
(.setName (d/name name))
|
||||
(.start)))
|
||||
[_ {:keys [parallelism prefix]}]
|
||||
(let [counter (AtomicLong. 0)]
|
||||
(ForkJoinPool. (int parallelism) (get-thread-factory prefix counter) nil false)))
|
||||
|
||||
(defmethod ig/halt-key! ::executor
|
||||
[_ instance]
|
||||
(.stop ^QueuedThreadPool instance))
|
||||
(.shutdown ^ForkJoinPool instance))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Executor Monitor
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(s/def ::executors (s/map-of keyword? ::executor))
|
||||
|
||||
(defmethod ig/pre-init-spec ::executors-monitor [_]
|
||||
(s/keys :req-un [::executors ::mtx/metrics]))
|
||||
|
||||
(defmethod ig/init-key ::executors-monitor
|
||||
[_ {:keys [executors metrics interval] :or {interval 2500}}]
|
||||
(letfn [(log-stats [scheduler]
|
||||
(doseq [[key ^ForkJoinPool executor] executors]
|
||||
(let [labels (into-array String [(name key)])]
|
||||
(mtx/run! metrics {:id :executors-active-threads
|
||||
:labels labels
|
||||
:val (.getPoolSize executor)})
|
||||
(mtx/run! metrics {:id :executors-running-threads
|
||||
:labels labels
|
||||
:val (.getRunningThreadCount executor)})
|
||||
(mtx/run! metrics {:id :executors-queued-submissions
|
||||
:labels labels
|
||||
:val (.getQueuedSubmissionCount executor)})))
|
||||
|
||||
(when-not (.isShutdown scheduler)
|
||||
(px/schedule! scheduler interval (partial log-stats scheduler))))]
|
||||
|
||||
(let [scheduler (px/scheduled-pool 1)]
|
||||
(px/schedule! scheduler interval (partial log-stats scheduler))
|
||||
scheduler)))
|
||||
|
||||
(defmethod ig/halt-key! ::executors-monitor
|
||||
[_ instance]
|
||||
(.shutdown ^ExecutorService instance))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Worker
|
||||
|
@ -60,7 +106,6 @@
|
|||
|
||||
(declare event-loop-fn)
|
||||
(declare event-loop)
|
||||
(declare instrument-tasks)
|
||||
|
||||
(s/def ::queue keyword?)
|
||||
(s/def ::parallelism ::us/integer)
|
||||
|
@ -420,11 +465,6 @@
|
|||
(def sql:lock-scheduled-task
|
||||
"select id from scheduled_task where id=? for update skip locked")
|
||||
|
||||
(defn exception->string
|
||||
[error]
|
||||
(with-out-str
|
||||
(.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
|
||||
|
||||
(defn- execute-scheduled-task
|
||||
[{:keys [executor pool] :as cfg} {:keys [id] :as task}]
|
||||
(letfn [(run-task [conn]
|
||||
|
@ -460,59 +500,27 @@
|
|||
|
||||
;; --- INSTRUMENTATION
|
||||
|
||||
(defn instrument!
|
||||
[registry]
|
||||
(mtx/instrument-vars!
|
||||
[#'submit!]
|
||||
{:registry registry
|
||||
:type :counter
|
||||
:labels ["name"]
|
||||
:name "tasks_submit_total"
|
||||
:help "A counter of task submissions."
|
||||
:wrap (fn [rootf mobj]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn [conn params]
|
||||
(let [tname (:name params)]
|
||||
(mobj :inc [tname])
|
||||
(origf conn params)))
|
||||
{::original origf})))})
|
||||
|
||||
(mtx/instrument-vars!
|
||||
[#'app.worker/run-task]
|
||||
{:registry registry
|
||||
:type :summary
|
||||
:quantiles []
|
||||
:name "tasks_checkout_timing"
|
||||
:help "Latency measured between scheduled_at and execution time."
|
||||
:wrap (fn [rootf mobj]
|
||||
(let [mdata (meta rootf)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn [tasks item]
|
||||
(let [now (inst-ms (dt/now))
|
||||
sat (inst-ms (:scheduled-at item))]
|
||||
(mobj :observe (- now sat))
|
||||
(origf tasks item)))
|
||||
{::original origf})))}))
|
||||
|
||||
(defn- wrap-task-handler
|
||||
[metrics tname f]
|
||||
(let [labels (into-array String [tname])]
|
||||
(fn [params]
|
||||
(let [start (System/nanoTime)]
|
||||
(try
|
||||
(f params)
|
||||
(finally
|
||||
(mtx/run! metrics
|
||||
{:id :tasks-timing
|
||||
:val (/ (- (System/nanoTime) start) 1000000)
|
||||
:labels labels})))))))
|
||||
|
||||
(defmethod ig/pre-init-spec ::registry [_]
|
||||
(s/keys :req-un [::mtx/metrics ::tasks]))
|
||||
|
||||
(defmethod ig/init-key ::registry
|
||||
[_ {:keys [metrics tasks]}]
|
||||
(let [mobj (mtx/create
|
||||
{:registry (:registry metrics)
|
||||
:type :summary
|
||||
:labels ["name"]
|
||||
:quantiles []
|
||||
:name "tasks_timing"
|
||||
:help "Background task execution timing."})]
|
||||
(reduce-kv (fn [res k v]
|
||||
(let [tname (name k)]
|
||||
(l/debug :action "register task" :name tname)
|
||||
(assoc res k (mtx/wrap-summary v mobj [tname]))))
|
||||
(l/debug :hint "register task" :name tname)
|
||||
(assoc res k (wrap-task-handler metrics tname v))))
|
||||
{}
|
||||
tasks)))
|
||||
tasks))
|
||||
|
|
|
@ -248,7 +248,7 @@
|
|||
[expr]
|
||||
`(try
|
||||
{:error nil
|
||||
:result ~expr}
|
||||
:result (deref ~expr)}
|
||||
(catch Exception e#
|
||||
{:error (handle-error e#)
|
||||
:result nil})))
|
||||
|
|
|
@ -21,7 +21,7 @@
|
|||
com.cognitect/transit-cljs {:mvn/version "0.8.269"}
|
||||
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
|
||||
|
||||
funcool/promesa {:mvn/version "6.1.431"}
|
||||
funcool/promesa {:mvn/version "7.0.444"}
|
||||
funcool/cuerdas {:mvn/version "2022.01.14-391"}
|
||||
|
||||
lambdaisland/uri {:mvn/version "1.13.95"
|
||||
|
|
|
@ -37,6 +37,22 @@
|
|||
#?(:cljs (instance? lks/LinkedSet o)
|
||||
:clj (instance? LinkedSet o)))
|
||||
|
||||
#?(:clj
|
||||
(defmethod print-method clojure.lang.PersistentQueue [q, w]
|
||||
;; Overload the printer for queues so they look like fish
|
||||
(print-method '<- w)
|
||||
(print-method (seq q) w)
|
||||
(print-method '-< w)))
|
||||
|
||||
(defn queue
|
||||
([] #?(:clj clojure.lang.PersistentQueue/EMPTY :cljs #queue []))
|
||||
([a] (into (queue) [a]))
|
||||
([a & more] (into (queue) (cons a more))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Structures Manipulation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn deep-merge
|
||||
([a b]
|
||||
(if (map? a)
|
||||
|
@ -45,10 +61,6 @@
|
|||
([a b & rest]
|
||||
(reduce deep-merge a (cons b rest))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Data Structures Manipulation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn dissoc-in
|
||||
[m [k & ks]]
|
||||
(if ks
|
||||
|
@ -151,7 +163,11 @@
|
|||
"Given a map, return a map removing key-value
|
||||
pairs when value is `nil`."
|
||||
[data]
|
||||
(into {} (remove (comp nil? second) data)))
|
||||
(into {} (remove (comp nil? second)) data))
|
||||
|
||||
(defn without-qualified
|
||||
[data]
|
||||
(into {} (remove (comp qualified-keyword? first)) data))
|
||||
|
||||
(defn without-keys
|
||||
"Return a map without the keys provided
|
||||
|
@ -676,3 +692,4 @@
|
|||
(recur acc (step k))
|
||||
acc)))
|
||||
acc))))))
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue