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

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

@ -35,9 +35,13 @@
(defn parse-client-ip
[request]
(or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip")
(some-> (rreq/remote-addr request) str)))
(let [ip-addr (or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip")
(some-> (rreq/remote-addr request) str))
ip-addr (-> ip-addr
(str/split ":" 2)
(first))]
ip-addr))
(defn extract-utm-params
"Extracts additional data from params and namespace them under
@ -192,15 +196,33 @@
(::webhooks/event? resultm)
false)}))
(defn- handle-event!
[cfg event]
(defn- event->params
[event]
(let [params {:id (uuid/next)
:name (::name event)
:type (::type event)
:profile-id (::profile-id event)
:ip-addr (::ip-addr event)
:context (::context event)
:props (::props event)}
:ip-addr (::ip-addr event "0.0.0.0")
:context (::context 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)]
(when (contains? cf/flags :audit-log)
@ -209,12 +231,8 @@
;; this case we just retry the operation.
(let [params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow)
(update :props db/tjson)
(update :context db/tjson)
(update :ip-addr db/inet)
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(update :tracked-at #(or % tnow)))]
(append-audit-entry! cfg params)))
(when (and (or (contains? cf/flags :telemetry)
(cf/get :telemetry-enabled))
@ -226,12 +244,11 @@
;; NOTE: this is only executed when general audit log is disabled
(let [params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow)
(assoc :props (db/tjson {}))
(assoc :context (db/tjson {}))
(assoc :ip-addr (db/inet "0.0.0.0"))
(assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(update :tracked-at #(or % tnow))
(assoc :props {})
(assoc :context {})
(assoc :ip-addr "0.0.0.0"))]
(append-audit-entry! cfg params)))
(when (and (contains? cf/flags :webhooks)
(::webhooks/event? event))
@ -258,9 +275,9 @@
(defn submit!
"Submit audit event to the collector."
[cfg params]
[cfg event]
(try
(let [event (d/without-nils params)
(let [event (d/without-nils event)
cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6)
@ -269,3 +286,18 @@
(rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable 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)}
::oidc.providers/gitlab
{}
{::http.client/client (ig/ref ::http.client/client)}
::oidc.providers/generic
{::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-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
"Ring handler that dispatches cmd requests and convert between
internal async flow into ring async flow."
@ -79,8 +93,8 @@
profile-id (or (::session/profile-id request)
(::actoken/profile-id request))
session-id (rreq/get-header request "x-external-session-id")
event-origin (rreq/get-header request "x-event-origin")
session-id (get-external-session-id request)
event-origin (get-external-event-origin request)
data (-> params
(assoc ::handler-name handler-name)

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

@ -21,8 +21,10 @@
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.features.components-v2 :as feat.comp-v2]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as audit]
[app.main :as main]
[app.msgbus :as mbus]
[app.rpc.commands.auth :as auth]
@ -38,10 +40,12 @@
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.java.io :as io]
[clojure.pprint :refer [print-table]]
[clojure.stacktrace :as strace]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str]
[datoteka.fs :as fs]
[promesa.exec :as px]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
@ -190,6 +194,12 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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]
:or {code :generic level :info}
:as params}]
@ -197,10 +207,6 @@
["invalid level %" level]
(contains? #{:success :error :info :warning} level))
(dm/verify!
["invalid code: %" code]
(contains? #{:generic :upgrade-version} code))
(letfn [(send [dest]
(l/inf :hint "sending notification" :dest (str dest))
(let [message {:type :notification
@ -226,6 +232,9 @@
(resolve-dest [dest]
(cond
(= :all dest)
[uuid/zero]
(uuid? dest)
[dest]
@ -241,14 +250,15 @@
(mapcat resolve-dest))
dest)
(and (coll? dest)
(every? coll? dest))
(and (vector? dest)
(every? vector? dest))
(sequence (comp
(map vec)
(mapcat resolve-dest))
dest)
(vector? dest)
(and (vector? dest)
(keyword? (first dest)))
(let [[op param] dest]
(cond
(= op :email)
@ -475,6 +485,27 @@
;; 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*
[{:keys [::db/conn]} file-id]
(db/update! conn :file
@ -502,20 +533,105 @@
: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*
[{:keys [::db/conn] :as cfg} project-id]
(db/update! conn :project
{:deleted-at nil}
{:id project-id})
(doseq [{:keys [id]} (db/query conn :file
{:project-id project-id}
{::db/columns [:id]})]
{::sql/columns [:id]})]
(restore-file* cfg id))
: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*
[{:keys [::db/conn] :as cfg} team-id]
(db/update! conn :team
@ -528,84 +644,127 @@
(doseq [{:keys [id]} (db/query conn :project
{:team-id team-id}
{::db/columns [:id]})]
{::sql/columns [:id]})]
(restore-project* cfg id))
:restored)
(defn- restore-profile*
[{: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!
(defn restore-team!
"Mark a team and all related objects as not deleted"
[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!
"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)))
(restore-team* system team-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!
"Mark a profile for deletion"
"Mark a profile for deletion."
[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
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :profile
:deleted-at (dt/now)
:id profile-id})))))
(defn delete-project!
"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})))))
:deleted-at tnow
:id profile-id})))
:deleted))
(defn delete-file!
"Mark a project for deletion"
[file-id]
(let [file-id (h/parse-uuid file-id)]
(wrk/invoke! (-> main/system
(assoc ::wrk/task :delete-object)
(assoc ::wrk/params {:object :file
:deleted-at (dt/now)
:id file-id})))))
(defn restore-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
(fn [system]
(when-let [profile (some-> (db/get* system :profile
{:id profile-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
[]

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-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;

3
frontend/scripts/build
View file

@ -8,6 +8,7 @@ export CURRENT_VERSION=$1;
export BUILD_DATE=$(date -R);
export CURRENT_HASH=${CURRENT_HASH:-$(git rev-parse --short HEAD)};
export EXTRA_PARAMS=$SHADOWCLJS_EXTRA_PARAMS;
export TS=$(date +%s);
# Some cljs reacts on this environment variable for define more
# performant code on macros (example: rumext)
@ -17,7 +18,7 @@ yarn install || exit 1;
rm -rf resources/public;
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;
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.features :as features]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :refer [tr]]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@ -58,6 +59,10 @@
[]
(.reload js/location))
(defn hide-notifications!
[]
(st/emit! msg/hide))
(defn handle-notification
[{:keys [message code level] :as params}]
(ptk/reify ::show-notification
@ -75,6 +80,15 @@
:actions [{:label "Refresh" :callback force-reload!}]
: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
:content message
:controls :close

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

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

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

@ -17,33 +17,38 @@
(mf/defc notifications-hub
[]
(let [message (mf/deref refs/message)
on-close #(st/emit! dmsg/hide)
toast-message {:type (or (:type message) :info)
:links (:links message)
:on-close on-close
:content (:content 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))))]
on-close (mf/use-fn #(st/emit! dmsg/hide))
context? (and (nil? (:timeout message))
(nil? (:actions message)))
inline? (or (= :inline (:notification-type message))
(= :floating (:position message)))
toast? (or (= :toast (:notification-type message))
(some? (:timeout message)))]
(when message
(cond
is-toast-msg
[:& toast-notification toast-message]
is-inline-msg
[:& inline-notification inline-message]
is-context-msg
[:& context-notification context-message]
toast?
[:& toast-notification
{:type (or (:type message) :info)
:links (:links message)
:on-close on-close
: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
[:& 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))
(mf/defc toast-notification
"These are ephemeral elements that disappear when
the close button is pressed,
the page is refreshed,
the page is navigated to another page or
after 7 seconds, which is enough time to be read,
except for error messages that require user interaction."
"These are ephemeral elements that disappear when the close button
is pressed, the page is refreshed, the page is navigated to another
page or after 7 seconds, which is enough time to be read, except for
error messages that require user interaction."
{::mf/props :obj}
[{: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"
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
msgid "notifications.invitation-email-sent"
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"
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
msgid "notifications.invitation-email-sent"
msgstr "Invitación enviada con éxito"