-
Notifications
You must be signed in to change notification settings - Fork 11
/
core.clj
206 lines (186 loc) · 9.35 KB
/
core.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
(ns timbre-json-appender.core
(:require [jsonista.core :as json]
[taoensso.timbre :as timbre])
(:import (com.fasterxml.jackson.databind SerializationFeature)
(clojure.lang ExceptionInfo)))
(set! *warn-on-reflection* true)
(defn object-mapper [opts]
(doto (json/object-mapper opts)
(.configure SerializationFeature/FAIL_ON_EMPTY_BEANS false)))
(defn count-format-specifiers [^String format-string]
(let [len (.length format-string)]
(loop [placeholders 0
idx 0]
(if (>= idx len)
placeholders
(let [placeholders (if (= \% (.charAt format-string idx))
(if (and (not (zero? idx))
(= \% (.charAt format-string (dec idx))))
(dec placeholders)
(inc placeholders))
placeholders)]
(recur placeholders (inc idx)))))))
(defn collect-vargs [vargs]
(cond
;; if only two vargs are provided with types [string, map], take the map as args
(and (= 2 (count vargs))
(string? (first vargs))
(map? (second vargs))) {:message (first vargs)
:args (second vargs)}
;; if only a map is provided, take it as args
(and (= 1 (count vargs))
(map? (first vargs))) {:message nil
:args (first vargs)}
;; assume a message precedes keyword-style args
(odd? (count vargs)) {:message (first vargs)
:args (apply hash-map (rest vargs))}
;; else take the vargs as keyword-style args
:else {:message nil
:args (apply hash-map vargs)}))
(defn- merge-log-map [inline-args? log-map args]
(if inline-args?
(merge log-map args)
(update log-map :args merge args)))
(defn handle-vargs
"Handles varg parsing, adding the msg and the given context to the given log map.
If inline-args is true, then the remaining vargs are added to :args,
otherwise they're inlined into the log-map."
[log-map ?msg-fmt vargs inline-args? msg-key]
(cond
?msg-fmt (let [format-specifiers (count-format-specifiers ?msg-fmt)
log-map (assoc log-map msg-key (String/format ?msg-fmt (to-array (take format-specifiers vargs))))]
(merge-log-map inline-args? log-map (apply hash-map (seq (drop format-specifiers vargs)))))
:else (let [{:keys [message args]} (collect-vargs vargs)
log-map (if message
(assoc log-map msg-key message)
log-map)]
(merge-log-map inline-args? log-map args))))
(defn default-should-log-field-fn
"Default function to determine whether to log fields.
Logs all fields except :file :line and :ns which are only logged on error."
[field-name {:keys [?err] :as _data}]
(if (contains? #{:file :line :ns} field-name)
?err
true))
(defn default-ex-data-field-fn
"Default function to pre-process fields in ex-info data map. This default implementation simply passes the
field value through. A common use case might be to strip non-Serializable values from the ex-info data map.
While exceptions with non-Serializable fields won't prevent logging, they will prevent successful
JSON parsing and will use the fallback logger.
An `:ex-data-field-fn` of
```
(fn [f] (when (instance? java.io.Serializable f) f))
```
would replace the non-Serializable values with nils."
[f]
f)
(def system-newline (System/getProperty "line.separator"))
;; Taken from timbre: https://github.com/ptaoussanis/timbre/commit/057b5a4c871752957e50c3eaf667c0517d56ca9a
(defn- atomic-println
"println that prints the string and a newline atomically"
[x]
(print (str x system-newline)) (flush))
(defn- process-ex-data-map [ex-data-field-fn ex]
(if (and ex (instance? ExceptionInfo ex))
(let [cause (process-ex-data-map ex-data-field-fn (ex-cause ex))]
(ex-info (ex-message ex)
(into {} (map (fn [[k v]] {k (ex-data-field-fn v)}) (ex-data ex)))
cause))
ex))
(defn json-appender
"Creates Timbre configuration map for JSON appender"
([]
(json-appender {}))
([{:keys [pretty inline-args? level-key msg-key should-log-field-fn ex-data-field-fn]
:or {pretty false
inline-args? false
level-key :level
msg-key :msg
should-log-field-fn default-should-log-field-fn
ex-data-field-fn default-ex-data-field-fn}}]
(let [object-mapper (object-mapper {:pretty pretty})
println-appender (taoensso.timbre/println-appender)
fallback-logger (:fn println-appender)
data-field-processor (partial process-ex-data-map ex-data-field-fn)]
{:enabled? true
:async? false
:min-level nil
:fn (fn [{:keys [level ?ns-str ?file ?line ?err vargs ?msg-fmt hostname_ context timestamp_] :as data}]
(let [;; apply context prior to resolving vargs so specific log values override context values
?err (data-field-processor ?err)
base-log-map (cond
(and (not inline-args?) (seq context)) {:args context}
(and inline-args? (seq context)) context
:else {})
log-map (-> (handle-vargs base-log-map
?msg-fmt
vargs
inline-args?
msg-key)
;; apply base fields last to ensure they have precedent over context and vargs
(assoc :timestamp (force timestamp_))
(assoc level-key level)
(cond->
(should-log-field-fn :thread data) (assoc :thread (.getName (Thread/currentThread)))
(should-log-field-fn :file data) (assoc :file ?file)
(should-log-field-fn :line data) (assoc :line ?line)
(should-log-field-fn :ns data) (assoc :ns ?ns-str)
(should-log-field-fn :hostname data) (assoc :hostname (force hostname_))
?err (assoc :err (Throwable->map ?err))))]
(try
(atomic-println (json/write-value-as-string log-map object-mapper))
(catch Throwable _
(fallback-logger data)))))})))
(defn install
"Installs json-appender as the sole appender for Timbre, options
`level`: Timbre log level (deprecated, prefer min-level)
`min-level`: Timbre log level
`level-key`: The key to use for log-level
`msg-key`: The key to use for the message (default :msg)
`pretty`: Pretty-print JSON
`inline-args?`: Place arguments on top level, instead of placing behind `args` field
`should-log-field-fn`: A function which determines whether to log the given top-level field. Defaults to `default-should-log-field-fn`
`ex-data-field-fn`: A function which pre-processes fields in the ex-info data map. Useful when ex-info data map includes non-Serializable values. Defaults to `default-ex-data-field-fn`"
([]
(install :info))
([{:keys [level min-level pretty inline-args? level-key msg-key should-log-field-fn ex-data-field-fn]
:or {level-key :level
pretty false
inline-args? true
msg-key :msg
should-log-field-fn default-should-log-field-fn
ex-data-field-fn default-ex-data-field-fn}}]
(timbre/set-config! {:min-level (or min-level level :info)
:appenders {:json (json-appender {:pretty pretty
:inline-args? inline-args?
:level-key level-key
:msg-key msg-key
:should-log-field-fn should-log-field-fn
:ex-data-field-fn ex-data-field-fn})}
:timestamp-opts {:pattern "yyyy-MM-dd'T'HH:mm:ssX"}})))
(defn log-success [request-method uri status]
(timbre/info :method request-method :uri uri :status status))
(defn log-failure [t request-method uri]
(timbre/error t "Failed to handle request" :method request-method :uri uri))
(defn wrap-json-logging
"Ring middleware for JSON logging. Logs :method, :uri and :status for successful handler invocations,
:method and :uri for failed invocations."
[handler]
(fn
([{:keys [request-method uri] :as request}]
(try
(let [{:keys [status] :as response} (handler request)]
(log-success request-method uri status)
response)
(catch Throwable t
(log-failure t request-method uri)
{:status 500
:body "Server error"})))
([{:keys [request-method uri] :as request} respond raise]
(handler request
(fn [{:keys [status] :as response}]
(log-success request-method uri status)
(respond response))
(fn [t]
(log-failure t request-method uri)
(raise t))))))