Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-01-08 16:00:19 -05:00
Code Issues 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
Show stats Download patch file Download diff file Expand all files Collapse all files

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

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

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

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

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

@ -12,7 +12,9 @@
[app.db :as db]
[app.db.sql :as sql]
[app.http.client :as http]
[app.main :as-alias main]
[app.tokens :as tokens]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
@ -26,21 +28,21 @@
(declare parse-notification)
(declare process-report)
(s/def ::http-client ::http/client)
(s/def ::sprops map?)
(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
[_ {:keys [executor] :as cfg}]
[_ {:keys [::wrk/executor] :as cfg}]
(fn [request respond _]
(let [data (-> request yrq/body slurp)]
(px/run! executor #(handle-request cfg data)))
(respond (yrs/response 200))))
(defn handle-request
[{:keys [http-client] :as cfg} data]
[cfg data]
(try
(let [body (parse-json data)
mtype (get body "Type")]
@ -49,7 +51,7 @@
(let [surl (get body "SubscribeURL")
stopic (get body "TopicArn")]
(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")
(when-let [message (parse-json (get body "Message"))]
@ -100,10 +102,11 @@
(get mail "headers")))
(defn- extract-identity
[{:keys [sprops]} headers]
[cfg headers]
(let [tdata (get headers "x-penpot-data")]
(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)))))
(defn- parse-notification
@ -136,7 +139,7 @@
(j/read-value v)))
(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")
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
@ -165,7 +168,7 @@
{:id profile-id}))))))
(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/insert! conn :profile-complaint-report
{:profile-id profile-id

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

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

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

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

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

@ -15,20 +15,27 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[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.util.async :as aa]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[lambdaisland.uri :as u]
[promesa.core :as p]
[promesa.exec :as px]
[promesa.exec.bulkhead :as pxb]
[yetti.request :as yrq]
[yetti.response :as yrs]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn parse-client-ip
[request]
(or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
@ -49,10 +56,23 @@
(assoc (->> sk str/kebab (keyword "penpot")) v))))]
(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
[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))
(d/without-nils)))
@ -79,11 +99,7 @@
(update event :props #(into {} xform %))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HTTP Handler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare persist-http-events)
;; --- SPECS
(s/def ::profile-id ::us/uuid)
(s/def ::name ::us/string)
@ -98,161 +114,174 @@
(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
[_ {:keys [executor pool] :as cfg}]
(if (or (db/read-only? pool) (not (contains? cf/flags :audit-log)))
[_ {:keys [::wrk/executor ::db/pool ::mtx/metrics ::concurrency] :as cfg}]
(if (or (db/read-only? pool)
(not (contains? cf/flags :audit-log)))
(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 _]
(respond (yrs/response 204))))
(letfn [(handler [{:keys [profile-id] :as request}]
(letfn [(event->row [event]
[(uuid/next)
(:name event)
(:source event)
(:type event)
(:timestamp event)
(:profile-id event)
(db/inet (:ip-addr event))
(db/tjson (:props 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)
cfg (-> cfg
(assoc :source "frontend")
(assoc :events events)
(assoc :ip-addr ip-addr))]
(persist-http-events cfg)))
xform (comp
(map #(assoc % :ip-addr ip-addr))
(map #(assoc % :source "frontend"))
(map event->row))
(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))))]
columns [:id :name :source :type :tracked-at
:profile-id :ip-addr :props :context]]
(when (seq events)
(->> (into [] xform events)
(db/insert-multi! pool :audit-log columns)))))
(fn [request respond _]
;; Fire and forget, log error in case of error
(-> (px/submit! executor #(handler request))
(p/catch handle-error))
(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)))
(respond (yrs/response 204))))))
(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)))
(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)
(:name event)
source
(:type event)
(:timestamp event)
(:profile-id event)
(db/inet ip-addr)
(db/tjson (:props event))
(db/tjson (d/without-nils (:context event)))]))]
(when (seq events)
(->> (into [] prepare-xf events)
(db/insert-multi! pool :audit-log columns)))))
(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
;; internal database. Later this audit log can be transferred to
;; 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 [_]
(s/keys :req-un [::db/pool ::wrk/executor]))
(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)))
(s/keys :req [::db/pool ::wrk/executor ::mtx/metrics]))
(defmethod ig/init-key ::collector
[_ {:keys [pool] :as cfg}]
[_ {:keys [::db/pool] :as cfg}]
(cond
(not (contains? cf/flags :audit-log))
(do
(l/info :hint "audit log collection disabled")
(constantly nil))
(l/info :hint "audit: log collection disabled")
(db/read-only? pool)
(do
(l/warn :hint "audit log collection disabled, db is read-only")
(constantly nil))
(l/warn :hint "audit: log collection disabled (db is read-only)")
:else
(let [input (a/chan 512 backend-event-xform)
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))))
cfg))
(fn [& {:keys [cmd] :as params}]
(case cmd
:stop
(a/close! input)
(defn- persist-event!
[pool event]
(us/verify! ::backend-event event)
(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
(let [params (-> params
(dissoc :cmd)
(assoc :tracked-at (dt/now)))]
(when-not (a/offer! input params)
(l/warn :hint "activity channel is full"))))))))
(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)))))))
(defn submit!
"Submit audit event to the collector."
[{:keys [::wrk/executor ::db/pool]} params]
(->> (px/submit! executor (partial persist-event! pool (d/without-nils params)))
(p/err (fn [cause]
(l/error :hint "audit: unexpected error processing event" :cause cause)
(p/resolved nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
(declare archive-events)
(s/def ::http-client fn?)
(s/def ::uri ::us/string)
(s/def ::sprops map?)
(s/def ::tasks/uri ::us/string)
(defmethod ig/pre-init-spec ::archive-task [_]
(s/keys :req-un [::db/pool ::sprops ::http-client]
:opt-un [::uri]))
(defmethod ig/pre-init-spec ::tasks/archive-task [_]
(s/keys :req [::db/pool ::main/props ::http/client]))
(defmethod ig/init-key ::archive-task
[_ {:keys [uri] :as cfg}]
(fn [props]
(defmethod ig/init-key ::tasks/archive
[_ cfg]
(fn [params]
;; NOTE: this let allows overwrite default configured values from
;; the repl, when manually invoking the task.
(let [enabled (or (contains? cf/flags :audit-log-archive)
(:enabled props false))
uri (or uri (:uri props))
cfg (assoc cfg :uri uri)]
(:enabled params false))
uri (cf/get :audit-log-archive-uri)
uri (or uri (:uri params))
cfg (assoc cfg ::uri uri)]
(when (and enabled (not uri))
(ex/raise :type :internal
@ -264,20 +293,21 @@
(let [n (archive-events cfg)]
(if n
(do
(aa/thread-sleep 100)
(px/sleep 100)
(recur (+ total n)))
(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
"select * from audit_log
(def ^:private sql:retrieve-batch-of-audit-log
"select *
from audit_log
where archived_at is null
order by created_at asc
limit 256
for update skip locked;")
(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}]
(cond-> row
(db/pgobject? props)
@ -301,9 +331,11 @@
:context]))
(send [events]
(let [token (tokens/generate sprops {:iss "authentication"
:iat (dt/now)
:uid uuid/zero})
(let [token (tokens/generate (::main/props cfg)
{:iss "authentication"
:iat (dt/now)
:uid uuid/zero})
;; FIXME tokens/generate
body (t/encode {:events events})
headers {"content-type" "application/transit+json"
"origin" (cf/get :public-uri)
@ -313,7 +345,7 @@
:method :post
:headers headers
:body body}
resp (http-client params {:sync? true})]
resp (http/req! cfg params {:sync? true})]
(if (= (:status resp) 204)
true
(do
@ -334,7 +366,7 @@
(map row->event))
events (into [] xform rows)]
(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)
(mark-as-archived conn rows)
(count events)))))))
@ -343,7 +375,7 @@
;; GC Task
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def sql:clean-archived
(def ^:private sql:clean-archived
"delete from audit_log
where archived_at is not null")
@ -354,10 +386,10 @@
(l/debug :hint "delete archived audit log entries" :deleted result)
result))
(defmethod ig/pre-init-spec ::gc-task [_]
(s/keys :req-un [::db/pool]))
(defmethod ig/pre-init-spec ::tasks/gc [_]
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::gc-task
(defmethod ig/init-key ::tasks/gc
[_ cfg]
(fn [_]
(clean-archived cfg)))

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

@ -8,58 +8,55 @@
"A Loki integration."
(:require
[app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cfg]
[app.config :as cf]
[app.http.client :as http]
[app.loggers.zmq :as lzmq]
[app.util.json :as json]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
[integrant.core :as ig]
[promesa.exec :as px]))
(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 [_]
(s/keys :req-un [ ::receiver ::http-client]
:opt-un [::uri]))
(s/keys :req [::http/client
::lzmq/receiver]))
(defmethod ig/init-key ::reporter
[_ {:keys [receiver uri] :as cfg}]
(when uri
(l/info :msg "initializing loki reporter" :uri uri)
(let [input (a/chan (a/dropping-buffer 2048))]
(receiver :sub input)
[_ cfg]
(when-let [uri (cf/get :loggers-loki-uri)]
(px/thread
{:name "penpot/loki-reporter"}
(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))
(.setDaemon true)
(.setName "penpot/loki-sender")
(.start))
(try
(lzmq/sub! (::lzmq/receiver cfg) input)
(loop []
(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
[_ output]
(when output
(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"))
[_ thread]
(some-> thread px/interrupt!))
(defn- prepare-payload
[event]
(let [labels {:host (cfg/get :host)
:tenant (cfg/get :tenant)
:version (:full cfg/version)
(let [labels {:host (cf/get :host)
:tenant (cf/get :tenant)
:version (:full cf/version)
:logger (:logger/name event)
:level (:logger/level event)}]
{:streams
@ -69,15 +66,15 @@
(when-let [error (:trace event)]
(str "\n" error)))]]}]}))
(defn- make-request
[{:keys [http-client uri] :as cfg} payload]
(http-client {:uri uri
:timeout 3000
:method :post
:headers {"content-type" "application/json"}
:body (json/write payload)}
{:sync? true}))
[{:keys [::uri] :as cfg} payload]
(http/req! cfg
{:uri uri
:timeout 3000
:method :post
:headers {"content-type" "application/json"}
:body (json/write payload)}
{:sync? true}))
(defn- handle-event
[cfg event]

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

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

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

@ -9,13 +9,15 @@
(:require
[app.common.exceptions :as ex]
[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.time :as dt]
[clojure.core.async :as a]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig])
[integrant.core :as ig]
[promesa.exec :as px])
(:import
org.zeromq.SocketType
org.zeromq.ZMQ$Socket
@ -24,38 +26,56 @@
(declare prepare)
(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
[_ {:keys [endpoint] :as cfg}]
(l/info :msg "initializing ZMQ receiver" :bind endpoint)
(let [buffer (a/chan 1)
[_ cfg]
(let [uri (cf/get :loggers-zmq-uri)
buffer (a/chan 1)
output (a/chan 1 (comp (filter map?)
(keep prepare)))
mult (a/mult output)]
(when endpoint
(let [thread (Thread. #(start-rcv-loop {:out buffer :endpoint endpoint}))]
(.setDaemon thread false)
(.setName thread "penpot/zmq-logger-receiver")
(.start thread)))
mult (a/mult output)
thread (when uri
(px/thread
{:name "penpot/zmq-receiver"
:daemon false}
(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)
(with-meta
(fn [cmd ch]
(case cmd
:sub (a/tap mult ch)
:unsub (a/untap mult ch))
ch)
{::output output
::buffer buffer
::mult mult})))
(-> cfg
(assoc ::receiver/mult mult)
(assoc ::receiver/thread thread)
(assoc ::receiver/output output)
(assoc ::receiver/buffer buffer))))
(s/def ::receiver/mult some?)
(s/def ::receiver/thread #(instance? Thread %))
(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
[_ f]
(a/close! (::buffer (meta f))))
[_ {:keys [::receiver/buffer ::receiver/thread]}]
(some-> thread px/interrupt!)
(some-> buffer a/close!))
(def ^:private json-mapper
(json/mapper
@ -63,23 +83,23 @@
:decode-key-fn (comp keyword str/kebab)}))
(defn- start-rcv-loop
([] (start-rcv-loop nil))
([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}]
(let [out (or out (a/chan 1))
zctx (ZContext. 1)
socket (.. zctx (createSocket SocketType/SUB))]
(.. socket (connect ^String endpoint))
(.. socket (subscribe ""))
(.. socket (setReceiveTimeOut 5000))
(loop []
(let [msg (.recv ^ZMQ$Socket socket)
msg (ex/ignoring (json/read msg json-mapper))
msg (if (nil? msg) :empty msg)]
(if (a/>!! out msg)
(recur)
(do
(.close ^java.lang.AutoCloseable socket)
(.destroy ^ZContext zctx))))))))
[output endpoint]
(let [zctx (ZContext. 1)
socket (.. zctx (createSocket SocketType/SUB))]
(try
(.. socket (connect ^String endpoint))
(.. socket (subscribe ""))
(.. socket (setReceiveTimeOut 5000))
(loop []
(let [msg (.recv ^ZMQ$Socket socket)
msg (ex/ignoring (json/read msg json-mapper))
msg (if (nil? msg) :empty msg)]
(when (a/>!! output msg)
(recur))))
(finally
(.close ^java.lang.AutoCloseable socket)
(.destroy ^ZContext zctx)))))
(s/def ::logger-name string?)
(s/def ::level string?)

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

@ -6,10 +6,16 @@
(ns app.main
(:require
[app.auth.oidc]
[app.auth.oidc :as-alias oidc]
[app.auth.oidc.providers :as-alias oidc.providers]
[app.common.logging :as l]
[app.config :as cf]
[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.definition :as-alias mdef]
[app.redis :as-alias rds]
@ -100,6 +106,24 @@
::mdef/labels ["name"]
::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
{::mdef/name "penpot_executors_active_threads"
::mdef/help "Current number of threads available in the executor service."
@ -178,8 +202,8 @@
::sto/gc-touched-task
{:pool (ig/ref ::db/pool)}
:app.http/client
{:executor (ig/ref ::wrk/executor)}
::http.client/client
{::wrk/executor (ig/ref ::wrk/executor)}
:app.http.session/manager
{:pool (ig/ref ::db/pool)
@ -191,10 +215,10 @@
:max-age (cf/get :auth-token-cookie-max-age)}
:app.http.awsns/handler
{:sprops (ig/ref :app.setup/props)
:pool (ig/ref ::db/pool)
:http-client (ig/ref :app.http/client)
:executor (ig/ref ::wrk/executor)}
{::props (ig/ref :app.setup/props)
::db/pool (ig/ref ::db/pool)
::http.client/client (ig/ref ::http.client/client)
::wrk/executor (ig/ref ::wrk/executor)}
:app.http/server
{:port (cf/get :http-server-port)
@ -220,51 +244,30 @@
:bind-password (cf/get :ldap-bind-password)
:enabled? (contains? cf/flags :login-with-ldap)}
:app.auth.oidc/google-provider
{:enabled? (contains? cf/flags :login-with-google)
:client-id (cf/get :google-client-id)
:client-secret (cf/get :google-client-secret)}
::oidc.providers/google
{}
:app.auth.oidc/github-provider
{:enabled? (contains? cf/flags :login-with-github)
:http-client (ig/ref :app.http/client)
:client-id (cf/get :github-client-id)
:client-secret (cf/get :github-client-secret)}
::oidc.providers/github
{::http.client/client (ig/ref ::http.client/client)}
:app.auth.oidc/gitlab-provider
{: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)}
::oidc.providers/gitlab
{}
:app.auth.oidc/generic-provider
{:enabled? (contains? cf/flags :login-with-oidc)
:http-client (ig/ref :app.http/client)
::oidc.providers/generic
{::http.client/client (ig/ref ::http.client/client)}
:client-id (cf/get :oidc-client-id)
:client-secret (cf/get :oidc-client-secret)
::oidc/routes
{::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
:app.http/router
@ -273,12 +276,12 @@
:session (ig/ref :app.http.session/manager)
:awsns-handler (ig/ref :app.http.awsns/handler)
: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)
:metrics (ig/ref ::mtx/metrics)
:public-uri (cf/get :public-uri)
: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)
:doc-routes (ig/ref :app.rpc.doc/routes)
:executor (ig/ref ::wrk/executor)}
@ -315,21 +318,22 @@
:scheduled-executor (ig/ref ::wrk/scheduled-executor)}
:app.rpc/methods
{:pool (ig/ref ::db/pool)
:session (ig/ref :app.http.session/manager)
:sprops (ig/ref :app.setup/props)
:metrics (ig/ref ::mtx/metrics)
:storage (ig/ref ::sto/storage)
:msgbus (ig/ref :app.msgbus/msgbus)
:public-uri (cf/get :public-uri)
:redis (ig/ref ::rds/redis)
:audit (ig/ref :app.loggers.audit/collector)
:ldap (ig/ref :app.auth.ldap/provider)
:http-client (ig/ref :app.http/client)
:climit (ig/ref :app.rpc/climit)
:rlimit (ig/ref :app.rpc/rlimit)
:executor (ig/ref ::wrk/executor)
:templates (ig/ref :app.setup/builtin-templates)
{::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)
:sprops (ig/ref :app.setup/props)
:metrics (ig/ref ::mtx/metrics)
:storage (ig/ref ::sto/storage)
:msgbus (ig/ref :app.msgbus/msgbus)
:public-uri (cf/get :public-uri)
:redis (ig/ref ::rds/redis)
:ldap (ig/ref :app.auth.ldap/provider)
:http-client (ig/ref ::http.client/client)
:climit (ig/ref :app.rpc/climit)
:rlimit (ig/ref :app.rpc/rlimit)
:executor (ig/ref ::wrk/executor)
:templates (ig/ref :app.setup/builtin-templates)
}
:app.rpc.doc/routes
@ -350,8 +354,8 @@
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
:telemetry (ig/ref :app.tasks.telemetry/handler)
:session-gc (ig/ref :app.http.session/gc-task)
:audit-log-archive (ig/ref :app.loggers.audit/archive-task)
:audit-log-gc (ig/ref :app.loggers.audit/gc-task)}}
:audit-log-archive (ig/ref ::audit.tasks/archive)
:audit-log-gc (ig/ref ::audit.tasks/gc)}}
:app.emails/sendmail
@ -383,52 +387,49 @@
{:pool (ig/ref ::db/pool)}
:app.tasks.telemetry/handler
{:pool (ig/ref ::db/pool)
:version (:full cf/version)
:uri (cf/get :telemetry-uri)
:sprops (ig/ref :app.setup/props)
:http-client (ig/ref :app.http/client)}
{::db/pool (ig/ref ::db/pool)
::http.client/client (ig/ref ::http.client/client)
::props (ig/ref :app.setup/props)}
:app.srepl/server
{:port (cf/get :srepl-port)
:host (cf/get :srepl-host)}
:app.setup/builtin-templates
{:http-client (ig/ref :app.http/client)}
{::http.client/client (ig/ref ::http.client/client)}
:app.setup/props
{:pool (ig/ref ::db/pool)
:key (cf/get :secret-key)}
:app.loggers.zmq/receiver
{:endpoint (cf/get :loggers-zmq-uri)}
::lzmq/receiver
{}
:app.loggers.audit/http-handler
{:pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor)}
::audit/http-handler
{::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor)
::mtx/metrics (ig/ref ::mtx/metrics)}
:app.loggers.audit/collector
{:pool (ig/ref ::db/pool)
:executor (ig/ref ::wrk/executor)}
::audit/collector
{::db/pool (ig/ref ::db/pool)
::wrk/executor (ig/ref ::wrk/executor)
::mtx/metrics (ig/ref ::mtx/metrics)}
:app.loggers.audit/archive-task
{:uri (cf/get :audit-log-archive-uri)
:sprops (ig/ref :app.setup/props)
:pool (ig/ref ::db/pool)
:http-client (ig/ref :app.http/client)}
::audit.tasks/archive
{::props (ig/ref :app.setup/props)
::db/pool (ig/ref ::db/pool)
::http.client/client (ig/ref ::http.client/client)}
:app.loggers.audit/gc-task
{:pool (ig/ref ::db/pool)}
::audit.tasks/gc
{::db/pool (ig/ref ::db/pool)}
:app.loggers.loki/reporter
{:uri (cf/get :loggers-loki-uri)
:receiver (ig/ref :app.loggers.zmq/receiver)
:http-client (ig/ref :app.http/client)}
{::lzmq/receiver (ig/ref ::lzmq/receiver)
::http.client/client (ig/ref ::http.client/client)}
:app.loggers.mattermost/reporter
{:uri (cf/get :error-report-webhook)
:receiver (ig/ref :app.loggers.zmq/receiver)
:http-client (ig/ref :app.http/client)}
{::lzmq/receiver (ig/ref ::lzmq/receiver)
::http.client/client (ig/ref ::http.client/client)}
:app.loggers.database/reporter
{:receiver (ig/ref :app.loggers.zmq/receiver)
@ -502,7 +503,8 @@
::db/pool (ig/ref ::db/pool)}
::wrk/worker
{::wrk/parallelism (cf/get ::worker-parallelism 3)
{::wrk/parallelism (cf/get ::worker-parallelism 1)
;; FIXME: read queues from configuration
::wrk/queue "default"
::rds/redis (ig/ref ::rds/redis)
::wrk/registry (ig/ref ::wrk/registry)
@ -521,7 +523,7 @@
(merge worker-config))
(ig/prep)
(ig/init))))
(l/info :msg "welcome to penpot"
(l/info :hint "welcome to penpot"
:flags (str/join "," (map name cf/flags))
:worker? (contains? cf/flags :backend-worker)
:version (:full cf/version)))

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

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

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

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

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

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

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

@ -6,6 +6,7 @@
(ns app.rpc.helpers
"General purpose RPC helpers."
(:refer-clojure :exclude [with-meta])
(:require
[app.common.data.macros :as dm]
[app.http :as-alias http]
@ -59,6 +60,10 @@
[mdw 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
[mdw max-age]
(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.uuid :as uuid]
[app.db :as db]
[app.loggers.audit :as-alias audit]
[app.media :as media]
[app.rpc.climit :as-alias climit]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.teams :as teams]
[app.storage :as sto]
[app.util.services :as sv]
@ -104,10 +106,13 @@
:ttf-file-id (:id ttf)}))
]
(-> (generate-fonts data)
(p/then validate-data)
(p/then persist-fonts executor)
(p/then insert-into-db executor))))
(->> (generate-fonts data)
(p/map validate-data)
(p/mcat executor persist-fonts)
(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

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

@ -13,6 +13,7 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.http.client :as http]
[app.media :as media]
[app.rpc.climit :as climit]
[app.rpc.queries.teams :as teams]
@ -186,7 +187,7 @@
(create-file-media-object-from-url cfg params)))
(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]
(let [size (some-> (get headers "content-length") d/parse-integer)
mtype (get headers "content-type")
@ -215,7 +216,7 @@
:format format}))
(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)))
(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.commands.auth :as cmd.auth]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.mutations.teams :as teams]
[app.rpc.queries.profile :as profile]
[app.storage :as sto]
@ -48,6 +49,7 @@
:opt-un [::lang ::theme]))
(sv/defmethod ::update-profile
{::doc/added "1.0"}
[{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
(db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use
@ -70,8 +72,11 @@
:props (db/tjson (:props profile))}
{:id profile-id})
(with-meta (-> profile profile/strip-private-attrs d/without-nils)
{::audit/props (audit/profile->props profile)}))))
(-> profile
profile/strip-private-attrs
d/without-nils
(rph/with-meta {::audit/props (audit/profile->props profile)})))))
;; --- MUTATION: Update Password
@ -133,7 +138,7 @@
(update-profile-photo cfg params)))
(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
(db/get-by-id pool :profile profile-id))
photo (teams/upload-photo cfg params)]
@ -146,7 +151,13 @@
(db/update! pool :profile
{:photo-id (:id photo)}
{: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
@ -278,8 +289,7 @@
{:deleted-at deleted-at}
{:id profile-id})
(with-meta {}
{::rpc/transform-response (session/delete-fn session)}))))
(rph/with-transform {} (session/delete-fn session)))))
(def sql:owned-teams
"with owner_teams as (
@ -298,77 +308,3 @@
(defn- get-owned-teams-with-participants
[conn 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))

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

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

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

@ -8,8 +8,10 @@
"Initial data setup of instance."
(:require
[app.common.logging :as l]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.main :as-alias main]
[app.setup.builtin-templates]
[app.setup.keys :as keys]
[buddy.core.codecs :as bc]
@ -48,6 +50,9 @@
:cause cause))))
instance-id)))
(s/def ::main/props
(s/map-of ::us/keyword some?))
(defmethod ig/pre-init-spec ::props [_]
(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]
:opt-un [::path]))
(s/def ::http-client ::http/client)
(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
[_ cfg]
@ -43,7 +41,7 @@
(defn- download-preset!
[cfg {:keys [path file-uri] :as preset}]
(let [response (http/req! (:http-client cfg)
(let [response (http/req! cfg
{:method :get
:uri file-uri}
{:response-type :input-stream

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

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

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

@ -288,10 +288,10 @@
::queue
::registry]))
;; FIXME: define queue as set
(defmethod ig/prep-key ::worker
[_ cfg]
(merge {::queue "default"
::parallelism 1}
(merge {::queue "default" ::parallelism 1}
(d/without-nils cfg)))
(defmethod ig/init-key ::worker
@ -666,10 +666,10 @@
props (-> options extract-props db/tjson)
id (uuid/next)]
(l/debug :action "submit task"
(l/debug :hint "submit task"
:name (d/name task)
:queue queue
:in duration)
:in (dt/format-duration duration))
(db/exec-one! conn [sql:insert-new-task id (d/name task) props
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
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
cfg {:sprops sprops}
report (bounce-report {:token (tokens/generate sprops
props (:app.setup/props th/*system*)
cfg {:app.main/props props}
report (bounce-report {:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
result (#'awsns/parse-notification cfg report)]
@ -118,9 +118,9 @@
(t/deftest test-parse-complaint-report
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
cfg {:sprops sprops}
report (complaint-report {:token (tokens/generate sprops
props (:app.setup/props th/*system*)
cfg {:app.main/props props}
report (complaint-report {:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
result (#'awsns/parse-notification cfg report)]
@ -133,8 +133,8 @@
))
(t/deftest test-parse-complaint-report-without-token
(let [sprops (:app.setup/props th/*system*)
cfg {:sprops sprops}
(let [props (:app.setup/props th/*system*)
cfg {:app.main/props props}
report (complaint-report {:token ""})
result (#'awsns/parse-notification cfg report)]
(t/is (= "complaint" (:type result)))
@ -146,10 +146,10 @@
(t/deftest test-process-bounce-report
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool}
report (bounce-report {:token (tokens/generate sprops
cfg {:app.main/props props :app.db/pool pool}
report (bounce-report {:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)]
@ -175,10 +175,11 @@
(t/deftest test-process-complaint-report
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
props (:app.setup/props th/*system*)
pool (:app.db/pool th/*system*)
cfg {:sprops sprops :pool pool}
report (complaint-report {:token (tokens/generate sprops
cfg {:app.main/props props
:app.db/pool pool}
report (complaint-report {:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)]
@ -206,11 +207,11 @@
(t/deftest test-process-bounce-report-to-self
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
props (:app.setup/props 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)
:token (tokens/generate sprops
:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
report (#'awsns/parse-notification cfg report)]
@ -228,11 +229,11 @@
(t/deftest test-process-complaint-report-to-self
(let [profile (th/create-profile* 1)
sprops (:app.setup/props th/*system*)
props (:app.setup/props 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)
:token (tokens/generate sprops
:token (tokens/generate props
{:iss :profile-identity
:profile-id (:id profile)})})
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
(t/deftest profile-login-success
(let [profile (th/create-profile* 1 {:is-active true})
data {::th/type :login
data {::th/type :login-with-password
:email "profile1.test@nodomain.com"
:password "123123"}
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= (:id profile) (get-in out [:result :id])))))
@ -198,7 +198,7 @@
(let [data {::th/type :prepare-register-profile
:email "user@example.com"
:password "foobar"}
out (th/mutation! data)
out (th/command! data)
token (get-in out [:result :token])]
(t/is (string? token))
@ -207,7 +207,7 @@
(let [data {::th/type :register-profile
:fullname "foobar"
:accept-terms-and-privacy true}
out (th/mutation! data)]
out (th/command! data)]
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
@ -219,7 +219,8 @@
:fullname "foobar"
:accept-terms-and-privacy 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))))
))
@ -302,7 +303,7 @@
:email "user@example.com"
:password "foobar"}
{:keys [result error] :as out} (th/mutation! data)]
{:keys [result error] :as out} (th/command! data)]
(t/is (nil? error))
(t/is (map? result))
(t/is (string? (:token result)))
@ -312,7 +313,7 @@
:token rtoken
:fullname "foobar"}
{:keys [result error] :as out} (th/mutation! data)]
{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
@ -467,7 +468,7 @@
;; with valid email inactive user
(let [data (assoc data :email (:email profile1))
out (th/mutation! data)
out (th/command! data)
error (:error out)]
(t/is (= 0 (:call-count @mock)))
(t/is (th/ex-info? error))
@ -476,7 +477,7 @@
;; with valid email and active user
(let [data (assoc data :email (:email profile2))
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 1 (:call-count @mock))))
@ -484,7 +485,7 @@
;; with valid email and active user with global complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email profile2)})
(let [data (assoc data :email (:email profile2))
out (th/mutation! data)]
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
@ -492,7 +493,7 @@
;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
(let [data (assoc data :email (:email profile2))
out (th/mutation! data)
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (= 2 (:call-count @mock)))

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

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

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

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

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

@ -7,14 +7,12 @@
(ns app.main.data.workspace.svg-upload
(:require
[app.common.data :as d]
[app.common.spec :as us]
[app.common.exceptions :as ex]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.changes-builder :as pcb]
[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-tree :as ctst]
[app.common.uuid :as uuid]

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

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