3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-07-15 08:45:13 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor loggers/audit, auth/oidc, and http/clent modules

Browse source
This commit is contained in:
Andrey Antukh 2022-11-28 16:48:30 +01:00
parent 7f7efc5760
commit 8bad9d8340
29 changed files with 796 additions and 769 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -7,6 +7,7 @@
(ns app.auth.oidc (ns app.auth.oidc
"OIDC client implementation." "OIDC client implementation."
(:require (:require
[app.auth.oidc.providers :as-alias providers]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
@ -19,6 +20,7 @@
[app.http.middleware :as hmw] [app.http.middleware :as hmw]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.json :as json] [app.util.json :as json]
@ -48,9 +50,11 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- discover-oidc-config (defn- discover-oidc-config
[{:keys [http-client]} {:keys [base-uri] :as opts}] [cfg {:keys [::base-uri] :as opts}]
(let [discovery-uri (u/join base-uri ".well-known/openid-configuration") (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
response (ex/try! (http/req! http-client {:method :get :uri (str discovery-uri)} {:sync? true}))] response (ex/try! (http/req! cfg
{:method :get :uri (str discovery-uri)}
{:sync? true}))]
(cond (cond
(ex/exception? response) (ex/exception? response)
(do (do
@ -74,15 +78,15 @@
(defn- prepare-oidc-opts (defn- prepare-oidc-opts
[cfg] [cfg]
(let [opts {:base-uri (:base-uri cfg) (let [opts {:base-uri (cf/get :oidc-base-uri)
:client-id (:client-id cfg) :client-id (cf/get :oidc-client-id)
:client-secret (:client-secret cfg) :client-secret (cf/get :oidc-client-secret)
:token-uri (:token-uri cfg) :token-uri (cf/get :oidc-token-uri)
:auth-uri (:auth-uri cfg) :auth-uri (cf/get :oidc-auth-uri)
:user-uri (:user-uri cfg) :user-uri (cf/get :oidc-user-uri)
:scopes (:scopes cfg #{"openid" "profile" "email"}) :scopes (cf/get :oidc-scopes #{"openid" "profile" "email"})
:roles-attr (:roles-attr cfg) :roles-attr (cf/get :oidc-roles-attr)
:roles (:roles cfg) :roles (cf/get :oidc-roles)
:name "oidc"} :name "oidc"}
opts (d/without-nils opts)] opts (d/without-nils opts)]
@ -97,13 +101,12 @@
(some-> (discover-oidc-config cfg opts) (some-> (discover-oidc-config cfg opts)
(merge opts {:discover? true})))))) (merge opts {:discover? true}))))))
(defmethod ig/prep-key ::generic-provider (defmethod ig/pre-init-spec ::providers/generic [_]
[_ cfg] (s/keys :req [::http/client]))
(d/without-nils cfg))
(defmethod ig/init-key ::generic-provider (defmethod ig/init-key ::providers/generic
[_ cfg] [_ cfg]
(when (:enabled? cfg) (when (contains? cf/flags :login-with-oidc)
(if-let [opts (prepare-oidc-opts cfg)] (if-let [opts (prepare-oidc-opts cfg)]
(do (do
(l/info :hint "provider initialized" (l/info :hint "provider initialized"
@ -126,21 +129,17 @@
;; GOOGLE AUTH PROVIDER ;; GOOGLE AUTH PROVIDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/prep-key ::google-provider (defmethod ig/init-key ::providers/google
[_ cfg] [_ _]
(d/without-nils cfg)) (let [opts {:client-id (cf/get :google-client-id)
:client-secret (cf/get :google-client-secret)
(defmethod ig/init-key ::google-provider
[_ cfg]
(let [opts {:client-id (:client-id cfg)
:client-secret (:client-secret cfg)
:scopes #{"openid" "email" "profile"} :scopes #{"openid" "email" "profile"}
:auth-uri "https://accounts.google.com/o/oauth2/v2/auth" :auth-uri "https://accounts.google.com/o/oauth2/v2/auth"
:token-uri "https://oauth2.googleapis.com/token" :token-uri "https://oauth2.googleapis.com/token"
:user-uri "https://openidconnect.googleapis.com/v1/userinfo" :user-uri "https://openidconnect.googleapis.com/v1/userinfo"
:name "google"}] :name "google"}]
(when (:enabled? cfg) (when (contains? cf/flags :login-with-google)
(if (and (string? (:client-id opts)) (if (and (string? (:client-id opts))
(string? (:client-secret opts))) (string? (:client-secret opts)))
(do (do
@ -159,13 +158,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- retrieve-github-email (defn- retrieve-github-email
[{:keys [http-client]} tdata info] [cfg tdata info]
(or (some-> info :email p/resolved) (or (some-> info :email p/resolved)
(-> (http/req! http-client {:uri "https://api.github.com/user/emails" (->> (http/req! cfg
{:uri "https://api.github.com/user/emails"
:headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))} :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))}
:timeout 6000 :timeout 6000
:method :get}) :method :get})
(p/then (fn [{:keys [status body] :as response}] (p/map (fn [{:keys [status body] :as response}]
(when-not (s/int-in-range? 200 300 status) (when-not (s/int-in-range? 200 300 status)
(ex/raise :type :internal (ex/raise :type :internal
:code :unable-to-retrieve-github-emails :code :unable-to-retrieve-github-emails
@ -174,14 +174,13 @@
:http-body body)) :http-body body))
(->> response :body json/read (filter :primary) first :email)))))) (->> response :body json/read (filter :primary) first :email))))))
(defmethod ig/prep-key ::github-provider (defmethod ig/pre-init-spec ::providers/github [_]
[_ cfg] (s/keys :req [::http/client]))
(d/without-nils cfg))
(defmethod ig/init-key ::github-provider (defmethod ig/init-key ::providers/github
[_ cfg] [_ cfg]
(let [opts {:client-id (:client-id cfg) (let [opts {:client-id (cf/get :github-client-id)
:client-secret (:client-secret cfg) :client-secret (cf/get :github-client-secret)
:scopes #{"read:user" "user:email"} :scopes #{"read:user" "user:email"}
:auth-uri "https://github.com/login/oauth/authorize" :auth-uri "https://github.com/login/oauth/authorize"
:token-uri "https://github.com/login/oauth/access_token" :token-uri "https://github.com/login/oauth/access_token"
@ -192,7 +191,7 @@
;; retrieve emails. ;; retrieve emails.
:get-email-fn (partial retrieve-github-email cfg)}] :get-email-fn (partial retrieve-github-email cfg)}]
(when (:enabled? cfg) (when (contains? cf/flags :login-with-github)
(if (and (string? (:client-id opts)) (if (and (string? (:client-id opts))
(string? (:client-secret opts))) (string? (:client-secret opts)))
(do (do
@ -210,22 +209,18 @@
;; GITLAB AUTH PROVIDER ;; GITLAB AUTH PROVIDER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/prep-key ::gitlab-provider (defmethod ig/init-key ::providers/gitlab
[_ cfg] [_ _]
(d/without-nils cfg)) (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
(defmethod ig/init-key ::gitlab-provider
[_ cfg]
(let [base (:base-uri cfg "https://gitlab.com")
opts {:base-uri base opts {:base-uri base
:client-id (:client-id cfg) :client-id (cf/get :gitlab-client-id)
:client-secret (:client-secret cfg) :client-secret (cf/get :gitlab-client-secret)
:scopes #{"openid" "profile" "email"} :scopes #{"openid" "profile" "email"}
:auth-uri (str base "/oauth/authorize") :auth-uri (str base "/oauth/authorize")
:token-uri (str base "/oauth/token") :token-uri (str base "/oauth/token")
:user-uri (str base "/oauth/userinfo") :user-uri (str base "/oauth/userinfo")
:name "gitlab"}] :name "gitlab"}]
(when (:enabled? cfg) (when (contains? cf/flags :login-with-gitlab)
(if (and (string? (:client-id opts)) (if (and (string? (:client-id opts))
(string? (:client-secret opts))) (string? (:client-secret opts)))
(do (do
@ -246,7 +241,7 @@
(defn- build-redirect-uri (defn- build-redirect-uri
[{:keys [provider] :as cfg}] [{:keys [provider] :as cfg}]
(let [public (u/uri (:public-uri cfg))] (let [public (u/uri (cf/get :public-uri))]
(str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback"))))) (str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback")))))
(defn- build-auth-uri (defn- build-auth-uri
@ -269,7 +264,7 @@
props)) props))
(defn retrieve-access-token (defn retrieve-access-token
[{:keys [provider http-client] :as cfg} code] [{:keys [provider] :as cfg} code]
(let [params {:client_id (:client-id provider) (let [params {:client_id (:client-id provider)
:client_secret (:client-secret provider) :client_secret (:client-secret provider)
:code code :code code
@ -280,9 +275,8 @@
"accept" "application/json"} "accept" "application/json"}
:uri (:token-uri provider) :uri (:token-uri provider)
:body (u/map->query-string params)}] :body (u/map->query-string params)}]
(p/then (->> (http/req! cfg req)
(http/req! http-client req) (p/map (fn [{:keys [status body] :as res}]
(fn [{:keys [status body] :as res}]
(if (= status 200) (if (= status 200)
(let [data (json/read body)] (let [data (json/read body)]
{:token (get data :access_token) {:token (get data :access_token)
@ -290,12 +284,13 @@
(ex/raise :type :internal (ex/raise :type :internal
:code :unable-to-retrieve-token :code :unable-to-retrieve-token
:http-status status :http-status status
:http-body body)))))) :http-body body)))))))
(defn- retrieve-user-info (defn- retrieve-user-info
[{:keys [provider http-client] :as cfg} tdata] [{:keys [provider] :as cfg} tdata]
(letfn [(retrieve [] (letfn [(retrieve []
(http/req! http-client {:uri (:user-uri provider) (http/req! cfg
{:uri (:user-uri provider)
:headers {"Authorization" (str (:type tdata) " " (:token tdata))} :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
:timeout 6000 :timeout 6000
:method :get})) :method :get}))
@ -355,7 +350,7 @@
::props])) ::props]))
(defn retrieve-info (defn retrieve-info
[{:keys [sprops provider] :as cfg} {:keys [params] :as request}] [{:keys [provider] :as cfg} {:keys [params] :as request}]
(letfn [(validate-oidc [info] (letfn [(validate-oidc [info]
;; If the provider is OIDC, we can proceed to check ;; If the provider is OIDC, we can proceed to check
;; roles if they are defined. ;; roles if they are defined.
@ -394,7 +389,7 @@
(let [state (get params :state) (let [state (get params :state)
code (get params :code) code (get params :code)
state (tokens/verify sprops {:token state :iss :oauth})] state (tokens/verify (::main/props cfg) {:token state :iss :oauth})]
(-> (p/resolved code) (-> (p/resolved code)
(p/then #(retrieve-access-token cfg %)) (p/then #(retrieve-access-token cfg %))
(p/then #(retrieve-user-info cfg %)) (p/then #(retrieve-user-info cfg %))
@ -402,7 +397,7 @@
(p/then' (partial post-process state)))))) (p/then' (partial post-process state))))))
(defn- retrieve-profile (defn- retrieve-profile
[{:keys [pool executor] :as cfg} info] [{:keys [::db/pool ::wrk/executor] :as cfg} info]
(px/with-dispatch executor (px/with-dispatch executor
(with-open [conn (db/open pool)] (with-open [conn (db/open pool)]
(some->> (:email info) (some->> (:email info)
@ -415,23 +410,23 @@
(yrs/response :status 302 :headers {"location" (str uri)})) (yrs/response :status 302 :headers {"location" (str uri)}))
(defn- generate-error-redirect (defn- generate-error-redirect
[cfg error] [_ error]
(let [uri (-> (u/uri (:public-uri cfg)) (let [uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/login") (assoc :path "/#/auth/login")
(assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))] (assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))]
(redirect-response uri))) (redirect-response uri)))
(defn- generate-redirect (defn- generate-redirect
[{:keys [sprops session audit] :as cfg} request info profile] [{:keys [::session/session] :as cfg} request info profile]
(if profile (if profile
(let [sxf (session/create-fn session (:id profile)) (let [sxf (session/create-fn session (:id profile))
token (or (:invitation-token info) token (or (:invitation-token info)
(tokens/generate sprops {:iss :auth (tokens/generate (::main/props cfg)
{:iss :auth
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
:profile-id (:id profile)})) :profile-id (:id profile)}))
params {:token token} params {:token token}
uri (-> (u/uri (cf/get :public-uri))
uri (-> (u/uri (:public-uri cfg))
(assoc :path "/#/auth/verify-token") (assoc :path "/#/auth/verify-token")
(assoc :query (u/map->query-string params)))] (assoc :query (u/map->query-string params)))]
@ -439,13 +434,12 @@
(ex/raise :type :restriction (ex/raise :type :restriction
:code :profile-blocked)) :code :profile-blocked))
(when (fn? audit) (when-let [collector (::audit/collector cfg)]
(audit :cmd :submit (audit/submit! collector {:type "command"
:type "command"
:name "login" :name "login"
:profile-id (:id profile) :profile-id (:id profile)
:ip-addr (audit/parse-client-ip request) :ip-addr (audit/parse-client-ip request)
:props (audit/profile->props profile))) :props (audit/profile->props profile)}))
(->> (redirect-response uri) (->> (redirect-response uri)
(sxf request))) (sxf request)))
@ -454,19 +448,19 @@
:iss :prepared-register :iss :prepared-register
:is-active true :is-active true
:exp (dt/in-future {:hours 48})) :exp (dt/in-future {:hours 48}))
token (tokens/generate sprops info) token (tokens/generate (::main/props cfg) info)
params (d/without-nils params (d/without-nils
{:token token {:token token
:fullname (:fullname info)}) :fullname (:fullname info)})
uri (-> (u/uri (:public-uri cfg)) uri (-> (u/uri (cf/get :public-uri))
(assoc :path "/#/auth/register/validate") (assoc :path "/#/auth/register/validate")
(assoc :query (u/map->query-string params)))] (assoc :query (u/map->query-string params)))]
(redirect-response uri)))) (redirect-response uri))))
(defn- auth-handler (defn- auth-handler
[{:keys [sprops] :as cfg} {:keys [params] :as request}] [cfg {:keys [params] :as request}]
(let [props (audit/extract-utm-params params) (let [props (audit/extract-utm-params params)
state (tokens/generate sprops state (tokens/generate (::main/props cfg)
{:iss :oauth {:iss :oauth
:invitation-token (:invitation-token params) :invitation-token (:invitation-token params)
:props props :props props
@ -492,7 +486,7 @@
{:compile {:compile
(fn [& _] (fn [& _]
(fn [handler] (fn [handler]
(fn [{:keys [providers] :as cfg} request] (fn [{:keys [::providers] :as cfg} request]
(let [provider (some-> request :path-params :provider keyword)] (let [provider (some-> request :path-params :provider keyword)]
(if-let [provider (get providers provider)] (if-let [provider (get providers provider)]
(handler (assoc cfg :provider provider) request) (handler (assoc cfg :provider provider) request)
@ -501,43 +495,57 @@
:provider provider :provider provider
:hint "provider not configured"))))))}) :hint "provider not configured"))))))})
(s/def ::public-uri ::us/not-empty-string)
(s/def ::http-client ::http/client) (s/def ::client-id ::cf/oidc-client-id)
(s/def ::sprops map?) (s/def ::client-secret ::cf/oidc-client-secret)
(s/def ::providers map?) (s/def ::base-uri ::cf/oidc-base-uri)
(s/def ::token-uri ::cf/oidc-token-uri)
(s/def ::auth-uri ::cf/oidc-auth-uri)
(s/def ::user-uri ::cf/oidc-user-uri)
(s/def ::scopes ::cf/oidc-scopes)
(s/def ::roles ::cf/oidc-roles)
(s/def ::roles-attr ::cf/oidc-roles-attr)
(s/def ::email-attr ::cf/oidc-email-attr)
(s/def ::name-attr ::cf/oidc-name-attr)
;; FIXME: migrate to qualified-keywords
(s/def ::provider
(s/keys :req-un [::client-id
::client-secret]
:opt-un [::base-uri
::token-uri
::auth-uri
::user-uri
::scopes
::roles
::roles-attr
::email-attr
::name-attr]))
(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
(defmethod ig/pre-init-spec ::routes (defmethod ig/pre-init-spec ::routes
[_] [_]
(s/keys :req-un [::public-uri (s/keys :req [::http/client
::session/session ::wrk/executor
::sprops ::main/props
::http-client
::providers
::db/pool ::db/pool
::wrk/executor])) ::providers
::session/session]))
(defmethod ig/init-key ::routes (defmethod ig/init-key ::routes
[_ {:keys [executor session] :as cfg}] [_ {:keys [::wrk/executor ::session/session] :as cfg}]
(let [cfg (update cfg :provider d/without-nils)] (let [cfg (update cfg :provider d/without-nils)]
["" {:middleware [[(:middleware session)] ["" {:middleware [[(:middleware session)]
[hmw/with-dispatch executor] [hmw/with-dispatch executor]
[hmw/with-config cfg] [hmw/with-config cfg]
[provider-lookup] [provider-lookup]
]} ]}
;; We maintain the both URI prefixes for backward compatibility.
["/auth/oauth" ["/auth/oauth"
["/:provider"
{:handler auth-handler
:allowed-methods #{:post}}]
["/:provider/callback"
{:handler callback-handler
:allowed-methods #{:get}}]]
["/auth/oidc"
["/:provider" ["/:provider"
{:handler auth-handler {:handler auth-handler
:allowed-methods #{:post}}] :allowed-methods #{:post}}]
["/:provider/callback" ["/:provider/callback"
{:handler callback-handler {:handler callback-handler
:allowed-methods #{:get}}]]])) :allowed-methods #{:get}}]]]))

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

@ -100,6 +100,7 @@
(s/def ::telemetry-enabled ::us/boolean) (s/def ::telemetry-enabled ::us/boolean)
(s/def ::audit-log-archive-uri ::us/string) (s/def ::audit-log-archive-uri ::us/string)
(s/def ::audit-log-http-handler-concurrency ::us/integer)
(s/def ::admins ::us/set-of-strings) (s/def ::admins ::us/set-of-strings)
(s/def ::file-change-snapshot-every ::us/integer) (s/def ::file-change-snapshot-every ::us/integer)
@ -205,6 +206,7 @@
::admins ::admins
::allow-demo-users ::allow-demo-users
::audit-log-archive-uri ::audit-log-archive-uri
::audit-log-http-handler-concurrency
::auth-token-cookie-name ::auth-token-cookie-name
::auth-token-cookie-max-age ::auth-token-cookie-max-age
::authenticated-cookie-name ::authenticated-cookie-name

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

@ -12,7 +12,9 @@
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
[app.http.client :as http] [app.http.client :as http]
[app.main :as-alias main]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
@ -26,21 +28,21 @@
(declare parse-notification) (declare parse-notification)
(declare process-report) (declare process-report)
(s/def ::http-client ::http/client)
(s/def ::sprops map?)
(defmethod ig/pre-init-spec ::handler [_] (defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::http-client ::sprops])) (s/keys :req [::http/client
::main/props
::db/pool
::wrk/executor]))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [executor] :as cfg}] [_ {:keys [::wrk/executor] :as cfg}]
(fn [request respond _] (fn [request respond _]
(let [data (-> request yrq/body slurp)] (let [data (-> request yrq/body slurp)]
(px/run! executor #(handle-request cfg data))) (px/run! executor #(handle-request cfg data)))
(respond (yrs/response 200)))) (respond (yrs/response 200))))
(defn handle-request (defn handle-request
[{:keys [http-client] :as cfg} data] [cfg data]
(try (try
(let [body (parse-json data) (let [body (parse-json data)
mtype (get body "Type")] mtype (get body "Type")]
@ -49,7 +51,7 @@
(let [surl (get body "SubscribeURL") (let [surl (get body "SubscribeURL")
stopic (get body "TopicArn")] stopic (get body "TopicArn")]
(l/info :action "subscription received" :topic stopic :url surl) (l/info :action "subscription received" :topic stopic :url surl)
(http/req! http-client {:uri surl :method :post :timeout 10000} {:sync? true})) (http/req! cfg {:uri surl :method :post :timeout 10000} {:sync? true}))
(= mtype "Notification") (= mtype "Notification")
(when-let [message (parse-json (get body "Message"))] (when-let [message (parse-json (get body "Message"))]
@ -100,10 +102,11 @@
(get mail "headers"))) (get mail "headers")))
(defn- extract-identity (defn- extract-identity
[{:keys [sprops]} headers] [cfg headers]
(let [tdata (get headers "x-penpot-data")] (let [tdata (get headers "x-penpot-data")]
(when-not (str/empty? tdata) (when-not (str/empty? tdata)
(let [result (tokens/verify sprops {:token tdata :iss :profile-identity})] (let [sprops (::main/props cfg)
result (tokens/verify sprops {:token tdata :iss :profile-identity})]
(:profile-id result))))) (:profile-id result)))))
(defn- parse-notification (defn- parse-notification
@ -136,7 +139,7 @@
(j/read-value v))) (j/read-value v)))
(defn- register-bounce-for-profile (defn- register-bounce-for-profile
[{:keys [pool]} {:keys [type kind profile-id] :as report}] [{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
(when (= kind "permanent") (when (= kind "permanent")
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report (db/insert! conn :profile-complaint-report
@ -165,7 +168,7 @@
{:id profile-id})))))) {:id profile-id}))))))
(defn- register-complaint-for-profile (defn- register-complaint-for-profile
[{:keys [pool]} {:keys [type profile-id] :as report}] [{:keys [::db/pool]} {:keys [type profile-id] :as report}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report (db/insert! conn :profile-complaint-report
{:profile-id profile-id {:profile-id profile-id

41
backend/src/app/http/client.clj
View file

@ -7,34 +7,41 @@
(ns app.http.client (ns app.http.client
"Http client abstraction layer." "Http client abstraction layer."
(:require (:require
[app.common.spec :as us]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig] [integrant.core :as ig]
[java-http-clj.core :as http])) [java-http-clj.core :as http])
(:import
java.net.http.HttpClient))
(s/def ::client fn?) (s/def ::client #(instance? HttpClient %))
(s/def ::client-holder
(s/keys :req [::client]))
(defmethod ig/pre-init-spec :app.http/client [_] (defmethod ig/pre-init-spec ::client [_]
(s/keys :req-un [::wrk/executor])) (s/keys :req [::wrk/executor]))
(defmethod ig/init-key :app.http/client (defmethod ig/init-key ::client
[_ {:keys [executor] :as cfg}] [_ {:keys [::wrk/executor] :as cfg}]
(let [client (http/build-client {:executor executor (http/build-client {:executor executor
:connect-timeout 30000 ;; 10s :connect-timeout 30000 ;; 10s
:follow-redirects :always})] :follow-redirects :always}))
(with-meta
(fn send (defn send!
([req] (send req {})) ([client req] (send! client req {}))
([req {:keys [response-type sync?] :or {response-type :string sync? false}}] ([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
(us/assert! ::client client)
(if sync? (if sync?
(http/send req {:client client :as response-type}) (http/send req {:client client :as response-type})
(http/send-async req {:client client :as response-type})))) (http/send-async req {:client client :as response-type}))))
{::client client})))
(defn req! (defn req!
"A convencience toplevel function for gradual migration to a new API "A convencience toplevel function for gradual migration to a new API
convention." convention."
([client request] ([{:keys [::client] :as holder} request]
(client request)) (us/assert! ::client-holder holder)
([client request options] (send! client request {}))
(client request options))) ([{:keys [::client] :as holder} request options]
(us/assert! ::client-holder holder)
(send! client request options)))

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

@ -79,9 +79,9 @@
[error request] [error request]
(let [edata (ex-data error) (let [edata (ex-data error)
explain (ex/explain edata)] explain (ex/explain edata)]
(l/error ::l/raw (str (ex-message error) "\n" explain) (l/error :hint (ex-message error)
::l/context (get-context request) :cause error
:cause error) ::l/context (get-context request))
(yrs/response :status 500 (yrs/response :status 500
:body {:type :server-error :body {:type :server-error
:code :assertion :code :assertion
@ -102,9 +102,9 @@
:else :else
(do (do
(l/error ::l/raw (ex-message error) (l/error :hint (ex-message error)
::l/context (get-context request) :cause error
:cause error) ::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unhandled :code :unhandled
:hint (ex-message error) :hint (ex-message error)
@ -113,9 +113,9 @@
(defmethod handle-exception org.postgresql.util.PSQLException (defmethod handle-exception org.postgresql.util.PSQLException
[error request] [error request]
(let [state (.getSQLState ^java.sql.SQLException error)] (let [state (.getSQLState ^java.sql.SQLException error)]
(l/error ::l/raw (ex-message error) (l/error :hint (ex-message error)
::l/context (get-context request) :cause error
:cause error) ::l/context (get-context request))
(cond (cond
(= state "57014") (= state "57014")
(yrs/response 504 {:type :server-error (yrs/response 504 {:type :server-error
@ -140,9 +140,9 @@
;; This means that exception is not a controlled exception. ;; This means that exception is not a controlled exception.
(nil? edata) (nil? edata)
(do (do
(l/error ::l/raw (ex-message error) (l/error :hint (ex-message error)
::l/context (get-context request) :cause error
:cause error) ::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unexpected :code :unexpected
:hint (ex-message error)})) :hint (ex-message error)}))
@ -158,9 +158,9 @@
:else :else
(do (do
(l/error ::l/raw (ex-message error) (l/error :hint (ex-message error)
::l/context (get-context request) :cause error
:cause error) ::l/context (get-context request))
(yrs/response 500 {:type :server-error (yrs/response 500 {:type :server-error
:code :unhandled :code :unhandled
:hint (ex-message error) :hint (ex-message error)

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

@ -15,20 +15,27 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http.client :as http]
[app.loggers.audit.tasks :as-alias tasks]
[app.main :as-alias main]
[app.metrics :as mtx]
[app.tokens :as tokens] [app.tokens :as tokens]
[app.util.async :as aa]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
[lambdaisland.uri :as u] [lambdaisland.uri :as u]
[promesa.core :as p] [promesa.core :as p]
[promesa.exec :as px] [promesa.exec :as px]
[promesa.exec.bulkhead :as pxb]
[yetti.request :as yrq] [yetti.request :as yrq]
[yetti.response :as yrs])) [yetti.response :as yrs]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn parse-client-ip (defn parse-client-ip
[request] [request]
(or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first) (or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
@ -49,10 +56,23 @@
(assoc (->> sk str/kebab (keyword "penpot")) v))))] (assoc (->> sk str/kebab (keyword "penpot")) v))))]
(reduce-kv process-param {} params))) (reduce-kv process-param {} params)))
(def ^:private
profile-props
[:id
:is-active
:is-muted
:auth-backend
:email
:default-team-id
:default-project-id
:fullname
:lang])
(defn profile->props (defn profile->props
[profile] [profile]
(-> profile (-> profile
(select-keys [:id :is-active :is-muted :auth-backend :email :default-team-id :default-project-id :fullname :lang]) (select-keys profile-props)
(merge (:props profile)) (merge (:props profile))
(d/without-nils))) (d/without-nils)))
@ -79,11 +99,7 @@
(update event :props #(into {} xform %)))) (update event :props #(into {} xform %))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; --- SPECS
;; HTTP Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare persist-http-events)
(s/def ::profile-id ::us/uuid) (s/def ::profile-id ::us/uuid)
(s/def ::name ::us/string) (s/def ::name ::us/string)
@ -98,161 +114,174 @@
(s/def ::frontend-events (s/every ::frontend-event)) (s/def ::frontend-events (s/every ::frontend-event))
(s/def ::ip-addr ::us/string)
(s/def ::backend-event
(s/keys :req-un [::type ::name ::profile-id]
:opt-un [::ip-addr ::props]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP HANDLER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::concurrency ::us/integer)
(defmethod ig/pre-init-spec ::http-handler [_]
(s/keys :req [::wrk/executor ::db/pool ::mtx/metrics ::concurrency]))
(defmethod ig/prep-key ::http-handler
[_ cfg]
(merge {::concurrency (cf/get :audit-log-http-handler-concurrency 8)}
(d/without-nils cfg)))
(defmethod ig/init-key ::http-handler (defmethod ig/init-key ::http-handler
[_ {:keys [executor pool] :as cfg}] [_ {:keys [::wrk/executor ::db/pool ::mtx/metrics ::concurrency] :as cfg}]
(if (or (db/read-only? pool) (not (contains? cf/flags :audit-log))) (if (or (db/read-only? pool)
(not (contains? cf/flags :audit-log)))
(do (do
(l/warn :hint "audit log http handler disabled or db is read-only") (l/warn :hint "audit: http handler disabled or db is read-only")
(fn [_ respond _] (fn [_ respond _]
(respond (yrs/response 204)))) (respond (yrs/response 204))))
(letfn [(handler [{:keys [profile-id] :as request}] (letfn [(event->row [event]
(let [events (->> (:events (:params request))
(remove #(not= profile-id (:profile-id %)))
(us/conform ::frontend-events))
ip-addr (parse-client-ip request)
cfg (-> cfg
(assoc :source "frontend")
(assoc :events events)
(assoc :ip-addr ip-addr))]
(persist-http-events cfg)))
(handle-error [cause]
(let [xdata (ex-data cause)]
(if (= :spec-validation (:code xdata))
(l/error ::l/raw (str "spec validation on persist-events:\n" (us/pretty-explain xdata)))
(l/error :hint "error on persist-events" :cause cause))))]
(fn [request respond _]
;; Fire and forget, log error in case of error
(-> (px/submit! executor #(handler request))
(p/catch handle-error))
(respond (yrs/response 204))))))
(defn- persist-http-events
[{:keys [pool events ip-addr source] :as cfg}]
(let [columns [:id :name :source :type :tracked-at :profile-id :ip-addr :props :context]
prepare-xf (map (fn [event]
[(uuid/next) [(uuid/next)
(:name event) (:name event)
source (:source event)
(:type event) (:type event)
(:timestamp event) (:timestamp event)
(:profile-id event) (:profile-id event)
(db/inet ip-addr) (db/inet (:ip-addr event))
(db/tjson (:props event)) (db/tjson (:props event))
(db/tjson (d/without-nils (:context event)))]))] (db/tjson (d/without-nils (:context event)))])
(handle-request [{:keys [profile-id] :as request}]
(let [events (->> (:events (:params request))
(remove #(not= profile-id (:profile-id %)))
(us/conform ::frontend-events))
ip-addr (parse-client-ip request)
xform (comp
(map #(assoc % :ip-addr ip-addr))
(map #(assoc % :source "frontend"))
(map event->row))
columns [:id :name :source :type :tracked-at
:profile-id :ip-addr :props :context]]
(when (seq events) (when (seq events)
(->> (into [] prepare-xf events) (->> (into [] xform events)
(db/insert-multi! pool :audit-log columns))))) (db/insert-multi! pool :audit-log columns)))))
(report-error! [cause]
(if-let [xdata (us/validation-error? cause)]
(l/error ::l/raw (str "audit: validation error frontend events request\n" (ex/explain xdata)))
(l/error :hint "audit: unexpected error on processing frontend events" :cause cause)))
(on-queue [instance]
(l/trace :hint "http-handler: enqueued"
:queue-size (get instance ::pxb/current-queue-size)
:concurrency (get instance ::pxb/current-concurrency))
(mtx/run! metrics
:id :audit-http-handler-queue-size
:val (get instance ::pxb/current-queue-size))
(mtx/run! metrics
:id :audit-http-handler-concurrency
:val (get instance ::pxb/current-concurrency)))
(on-run [instance task]
(let [elapsed (- (inst-ms (dt/now))
(inst-ms task))]
(l/trace :hint "http-handler: execute"
:elapsed (str elapsed "ms"))
(mtx/run! metrics
:id :audit-http-handler-timing
:val elapsed)
(mtx/run! metrics
:id :audit-http-handler-queue-size
:val (get instance ::pxb/current-queue-size))
(mtx/run! metrics
:id :audit-http-handler-concurrency
:val (get instance ::pxb/current-concurrency))))]
(let [limiter (pxb/create :executor executor
:concurrency concurrency
:on-queue on-queue
:on-run on-run)]
(fn [request respond _]
(->> (px/submit! limiter (partial handle-request request))
(p/fnly (fn [_ cause]
(some-> cause report-error!)
(respond (yrs/response 204))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Collector ;; COLLECTOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Defines a service that collects the audit/activity log using ;; Defines a service that collects the audit/activity log using
;; internal database. Later this audit log can be transferred to ;; internal database. Later this audit log can be transferred to
;; an external storage and data cleared. ;; an external storage and data cleared.
(declare persist-events) (s/def ::collector
(s/nilable
(s/keys :req [::wrk/executor ::db/pool])))
(defmethod ig/pre-init-spec ::collector [_] (defmethod ig/pre-init-spec ::collector [_]
(s/keys :req-un [::db/pool ::wrk/executor])) (s/keys :req [::db/pool ::wrk/executor ::mtx/metrics]))
(s/def ::ip-addr string?)
(s/def ::backend-event
(s/keys :req-un [::type ::name ::profile-id]
:opt-un [::ip-addr ::props]))
(def ^:private backend-event-xform
(comp
(filter #(us/valid? ::backend-event %))
(map clean-props)))
(defmethod ig/init-key ::collector (defmethod ig/init-key ::collector
[_ {:keys [pool] :as cfg}] [_ {:keys [::db/pool] :as cfg}]
(cond (cond
(not (contains? cf/flags :audit-log)) (not (contains? cf/flags :audit-log))
(do (l/info :hint "audit: log collection disabled")
(l/info :hint "audit log collection disabled")
(constantly nil))
(db/read-only? pool) (db/read-only? pool)
(do (l/warn :hint "audit: log collection disabled (db is read-only)")
(l/warn :hint "audit log collection disabled, db is read-only")
(constantly nil))
:else :else
(let [input (a/chan 512 backend-event-xform) cfg))
buffer (aa/batch input {:max-batch-size 100
:max-batch-age (* 10 1000) ; 10s
:init []})]
(l/info :hint "audit log collector initialized")
(a/go-loop []
(when-let [[_type events] (a/<! buffer)]
(let [res (a/<! (persist-events cfg events))]
(when (ex/exception? res)
(l/error :hint "error on persisting events" :cause res))
(recur))))
(fn [& {:keys [cmd] :as params}] (defn- persist-event!
(case cmd [pool event]
:stop (us/verify! ::backend-event event)
(a/close! input) (db/insert! pool :audit-log
{:id (uuid/next)
:name (:name event)
:type (:type event)
:profile-id (:profile-id event)
:tracked-at (dt/now)
:ip-addr (some-> (:ip-addr event) db/inet)
:props (db/tjson (:props event))
:source "backend"}))
:submit (defn submit!
(let [params (-> params "Submit audit event to the collector."
(dissoc :cmd) [{:keys [::wrk/executor ::db/pool]} params]
(assoc :tracked-at (dt/now)))] (->> (px/submit! executor (partial persist-event! pool (d/without-nils params)))
(when-not (a/offer! input params) (p/err (fn [cause]
(l/warn :hint "activity channel is full")))))))) (l/error :hint "audit: unexpected error processing event" :cause cause)
(p/resolved nil)))))
(defn- persist-events
[{:keys [pool executor] :as cfg} events]
(letfn [(event->row [event]
[(uuid/next)
(:name event)
(:type event)
(:profile-id event)
(:tracked-at event)
(some-> (:ip-addr event) db/inet)
(db/tjson (:props event))
"backend"])]
(aa/with-thread executor
(when (seq events)
(db/with-atomic [conn pool]
(db/insert-multi! conn :audit-log
[:id :name :type :profile-id :tracked-at :ip-addr :props :source]
(sequence (keep event->row) events)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Archive Task ;; TASK: ARCHIVE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This is a task responsible to send the accumulated events to an ;; This is a task responsible to send the accumulated events to
;; external service for archival. ;; external service for archival.
(declare archive-events) (declare archive-events)
(s/def ::http-client fn?) (s/def ::tasks/uri ::us/string)
(s/def ::uri ::us/string)
(s/def ::sprops map?)
(defmethod ig/pre-init-spec ::archive-task [_] (defmethod ig/pre-init-spec ::tasks/archive-task [_]
(s/keys :req-un [::db/pool ::sprops ::http-client] (s/keys :req [::db/pool ::main/props ::http/client]))
:opt-un [::uri]))
(defmethod ig/init-key ::archive-task (defmethod ig/init-key ::tasks/archive
[_ {:keys [uri] :as cfg}] [_ cfg]
(fn [props] (fn [params]
;; NOTE: this let allows overwrite default configured values from ;; NOTE: this let allows overwrite default configured values from
;; the repl, when manually invoking the task. ;; the repl, when manually invoking the task.
(let [enabled (or (contains? cf/flags :audit-log-archive) (let [enabled (or (contains? cf/flags :audit-log-archive)
(:enabled props false)) (:enabled params false))
uri (or uri (:uri props)) uri (cf/get :audit-log-archive-uri)
cfg (assoc cfg :uri uri)] uri (or uri (:uri params))
cfg (assoc cfg ::uri uri)]
(when (and enabled (not uri)) (when (and enabled (not uri))
(ex/raise :type :internal (ex/raise :type :internal
@ -264,20 +293,21 @@
(let [n (archive-events cfg)] (let [n (archive-events cfg)]
(if n (if n
(do (do
(aa/thread-sleep 100) (px/sleep 100)
(recur (+ total n))) (recur (+ total n)))
(when (pos? total) (when (pos? total)
(l/trace :hint "events chunk archived" :num total))))))))) (l/debug :hint "events archived" :total total)))))))))
(def sql:retrieve-batch-of-audit-log (def ^:private sql:retrieve-batch-of-audit-log
"select * from audit_log "select *
from audit_log
where archived_at is null where archived_at is null
order by created_at asc order by created_at asc
limit 256 limit 256
for update skip locked;") for update skip locked;")
(defn archive-events (defn archive-events
[{:keys [pool uri sprops http-client] :as cfg}] [{:keys [::db/pool ::uri] :as cfg}]
(letfn [(decode-row [{:keys [props ip-addr context] :as row}] (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
(cond-> row (cond-> row
(db/pgobject? props) (db/pgobject? props)
@ -301,9 +331,11 @@
:context])) :context]))
(send [events] (send [events]
(let [token (tokens/generate sprops {:iss "authentication" (let [token (tokens/generate (::main/props cfg)
{:iss "authentication"
:iat (dt/now) :iat (dt/now)
:uid uuid/zero}) :uid uuid/zero})
;; FIXME tokens/generate
body (t/encode {:events events}) body (t/encode {:events events})
headers {"content-type" "application/transit+json" headers {"content-type" "application/transit+json"
"origin" (cf/get :public-uri) "origin" (cf/get :public-uri)
@ -313,7 +345,7 @@
:method :post :method :post
:headers headers :headers headers
:body body} :body body}
resp (http-client params {:sync? true})] resp (http/req! cfg params {:sync? true})]
(if (= (:status resp) 204) (if (= (:status resp) 204)
true true
(do (do
@ -334,7 +366,7 @@
(map row->event)) (map row->event))
events (into [] xform rows)] events (into [] xform rows)]
(when-not (empty? events) (when-not (empty? events)
(l/debug :action "archive-events" :uri uri :events (count events)) (l/trace :hint "archive events chunk" :uri uri :events (count events))
(when (send events) (when (send events)
(mark-as-archived conn rows) (mark-as-archived conn rows)
(count events))))))) (count events)))))))
@ -343,7 +375,7 @@
;; GC Task ;; GC Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def sql:clean-archived (def ^:private sql:clean-archived
"delete from audit_log "delete from audit_log
where archived_at is not null") where archived_at is not null")
@ -354,10 +386,10 @@
(l/debug :hint "delete archived audit log entries" :deleted result) (l/debug :hint "delete archived audit log entries" :deleted result)
result)) result))
(defmethod ig/pre-init-spec ::gc-task [_] (defmethod ig/pre-init-spec ::tasks/gc [_]
(s/keys :req-un [::db/pool])) (s/keys :req [::db/pool]))
(defmethod ig/init-key ::gc-task (defmethod ig/init-key ::tasks/gc
[_ cfg] [_ cfg]
(fn [_] (fn [_]
(clean-archived cfg))) (clean-archived cfg)))

75
backend/src/app/loggers/loki.clj
View file

@ -8,58 +8,55 @@
"A Loki integration." "A Loki integration."
(:require (:require
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.config :as cf]
[app.config :as cfg] [app.http.client :as http]
[app.loggers.zmq :as lzmq]
[app.util.json :as json] [app.util.json :as json]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig])) [integrant.core :as ig]
[promesa.exec :as px]))
(declare ^:private handle-event) (declare ^:private handle-event)
(declare ^:private start-rcv-loop)
(s/def ::uri ::us/string)
(s/def ::receiver fn?)
(s/def ::http-client fn?)
(defmethod ig/pre-init-spec ::reporter [_] (defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req-un [ ::receiver ::http-client] (s/keys :req [::http/client
:opt-un [::uri])) ::lzmq/receiver]))
(defmethod ig/init-key ::reporter (defmethod ig/init-key ::reporter
[_ {:keys [receiver uri] :as cfg}] [_ cfg]
(when uri (when-let [uri (cf/get :loggers-loki-uri)]
(l/info :msg "initializing loki reporter" :uri uri) (px/thread
(let [input (a/chan (a/dropping-buffer 2048))] {:name "penpot/loki-reporter"}
(receiver :sub input) (l/info :hint "reporter started" :uri uri)
(let [input (a/chan (a/dropping-buffer 2048))
cfg (assoc cfg ::uri uri)]
(doto (Thread. #(start-rcv-loop cfg input)) (try
(.setDaemon true) (lzmq/sub! (::lzmq/receiver cfg) input)
(.setName "penpot/loki-sender") (loop []
(.start)) (when-let [msg (a/<!! input)]
(handle-event cfg msg)
(recur)))
input))) (catch InterruptedException _
(l/debug :hint "reporter interrupted"))
(catch Throwable cause
(l/error :hint "unexpected exception"
:cause cause))
(finally
(a/close! input)
(l/info :hint "reporter terminated")))))))
(defmethod ig/halt-key! ::reporter (defmethod ig/halt-key! ::reporter
[_ output] [_ thread]
(when output (some-> thread px/interrupt!))
(a/close! output)))
(defn- start-rcv-loop
[cfg input]
(loop []
(let [msg (a/<!! input)]
(when-not (nil? msg)
(handle-event cfg msg)
(recur))))
(l/info :msg "stopping error reporting loop"))
(defn- prepare-payload (defn- prepare-payload
[event] [event]
(let [labels {:host (cfg/get :host) (let [labels {:host (cf/get :host)
:tenant (cfg/get :tenant) :tenant (cf/get :tenant)
:version (:full cfg/version) :version (:full cf/version)
:logger (:logger/name event) :logger (:logger/name event)
:level (:logger/level event)}] :level (:logger/level event)}]
{:streams {:streams
@ -69,10 +66,10 @@
(when-let [error (:trace event)] (when-let [error (:trace event)]
(str "\n" error)))]]}]})) (str "\n" error)))]]}]}))
(defn- make-request (defn- make-request
[{:keys [http-client uri] :as cfg} payload] [{:keys [::uri] :as cfg} payload]
(http-client {:uri uri (http/req! cfg
{:uri uri
:timeout 3000 :timeout 3000
:method :post :method :post
:headers {"content-type" "application/json"} :headers {"content-type" "application/json"}

88
backend/src/app/loggers/mattermost.clj
View file

@ -9,67 +9,69 @@
(:require (:require
[app.common.logging :as l] [app.common.logging :as l]
[app.config :as cf] [app.config :as cf]
[app.http.client :as http]
[app.loggers.database :as ldb] [app.loggers.database :as ldb]
[app.loggers.zmq :as lzmq]
[app.util.json :as json] [app.util.json :as json]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.core :as p])) [promesa.exec :as px]))
(defonce enabled (atom true)) (defonce enabled (atom true))
(defn- send-mattermost-notification! (defn- send-mattermost-notification!
[{:keys [http-client] :as cfg} {:keys [host id public-uri] :as event}] [cfg {:keys [host id public-uri] :as event}]
(let [uri (:uri cfg) (let [text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
(when-let [pid (:profile-id event)] (when-let [pid (:profile-id event)]
(str "- profile-id: #uuid-" pid "\n")))] (str "- profile-id: #uuid-" pid "\n")))
(p/then resp (http/req! cfg
(http-client {:uri uri {:uri (cf/get :error-report-webhook)
:method :post :method :post
:headers {"content-type" "application/json"} :headers {"content-type" "application/json"}
:body (json/write-str {:text text})}) :body (json/write-str {:text text})}
(fn [{:keys [status] :as rsp}] {:sync? true})]
(when (not= status 200)
(l/warn :hint "error on sending data to mattermost" (when (not= 200 (:status resp))
:response (pr-str rsp))))))) (l/warn :hint "error on sending data"
:response (pr-str resp)))))
(defn handle-event (defn handle-event
[cfg event] [cfg event]
(let [ch (a/chan)] (try
(-> (p/let [event (ldb/parse-event event)] (let [event (ldb/parse-event event)]
(send-mattermost-notification! cfg event)) (when @enabled
(p/finally (fn [_ cause] (send-mattermost-notification! cfg event)))
(when cause (catch Throwable cause
(l/warn :hint "unexpected exception on error reporter" :cause cause)) (l/warn :hint "unhandled error"
(a/close! ch)))) :cause cause))))
ch))
(s/def ::http-client fn?)
(s/def ::uri ::cf/error-report-webhook)
(defmethod ig/pre-init-spec ::reporter [_] (defmethod ig/pre-init-spec ::reporter [_]
(s/keys :req-un [::http-client ::receiver] (s/keys :req [::http/client
:opt-un [::uri])) ::lzmq/receiver]))
(defmethod ig/init-key ::reporter (defmethod ig/init-key ::reporter
[_ {:keys [receiver uri] :as cfg}] [_ cfg]
(when uri (when-let [uri (cf/get :error-report-webhook)]
(l/info :msg "initializing mattermost error reporter" :uri uri) (px/thread
(let [output (a/chan (a/sliding-buffer 128) {:name "penpot/mattermost-reporter"}
(filter (fn [event] (l/info :msg "initializing error reporter" :uri uri)
(= (:logger/level event) "error"))))] (let [input (a/chan (a/sliding-buffer 128)
(receiver :sub output) (filter #(= (:logger/level %) "error")))]
(a/go-loop [] (try
(let [msg (a/<! output)] (lzmq/sub! (::lzmq/receiver cfg) input)
(if (nil? msg) (loop []
(l/info :msg "stopping error reporting loop") (when-let [msg (a/<!! input)]
(do (handle-event cfg msg)
(a/<! (handle-event cfg msg)) (recur)))
(recur))))) (catch InterruptedException _
output))) (l/debug :hint "reporter interrupted"))
(catch Throwable cause
(l/error :hint "unexpected error" :cause cause))
(finally
(a/close! input)
(l/info :hint "reporter terminated")))))))
(defmethod ig/halt-key! ::reporter (defmethod ig/halt-key! ::reporter
[_ output] [_ thread]
(when output (some-> thread px/interrupt!))
(a/close! output)))

90
backend/src/app/loggers/zmq.clj
View file

@ -9,13 +9,15 @@
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.config :as cf]
[app.loggers.zmq.receiver :as-alias receiver]
[app.util.json :as json] [app.util.json :as json]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig]) [integrant.core :as ig]
[promesa.exec :as px])
(:import (:import
org.zeromq.SocketType org.zeromq.SocketType
org.zeromq.ZMQ$Socket org.zeromq.ZMQ$Socket
@ -24,38 +26,56 @@
(declare prepare) (declare prepare)
(declare start-rcv-loop) (declare start-rcv-loop)
(s/def ::endpoint ::us/string)
(defmethod ig/pre-init-spec ::receiver [_]
(s/keys :opt-un [::endpoint]))
(defmethod ig/init-key ::receiver (defmethod ig/init-key ::receiver
[_ {:keys [endpoint] :as cfg}] [_ cfg]
(l/info :msg "initializing ZMQ receiver" :bind endpoint) (let [uri (cf/get :loggers-zmq-uri)
(let [buffer (a/chan 1) buffer (a/chan 1)
output (a/chan 1 (comp (filter map?) output (a/chan 1 (comp (filter map?)
(keep prepare))) (keep prepare)))
mult (a/mult output)] mult (a/mult output)
(when endpoint thread (when uri
(let [thread (Thread. #(start-rcv-loop {:out buffer :endpoint endpoint}))] (px/thread
(.setDaemon thread false) {:name "penpot/zmq-receiver"
(.setName thread "penpot/zmq-logger-receiver") :daemon false}
(.start thread))) (l/info :hint "receiver started")
(try
(start-rcv-loop buffer uri)
(catch InterruptedException _
(l/debug :hint "receiver interrupted"))
(catch java.lang.IllegalStateException cause
(if (= "errno 4" (ex-message cause))
(l/debug :hint "receiver interrupted")
(l/error :hint "unhandled error" :cause cause)))
(catch Throwable cause
(l/error :hint "unhandled error" :cause cause))
(finally
(l/info :hint "receiver terminated")))))]
(a/pipe buffer output) (a/pipe buffer output)
(with-meta (-> cfg
(fn [cmd ch] (assoc ::receiver/mult mult)
(case cmd (assoc ::receiver/thread thread)
:sub (a/tap mult ch) (assoc ::receiver/output output)
:unsub (a/untap mult ch)) (assoc ::receiver/buffer buffer))))
ch)
{::output output (s/def ::receiver/mult some?)
::buffer buffer (s/def ::receiver/thread #(instance? Thread %))
::mult mult}))) (s/def ::receiver/output some?)
(s/def ::receiver/buffer some?)
(s/def ::receiver
(s/keys :req [::receiver/mult
::receiver/thread
::receiver/output
::receiver/buffer]))
(defn sub!
[{:keys [::receiver/mult]} ch]
(a/tap mult ch))
(defmethod ig/halt-key! ::receiver (defmethod ig/halt-key! ::receiver
[_ f] [_ {:keys [::receiver/buffer ::receiver/thread]}]
(a/close! (::buffer (meta f)))) (some-> thread px/interrupt!)
(some-> buffer a/close!))
(def ^:private json-mapper (def ^:private json-mapper
(json/mapper (json/mapper
@ -63,11 +83,10 @@
:decode-key-fn (comp keyword str/kebab)})) :decode-key-fn (comp keyword str/kebab)}))
(defn- start-rcv-loop (defn- start-rcv-loop
([] (start-rcv-loop nil)) [output endpoint]
([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}] (let [zctx (ZContext. 1)
(let [out (or out (a/chan 1))
zctx (ZContext. 1)
socket (.. zctx (createSocket SocketType/SUB))] socket (.. zctx (createSocket SocketType/SUB))]
(try
(.. socket (connect ^String endpoint)) (.. socket (connect ^String endpoint))
(.. socket (subscribe "")) (.. socket (subscribe ""))
(.. socket (setReceiveTimeOut 5000)) (.. socket (setReceiveTimeOut 5000))
@ -75,11 +94,12 @@
(let [msg (.recv ^ZMQ$Socket socket) (let [msg (.recv ^ZMQ$Socket socket)
msg (ex/ignoring (json/read msg json-mapper)) msg (ex/ignoring (json/read msg json-mapper))
msg (if (nil? msg) :empty msg)] msg (if (nil? msg) :empty msg)]
(if (a/>!! out msg) (when (a/>!! output msg)
(recur) (recur))))
(do
(finally
(.close ^java.lang.AutoCloseable socket) (.close ^java.lang.AutoCloseable socket)
(.destroy ^ZContext zctx)))))))) (.destroy ^ZContext zctx)))))
(s/def ::logger-name string?) (s/def ::logger-name string?)
(s/def ::level string?) (s/def ::level string?)

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

@ -6,10 +6,16 @@
(ns app.main (ns app.main
(:require (:require
[app.auth.oidc] [app.auth.oidc :as-alias oidc]
[app.auth.oidc.providers :as-alias oidc.providers]
[app.common.logging :as l] [app.common.logging :as l]
[app.config :as cf] [app.config :as cf]
[app.db :as-alias db] [app.db :as-alias db]
[app.http.client :as-alias http.client]
[app.http.session :as-alias http.session]
[app.loggers.audit :as-alias audit]
[app.loggers.audit.tasks :as-alias audit.tasks]
[app.loggers.zmq :as-alias lzmq]
[app.metrics :as-alias mtx] [app.metrics :as-alias mtx]
[app.metrics.definition :as-alias mdef] [app.metrics.definition :as-alias mdef]
[app.redis :as-alias rds] [app.redis :as-alias rds]
@ -100,6 +106,24 @@
::mdef/labels ["name"] ::mdef/labels ["name"]
::mdef/type :summary} ::mdef/type :summary}
:audit-http-handler-queue-size
{::mdef/name "penpot_audit_http_handler_queue_size"
::mdef/help "Current number of queued submissions on the audit log http handler"
::mdef/labels []
::mdef/type :gauge}
:audit-http-handler-concurrency
{::mdef/name "penpot_audit_http_handler_concurrency"
::mdef/help "Current number of used concurrency capacity on the audit log http handler"
::mdef/labels []
::mdef/type :gauge}
:audit-http-handler-timing
{::mdef/name "penpot_audit_http_handler_timing"
::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
::mdef/labels []
::mdef/type :summary}
:executors-active-threads :executors-active-threads
{::mdef/name "penpot_executors_active_threads" {::mdef/name "penpot_executors_active_threads"
::mdef/help "Current number of threads available in the executor service." ::mdef/help "Current number of threads available in the executor service."
@ -178,8 +202,8 @@
::sto/gc-touched-task ::sto/gc-touched-task
{:pool (ig/ref ::db/pool)} {:pool (ig/ref ::db/pool)}
:app.http/client ::http.client/client
{:executor (ig/ref ::wrk/executor)} {::wrk/executor (ig/ref ::wrk/executor)}
:app.http.session/manager :app.http.session/manager
{:pool (ig/ref ::db/pool) {:pool (ig/ref ::db/pool)
@ -191,10 +215,10 @@
:max-age (cf/get :auth-token-cookie-max-age)} :max-age (cf/get :auth-token-cookie-max-age)}
:app.http.awsns/handler :app.http.awsns/handler
{:sprops (ig/ref :app.setup/props) {::props (ig/ref :app.setup/props)
:pool (ig/ref ::db/pool) ::db/pool (ig/ref ::db/pool)
:http-client (ig/ref :app.http/client) ::http.client/client (ig/ref ::http.client/client)
:executor (ig/ref ::wrk/executor)} ::wrk/executor (ig/ref ::wrk/executor)}
:app.http/server :app.http/server
{:port (cf/get :http-server-port) {:port (cf/get :http-server-port)
@ -220,51 +244,30 @@
:bind-password (cf/get :ldap-bind-password) :bind-password (cf/get :ldap-bind-password)
:enabled? (contains? cf/flags :login-with-ldap)} :enabled? (contains? cf/flags :login-with-ldap)}
:app.auth.oidc/google-provider ::oidc.providers/google
{:enabled? (contains? cf/flags :login-with-google) {}
:client-id (cf/get :google-client-id)
:client-secret (cf/get :google-client-secret)}
:app.auth.oidc/github-provider ::oidc.providers/github
{:enabled? (contains? cf/flags :login-with-github) {::http.client/client (ig/ref ::http.client/client)}
:http-client (ig/ref :app.http/client)
:client-id (cf/get :github-client-id)
:client-secret (cf/get :github-client-secret)}
:app.auth.oidc/gitlab-provider ::oidc.providers/gitlab
{:enabled? (contains? cf/flags :login-with-gitlab) {}
:base-uri (cf/get :gitlab-base-uri "https://gitlab.com")
:client-id (cf/get :gitlab-client-id)
:client-secret (cf/get :gitlab-client-secret)}
:app.auth.oidc/generic-provider ::oidc.providers/generic
{:enabled? (contains? cf/flags :login-with-oidc) {::http.client/client (ig/ref ::http.client/client)}
:http-client (ig/ref :app.http/client)
:client-id (cf/get :oidc-client-id) ::oidc/routes
:client-secret (cf/get :oidc-client-secret) {::http.client/client (ig/ref ::http.client/client)
::db/pool (ig/ref ::db/pool)
::props (ig/ref :app.setup/props)
::wrk/executor (ig/ref ::wrk/executor)
::oidc/providers {:google (ig/ref ::oidc.providers/google)
:github (ig/ref ::oidc.providers/github)
:gitlab (ig/ref ::oidc.providers/gitlab)
:oidc (ig/ref ::oidc.providers/generic)}
::audit/collector (ig/ref ::audit/collector)
::http.session/session (ig/ref :app.http.session/manager)}
:base-uri (cf/get :oidc-base-uri)
:token-uri (cf/get :oidc-token-uri)
:auth-uri (cf/get :oidc-auth-uri)
:user-uri (cf/get :oidc-user-uri)
:scopes (cf/get :oidc-scopes)
:roles-attr (cf/get :oidc-roles-attr)
:roles (cf/get :oidc-roles)}
:app.auth.oidc/routes
{:providers {:google (ig/ref :app.auth.oidc/google-provider)
:github (ig/ref :app.auth.oidc/github-provider)
:gitlab (ig/ref :app.auth.oidc/gitlab-provider)
:oidc (ig/ref :app.auth.oidc/generic-provider)}
:sprops (ig/ref :app.setup/props)
:http-client (ig/ref :app.http/client)
:pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager)
:public-uri (cf/get :public-uri)
:executor (ig/ref ::wrk/executor)}
;; TODO: revisit the dependencies of this service, looks they are too much unused of them ;; TODO: revisit the dependencies of this service, looks they are too much unused of them
:app.http/router :app.http/router
@ -273,12 +276,12 @@
:session (ig/ref :app.http.session/manager) :session (ig/ref :app.http.session/manager)
:awsns-handler (ig/ref :app.http.awsns/handler) :awsns-handler (ig/ref :app.http.awsns/handler)
:debug-routes (ig/ref :app.http.debug/routes) :debug-routes (ig/ref :app.http.debug/routes)
:oidc-routes (ig/ref :app.auth.oidc/routes) :oidc-routes (ig/ref ::oidc/routes)
:ws (ig/ref :app.http.websocket/handler) :ws (ig/ref :app.http.websocket/handler)
:metrics (ig/ref ::mtx/metrics) :metrics (ig/ref ::mtx/metrics)
:public-uri (cf/get :public-uri) :public-uri (cf/get :public-uri)
:storage (ig/ref ::sto/storage) :storage (ig/ref ::sto/storage)
:audit-handler (ig/ref :app.loggers.audit/http-handler) :audit-handler (ig/ref ::audit/http-handler)
:rpc-routes (ig/ref :app.rpc/routes) :rpc-routes (ig/ref :app.rpc/routes)
:doc-routes (ig/ref :app.rpc.doc/routes) :doc-routes (ig/ref :app.rpc.doc/routes)
:executor (ig/ref ::wrk/executor)} :executor (ig/ref ::wrk/executor)}
@ -315,7 +318,9 @@
:scheduled-executor (ig/ref ::wrk/scheduled-executor)} :scheduled-executor (ig/ref ::wrk/scheduled-executor)}
:app.rpc/methods :app.rpc/methods
{:pool (ig/ref ::db/pool) {::audit/collector (ig/ref ::audit/collector)
::http.client/client (ig/ref ::http.client/client)
:pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager) :session (ig/ref :app.http.session/manager)
:sprops (ig/ref :app.setup/props) :sprops (ig/ref :app.setup/props)
:metrics (ig/ref ::mtx/metrics) :metrics (ig/ref ::mtx/metrics)
@ -323,9 +328,8 @@
:msgbus (ig/ref :app.msgbus/msgbus) :msgbus (ig/ref :app.msgbus/msgbus)
:public-uri (cf/get :public-uri) :public-uri (cf/get :public-uri)
:redis (ig/ref ::rds/redis) :redis (ig/ref ::rds/redis)
:audit (ig/ref :app.loggers.audit/collector)
:ldap (ig/ref :app.auth.ldap/provider) :ldap (ig/ref :app.auth.ldap/provider)
:http-client (ig/ref :app.http/client) :http-client (ig/ref ::http.client/client)
:climit (ig/ref :app.rpc/climit) :climit (ig/ref :app.rpc/climit)
:rlimit (ig/ref :app.rpc/rlimit) :rlimit (ig/ref :app.rpc/rlimit)
:executor (ig/ref ::wrk/executor) :executor (ig/ref ::wrk/executor)
@ -350,8 +354,8 @@
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler) :tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
:telemetry (ig/ref :app.tasks.telemetry/handler) :telemetry (ig/ref :app.tasks.telemetry/handler)
:session-gc (ig/ref :app.http.session/gc-task) :session-gc (ig/ref :app.http.session/gc-task)
:audit-log-archive (ig/ref :app.loggers.audit/archive-task) :audit-log-archive (ig/ref ::audit.tasks/archive)
:audit-log-gc (ig/ref :app.loggers.audit/gc-task)}} :audit-log-gc (ig/ref ::audit.tasks/gc)}}
:app.emails/sendmail :app.emails/sendmail
@ -383,52 +387,49 @@
{:pool (ig/ref ::db/pool)} {:pool (ig/ref ::db/pool)}
:app.tasks.telemetry/handler :app.tasks.telemetry/handler
{:pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
:version (:full cf/version) ::http.client/client (ig/ref ::http.client/client)
:uri (cf/get :telemetry-uri) ::props (ig/ref :app.setup/props)}
:sprops (ig/ref :app.setup/props)
:http-client (ig/ref :app.http/client)}
:app.srepl/server :app.srepl/server
{:port (cf/get :srepl-port) {:port (cf/get :srepl-port)
:host (cf/get :srepl-host)} :host (cf/get :srepl-host)}
:app.setup/builtin-templates :app.setup/builtin-templates
{:http-client (ig/ref :app.http/client)} {::http.client/client (ig/ref ::http.client/client)}
:app.setup/props :app.setup/props
{:pool (ig/ref ::db/pool) {:pool (ig/ref ::db/pool)
:key (cf/get :secret-key)} :key (cf/get :secret-key)}
:app.loggers.zmq/receiver ::lzmq/receiver
{:endpoint (cf/get :loggers-zmq-uri)} {}
:app.loggers.audit/http-handler ::audit/http-handler
{:pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor)} ::wrk/executor (ig/ref ::wrk/executor)
::mtx/metrics (ig/ref ::mtx/metrics)}
:app.loggers.audit/collector ::audit/collector
{:pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor)} ::wrk/executor (ig/ref ::wrk/executor)
::mtx/metrics (ig/ref ::mtx/metrics)}
:app.loggers.audit/archive-task ::audit.tasks/archive
{:uri (cf/get :audit-log-archive-uri) {::props (ig/ref :app.setup/props)
:sprops (ig/ref :app.setup/props) ::db/pool (ig/ref ::db/pool)
:pool (ig/ref ::db/pool) ::http.client/client (ig/ref ::http.client/client)}
:http-client (ig/ref :app.http/client)}
:app.loggers.audit/gc-task ::audit.tasks/gc
{:pool (ig/ref ::db/pool)} {::db/pool (ig/ref ::db/pool)}
:app.loggers.loki/reporter :app.loggers.loki/reporter
{:uri (cf/get :loggers-loki-uri) {::lzmq/receiver (ig/ref ::lzmq/receiver)
:receiver (ig/ref :app.loggers.zmq/receiver) ::http.client/client (ig/ref ::http.client/client)}
:http-client (ig/ref :app.http/client)}
:app.loggers.mattermost/reporter :app.loggers.mattermost/reporter
{:uri (cf/get :error-report-webhook) {::lzmq/receiver (ig/ref ::lzmq/receiver)
:receiver (ig/ref :app.loggers.zmq/receiver) ::http.client/client (ig/ref ::http.client/client)}
:http-client (ig/ref :app.http/client)}
:app.loggers.database/reporter :app.loggers.database/reporter
{:receiver (ig/ref :app.loggers.zmq/receiver) {:receiver (ig/ref :app.loggers.zmq/receiver)
@ -502,7 +503,8 @@
::db/pool (ig/ref ::db/pool)} ::db/pool (ig/ref ::db/pool)}
::wrk/worker ::wrk/worker
{::wrk/parallelism (cf/get ::worker-parallelism 3) {::wrk/parallelism (cf/get ::worker-parallelism 1)
;; FIXME: read queues from configuration
::wrk/queue "default" ::wrk/queue "default"
::rds/redis (ig/ref ::rds/redis) ::rds/redis (ig/ref ::rds/redis)
::wrk/registry (ig/ref ::wrk/registry) ::wrk/registry (ig/ref ::wrk/registry)
@ -521,7 +523,7 @@
(merge worker-config)) (merge worker-config))
(ig/prep) (ig/prep)
(ig/init)))) (ig/init))))
(l/info :msg "welcome to penpot" (l/info :hint "welcome to penpot"
:flags (str/join "," (map name cf/flags)) :flags (str/join "," (map name cf/flags))
:worker? (contains? cf/flags :backend-worker) :worker? (contains? cf/flags :backend-worker)
:version (:full cf/version))) :version (:full cf/version)))

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

@ -6,12 +6,15 @@
(ns app.rpc (ns app.rpc
(:require (:require
[app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.http :as-alias http] [app.http :as-alias http]
[app.http.session :as-alias session] [app.http.client :as-alias http.client]
[app.http.session :as-alias http.session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.msgbus :as-alias mbus] [app.msgbus :as-alias mbus]
@ -84,7 +87,7 @@
internal async flow into ring async flow." internal async flow into ring async flow."
[methods {:keys [profile-id session-id params] :as request} respond raise] [methods {:keys [profile-id session-id params] :as request} respond raise]
(let [type (keyword (:type params)) (let [type (keyword (:type params))
data (into {::request request} params) data (into {::http/request request} params)
data (if profile-id data (if profile-id
(assoc data :profile-id profile-id ::session-id session-id) (assoc data :profile-id profile-id ::session-id session-id)
(dissoc data :profile-id)) (dissoc data :profile-id))
@ -103,7 +106,7 @@
[methods {:keys [profile-id session-id params] :as request} respond raise] [methods {:keys [profile-id session-id params] :as request} respond raise]
(let [cmd (keyword (:command params)) (let [cmd (keyword (:command params))
etag (yrq/get-header request "if-none-match") etag (yrq/get-header request "if-none-match")
data (into {::request request ::cond/key etag} params) data (into {::http/request request ::cond/key etag} params)
data (if profile-id data (if profile-id
(assoc data :profile-id profile-id ::session-id session-id) (assoc data :profile-id profile-id ::session-id session-id)
(dissoc data :profile-id)) (dissoc data :profile-id))
@ -143,30 +146,36 @@
mdata)) mdata))
(defn- wrap-audit (defn- wrap-audit
[{:keys [audit] :as cfg} f mdata] [cfg f mdata]
(if audit (if-let [collector (::audit/collector cfg)]
(with-meta (letfn [(handle-audit [params result]
(fn [cfg {:keys [::request] :as params}]
(p/finally (f cfg params)
(fn [result _]
(when result
(let [resultm (meta result) (let [resultm (meta result)
request (::http/request params)
profile-id (or (::audit/profile-id resultm) profile-id (or (::audit/profile-id resultm)
(:profile-id result) (:profile-id result)
(:profile-id params)) (:profile-id params)
uuid/zero)
props (or (::audit/replace-props resultm) props (or (::audit/replace-props resultm)
(-> params (-> params
(merge (::audit/props resultm)) (merge (::audit/props resultm))
(dissoc :type)))] (dissoc :profile-id)
(audit :cmd :submit (dissoc :type)))
:type (or (::audit/type resultm) event {:type (or (::audit/type resultm)
(::type cfg)) (::type cfg))
:name (or (::audit/name resultm) :name (or (::audit/name resultm)
(::sv/name mdata)) (::sv/name mdata))
:profile-id profile-id :profile-id profile-id
:ip-addr (some-> request audit/parse-client-ip) :ip-addr (some-> request audit/parse-client-ip)
:props (dissoc props ::request))))))) :props (d/without-qualified props)}]
mdata) (audit/submit! collector event)))
(handle-request [cfg params]
(->> (f cfg params)
(p/mcat (fn [result]
(->> (handle-audit params result)
(p/map (constantly result)))))))]
(with-meta handle-request mdata))
f)) f))
(defn- wrap (defn- wrap
@ -251,8 +260,6 @@
(map (partial process-method cfg)) (map (partial process-method cfg))
(into {})))) (into {}))))
(s/def ::audit (s/nilable fn?))
(s/def ::http-client fn?)
(s/def ::ldap (s/nilable map?)) (s/def ::ldap (s/nilable map?))
(s/def ::msgbus ::mbus/msgbus) (s/def ::msgbus ::mbus/msgbus)
(s/def ::climit (s/nilable ::climit/climit)) (s/def ::climit (s/nilable ::climit/climit))
@ -262,13 +269,13 @@
(s/def ::sprops map?) (s/def ::sprops map?)
(defmethod ig/pre-init-spec ::methods [_] (defmethod ig/pre-init-spec ::methods [_]
(s/keys :req-un [::sto/storage (s/keys :req [::audit/collector
::session/session ::http.client/client]
:req-un [::sto/storage
::http.session/session
::sprops ::sprops
::audit
::public-uri ::public-uri
::msgbus ::msgbus
::http-client
::rlimit ::rlimit
::climit ::climit
::wrk/executor ::wrk/executor

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

@ -15,7 +15,6 @@
[app.emails :as eml] [app.emails :as eml]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc :as-alias rpc]
[app.rpc.climit :as climit] [app.rpc.climit :as climit]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph] [app.rpc.helpers :as rph]
@ -138,7 +137,7 @@
(-> response (-> response
(rph/with-transform (session/create-fn session (:id profile))) (rph/with-transform (session/create-fn session (:id profile)))
(vary-meta merge {::audit/props (audit/profile->props profile) (rph/with-meta {::audit/props (audit/profile->props profile)
::audit/profile-id (:id profile)})))))) ::audit/profile-id (:id profile)}))))))
(s/def ::login-with-password (s/def ::login-with-password
@ -163,8 +162,7 @@
{:auth false {:auth false
::doc/added "1.15"} ::doc/added "1.15"}
[{:keys [session] :as cfg} _] [{:keys [session] :as cfg} _]
(with-meta {} (rph/with-transform {} (session/delete-fn session)))
{::rpc/transform-response (session/delete-fn session)}))
;; ---- COMMAND: Recover Profile ;; ---- COMMAND: Recover Profile
@ -378,8 +376,6 @@
(create-profile conn) (create-profile conn)
(create-profile-relations conn) (create-profile-relations conn)
(profile/decode-profile-row))) (profile/decode-profile-row)))
audit-fn (:audit cfg)
invitation (when-let [token (:invitation-token params)] invitation (when-let [token (:invitation-token params)]
(tokens/verify sprops {:token token :iss :team-invitation}))] (tokens/verify sprops {:token token :iss :team-invitation}))]
@ -388,10 +384,11 @@
;; accordingly. ;; accordingly.
(when-let [id (:profile-id claims)] (when-let [id (:profile-id claims)]
(db/update! conn :profile {:modified-at (dt/now)} {:id id}) (db/update! conn :profile {:modified-at (dt/now)} {:id id})
(audit-fn :cmd :submit (when-let [collector (::audit/collector cfg)]
:type "fact" (audit/submit! collector
{:type "fact"
:name "register-profile-retry" :name "register-profile-retry"
:profile-id id)) :profile-id id})))
(cond (cond
;; If invitation token comes in params, this is because the ;; If invitation token comes in params, this is because the
@ -404,33 +401,33 @@
(let [claims (assoc invitation :member-id (:id profile)) (let [claims (assoc invitation :member-id (:id profile))
token (tokens/generate sprops claims) token (tokens/generate sprops claims)
resp {:invitation-token token}] resp {:invitation-token token}]
(with-meta resp (-> resp
{::rpc/transform-response (session/create-fn session (:id profile)) (rph/with-transform (session/create-fn session (:id profile)))
::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)})) ::audit/profile-id (:id profile)})))
;; If auth backend is different from "penpot" means user is ;; If auth backend is different from "penpot" means user is
;; registering using third party auth mechanism; in this case ;; registering using third party auth mechanism; in this case
;; we need to mark this session as logged. ;; we need to mark this session as logged.
(not= "penpot" (:auth-backend profile)) (not= "penpot" (:auth-backend profile))
(with-meta (profile/strip-private-attrs profile) (-> (profile/strip-private-attrs profile)
{::rpc/transform-response (session/create-fn session (:id profile)) (rph/with-transform (session/create-fn session (:id profile)))
::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}) ::audit/profile-id (:id profile)}))
;; If the `:enable-insecure-register` flag is set, we proceed ;; If the `:enable-insecure-register` flag is set, we proceed
;; to sign in the user directly, without email verification. ;; to sign in the user directly, without email verification.
(true? is-active) (true? is-active)
(with-meta (profile/strip-private-attrs profile) (-> (profile/strip-private-attrs profile)
{::rpc/transform-response (session/create-fn session (:id profile)) (rph/with-transform (session/create-fn session (:id profile)))
::audit/replace-props (audit/profile->props profile) (rph/with-meta {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}) ::audit/profile-id (:id profile)}))
;; In all other cases, send a verification email. ;; In all other cases, send a verification email.
:else :else
(do (do
(send-email-verification! conn sprops profile) (send-email-verification! conn sprops profile)
(with-meta profile (rph/with-meta profile
{::audit/replace-props (audit/profile->props profile) {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}))))) ::audit/profile-id (:id profile)})))))

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

@ -12,9 +12,9 @@
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.rpc :as-alias rpc]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.util.services :as sv] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -63,15 +63,16 @@
:member-id (:id profile) :member-id (:id profile)
:member-email (:email profile)) :member-email (:email profile))
token (tokens :generate claims)] token (tokens :generate claims)]
(with-meta {:invitation-token token}
{::rpc/transform-response (session/create-fn session (:id profile))
::audit/props (:props profile)
::audit/profile-id (:id profile)}))
(with-meta profile (-> {:invitation-token token}
{::rpc/transform-response (session/create-fn session (:id profile)) (rph/with-transform (session/create-fn session (:id profile)))
::audit/props (:props profile) (rph/with-meta {::audit/props (:props profile)
::audit/profile-id (:id profile)}))))) ::audit/profile-id (:id profile)})))
(-> profile
(rph/with-transform (session/create-fn session (:id profile)))
(rph/with-meta {::audit/props (:props profile)
::audit/profile-id (:id profile)}))))))
(defn- login-or-register (defn- login-or-register
[{:keys [pool] :as cfg} info] [{:keys [pool] :as cfg} info]

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

@ -11,8 +11,8 @@
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc :as-alias rpc]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams] [app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.tokens :as tokens] [app.tokens :as tokens]
@ -48,7 +48,7 @@
{:email email} {:email email}
{:id profile-id}) {:id profile-id})
(with-meta claims (rph/with-meta claims
{::audit/name "update-profile-email" {::audit/name "update-profile-email"
::audit/props {:email email} ::audit/props {:email email}
::audit/profile-id profile-id})) ::audit/profile-id profile-id}))
@ -68,11 +68,11 @@
{:is-active true} {:is-active true}
{:id (:id profile)})) {:id (:id profile)}))
(with-meta claims (-> claims
{::rpc/transform-response (session/create-fn session profile-id) (rph/with-transform (session/create-fn session profile-id))
::audit/name "verify-profile-email" (rph/with-meta {::audit/name "verify-profile-email"
::audit/props (audit/profile->props profile) ::audit/props (audit/profile->props profile)
::audit/profile-id (:id profile)}))) ::audit/profile-id (:id profile)}))))
(defmethod process-token :auth (defmethod process-token :auth
[{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}] [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
@ -148,14 +148,13 @@
;; proceed with accepting the invitation and joining the ;; proceed with accepting the invitation and joining the
;; current profile to the invited team. ;; current profile to the invited team.
(let [profile (accept-invitation cfg claims invitation profile)] (let [profile (accept-invitation cfg claims invitation profile)]
(with-meta (-> (assoc claims :state :created)
(assoc claims :state :created) (rph/with-meta {::audit/name "accept-team-invitation"
{::audit/name "accept-team-invitation"
::audit/props (merge ::audit/props (merge
(audit/profile->props profile) (audit/profile->props profile)
{:team-id (:team-id claims) {:team-id (:team-id claims)
:role (:role claims)}) :role (:role claims)})
::audit/profile-id profile-id})) ::audit/profile-id profile-id})))
(ex/raise :type :validation (ex/raise :type :validation
:code :invalid-token :code :invalid-token
@ -171,15 +170,14 @@
{:email member-email}) {:email member-email})
{:columns [:id :email]})] {:columns [:id :email]})]
(let [profile (accept-invitation cfg claims invitation member)] (let [profile (accept-invitation cfg claims invitation member)]
(with-meta (-> (assoc claims :state :created)
(assoc claims :state :created) (rph/with-transform (session/create-fn session (:id profile)))
{::rpc/transform-response (session/create-fn session (:id profile)) (rph/with-meta {::audit/name "accept-team-invitation"
::audit/name "accept-team-invitation"
::audit/props (merge ::audit/props (merge
(audit/profile->props profile) (audit/profile->props profile)
{:team-id (:team-id claims) {:team-id (:team-id claims)
:role (:role claims)}) :role (:role claims)})
::audit/profile-id member-id})) ::audit/profile-id member-id})))
{:invitation-token token {:invitation-token token
:iss :team-invitation :iss :team-invitation

5
backend/src/app/rpc/helpers.clj
View file

@ -6,6 +6,7 @@
(ns app.rpc.helpers (ns app.rpc.helpers
"General purpose RPC helpers." "General purpose RPC helpers."
(:refer-clojure :exclude [with-meta])
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.http :as-alias http] [app.http :as-alias http]
@ -59,6 +60,10 @@
[mdw hook-fn] [mdw hook-fn]
(vary-meta mdw update ::rpc/before-complete-fns conj hook-fn)) (vary-meta mdw update ::rpc/before-complete-fns conj hook-fn))
(defn with-meta
[mdw mdata]
(vary-meta mdw merge mdata))
(defn with-http-cache (defn with-http-cache
[mdw max-age] [mdw max-age]
(vary-meta mdw update ::rpc/response-transform-fns conj (vary-meta mdw update ::rpc/response-transform-fns conj

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

@ -11,9 +11,11 @@
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.loggers.audit :as-alias audit]
[app.media :as media] [app.media :as media]
[app.rpc.climit :as-alias climit] [app.rpc.climit :as-alias climit]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.teams :as teams] [app.rpc.queries.teams :as teams]
[app.storage :as sto] [app.storage :as sto]
[app.util.services :as sv] [app.util.services :as sv]
@ -104,10 +106,13 @@
:ttf-file-id (:id ttf)})) :ttf-file-id (:id ttf)}))
] ]
(-> (generate-fonts data) (->> (generate-fonts data)
(p/then validate-data) (p/map validate-data)
(p/then persist-fonts executor) (p/mcat executor persist-fonts)
(p/then insert-into-db executor)))) (p/map executor insert-into-db)
(p/map (fn [result]
(let [params (update params :data (comp vec keys))]
(rph/with-meta result {::audit/replace-props params})))))))
;; --- UPDATE FONT FAMILY ;; --- UPDATE FONT FAMILY

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

@ -13,6 +13,7 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.http.client :as http]
[app.media :as media] [app.media :as media]
[app.rpc.climit :as climit] [app.rpc.climit :as climit]
[app.rpc.queries.teams :as teams] [app.rpc.queries.teams :as teams]
@ -186,7 +187,7 @@
(create-file-media-object-from-url cfg params))) (create-file-media-object-from-url cfg params)))
(defn- create-file-media-object-from-url (defn- create-file-media-object-from-url
[{:keys [http-client] :as cfg} {:keys [url name] :as params}] [cfg {:keys [url name] :as params}]
(letfn [(parse-and-validate-size [headers] (letfn [(parse-and-validate-size [headers]
(let [size (some-> (get headers "content-length") d/parse-integer) (let [size (some-> (get headers "content-length") d/parse-integer)
mtype (get headers "content-type") mtype (get headers "content-type")
@ -215,7 +216,7 @@
:format format})) :format format}))
(download-media [uri] (download-media [uri]
(-> (http-client {:method :get :uri uri} {:response-type :input-stream}) (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
(p/then process-response))) (p/then process-response)))
(process-response [{:keys [body headers] :as response}] (process-response [{:keys [body headers] :as response}]

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

@ -19,6 +19,7 @@
[app.rpc.climit :as-alias climit] [app.rpc.climit :as-alias climit]
[app.rpc.commands.auth :as cmd.auth] [app.rpc.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams] [app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.storage :as sto] [app.storage :as sto]
@ -48,6 +49,7 @@
:opt-un [::lang ::theme])) :opt-un [::lang ::theme]))
(sv/defmethod ::update-profile (sv/defmethod ::update-profile
{::doc/added "1.0"}
[{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use ;; NOTE: we need to retrieve the profile independently if we use
@ -70,8 +72,11 @@
:props (db/tjson (:props profile))} :props (db/tjson (:props profile))}
{:id profile-id}) {:id profile-id})
(with-meta (-> profile profile/strip-private-attrs d/without-nils) (-> profile
{::audit/props (audit/profile->props profile)})))) profile/strip-private-attrs
d/without-nils
(rph/with-meta {::audit/props (audit/profile->props profile)})))))
;; --- MUTATION: Update Password ;; --- MUTATION: Update Password
@ -133,7 +138,7 @@
(update-profile-photo cfg params))) (update-profile-photo cfg params)))
(defn update-profile-photo (defn update-profile-photo
[{:keys [pool storage executor] :as cfg} {:keys [profile-id] :as params}] [{:keys [pool storage executor] :as cfg} {:keys [profile-id file] :as params}]
(p/let [profile (px/with-dispatch executor (p/let [profile (px/with-dispatch executor
(db/get-by-id pool :profile profile-id)) (db/get-by-id pool :profile profile-id))
photo (teams/upload-photo cfg params)] photo (teams/upload-photo cfg params)]
@ -146,7 +151,13 @@
(db/update! pool :profile (db/update! pool :profile
{:photo-id (:id photo)} {:photo-id (:id photo)}
{:id profile-id}) {:id profile-id})
nil))
(-> (rph/wrap)
(rph/with-meta {::audit/replace-props
{:file-name (:filename file)
:file-size (:size file)
:file-path (str (:path file))
:file-mtype (:mtype file)}}))))
;; --- MUTATION: Request Email Change ;; --- MUTATION: Request Email Change
@ -278,8 +289,7 @@
{:deleted-at deleted-at} {:deleted-at deleted-at}
{:id profile-id}) {:id profile-id})
(with-meta {} (rph/with-transform {} (session/delete-fn session)))))
{::rpc/transform-response (session/delete-fn session)}))))
(def sql:owned-teams (def sql:owned-teams
"with owner_teams as ( "with owner_teams as (
@ -298,77 +308,3 @@
(defn- get-owned-teams-with-participants (defn- get-owned-teams-with-participants
[conn profile-id] [conn profile-id]
(db/exec! conn [sql:owned-teams profile-id profile-id])) (db/exec! conn [sql:owned-teams profile-id profile-id]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DEPRECATED METHODS (TO BE REMOVED ON 1.16.x)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- MUTATION: Login
(s/def ::login ::cmd.auth/login-with-password)
(sv/defmethod ::login
{:auth false
::climit/queue :auth
::doc/added "1.0"
::doc/deprecated "1.15"}
[cfg params]
(cmd.auth/login-with-password cfg params))
;; --- MUTATION: Logout
(s/def ::logout ::cmd.auth/logout)
(sv/defmethod ::logout
{:auth false
::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [session] :as cfg} _]
(with-meta {}
{::rpc/transform-response (session/delete-fn session)}))
;; --- MUTATION: Recover Profile
(s/def ::recover-profile ::cmd.auth/recover-profile)
(sv/defmethod ::recover-profile
{::doc/added "1.0"
::doc/deprecated "1.15"}
[cfg params]
(cmd.auth/recover-profile cfg params))
;; --- MUTATION: Prepare Register
(s/def ::prepare-register-profile ::cmd.auth/prepare-register-profile)
(sv/defmethod ::prepare-register-profile
{:auth false
::doc/added "1.0"
::doc/deprecated "1.15"}
[cfg params]
(cmd.auth/prepare-register cfg params))
;; --- MUTATION: Register Profile
(s/def ::register-profile ::cmd.auth/register-profile)
(sv/defmethod ::register-profile
{:auth false
::climit/queue :auth
::doc/added "1.0"
::doc/deprecated "1.15"}
[{:keys [pool] :as cfg} params]
(db/with-atomic [conn pool]
(-> (assoc cfg :conn conn)
(cmd.auth/register-profile params))))
;; --- MUTATION: Request Profile Recovery
(s/def ::request-profile-recovery ::cmd.auth/request-profile-recovery)
(sv/defmethod ::request-profile-recovery
{:auth false
::doc/added "1.0"
::doc/deprecated "1.15"}
[cfg params]
(cmd.auth/request-profile-recovery cfg params))

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

@ -474,7 +474,6 @@
[{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id emails role] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(let [team (create-team conn params) (let [team (create-team conn params)
audit-fn (:audit cfg)
profile (db/get-by-id conn :profile profile-id)] profile (db/get-by-id conn :profile profile-id)]
;; Create invitations for all provided emails. ;; Create invitations for all provided emails.
@ -490,14 +489,15 @@
(-> team (-> team
(vary-meta assoc ::audit/props {:invitations (count emails)}) (vary-meta assoc ::audit/props {:invitations (count emails)})
(rph/with-defer (rph/with-defer
#(audit-fn :cmd :submit #(when-let [collector (::audit/collector cfg)]
:type "mutation" (audit/submit! collector
{:type "mutation"
:name "invite-team-member" :name "invite-team-member"
:profile-id profile-id :profile-id profile-id
:props {:emails emails :props {:emails emails
:role role :role role
:profile-id profile-id :profile-id profile-id
:invitations (count emails)})))))) :invitations (count emails)}})))))))
;; --- Mutation: Update invitation role ;; --- Mutation: Update invitation role

5
backend/src/app/setup.clj
View file

@ -8,8 +8,10 @@
"Initial data setup of instance." "Initial data setup of instance."
(:require (:require
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.main :as-alias main]
[app.setup.builtin-templates] [app.setup.builtin-templates]
[app.setup.keys :as keys] [app.setup.keys :as keys]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
@ -48,6 +50,9 @@
:cause cause)))) :cause cause))))
instance-id))) instance-id)))
(s/def ::main/props
(s/map-of ::us/keyword some?))
(defmethod ig/pre-init-spec ::props [_] (defmethod ig/pre-init-spec ::props [_]
(s/keys :req-un [::db/pool])) (s/keys :req-un [::db/pool]))

6
backend/src/app/setup/builtin_templates.clj
View file

@ -29,10 +29,8 @@
(s/keys :req-un [::id ::name ::thumbnail-uri ::file-uri] (s/keys :req-un [::id ::name ::thumbnail-uri ::file-uri]
:opt-un [::path])) :opt-un [::path]))
(s/def ::http-client ::http/client)
(defmethod ig/pre-init-spec :app.setup/builtin-templates [_] (defmethod ig/pre-init-spec :app.setup/builtin-templates [_]
(s/keys :req-un [::http-client])) (s/keys :req [::http/client]))
(defmethod ig/init-key :app.setup/builtin-templates (defmethod ig/init-key :app.setup/builtin-templates
[_ cfg] [_ cfg]
@ -43,7 +41,7 @@
(defn- download-preset! (defn- download-preset!
[cfg {:keys [path file-uri] :as preset}] [cfg {:keys [path file-uri] :as preset}]
(let [response (http/req! (:http-client cfg) (let [response (http/req! cfg
{:method :get {:method :get
:uri file-uri} :uri file-uri}
{:response-type :input-stream {:response-type :input-stream

35
backend/src/app/tasks/telemetry.clj
View file

@ -11,13 +11,14 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.util.async :refer [thread-sleep]] [app.http.client :as http]
[app.main :as-alias main]
[app.util.json :as json] [app.util.json :as json]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig])) [integrant.core :as ig]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASK ENTRY POINT ;; TASK ENTRY POINT
@ -28,18 +29,13 @@
(declare get-subscriptions-newsletter-updates) (declare get-subscriptions-newsletter-updates)
(declare get-subscriptions-newsletter-news) (declare get-subscriptions-newsletter-news)
(s/def ::http-client fn?)
(s/def ::version ::us/string)
(s/def ::uri ::us/string)
(s/def ::instance-id ::us/uuid)
(s/def ::sprops
(s/keys :req-un [::instance-id]))
(defmethod ig/pre-init-spec ::handler [_] (defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::http-client ::version ::uri ::sprops])) (s/keys :req [::http/client
::db/pool
::main/props]))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [pool sprops version] :as cfg}] [_ {:keys [::db/pool ::main/props] :as cfg}]
(fn [{:keys [send? enabled?] :or {send? true enabled? false}}] (fn [{:keys [send? enabled?] :or {send? true enabled? false}}]
(let [subs {:newsletter-updates (get-subscriptions-newsletter-updates pool) (let [subs {:newsletter-updates (get-subscriptions-newsletter-updates pool)
:newsletter-news (get-subscriptions-newsletter-news pool)} :newsletter-news (get-subscriptions-newsletter-news pool)}
@ -48,15 +44,15 @@
(cf/get :telemetry-enabled)) (cf/get :telemetry-enabled))
data {:subscriptions subs data {:subscriptions subs
:version version :version (:full cf/version)
:instance-id (:instance-id sprops)}] :instance-id (:instance-id props)}]
(cond (cond
;; If we have telemetry enabled, then proceed the normal ;; If we have telemetry enabled, then proceed the normal
;; operation. ;; operation.
enabled? enabled?
(let [data (merge data (get-stats pool))] (let [data (merge data (get-stats pool))]
(when send? (when send?
(thread-sleep (rand-int 10000)) (px/sleep (rand-int 10000))
(send! cfg data)) (send! cfg data))
data) data)
@ -68,7 +64,7 @@
(seq subs) (seq subs)
(do (do
(when send? (when send?
(thread-sleep (rand-int 10000)) (px/sleep (rand-int 10000))
(send! cfg data)) (send! cfg data))
data) data)
@ -80,9 +76,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- send! (defn- send!
[{:keys [http-client uri] :as cfg} data] [cfg data]
(let [response (http-client {:method :post (let [response (http/req! cfg
:uri uri {:method :post
:uri (cf/get :telemetry-uri)
:headers {"content-type" "application/json"} :headers {"content-type" "application/json"}
:body (json/write-str data)} :body (json/write-str data)}
{:sync? true})] {:sync? true})]

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

@ -288,10 +288,10 @@
::queue ::queue
::registry])) ::registry]))
;; FIXME: define queue as set
(defmethod ig/prep-key ::worker (defmethod ig/prep-key ::worker
[_ cfg] [_ cfg]
(merge {::queue "default" (merge {::queue "default" ::parallelism 1}
::parallelism 1}
(d/without-nils cfg))) (d/without-nils cfg)))
(defmethod ig/init-key ::worker (defmethod ig/init-key ::worker
@ -666,10 +666,10 @@
props (-> options extract-props db/tjson) props (-> options extract-props db/tjson)
id (uuid/next)] id (uuid/next)]
(l/debug :action "submit task" (l/debug :hint "submit task"
:name (d/name task) :name (d/name task)
:queue queue :queue queue
:in duration) :in (dt/format-duration duration))
(db/exec-one! conn [sql:insert-new-task id (d/name task) props (db/exec-one! conn [sql:insert-new-task id (d/name task) props
queue priority max-retries interval]) queue priority max-retries interval])

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

@ -101,9 +101,9 @@
(t/deftest test-parse-bounce-report (t/deftest test-parse-bounce-report
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
cfg {:sprops sprops} cfg {:app.main/props props}
report (bounce-report {:token (tokens/generate sprops report (bounce-report {:token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
result (#'awsns/parse-notification cfg report)] result (#'awsns/parse-notification cfg report)]
@ -118,9 +118,9 @@
(t/deftest test-parse-complaint-report (t/deftest test-parse-complaint-report
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
cfg {:sprops sprops} cfg {:app.main/props props}
report (complaint-report {:token (tokens/generate sprops report (complaint-report {:token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
result (#'awsns/parse-notification cfg report)] result (#'awsns/parse-notification cfg report)]
@ -133,8 +133,8 @@
)) ))
(t/deftest test-parse-complaint-report-without-token (t/deftest test-parse-complaint-report-without-token
(let [sprops (:app.setup/props th/*system*) (let [props (:app.setup/props th/*system*)
cfg {:sprops sprops} cfg {:app.main/props props}
report (complaint-report {:token ""}) report (complaint-report {:token ""})
result (#'awsns/parse-notification cfg report)] result (#'awsns/parse-notification cfg report)]
(t/is (= "complaint" (:type result))) (t/is (= "complaint" (:type result)))
@ -146,10 +146,10 @@
(t/deftest test-process-bounce-report (t/deftest test-process-bounce-report
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool} cfg {:app.main/props props :app.db/pool pool}
report (bounce-report {:token (tokens/generate sprops report (bounce-report {:token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)] report (#'awsns/parse-notification cfg report)]
@ -175,10 +175,11 @@
(t/deftest test-process-complaint-report (t/deftest test-process-complaint-report
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool} cfg {:app.main/props props
report (complaint-report {:token (tokens/generate sprops :app.db/pool pool}
report (complaint-report {:token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)] report (#'awsns/parse-notification cfg report)]
@ -206,11 +207,11 @@
(t/deftest test-process-bounce-report-to-self (t/deftest test-process-bounce-report-to-self
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool} cfg {:app.main/props props :app.db/pool pool}
report (bounce-report {:email (:email profile) report (bounce-report {:email (:email profile)
:token (tokens/generate sprops :token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)] report (#'awsns/parse-notification cfg report)]
@ -228,11 +229,11 @@
(t/deftest test-process-complaint-report-to-self (t/deftest test-process-complaint-report-to-self
(let [profile (th/create-profile* 1) (let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*) props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*) pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool} cfg {:app.main/props props :app.db/pool pool}
report (complaint-report {:email (:email profile) report (complaint-report {:email (:email profile)
:token (tokens/generate sprops :token (tokens/generate props
{:iss :profile-identity {:iss :profile-identity
:profile-id (:id profile)})}) :profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)] report (#'awsns/parse-notification cfg report)]

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

@ -56,10 +56,10 @@
;; Test with good credentials but profile already activated ;; Test with good credentials but profile already activated
(t/deftest profile-login-success (t/deftest profile-login-success
(let [profile (th/create-profile* 1 {:is-active true}) (let [profile (th/create-profile* 1 {:is-active true})
data {::th/type :login data {::th/type :login-with-password
:email "profile1.test@nodomain.com" :email "profile1.test@nodomain.com"
:password "123123"} :password "123123"}
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= (:id profile) (get-in out [:result :id]))))) (t/is (= (:id profile) (get-in out [:result :id])))))
@ -198,7 +198,7 @@
(let [data {::th/type :prepare-register-profile (let [data {::th/type :prepare-register-profile
:email "user@example.com" :email "user@example.com"
:password "foobar"} :password "foobar"}
out (th/mutation! data) out (th/command! data)
token (get-in out [:result :token])] token (get-in out [:result :token])]
(t/is (string? token)) (t/is (string? token))
@ -207,7 +207,7 @@
(let [data {::th/type :register-profile (let [data {::th/type :register-profile
:fullname "foobar" :fullname "foobar"
:accept-terms-and-privacy true} :accept-terms-and-privacy true}
out (th/mutation! data)] out (th/command! data)]
(let [error (:error out)] (let [error (:error out)]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation)) (t/is (th/ex-of-type? error :validation))
@ -219,7 +219,8 @@
:fullname "foobar" :fullname "foobar"
:accept-terms-and-privacy true :accept-terms-and-privacy true
:accept-newsletter-subscription true}] :accept-newsletter-subscription true}]
(let [{:keys [result error]} (th/mutation! data)] (let [{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error)))) (t/is (nil? error))))
)) ))
@ -302,7 +303,7 @@
:email "user@example.com" :email "user@example.com"
:password "foobar"} :password "foobar"}
{:keys [result error] :as out} (th/mutation! data)] {:keys [result error] :as out} (th/command! data)]
(t/is (nil? error)) (t/is (nil? error))
(t/is (map? result)) (t/is (map? result))
(t/is (string? (:token result))) (t/is (string? (:token result)))
@ -312,7 +313,7 @@
:token rtoken :token rtoken
:fullname "foobar"} :fullname "foobar"}
{:keys [result error] :as out} (th/mutation! data)] {:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? error)) (t/is (nil? error))
(t/is (map? result)) (t/is (map? result))
@ -467,7 +468,7 @@
;; with valid email inactive user ;; with valid email inactive user
(let [data (assoc data :email (:email profile1)) (let [data (assoc data :email (:email profile1))
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
(t/is (= 0 (:call-count @mock))) (t/is (= 0 (:call-count @mock)))
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
@ -476,7 +477,7 @@
;; with valid email and active user ;; with valid email and active user
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:result out))) (t/is (nil? (:result out)))
(t/is (= 1 (:call-count @mock)))) (t/is (= 1 (:call-count @mock))))
@ -484,7 +485,7 @@
;; with valid email and active user with global complaints ;; with valid email and active user with global complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email profile2)}) (th/create-global-complaint-for pool {:type :complaint :email (:email profile2)})
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/mutation! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:result out))) (t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock)))) (t/is (= 2 (:call-count @mock))))
@ -492,7 +493,7 @@
;; with valid email and active user with global bounce ;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)}) (th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
(let [data (assoc data :email (:email profile2)) (let [data (assoc data :email (:email profile2))
out (th/mutation! data) out (th/command! data)
error (:error out)] error (:error out)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (= 2 (:call-count @mock))) (t/is (= 2 (:call-count @mock)))

5
common/src/app/common/exceptions.cljc
View file

@ -41,6 +41,11 @@
[& exprs] [& exprs]
`(try* (^:once fn* [] ~@exprs) identity)) `(try* (^:once fn* [] ~@exprs) identity))
(defn cause
"Retrieve chained cause if available of the exception."
[^Throwable throwable]
(.getCause throwable))
(defn ex-info? (defn ex-info?
[v] [v]
(instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v)) (instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v))

2
common/test/common_tests/types_shape_interactions_test.cljc
View file

@ -30,7 +30,7 @@
(t/is (= :mouse-press (:event-type new-interaction))))) (t/is (= :mouse-press (:event-type new-interaction)))))
(t/testing "Set after delay on non-frame" (t/testing "Set after delay on non-frame"
(let [result (ex/try (let [result (ex/try!
(ctsi/set-event-type interaction :after-delay shape))] (ctsi/set-event-type interaction :after-delay shape))]
(t/is (ex/exception? result)))) (t/is (ex/exception? result))))

4
frontend/src/app/main/data/workspace/svg_upload.cljs
View file

@ -7,14 +7,12 @@
(ns app.main.data.workspace.svg-upload (ns app.main.data.workspace.svg-upload
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt] [app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh] [app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb] [app.common.pages.changes-builder :as pcb]
[app.common.pages.helpers :as cph] [app.common.pages.helpers :as cph]
[app.common.spec :refer [max-safe-int min-safe-int]] [app.common.spec :as us :refer [max-safe-int min-safe-int]]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.types.shape-tree :as ctst] [app.common.types.shape-tree :as ctst]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]

1
frontend/src/app/util/color.cljs
View file

@ -7,7 +7,6 @@
(ns app.util.color (ns app.util.color
"Color conversion utils." "Color conversion utils."
(:require (:require
[app.common.exceptions :as ex]
[app.util.object :as obj] [app.util.object :as obj]
[cuerdas.core :as str] [cuerdas.core :as str]
[goog.color :as gcolor])) [goog.color :as gcolor]))