Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-10 06:41:40 -05:00
Code Issues Activity

Merge remote-tracking branch 'origin/staging' into develop

Browse source
This commit is contained in:
Andrey Antukh 2024-07-24 08:20:36 +02:00
commit a100d1d11a
13 changed files with 490 additions and 234 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -19,8 +19,10 @@
[app.email.blacklist :as email.blacklist] [app.email.blacklist :as email.blacklist]
[app.email.whitelist :as email.whitelist] [app.email.whitelist :as email.whitelist]
[app.http.client :as http] [app.http.client :as http]
[app.http.errors :as errors]
[app.http.session :as session] [app.http.session :as session]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.rpc :as rpc]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
[app.setup :as-alias setup] [app.setup :as-alias setup]
[app.tokens :as tokens] [app.tokens :as tokens]
@ -130,8 +132,8 @@
(-> body json/decode :keys process-oidc-jwks) (-> body json/decode :keys process-oidc-jwks)
(do (do
(l/warn :hint "unable to retrieve JWKs (unexpected response status code)" (l/warn :hint "unable to retrieve JWKs (unexpected response status code)"
:http-status status :response-status status
:http-body body) :response-body body)
nil))) nil)))
(catch Throwable cause (catch Throwable cause
(l/warn :hint "unable to retrieve JWKs (unexpected exception)" (l/warn :hint "unable to retrieve JWKs (unexpected exception)"
@ -145,18 +147,18 @@
(when (contains? cf/flags :login-with-oidc) (when (contains? cf/flags :login-with-oidc)
(if-let [opts (prepare-oidc-opts cfg)] (if-let [opts (prepare-oidc-opts cfg)]
(let [jwks (fetch-oidc-jwks cfg opts)] (let [jwks (fetch-oidc-jwks cfg opts)]
(l/info :hint "provider initialized" (l/inf :hint "provider initialized"
:provider "oidc" :provider "oidc"
:method (if (:discover? opts) "discover" "manual") :method (if (:discover? opts) "discover" "manual")
:client-id (:client-id opts) :client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts)) :client-secret (obfuscate-string (:client-secret opts))
:scopes (str/join "," (:scopes opts)) :scopes (str/join "," (:scopes opts))
:auth-uri (:auth-uri opts) :auth-uri (:auth-uri opts)
:user-uri (:user-uri opts) :user-uri (:user-uri opts)
:token-uri (:token-uri opts) :token-uri (:token-uri opts)
:roles-attr (:roles-attr opts) :roles-attr (:roles-attr opts)
:roles (:roles opts) :roles (:roles opts)
:keys (str/join "," (map str (keys jwks)))) :keys (str/join "," (map str (keys jwks))))
(assoc opts :jwks jwks)) (assoc opts :jwks jwks))
(do (do
(l/warn :hint "unable to initialize auth provider, missing configuration" :provider "oidc") (l/warn :hint "unable to initialize auth provider, missing configuration" :provider "oidc")
@ -180,10 +182,10 @@
(if (and (string? (:client-id opts)) (if (and (string? (:client-id opts))
(string? (:client-secret opts))) (string? (:client-secret opts)))
(do (do
(l/info :hint "provider initialized" (l/inf :hint "provider initialized"
:provider "google" :provider "google"
:client-id (:client-id opts) :client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts))) :client-secret (obfuscate-string (:client-secret opts)))
opts) opts)
(do (do
@ -208,8 +210,9 @@
(ex/raise :type :internal (ex/raise :type :internal
:code :unable-to-retrieve-github-emails :code :unable-to-retrieve-github-emails
:hint "unable to retrieve github emails" :hint "unable to retrieve github emails"
:http-status status :request-uri (:uri params)
:http-body body)) :response-status status
:response-body body))
(->> body json/decode (filter :primary) first :email)))) (->> body json/decode (filter :primary) first :email))))
@ -234,10 +237,10 @@
(if (and (string? (:client-id opts)) (if (and (string? (:client-id opts))
(string? (:client-secret opts))) (string? (:client-secret opts)))
(do (do
(l/info :hint "provider initialized" (l/inf :hint "provider initialized"
:provider "github" :provider "github"
:client-id (:client-id opts) :client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts))) :client-secret (obfuscate-string (:client-secret opts)))
opts) opts)
(do (do
@ -249,7 +252,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/init-key ::providers/gitlab (defmethod ig/init-key ::providers/gitlab
[_ _] [_ cfg]
(let [base (cf/get :gitlab-base-uri "https://gitlab.com") (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
opts {:base-uri base opts {:base-uri base
:client-id (cf/get :gitlab-client-id) :client-id (cf/get :gitlab-client-id)
@ -258,17 +261,18 @@
: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")
:jwks-uri (str base "/oauth/discovery/keys")
:name "gitlab"}] :name "gitlab"}]
(when (contains? cf/flags :login-with-gitlab) (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 (let [jwks (fetch-oidc-jwks cfg opts)]
(l/info :hint "provider initialized" (l/inf :hint "provider initialized"
:provider "gitlab" :provider "gitlab"
:base-uri base :base-uri base
:client-id (:client-id opts) :client-id (:client-id opts)
:client-secret (obfuscate-string (:client-secret opts))) :client-secret (obfuscate-string (:client-secret opts)))
opts) (assoc opts :jwks jwks))
(do (do
(l/warn :hint "unable to initialize auth provider, missing configuration" :provider "gitlab") (l/warn :hint "unable to initialize auth provider, missing configuration" :provider "gitlab")
@ -324,26 +328,31 @@
:uri (:token-uri provider) :uri (:token-uri provider)
:body (u/map->query-string params)}] :body (u/map->query-string params)}]
(l/trace :hint "request access token" (l/trc :hint "fetch access token"
:provider (:name provider) :provider (:name provider)
:client-id (:client-id provider) :client-id (:client-id provider)
:client-secret (obfuscate-string (:client-secret provider)) :client-secret (obfuscate-string (:client-secret provider))
:grant-type (:grant_type params) :grant-type (:grant_type params)
:redirect-uri (:redirect_uri params)) :redirect-uri (:redirect_uri params))
(let [{:keys [status body]} (http/req! cfg req {:sync? true})] (let [{:keys [status body]} (http/req! cfg req {:sync? true})]
(l/trace :hint "access token response" :status status :body body) (l/trc :hint "access token fetched" :status status :body body)
(if (= status 200) (if (= status 200)
(let [data (json/decode body)] (let [data (json/decode body)
{:token/access (get data :access_token) data {:token/access (get data :access_token)
:token/id (get data :id_token) :token/id (get data :id_token)
:token/type (get data :token_type)}) :token/type (get data :token_type)}]
(l/trc :hint "access token fetched"
:token-id (:token/id data)
:token-type (:token/type data)
:token (:token/access data))
data)
(ex/raise :type :internal (ex/raise :type :internal
:code :unable-to-retrieve-token :code :unable-to-fetch-access-token
:hint "unable to retrieve token" :hint "unable to fetch access token"
:http-status status :request-uri (:uri req)
:http-body body))))) :response-status status
:response-body body)))))
(defn- process-user-info (defn- process-user-info
[provider tdata info] [provider tdata info]
@ -370,9 +379,9 @@
(defn- fetch-user-info (defn- fetch-user-info
[{:keys [::provider] :as cfg} tdata] [{:keys [::provider] :as cfg} tdata]
(l/trace :hint "fetch user info" (l/trc :hint "fetch user info"
:uri (:user-uri provider) :uri (:user-uri provider)
:token (obfuscate-string (:token/access tdata))) :token (obfuscate-string (:token/access tdata)))
(let [params {:uri (:user-uri provider) (let [params {:uri (:user-uri provider)
:headers {"Authorization" (str (:token/type tdata) " " (:token/access tdata))} :headers {"Authorization" (str (:token/type tdata) " " (:token/access tdata))}
@ -380,9 +389,9 @@
:method :get} :method :get}
response (http/req! cfg params {:sync? true})] response (http/req! cfg params {:sync? true})]
(l/trace :hint "user info response" (l/trc :hint "user info response"
:status (:status response) :status (:status response)
:body (:body response)) :body (:body response))
(when-not (s/int-in-range? 200 300 (:status response)) (when-not (s/int-in-range? 200 300 (:status response))
(ex/raise :type :internal (ex/raise :type :internal
@ -432,7 +441,7 @@
info (process-user-info provider tdata info)] info (process-user-info provider tdata info)]
(l/trace :hint "user info" :info info) (l/trc :hint "user info" :info info)
(when-not (s/valid? ::info info) (when-not (s/valid? ::info info)
(l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info) (l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
@ -586,22 +595,33 @@
(redirect-to-register cfg info request) (redirect-to-register cfg info request)
(redirect-with-error "registration-disabled"))))) (redirect-with-error "registration-disabled")))))
(defn- get-external-session-id
[request]
(let [session-id (rreq/get-header request "x-external-session-id")]
(when (string? session-id)
(if (or (> (count session-id) 256)
(= session-id "null")
(str/blank? session-id))
nil
session-id))))
(defn- auth-handler (defn- auth-handler
[cfg {:keys [params] :as request}] [cfg {:keys [params] :as request}]
(let [props (audit/extract-utm-params params) (let [props (audit/extract-utm-params params)
esid (rreq/get-header request "x-external-session-id") esid (rpc/get-external-session-id request)
state (tokens/generate (::setup/props cfg) params {:iss :oauth
{:iss :oauth :invitation-token (:invitation-token params)
:invitation-token (:invitation-token params) :external-session-id esid
:external-session-id esid :props props
:props props :exp (dt/in-future "4h")}
:exp (dt/in-future "4h")}) state (tokens/generate (::setup/props cfg)
uri (build-auth-uri cfg state)] (d/without-nils params))
uri (build-auth-uri cfg state)]
{::rres/status 200 {::rres/status 200
::rres/body {:redirect-uri uri}})) ::rres/body {:redirect-uri uri}}))
(defn- callback-handler (defn- callback-handler
[cfg request] [{:keys [::provider] :as cfg} request]
(try (try
(if-let [error (dm/get-in request [:params :error])] (if-let [error (dm/get-in request [:params :error])]
(redirect-with-error "unable-to-auth" error) (redirect-with-error "unable-to-auth" error)
@ -609,7 +629,16 @@
profile (get-profile cfg info)] profile (get-profile cfg info)]
(process-callback cfg request info profile))) (process-callback cfg request info profile)))
(catch Throwable cause (catch Throwable cause
(l/err :hint "error on oauth process" :cause cause) (binding [l/*context* (-> (errors/request->context request)
(assoc :auth/provider (:name provider)))]
(let [edata (ex-data cause)]
(cond
(= :validation (:type edata))
(l/wrn :hint "invalid token received" :cause cause)
:else
(l/err :hint "error on oauth process" :cause cause))))
(redirect-with-error "unable-to-auth" (ex-message cause))))) (redirect-with-error "unable-to-auth" (ex-message cause)))))
(def provider-lookup (def provider-lookup

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

@ -35,9 +35,13 @@
(defn parse-client-ip (defn parse-client-ip
[request] [request]
(or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first) (let [ip-addr (or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip") (rreq/get-header request "x-real-ip")
(some-> (rreq/remote-addr request) str))) (some-> (rreq/remote-addr request) str))
ip-addr (-> ip-addr
(str/split ":" 2)
(first))]
ip-addr))
(defn extract-utm-params (defn extract-utm-params
"Extracts additional data from params and namespace them under "Extracts additional data from params and namespace them under
@ -192,15 +196,33 @@
(::webhooks/event? resultm) (::webhooks/event? resultm)
false)})) false)}))
(defn- handle-event! (defn- event->params
[cfg event] [event]
(let [params {:id (uuid/next) (let [params {:id (uuid/next)
:name (::name event) :name (::name event)
:type (::type event) :type (::type event)
:profile-id (::profile-id event) :profile-id (::profile-id event)
:ip-addr (::ip-addr event) :ip-addr (::ip-addr event "0.0.0.0")
:context (::context event) :context (::context event {})
:props (::props event)} :props (::props event {})
:source "backend"}
tnow (::tracked-at event)]
(cond-> params
(some? tnow)
(assoc :tracked-at tnow))))
(defn- append-audit-entry!
[cfg params]
(let [params (-> params
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet))]
(db/insert! cfg :audit-log params)))
(defn- handle-event!
[cfg event]
(let [params (event->params event)
tnow (dt/now)] tnow (dt/now)]
(when (contains? cf/flags :audit-log) (when (contains? cf/flags :audit-log)
@ -209,12 +231,8 @@
;; this case we just retry the operation. ;; this case we just retry the operation.
(let [params (-> params (let [params (-> params
(assoc :created-at tnow) (assoc :created-at tnow)
(assoc :tracked-at tnow) (update :tracked-at #(or % tnow)))]
(update :props db/tjson) (append-audit-entry! cfg params)))
(update :context db/tjson)
(update :ip-addr db/inet)
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(when (and (or (contains? cf/flags :telemetry) (when (and (or (contains? cf/flags :telemetry)
(cf/get :telemetry-enabled)) (cf/get :telemetry-enabled))
@ -226,12 +244,11 @@
;; NOTE: this is only executed when general audit log is disabled ;; NOTE: this is only executed when general audit log is disabled
(let [params (-> params (let [params (-> params
(assoc :created-at tnow) (assoc :created-at tnow)
(assoc :tracked-at tnow) (update :tracked-at #(or % tnow))
(assoc :props (db/tjson {})) (assoc :props {})
(assoc :context (db/tjson {})) (assoc :context {})
(assoc :ip-addr (db/inet "0.0.0.0")) (assoc :ip-addr "0.0.0.0"))]
(assoc :source "backend"))] (append-audit-entry! cfg params)))
(db/insert! cfg :audit-log params)))
(when (and (contains? cf/flags :webhooks) (when (and (contains? cf/flags :webhooks)
(::webhooks/event? event)) (::webhooks/event? event))
@ -258,9 +275,9 @@
(defn submit! (defn submit!
"Submit audit event to the collector." "Submit audit event to the collector."
[cfg params] [cfg event]
(try (try
(let [event (d/without-nils params) (let [event (d/without-nils event)
cfg (-> cfg cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?) (assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6) (assoc ::rtry/max-retries 6)
@ -269,3 +286,18 @@
(rtry/invoke! cfg db/tx-run! handle-event! event)) (rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable cause (catch Throwable cause
(l/error :hint "unexpected error processing event" :cause cause)))) (l/error :hint "unexpected error processing event" :cause cause))))
(defn insert!
"Submit audit event to the collector, intended to be used only from
command line helpers because this skips all webhooks and telemetry
logic."
[cfg event]
(when (contains? cf/flags :audit-log)
(let [event (d/without-nils event)]
(us/verify! ::event event)
(db/run! cfg (fn [cfg]
(let [tnow (dt/now)
params (-> (event->params event)
(assoc :created-at tnow)
(update :tracked-at #(or % tnow)))]
(append-audit-entry! cfg params)))))))

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

@ -254,7 +254,7 @@
{::http.client/client (ig/ref ::http.client/client)} {::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/gitlab ::oidc.providers/gitlab
{} {::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/generic ::oidc.providers/generic
{::http.client/client (ig/ref ::http.client/client)} {::http.client/client (ig/ref ::http.client/client)}

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

@ -70,6 +70,20 @@
(handle-response-transformation request mdata) (handle-response-transformation request mdata)
(handle-before-comple-hook mdata)))) (handle-before-comple-hook mdata))))
(defn get-external-session-id
[request]
(when-let [session-id (rreq/get-header request "x-external-session-id")]
(when-not (or (> (count session-id) 256)
(= session-id "null")
(str/blank? session-id))
session-id)))
(defn- get-external-event-origin
[request]
(when-let [origin (rreq/get-header request "x-event-origin")]
(when-not (> (count origin) 256)
origin)))
(defn- rpc-handler (defn- rpc-handler
"Ring handler that dispatches cmd requests and convert between "Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow." internal async flow into ring async flow."
@ -79,8 +93,8 @@
profile-id (or (::session/profile-id request) profile-id (or (::session/profile-id request)
(::actoken/profile-id request)) (::actoken/profile-id request))
session-id (rreq/get-header request "x-external-session-id") session-id (get-external-session-id request)
event-origin (rreq/get-header request "x-event-origin") event-origin (get-external-event-origin request)
data (-> params data (-> params
(assoc ::handler-name handler-name) (assoc ::handler-name handler-name)

303
backend/src/app/srepl/main.clj
View file

@ -21,8 +21,10 @@
[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.db.sql :as-alias sql]
[app.features.components-v2 :as feat.comp-v2] [app.features.components-v2 :as feat.comp-v2]
[app.features.fdata :as feat.fdata] [app.features.fdata :as feat.fdata]
[app.loggers.audit :as audit]
[app.main :as main] [app.main :as main]
[app.msgbus :as mbus] [app.msgbus :as mbus]
[app.rpc.commands.auth :as auth] [app.rpc.commands.auth :as auth]
@ -38,10 +40,12 @@
[app.util.pointer-map :as pmap] [app.util.pointer-map :as pmap]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.java.io :as io]
[clojure.pprint :refer [print-table]] [clojure.pprint :refer [print-table]]
[clojure.stacktrace :as strace] [clojure.stacktrace :as strace]
[clojure.tools.namespace.repl :as repl] [clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.fs :as fs]
[promesa.exec :as px] [promesa.exec :as px]
[promesa.exec.semaphore :as ps] [promesa.exec.semaphore :as ps]
[promesa.util :as pu])) [promesa.util :as pu]))
@ -190,6 +194,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn notify! (defn notify!
"Send flash notifications.
This method allows send flash notifications to specified target destinations.
The message can be a free text or a preconfigured one.
The destination can be: all, profile-id, team-id, or a coll of them."
[{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level] [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
:or {code :generic level :info} :or {code :generic level :info}
:as params}] :as params}]
@ -197,10 +207,6 @@
["invalid level %" level] ["invalid level %" level]
(contains? #{:success :error :info :warning} level)) (contains? #{:success :error :info :warning} level))
(dm/verify!
["invalid code: %" code]
(contains? #{:generic :upgrade-version} code))
(letfn [(send [dest] (letfn [(send [dest]
(l/inf :hint "sending notification" :dest (str dest)) (l/inf :hint "sending notification" :dest (str dest))
(let [message {:type :notification (let [message {:type :notification
@ -226,6 +232,9 @@
(resolve-dest [dest] (resolve-dest [dest]
(cond (cond
(= :all dest)
[uuid/zero]
(uuid? dest) (uuid? dest)
[dest] [dest]
@ -241,14 +250,15 @@
(mapcat resolve-dest)) (mapcat resolve-dest))
dest) dest)
(and (coll? dest) (and (vector? dest)
(every? coll? dest)) (every? vector? dest))
(sequence (comp (sequence (comp
(map vec) (map vec)
(mapcat resolve-dest)) (mapcat resolve-dest))
dest) dest)
(vector? dest) (and (vector? dest)
(keyword? (first dest)))
(let [[op param] dest] (let [[op param] dest]
(cond (cond
(= op :email) (= op :email)
@ -475,6 +485,27 @@
;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT) ;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn delete-file!
"Mark a project for deletion"
[file-id]
(let [file-id (h/parse-uuid file-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id file-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-file!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :file
:deleted-at tnow
:id file-id})))
:deleted))
(defn- restore-file* (defn- restore-file*
[{:keys [::db/conn]} file-id] [{:keys [::db/conn]} file-id]
(db/update! conn :file (db/update! conn :file
@ -502,20 +533,105 @@
:restored) :restored)
(defn restore-file!
"Mark a file and all related objects as not deleted"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system
(fn [system]
(when-let [file (some-> (db/get* system :file
{:id file-id}
{::db/remove-deleted false
::sql/columns [:id :name]})
(files/decode-row))]
(audit/insert! system
{::audit/name "restore-file"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props file
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-file!"}
::audit/tracked-at (dt/now)})
(restore-file* system file-id))))))
(defn delete-project!
"Mark a project for deletion"
[project-id]
(let [project-id (h/parse-uuid project-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id project-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-project!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :project
:deleted-at tnow
:id project-id})))
:deleted))
(defn- restore-project* (defn- restore-project*
[{:keys [::db/conn] :as cfg} project-id] [{:keys [::db/conn] :as cfg} project-id]
(db/update! conn :project (db/update! conn :project
{:deleted-at nil} {:deleted-at nil}
{:id project-id}) {:id project-id})
(doseq [{:keys [id]} (db/query conn :file (doseq [{:keys [id]} (db/query conn :file
{:project-id project-id} {:project-id project-id}
{::db/columns [:id]})] {::sql/columns [:id]})]
(restore-file* cfg id)) (restore-file* cfg id))
:restored) :restored)
(defn restore-project!
"Mark a project and all related objects as not deleted"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system
(fn [system]
(when-let [project (db/get* system :project
{:id project-id}
{::db/remove-deleted false})]
(audit/insert! system
{::audit/name "restore-project"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props project
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (dt/now)})
(restore-project* system project-id))))))
(defn delete-team!
"Mark a team for deletion"
[team-id]
(let [team-id (h/parse-uuid team-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props {:id team-id}
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :team
:deleted-at tnow
:id team-id})))
:deleted))
(defn- restore-team* (defn- restore-team*
[{:keys [::db/conn] :as cfg} team-id] [{:keys [::db/conn] :as cfg} team-id]
(db/update! conn :team (db/update! conn :team
@ -528,84 +644,127 @@
(doseq [{:keys [id]} (db/query conn :project (doseq [{:keys [id]} (db/query conn :project
{:team-id team-id} {:team-id team-id}
{::db/columns [:id]})] {::sql/columns [:id]})]
(restore-project* cfg id)) (restore-project* cfg id))
:restored) :restored)
(defn- restore-profile* (defn restore-team!
[{:keys [::db/conn] :as cfg} profile-id]
(db/update! conn :profile
{:deleted-at nil}
{:id profile-id})
(doseq [{:keys [id]} (profile/get-owned-teams conn profile-id)]
(restore-team* cfg id))
:restored)
(defn restore-deleted-profile!
"Mark a team and all related objects as not deleted"
[profile-id]
(let [profile-id (h/parse-uuid profile-id)]
(db/tx-run! main/system restore-profile* profile-id)))
(defn restore-deleted-team!
"Mark a team and all related objects as not deleted" "Mark a team and all related objects as not deleted"
[team-id] [team-id]
(let [team-id (h/parse-uuid team-id)] (let [team-id (h/parse-uuid team-id)]
(db/tx-run! main/system restore-team* team-id))) (db/tx-run! main/system
(fn [system]
(when-let [team (some-> (db/get* system :team
{:id team-id}
{::db/remove-deleted false})
(teams/decode-row))]
(audit/insert! system
{::audit/name "restore-team"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props team
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-team!"}
::audit/tracked-at (dt/now)})
(defn restore-deleted-project! (restore-team* system team-id))))))
"Mark a project and all related objects as not deleted"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(db/tx-run! main/system restore-project* project-id)))
(defn restore-deleted-file!
"Mark a file and all related objects as not deleted"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system restore-file* file-id)))
(defn delete-team!
"Mark a team for deletion"
[team-id]
(let [team-id (h/parse-uuid team-id)]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :team
:deleted-at (dt/now)
:id team-id})))))
(defn delete-profile! (defn delete-profile!
"Mark a profile for deletion" "Mark a profile for deletion."
[profile-id] [profile-id]
(let [profile-id (h/parse-uuid profile-id)] (let [profile-id (h/parse-uuid profile-id)
tnow (dt/now)]
(audit/insert! main/system
{::audit/name "delete-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profile!"}
::audit/tracked-at tnow})
(wrk/invoke! (-> main/system (wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object) (assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile (assoc ::wrk/params {:object :profile
:deleted-at (dt/now) :deleted-at tnow
:id profile-id}))))) :id profile-id})))
(defn delete-project! :deleted))
"Mark a project for deletion"
[project-id]
(let [project-id (h/parse-uuid project-id)]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :project
:deleted-at (dt/now)
:id project-id})))))
(defn delete-file! (defn restore-profile!
"Mark a project for deletion" "Mark a team and all related objects as not deleted"
[file-id] [profile-id]
(let [file-id (h/parse-uuid file-id)] (let [profile-id (h/parse-uuid profile-id)]
(wrk/invoke! (-> main/system (db/tx-run! main/system
(assoc ::wrk/task :delete-object) (fn [system]
(assoc ::wrk/params {:object :file (when-let [profile (some-> (db/get* system :profile
:deleted-at (dt/now) {:id profile-id}
:id file-id}))))) {::db/remove-deleted false})
(profile/decode-row))]
(audit/insert! system
{::audit/name "restore-profile"
::audit/type "action"
::audit/profile-id uuid/zero
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to restore-profile!"}
::audit/tracked-at (dt/now)})
(db/update! system :profile
{:deleted-at nil}
{:id profile-id}
{::db/return-keys false})
(doseq [{:keys [id]} (profile/get-owned-teams system profile-id)]
(restore-team* system id))
:restored)))))
(defn delete-profiles-in-bulk!
[system path]
(letfn [(process-data! [system deleted-at emails]
(loop [emails emails
deleted 0
total 0]
(if-let [email (first emails)]
(if-let [profile (db/get* system :profile
{:email (str/lower email)}
{::db/remove-deleted false})]
(do
(audit/insert! system
{::audit/name "delete-profile"
::audit/type "action"
::audit/tracked-at deleted-at
::audit/props (audit/profile->props profile)
::audit/context {:triggered-by "srepl"
:cause "explicit call to delete-profiles-in-bulk!"}})
(wrk/invoke! (-> system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile
:deleted-at deleted-at
:id (:id profile)})))
(recur (rest emails)
(inc deleted)
(inc total)))
(recur (rest emails)
deleted
(inc total)))
{:deleted deleted :total total})))]
(let [path (fs/path path)
deleted-at (dt/minus (dt/now) cf/deletion-delay)]
(when-not (fs/exists? path)
(throw (ex-info "path does not exists" {:path path})))
(db/tx-run! system
(fn [system]
(with-open [reader (io/reader path)]
(process-data! system deleted-at (line-seq reader))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CASCADE FIXING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn process-deleted-profiles-cascade (defn process-deleted-profiles-cascade
[] []

5
docker/devenv/files/nginx.conf
View file

@ -68,7 +68,10 @@ http {
proxy_set_header X-Forwarded-Proto $scheme; proxy_set_header X-Forwarded-Proto $scheme;
proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for; proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
resolver 127.0.0.11; proxy_buffer_size 16k;
proxy_busy_buffers_size 24k; # essentially, proxy_buffer_size + 2 small buffers of 4k
proxy_buffers 32 4k;
resolver 127.0.0.11 ipv6=off;
etag off; etag off;

3
frontend/scripts/build
View file

@ -8,6 +8,7 @@ export CURRENT_VERSION=$1;
export BUILD_DATE=$(date -R); export BUILD_DATE=$(date -R);
export CURRENT_HASH=${CURRENT_HASH:-$(git rev-parse --short HEAD)}; export CURRENT_HASH=${CURRENT_HASH:-$(git rev-parse --short HEAD)};
export EXTRA_PARAMS=$SHADOWCLJS_EXTRA_PARAMS; export EXTRA_PARAMS=$SHADOWCLJS_EXTRA_PARAMS;
export TS=$(date +%s);
# Some cljs reacts on this environment variable for define more # Some cljs reacts on this environment variable for define more
# performant code on macros (example: rumext) # performant code on macros (example: rumext)
@ -17,7 +18,7 @@ yarn install || exit 1;
rm -rf resources/public; rm -rf resources/public;
rm -rf target/dist; rm -rf target/dist;
clojure -M:dev:shadow-cljs release main --config-merge "{:release-version \"${CURRENT_HASH}\"}" $EXTRA_PARAMS || exit 1 clojure -M:dev:shadow-cljs release main --config-merge "{:release-version \"${CURRENT_HASH}-${TS}\"}" $EXTRA_PARAMS || exit 1
yarn run compile || exit 1; yarn run compile || exit 1;
mkdir -p target/dist; mkdir -p target/dist;

14
frontend/src/app/main/data/common.cljs
View file

@ -13,6 +13,7 @@
[app.main.data.modal :as modal] [app.main.data.modal :as modal]
[app.main.features :as features] [app.main.features :as features]
[app.main.repo :as rp] [app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :refer [tr]] [app.util.i18n :refer [tr]]
[beicon.v2.core :as rx] [beicon.v2.core :as rx]
[potok.v2.core :as ptk])) [potok.v2.core :as ptk]))
@ -58,6 +59,10 @@
[] []
(.reload js/location)) (.reload js/location))
(defn hide-notifications!
[]
(st/emit! msg/hide))
(defn handle-notification (defn handle-notification
[{:keys [message code level] :as params}] [{:keys [message code level] :as params}]
(ptk/reify ::show-notification (ptk/reify ::show-notification
@ -75,6 +80,15 @@
:actions [{:label "Refresh" :callback force-reload!}] :actions [{:label "Refresh" :callback force-reload!}]
:tag :notification))) :tag :notification)))
:maintenance
(rx/of (msg/dialog
:content (tr "notifications.by-code.maintenance")
:controls :inline-actions
:type level
:actions [{:label (tr "labels.accept")
:callback hide-notifications!}]
:tag :notification))
(rx/of (msg/dialog (rx/of (msg/dialog
:content message :content message
:controls :close :controls :close

67
frontend/src/app/main/data/messages.cljs
View file

@ -15,42 +15,42 @@
(declare hide) (declare hide)
(declare show) (declare show)
(def default-animation-timeout 600)
(def default-timeout 7000) (def default-timeout 7000)
(def ^:private (def ^:private schema:message
schema:message [:map {:title "Message"}
(sm/define [:type [::sm/one-of #{:success :error :info :warning}]]
[:map {:title "Message"} [:status {:optional true}
[:type [::sm/one-of #{:success :error :info :warning}]] [::sm/one-of #{:visible :hide}]]
[:status {:optional true} [:position {:optional true}
[::sm/one-of #{:visible :hide}]] [::sm/one-of #{:fixed :floating :inline}]]
[:position {:optional true} [:notification-type {:optional true}
[::sm/one-of #{:fixed :floating :inline}]] [::sm/one-of #{:inline :context :toast}]]
[:notification-type {:optional true} [:controls {:optional true}
[::sm/one-of #{:inline :context :toast}]] [::sm/one-of #{:none :close :inline-actions :bottom-actions}]]
[:controls {:optional true} [:tag {:optional true}
[::sm/one-of #{:none :close :inline-actions :bottom-actions}]] [:or :string :keyword]]
[:tag {:optional true} [:timeout {:optional true}
[:or :string :keyword]] [:maybe :int]]
[:timeout {:optional true} [:actions {:optional true}
[:maybe :int]] [:vector
[:actions {:optional true} [:map
[:vector [:label :string]
[:map [:callback ::sm/fn]]]]
[:label :string] [:links {:optional true}
[:callback ::sm/fn]]]] [:vector
[:links {:optional true} [:map
[:vector [:label :string]
[:map [:callback ::sm/fn]]]]])
[:label :string]
[:callback ::sm/fn]]]]])) (def ^:private valid-message?
(sm/validator schema:message))
(defn show (defn show
[data] [data]
(dm/assert! (dm/assert!
"expected valid message map" "expected valid message map"
(sm/check! schema:message data)) (valid-message? data))
(ptk/reify ::show (ptk/reify ::show
ptk/UpdateEvent ptk/UpdateEvent
@ -76,14 +76,7 @@
(ptk/reify ::hide (ptk/reify ::hide
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(d/update-when state :message assoc :status :hide)) (dissoc state :message))))
ptk/WatchEvent
(watch [_ _ stream]
(let [stopper (rx/filter (ptk/type? ::show) stream)]
(->> (rx/of #(dissoc % :message))
(rx/delay default-animation-timeout)
(rx/take-until stopper))))))
(defn hide-tag (defn hide-tag
[tag] [tag]

57
frontend/src/app/main/ui/messages.cljs
View file

@ -17,33 +17,38 @@
(mf/defc notifications-hub (mf/defc notifications-hub
[] []
(let [message (mf/deref refs/message) (let [message (mf/deref refs/message)
on-close (mf/use-fn #(st/emit! dmsg/hide))
on-close #(st/emit! dmsg/hide) context? (and (nil? (:timeout message))
(nil? (:actions message)))
toast-message {:type (or (:type message) :info) inline? (or (= :inline (:notification-type message))
:links (:links message) (= :floating (:position message)))
:on-close on-close toast? (or (= :toast (:notification-type message))
:content (:content message)} (some? (:timeout message)))]
inline-message {:actions (:actions message)
:links (:links message)
:content (:content message)}
context-message {:type (or (:type message) :info)
:links (:links message)
:content (:content message)}
is-context-msg (and (nil? (:timeout message)) (nil? (:actions message)))
is-toast-msg (or (= :toast (:notification-type message)) (some? (:timeout message)))
is-inline-msg (or (= :inline (:notification-type message)) (and (some? (:position message)) (= :floating (:position message))))]
(when message (when message
(cond (cond
is-toast-msg toast?
[:& toast-notification toast-message] [:& toast-notification
is-inline-msg {:type (or (:type message) :info)
[:& inline-notification inline-message] :links (:links message)
is-context-msg :on-close on-close
[:& context-notification context-message] :content (:content message)}]
inline?
[:& inline-notification
{:actions (:actions message)
:links (:links message)
:content (:content message)}]
context?
[:& context-notification
{:type (or (:type message) :info)
:links (:links message)
:content (:content message)}]
:else :else
[:& toast-notification toast-message])))) [:& toast-notification
{:type (or (:type message) :info)
:links (:links message)
:on-close on-close
:content (:content message)}]))))

10
frontend/src/app/main/ui/notifications/toast_notification.cljs
View file

@ -38,12 +38,10 @@
neutral-icon)) neutral-icon))
(mf/defc toast-notification (mf/defc toast-notification
"These are ephemeral elements that disappear when "These are ephemeral elements that disappear when the close button
the close button is pressed, is pressed, the page is refreshed, the page is navigated to another
the page is refreshed, page or after 7 seconds, which is enough time to be read, except for
the page is navigated to another page or error messages that require user interaction."
after 7 seconds, which is enough time to be read,
except for error messages that require user interaction."
{::mf/props :obj} {::mf/props :obj}
[{:keys [type content on-close links] :as props}] [{:keys [type content on-close links] :as props}]

4
frontend/translations/en.po
View file

@ -2209,6 +2209,10 @@ msgstr "Update a component in a shared library"
msgid "notifications.by-code.upgrade-version" msgid "notifications.by-code.upgrade-version"
msgstr "A new version is available, please refresh the page" msgstr "A new version is available, please refresh the page"
#: src/app/main/data/common.cljs
msgid "notifications.by-code.maintenance"
msgstr "Maintenance break: we will be down for a short maintenance within 5 minutes."
#: src/app/main/ui/dashboard/team.cljs #: src/app/main/ui/dashboard/team.cljs
msgid "notifications.invitation-email-sent" msgid "notifications.invitation-email-sent"
msgstr "Invitation sent successfully" msgstr "Invitation sent successfully"

4
frontend/translations/es.po
View file

@ -2278,6 +2278,10 @@ msgstr "Actualizar un componente en biblioteca"
msgid "notifications.by-code.upgrade-version" msgid "notifications.by-code.upgrade-version"
msgstr "Una nueva versión está disponible, por favor actualiza la página" msgstr "Una nueva versión está disponible, por favor actualiza la página"
#: src/app/main/data/common.cljs
msgid "notifications.by-code.maintenance"
msgstr "Pausa de mantenimiento: en los próximos 5 minutos estaremos fuera de servicio por un breve mantenimiento."
#: src/app/main/ui/dashboard/team.cljs #: src/app/main/ui/dashboard/team.cljs
msgid "notifications.invitation-email-sent" msgid "notifications.invitation-email-sent"
msgstr "Invitación enviada con éxito" msgstr "Invitación enviada con éxito"