-
Notifications
You must be signed in to change notification settings - Fork 4
/
api.cljc
361 lines (317 loc) · 12.2 KB
/
api.cljc
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
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
(ns fress.api
#?(:clj (:refer-clojure :exclude (read)))
#?(:cljs
(:require [fress.reader :as r]
[fress.writer :as w]
[fress.impl.buffer :as buf])
:clj
(:require [clojure.data.fressian :as fressian]
[fress.impl.bytestream]))
#?(:clj (:import [org.fressian.handlers WriteHandler ReadHandler]
[org.fressian FressianWriter StreamingWriter FressianReader TaggedObject Writer Reader]
[org.fressian.impl RawOutput RawInput BytesOutputStream]
java.nio.ByteBuffer
[fress.impl bytestream]
[java.io InputStream OutputStream EOFException])))
(set! *warn-on-reflection* true)
#?(:clj
(defn private-field [^Object obj name-string]
(let [m (. (.getClass obj)(getDeclaredField name-string))]
(. m (setAccessible true))
(. m (get obj)))))
#?(:clj
(defn- w->raw [wrt] (private-field wrt "rawOut")))
#?(:clj
(defn- rdr->raw [rdr] (private-field rdr "is")))
#?(:clj
(deftype utf8 [^String s]))
#?(:clj
(defn utf8? [o] (instance? utf8 o)))
(def ^:dynamic *write-utf8-tag* false)
#?(:clj
(defn fn->write-handler [f]
(if (instance? org.fressian.handlers.WriteHandler f)
f
(reify WriteHandler
(write [_ writer obj]
(try
(f ^Writer writer obj)
(catch clojure.lang.ArityException e
(throw (Exception. "fressian write-handlers need to be fn<writer,obj>")))))))))
#?(:clj
(defn fn->read-handler [f]
(if (instance? org.fressian.handlers.ReadHandler f)
f
(reify ReadHandler
(read [_ rdr tag field-count]
(try
(f ^Reader rdr ^String tag field-count)
(catch clojure.lang.ArityException e
(throw (Exception. "fressian read-handlers need to be fn<reader,tag,field-count>")))))))))
#?(:clj
(defn utf8-writer [w u]
(let [s (.-s ^utf8 u)
bytes (.getBytes ^String s "UTF-8")
raw-out (w->raw w)
length (count bytes)]
(if *write-utf8-tag* ;<= client can read either
(.writeTag ^FressianWriter w "utf8" 2)
(.writeCode ^FressianWriter w (int 191)))
(.writeCount ^FressianWriter w length)
;FIXME use writeBytes, code makes tagged-object compatible
(.writeRawBytes ^RawOutput raw-out bytes 0 length))))
#?(:clj
(defn utf8-reader
"cant modify fressian.impl.Codes so using code from client will fail
JVM readers must use \"utf8\" tag."
[^Reader rdr tag _]
(let [length (int (.readInt rdr))
offset (int 0)
bytes (byte-array length)
raw-in (rdr->raw rdr)]
(.readFully ^RawInput raw-in bytes offset length)
(String. bytes "UTF-8"))))
#?(:clj
(defn read-handlers
"merge in user handlers with default-handlers, wrap for fressian lookup"
([] (read-handlers nil))
([user-handlers]
(when user-handlers
(assert
(and (map? user-handlers)
(every? string? (keys user-handlers))
(every? fn? (vals user-handlers)))))
(let [user-handlers (merge {"utf8" utf8-reader} user-handlers)
handlers (into fressian/clojure-read-handlers
(map
(fn [[tag f]]
[tag (fn->read-handler f)]))
user-handlers)]
(fressian/associative-lookup handlers)))))
#?(:clj
(defn write-handlers
"merge in user handlers with default-handlers, wrap for fressian lookup"
([](write-handlers nil))
([user-handlers]
(let [user-handlers (merge {utf8 {"utf8" utf8-writer}} user-handlers)
handlers (into fressian/clojure-write-handlers
(map
(fn [[T m]]
(let [[k v] (first (seq m))]
[T {k (fn->write-handler v)}])))
user-handlers)]
(-> handlers
fressian/associative-lookup
fressian/inheritance-lookup)))))
#?(:clj
(extend-protocol fressian/FressianReadable
BytesOutputStream
(to-input-stream [stream]
(fressian/to-input-stream (ByteBuffer/wrap (.internalBuffer stream) 0 (.length stream))))))
(defn- ^boolean fressian-reader? [in]
#?(:clj (instance? org.fressian.FressianReader in)
:cljs (instance? r/FressianReader in)))
(defn- ^boolean fressian-writer? [in]
#?(:clj (instance? org.fressian.FressianWriter in)
:cljs (instance? w/FressianWriter in)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn create-reader
"Create a fressian reader targeting in.
- :handlers is just a map of tag->fn merged with default read handlers
- :checksum? {boolean} :: maintain a checksum for each byte read, validated
when footer received. throws when fails. If no footer, has no effect
- :name->map-ctor map of record names to map->Record constructors at runtime
{'string-name' map->some-record}
- cljs allows reading from :offset"
[^InputStream in & opts]
#?(:clj
(let [in (fressian/to-input-stream in)
{:keys [handlers checksum?]} (apply hash-map opts)
handlers (read-handlers handlers)]
(fressian/create-reader in :handlers handlers :checksum? checksum?))
:cljs
(apply r/reader in opts)))
(defn read-object
"Read a single object from a fressian reader."
[rdr]
(assert (fressian-reader? rdr))
#?(:clj (fressian/read-object rdr)
:cljs (r/readObject rdr)))
(defn tagged-object?
"Returns true if o is a tagged object, which will occur when
the reader does not recognized a specific type. Use tag
and tagged-value to access the contents of a tagged-object."
[o]
#?(:clj (fressian/tagged-object? o)
:cljs (instance? r/TaggedObject o)))
(defn tag
"Returns the tag if object is a tagged-object, else nil."
[o]
#?(:clj (fressian/tag o)
:cljs (get o :tag)))
(defn tagged-value
"Returns the value (an Object array) wrapped by obj, or nil
if obj is not a tagged object."
[o]
#?(:clj (fressian/tagged-value o)
:cljs (get o :value)))
(defn create-writer
"Create a fressian writer targeting out.
- :handlers is just a map of {type {'tag' write-fn}} merged with default
write handlers
- :record->name (cljs only) map of record ctor to string-name (the string
version of the record's fully resolved symbol)"
[^OutputStream out & opts]
#?(:clj (let [{:keys [handlers] :as opts} (apply hash-map opts)
handlers (write-handlers handlers)]
(fressian/create-writer out :handlers handlers))
:cljs (apply w/writer out opts)))
(defn write-object
"Write a single object to a fressian writer."
([writer o]
(assert (fressian-writer? writer))
#?(:clj (fressian/write-object writer o)
:cljs (w/writeObject writer o)))
([writer o cache?]
(assert (fressian-writer? writer))
#?(:clj (.writeObject ^FressianWriter writer o (boolean cache?))
:cljs (w/writeObject writer o cache?))))
(defn write-utf8
"write a string as raw utf-8 bytes"
([writer s](write-utf8 writer s false))
([writer s cache?]
(assert (fressian-writer? writer))
(assert (string? s))
#?(:clj (write-object writer (utf8. s) cache?)
:cljs
(binding [w/*write-raw-utf8* true
w/*write-utf8-tag* *write-utf8-tag*]
(write-object writer s cache?)))))
(defn write-tag
"for use in custom write handlers"
[writer tag field-count]
(assert (string? tag))
(assert (and (number? field-count) (<= 1 field-count)))
#?(:clj (.writeTag ^FressianWriter writer tag field-count)
:cljs (w/writeTag writer tag field-count)))
(defn write-footer
"use to seal off a writer with a final byte count & checksum for
verification by a reader. Induces EOF"
[writer]
(assert (fressian-writer? writer))
#?(:clj (fressian/write-footer writer)
:cljs (w/writeFooter writer)))
(defn reset-caches
"write a signal to the reader to forget established cache codes"
[writer]
(assert (fressian-writer? writer))
#?(:clj (.resetCaches ^FressianWriter writer)
:cljs (w/resetCaches writer)))
(defn begin-closed-list
"Begin writing a fressianed list. To end the list, call end-list.
Used to write sequential data whose size is not known in advance."
[writer]
(assert (fressian-writer? writer))
#?(:clj (fressian/begin-closed-list writer)
:cljs (w/beginClosedList writer)))
(defn end-list
"Ends a list begun with begin-closed-list."
[writer]
(assert (fressian-writer? writer))
#?(:clj (fressian/end-list writer)
:cljs (w/endList writer)))
(defn begin-open-list
"Writes fressian code to begin an open list. An
open list can be terminated either by a call to end-list,
or by simply closing the stream. Used to write sequential
data whose size is not known in advance, in contexts where
stream failure can safely be interpreted as end of list."
[writer]
(assert (fressian-writer? writer))
#?(:clj (fressian/begin-open-list writer)
:cljs (w/beginOpenList writer)))
(defn field-caching-writer
"Returns a record writer that caches values for keys
matching cache-pred, which is typically specified
as a set, e.g. (field-caching-writer #{:color})"
[cache-pred]
#?(:clj (fressian/field-caching-writer cache-pred)
:cljs
(fn [w rec record->name]
(w/writeTag w "record" 2)
(w/writeObject w (w/class-sym rec record->name) true)
(w/writeTag w "map" 1)
(w/beginClosedList w)
(doseq [[field value] rec]
(w/writeObject w field true)
(w/writeObject w value (boolean (cache-pred field))))
(w/endList w))))
(defn byte-stream []
#?(:clj (fress.impl.bytestream.)
:cljs (buf/byte-stream)))
(defn ^ByteBuffer byte-stream->buf
"Create a byte-buffer (:clj), byte-array (:cljs) from the current
internal state of a BytesOutputStream"
[^BytesOutputStream stream]
;presumably bytebuffer is preferable to byte[] on jvm
#?(:clj (ByteBuffer/wrap (.internalBuffer stream) 0 (.length stream))
:cljs (buf/toByteArray stream))) ;fixed, will not change with more writes! call again
#?(:cljs
(defn flush-to
([stream out](flush-to stream out 0))
([stream out offset]
(assert (instance? buf/BytesOutputStream stream))
(assert (some? (.-buffer out)))
(buf/flushTo stream out offset))))
#_(:cljs
(defn wrap ;TODO
([stream out])
([stream out offset])))
(defn read
"Convenience method for reading a single fressian object.
Takes same options as create-reader"
[readable & options]
#?(:clj
(.readObject ^Reader (apply create-reader (fressian/to-input-stream readable) options))
:cljs
(r/readObject (apply create-reader readable options))))
(defn read-batch
"Read a fressian reader fully (until eof), returning a (possibly empty)
vector of results."
[^Reader fin]
(assert (fressian-reader? fin))
(let [sentinel #?(:clj (Object.) :cljs #js{})]
(loop [objects (transient [])]
(let [obj #?(:clj (try (.readObject fin) (catch EOFException e sentinel))
:cljs (try (r/readObject fin) (catch js/Error e sentinel)))]
(if (= obj sentinel)
(persistent! objects)
(recur (conj! objects obj)))))))
(defn read-all
"like read-batch but accepts readables in addition to FressianReaders"
[in & options]
(if (fressian-reader? in)
(read-batch in)
(read-batch (apply create-reader in options))))
(defn write
"Convenience method for writing a single object. Returns a
byte buffer. Options are the same as for create-reader,
with one additional option :footer? {bool}, if specified will
write a fressian footer after writing the object."
[obj & options]
#?(:clj
(let [{:keys [footer?]} (apply hash-map options)
bos (BytesOutputStream.)
writer ^Writer (apply create-writer bos options)]
(.writeObject writer obj)
(when footer?
(.writeFooter writer))
(byte-stream->buf bos))
:cljs
(let [{:keys [footer?]} (when options (apply hash-map options))
bos (buf/byte-stream)
writer (apply create-writer bos options)]
(w/writeObject writer obj)
(when footer?
(w/writeFooter writer))
(buf/close bos))))