mirror of
https://github.com/penpot/penpot.git
synced 2025-02-13 10:38:13 -05:00
Andrés Moya
GitHub
commit
4a61eba3b9
30 changed files with 658 additions and 418 deletions
|
|
@ -7,6 +7,7 @@
|
|||
- Add major refactor of internal pubsub/redis code; improves scalability and performance [#640](https://github.com/penpot/penpot/pull/640)
|
||||
- Add optional loki integration [#645](https://github.com/penpot/penpot/pull/645)
|
||||
- Add emailcatcher and ldap test containers to devenv. [#506](https://github.com/penpot/penpot/pull/506)
|
||||
- Add proper http session lifecycle handling.
|
||||
- Add more presets for artboard [#654](https://github.com/penpot/penpot/pull/654)
|
||||
- Bounce & Complaint handling [#635](https://github.com/penpot/penpot/pull/635)
|
||||
- Disable groups interactions when holding "Ctrl" key (deep selection)
|
||||
|
|
@ -21,6 +22,7 @@
|
|||
- Fix corner cases on invitation/signup flows.
|
||||
- Fix problem width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
|
||||
- Fix problem with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
|
||||
- Fix infinite recursion on logout.
|
||||
- Have language change notification written in the new language [Taiga #1205](https://tree.taiga.io/project/penpot/issue/1205)
|
||||
- Properly handle errors on github, gitlab and ldap auth backends.
|
||||
- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider).
|
||||
|
|
|
|||
|
|
@ -237,6 +237,6 @@
|
|||
(try
|
||||
(run-in-system system preset)
|
||||
(catch Exception e
|
||||
(log/errorf e "Unhandled exception."))
|
||||
(log/errorf e "unhandled exception"))
|
||||
(finally
|
||||
(ig/halt! system)))))
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
||||
|
||||
(ns app.config
|
||||
"A configuration management."
|
||||
|
|
@ -80,92 +80,78 @@
|
|||
;; :initial-data-project-name "Penpot Oboarding"
|
||||
})
|
||||
|
||||
(s/def ::http-server-port ::us/integer)
|
||||
|
||||
(s/def ::host ::us/string)
|
||||
(s/def ::tenant ::us/string)
|
||||
|
||||
(s/def ::database-username (s/nilable ::us/string))
|
||||
(s/def ::allow-demo-users ::us/boolean)
|
||||
(s/def ::asserts-enabled ::us/boolean)
|
||||
(s/def ::assets-path ::us/string)
|
||||
(s/def ::database-password (s/nilable ::us/string))
|
||||
(s/def ::database-uri ::us/string)
|
||||
(s/def ::redis-uri ::us/string)
|
||||
|
||||
(s/def ::loggers-loki-uri ::us/string)
|
||||
(s/def ::loggers-zmq-uri ::us/string)
|
||||
|
||||
(s/def ::storage-backend ::us/keyword)
|
||||
(s/def ::storage-fs-directory ::us/string)
|
||||
(s/def ::assets-path ::us/string)
|
||||
(s/def ::storage-s3-region ::us/keyword)
|
||||
(s/def ::storage-s3-bucket ::us/string)
|
||||
|
||||
(s/def ::media-uri ::us/string)
|
||||
(s/def ::media-directory ::us/string)
|
||||
(s/def ::asserts-enabled ::us/boolean)
|
||||
|
||||
(s/def ::feedback-enabled ::us/boolean)
|
||||
(s/def ::feedback-destination ::us/string)
|
||||
|
||||
(s/def ::profile-complaint-max-age ::dt/duration)
|
||||
(s/def ::profile-complaint-threshold ::us/integer)
|
||||
(s/def ::profile-bounce-max-age ::dt/duration)
|
||||
(s/def ::profile-bounce-threshold ::us/integer)
|
||||
|
||||
(s/def ::database-username (s/nilable ::us/string))
|
||||
(s/def ::default-blob-version ::us/integer)
|
||||
(s/def ::error-report-webhook ::us/string)
|
||||
|
||||
(s/def ::smtp-enabled ::us/boolean)
|
||||
(s/def ::smtp-default-reply-to ::us/string)
|
||||
(s/def ::smtp-default-from ::us/string)
|
||||
(s/def ::smtp-host ::us/string)
|
||||
(s/def ::smtp-port ::us/integer)
|
||||
(s/def ::smtp-username (s/nilable ::us/string))
|
||||
(s/def ::smtp-password (s/nilable ::us/string))
|
||||
(s/def ::smtp-tls ::us/boolean)
|
||||
(s/def ::smtp-ssl ::us/boolean)
|
||||
(s/def ::allow-demo-users ::us/boolean)
|
||||
(s/def ::registration-enabled ::us/boolean)
|
||||
(s/def ::registration-domain-whitelist ::us/string)
|
||||
(s/def ::public-uri ::us/string)
|
||||
|
||||
(s/def ::srepl-host ::us/string)
|
||||
(s/def ::srepl-port ::us/integer)
|
||||
|
||||
(s/def ::rlimits-password ::us/integer)
|
||||
(s/def ::rlimits-image ::us/integer)
|
||||
|
||||
(s/def ::google-client-id ::us/string)
|
||||
(s/def ::google-client-secret ::us/string)
|
||||
|
||||
(s/def ::gitlab-client-id ::us/string)
|
||||
(s/def ::gitlab-client-secret ::us/string)
|
||||
(s/def ::gitlab-base-uri ::us/string)
|
||||
|
||||
(s/def ::feedback-destination ::us/string)
|
||||
(s/def ::feedback-enabled ::us/boolean)
|
||||
(s/def ::github-client-id ::us/string)
|
||||
(s/def ::github-client-secret ::us/string)
|
||||
|
||||
(s/def ::ldap-host ::us/string)
|
||||
(s/def ::ldap-port ::us/integer)
|
||||
(s/def ::ldap-bind-dn ::us/string)
|
||||
(s/def ::ldap-bind-password ::us/string)
|
||||
(s/def ::ldap-ssl ::us/boolean)
|
||||
(s/def ::ldap-starttls ::us/boolean)
|
||||
(s/def ::ldap-base-dn ::us/string)
|
||||
(s/def ::ldap-user-query ::us/string)
|
||||
(s/def ::ldap-attrs-username ::us/string)
|
||||
(s/def ::gitlab-base-uri ::us/string)
|
||||
(s/def ::gitlab-client-id ::us/string)
|
||||
(s/def ::gitlab-client-secret ::us/string)
|
||||
(s/def ::google-client-id ::us/string)
|
||||
(s/def ::google-client-secret ::us/string)
|
||||
(s/def ::host ::us/string)
|
||||
(s/def ::http-server-port ::us/integer)
|
||||
(s/def ::http-session-cookie-name ::us/string)
|
||||
(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)
|
||||
(s/def ::initial-data-file ::us/string)
|
||||
(s/def ::initial-data-project-name ::us/string)
|
||||
(s/def ::ldap-attrs-email ::us/string)
|
||||
(s/def ::ldap-attrs-fullname ::us/string)
|
||||
(s/def ::ldap-attrs-photo ::us/string)
|
||||
|
||||
(s/def ::ldap-attrs-username ::us/string)
|
||||
(s/def ::ldap-base-dn ::us/string)
|
||||
(s/def ::ldap-bind-dn ::us/string)
|
||||
(s/def ::ldap-bind-password ::us/string)
|
||||
(s/def ::ldap-host ::us/string)
|
||||
(s/def ::ldap-port ::us/integer)
|
||||
(s/def ::ldap-ssl ::us/boolean)
|
||||
(s/def ::ldap-starttls ::us/boolean)
|
||||
(s/def ::ldap-user-query ::us/string)
|
||||
(s/def ::loggers-loki-uri ::us/string)
|
||||
(s/def ::loggers-zmq-uri ::us/string)
|
||||
(s/def ::media-directory ::us/string)
|
||||
(s/def ::media-uri ::us/string)
|
||||
(s/def ::profile-bounce-max-age ::dt/duration)
|
||||
(s/def ::profile-bounce-threshold ::us/integer)
|
||||
(s/def ::profile-complaint-max-age ::dt/duration)
|
||||
(s/def ::profile-complaint-threshold ::us/integer)
|
||||
(s/def ::public-uri ::us/string)
|
||||
(s/def ::redis-uri ::us/string)
|
||||
(s/def ::registration-domain-whitelist ::us/string)
|
||||
(s/def ::registration-enabled ::us/boolean)
|
||||
(s/def ::rlimits-image ::us/integer)
|
||||
(s/def ::rlimits-password ::us/integer)
|
||||
(s/def ::smtp-default-from ::us/string)
|
||||
(s/def ::smtp-default-reply-to ::us/string)
|
||||
(s/def ::smtp-enabled ::us/boolean)
|
||||
(s/def ::smtp-host ::us/string)
|
||||
(s/def ::smtp-password (s/nilable ::us/string))
|
||||
(s/def ::smtp-port ::us/integer)
|
||||
(s/def ::smtp-ssl ::us/boolean)
|
||||
(s/def ::smtp-tls ::us/boolean)
|
||||
(s/def ::smtp-username (s/nilable ::us/string))
|
||||
(s/def ::srepl-host ::us/string)
|
||||
(s/def ::srepl-port ::us/integer)
|
||||
(s/def ::storage-backend ::us/keyword)
|
||||
(s/def ::storage-fs-directory ::us/string)
|
||||
(s/def ::storage-s3-bucket ::us/string)
|
||||
(s/def ::storage-s3-region ::us/keyword)
|
||||
(s/def ::telemetry-enabled ::us/boolean)
|
||||
(s/def ::telemetry-with-taiga ::us/boolean)
|
||||
(s/def ::telemetry-uri ::us/string)
|
||||
(s/def ::telemetry-server-enabled ::us/boolean)
|
||||
(s/def ::telemetry-server-port ::us/integer)
|
||||
|
||||
(s/def ::initial-data-file ::us/string)
|
||||
(s/def ::initial-data-project-name ::us/string)
|
||||
|
||||
(s/def ::default-blob-version ::us/integer)
|
||||
(s/def ::telemetry-uri ::us/string)
|
||||
(s/def ::telemetry-with-taiga ::us/boolean)
|
||||
(s/def ::tenant ::us/string)
|
||||
|
||||
(s/def ::config
|
||||
(s/keys :opt-un [::allow-demo-users
|
||||
|
|
@ -185,6 +171,9 @@
|
|||
::google-client-id
|
||||
::google-client-secret
|
||||
::http-server-port
|
||||
::http-session-updater-batch-max-age
|
||||
::http-session-updater-batch-max-size
|
||||
::http-session-idle-max-age
|
||||
::host
|
||||
::ldap-attrs-username
|
||||
::ldap-attrs-email
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@
|
|||
[app.common.geom.point :as gpt]
|
||||
[app.common.spec :as us]
|
||||
[app.db.sql :as sql]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.json :as json]
|
||||
[app.util.migrations :as mg]
|
||||
[app.util.time :as dt]
|
||||
|
|
@ -45,19 +46,21 @@
|
|||
;; Initialization
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare instrument-jdbc!)
|
||||
|
||||
(s/def ::uri ::us/not-empty-string)
|
||||
(s/def ::name ::us/not-empty-string)
|
||||
(s/def ::min-pool-size ::us/integer)
|
||||
(s/def ::max-pool-size ::us/integer)
|
||||
(s/def ::migrations map?)
|
||||
(s/def ::metrics map?)
|
||||
|
||||
(defmethod ig/pre-init-spec ::pool [_]
|
||||
(s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations]))
|
||||
(s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations ::mtx/metrics]))
|
||||
|
||||
(defmethod ig/init-key ::pool
|
||||
[_ {:keys [migrations] :as cfg}]
|
||||
(log/debugf "initialize connection pool %s with uri %s" (:name cfg) (:uri cfg))
|
||||
[_ {:keys [migrations metrics] :as cfg}]
|
||||
(log/infof "initialize connection pool '%s' with uri '%s'" (:name cfg) (:uri cfg))
|
||||
(instrument-jdbc! (:registry metrics))
|
||||
(let [pool (create-pool cfg)]
|
||||
(when (seq migrations)
|
||||
(with-open [conn ^AutoCloseable (open pool)]
|
||||
|
|
@ -70,12 +73,22 @@
|
|||
[_ 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_count"
|
||||
:help "An absolute counter of database queries."}))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; API & Impl
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def initsql
|
||||
(str "SET statement_timeout = 60000;\n"
|
||||
(str "SET statement_timeout = 120000;\n"
|
||||
"SET idle_in_transaction_session_timeout = 120000;"))
|
||||
|
||||
(defn- create-datasource-config
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@
|
|||
(= mtype "SubscriptionConfirmation")
|
||||
(let [surl (get body "SubscribeURL")
|
||||
stopic (get body "TopicArn")]
|
||||
(log/infof "Subscription received (topic=%s, url=%s)" stopic surl)
|
||||
(log/infof "subscription received (topic=%s, url=%s)" stopic surl)
|
||||
(http/send! {:uri surl :method :post :timeout 10000}))
|
||||
|
||||
(= mtype "Notification")
|
||||
|
|
@ -52,7 +52,7 @@
|
|||
(process-report cfg notification)))
|
||||
|
||||
:else
|
||||
(log/warn (str "Unexpected data received.\n"
|
||||
(log/warn (str "unexpected data received\n"
|
||||
(pprint-report body))))
|
||||
|
||||
{:status 200 :body ""})))
|
||||
|
|
@ -184,14 +184,14 @@
|
|||
|
||||
(defn- process-report
|
||||
[cfg {:keys [type profile-id] :as report}]
|
||||
(log/debug (str "Procesing report:\n" (pprint-report report)))
|
||||
(log/debug (str "procesing report:\n" (pprint-report report)))
|
||||
(cond
|
||||
;; In this case we receive a bounce/complaint notification without
|
||||
;; confirmed identity, we just emit a warning but do nothing about
|
||||
;; it because this is not a normal case. All notifications should
|
||||
;; come with profile identity.
|
||||
(nil? profile-id)
|
||||
(log/warn (str "A notification without identity recevied from AWS\n"
|
||||
(log/warn (str "a notification without identity recevied from AWS\n"
|
||||
(pprint-report report)))
|
||||
|
||||
(= "bounce" type)
|
||||
|
|
@ -201,7 +201,7 @@
|
|||
(register-complaint-for-profile cfg report)
|
||||
|
||||
:else
|
||||
(log/warn (str "Unrecognized report received from AWS\n"
|
||||
(log/warn (str "unrecognized report received from AWS\n"
|
||||
(pprint-report report)))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@
|
|||
(let [edata (ex-data error)
|
||||
cdata (get-error-context request error)]
|
||||
(update-thread-context! cdata)
|
||||
(log/errorf error "Internal error: assertion (id: %s)" (str (:id cdata)))
|
||||
(log/errorf error "internal error: assertion (id: %s)" (str (:id cdata)))
|
||||
{:status 500
|
||||
:body {:type :server-error
|
||||
:data (-> edata
|
||||
|
|
@ -88,7 +88,7 @@
|
|||
[error request]
|
||||
(let [cdata (get-error-context request error)]
|
||||
(update-thread-context! cdata)
|
||||
(log/errorf error "Internal error: %s (id: %s)"
|
||||
(log/errorf error "internal error: %s (id: %s)"
|
||||
(ex-message error)
|
||||
(str (:id cdata)))
|
||||
{:status 500
|
||||
|
|
|
|||
|
|
@ -9,11 +9,20 @@
|
|||
|
||||
(ns app.http.session
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.config :as cfg]
|
||||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.async :as aa]
|
||||
[app.util.log4j :refer [update-thread-context!]]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.nonce :as bn]
|
||||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
;; --- IMPL
|
||||
|
|
@ -42,8 +51,7 @@
|
|||
(defn- retrieve
|
||||
[{:keys [conn] :as cfg} token]
|
||||
(when token
|
||||
(-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
|
||||
(:profile-id))))
|
||||
(db/exec-one! conn ["select id, profile_id from http_session where id = ?" token])))
|
||||
|
||||
(defn- retrieve-from-request
|
||||
[{:keys [cookie-name] :as cfg} {:keys [cookies] :as request}]
|
||||
|
|
@ -57,24 +65,33 @@
|
|||
(defn- middleware
|
||||
[cfg handler]
|
||||
(fn [request]
|
||||
(if-let [profile-id (retrieve-from-request cfg request)]
|
||||
(do
|
||||
(if-let [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
|
||||
(let [ech (::events-ch cfg)]
|
||||
(a/>!! ech id)
|
||||
(update-thread-context! {:profile-id profile-id})
|
||||
(handler (assoc request :profile-id profile-id)))
|
||||
(handler request))))
|
||||
|
||||
;; --- STATE INIT
|
||||
;; --- STATE INIT: SESSION
|
||||
|
||||
(s/def ::cookie-name ::cfg/http-session-cookie-name)
|
||||
|
||||
(defmethod ig/pre-init-spec ::session [_]
|
||||
(s/keys :req-un [::db/pool]))
|
||||
(s/keys :req-un [::db/pool]
|
||||
:opt-un [::cookie-name]))
|
||||
|
||||
(defmethod ig/prep-key ::session
|
||||
[_ cfg]
|
||||
(merge {:cookie-name "auth-token"} cfg))
|
||||
(merge {:cookie-name "auth-token"
|
||||
:buffer-size 64}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::session
|
||||
[_ {:keys [pool] :as cfg}]
|
||||
(let [cfg (assoc cfg :conn pool)]
|
||||
(let [events (a/chan (a/dropping-buffer (:buffer-size cfg)))
|
||||
cfg (assoc cfg
|
||||
:conn pool
|
||||
::events-ch events)]
|
||||
(-> cfg
|
||||
(assoc :middleware #(middleware cfg %))
|
||||
(assoc :create (fn [profile-id]
|
||||
|
|
@ -89,3 +106,113 @@
|
|||
:body ""
|
||||
:cookies (cookies cfg {:value "" :max-age -1})))))))
|
||||
|
||||
(defmethod ig/halt-key! ::session
|
||||
[_ data]
|
||||
(a/close! (::events-ch data)))
|
||||
|
||||
;; --- STATE INIT: SESSION UPDATER
|
||||
|
||||
(declare batch-events)
|
||||
(declare update-sessions)
|
||||
|
||||
(s/def ::session map?)
|
||||
(s/def ::max-batch-age ::cfg/http-session-updater-batch-max-age)
|
||||
(s/def ::max-batch-size ::cfg/http-session-updater-batch-max-size)
|
||||
|
||||
(defmethod ig/pre-init-spec ::updater [_]
|
||||
(s/keys :req-un [::db/pool ::wrk/executor ::mtx/metrics ::session]
|
||||
:opt-un [::max-batch-age
|
||||
::max-batch-size]))
|
||||
|
||||
(defmethod ig/prep-key ::updater
|
||||
[_ cfg]
|
||||
(merge {:max-batch-age (dt/duration {:minutes 5})
|
||||
:max-batch-size 200}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::updater
|
||||
[_ {:keys [session metrics] :as cfg}]
|
||||
(log/infof "initialize session updater (max-batch-age=%s, max-batch-size=%s)"
|
||||
(str (:max-batch-age cfg))
|
||||
(str (:max-batch-size cfg)))
|
||||
(let [input (batch-events cfg (::events-ch session))
|
||||
mcnt (mtx/create
|
||||
{:name "http_session_updater_count"
|
||||
:help "A counter of session update batch events."
|
||||
:registry (:registry metrics)
|
||||
:type :counter})]
|
||||
(a/go-loop []
|
||||
(when-let [[reason batch] (a/<! input)]
|
||||
(let [result (a/<! (update-sessions cfg batch))]
|
||||
(mcnt :inc)
|
||||
(if (ex/exception? result)
|
||||
(log/error result "updater: unexpected error on update sessions")
|
||||
(log/debugf "updater: updated %s sessions (reason: %s)." result (name reason)))
|
||||
(recur))))))
|
||||
|
||||
(defn- timeout-chan
|
||||
[cfg]
|
||||
(a/timeout (inst-ms (:max-batch-age cfg))))
|
||||
|
||||
(defn- batch-events
|
||||
[cfg in]
|
||||
(let [out (a/chan)]
|
||||
(a/go-loop [tch (timeout-chan cfg)
|
||||
buf #{}]
|
||||
(let [[val port] (a/alts! [tch in])]
|
||||
(cond
|
||||
(identical? port tch)
|
||||
(if (empty? buf)
|
||||
(recur (timeout-chan cfg) buf)
|
||||
(do
|
||||
(a/>! out [:timeout buf])
|
||||
(recur (timeout-chan cfg) #{})))
|
||||
|
||||
(nil? val)
|
||||
(a/close! out)
|
||||
|
||||
(identical? port in)
|
||||
(let [buf (conj buf val)]
|
||||
(if (>= (count buf) (:max-batch-size cfg))
|
||||
(do
|
||||
(a/>! out [:size buf])
|
||||
(recur (timeout-chan cfg) #{}))
|
||||
(recur tch buf))))))
|
||||
out))
|
||||
|
||||
(defn- update-sessions
|
||||
[{:keys [pool executor]} ids]
|
||||
(aa/with-thread executor
|
||||
(db/exec-one! pool ["update http_session set updated_at=now() where id = ANY(?)"
|
||||
(into-array String ids)])
|
||||
(count ids)))
|
||||
|
||||
;; --- STATE INIT: SESSION GC
|
||||
|
||||
(declare sql:delete-expired)
|
||||
|
||||
(s/def ::max-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::gc-task [_]
|
||||
(s/keys :req-un [::db/pool]
|
||||
:opt-un [::max-age]))
|
||||
|
||||
(defmethod ig/prep-key ::gc-task
|
||||
[_ cfg]
|
||||
(merge {:max-age (dt/duration {:days 2})}
|
||||
(d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::gc-task
|
||||
[_ {:keys [pool max-age] :as cfg}]
|
||||
(fn [_]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! conn [sql:delete-expired interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(log/debugf "gc-task: removed %s rows from http-session table" result)
|
||||
result))))
|
||||
|
||||
(def ^:private
|
||||
sql:delete-expired
|
||||
"delete from http_session
|
||||
where updated_at < now() - ?::interval")
|
||||
|
|
|
|||
|
|
@ -33,13 +33,13 @@
|
|||
(defmethod ig/init-key ::reporter
|
||||
[_ {:keys [receiver uri] :as cfg}]
|
||||
(when uri
|
||||
(log/info "Intializing loki reporter.")
|
||||
(log/info "intializing loki reporter")
|
||||
(let [output (a/chan (a/sliding-buffer 1024))]
|
||||
(receiver :sub output)
|
||||
(a/go-loop []
|
||||
(let [msg (a/<! output)]
|
||||
(if (nil? msg)
|
||||
(log/info "Stoping error reporting loop.")
|
||||
(log/info "stoping error reporting loop")
|
||||
(do
|
||||
(a/<! (handle-event cfg msg))
|
||||
(recur)))))
|
||||
|
|
@ -75,10 +75,10 @@
|
|||
(if (= (:status response) 204)
|
||||
true
|
||||
(do
|
||||
(log/errorf "Error on sending log to loki (try %s).\n%s" i (pr-str response))
|
||||
(log/errorf "error on sending log to loki (try %s)\n%s" i (pr-str response))
|
||||
false)))
|
||||
(catch Exception e
|
||||
(log/errorf e "Error on sending message to loki (try %s)." i)
|
||||
(log/errorf e "error on sending message to loki (try %s)" i)
|
||||
false)))
|
||||
|
||||
(defn- handle-event
|
||||
|
|
|
|||
|
|
@ -43,14 +43,14 @@
|
|||
|
||||
(defmethod ig/init-key ::reporter
|
||||
[_ {:keys [receiver] :as cfg}]
|
||||
(log/info "Intializing mattermost error reporter.")
|
||||
(log/info "intializing mattermost error reporter")
|
||||
(let [output (a/chan (a/sliding-buffer 128)
|
||||
(filter #(= (:level %) "error")))]
|
||||
(receiver :sub output)
|
||||
(a/go-loop []
|
||||
(let [msg (a/<! output)]
|
||||
(if (nil? msg)
|
||||
(log/info "Stoping error reporting loop.")
|
||||
(log/info "stoping error reporting loop")
|
||||
(do
|
||||
(a/<! (handle-event cfg msg))
|
||||
(recur)))))
|
||||
|
|
@ -75,10 +75,10 @@
|
|||
:headers {"content-type" "application/json"}
|
||||
:body (json/encode-str {:text text})})]
|
||||
(when (not= (:status rsp) 200)
|
||||
(log/errorf "Error on sending data to mattermost\n%s" (pr-str rsp))))
|
||||
(log/errorf "error on sending data to mattermost\n%s" (pr-str rsp))))
|
||||
|
||||
(catch Exception e
|
||||
(log/error e "Unexpected exception on error reporter."))))
|
||||
(log/error e "unexpected exception on error reporter"))))
|
||||
|
||||
(defn- persist-on-database!
|
||||
[{:keys [pool] :as cfg} {:keys [id] :as cdata}]
|
||||
|
|
@ -116,7 +116,7 @@
|
|||
(send-mattermost-notification! cfg cdata))
|
||||
(persist-on-database! cfg cdata))
|
||||
(catch Exception e
|
||||
(log/error e "Unexpected exception on error reporter.")))))
|
||||
(log/error e "unexpected exception on error reporter")))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Http Handler
|
||||
|
|
|
|||
|
|
@ -34,7 +34,7 @@
|
|||
|
||||
(defmethod ig/init-key ::receiver
|
||||
[_ {:keys [endpoint] :as cfg}]
|
||||
(log/infof "Intializing ZMQ receiver on '%s'." endpoint)
|
||||
(log/infof "intializing ZMQ receiver on '%s'" endpoint)
|
||||
(let [buffer (a/chan 1)
|
||||
output (a/chan 1 (comp (filter map?)
|
||||
(map prepare)))
|
||||
|
|
|
|||
|
|
@ -37,11 +37,19 @@
|
|||
:max-pool-size 20}
|
||||
|
||||
:app.metrics/metrics
|
||||
{}
|
||||
{:definitions
|
||||
{: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}}}
|
||||
|
||||
:app.migrations/all
|
||||
{:main (ig/ref :app.migrations/migrations)
|
||||
:telemetry (ig/ref :app.telemetry/migrations)}
|
||||
{:main (ig/ref :app.migrations/migrations)
|
||||
:telemetry (ig/ref :app.telemetry/migrations)}
|
||||
|
||||
:app.migrations/migrations
|
||||
{}
|
||||
|
|
@ -69,7 +77,19 @@
|
|||
|
||||
:app.http.session/session
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:cookie-name "auth-token"}
|
||||
:cookie-name (:http-session-cookie-name config)}
|
||||
|
||||
:app.http.session/gc-task
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:max-age (:http-session-idle-max-age config)}
|
||||
|
||||
:app.http.session/updater
|
||||
{:pool (ig/ref :app.db/pool)
|
||||
:metrics (ig/ref :app.metrics/metrics)
|
||||
:executor (ig/ref :app.worker/executor)
|
||||
:session (ig/ref :app.http.session/session)
|
||||
:max-batch-age (:http-session-updater-batch-max-age config)
|
||||
:max-batch-size (:http-session-updater-batch-max-size config)}
|
||||
|
||||
:app.http.awsns/handler
|
||||
{:tokens (ig/ref :app.tokens/tokens)
|
||||
|
|
@ -174,46 +194,61 @@
|
|||
:app.worker/worker
|
||||
{:executor (ig/ref :app.worker/executor)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:tasks (ig/ref :app.tasks/all)}
|
||||
:tasks (ig/ref :app.tasks/registry)}
|
||||
|
||||
:app.worker/scheduler
|
||||
{:executor (ig/ref :app.worker/executor)
|
||||
:pool (ig/ref :app.db/pool)
|
||||
:tasks (ig/ref :app.tasks/registry)
|
||||
:schedule
|
||||
[{:id "file-media-gc"
|
||||
:cron #app/cron "0 0 0 */1 * ? *" ;; daily
|
||||
:fn (ig/ref :app.tasks.file-media-gc/handler)}
|
||||
:task :file-media-gc}
|
||||
|
||||
{:id "file-xlog-gc"
|
||||
:cron #app/cron "0 0 */1 * * ?" ;; hourly
|
||||
:fn (ig/ref :app.tasks.file-xlog-gc/handler)}
|
||||
:task :file-xlog-gc}
|
||||
|
||||
{:id "storage-deleted-gc"
|
||||
:cron #app/cron "0 0 1 */1 * ?" ;; daily (1 hour shift)
|
||||
:fn (ig/ref :app.storage/gc-deleted-task)}
|
||||
:task :storage-deleted-gc}
|
||||
|
||||
{:id "storage-touched-gc"
|
||||
:cron #app/cron "0 0 2 */1 * ?" ;; daily (2 hour shift)
|
||||
:fn (ig/ref :app.storage/gc-touched-task)}
|
||||
:task :storage-touched-gc}
|
||||
|
||||
{:id "session-gc"
|
||||
:cron #app/cron "0 0 3 */1 * ?" ;; daily (3 hour shift)
|
||||
:task :session-gc}
|
||||
|
||||
{:id "storage-recheck"
|
||||
:cron #app/cron "0 0 */1 * * ?" ;; hourly
|
||||
:fn (ig/ref :app.storage/recheck-task)}
|
||||
:task :storage-recheck}
|
||||
|
||||
{:id "tasks-gc"
|
||||
:cron #app/cron "0 0 0 */1 * ?" ;; daily
|
||||
:fn (ig/ref :app.tasks.tasks-gc/handler)}
|
||||
:task :tasks-gc}
|
||||
|
||||
(when (:telemetry-enabled config)
|
||||
{:id "telemetry"
|
||||
:cron #app/cron "0 0 */6 * * ?" ;; every 6h
|
||||
:uri (:telemetry-uri config)
|
||||
:fn (ig/ref :app.tasks.telemetry/handler)})]}
|
||||
:task :telemetry})]}
|
||||
|
||||
:app.tasks/all
|
||||
{"sendmail" (ig/ref :app.tasks.sendmail/handler)
|
||||
"delete-object" (ig/ref :app.tasks.delete-object/handler)
|
||||
"delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
|
||||
:app.tasks/registry
|
||||
{:metrics (ig/ref :app.metrics/metrics)
|
||||
:tasks
|
||||
{:sendmail (ig/ref :app.tasks.sendmail/handler)
|
||||
:delete-object (ig/ref :app.tasks.delete-object/handler)
|
||||
:delete-profile (ig/ref :app.tasks.delete-profile/handler)
|
||||
:file-media-gc (ig/ref :app.tasks.file-media-gc/handler)
|
||||
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
|
||||
:storage-deleted-gc (ig/ref :app.storage/gc-deleted-task)
|
||||
:storage-touched-gc (ig/ref :app.storage/gc-touched-task)
|
||||
:storage-recheck (ig/ref :app.storage/recheck-task)
|
||||
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
|
||||
:telemetry (ig/ref :app.tasks.telemetry/handler)
|
||||
:session-gc (ig/ref :app.http.session/gc-task)}}
|
||||
|
||||
:app.tasks.sendmail/handler
|
||||
{:host (:smtp-host config)
|
||||
|
|
@ -335,7 +370,7 @@
|
|||
(-> system-config
|
||||
(ig/prep)
|
||||
(ig/init))))
|
||||
(log/infof "Welcome to penpot! Version: '%s'."
|
||||
(log/infof "welcome to penpot (version: '%s')"
|
||||
(:full cfg/version))))
|
||||
|
||||
(defn stop
|
||||
|
|
|
|||
|
|
@ -10,17 +10,15 @@
|
|||
(ns app.metrics
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.util.time :as dt]
|
||||
[app.worker]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]
|
||||
[next.jdbc :as jdbc])
|
||||
[integrant.core :as ig])
|
||||
(:import
|
||||
io.prometheus.client.CollectorRegistry
|
||||
io.prometheus.client.Counter
|
||||
io.prometheus.client.Gauge
|
||||
io.prometheus.client.Summary
|
||||
io.prometheus.client.Histogram
|
||||
io.prometheus.client.exporter.common.TextFormat
|
||||
io.prometheus.client.hotspot.DefaultExports
|
||||
io.prometheus.client.jetty.JettyStatisticsCollector
|
||||
|
|
@ -30,41 +28,12 @@
|
|||
(declare instrument-vars!)
|
||||
(declare instrument)
|
||||
(declare create-registry)
|
||||
|
||||
(declare create)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Entry Point
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- instrument-jdbc!
|
||||
[registry]
|
||||
(instrument-vars!
|
||||
[#'next.jdbc/execute-one!
|
||||
#'next.jdbc/execute!]
|
||||
{:registry registry
|
||||
:type :counter
|
||||
:name "database_query_counter"
|
||||
:help "An absolute counter of database queries."}))
|
||||
|
||||
(defn- instrument-workers!
|
||||
[registry]
|
||||
(instrument-vars!
|
||||
[#'app.worker/run-task]
|
||||
{:registry registry
|
||||
:type :summary
|
||||
:name "worker_task_checkout_millis"
|
||||
:help "Latency measured between scheduld_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- handler
|
||||
[registry _request]
|
||||
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
|
||||
|
|
@ -73,13 +42,24 @@
|
|||
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
||||
:body (.toString writer)}))
|
||||
|
||||
(s/def ::definitions
|
||||
(s/map-of keyword? map?))
|
||||
|
||||
(defmethod ig/pre-init-spec ::metrics [_]
|
||||
(s/keys :opt-un [::definitions]))
|
||||
|
||||
(defmethod ig/init-key ::metrics
|
||||
[_ _cfg]
|
||||
[_ {:keys [definitions] :as cfg}]
|
||||
(log/infof "Initializing prometheus registry and instrumentation.")
|
||||
(let [registry (create-registry)]
|
||||
(instrument-workers! registry)
|
||||
(instrument-jdbc! registry)
|
||||
(let [registry (create-registry)
|
||||
definitions (reduce-kv (fn [res k v]
|
||||
(->> (assoc v :registry registry)
|
||||
(create)
|
||||
(assoc res k)))
|
||||
{}
|
||||
definitions)]
|
||||
{:handler (partial handler registry)
|
||||
:definitions definitions
|
||||
:registry registry}))
|
||||
|
||||
(s/def ::handler fn?)
|
||||
|
|
@ -87,7 +67,6 @@
|
|||
(s/def ::metrics
|
||||
(s/keys :req-un [::registry ::handler]))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Implementation
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -126,7 +105,7 @@
|
|||
|
||||
(invoke [_ cmd labels]
|
||||
(.. ^Counter instance
|
||||
(labels labels)
|
||||
(labels (into-array String labels))
|
||||
(inc))))))
|
||||
|
||||
(defn make-gauge
|
||||
|
|
@ -150,19 +129,27 @@
|
|||
:dec (.dec ^Gauge instance)))
|
||||
|
||||
(invoke [_ cmd labels]
|
||||
(case cmd
|
||||
:inc (.. ^Gauge instance (labels labels) (inc))
|
||||
:dec (.. ^Gauge instance (labels labels) (dec)))))))
|
||||
(let [labels (into-array String [labels])]
|
||||
(case cmd
|
||||
:inc (.. ^Gauge instance (labels labels) (inc))
|
||||
:dec (.. ^Gauge instance (labels labels) (dec))))))))
|
||||
|
||||
(def default-quantiles
|
||||
[[0.75 0.02]
|
||||
[0.99 0.001]])
|
||||
|
||||
(defn make-summary
|
||||
[{:keys [name help registry reg labels max-age] :or {max-age 3600} :as props}]
|
||||
[{:keys [name help registry reg labels max-age quantiles buckets]
|
||||
:or {max-age 3600 buckets 6 quantiles default-quantiles} :as props}]
|
||||
(let [registry (or registry reg)
|
||||
instance (doto (Summary/build)
|
||||
(.name name)
|
||||
(.help help)
|
||||
(.maxAgeSeconds max-age)
|
||||
(.quantile 0.75 0.02)
|
||||
(.quantile 0.99 0.001))
|
||||
(.help help))
|
||||
_ (when (seq quantiles)
|
||||
(.maxAgeSeconds ^Summary instance max-age)
|
||||
(.ageBuckets ^Summary instance buckets))
|
||||
_ (doseq [[q e] quantiles]
|
||||
(.quantile ^Summary instance q e))
|
||||
_ (when (seq labels)
|
||||
(.labelNames instance (into-array String labels)))
|
||||
instance (.register instance registry)]
|
||||
|
|
@ -176,7 +163,34 @@
|
|||
|
||||
(invoke [_ cmd val labels]
|
||||
(.. ^Summary instance
|
||||
(labels labels)
|
||||
(labels (into-array String labels))
|
||||
(observe val))))))
|
||||
|
||||
(def default-histogram-buckets
|
||||
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
|
||||
|
||||
(defn make-histogram
|
||||
[{:keys [name help registry reg labels buckets]
|
||||
:or {buckets default-histogram-buckets}}]
|
||||
(let [registry (or registry reg)
|
||||
instance (doto (Histogram/build)
|
||||
(.name name)
|
||||
(.help help)
|
||||
(.buckets (into-array Double/TYPE buckets)))
|
||||
_ (when (seq labels)
|
||||
(.labelNames instance (into-array String labels)))
|
||||
instance (.register instance registry)]
|
||||
(reify
|
||||
clojure.lang.IDeref
|
||||
(deref [_] instance)
|
||||
|
||||
clojure.lang.IFn
|
||||
(invoke [_ cmd val]
|
||||
(.observe ^Histogram instance val))
|
||||
|
||||
(invoke [_ cmd val labels]
|
||||
(.. ^Histogram instance
|
||||
(labels (into-array String labels))
|
||||
(observe val))))))
|
||||
|
||||
(defn create
|
||||
|
|
@ -184,7 +198,8 @@
|
|||
(case type
|
||||
:counter (make-counter props)
|
||||
:gauge (make-gauge props)
|
||||
:summary (make-summary props)))
|
||||
:summary (make-summary props)
|
||||
:histogram (make-histogram props)))
|
||||
|
||||
(defn wrap-counter
|
||||
([rootf mobj]
|
||||
|
|
@ -204,7 +219,6 @@
|
|||
(assoc mdata ::original origf))))
|
||||
([rootf mobj labels]
|
||||
(let [mdata (meta rootf)
|
||||
labels (into-array String labels)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
|
|
@ -241,7 +255,6 @@
|
|||
|
||||
([rootf mobj labels]
|
||||
(let [mdata (meta rootf)
|
||||
labels (into-array String labels)
|
||||
origf (::original mdata rootf)]
|
||||
(with-meta
|
||||
(fn
|
||||
|
|
@ -284,6 +297,9 @@
|
|||
(instance? Summary @obj)
|
||||
((or wrap wrap-summary) f obj)
|
||||
|
||||
(instance? Histogram @obj)
|
||||
((or wrap wrap-summary) f obj)
|
||||
|
||||
:else
|
||||
(ex/raise :type :not-implemented))))
|
||||
|
||||
|
|
|
|||
|
|
@ -158,6 +158,8 @@
|
|||
{:name "0048-mod-storage-tables"
|
||||
:fn (mg/resource "app/migrations/sql/0048-mod-storage-tables.sql")}
|
||||
|
||||
{:name "0049-mod-http-session-table"
|
||||
:fn (mg/resource "app/migrations/sql/0049-mod-http-session-table.sql")}
|
||||
])
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
ALTER TABLE http_session
|
||||
ADD COLUMN updated_at timestamptz NULL;
|
||||
|
||||
CREATE INDEX http_session__updated_at__idx
|
||||
ON http_session (updated_at)
|
||||
WHERE updated_at IS NOT NULL;
|
||||
|
|
@ -14,6 +14,7 @@
|
|||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.async :as aa]
|
||||
[app.util.time :as dt]
|
||||
[app.util.transit :as t]
|
||||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s]
|
||||
|
|
@ -46,29 +47,32 @@
|
|||
|
||||
mtx-active-connections
|
||||
(mtx/create
|
||||
{:name "websocket_notifications_active_connections"
|
||||
{:name "websocket_active_connections"
|
||||
:registry (:registry metrics)
|
||||
:type :gauge
|
||||
:help "Active websocket connections on notifications service."})
|
||||
:help "Active websocket connections."})
|
||||
|
||||
mtx-message-recv
|
||||
mtx-messages
|
||||
(mtx/create
|
||||
{:name "websocket_notifications_message_recv_timing"
|
||||
{:name "websocket_message_count"
|
||||
:registry (:registry metrics)
|
||||
:type :summary
|
||||
:help "Message receive summary timing (ms)."})
|
||||
:labels ["op"]
|
||||
:type :counter
|
||||
:help "Counter of processed messages."})
|
||||
|
||||
mtx-message-send
|
||||
mtx-sessions
|
||||
(mtx/create
|
||||
{:name "websocket_notifications_message_send_timing"
|
||||
{:name "websocket_session_timing"
|
||||
:registry (:registry metrics)
|
||||
:type :summary
|
||||
:help "Message receive summary timing (ms)."})
|
||||
:quantiles []
|
||||
:help "Websocket session timing (seconds)."
|
||||
:type :summary})
|
||||
|
||||
cfg (assoc cfg
|
||||
:mtx-active-connections mtx-active-connections
|
||||
:mtx-message-recv mtx-message-recv
|
||||
:mtx-message-send mtx-message-send)]
|
||||
:mtx-messages mtx-messages
|
||||
:mtx-sessions mtx-sessions
|
||||
)]
|
||||
(-> #(handler cfg %)
|
||||
(wrap-session)
|
||||
(wrap-keyword-params)
|
||||
|
|
@ -130,16 +134,17 @@
|
|||
|
||||
(defn websocket
|
||||
[{:keys [file-id team-id msgbus] :as cfg}]
|
||||
(let [in (a/chan 32)
|
||||
out (a/chan 32)
|
||||
mtx-active-connections (:mtx-active-connections cfg)
|
||||
mtx-message-send (:mtx-message-send cfg)
|
||||
mtx-message-recv (:mtx-message-recv cfg)
|
||||
(let [in (a/chan 32)
|
||||
out (a/chan 32)
|
||||
mtx-aconn (:mtx-active-connections cfg)
|
||||
mtx-messages (:mtx-messages cfg)
|
||||
mtx-sessions (:mtx-sessions cfg)
|
||||
created-at (dt/now)
|
||||
|
||||
ws-send (mtx/wrap-summary ws-send mtx-message-send)]
|
||||
ws-send (mtx/wrap-counter ws-send mtx-messages ["send"])]
|
||||
|
||||
(letfn [(on-connect [conn]
|
||||
(mtx-active-connections :inc)
|
||||
(mtx-aconn :inc)
|
||||
(let [sub (a/chan)
|
||||
ws (WebSocket. conn in out sub nil cfg)]
|
||||
|
||||
|
|
@ -159,11 +164,14 @@
|
|||
(a/close! sub))))
|
||||
|
||||
(on-error [_conn _e]
|
||||
(mtx-aconn :dec)
|
||||
(mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
|
||||
(a/close! out)
|
||||
(a/close! in))
|
||||
|
||||
(on-close [_conn _status _reason]
|
||||
(mtx-active-connections :dec)
|
||||
(mtx-aconn :dec)
|
||||
(mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
|
||||
(a/close! out)
|
||||
(a/close! in))
|
||||
|
||||
|
|
@ -174,7 +182,7 @@
|
|||
{:on-connect on-connect
|
||||
:on-error on-error
|
||||
:on-close on-close
|
||||
:on-text (mtx/wrap-summary on-message mtx-message-recv)
|
||||
:on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
|
||||
:on-bytes (constantly nil)})))
|
||||
|
||||
(declare handle-message)
|
||||
|
|
@ -188,7 +196,7 @@
|
|||
(aa/<? (start-loop! ws))
|
||||
(aa/<? (handle-message ws {:type :disconnect}))
|
||||
(catch Throwable err
|
||||
(log/errorf err "Unexpected exception on websocket handler.")
|
||||
(log/errorf err "unexpected exception on websocket handler")
|
||||
(let [session (.getSession ^WebSocketAdapter conn)]
|
||||
(when session
|
||||
(.disconnect session)))))))
|
||||
|
|
|
|||
|
|
@ -25,6 +25,11 @@
|
|||
[_]
|
||||
(ex/raise :type :not-found))
|
||||
|
||||
(defn- run-hook
|
||||
[hook-fn response]
|
||||
(ex/ignoring (hook-fn))
|
||||
response)
|
||||
|
||||
(defn- rpc-query-handler
|
||||
[methods {:keys [profile-id] :as request}]
|
||||
(let [type (keyword (get-in request [:path-params :type]))
|
||||
|
|
@ -50,7 +55,11 @@
|
|||
result ((get methods type default-handler) data)
|
||||
mdata (meta result)]
|
||||
(cond->> {:status 200 :body result}
|
||||
(fn? (:transform-response mdata)) ((:transform-response mdata) request))))
|
||||
(fn? (:transform-response mdata))
|
||||
((:transform-response mdata) request)
|
||||
|
||||
(fn? (:before-complete mdata))
|
||||
(run-hook (:before-complete mdata)))))
|
||||
|
||||
(defn- wrap-with-metrics
|
||||
[cfg f mdata]
|
||||
|
|
@ -66,7 +75,7 @@
|
|||
(ex/raise :type :internal
|
||||
:code :rlimit-not-configured
|
||||
:hint (str/fmt "%s rlimit not configured" key)))
|
||||
(log/tracef "Adding rlimit to '%s' rpc handler." (::sv/name mdata))
|
||||
(log/tracef "adding rlimit to '%s' rpc handler" (::sv/name mdata))
|
||||
(fn [cfg params]
|
||||
(rlm/execute rlinst (f cfg params))))
|
||||
f))
|
||||
|
|
@ -76,7 +85,7 @@
|
|||
(let [f (wrap-with-rlimits cfg f mdata)
|
||||
f (wrap-with-metrics cfg f mdata)
|
||||
spec (or (::sv/spec mdata) (s/spec any?))]
|
||||
(log/tracef "Registering '%s' command to rpc service." (::sv/name mdata))
|
||||
(log/tracef "registering '%s' command to rpc service" (::sv/name mdata))
|
||||
(fn [params]
|
||||
(when (and (:auth mdata true) (not (uuid? (:profile-id params))))
|
||||
(ex/raise :type :authentication
|
||||
|
|
@ -96,7 +105,7 @@
|
|||
{:name "rpc_query_timing"
|
||||
:labels ["name"]
|
||||
:registry (get-in cfg [:metrics :registry])
|
||||
:type :summary
|
||||
:type :histogram
|
||||
:help "Timing of query services."})
|
||||
cfg (assoc cfg ::mobj mobj)]
|
||||
(->> (sv/scan-ns 'app.rpc.queries.projects
|
||||
|
|
@ -115,7 +124,7 @@
|
|||
{:name "rpc_mutation_timing"
|
||||
:labels ["name"]
|
||||
:registry (get-in cfg [:metrics :registry])
|
||||
:type :summary
|
||||
:type :histogram
|
||||
:help "Timing of mutation services."})
|
||||
cfg (assoc cfg ::mobj mobj)]
|
||||
(->> (sv/scan-ns 'app.rpc.mutations.demo
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
(try
|
||||
(ldap/connect params)
|
||||
(catch Exception e
|
||||
(log/errorf e "Cannot connect to LDAP %s:%s"
|
||||
(log/errorf e "cannot connect to LDAP %s:%s"
|
||||
(get-in params [:host :address])
|
||||
(get-in params [:host :port])))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -26,7 +26,6 @@
|
|||
[app.util.time :as dt]
|
||||
[buddy.hashers :as hashers]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
;; --- Helpers & Specs
|
||||
|
|
@ -42,10 +41,12 @@
|
|||
|
||||
;; --- Mutation: Register Profile
|
||||
|
||||
(declare annotate-profile-register)
|
||||
(declare check-profile-existence!)
|
||||
(declare create-profile)
|
||||
(declare create-profile-relations)
|
||||
(declare email-domain-in-whitelist?)
|
||||
(declare register-profile)
|
||||
|
||||
(s/def ::invitation-token ::us/not-empty-string)
|
||||
(s/def ::register-profile
|
||||
|
|
@ -63,48 +64,64 @@
|
|||
:code :email-domain-is-not-allowed))
|
||||
|
||||
(db/with-atomic [conn pool]
|
||||
(check-profile-existence! conn params)
|
||||
(let [profile (->> (create-profile conn params)
|
||||
(create-profile-relations conn))]
|
||||
(create-profile-initial-data conn profile)
|
||||
(let [cfg (assoc cfg :conn conn)]
|
||||
(register-profile cfg params))))
|
||||
|
||||
(if-let [token (:invitation-token params)]
|
||||
;; If invitation token comes in params, this is because the
|
||||
;; user comes from team-invitation process; in this case,
|
||||
;; regenerate token and send back to the user a new invitation
|
||||
;; token (and mark current session as logged).
|
||||
(let [claims (tokens :verify {:token token :iss :team-invitation})
|
||||
claims (assoc claims
|
||||
:member-id (:id profile)
|
||||
:member-email (:email profile))
|
||||
token (tokens :generate claims)]
|
||||
(with-meta
|
||||
{:invitation-token token}
|
||||
{:transform-response ((:create session) (:id profile))}))
|
||||
(defn- annotate-profile-register
|
||||
"A helper for properly increase the profile-register metric once the
|
||||
transaction is completed."
|
||||
[metrics profile]
|
||||
(fn []
|
||||
(when (::created profile)
|
||||
((get-in metrics [:definitions :profile-register]) :inc))))
|
||||
|
||||
;; If no token is provided, send a verification email
|
||||
(let [vtoken (tokens :generate
|
||||
{:iss :verify-email
|
||||
:exp (dt/in-future "48h")
|
||||
:profile-id (:id profile)
|
||||
:email (:email profile)})
|
||||
ptoken (tokens :generate-predefined
|
||||
{:iss :profile-identity
|
||||
:profile-id (:id profile)})]
|
||||
(defn- register-profile
|
||||
[{:keys [conn tokens session metrics] :as cfg} params]
|
||||
(check-profile-existence! conn params)
|
||||
(let [profile (->> (create-profile conn params)
|
||||
(create-profile-relations conn))
|
||||
profile (assoc profile ::created true)]
|
||||
(create-profile-initial-data conn profile)
|
||||
|
||||
;; Don't allow proceed in register page if the email is
|
||||
;; already reported as permanent bounced
|
||||
(when (emails/has-bounce-reports? conn (:email profile))
|
||||
(ex/raise :type :validation
|
||||
:code :email-has-permanent-bounces
|
||||
:hint "looks like the email has one or many bounces reported"))
|
||||
(if-let [token (:invitation-token params)]
|
||||
;; If invitation token comes in params, this is because the
|
||||
;; user comes from team-invitation process; in this case,
|
||||
;; regenerate token and send back to the user a new invitation
|
||||
;; token (and mark current session as logged).
|
||||
(let [claims (tokens :verify {:token token :iss :team-invitation})
|
||||
claims (assoc claims
|
||||
:member-id (:id profile)
|
||||
:member-email (:email profile))
|
||||
token (tokens :generate claims)
|
||||
resp {:invitation-token token}]
|
||||
(with-meta resp
|
||||
{:transform-response ((:create session) (:id profile))
|
||||
:before-complete (annotate-profile-register metrics profile)}))
|
||||
|
||||
(emails/send! conn emails/register
|
||||
{:to (:email profile)
|
||||
:name (:fullname profile)
|
||||
:token vtoken
|
||||
:extra-data ptoken})
|
||||
profile)))))
|
||||
;; If no token is provided, send a verification email
|
||||
(let [vtoken (tokens :generate
|
||||
{:iss :verify-email
|
||||
:exp (dt/in-future "48h")
|
||||
:profile-id (:id profile)
|
||||
:email (:email profile)})
|
||||
ptoken (tokens :generate-predefined
|
||||
{:iss :profile-identity
|
||||
:profile-id (:id profile)})]
|
||||
|
||||
;; Don't allow proceed in register page if the email is
|
||||
;; already reported as permanent bounced
|
||||
(when (emails/has-bounce-reports? conn (:email profile))
|
||||
(ex/raise :type :validation
|
||||
:code :email-has-permanent-bounces
|
||||
:hint "looks like the email has one or many bounces reported"))
|
||||
|
||||
(emails/send! conn emails/register
|
||||
{:to (:email profile)
|
||||
:name (:fullname profile)
|
||||
:token vtoken
|
||||
:extra-data ptoken})
|
||||
(with-meta profile
|
||||
{:before-complete (annotate-profile-register metrics profile)})))))
|
||||
|
||||
(defn email-domain-in-whitelist?
|
||||
"Returns true if email's domain is in the given whitelist or if given
|
||||
|
|
@ -142,8 +159,7 @@
|
|||
[attempt password]
|
||||
(try
|
||||
(hashers/verify attempt password)
|
||||
(catch Exception e
|
||||
(log/warnf e "Error on verify password (only informative, nothing affected to user).")
|
||||
(catch Exception _e
|
||||
{:update false
|
||||
:valid false})))
|
||||
|
||||
|
|
@ -269,10 +285,12 @@
|
|||
(s/keys :req-un [::email ::fullname ::backend]))
|
||||
|
||||
(sv/defmethod ::login-or-register {:auth false}
|
||||
[{:keys [pool] :as cfg} params]
|
||||
[{:keys [pool metrics] :as cfg} params]
|
||||
(db/with-atomic [conn pool]
|
||||
(-> (assoc cfg :conn conn)
|
||||
(login-or-register params))))
|
||||
(let [profile (-> (assoc cfg :conn conn)
|
||||
(login-or-register params))]
|
||||
(with-meta profile
|
||||
{:before-complete (annotate-profile-register metrics profile)}))))
|
||||
|
||||
(defn login-or-register
|
||||
[{:keys [conn] :as cfg} {:keys [email backend] :as params}]
|
||||
|
|
@ -294,7 +312,7 @@
|
|||
(let [profile (->> (create-profile conn params)
|
||||
(create-profile-relations conn))]
|
||||
(create-profile-initial-data conn profile)
|
||||
profile))]
|
||||
(assoc profile ::created true)))]
|
||||
|
||||
(let [profile (profile/retrieve-profile-data-by-email conn email)
|
||||
profile (if profile
|
||||
|
|
|
|||
|
|
@ -40,8 +40,15 @@
|
|||
{:id profile-id})
|
||||
claims)
|
||||
|
||||
(defn- annotate-profile-activation
|
||||
"A helper for properly increase the profile-activation metric once the
|
||||
transaction is completed."
|
||||
[metrics]
|
||||
(fn []
|
||||
((get-in metrics [:definitions :profile-activation]) :inc)))
|
||||
|
||||
(defmethod process-token :verify-email
|
||||
[{:keys [conn session] :as cfg} _params {:keys [profile-id] :as claims}]
|
||||
[{:keys [conn session metrics] :as cfg} _ {:keys [profile-id] :as claims}]
|
||||
(let [profile (profile/retrieve-profile conn profile-id)
|
||||
claims (assoc claims :profile profile)]
|
||||
|
||||
|
|
@ -56,7 +63,8 @@
|
|||
{:id (:id profile)}))
|
||||
|
||||
(with-meta claims
|
||||
{:transform-response ((:create session) profile-id)})))
|
||||
{:transform-response ((:create session) profile-id)
|
||||
:before-complete (annotate-profile-activation metrics)})))
|
||||
|
||||
(defmethod process-token :auth
|
||||
[{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
|
||||
|
|
|
|||
|
|
@ -5,17 +5,19 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
||||
|
||||
(ns app.tasks
|
||||
(:require
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
;; [app.metrics :as mtx]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.time :as dt]
|
||||
[app.worker]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]))
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::delay
|
||||
|
|
@ -41,11 +43,68 @@
|
|||
interval (db/interval duration)
|
||||
props (db/tjson props)
|
||||
id (uuid/next)]
|
||||
(log/infof "Submit task '%s' to be executed in '%s'." name (str duration))
|
||||
(log/debugf "submit task '%s' to be executed in '%s'" name (str duration))
|
||||
(db/exec-one! conn [sql:insert-new-task id name props queue priority max-retries interval])
|
||||
id))
|
||||
|
||||
;; (mtx/instrument-with-counter!
|
||||
;; {:var #'submit!
|
||||
;; :id "tasks__submit_counter"
|
||||
;; :help "Absolute task submit counter."})
|
||||
(defn- instrument!
|
||||
[registry]
|
||||
(mtx/instrument-vars!
|
||||
[#'submit!]
|
||||
{:registry registry
|
||||
:type :counter
|
||||
:labels ["name"]
|
||||
:name "tasks_submit_counter"
|
||||
:help "An absolute 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 scheduld_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})))}))
|
||||
|
||||
;; --- STATE INIT: REGISTRY
|
||||
|
||||
(s/def ::tasks
|
||||
(s/map-of keyword? fn?))
|
||||
|
||||
(defmethod ig/pre-init-spec ::registry [_]
|
||||
(s/keys :req-un [::mtx/metrics ::tasks]))
|
||||
|
||||
(defmethod ig/init-key ::registry
|
||||
[_ {:keys [metrics tasks]}]
|
||||
(instrument! (:registry metrics))
|
||||
(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)]
|
||||
(log/debugf "registring task '%s'" tname)
|
||||
(assoc res tname (mtx/wrap-summary v mobj [tname]))))
|
||||
{}
|
||||
tasks)))
|
||||
|
|
|
|||
|
|
@ -12,42 +12,32 @@
|
|||
(:require
|
||||
[app.common.spec :as us]
|
||||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare handler)
|
||||
(declare handle-deletion)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::db/pool ::mtx/metrics]))
|
||||
(s/keys :req-un [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_delete_object_timing"
|
||||
:help "delete object task timing"}
|
||||
(mtx/instrument handler))))
|
||||
[_ {:keys [pool] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(us/verify ::props props)
|
||||
(db/with-atomic [conn pool]
|
||||
(handle-deletion conn props))))
|
||||
|
||||
(s/def ::type ::us/keyword)
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::props (s/keys :req-un [::id ::type]))
|
||||
|
||||
(defn- handler
|
||||
[{:keys [pool]} {:keys [props] :as task}]
|
||||
(us/verify ::props props)
|
||||
(db/with-atomic [conn pool]
|
||||
(handle-deletion conn props)))
|
||||
|
||||
(defmulti handle-deletion
|
||||
(fn [_ props] (:type props)))
|
||||
|
||||
(defmethod handle-deletion :default
|
||||
[_conn {:keys [type]}]
|
||||
(log/warnf "no handler found for %s" type))
|
||||
(log/warnf "no handler found for '%s'" type))
|
||||
|
||||
(defmethod handle-deletion :file
|
||||
[conn {:keys [id] :as props}]
|
||||
|
|
|
|||
|
|
@ -13,27 +13,16 @@
|
|||
[app.common.spec :as us]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as sql]
|
||||
[app.metrics :as mtx]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare delete-profile-data)
|
||||
(declare handler)
|
||||
|
||||
;; --- INIT
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::db/pool ::mtx/metrics]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_delete_profile_timing"
|
||||
:help "delete profile task timing"}
|
||||
(mtx/instrument handler))))
|
||||
(s/keys :req-un [::db/pool]))
|
||||
|
||||
;; This task is responsible to permanently delete a profile with all
|
||||
;; the dependent data. As step (1) we delete all owned teams of the
|
||||
|
|
@ -48,16 +37,17 @@
|
|||
(s/def ::profile-id ::us/uuid)
|
||||
(s/def ::props (s/keys :req-un [::profile-id]))
|
||||
|
||||
(defn handler
|
||||
[{:keys [pool]} {:keys [props] :as task}]
|
||||
(us/verify ::props props)
|
||||
(db/with-atomic [conn pool]
|
||||
(let [id (:profile-id props)
|
||||
profile (db/exec-one! conn (sql/select :profile {:id id} {:for-update true}))]
|
||||
(if (or (:is-demo profile)
|
||||
(:deleted-at profile))
|
||||
(delete-profile-data conn id)
|
||||
(log/warnf "Profile %s does not match constraints for deletion" id)))))
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [pool] :as cfg}]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(us/verify ::props props)
|
||||
(db/with-atomic [conn pool]
|
||||
(let [id (:profile-id props)
|
||||
profile (db/exec-one! conn (sql/select :profile {:id id} {:for-update true}))]
|
||||
(if (or (:is-demo profile)
|
||||
(:deleted-at profile))
|
||||
(delete-profile-data conn id)
|
||||
(log/warnf "profile '%s' does not match constraints for deletion" id))))))
|
||||
|
||||
;; --- IMPL
|
||||
|
||||
|
|
@ -80,7 +70,7 @@
|
|||
|
||||
(defn- delete-profile-data
|
||||
[conn profile-id]
|
||||
(log/infof "Proceding to delete all data related to profile id = %s" profile-id)
|
||||
(log/debugf "proceding to delete all data related to profile '%s'" profile-id)
|
||||
(delete-teams conn profile-id)
|
||||
(delete-profile conn profile-id)
|
||||
true)
|
||||
|
|
|
|||
|
|
@ -5,7 +5,7 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
||||
|
||||
(ns app.tasks.file-media-gc
|
||||
"A maintenance task that is responsible to purge the unused media
|
||||
|
|
@ -14,44 +14,34 @@
|
|||
(:require
|
||||
[app.common.pages.migrations :as pmg]
|
||||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare handler)
|
||||
(declare process-file)
|
||||
(declare retrieve-candidates)
|
||||
|
||||
(s/def ::max-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
|
||||
(s/keys :req-un [::db/pool ::max-age]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_file_media_gc_timing"
|
||||
:help "file media garbage collection task timing"}
|
||||
(mtx/instrument handler))))
|
||||
|
||||
(defn- handler
|
||||
[{:keys [pool] :as cfg} _]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [cfg (assoc cfg :conn conn)]
|
||||
(loop [n 0]
|
||||
(let [files (retrieve-candidates cfg)]
|
||||
(if (seq files)
|
||||
(do
|
||||
(run! (partial process-file cfg) files)
|
||||
(recur (+ n (count files))))
|
||||
(do
|
||||
(log/infof "finalized with total of %s processed files" n)
|
||||
{:processed n})))))))
|
||||
[_ {:keys [pool] :as cfg}]
|
||||
(fn [_]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [cfg (assoc cfg :conn conn)]
|
||||
(loop [n 0]
|
||||
(let [files (retrieve-candidates cfg)]
|
||||
(if (seq files)
|
||||
(do
|
||||
(run! (partial process-file cfg) files)
|
||||
(recur (+ n (count files))))
|
||||
(do
|
||||
(log/debugf "finalized with total of %s processed files" n)
|
||||
{:processed n}))))))))
|
||||
|
||||
(def ^:private
|
||||
sql:retrieve-candidates-chunk
|
||||
|
|
@ -98,7 +88,7 @@
|
|||
unused (->> (db/query conn :file-media-object {:file-id id})
|
||||
(remove #(contains? used (:id %))))]
|
||||
|
||||
(log/infof "processing file: id='%s' age='%s' to-delete=%s" id age (count unused))
|
||||
(log/debugf "processing file: id='%s' age='%s' to-delete=%s" id age (count unused))
|
||||
|
||||
;; Mark file as trimmed
|
||||
(db/update! conn :file
|
||||
|
|
|
|||
|
|
@ -5,45 +5,36 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
||||
|
||||
(ns app.tasks.file-xlog-gc
|
||||
"A maintenance task that performs a garbage collection of the file
|
||||
change (transaction) log."
|
||||
(:require
|
||||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare handler)
|
||||
(declare sql:delete-files-xlog)
|
||||
|
||||
(s/def ::max-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
|
||||
(s/keys :req-un [::db/pool ::max-age]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_file_xlog_gc_timing"
|
||||
:help "file changes garbage collection task timing"}
|
||||
(mtx/instrument handler))))
|
||||
[_ {:keys [pool max-age] :as cfg}]
|
||||
(fn [_]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! conn [sql:delete-files-xlog interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(log/debugf "removed %s rows from file-change table" result)
|
||||
result))))
|
||||
|
||||
(def ^:private
|
||||
sql:delete-files-xlog
|
||||
"delete from file_change
|
||||
where created_at < now() - ?::interval")
|
||||
|
||||
(defn- handler
|
||||
[{:keys [pool max-age]} _]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! conn [sql:delete-files-xlog interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(log/infof "removed %s rows from file_change table" result)
|
||||
nil)))
|
||||
|
|
|
|||
|
|
@ -10,13 +10,12 @@
|
|||
(ns app.tasks.sendmail
|
||||
(:require
|
||||
[app.config :as cfg]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.emails :as emails]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare handler)
|
||||
(declare send-console!)
|
||||
|
||||
(s/def ::username ::cfg/smtp-username)
|
||||
(s/def ::password ::cfg/smtp-password)
|
||||
|
|
@ -29,7 +28,7 @@
|
|||
(s/def ::enabled ::cfg/smtp-enabled)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::enabled ::mtx/metrics]
|
||||
(s/keys :req-un [::enabled]
|
||||
:opt-un [::username
|
||||
::password
|
||||
::tls
|
||||
|
|
@ -40,13 +39,11 @@
|
|||
::default-reply-to]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_sendmail_timing"
|
||||
:help "sendmail task timing"}
|
||||
(mtx/instrument handler))))
|
||||
[_ cfg]
|
||||
(fn [{:keys [props] :as task}]
|
||||
(if (:enabled cfg)
|
||||
(emails/send! cfg props)
|
||||
(send-console! cfg props))))
|
||||
|
||||
(defn- send-console!
|
||||
[cfg email]
|
||||
|
|
@ -59,9 +56,3 @@
|
|||
(println (.toString baos))
|
||||
(println "******** end email "(:id email) "**********"))]
|
||||
(log/info out))))
|
||||
|
||||
(defn handler
|
||||
[cfg {:keys [props] :as task}]
|
||||
(if (:enabled cfg)
|
||||
(emails/send! cfg props)
|
||||
(send-console! cfg props)))
|
||||
|
|
|
|||
|
|
@ -5,46 +5,36 @@
|
|||
;; This Source Code Form is "Incompatible With Secondary Licenses", as
|
||||
;; defined by the Mozilla Public License, v. 2.0.
|
||||
;;
|
||||
;; Copyright (c) 2020 UXBOX Labs SL
|
||||
;; Copyright (c) 2020-2021 UXBOX Labs SL
|
||||
|
||||
(ns app.tasks.tasks-gc
|
||||
"A maintenance task that performs a cleanup of already executed tasks
|
||||
from the database table."
|
||||
(:require
|
||||
[app.db :as db]
|
||||
[app.metrics :as mtx]
|
||||
[app.util.time :as dt]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare handler)
|
||||
(declare sql:delete-completed-tasks)
|
||||
|
||||
(s/def ::max-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::handler [_]
|
||||
(s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
|
||||
(s/keys :req-un [::db/pool ::max-age]))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [metrics] :as cfg}]
|
||||
(let [handler #(handler cfg %)]
|
||||
(->> {:registry (:registry metrics)
|
||||
:type :summary
|
||||
:name "task_tasks_gc_timing"
|
||||
:help "tasks garbage collection task timing"}
|
||||
(mtx/instrument handler))))
|
||||
[_ {:keys [pool max-age] :as cfg}]
|
||||
(fn [_]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! conn [sql:delete-completed-tasks interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(log/debugf "removed %s rows from tasks-completed table" result)
|
||||
result))))
|
||||
|
||||
(def ^:private
|
||||
sql:delete-completed-tasks
|
||||
"delete from task_completed
|
||||
where scheduled_at < now() - ?::interval")
|
||||
|
||||
(defn- handler
|
||||
[{:keys [pool max-age]} _]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [interval (db/interval max-age)
|
||||
result (db/exec-one! conn [sql:delete-completed-tasks interval])
|
||||
result (:next.jdbc/update-count result)]
|
||||
(log/infof "removed %s rows from tasks_completed table" result)
|
||||
nil)))
|
||||
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@
|
|||
(catch Exception e
|
||||
;; We don't want notify user of a error, just log it for posible
|
||||
;; future investigation.
|
||||
(log/warn e (str "Unexpected error on telemetry:\n"
|
||||
(log/warn e (str "unexpected error on telemetry:\n"
|
||||
(when-let [edata (ex-data e)]
|
||||
(str "ex-data: \n"
|
||||
(with-out-str (pprint edata))))
|
||||
|
|
@ -118,4 +118,4 @@
|
|||
data
|
||||
data])))
|
||||
(catch Exception e
|
||||
(log/errorf e "Error on procesing request."))))
|
||||
(log/errorf e "error on procesing request"))))
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
(ns app.worker
|
||||
"Async tasks abstraction (impl)."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
|
|
@ -19,6 +20,7 @@
|
|||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.tools.logging :as log]
|
||||
[cuerdas.core :as str]
|
||||
[integrant.core :as ig]
|
||||
[promesa.exec :as px])
|
||||
(:import
|
||||
|
|
@ -72,7 +74,7 @@
|
|||
(s/def ::queue ::us/string)
|
||||
(s/def ::parallelism ::us/integer)
|
||||
(s/def ::batch-size ::us/integer)
|
||||
(s/def ::tasks (s/map-of string? ::us/fn))
|
||||
(s/def ::tasks (s/map-of string? fn?))
|
||||
(s/def ::poll-interval ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::worker [_]
|
||||
|
|
@ -94,7 +96,7 @@
|
|||
|
||||
(defmethod ig/init-key ::worker
|
||||
[_ {:keys [pool poll-interval name queue] :as cfg}]
|
||||
(log/infof "Starting worker '%s' on queue '%s'." name queue)
|
||||
(log/infof "starting worker '%s' on queue '%s'" name queue)
|
||||
(let [cch (a/chan 1)
|
||||
poll-ms (inst-ms poll-interval)]
|
||||
(a/go-loop []
|
||||
|
|
@ -103,30 +105,30 @@
|
|||
;; Terminate the loop if close channel is closed or
|
||||
;; event-loop-fn returns nil.
|
||||
(or (= port cch) (nil? val))
|
||||
(log/infof "Stop condition found. Shutdown worker: '%s'" name)
|
||||
(log/infof "stop condition found; shutdown worker: '%s'" name)
|
||||
|
||||
(db/pool-closed? pool)
|
||||
(do
|
||||
(log/info "Worker eventloop is aborted because pool is closed.")
|
||||
(log/info "worker eventloop is aborted because pool is closed")
|
||||
(a/close! cch))
|
||||
|
||||
(and (instance? java.sql.SQLException val)
|
||||
(contains? #{"08003" "08006" "08001" "08004"} (.getSQLState ^java.sql.SQLException val)))
|
||||
(do
|
||||
(log/error "Connection error, trying resume in some instants.")
|
||||
(log/error "connection error, trying resume in some instants")
|
||||
(a/<! (a/timeout poll-interval))
|
||||
(recur))
|
||||
|
||||
(and (instance? java.sql.SQLException val)
|
||||
(= "40001" (.getSQLState ^java.sql.SQLException val)))
|
||||
(do
|
||||
(log/debug "Serialization failure (retrying in some instants).")
|
||||
(log/debug "serialization failure (retrying in some instants)")
|
||||
(a/<! (a/timeout poll-ms))
|
||||
(recur))
|
||||
|
||||
(instance? Exception val)
|
||||
(do
|
||||
(log/errorf val "Unexpected error ocurried on polling the database (will resume in some instants).")
|
||||
(log/errorf val "unexpected error ocurried on polling the database (will resume in some instants)")
|
||||
(a/<! (a/timeout poll-ms))
|
||||
(recur))
|
||||
|
||||
|
|
@ -202,7 +204,7 @@
|
|||
(let [task-fn (get tasks name)]
|
||||
(if task-fn
|
||||
(task-fn item)
|
||||
(log/warn "no task handler found for" (pr-str name)))
|
||||
(log/warnf "no task handler found for '%s'" (pr-str name)))
|
||||
{:status :completed :task item}))
|
||||
|
||||
(defn get-error-context
|
||||
|
|
@ -227,7 +229,7 @@
|
|||
|
||||
(let [cdata (get-error-context error item)]
|
||||
(update-thread-context! cdata)
|
||||
(log/errorf error "Unhandled exception on task (id: %s)" (:id cdata))
|
||||
(log/errorf error "unhandled exception on task (id: '%s')" (:id cdata))
|
||||
(if (>= (:retry-num item) (:max-retries item))
|
||||
{:status :failed :task item :error error}
|
||||
{:status :retry :task item :error error})))))
|
||||
|
|
@ -235,12 +237,12 @@
|
|||
(defn- run-task
|
||||
[{:keys [tasks]} item]
|
||||
(try
|
||||
(log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))
|
||||
(log/debugf "started task '%s/%s/%s'" (:name item) (:id item) (:retry-num item))
|
||||
(handle-task tasks item)
|
||||
(catch Exception e
|
||||
(handle-exception e item))
|
||||
(finally
|
||||
(log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)))))
|
||||
(log/debugf "finished task '%s/%s/%s'" (:name item) (:id item) (:retry-num item)))))
|
||||
|
||||
(def sql:select-next-tasks
|
||||
"select * from task as t
|
||||
|
|
@ -289,21 +291,31 @@
|
|||
(s/def ::id ::us/string)
|
||||
(s/def ::cron dt/cron?)
|
||||
(s/def ::props (s/nilable map?))
|
||||
(s/def ::task keyword?)
|
||||
|
||||
(s/def ::scheduled-task-spec
|
||||
(s/keys :req-un [::id ::cron ::fn]
|
||||
(s/keys :req-un [::id ::cron ::task]
|
||||
:opt-un [::props]))
|
||||
|
||||
(s/def ::schedule
|
||||
(s/coll-of (s/nilable ::scheduled-task-spec)))
|
||||
(s/def ::schedule (s/coll-of (s/nilable ::scheduled-task-spec)))
|
||||
|
||||
(defmethod ig/pre-init-spec ::scheduler [_]
|
||||
(s/keys :req-un [::executor ::db/pool ::schedule]))
|
||||
(s/keys :req-un [::executor ::db/pool ::schedule ::tasks]))
|
||||
|
||||
(defmethod ig/init-key ::scheduler
|
||||
[_ {:keys [schedule] :as cfg}]
|
||||
[_ {:keys [schedule tasks] :as cfg}]
|
||||
(let [scheduler (Executors/newScheduledThreadPool (int 1))
|
||||
schedule (filter some? schedule)
|
||||
schedule (->> schedule
|
||||
(filter some?)
|
||||
(map (fn [{:keys [task] :as item}]
|
||||
(let [f (get tasks (name task))]
|
||||
(when-not f
|
||||
(ex/raise :type :internal
|
||||
:code :task-not-found
|
||||
:hint (str/fmt "task %s not configured" task)))
|
||||
(-> item
|
||||
(dissoc :task)
|
||||
(assoc :fn f))))))
|
||||
cfg (assoc cfg
|
||||
:scheduler scheduler
|
||||
:schedule schedule)]
|
||||
|
|
@ -330,7 +342,7 @@
|
|||
(defn- synchronize-schedule-item
|
||||
[conn {:keys [id cron]}]
|
||||
(let [cron (str cron)]
|
||||
(log/debugf "initialize scheduled task '%s' (cron: '%s')." id cron)
|
||||
(log/infof "initialize scheduled task '%s' (cron: '%s')" id cron)
|
||||
(db/exec-one! conn [sql:upsert-scheduled-task id cron cron])))
|
||||
|
||||
(defn- synchronize-schedule
|
||||
|
|
@ -351,27 +363,16 @@
|
|||
(letfn [(run-task [conn]
|
||||
(try
|
||||
(when (db/exec-one! conn [sql:lock-scheduled-task id])
|
||||
(log/info "Executing scheduled task" id)
|
||||
(log/debugf "executing scheduled task '%s'" id)
|
||||
((:fn task) task))
|
||||
(catch Exception e
|
||||
(catch Throwable e
|
||||
e)))
|
||||
|
||||
(handle-task* [conn]
|
||||
(let [result (run-task conn)]
|
||||
(if (instance? Throwable result)
|
||||
(do
|
||||
(log/warnf result "unhandled exception on scheduled task '%s'" id)
|
||||
(db/insert! conn :scheduled-task-history
|
||||
{:id (uuid/next)
|
||||
:task-id id
|
||||
:is-error true
|
||||
:reason (exception->string result)}))
|
||||
(db/insert! conn :scheduled-task-history
|
||||
{:id (uuid/next)
|
||||
:task-id id}))))
|
||||
(handle-task []
|
||||
(db/with-atomic [conn pool]
|
||||
(handle-task* conn)))]
|
||||
(let [result (run-task conn)]
|
||||
(when (ex/exception? result)
|
||||
(log/errorf result "unhandled exception on scheduled task '%s'" id)))))]
|
||||
|
||||
(try
|
||||
(px/run! executor handle-task)
|
||||
|
|
|
|||
|
|
@ -52,3 +52,7 @@
|
|||
(defn ex-info?
|
||||
[v]
|
||||
(instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v))
|
||||
|
||||
(defn exception?
|
||||
[v]
|
||||
(instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
|
||||
|
|
|
|||
|
|
@ -90,6 +90,7 @@
|
|||
ptk/WatchEvent
|
||||
(watch [_ state s]
|
||||
(->> (rp/mutation :logout)
|
||||
(rx/catch (constantly (rx/empty)))
|
||||
(rx/ignore)))
|
||||
|
||||
ptk/EffectEvent
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue