mirror of
https://github.com/penpot/penpot.git
synced 2025-03-14 16:51:18 -05:00
♻️ Refactor logging subsystem and error reporting
This commit is contained in:
Andrey Antukh
parent
50ee0ad3fd
commit
bb055a3c84
30 changed files with 759 additions and 892 deletions
|
|
@ -3,9 +3,6 @@
|
|||
org.clojure/clojure {:mvn/version "1.11.1"}
|
||||
org.clojure/core.async {:mvn/version "1.6.673"}
|
||||
|
||||
;; Logging
|
||||
org.zeromq/jeromq {:mvn/version "0.5.3"}
|
||||
|
||||
com.github.luben/zstd-jni {:mvn/version "1.5.2-5"}
|
||||
org.clojure/data.fressian {:mvn/version "1.0.0"}
|
||||
|
||||
|
|
|
|||
112
backend/resources/app/templates/error-report.v2.tmpl
Normal file
112
backend/resources/app/templates/error-report.v2.tmpl
Normal file
|
|
@ -0,0 +1,112 @@
|
|||
{% extends "app/templates/base.tmpl" %}
|
||||
|
||||
{% block title %}
|
||||
penpot - error report v2 {{id}}
|
||||
{% endblock %}
|
||||
|
||||
{% block content %}
|
||||
<nav>
|
||||
<div>[<a href="/dbg/error">⮜</a>]</div>
|
||||
<div>[<a href="#message">message</a>]</div>
|
||||
<div>[<a href="#props">props</a>]</div>
|
||||
<div>[<a href="#context">context</a>]</div>
|
||||
{% if params %}
|
||||
<div>[<a href="#params">request params</a>]</div>
|
||||
{% endif %}
|
||||
{% if data %}
|
||||
<div>[<a href="#edata">error data</a>]</div>
|
||||
{% endif %}
|
||||
{% if spec-explain %}
|
||||
<div>[<a href="#spec-explain">spec explain</a>]</div>
|
||||
{% endif %}
|
||||
{% if spec-problems %}
|
||||
<div>[<a href="#spec-problems">spec problems</a>]</div>
|
||||
{% endif %}
|
||||
{% if spec-value %}
|
||||
<div>[<a href="#spec-value">spec value</a>]</div>
|
||||
{% endif %}
|
||||
{% if trace %}
|
||||
<div>[<a href="#trace">error trace</a>]</div>
|
||||
{% endif %}
|
||||
</nav>
|
||||
<main>
|
||||
<div class="table">
|
||||
<div class="table-row multiline">
|
||||
<div id="message" class="table-key">MESSAGE: </div>
|
||||
|
||||
<div class="table-val">
|
||||
<h1>{{hint}}</h1>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="table-row multiline">
|
||||
<div id="props" class="table-key">LOG PROPS: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{props}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
<div class="table-row multiline">
|
||||
<div id="context" class="table-key">CONTEXT: </div>
|
||||
|
||||
<div class="table-val">
|
||||
<pre>{{context}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
|
||||
{% if params %}
|
||||
<div class="table-row multiline">
|
||||
<div id="params" class="table-key">REQUEST PARAMS: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{params}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
|
||||
{% if data %}
|
||||
<div class="table-row multiline">
|
||||
<div id="edata" class="table-key">ERROR DATA: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{data}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
|
||||
{% if spec-explain %}
|
||||
<div class="table-row multiline">
|
||||
<div id="spec-explain" class="table-key">SPEC EXPLAIN: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{spec-explain}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
|
||||
{% if spec-problems %}
|
||||
<div class="table-row multiline">
|
||||
<div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{spec-problems}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
|
||||
{% if spec-value %}
|
||||
<div class="table-row multiline">
|
||||
<div id="spec-value" class="table-key">SPEC VALUE: </div>
|
||||
<div class="table-val">
|
||||
<pre>{{spec-value}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
|
||||
{% if trace %}
|
||||
<div class="table-row multiline">
|
||||
<div id="trace" class="table-key">TRACE:</div>
|
||||
<div class="table-val">
|
||||
<pre>{{trace}}</pre>
|
||||
</div>
|
||||
</div>
|
||||
{% endif %}
|
||||
</div>
|
||||
</main>
|
||||
{% endblock %}
|
||||
|
|
@ -51,7 +51,6 @@
|
|||
:database-password "penpot"
|
||||
|
||||
:default-blob-version 5
|
||||
:loggers-zmq-uri "tcp://localhost:45556"
|
||||
|
||||
:rpc-rlimit-config (fs/path "resources/rlimit.edn")
|
||||
:rpc-climit-config (fs/path "resources/climit.edn")
|
||||
|
|
@ -175,8 +174,6 @@
|
|||
(s/def ::ldap-ssl ::us/boolean)
|
||||
(s/def ::ldap-starttls ::us/boolean)
|
||||
(s/def ::ldap-user-query ::us/string)
|
||||
(s/def ::loggers-loki-uri ::us/string)
|
||||
(s/def ::loggers-zmq-uri ::us/string)
|
||||
(s/def ::media-directory ::us/string)
|
||||
(s/def ::media-uri ::us/string)
|
||||
(s/def ::profile-bounce-max-age ::dt/duration)
|
||||
|
|
@ -272,8 +269,6 @@
|
|||
::ldap-starttls
|
||||
::ldap-user-query
|
||||
::local-assets-uri
|
||||
::loggers-loki-uri
|
||||
::loggers-zmq-uri
|
||||
::media-max-file-size
|
||||
::profile-bounce-max-age
|
||||
::profile-bounce-threshold
|
||||
|
|
@ -357,7 +352,7 @@
|
|||
(merge defaults)
|
||||
(us/conform ::config))
|
||||
(catch Throwable e
|
||||
(when (ex/ex-info? e)
|
||||
(when (ex/error? e)
|
||||
(println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
|
||||
(println "Error on validating configuration:")
|
||||
(println (some-> e ex-data ex/explain))
|
||||
|
|
|
|||
|
|
@ -205,45 +205,47 @@
|
|||
|
||||
(defn error-handler
|
||||
[{:keys [::db/pool]} request]
|
||||
(letfn [(parse-id [request]
|
||||
(let [id (get-in request [:path-params :id])
|
||||
id (parse-uuid id)]
|
||||
(when (uuid? id)
|
||||
id)))
|
||||
|
||||
(retrieve-report [id]
|
||||
(letfn [(get-report [{:keys [path-params]}]
|
||||
(ex/ignoring
|
||||
(some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject)))
|
||||
(let [report-id (some-> path-params :id parse-uuid)]
|
||||
(some-> (db/get-by-id pool :server-error-report report-id)
|
||||
(update :content db/decode-transit-pgobject)))))
|
||||
|
||||
(render-template [report]
|
||||
(let [context (dissoc report
|
||||
(render-template-v1 [{:keys [content]}]
|
||||
(let [context (dissoc content
|
||||
:trace :cause :params :data :spec-problems :message
|
||||
:spec-explain :spec-value :error :explain :hint)
|
||||
params {:context (pp/pprint-str context :width 200)
|
||||
:hint (:hint report)
|
||||
:spec-explain (:spec-explain report)
|
||||
:spec-problems (:spec-problems report)
|
||||
:spec-value (:spec-value report)
|
||||
:data (:data report)
|
||||
:trace (or (:trace report)
|
||||
(some-> report :error :trace))
|
||||
:params (:params report)}]
|
||||
:hint (:hint content)
|
||||
:spec-explain (:spec-explain content)
|
||||
:spec-problems (:spec-problems content)
|
||||
:spec-value (:spec-value content)
|
||||
:data (:data content)
|
||||
:trace (or (:trace content)
|
||||
(some-> content :error :trace))
|
||||
:params (:params content)}]
|
||||
(-> (io/resource "app/templates/error-report.tmpl")
|
||||
(tmpl/render params))))]
|
||||
(tmpl/render params))))
|
||||
|
||||
(render-template-v2 [{report :content}]
|
||||
(-> (io/resource "app/templates/error-report.v2.tmpl")
|
||||
(tmpl/render report)))
|
||||
|
||||
]
|
||||
|
||||
(when-not (authorized? pool request)
|
||||
(ex/raise :type :authentication
|
||||
:code :only-admins-allowed))
|
||||
|
||||
(let [result (some-> (parse-id request)
|
||||
(retrieve-report)
|
||||
(render-template))]
|
||||
(if result
|
||||
(if-let [report (get-report request)]
|
||||
(let [result (if (= 1 (:version report))
|
||||
(render-template-v1 report)
|
||||
(render-template-v2 report))]
|
||||
(yrs/response :status 200
|
||||
:body result
|
||||
:headers {"content-type" "text/html; charset=utf-8"
|
||||
"x-robots-tag" "noindex"})
|
||||
(yrs/response 404 "not found")))))
|
||||
"x-robots-tag" "noindex"}))
|
||||
(yrs/response 404 "not found"))))
|
||||
|
||||
(def sql:error-reports
|
||||
"SELECT id, created_at,
|
||||
|
|
|
|||
|
|
@ -7,7 +7,6 @@
|
|||
(ns app.http.errors
|
||||
"A errors handling for the http server."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.http :as-alias http]
|
||||
|
|
@ -18,30 +17,26 @@
|
|||
[yetti.request :as yrq]
|
||||
[yetti.response :as yrs]))
|
||||
|
||||
(def ^:dynamic *context* {})
|
||||
|
||||
(defn- parse-client-ip
|
||||
[request]
|
||||
(or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
|
||||
(yrq/get-header request "x-real-ip")
|
||||
(yrq/remote-addr request)))
|
||||
|
||||
(defn get-context
|
||||
(defn request->context
|
||||
"Extracts error report relevant context data from request."
|
||||
[request]
|
||||
(let [claims (-> {}
|
||||
(into (::session/token-claims request))
|
||||
(into (::actoken/token-claims request)))]
|
||||
(merge
|
||||
*context*
|
||||
{:path (:path request)
|
||||
:method (:method request)
|
||||
:params (:params request)
|
||||
:ip-addr (parse-client-ip request)}
|
||||
(d/without-nils
|
||||
{:user-agent (yrq/get-header request "user-agent")
|
||||
:frontend-version (or (yrq/get-header request "x-frontend-version")
|
||||
"unknown")
|
||||
:profile-id (:uid claims)}))))
|
||||
{:path (:path request)
|
||||
:method (:method request)
|
||||
:params (:params request)
|
||||
:ip-addr (parse-client-ip request)
|
||||
:user-agent (yrq/get-header request "user-agent")
|
||||
:profile-id (:uid claims)
|
||||
:version (or (yrq/get-header request "x-frontend-version")
|
||||
"unknown")}))
|
||||
|
||||
(defmulti handle-exception
|
||||
(fn [err & _rest]
|
||||
|
|
@ -87,15 +82,14 @@
|
|||
[error request]
|
||||
(let [edata (ex-data error)
|
||||
explain (ex/explain edata)]
|
||||
(l/error :hint (ex-message error)
|
||||
:cause error
|
||||
::l/context (get-context request))
|
||||
(yrs/response :status 500
|
||||
:body {:type :server-error
|
||||
:code :assertion
|
||||
:data (-> edata
|
||||
(dissoc ::s/problems ::s/value ::s/spec)
|
||||
(cond-> explain (assoc :explain explain)))})))
|
||||
(binding [l/*context* (request->context request)]
|
||||
(l/error :hint "Assertion error" :message (ex-message error) :cause error)
|
||||
(yrs/response :status 500
|
||||
:body {:type :server-error
|
||||
:code :assertion
|
||||
:data (-> edata
|
||||
(dissoc ::s/problems ::s/value ::s/spec)
|
||||
(cond-> explain (assoc :explain explain)))}))))
|
||||
|
||||
(defmethod handle-exception :not-found
|
||||
[err _]
|
||||
|
|
@ -109,10 +103,8 @@
|
|||
(yrs/response 429)
|
||||
|
||||
:else
|
||||
(do
|
||||
(l/error :hint (ex-message error)
|
||||
:cause error
|
||||
::l/context (get-context request))
|
||||
(binding [l/*context* (request->context request)]
|
||||
(l/error :hint "Internal error" :message (ex-message error) :cause error)
|
||||
(yrs/response 500 {:type :server-error
|
||||
:code :unhandled
|
||||
:hint (ex-message error)
|
||||
|
|
@ -121,25 +113,24 @@
|
|||
(defmethod handle-exception org.postgresql.util.PSQLException
|
||||
[error request]
|
||||
(let [state (.getSQLState ^java.sql.SQLException error)]
|
||||
(l/error :hint (ex-message error)
|
||||
:cause error
|
||||
::l/context (get-context request))
|
||||
(cond
|
||||
(= state "57014")
|
||||
(yrs/response 504 {:type :server-error
|
||||
:code :statement-timeout
|
||||
:hint (ex-message error)})
|
||||
(binding [l/*context* (request->context request)]
|
||||
(l/error :hint "PSQL error" :message (ex-message error) :cause error)
|
||||
(cond
|
||||
(= state "57014")
|
||||
(yrs/response 504 {:type :server-error
|
||||
:code :statement-timeout
|
||||
:hint (ex-message error)})
|
||||
|
||||
(= state "25P03")
|
||||
(yrs/response 504 {:type :server-error
|
||||
:code :idle-in-transaction-timeout
|
||||
:hint (ex-message error)})
|
||||
(= state "25P03")
|
||||
(yrs/response 504 {:type :server-error
|
||||
:code :idle-in-transaction-timeout
|
||||
:hint (ex-message error)})
|
||||
|
||||
:else
|
||||
(yrs/response 500 {:type :server-error
|
||||
:code :unexpected
|
||||
:hint (ex-message error)
|
||||
:state state}))))
|
||||
:else
|
||||
(yrs/response 500 {:type :server-error
|
||||
:code :unexpected
|
||||
:hint (ex-message error)
|
||||
:state state})))))
|
||||
|
||||
(defmethod handle-exception :default
|
||||
[error request]
|
||||
|
|
@ -147,10 +138,8 @@
|
|||
(cond
|
||||
;; This means that exception is not a controlled exception.
|
||||
(nil? edata)
|
||||
(do
|
||||
(l/error :hint (ex-message error)
|
||||
:cause error
|
||||
::l/context (get-context request))
|
||||
(binding [l/*context* (request->context request)]
|
||||
(l/error :hint "Unexpected error" :message (ex-message error) :cause error)
|
||||
(yrs/response 500 {:type :server-error
|
||||
:code :unexpected
|
||||
:hint (ex-message error)}))
|
||||
|
|
@ -165,10 +154,8 @@
|
|||
(handle-exception (:handling edata) request)
|
||||
|
||||
:else
|
||||
(do
|
||||
(l/error :hint (ex-message error)
|
||||
:cause error
|
||||
::l/context (get-context request))
|
||||
(binding [l/*context* (request->context request)]
|
||||
(l/error :hint "Unhandled error" :message (ex-message error) :cause error)
|
||||
(yrs/response 500 {:type :server-error
|
||||
:code :unhandled
|
||||
:hint (ex-message error)
|
||||
|
|
@ -176,16 +163,7 @@
|
|||
|
||||
(defn handle
|
||||
[cause request]
|
||||
(cond
|
||||
(or (instance? java.util.concurrent.CompletionException cause)
|
||||
(instance? java.util.concurrent.ExecutionException cause))
|
||||
(handle-exception (.getCause ^Throwable cause) request)
|
||||
|
||||
(ex/wrapped? cause)
|
||||
(let [context (meta cause)
|
||||
cause (deref cause)]
|
||||
(binding [*context* context]
|
||||
(handle-exception cause request)))
|
||||
|
||||
:else
|
||||
(if (or (instance? java.util.concurrent.CompletionException cause)
|
||||
(instance? java.util.concurrent.ExecutionException cause))
|
||||
(handle-exception (ex-cause cause) request)
|
||||
(handle-exception cause request)))
|
||||
|
|
|
|||
|
|
@ -80,8 +80,8 @@
|
|||
(fn [request respond raise]
|
||||
(let [request (ex/try! (process-request request))]
|
||||
(if (ex/exception? request)
|
||||
(if (instance? RuntimeException request)
|
||||
(handle-error raise (or (ex/cause request) request))
|
||||
(if (ex/runtime-exception? request)
|
||||
(handle-error raise (or (ex-cause request) request))
|
||||
(handle-error raise request))
|
||||
(handler request respond raise))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
(:refer-clojure :exclude [read])
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.config :as cf]
|
||||
|
|
@ -230,17 +231,18 @@
|
|||
|
||||
(let [{:keys [::wrk/executor ::main/props]} (meta manager)]
|
||||
(fn [request respond raise]
|
||||
(let [token (get-token request)]
|
||||
(->> (px/submit! executor (partial decode-token props token))
|
||||
(p/fnly (fn [claims cause]
|
||||
(when cause
|
||||
(l/trace :hint "exception on decoding malformed token" :cause cause))
|
||||
|
||||
(let [request (cond-> request
|
||||
(map? claims)
|
||||
(-> (assoc ::token-claims claims)
|
||||
(assoc ::token token)))]
|
||||
(handler request respond raise)))))))))
|
||||
(let [token (ex/try! (get-token request))]
|
||||
(if (ex/exception? token)
|
||||
(raise token)
|
||||
(->> (px/submit! executor (partial decode-token props token))
|
||||
(p/fnly (fn [claims cause]
|
||||
(when cause
|
||||
(l/trace :hint "exception on decoding malformed token" :cause cause))
|
||||
(let [request (cond-> request
|
||||
(map? claims)
|
||||
(-> (assoc ::token-claims claims)
|
||||
(assoc ::token token)))]
|
||||
(handler request respond raise))))))))))
|
||||
|
||||
(defn- wrap-authz
|
||||
[handler {:keys [::manager]}]
|
||||
|
|
|
|||
|
|
@ -7,16 +7,17 @@
|
|||
(ns app.loggers.database
|
||||
"A specific logger impl that persists errors on the database."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.spec :as us]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.loggers.zmq :as lzmq]
|
||||
[clojure.core.async :as a]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[integrant.core :as ig]
|
||||
[promesa.exec :as px]))
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.csp :as sp]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Error Listener
|
||||
|
|
@ -27,73 +28,79 @@
|
|||
(defonce enabled (atom true))
|
||||
|
||||
(defn- persist-on-database!
|
||||
[{:keys [::db/pool] :as cfg} {:keys [id] :as event}]
|
||||
[pool id report]
|
||||
(when-not (db/read-only? pool)
|
||||
(db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
|
||||
(db/insert! pool :server-error-report
|
||||
{:id id
|
||||
:version 2
|
||||
:content (db/tjson report)})))
|
||||
|
||||
(defn- parse-event-data
|
||||
[event]
|
||||
(reduce-kv
|
||||
(fn [acc k v]
|
||||
(cond
|
||||
(= k :id) (assoc acc k (uuid/uuid v))
|
||||
(= k :profile-id) (assoc acc k (uuid/uuid v))
|
||||
(str/blank? v) acc
|
||||
:else (assoc acc k v)))
|
||||
{}
|
||||
event))
|
||||
(defn record->report
|
||||
[{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
|
||||
(us/assert! ::l/record record)
|
||||
|
||||
(defn parse-event
|
||||
[event]
|
||||
(-> (parse-event-data event)
|
||||
(assoc :hint (or (:hint event) (:message event)))
|
||||
(assoc :tenant (cf/get :tenant))
|
||||
(assoc :host (cf/get :host))
|
||||
(assoc :public-uri (cf/get :public-uri))
|
||||
(assoc :version (:full cf/version))
|
||||
(update :id #(or % (uuid/next)))))
|
||||
(merge
|
||||
{:context (-> context
|
||||
(assoc :tenant (cf/get :tenant))
|
||||
(assoc :host (cf/get :host))
|
||||
(assoc :public-uri (cf/get :public-uri))
|
||||
(assoc :version (:full cf/version))
|
||||
(assoc :logger-name logger)
|
||||
(assoc :logger-level level)
|
||||
(dissoc :params)
|
||||
(pp/pprint-str :width 200))
|
||||
:params (some-> (:params context)
|
||||
(pp/pprint-str :width 200))
|
||||
:props (pp/pprint-str props :width 200)
|
||||
:hint (or (ex-message cause) @message)
|
||||
:trace (ex/format-throwable cause :data? false :explain? false :header? false :summary? false)}
|
||||
|
||||
(when-let [data (ex-data cause)]
|
||||
{:spec-value (some-> (::s/value data) (pp/pprint-str :width 200))
|
||||
:spec-explain (ex/explain data)
|
||||
:data (-> data
|
||||
(dissoc ::s/problems ::s/value ::s/spec :hint)
|
||||
(pp/pprint-str :width 200))})))
|
||||
|
||||
(defn- handle-event
|
||||
[cfg event]
|
||||
[{:keys [::db/pool]} {:keys [::l/id] :as record}]
|
||||
(try
|
||||
(let [event (parse-event event)
|
||||
uri (cf/get :public-uri)]
|
||||
(let [uri (cf/get :public-uri)
|
||||
report (-> record record->report d/without-nils)]
|
||||
(l/debug :hint "registering error on database" :id id
|
||||
:uri (str uri "/dbg/error/" id))
|
||||
|
||||
(l/debug :hint "registering error on database" :id (:id event)
|
||||
:uri (str uri "/dbg/error/" (:id event)))
|
||||
|
||||
(persist-on-database! cfg event))
|
||||
(persist-on-database! pool id report))
|
||||
(catch Throwable cause
|
||||
(l/warn :hint "unexpected exception on database error logger" :cause cause))))
|
||||
|
||||
(defn- error-event?
|
||||
[event]
|
||||
(= "error" (:logger/level event)))
|
||||
(defn error-record?
|
||||
[{:keys [::l/level ::l/cause]}]
|
||||
(and (= :error level)
|
||||
(ex/exception? cause)))
|
||||
|
||||
(defmethod ig/pre-init-spec ::reporter [_]
|
||||
(s/keys :req [::db/pool ::lzmq/receiver]))
|
||||
(s/keys :req [::db/pool]))
|
||||
|
||||
(defmethod ig/init-key ::reporter
|
||||
[_ {:keys [::lzmq/receiver] :as cfg}]
|
||||
(px/thread
|
||||
{:name "penpot/database-reporter"}
|
||||
(l/info :hint "initializing database error persistence")
|
||||
|
||||
(let [input (a/chan (a/sliding-buffer 5)
|
||||
(filter error-event?))]
|
||||
[_ cfg]
|
||||
(let [input (sp/chan (sp/sliding-buffer 32) (filter error-record?))]
|
||||
(add-watch l/log-record ::reporter #(sp/put! input %4))
|
||||
(px/thread
|
||||
{:name "penpot/database-reporter" :virtual true}
|
||||
(l/info :hint "initializing database error persistence")
|
||||
(try
|
||||
(lzmq/sub! receiver input)
|
||||
(loop []
|
||||
(when-let [msg (a/<!! input)]
|
||||
(handle-event cfg msg))
|
||||
(recur))
|
||||
|
||||
(when-let [record (sp/take! input)]
|
||||
(handle-event cfg record)
|
||||
(recur)))
|
||||
(catch InterruptedException _
|
||||
(l/debug :hint "reporter interrupted"))
|
||||
(catch Throwable cause
|
||||
(l/error :hint "unexpected error" :cause cause))
|
||||
(finally
|
||||
(a/close! input)
|
||||
(sp/close! input)
|
||||
(remove-watch l/log-record ::reporter)
|
||||
(l/info :hint "reporter terminated"))))))
|
||||
|
||||
(defmethod ig/halt-key! ::reporter
|
||||
|
|
|
|||
|
|
@ -1,89 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.loggers.loki
|
||||
"A Loki integration."
|
||||
(:require
|
||||
[app.common.logging :as l]
|
||||
[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]
|
||||
[promesa.exec :as px]))
|
||||
|
||||
(declare ^:private handle-event)
|
||||
|
||||
(defmethod ig/pre-init-spec ::reporter [_]
|
||||
(s/keys :req [::http/client
|
||||
::lzmq/receiver]))
|
||||
|
||||
(defmethod ig/init-key ::reporter
|
||||
[_ 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)]
|
||||
|
||||
(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 exception"
|
||||
:cause cause))
|
||||
(finally
|
||||
(a/close! input)
|
||||
(l/info :hint "reporter terminated")))))))
|
||||
|
||||
(defmethod ig/halt-key! ::reporter
|
||||
[_ thread]
|
||||
(some-> thread px/interrupt!))
|
||||
|
||||
(defn- prepare-payload
|
||||
[event]
|
||||
(let [labels {:host (cf/get :host)
|
||||
:tenant (cf/get :tenant)
|
||||
:version (:full cf/version)
|
||||
:logger (:logger/name event)
|
||||
:level (:logger/level event)}]
|
||||
{:streams
|
||||
[{:stream labels
|
||||
:values [[(str (* (inst-ms (:created-at event)) 1000000))
|
||||
(str (:message event)
|
||||
(when-let [error (:trace event)]
|
||||
(str "\n" error)))]]}]}))
|
||||
|
||||
(defn- make-request
|
||||
[{:keys [::uri] :as cfg} payload]
|
||||
(http/req! cfg
|
||||
{:uri uri
|
||||
:timeout 3000
|
||||
:method :post
|
||||
:headers {"content-type" "application/json"}
|
||||
:body (json/encode payload)}
|
||||
{:sync? true}))
|
||||
|
||||
(defn- handle-event
|
||||
[cfg event]
|
||||
(try
|
||||
(let [payload (prepare-payload event)
|
||||
response (make-request cfg payload)]
|
||||
(when-not (= 204 (:status response))
|
||||
(l/error :hint "error on sending log to loki (unexpected response)"
|
||||
:response (pr-str response))))
|
||||
(catch Throwable cause
|
||||
(l/error :hint "error on sending log to loki (unexpected exception)"
|
||||
:cause cause))))
|
||||
|
|
@ -7,24 +7,35 @@
|
|||
(ns app.loggers.mattermost
|
||||
"A mattermost integration for error reporting."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[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.exec :as px]))
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.csp :as sp]))
|
||||
|
||||
(defonce enabled (atom true))
|
||||
(defonce enabled (atom false))
|
||||
|
||||
(defn- send-mattermost-notification!
|
||||
[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")))
|
||||
[cfg {:keys [id public-uri] :as report}]
|
||||
(let [text (str "Exception: " public-uri "/dbg/error/" id " "
|
||||
(when-let [pid (:profile-id report)]
|
||||
(str "(pid: #uuid-" pid ")"))
|
||||
"\n"
|
||||
"```\n"
|
||||
"- host: `" (:host report) "`\n"
|
||||
"- tenant: `" (:tenant report) "`\n"
|
||||
"- version: `" (:version report) "`\n"
|
||||
"\n"
|
||||
"Trace:\n"
|
||||
(:trace report)
|
||||
"```")
|
||||
|
||||
resp (http/req! cfg
|
||||
{:uri (cf/get :error-report-webhook)
|
||||
:method :post
|
||||
|
|
@ -36,32 +47,41 @@
|
|||
(l/warn :hint "error on sending data"
|
||||
:response (pr-str resp)))))
|
||||
|
||||
(defn record->report
|
||||
[{:keys [::l/context ::l/id ::l/cause] :as record}]
|
||||
(us/assert! ::l/record record)
|
||||
{:id id
|
||||
:tenant (cf/get :tenant)
|
||||
:host (cf/get :host)
|
||||
:public-uri (cf/get :public-uri)
|
||||
:version (:full cf/version)
|
||||
:profile-id (:profile-id context)
|
||||
:trace (ex/format-throwable cause :detail? false :header? false)})
|
||||
|
||||
(defn handle-event
|
||||
[cfg event]
|
||||
[cfg record]
|
||||
(when @enabled
|
||||
(try
|
||||
(let [event (ldb/parse-event event)]
|
||||
(send-mattermost-notification! cfg event))
|
||||
(let [report (record->report record)]
|
||||
(send-mattermost-notification! cfg report))
|
||||
(catch Throwable cause
|
||||
(l/warn :hint "unhandled error"
|
||||
:cause cause)))))
|
||||
(l/warn :hint "unhandled error" :cause cause)))))
|
||||
|
||||
(defmethod ig/pre-init-spec ::reporter [_]
|
||||
(s/keys :req [::http/client
|
||||
::lzmq/receiver]))
|
||||
(s/keys :req [::http/client]))
|
||||
|
||||
(defmethod ig/init-key ::reporter
|
||||
[_ 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")))]
|
||||
{:name "penpot/mattermost-reporter"
|
||||
:virtual true}
|
||||
(l/info :hint "initializing error reporter" :uri uri)
|
||||
(let [input (sp/chan (sp/sliding-buffer 128) (filter ldb/error-record?))]
|
||||
(add-watch l/log-record ::reporter #(sp/put! input %4))
|
||||
(try
|
||||
(lzmq/sub! (::lzmq/receiver cfg) input)
|
||||
(loop []
|
||||
(when-let [msg (a/<!! input)]
|
||||
(when-let [msg (sp/take! input)]
|
||||
(handle-event cfg msg)
|
||||
(recur)))
|
||||
(catch InterruptedException _
|
||||
|
|
@ -69,7 +89,8 @@
|
|||
(catch Throwable cause
|
||||
(l/error :hint "unexpected error" :cause cause))
|
||||
(finally
|
||||
(a/close! input)
|
||||
(sp/close! input)
|
||||
(remove-watch l/log-record ::reporter)
|
||||
(l/info :hint "reporter terminated")))))))
|
||||
|
||||
(defmethod ig/halt-key! ::reporter
|
||||
|
|
|
|||
|
|
@ -1,130 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.loggers.zmq
|
||||
"A generic ZMQ listener."
|
||||
(:require
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[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]
|
||||
[promesa.exec :as px])
|
||||
(:import
|
||||
org.zeromq.SocketType
|
||||
org.zeromq.ZMQ$Socket
|
||||
org.zeromq.ZContext))
|
||||
|
||||
(declare prepare)
|
||||
(declare start-rcv-loop)
|
||||
|
||||
(defmethod ig/init-key ::receiver
|
||||
[_ 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)
|
||||
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)
|
||||
(-> 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
|
||||
[_ {:keys [::receiver/buffer ::receiver/thread]}]
|
||||
(some-> thread px/interrupt!)
|
||||
(some-> buffer a/close!))
|
||||
|
||||
(def ^:private json-mapper
|
||||
(json/mapper
|
||||
{:encode-key-fn str/camel
|
||||
:decode-key-fn (comp keyword str/kebab)}))
|
||||
|
||||
(defn- start-rcv-loop
|
||||
[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/decode 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?)
|
||||
(s/def ::thread string?)
|
||||
(s/def ::time-millis integer?)
|
||||
(s/def ::message string?)
|
||||
(s/def ::context-map map?)
|
||||
(s/def ::thrown map?)
|
||||
|
||||
(s/def ::log4j-event
|
||||
(s/keys :req-un [::logger-name ::level ::thread ::time-millis ::message]
|
||||
:opt-un [::context-map ::thrown]))
|
||||
|
||||
(defn- prepare
|
||||
[event]
|
||||
(if (s/valid? ::log4j-event event)
|
||||
(merge {:message (:message event)
|
||||
:created-at (dt/instant (:time-millis event))
|
||||
:logger/name (:logger-name event)
|
||||
:logger/level (str/lower (:level event))}
|
||||
|
||||
(when-let [trace (-> event :thrown :extended-stack-trace)]
|
||||
{:trace trace})
|
||||
|
||||
(:context-map event))
|
||||
(do
|
||||
(l/warn :hint "invalid event" :event event)
|
||||
nil)))
|
||||
|
|
@ -23,7 +23,6 @@
|
|||
[app.loggers.audit :as-alias audit]
|
||||
[app.loggers.audit.tasks :as-alias audit.tasks]
|
||||
[app.loggers.webhooks :as-alias webhooks]
|
||||
[app.loggers.zmq :as-alias lzmq]
|
||||
[app.metrics :as-alias mtx]
|
||||
[app.metrics.definition :as-alias mdef]
|
||||
[app.msgbus :as-alias mbus]
|
||||
|
|
@ -430,9 +429,6 @@
|
|||
{:pool (ig/ref ::db/pool)
|
||||
:key (cf/get :secret-key)}
|
||||
|
||||
::lzmq/receiver
|
||||
{}
|
||||
|
||||
::audit/collector
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::wrk/executor (ig/ref ::wrk/executor)
|
||||
|
|
@ -454,17 +450,11 @@
|
|||
{::db/pool (ig/ref ::db/pool)
|
||||
::http.client/client (ig/ref ::http.client/client)}
|
||||
|
||||
:app.loggers.loki/reporter
|
||||
{::lzmq/receiver (ig/ref ::lzmq/receiver)
|
||||
::http.client/client (ig/ref ::http.client/client)}
|
||||
|
||||
:app.loggers.mattermost/reporter
|
||||
{::lzmq/receiver (ig/ref ::lzmq/receiver)
|
||||
::http.client/client (ig/ref ::http.client/client)}
|
||||
{::http.client/client (ig/ref ::http.client/client)}
|
||||
|
||||
:app.loggers.database/reporter
|
||||
{::lzmq/receiver (ig/ref :app.loggers.zmq/receiver)
|
||||
::db/pool (ig/ref ::db/pool)}
|
||||
{::db/pool (ig/ref ::db/pool)}
|
||||
|
||||
::sto/storage
|
||||
{:pool (ig/ref ::db/pool)
|
||||
|
|
|
|||
|
|
@ -308,6 +308,9 @@
|
|||
{:name "0100-mod-profile-indexes"
|
||||
:fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")}
|
||||
|
||||
{:name "0101-mod-server-error-report-table"
|
||||
:fn (mg/resource "app/migrations/sql/0101-mod-server-error-report-table.sql")}
|
||||
|
||||
])
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,2 @@
|
|||
ALTER TABLE server_error_report
|
||||
ADD COLUMN version integer DEFAULT 1;
|
||||
|
|
@ -79,7 +79,7 @@
|
|||
|
||||
(us/verify! ::msgbus msgbus)
|
||||
|
||||
(set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/async false))
|
||||
(set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
|
||||
(set-error-mode! state :continue)
|
||||
(start-io-loop! msgbus)
|
||||
|
||||
|
|
@ -133,7 +133,7 @@
|
|||
[nsubs cfg topic chan]
|
||||
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
|
||||
(when (= 1 (count nsubs))
|
||||
(l/trace :hint "open subscription" :topic topic ::l/async false)
|
||||
(l/trace :hint "open subscription" :topic topic ::l/sync? true)
|
||||
(redis-sub cfg topic))
|
||||
nsubs))
|
||||
|
||||
|
|
@ -144,7 +144,7 @@
|
|||
[nsubs cfg topic chan]
|
||||
(let [nsubs (disj nsubs chan)]
|
||||
(when (empty? nsubs)
|
||||
(l/trace :hint "close subscription" :topic topic ::l/async false)
|
||||
(l/trace :hint "close subscription" :topic topic ::l/sync? true)
|
||||
(redis-unsub cfg topic))
|
||||
nsubs))
|
||||
|
||||
|
|
|
|||
|
|
@ -93,7 +93,7 @@
|
|||
(p/mcat (partial handle-response request))
|
||||
(p/fnly (fn [response cause]
|
||||
(if cause
|
||||
(raise (ex/wrap-with-context cause {:profile-id profile-id}))
|
||||
(raise cause)
|
||||
(respond response)))))))
|
||||
|
||||
(defn- rpc-mutation-handler
|
||||
|
|
@ -117,7 +117,7 @@
|
|||
(p/mcat (partial handle-response request))
|
||||
(p/fnly (fn [response cause]
|
||||
(if cause
|
||||
(raise (ex/wrap-with-context cause {:profile-id profile-id}))
|
||||
(raise cause)
|
||||
(respond response)))))))
|
||||
|
||||
(defn- rpc-command-handler
|
||||
|
|
@ -144,7 +144,7 @@
|
|||
(p/mcat (partial handle-response request))
|
||||
(p/fnly (fn [response cause]
|
||||
(if cause
|
||||
(raise (ex/wrap-with-context cause {:profile-id profile-id}))
|
||||
(raise cause)
|
||||
(respond response))))))))
|
||||
|
||||
(defn- wrap-metrics
|
||||
|
|
|
|||
|
|
@ -32,7 +32,7 @@
|
|||
|
||||
(defn- capacity-exception?
|
||||
[o]
|
||||
(and (ex/ex-info? o)
|
||||
(and (ex/error? o)
|
||||
(let [data (ex-data o)]
|
||||
(and (= :bulkhead-error (:type data))
|
||||
(= :capacity-limit-reached (:code data))))))
|
||||
|
|
|
|||
|
|
@ -109,20 +109,20 @@
|
|||
|
||||
(defn write-byte!
|
||||
[^DataOutputStream output data]
|
||||
(l/trace :fn "write-byte!" :data data :position @*position* ::l/async false)
|
||||
(l/trace :fn "write-byte!" :data data :position @*position* ::l/sync? true)
|
||||
(.writeByte output (byte data))
|
||||
(swap! *position* inc))
|
||||
|
||||
(defn read-byte!
|
||||
[^DataInputStream input]
|
||||
(let [v (.readByte input)]
|
||||
(l/trace :fn "read-byte!" :val v :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-byte!" :val v :position @*position* ::l/sync? true)
|
||||
(swap! *position* inc)
|
||||
v))
|
||||
|
||||
(defn write-long!
|
||||
[^DataOutputStream output data]
|
||||
(l/trace :fn "write-long!" :data data :position @*position* ::l/async false)
|
||||
(l/trace :fn "write-long!" :data data :position @*position* ::l/sync? true)
|
||||
(.writeLong output (long data))
|
||||
(swap! *position* + 8))
|
||||
|
||||
|
|
@ -130,14 +130,14 @@
|
|||
(defn read-long!
|
||||
[^DataInputStream input]
|
||||
(let [v (.readLong input)]
|
||||
(l/trace :fn "read-long!" :val v :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-long!" :val v :position @*position* ::l/sync? true)
|
||||
(swap! *position* + 8)
|
||||
v))
|
||||
|
||||
(defn write-bytes!
|
||||
[^DataOutputStream output ^bytes data]
|
||||
(let [size (alength data)]
|
||||
(l/trace :fn "write-bytes!" :size size :position @*position* ::l/async false)
|
||||
(l/trace :fn "write-bytes!" :size size :position @*position* ::l/sync? true)
|
||||
(.write output data 0 size)
|
||||
(swap! *position* + size)))
|
||||
|
||||
|
|
@ -145,7 +145,7 @@
|
|||
[^InputStream input ^bytes buff]
|
||||
(let [size (alength buff)
|
||||
readed (.readNBytes input buff 0 size)]
|
||||
(l/trace :fn "read-bytes!" :expected (alength buff) :readed readed :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-bytes!" :expected (alength buff) :readed readed :position @*position* ::l/sync? true)
|
||||
(swap! *position* + readed)
|
||||
readed))
|
||||
|
||||
|
|
@ -153,7 +153,7 @@
|
|||
|
||||
(defn write-uuid!
|
||||
[^DataOutputStream output id]
|
||||
(l/trace :fn "write-uuid!" :position @*position* :WRITTEN? (.size output) ::l/async false)
|
||||
(l/trace :fn "write-uuid!" :position @*position* :WRITTEN? (.size output) ::l/sync? true)
|
||||
|
||||
(doto output
|
||||
(write-byte! (get-mark :uuid))
|
||||
|
|
@ -162,7 +162,7 @@
|
|||
|
||||
(defn read-uuid!
|
||||
[^DataInputStream input]
|
||||
(l/trace :fn "read-uuid!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-uuid!" :position @*position* ::l/sync? true)
|
||||
(let [m (read-byte! input)]
|
||||
(assert-mark m :uuid)
|
||||
(let [a (read-long! input)
|
||||
|
|
@ -171,7 +171,7 @@
|
|||
|
||||
(defn write-obj!
|
||||
[^DataOutputStream output data]
|
||||
(l/trace :fn "write-obj!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "write-obj!" :position @*position* ::l/sync? true)
|
||||
(let [^bytes data (fres/encode data)]
|
||||
(doto output
|
||||
(write-byte! (get-mark :obj))
|
||||
|
|
@ -180,7 +180,7 @@
|
|||
|
||||
(defn read-obj!
|
||||
[^DataInputStream input]
|
||||
(l/trace :fn "read-obj!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-obj!" :position @*position* ::l/sync? true)
|
||||
(let [m (read-byte! input)]
|
||||
(assert-mark m :obj)
|
||||
(let [size (read-long! input)]
|
||||
|
|
@ -191,14 +191,14 @@
|
|||
|
||||
(defn write-label!
|
||||
[^DataOutputStream output label]
|
||||
(l/trace :fn "write-label!" :label label :position @*position* ::l/async false)
|
||||
(l/trace :fn "write-label!" :label label :position @*position* ::l/sync? true)
|
||||
(doto output
|
||||
(write-byte! (get-mark :label))
|
||||
(write-obj! label)))
|
||||
|
||||
(defn read-label!
|
||||
[^DataInputStream input]
|
||||
(l/trace :fn "read-label!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-label!" :position @*position* ::l/sync? true)
|
||||
(let [m (read-byte! input)]
|
||||
(assert-mark m :label)
|
||||
(read-obj! input)))
|
||||
|
|
@ -208,7 +208,7 @@
|
|||
(l/trace :fn "write-header!"
|
||||
:version version
|
||||
:position @*position*
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
(let [vers (-> version name (subs 1) parse-long)
|
||||
output (io/data-output-stream output)]
|
||||
(doto output
|
||||
|
|
@ -218,7 +218,7 @@
|
|||
|
||||
(defn read-header!
|
||||
[^InputStream input]
|
||||
(l/trace :fn "read-header!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-header!" :position @*position* ::l/sync? true)
|
||||
(let [input (io/data-input-stream input)
|
||||
mark (read-byte! input)
|
||||
mnum (read-long! input)
|
||||
|
|
@ -235,13 +235,13 @@
|
|||
(defn copy-stream!
|
||||
[^OutputStream output ^InputStream input ^long size]
|
||||
(let [written (io/copy! input output :size size)]
|
||||
(l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/async false)
|
||||
(l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/sync? true)
|
||||
(swap! *position* + written)
|
||||
written))
|
||||
|
||||
(defn write-stream!
|
||||
[^DataOutputStream output stream size]
|
||||
(l/trace :fn "write-stream!" :position @*position* ::l/async false :size size)
|
||||
(l/trace :fn "write-stream!" :position @*position* ::l/sync? true :size size)
|
||||
(doto output
|
||||
(write-byte! (get-mark :stream))
|
||||
(write-long! size))
|
||||
|
|
@ -250,7 +250,7 @@
|
|||
|
||||
(defn read-stream!
|
||||
[^DataInputStream input]
|
||||
(l/trace :fn "read-stream!" :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-stream!" :position @*position* ::l/sync? true)
|
||||
(let [m (read-byte! input)
|
||||
s (read-long! input)
|
||||
p (tmp/tempfile :prefix "penpot.binfile.")]
|
||||
|
|
@ -264,7 +264,7 @@
|
|||
(if (> s temp-file-threshold)
|
||||
(with-open [^OutputStream output (io/output-stream p)]
|
||||
(let [readed (io/copy! input output :offset 0 :size s)]
|
||||
(l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/async false)
|
||||
(l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/sync? true)
|
||||
(swap! *position* + readed)
|
||||
[s p]))
|
||||
[s (io/read-as-bytes input :size s)])))
|
||||
|
|
@ -465,7 +465,7 @@
|
|||
(with-open [output (io/data-output-stream output)]
|
||||
(binding [*state* (volatile! {})]
|
||||
(run! (fn [section]
|
||||
(l/debug :hint "write section" :section section ::l/async false)
|
||||
(l/debug :hint "write section" :section section ::l/sync? true)
|
||||
(write-label! output section)
|
||||
(let [options (-> options
|
||||
(assoc ::output output)
|
||||
|
|
@ -499,7 +499,7 @@
|
|||
(l/debug :hint "write penpot file"
|
||||
:id file-id
|
||||
:media (count media)
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
|
||||
(doto output
|
||||
(write-obj! file)
|
||||
|
|
@ -511,7 +511,7 @@
|
|||
[{:keys [::db/pool ::output ::include-libraries?]}]
|
||||
(let [rels (when include-libraries?
|
||||
(retrieve-library-relations pool (-> *state* deref :files)))]
|
||||
(l/debug :hint "found rels" :total (count rels) ::l/async false)
|
||||
(l/debug :hint "found rels" :total (count rels) ::l/sync? true)
|
||||
(write-obj! output rels)))
|
||||
|
||||
(defmethod write-section :v1/sobjects
|
||||
|
|
@ -520,14 +520,14 @@
|
|||
storage (media/configure-assets-storage storage)]
|
||||
(l/debug :hint "found sobjects"
|
||||
:items (count sids)
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
|
||||
;; Write all collected storage objects
|
||||
(write-obj! output sids)
|
||||
|
||||
(doseq [id sids]
|
||||
(let [{:keys [size] :as obj} @(sto/get-object storage id)]
|
||||
(l/debug :hint "write sobject" :id id ::l/async false)
|
||||
(l/debug :hint "write sobject" :id id ::l/sync? true)
|
||||
(doto output
|
||||
(write-uuid! id)
|
||||
(write-obj! (meta obj)))
|
||||
|
|
@ -587,7 +587,7 @@
|
|||
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
|
||||
(binding [*state* (volatile! {:media [] :index {}})]
|
||||
(run! (fn [section]
|
||||
(l/debug :hint "reading section" :section section ::l/async false)
|
||||
(l/debug :hint "reading section" :section section ::l/sync? true)
|
||||
(assert-read-label! input section)
|
||||
(let [options (-> options
|
||||
(assoc ::section section)
|
||||
|
|
@ -605,7 +605,7 @@
|
|||
(defmethod read-section :v1/metadata
|
||||
[{:keys [::input]}]
|
||||
(let [{:keys [version files]} (read-obj! input)]
|
||||
(l/debug :hint "metadata readed" :version (:full version) :files files ::l/async false)
|
||||
(l/debug :hint "metadata readed" :version (:full version) :files files ::l/sync? true)
|
||||
(vswap! *state* update :index update-index files)
|
||||
(vswap! *state* assoc :version version :files files)))
|
||||
|
||||
|
|
@ -633,14 +633,14 @@
|
|||
:hint "the penpot file seems corrupt, found unexpected uuid (file-id)"))
|
||||
|
||||
;; Update index using with media
|
||||
(l/debug :hint "update index with media" ::l/async false)
|
||||
(l/debug :hint "update index with media" ::l/sync? true)
|
||||
(vswap! *state* update :index update-index (map :id media'))
|
||||
|
||||
;; Store file media for later insertion
|
||||
(l/debug :hint "update media references" ::l/async false)
|
||||
(l/debug :hint "update media references" ::l/sync? true)
|
||||
(vswap! *state* update :media into (map #(update % :id lookup-index)) media')
|
||||
|
||||
(l/debug :hint "processing file" :file-id file-id ::features features ::l/async false)
|
||||
(l/debug :hint "processing file" :file-id file-id ::features features ::l/sync? true)
|
||||
|
||||
(binding [ffeat/*current* features
|
||||
ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
|
||||
|
|
@ -666,7 +666,7 @@
|
|||
:created-at timestamp
|
||||
:modified-at timestamp}]
|
||||
|
||||
(l/debug :hint "create file" :id file-id' ::l/async false)
|
||||
(l/debug :hint "create file" :id file-id' ::l/sync? true)
|
||||
|
||||
(if overwrite?
|
||||
(create-or-update-file conn params)
|
||||
|
|
@ -689,7 +689,7 @@
|
|||
(l/debug :hint "create file library link"
|
||||
:file-id (:file-id rel)
|
||||
:lib-id (:library-file-id rel)
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
(db/insert! conn :file-library-rel rel)))))
|
||||
|
||||
(defmethod read-section :v1/sobjects
|
||||
|
|
@ -706,7 +706,7 @@
|
|||
:code :inconsistent-penpot-file
|
||||
:hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"))
|
||||
|
||||
(l/debug :hint "readed storage object" :id id ::l/async false)
|
||||
(l/debug :hint "readed storage object" :id id ::l/sync? true)
|
||||
|
||||
(let [[size resource] (read-stream! input)
|
||||
hash (sto/calculate-hash resource)
|
||||
|
|
@ -720,18 +720,18 @@
|
|||
|
||||
sobject @(sto/put-object! storage params)]
|
||||
|
||||
(l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/async false)
|
||||
(l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true)
|
||||
(vswap! *state* update :index assoc id (:id sobject)))))
|
||||
|
||||
(doseq [item (:media @*state*)]
|
||||
(l/debug :hint "inserting file media object"
|
||||
:id (:id item)
|
||||
:file-id (:file-id item)
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
|
||||
(let [file-id (lookup-index (:file-id item))]
|
||||
(if (= file-id (:file-id item))
|
||||
(l/warn :hint "ignoring file media object" :file-id (:file-id item) ::l/async false)
|
||||
(l/warn :hint "ignoring file media object" :file-id (:file-id item) ::l/sync? true)
|
||||
(db/insert! conn :file-media-object
|
||||
(-> item
|
||||
(assoc :file-id file-id)
|
||||
|
|
@ -742,7 +742,7 @@
|
|||
(defn- lookup-index
|
||||
[id]
|
||||
(let [val (get-in @*state* [:index id])]
|
||||
(l/trace :fn "lookup-index" :id id :val val ::l/async false)
|
||||
(l/trace :fn "lookup-index" :id id :val val ::l/sync? true)
|
||||
(when (and (not (::ignore-index-errors? *options*)) (not val))
|
||||
(ex/raise :type :validation
|
||||
:code :incomplete-index
|
||||
|
|
@ -755,7 +755,7 @@
|
|||
index index]
|
||||
(if-let [id (first items)]
|
||||
(let [new-id (if (::overwrite? *options*) id (uuid/next))]
|
||||
(l/trace :fn "update-index" :id id :new-id new-id ::l/async false)
|
||||
(l/trace :fn "update-index" :id id :new-id new-id ::l/sync? true)
|
||||
(recur (rest items)
|
||||
(assoc index id new-id)))
|
||||
index)))
|
||||
|
|
@ -803,7 +803,7 @@
|
|||
(try
|
||||
(process-map-form form)
|
||||
(catch Throwable cause
|
||||
(l/warn :hint "failed form" :form (pr-str form) ::l/async false)
|
||||
(l/warn :hint "failed form" :form (pr-str form) ::l/sync? true)
|
||||
(throw cause)))
|
||||
form))
|
||||
data)))
|
||||
|
|
|
|||
|
|
@ -41,7 +41,6 @@
|
|||
(s/def ::project-id ::us/uuid)
|
||||
(s/def ::style valid-style)
|
||||
(s/def ::team-id ::us/uuid)
|
||||
(s/def ::team-id ::us/uuid)
|
||||
(s/def ::weight valid-weight)
|
||||
|
||||
;; --- QUERY: Get font variants
|
||||
|
|
|
|||
|
|
@ -363,7 +363,7 @@
|
|||
(let [state (read-config path)]
|
||||
(l/info :hint "config refreshed"
|
||||
:loaded-limits (count (::limits state))
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
state)))))
|
||||
|
||||
(schedule-next [state]
|
||||
|
|
@ -380,10 +380,10 @@
|
|||
(when-not (instance? java.util.concurrent.RejectedExecutionException cause)
|
||||
(if-let [explain (-> cause ex-data ex/explain)]
|
||||
(l/warn ::l/raw (str "unable to refresh config, invalid format:\n" explain)
|
||||
::l/async false)
|
||||
::l/sync? true)
|
||||
(l/warn :hint "unexpected exception on loading config"
|
||||
:cause cause
|
||||
::l/async false))))
|
||||
::l/sync? true))))
|
||||
|
||||
(defn- get-config-path
|
||||
[]
|
||||
|
|
|
|||
|
|
@ -242,7 +242,7 @@
|
|||
(let [result (a/<! (handler wsp v))]
|
||||
;; (l/trace :hint "message received" :message v)
|
||||
(cond
|
||||
(ex/ex-info? result)
|
||||
(ex/error? result)
|
||||
(a/>! output-ch {:type :error :error (ex-data result)})
|
||||
|
||||
(ex/exception? result)
|
||||
|
|
|
|||
|
|
@ -80,9 +80,9 @@
|
|||
:path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
|
||||
system (-> (merge main/system-config main/worker-config)
|
||||
(assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config))
|
||||
(assoc-in [:app.db/pool :uri] (:database-uri config))
|
||||
(assoc-in [:app.db/pool :username] (:database-username config))
|
||||
(assoc-in [:app.db/pool :password] (:database-password config))
|
||||
(assoc-in [::db/pool ::db/uri] (:database-uri config))
|
||||
(assoc-in [::db/pool ::db/username] (:database-username config))
|
||||
(assoc-in [::db/pool ::db/password] (:database-password config))
|
||||
(assoc-in [:app.rpc/methods :templates] templates)
|
||||
(dissoc :app.srepl/server
|
||||
:app.http/server
|
||||
|
|
@ -390,7 +390,7 @@
|
|||
|
||||
(defn ex-info?
|
||||
[v]
|
||||
(instance? clojure.lang.ExceptionInfo v))
|
||||
(ex/error? v))
|
||||
|
||||
(defn ex-type
|
||||
[e]
|
||||
|
|
|
|||
|
|
@ -11,13 +11,13 @@
|
|||
org.apache.logging.log4j/log4j-core {:mvn/version "2.19.0"}
|
||||
org.apache.logging.log4j/log4j-web {:mvn/version "2.19.0"}
|
||||
org.apache.logging.log4j/log4j-jul {:mvn/version "2.19.0"}
|
||||
org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.18.0"}
|
||||
org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
|
||||
org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.19.0"}
|
||||
org.slf4j/slf4j-api {:mvn/version "2.0.6"}
|
||||
pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.26"}
|
||||
|
||||
selmer/selmer {:mvn/version "1.12.55"}
|
||||
criterium/criterium {:mvn/version "0.4.6"}
|
||||
|
||||
|
||||
expound/expound {:mvn/version "0.9.0"}
|
||||
com.cognitect/transit-clj {:mvn/version "1.0.329"}
|
||||
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
|
||||
|
|
|
|||
|
|
@ -13,18 +13,19 @@
|
|||
(:require-macros [app.common.data]))
|
||||
|
||||
(:require
|
||||
[app.common.math :as mth]
|
||||
[clojure.set :as set]
|
||||
[cuerdas.core :as str]
|
||||
#?(:cljs [cljs.reader :as r]
|
||||
:clj [clojure.edn :as r])
|
||||
#?(:cljs [cljs.core :as c]
|
||||
:clj [clojure.core :as c])
|
||||
[app.common.math :as mth]
|
||||
[clojure.set :as set]
|
||||
[cuerdas.core :as str]
|
||||
[linked.map :as lkm]
|
||||
[linked.set :as lks])
|
||||
|
||||
#?(:clj
|
||||
(:import
|
||||
linked.set.LinkedSet
|
||||
linked.map.LinkedMap
|
||||
java.lang.AutoCloseable)))
|
||||
|
||||
(def boolean-or-nil?
|
||||
|
|
@ -39,11 +40,21 @@
|
|||
([a] (conj lks/empty-linked-set a))
|
||||
([a & xs] (apply conj lks/empty-linked-set a xs)))
|
||||
|
||||
(defn ordered-map
|
||||
([] lkm/empty-linked-map)
|
||||
([a] (conj lkm/empty-linked-map a))
|
||||
([a & xs] (apply conj lkm/empty-linked-map a xs)))
|
||||
|
||||
(defn ordered-set?
|
||||
[o]
|
||||
#?(:cljs (instance? lks/LinkedSet o)
|
||||
:clj (instance? LinkedSet o)))
|
||||
|
||||
(defn ordered-map?
|
||||
[o]
|
||||
#?(:cljs (instance? lkm/LinkedMap o)
|
||||
:clj (instance? LinkedMap o)))
|
||||
|
||||
#?(:clj
|
||||
(defmethod print-method clojure.lang.PersistentQueue [q, w]
|
||||
;; Overload the printer for queues so they look like fish
|
||||
|
|
|
|||
|
|
@ -12,7 +12,12 @@
|
|||
[app.common.pprint :as pp]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[expound.alpha :as expound]))
|
||||
[expound.alpha :as expound])
|
||||
#?(:clj
|
||||
(:import
|
||||
clojure.lang.IPersistentMap)))
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(defmacro error
|
||||
[& {:keys [type hint] :as params}]
|
||||
|
|
@ -41,44 +46,22 @@
|
|||
[& 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))
|
||||
(instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
|
||||
|
||||
(defn error?
|
||||
[v]
|
||||
(instance? #?(:clj clojure.lang.IExceptionInfo :cljs cljs.core.ExceptionInfo) v))
|
||||
|
||||
(defn exception?
|
||||
[v]
|
||||
(instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
|
||||
|
||||
#?(:cljs
|
||||
(deftype WrappedException [cause meta]
|
||||
cljs.core/IMeta
|
||||
(-meta [_] meta)
|
||||
|
||||
cljs.core/IDeref
|
||||
(-deref [_] cause))
|
||||
:clj
|
||||
(deftype WrappedException [cause meta]
|
||||
clojure.lang.IMeta
|
||||
(meta [_] meta)
|
||||
|
||||
clojure.lang.IDeref
|
||||
(deref [_] cause)))
|
||||
|
||||
#?(:clj (ns-unmap 'app.common.exceptions '->WrappedException))
|
||||
#?(:clj (ns-unmap 'app.common.exceptions 'map->WrappedException))
|
||||
|
||||
(defn wrapped?
|
||||
[o]
|
||||
(instance? WrappedException o))
|
||||
|
||||
(defn wrap-with-context
|
||||
[cause context]
|
||||
(WrappedException. cause context))
|
||||
#?(:clj
|
||||
(defn runtime-exception?
|
||||
[v]
|
||||
(instance? RuntimeException v)))
|
||||
|
||||
(defn explain
|
||||
([data] (explain data nil))
|
||||
|
|
@ -97,15 +80,17 @@
|
|||
(s/explain-out (update data ::s/problems #(take max-problems %))))))))
|
||||
|
||||
#?(:clj
|
||||
(defn print-throwable
|
||||
[^Throwable cause
|
||||
& {:keys [trace? data? chain? data-level data-length trace-length explain-length]
|
||||
:or {trace? true
|
||||
data? true
|
||||
chain? true
|
||||
explain-length 10
|
||||
data-length 10
|
||||
data-level 3}}]
|
||||
(defn format-throwable
|
||||
[^Throwable cause & {:keys [summary? detail? header? data? explain? chain? data-level data-length trace-length]
|
||||
:or {summary? true
|
||||
detail? true
|
||||
header? true
|
||||
data? true
|
||||
explain? true
|
||||
chain? true
|
||||
data-length 10
|
||||
data-level 3}}]
|
||||
|
||||
(letfn [(print-trace-element [^StackTraceElement e]
|
||||
(let [class (.getClassName e)
|
||||
method (.getMethodName e)]
|
||||
|
|
@ -132,28 +117,29 @@
|
|||
(doseq [line lines]
|
||||
(println " " line)))))
|
||||
|
||||
(print-trace-title [cause]
|
||||
(print-trace-title [^Throwable cause]
|
||||
(print " → ")
|
||||
(printf "%s: %s" (.getName (class cause)) (first (str/lines (ex-message cause))))
|
||||
|
||||
(when-let [e (first (.getStackTrace cause))]
|
||||
(when-let [^StackTraceElement e (first (.getStackTrace ^Throwable cause))]
|
||||
(printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
|
||||
|
||||
(newline))
|
||||
|
||||
(print-summary [cause]
|
||||
(let [causes (loop [cause (.getCause cause)
|
||||
(print-summary [^Throwable cause]
|
||||
(let [causes (loop [cause (ex-cause cause)
|
||||
result []]
|
||||
(if cause
|
||||
(recur (.getCause cause)
|
||||
(recur (ex-cause cause)
|
||||
(conj result cause))
|
||||
result))]
|
||||
(println "TRACE:")
|
||||
(when header?
|
||||
(println "SUMMARY:"))
|
||||
(print-trace-title cause)
|
||||
(doseq [cause causes]
|
||||
(print-trace-title cause))))
|
||||
|
||||
(print-trace [cause]
|
||||
(print-trace [^Throwable cause]
|
||||
(print-trace-title cause)
|
||||
(let [st (.getStackTrace cause)]
|
||||
(print " at: ")
|
||||
|
|
@ -167,35 +153,35 @@
|
|||
(print-trace-element e)
|
||||
(newline))))
|
||||
|
||||
(print-all [cause]
|
||||
(print-summary cause)
|
||||
(println "DETAIL:")
|
||||
(when trace?
|
||||
(print-trace cause))
|
||||
|
||||
(when data?
|
||||
(when-let [data (ex-data cause)]
|
||||
(print-detail [^Throwable cause]
|
||||
(print-trace cause)
|
||||
(when-let [data (ex-data cause)]
|
||||
(when data?
|
||||
(print-data (dissoc data ::s/problems ::s/spec ::s/value)))
|
||||
(when explain?
|
||||
(if-let [explain (explain data)]
|
||||
(print-explain explain)
|
||||
(print-data data))))
|
||||
(print-explain explain)))))
|
||||
|
||||
(when chain?
|
||||
(loop [cause cause]
|
||||
(when-let [cause (.getCause cause)]
|
||||
(newline)
|
||||
(print-trace cause)
|
||||
(print-all [^Throwable cause]
|
||||
(when summary?
|
||||
(print-summary cause))
|
||||
|
||||
(when data?
|
||||
(when-let [data (ex-data cause)]
|
||||
(if-let [explain (explain data)]
|
||||
(print-explain explain)
|
||||
(print-data data))))
|
||||
(when detail?
|
||||
(when header?
|
||||
(println "DETAIL:"))
|
||||
|
||||
(recur cause)))))
|
||||
(print-detail cause)
|
||||
(when chain?
|
||||
(loop [cause cause]
|
||||
(when-let [cause (ex-cause cause)]
|
||||
(newline)
|
||||
(print-detail cause)
|
||||
(recur cause))))))
|
||||
]
|
||||
(with-out-str
|
||||
(print-all cause)))))
|
||||
|
||||
(println
|
||||
(with-out-str
|
||||
(print-all cause))))))
|
||||
|
||||
|
||||
#?(:clj
|
||||
(defn print-throwable
|
||||
[cause & {:as opts}]
|
||||
(println (format-throwable cause opts))))
|
||||
|
|
|
|||
|
|
@ -5,375 +5,362 @@
|
|||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.common.logging
|
||||
"A lightweight and multiplaform (clj & cljs) asynchronous by default
|
||||
logging API.
|
||||
|
||||
On the CLJ side it backed by SLF4J API, so the user can route
|
||||
logging output to any implementation that SLF4J supports. And on the
|
||||
CLJS side, it is backed by printing logs using console.log.
|
||||
|
||||
Simple example of logging API:
|
||||
|
||||
(require '[funcool.tools.logging :as l])
|
||||
(l/info :hint \"hello funcool logging\"
|
||||
:tname (.getName (Thread/currentThread)))
|
||||
|
||||
The log records are ordered key-value pairs (instead of plain
|
||||
strings) and by default are formatted usin custom, human readable
|
||||
but also easy parseable format; but it can be extended externally
|
||||
to use JSON or whatever format user prefers.
|
||||
|
||||
The format can be set at compile time (externaly), passing a JVM
|
||||
property or closure compiler compile-time constant. Example:
|
||||
|
||||
-Dpenpot.logging.props-format=':default'
|
||||
|
||||
The exception formating is customizable in the same way as the props
|
||||
formatter.
|
||||
|
||||
All messages are evaluated lazily, in a different thread, only if
|
||||
the message can be logged (logger level is loggable). This means
|
||||
that you should take care of lazy values on loging props. For cases
|
||||
where you strictly need syncrhonous message evaluation, you can use
|
||||
the special `::sync?` prop.
|
||||
|
||||
The formatting of the message and the exception is handled on this
|
||||
library and it doesn't rely on the underlying implementation (aka
|
||||
SLF4J).
|
||||
"
|
||||
#?(:cljs (:require-macros [app.common.logging :as l]))
|
||||
(:require
|
||||
#?(:clj [clojure.edn :as edn]
|
||||
:cljs [cljs.reader :as edn])
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.spec :as us]
|
||||
[cuerdas.core :as str]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.spec.alpha :as s]
|
||||
[fipp.edn :as fpp]
|
||||
#?(:cljs [goog.log :as glog]))
|
||||
#?(:cljs (:require-macros [app.common.logging])
|
||||
:clj (:import
|
||||
org.apache.logging.log4j.Level
|
||||
org.apache.logging.log4j.LogManager
|
||||
org.apache.logging.log4j.Logger
|
||||
org.apache.logging.log4j.ThreadContext
|
||||
org.apache.logging.log4j.CloseableThreadContext
|
||||
org.apache.logging.log4j.spi.LoggerContext)))
|
||||
[cuerdas.core :as str]
|
||||
[promesa.exec :as px]
|
||||
[promesa.util :as pu])
|
||||
#?(:clj
|
||||
(:import
|
||||
org.slf4j.LoggerFactory
|
||||
org.slf4j.Logger)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; CLJ Specific
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(def ^:dynamic *context* nil)
|
||||
|
||||
#?(:clj (set! *warn-on-reflection* true))
|
||||
|
||||
(def ^:private reserved-props
|
||||
#{:level :cause ::logger ::async ::raw ::context})
|
||||
(defonce ^{:doc "A global log-record atom instance; stores last logged record."}
|
||||
log-record
|
||||
(atom nil))
|
||||
|
||||
(defn build-message-kv
|
||||
[props]
|
||||
(loop [pairs (remove (fn [[k]] (contains? reserved-props k)) props)
|
||||
result []]
|
||||
(if-let [[k v] (first pairs)]
|
||||
(recur (rest pairs)
|
||||
(conj result (str/concat (d/name k) "=" (pr-str v))))
|
||||
(str/join ", " result))))
|
||||
(defonce
|
||||
^{:doc "Default executor instance used for processing logs."
|
||||
:dynamic true}
|
||||
*default-executor*
|
||||
(delay
|
||||
#?(:clj (px/single-executor :factory (px/thread-factory :name "penpot/logger"))
|
||||
:cljs (px/microtask-executor))))
|
||||
|
||||
(defn build-message-cause
|
||||
[props]
|
||||
#?(:clj (when-let [[_ cause] (d/seek (fn [[k]] (= k :cause)) props)]
|
||||
(when cause
|
||||
(with-out-str
|
||||
(ex/print-throwable cause))))
|
||||
:cljs nil))
|
||||
#?(:cljs
|
||||
(defonce loggers (js/Map.)))
|
||||
|
||||
#?(:cljs
|
||||
(declare level->int))
|
||||
|
||||
#?(:cljs
|
||||
(defn- get-parent-logger
|
||||
[^string logger]
|
||||
(let [lindex (.lastIndexOf logger ".")]
|
||||
(.slice logger 0 (max lindex 0)))))
|
||||
|
||||
#?(:cljs
|
||||
(defn- get-logger-level
|
||||
"Get the current level set for the specified logger. Returns int."
|
||||
[^string logger]
|
||||
(let [val (.get ^js/Map loggers logger)]
|
||||
(if (pos? val)
|
||||
val
|
||||
(loop [logger' (get-parent-logger logger)]
|
||||
(let [val (.get ^js/Map loggers logger')]
|
||||
(if (some? val)
|
||||
(do
|
||||
(.set ^js/Map loggers logger val)
|
||||
val)
|
||||
(if (= "" logger')
|
||||
(do
|
||||
(.set ^js/Map loggers logger 100)
|
||||
100)
|
||||
(recur (get-parent-logger logger'))))))))))
|
||||
|
||||
(defn enabled?
|
||||
"Check if logger has enabled logging for given level."
|
||||
[logger level]
|
||||
#?(:clj
|
||||
(let [logger (LoggerFactory/getLogger ^String logger)]
|
||||
(case level
|
||||
:trace (and (.isTraceEnabled ^Logger logger) logger)
|
||||
:debug (and (.isDebugEnabled ^Logger logger) logger)
|
||||
:info (and (.isInfoEnabled ^Logger logger) logger)
|
||||
:warn (and (.isWarnEnabled ^Logger logger) logger)
|
||||
:error (and (.isErrorEnabled ^Logger logger) logger)
|
||||
:fatal (and (.isErrorEnabled ^Logger logger) logger)
|
||||
(throw (IllegalArgumentException. (str "invalid level:" level)))))
|
||||
:cljs
|
||||
(>= (level->int level)
|
||||
(get-logger-level logger))))
|
||||
|
||||
(defn- level->color
|
||||
[level]
|
||||
(case level
|
||||
:error "#c82829"
|
||||
:warn "#f5871f"
|
||||
:info "#4271ae"
|
||||
:debug "#969896"
|
||||
:trace "#8e908c"))
|
||||
|
||||
(defn- level->name
|
||||
[level]
|
||||
(case level
|
||||
:debug "DBG"
|
||||
:trace "TRC"
|
||||
:info "INF"
|
||||
:warn "WRN"
|
||||
:error "ERR"))
|
||||
|
||||
(defn level->int
|
||||
[level]
|
||||
(case level
|
||||
:debug 10
|
||||
:trace 20
|
||||
:info 30
|
||||
:warn 40
|
||||
:error 50))
|
||||
|
||||
(defn build-message
|
||||
[props]
|
||||
(let [props (sequence (comp (partition-all 2) (map vec)) props)
|
||||
message-kv (build-message-kv props)
|
||||
message-ex (build-message-cause props)]
|
||||
(cond-> message-kv
|
||||
(some? message-ex)
|
||||
(str "\n" message-ex))))
|
||||
(loop [props (seq props)
|
||||
result []]
|
||||
(if-let [[k v] (first props)]
|
||||
(if (simple-ident? k)
|
||||
(recur (next props)
|
||||
(conj result (str (name k) "=" (pr-str v))))
|
||||
(recur (next props)
|
||||
result))
|
||||
(str/join ", " result))))
|
||||
|
||||
#?(:clj
|
||||
(def logger-context
|
||||
(LogManager/getContext false)))
|
||||
(defn build-stack-trace
|
||||
[cause]
|
||||
#?(:clj (ex/format-throwable cause)
|
||||
:cljs (.-stack ^js cause)))
|
||||
|
||||
#?(:clj
|
||||
(def logging-agent
|
||||
(agent nil :error-mode :continue)))
|
||||
#?(:cljs
|
||||
(defn- get-special-props
|
||||
[props]
|
||||
(->> (seq props)
|
||||
(keep (fn [[k v]]
|
||||
(when (qualified-ident? k)
|
||||
(cond
|
||||
(= "js" (namespace k))
|
||||
[:js (name k) (if (object? v) v (clj->js v))]
|
||||
|
||||
#?(:clj
|
||||
(defn stringify-data
|
||||
[val]
|
||||
(cond
|
||||
(string? val)
|
||||
val
|
||||
(= "error" (namespace k))
|
||||
[:error (name k) v])))))))
|
||||
|
||||
(instance? clojure.lang.Named val)
|
||||
(name val)
|
||||
(def ^:private reserved-props
|
||||
#{::level :cause ::logger ::sync? ::context})
|
||||
|
||||
(coll? val)
|
||||
(binding [*print-level* 8
|
||||
*print-length* 25]
|
||||
(with-out-str (fpp/pprint val {:width 200})))
|
||||
(def ^:no-doc msg-props-xf
|
||||
(comp (partition-all 2)
|
||||
(map vec)
|
||||
(remove (fn [[k _]] (contains? reserved-props k)))))
|
||||
|
||||
:else
|
||||
(str val))))
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::props any? #_d/ordered-map?)
|
||||
(s/def ::context (s/nilable (s/map-of keyword? any?)))
|
||||
(s/def ::level #{:trace :debug :info :warn :error :fatal})
|
||||
(s/def ::logger string?)
|
||||
(s/def ::timestamp ::us/integer)
|
||||
(s/def ::cause (s/nilable ex/exception?))
|
||||
(s/def ::message delay?)
|
||||
(s/def ::record
|
||||
(s/keys :req [::id ::props ::logger ::level]
|
||||
:opt [::cause ::context]))
|
||||
|
||||
#?(:clj
|
||||
(defn data->context-map
|
||||
^java.util.Map
|
||||
[data]
|
||||
(into {}
|
||||
(comp (filter second)
|
||||
(map (fn [[key val]]
|
||||
[(stringify-data key)
|
||||
(stringify-data val)])))
|
||||
data)))
|
||||
(defn current-timestamp
|
||||
[]
|
||||
#?(:clj (inst-ms (java.time.Instant/now))
|
||||
:cljs (js/Date.now)))
|
||||
|
||||
#?(:clj
|
||||
(defmacro with-context
|
||||
[data & body]
|
||||
`(let [data# (data->context-map ~data)]
|
||||
(with-open [closeable# (CloseableThreadContext/putAll data#)]
|
||||
~@body))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Common
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn get-logger
|
||||
[lname]
|
||||
#?(:clj (.getLogger ^LoggerContext logger-context ^String lname)
|
||||
:cljs (glog/getLogger
|
||||
(cond
|
||||
(string? lname) lname
|
||||
(= lname :root) ""
|
||||
(simple-ident? lname) (name lname)
|
||||
(qualified-ident? lname) (str (namespace lname) "." (name lname))
|
||||
:else (str lname)))))
|
||||
|
||||
(defn get-level
|
||||
[level]
|
||||
#?(:clj
|
||||
(case level
|
||||
:trace Level/TRACE
|
||||
:debug Level/DEBUG
|
||||
:info Level/INFO
|
||||
:warn Level/WARN
|
||||
:error Level/ERROR
|
||||
:fatal Level/FATAL)
|
||||
:cljs
|
||||
(case level
|
||||
:off (.-OFF ^js glog/Level)
|
||||
:shout (.-SHOUT ^js glog/Level)
|
||||
:error (.-SEVERE ^js glog/Level)
|
||||
:severe (.-SEVERE ^js glog/Level)
|
||||
:warning (.-WARNING ^js glog/Level)
|
||||
:warn (.-WARNING ^js glog/Level)
|
||||
:info (.-INFO ^js glog/Level)
|
||||
:config (.-CONFIG ^js glog/Level)
|
||||
:debug (.-FINE ^js glog/Level)
|
||||
:fine (.-FINE ^js glog/Level)
|
||||
:finer (.-FINER ^js glog/Level)
|
||||
:trace (.-FINER ^js glog/Level)
|
||||
:finest (.-FINEST ^js glog/Level)
|
||||
:all (.-ALL ^js glog/Level))))
|
||||
|
||||
(defn write-log!
|
||||
[logger level exception message]
|
||||
#?(:clj
|
||||
(let [message (if (string? message) message (str/join ", " message))]
|
||||
(if exception
|
||||
(.log ^Logger logger
|
||||
^Level level
|
||||
^Object message
|
||||
^Throwable exception)
|
||||
(.log ^Logger logger
|
||||
^Level level
|
||||
^Object message)))
|
||||
:cljs
|
||||
(when glog/ENABLED
|
||||
(let [logger (get-logger logger)
|
||||
level (get-level level)]
|
||||
(when (and logger (glog/isLoggable logger level))
|
||||
(let [message (if (fn? message) (message) message)
|
||||
message (if (string? message) message (str/join ", " message))
|
||||
record (glog/LogRecord. level message (.getName ^js logger))]
|
||||
(when exception (.setException record exception))
|
||||
(glog/publishLogRecord logger record)))))))
|
||||
|
||||
#?(:clj
|
||||
(defn enabled?
|
||||
[logger level]
|
||||
(.isEnabled ^Logger logger ^Level level)))
|
||||
|
||||
#?(:clj
|
||||
(defn get-error-context
|
||||
[error]
|
||||
(merge
|
||||
{:hint (ex-message error)}
|
||||
(when-let [data (ex-data error)]
|
||||
(merge
|
||||
{:spec-problems (some->> data ::s/problems (take 10) seq vec)
|
||||
:spec-value (some->> data ::s/value)
|
||||
:data (some-> data (dissoc ::s/problems ::s/value ::s/spec))}
|
||||
(when-let [explain (ex/explain data)]
|
||||
{:spec-explain explain}))))))
|
||||
|
||||
(defmacro log
|
||||
(defmacro log!
|
||||
"Emit a new log record to the global log-record state (asynchronously). "
|
||||
[& props]
|
||||
(if (:ns &env) ; CLJS
|
||||
(let [{:keys [level cause ::logger ::raw]} props]
|
||||
`(write-log! ~(or logger (str *ns*)) ~level ~cause (or ~raw (fn [] (build-message ~(vec props))))))
|
||||
(let [{:keys [::level ::logger ::context ::sync? cause] :or {sync? false}} props
|
||||
props (into [] msg-props-xf props)]
|
||||
`(when (enabled? ~logger ~level)
|
||||
(let [props# (cond-> (delay ~props) ~sync? deref)
|
||||
ts# (current-timestamp)
|
||||
context# *context*]
|
||||
(px/run! *default-executor*
|
||||
(fn []
|
||||
(let [props# (if ~sync? props# (deref props#))
|
||||
props# (into (d/ordered-map) props#)
|
||||
cause# ~cause
|
||||
context# (d/without-nils
|
||||
(merge context# ~context))
|
||||
lrecord# {::id (uuid/next)
|
||||
::timestamp ts#
|
||||
::message (delay (build-message props#))
|
||||
::props props#
|
||||
::context context#
|
||||
::level ~level
|
||||
::logger ~logger}
|
||||
lrecord# (cond-> lrecord#
|
||||
(some? cause#)
|
||||
(assoc ::cause cause#
|
||||
::trace (delay (build-stack-trace cause#))))]
|
||||
(swap! log-record (constantly lrecord#)))))))))
|
||||
|
||||
(let [{:keys [level cause ::logger ::async ::raw ::context] :or {async true}} props
|
||||
logger (or logger (str *ns*))
|
||||
logger-sym (gensym "log")
|
||||
level-sym (gensym "log")]
|
||||
`(let [~logger-sym (get-logger ~logger)
|
||||
~level-sym (get-level ~level)]
|
||||
(when (enabled? ~logger-sym ~level-sym)
|
||||
~(if async
|
||||
`(do
|
||||
(send-off logging-agent
|
||||
(fn [_#]
|
||||
(let [message# (or ~raw (build-message ~(vec props)))]
|
||||
(with-context (-> {:id (uuid/next)}
|
||||
(into ~context)
|
||||
(into (get-error-context ~cause)))
|
||||
(try
|
||||
(write-log! ~logger-sym ~level-sym ~cause message#)
|
||||
(catch Throwable cause#
|
||||
(write-log! ~logger-sym (get-level :error) cause#
|
||||
"unexpected error on writing log")))))))
|
||||
nil)
|
||||
`(let [message# (or ~raw (build-message ~(vec props)))]
|
||||
(write-log! ~logger-sym ~level-sym ~cause message#)
|
||||
nil)))))))
|
||||
#?(:clj
|
||||
(defn slf4j-log-handler
|
||||
{:no-doc true}
|
||||
[_ _ _ {:keys [::logger ::level ::props ::cause ::trace ::message]}]
|
||||
(when-let [logger (enabled? logger level)]
|
||||
(let [message (cond-> @message
|
||||
(some? trace)
|
||||
(str "\n" @trace))]
|
||||
(case level
|
||||
:trace (.trace ^Logger logger ^String message ^Throwable cause)
|
||||
:debug (.debug ^Logger logger ^String message ^Throwable cause)
|
||||
:info (.info ^Logger logger ^String message ^Throwable cause)
|
||||
:warn (.warn ^Logger logger ^String message ^Throwable cause)
|
||||
:error (.error ^Logger logger ^String message ^Throwable cause)
|
||||
:fatal (.error ^Logger logger ^String message ^Throwable cause)
|
||||
(throw (IllegalArgumentException. (str "invalid level:" level))))))))
|
||||
|
||||
#?(:cljs
|
||||
(defn console-log-handler
|
||||
{:no-doc true}
|
||||
[_ _ _ {:keys [::logger ::props ::level ::cause ::trace ::message]}]
|
||||
(when (enabled? logger level)
|
||||
(let [hstyles (str/ffmt "font-weight: 600; color: %" (level->color level))
|
||||
mstyles (str/ffmt "font-weight: 300; color: %" "#282a2e")
|
||||
header (str/concat "%c" (level->name level) " [" logger "] ")
|
||||
message (str/concat header "%c" @message)]
|
||||
|
||||
(js/console.group message hstyles mstyles)
|
||||
(doseq [[type n v] (get-special-props props)]
|
||||
(case type
|
||||
:js (js/console.log n v)
|
||||
:error (if (ex/error? v)
|
||||
(js/console.error n (pr-str v))
|
||||
(js/console.error n v))))
|
||||
|
||||
(when cause
|
||||
(let [data (ex-data cause)
|
||||
explain (ex/explain data)]
|
||||
(when explain
|
||||
(js/console.log "Explain:")
|
||||
(js/console.log explain))
|
||||
|
||||
(when (and data (not explain))
|
||||
(js/console.log "Data:")
|
||||
(js/console.log (pp/pprint-str data)))
|
||||
|
||||
(js/console.log @trace #_(.-stack cause))))
|
||||
|
||||
(js/console.groupEnd message)))))
|
||||
|
||||
#?(:clj (add-watch log-record ::default slf4j-log-handler)
|
||||
:cljs (add-watch log-record ::default console-log-handler))
|
||||
|
||||
(defmacro set-level!
|
||||
"A CLJS-only macro for set logging level to current (that matches the
|
||||
current namespace) or user specified logger."
|
||||
([level]
|
||||
(when (:ns &env)
|
||||
`(.set ^js/Map loggers ~(str *ns*) (level->int ~level))))
|
||||
([name level]
|
||||
(when (:ns &env)
|
||||
`(.set ^js/Map loggers ~name (level->int ~level)))))
|
||||
|
||||
#?(:cljs
|
||||
(defn setup!
|
||||
[{:as config}]
|
||||
(run! (fn [[logger level]]
|
||||
(let [logger (if (keyword? logger) (name logger) logger)]
|
||||
(l/set-level! logger level)))
|
||||
config)))
|
||||
|
||||
(defmacro info
|
||||
[& params]
|
||||
`(log :level :info ~@params))
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :info ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro inf
|
||||
[& params]
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :info ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro error
|
||||
[& params]
|
||||
`(log :level :error ~@params))
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :error ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro err
|
||||
[& params]
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :error ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro warn
|
||||
[& params]
|
||||
`(log :level :warn ~@params))
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :warn ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro wrn
|
||||
[& params]
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :warn ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro debug
|
||||
[& params]
|
||||
`(log :level :debug ~@params))
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :debug ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro dbg
|
||||
[& params]
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :debug ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro trace
|
||||
[& params]
|
||||
`(log :level :trace ~@params))
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :trace ~@params)
|
||||
nil))
|
||||
|
||||
(defmacro set-level!
|
||||
([level]
|
||||
(when (:ns &env)
|
||||
`(set-level* ~(str *ns*) ~level)))
|
||||
([n level]
|
||||
(when (:ns &env)
|
||||
`(set-level* ~n ~level))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; CLJS Specific
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#?(:cljs
|
||||
(def ^:private colors
|
||||
{:gray3 "#8e908c"
|
||||
:gray4 "#969896"
|
||||
:gray5 "#4d4d4c"
|
||||
:gray6 "#282a2e"
|
||||
:black "#1d1f21"
|
||||
:red "#c82829"
|
||||
:blue "#4271ae"
|
||||
:orange "#f5871f"}))
|
||||
|
||||
#?(:cljs
|
||||
(defn- level->color
|
||||
[level]
|
||||
(letfn [(get-level-value [l] (.-value ^js (get-level l)))]
|
||||
(condp <= (get-level-value level)
|
||||
(get-level-value :error) (get colors :red)
|
||||
(get-level-value :warn) (get colors :orange)
|
||||
(get-level-value :info) (get colors :blue)
|
||||
(get-level-value :debug) (get colors :gray4)
|
||||
(get-level-value :trace) (get colors :gray3)
|
||||
(get colors :gray2)))))
|
||||
|
||||
#?(:cljs
|
||||
(defn- level->short-name
|
||||
[l]
|
||||
(case l
|
||||
:fine "DBG"
|
||||
:debug "DBG"
|
||||
:finer "TRC"
|
||||
:trace "TRC"
|
||||
:info "INF"
|
||||
:warn "WRN"
|
||||
:warning "WRN"
|
||||
:error "ERR"
|
||||
(subs (.-name ^js (get-level l)) 0 3))))
|
||||
|
||||
#?(:cljs
|
||||
(defn set-level*
|
||||
"Set the level (a keyword) of the given logger, identified by name."
|
||||
[name lvl]
|
||||
(some-> (get-logger name)
|
||||
(glog/setLevel (get-level lvl)))))
|
||||
|
||||
#?(:cljs
|
||||
(defn set-levels!
|
||||
[lvls]
|
||||
(doseq [[logger level] lvls
|
||||
:let [level (if (string? level) (keyword level) level)]]
|
||||
(set-level* logger level))))
|
||||
|
||||
#?(:cljs
|
||||
(defn- prepare-message
|
||||
[message]
|
||||
(loop [kvpairs (seq message)
|
||||
message []
|
||||
specials []]
|
||||
(if (nil? kvpairs)
|
||||
[message specials]
|
||||
(let [[k v] (first kvpairs)]
|
||||
(cond
|
||||
(= k :err)
|
||||
(recur (next kvpairs)
|
||||
message
|
||||
(conj specials [:error nil v]))
|
||||
|
||||
(and (qualified-ident? k)
|
||||
(= "js" (namespace k)))
|
||||
(recur (next kvpairs)
|
||||
message
|
||||
(conj specials [:js (name k) (if (object? v) v (clj->js v))]))
|
||||
|
||||
:else
|
||||
(recur (next kvpairs)
|
||||
(conj message (str/concat (d/name k) "=" (pr-str v)))
|
||||
specials)))))))
|
||||
|
||||
#?(:cljs
|
||||
(defn default-handler
|
||||
[{:keys [message level logger-name exception] :as params}]
|
||||
(let [header-styles (str "font-weight: 600; color: " (level->color level))
|
||||
normal-styles (str "font-weight: 300; color: " (get colors :gray6))
|
||||
level-name (level->short-name level)
|
||||
header (str "%c" level-name " [" logger-name "] ")]
|
||||
|
||||
(if (string? message)
|
||||
(let [message (str header "%c" message)]
|
||||
(js/console.log message header-styles normal-styles))
|
||||
(let [[message specials] (prepare-message message)]
|
||||
(if (seq specials)
|
||||
(let [message (str header "%c" message)]
|
||||
(js/console.group message header-styles normal-styles)
|
||||
(doseq [[type n v] specials]
|
||||
(case type
|
||||
:js (js/console.log n v)
|
||||
:error (if (ex/ex-info? v)
|
||||
(js/console.error (pr-str v))
|
||||
(js/console.error v))))
|
||||
(js/console.groupEnd message))
|
||||
(let [message (str header "%c" message)]
|
||||
(js/console.log message header-styles normal-styles)))))
|
||||
|
||||
(when exception
|
||||
(when-let [data (ex-data exception)]
|
||||
(js/console.error "cause data:" (pr-str data)))
|
||||
(js/console.error (.-stack exception))))))
|
||||
|
||||
|
||||
#?(:cljs
|
||||
(defn record->map
|
||||
[^js record]
|
||||
{:seqn (.-sequenceNumber_ record)
|
||||
:time (.-time_ record)
|
||||
:level (keyword (str/lower (.-name (.-level_ record))))
|
||||
:message (.-msg_ record)
|
||||
:logger-name (.-loggerName_ record)
|
||||
:exception (.-exception_ record)}))
|
||||
|
||||
#?(:cljs
|
||||
(defonce default-console-handler
|
||||
(comp default-handler record->map)))
|
||||
|
||||
#?(:cljs
|
||||
(defn initialize!
|
||||
[]
|
||||
(let [l (get-logger :root)]
|
||||
(glog/removeHandler l default-console-handler)
|
||||
(glog/addHandler l default-console-handler)
|
||||
nil)))
|
||||
(defmacro trc
|
||||
[& params]
|
||||
`(do
|
||||
(log! ::logger ~(str *ns*) ::level :trace ~@params)
|
||||
nil))
|
||||
|
|
|
|||
|
|
@ -435,6 +435,6 @@
|
|||
[cause]
|
||||
(if (and (map? cause) (= :spec-validation (:type cause)))
|
||||
cause
|
||||
(when (ex/ex-info? cause)
|
||||
(when (ex/error? cause)
|
||||
(validation-error? (ex-data cause)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -30,9 +30,7 @@
|
|||
[potok.core :as ptk]
|
||||
[rumext.v2 :as mf]))
|
||||
|
||||
(log/initialize!)
|
||||
(log/set-level! :root :warn)
|
||||
(log/set-level! :app :info)
|
||||
(log/setup! {:app :info})
|
||||
|
||||
(when (= :browser @cf/target)
|
||||
(log/info :message "Welcome to penpot"
|
||||
|
|
|
|||
|
|
@ -29,9 +29,7 @@
|
|||
;; SETUP
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(l/initialize!)
|
||||
(l/set-level! :root :warn)
|
||||
(l/set-level! :app :info)
|
||||
(l/setup! {:app :info})
|
||||
|
||||
(declare ^:private render-single-object)
|
||||
(declare ^:private render-components)
|
||||
|
|
|
|||
|
|
@ -19,9 +19,7 @@
|
|||
[cljs.spec.alpha :as s]
|
||||
[promesa.core :as p]))
|
||||
|
||||
(log/initialize!)
|
||||
(log/set-level! :root :warn)
|
||||
(log/set-level! :app :info)
|
||||
(log/setup! {:app :info})
|
||||
|
||||
;; --- Messages Handling
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue