mirror of
https://github.com/penpot/penpot.git
synced 2025-05-12 20:56:40 +02:00
✨ Add improvements to dbg interface
This commit is contained in:
parent
b6a312815c
commit
b70880420a
4 changed files with 222 additions and 57 deletions
|
@ -7,6 +7,7 @@
|
|||
(ns app.http.debug
|
||||
(:refer-clojure :exclude [error-handler])
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as pp]
|
||||
|
@ -14,9 +15,12 @@
|
|||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.http.session :as session]
|
||||
[app.main :as-alias main]
|
||||
[app.rpc.commands.auth :as auth]
|
||||
[app.rpc.commands.binfile :as binf]
|
||||
[app.rpc.commands.files-create :refer [create-file]]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.srepl.helpers :as srepl]
|
||||
[app.storage :as-alias sto]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.template :as tmpl]
|
||||
|
@ -34,15 +38,19 @@
|
|||
;; (selmer.parser/cache-off!)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HELPERS
|
||||
;; INDEX
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn authorized?
|
||||
[pool {:keys [::session/profile-id]}]
|
||||
(or (= "devenv" (cf/get :host))
|
||||
(let [profile (ex/ignoring (profile/get-profile pool profile-id))
|
||||
admins (or (cf/get :admins) #{})]
|
||||
(contains? admins (:email profile)))))
|
||||
(defn index-handler
|
||||
[_cfg _request]
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/html"}
|
||||
::yrs/body (-> (io/resource "app/templates/debug.tmpl")
|
||||
(tmpl/render {}))})
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FILE CHANGES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn prepare-response
|
||||
[body]
|
||||
|
@ -59,24 +67,6 @@
|
|||
::yrs/body body
|
||||
::yrs/headers headers}))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; INDEX
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn index-handler
|
||||
[{:keys [::db/pool]} request]
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/html"}
|
||||
::yrs/body (-> (io/resource "app/templates/debug.tmpl")
|
||||
(tmpl/render {}))})
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FILE CHANGES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def sql:retrieve-range-of-changes
|
||||
"select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
|
||||
|
||||
|
@ -85,10 +75,6 @@
|
|||
|
||||
(defn- retrieve-file-data
|
||||
[{:keys [::db/pool]} {:keys [params ::session/profile-id] :as request}]
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
|
||||
(let [file-id (some-> params :file-id parse-uuid)
|
||||
revn (some-> params :revn parse-long)
|
||||
filename (str file-id)]
|
||||
|
@ -178,10 +164,6 @@
|
|||
|
||||
(defn file-changes-handler
|
||||
[{:keys [::db/pool]} {:keys [params] :as request}]
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
|
||||
(letfn [(retrieve-changes [file-id revn]
|
||||
(if (str/includes? revn ":")
|
||||
(let [[start end] (->> (str/split revn #":")
|
||||
|
@ -251,10 +233,6 @@
|
|||
(assoc :created-at (dt/format-instant created-at :rfc1123))))))
|
||||
]
|
||||
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
|
||||
(if-let [report (get-report request)]
|
||||
(let [result (case (:version report)
|
||||
1 (render-template-v1 report)
|
||||
|
@ -275,10 +253,7 @@
|
|||
LIMIT 200")
|
||||
|
||||
(defn error-list-handler
|
||||
[{:keys [::db/pool]} request]
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
[{:keys [::db/pool]} _request]
|
||||
(let [items (->> (db/exec! pool [sql:error-reports])
|
||||
(map #(update % :created-at dt/format-instant :rfc1123)))]
|
||||
{::yrs/status 200
|
||||
|
@ -363,6 +338,93 @@
|
|||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body "OK"}))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ACTIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- resend-email-notification
|
||||
[{:keys [::db/pool ::main/props] :as cfg} {:keys [params] :as request}]
|
||||
|
||||
(when-not (contains? params :force)
|
||||
(ex/raise :type :validation
|
||||
:code :missing-force
|
||||
:hint "missing force checkbox"))
|
||||
|
||||
(let [profile (some->> params :email (profile/get-profile-by-email pool))]
|
||||
|
||||
(when-not profile
|
||||
(ex/raise :type :validation
|
||||
:code :missing-profile
|
||||
:hint "unable to find profile by email"))
|
||||
|
||||
(cond
|
||||
(contains? params :block)
|
||||
(do
|
||||
(db/update! pool :profile {:is-blocked true} {:id (:id profile)})
|
||||
(db/delete! pool :http-session {:profile-id (:id profile)})
|
||||
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
|
||||
|
||||
(contains? params :unblock)
|
||||
(do
|
||||
(db/update! pool :profile {:is-blocked false} {:id (:id profile)})
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body (str/ffmt "PROFILE '%' UNBLOCKED" (:email profile))})
|
||||
|
||||
(contains? params :resend)
|
||||
(if (:is-blocked profile)
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body "PROFILE ALREADY BLOCKED"}
|
||||
(do
|
||||
(auth/send-email-verification! pool props profile)
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body (str/ffmt "RESENDED FOR '%'" (:email profile))}))
|
||||
|
||||
:else
|
||||
(do
|
||||
(db/update! pool :profile {:is-active true} {:id (:id profile)})
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))
|
||||
|
||||
|
||||
(defn- reset-file-data-version
|
||||
[cfg {:keys [params] :as request}]
|
||||
(let [file-id (some-> params :file-id d/parse-uuid)
|
||||
version (some-> params :version d/parse-integer)]
|
||||
|
||||
(when-not (contains? params :force)
|
||||
(ex/raise :type :validation
|
||||
:code :missing-force
|
||||
:hint "missing force checkbox"))
|
||||
|
||||
(when (nil? file-id)
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-file-id
|
||||
:hint "provided invalid file id"))
|
||||
|
||||
(when (nil? version)
|
||||
(ex/raise :type :validation
|
||||
:code :invalid-version
|
||||
:hint "provided invalid version"))
|
||||
|
||||
(srepl/update-file! cfg
|
||||
:id file-id
|
||||
:update-fn (fn [file]
|
||||
(update file :data assoc :version version))
|
||||
:migrate? false
|
||||
:inc-revn? false
|
||||
:save? true)
|
||||
{::yrs/status 200
|
||||
::yrs/headers {"content-type" "text/plain"}
|
||||
::yrs/body "OK"}))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; OTHER SMALL VIEWS/HANDLERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -397,6 +459,13 @@
|
|||
;; INIT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn authorized?
|
||||
[pool {:keys [::session/profile-id]}]
|
||||
(or (= "devenv" (cf/get :host))
|
||||
(let [profile (ex/ignoring (profile/get-profile pool profile-id))
|
||||
admins (or (cf/get :admins) #{})]
|
||||
(contains? admins (:email profile)))))
|
||||
|
||||
(def with-authorization
|
||||
{:compile
|
||||
(fn [& _]
|
||||
|
@ -420,6 +489,10 @@
|
|||
["/changelog" {:handler (partial changelog-handler cfg)}]
|
||||
["/error/:id" {:handler (partial error-handler cfg)}]
|
||||
["/error" {:handler (partial error-list-handler cfg)}]
|
||||
["/actions/resend-email-verification"
|
||||
{:handler (partial resend-email-notification cfg)}]
|
||||
["/actions/reset-file-data-version"
|
||||
{:handler (partial reset-file-data-version cfg)}]
|
||||
["/file/export" {:handler (partial export-handler cfg)}]
|
||||
["/file/import" {:handler (partial import-handler cfg)}]
|
||||
["/file/data" {:handler (partial file-data-handler cfg)}]
|
||||
|
|
|
@ -284,11 +284,13 @@
|
|||
::http.ws/routes (ig/ref ::http.ws/routes)
|
||||
::http.awsns/routes (ig/ref ::http.awsns/routes)}
|
||||
|
||||
:app.http.debug/routes
|
||||
::http.debug/routes
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::wrk/executor (ig/ref ::wrk/executor)
|
||||
::session/manager (ig/ref ::session/manager)
|
||||
::sto/storage (ig/ref ::sto/storage)}
|
||||
::sto/storage (ig/ref ::sto/storage)
|
||||
::props (ig/ref ::setup/props)}
|
||||
|
||||
|
||||
::http.ws/routes
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue