-
Notifications
You must be signed in to change notification settings - Fork 4
/
key_value.tcl
396 lines (360 loc) · 15.1 KB
/
key_value.tcl
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
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
# Copyright (c) 2023 Petro Kazmirchuk https://github.com/Kazmirchuk
# Copyright (c) 2023 ANT Solutions https://antsolutions.eu/
# Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
# Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License.
# based on https://github.com/nats-io/nats-architecture-and-design/blob/main/adr/ADR-8.md
oo::class create ::nats::key_value {
variable Conn Js Bucket Stream ReadPrefix WritePrefix UseJsPrefix UseDirect ;# mirrored_bucket
constructor {connection jet_stream domain bucket_name stream_config} {
set Conn $connection
set Js $jet_stream
set Bucket $bucket_name
set Stream "KV_$Bucket"
# since keys work on top of subjects, using mirrors, JS domains or API import prefixes affects ReadPrefix and WritePrefix
# see also nats.go, func mapStreamToKVS
# ADR-19 https://github.com/nats-io/nats-architecture-and-design/blob/main/adr/ADR-19.md
# https://github.com/nats-io/nats-architecture-and-design/issues/167
# however, ADR-8 v1.1 deprecates this approach and uses subject transforms instead
set ReadPrefix "\$KV.$Bucket"
set WritePrefix $ReadPrefix
set UseJsPrefix false
if { [$Js api_prefix] ne "\$JS.API"} {
set UseJsPrefix true
}
set UseDirect [dict get $stream_config allow_direct]
if {[dict exists $stream_config mirror name]} {
set originStream [dict get $stream_config mirror name]
set originBucket [string range $originStream 3 end] ;# remove "KV_" from "KV_bucket_name"
set WritePrefix "\$KV.$originBucket"
if {[dict exists $stream_config mirror external api]} {
set UseJsPrefix false
set ReadPrefix "\$KV.$originBucket"
set externalApi [dict get $stream_config mirror external api]
set WritePrefix "$externalApi.\$KV.$originBucket"
}
}
}
destructor {
$Js releaseRef [self]
}
method PublishToStream {key {value ""} {hdrs ""}} {
my CheckKeyName $key
if {$UseJsPrefix} {
append subject "[$Js api_prefix]."
}
append subject "$WritePrefix.$key"
set msg [nats::msg create $subject -data $value]
if {$hdrs ne ""} {
dict set msg header $hdrs
}
try {
return [$Js publish_msg $msg]
} trap {NATS ErrNoResponders} err {
throw {NATS ErrBucketNotFound} "Bucket $Bucket not found"
}
}
method get {key args} {
my CheckKeyName $key
nats::_parse_args $args {
revision pos_int ""
}
try {
return [my Get $key $revision]
} trap {NATS ErrKeyDeleted} err {
# ErrKeyDeleted is an internal error, see also 'method create'
throw {NATS ErrKeyNotFound} $err
}
}
method get_value {key args} {
dict get [my get $key {*}$args] value
}
method Get {key {revision ""}} {
set subject "$ReadPrefix.$key"
if {$UseDirect} {
set methodName stream_direct_get
} else {
set methodName stream_msg_get
}
try {
if {$revision ne ""} {
set msg [$Js $methodName $Stream -seq $revision]
# not sure under what conditions this may happen, but nats.go does this check
if {$subject ne [nats::msg subject $msg]} {
throw {NATS ErrKeyNotFound} "Expected $subject, got [nats::msg subject $msg]"
}
} else {
set msg [$Js $methodName $Stream -last_by_subj $subject]
}
} trap {NATS ErrMsgNotFound} err {
throw {NATS ErrKeyNotFound} "Key $key not found in bucket $Bucket"
} trap {NATS ErrStreamNotFound} err {
# looks like a bug or design flaw in nats-server that only STREAM.MSG.GET can reply with ErrStreamNotFound; requests to DIRECT.GET simply time out
# which is not a real problem because we get here only if somebody else deletes the bucket *after* we've bound to it
throw {NATS ErrBucketNotFound} "Bucket $Bucket not found"
}
# we know the delta only when using the KV watcher; same in nats.go
set entry [dict create \
bucket $Bucket \
key $key \
value [nats::msg data $msg] \
revision [nats::msg seq $msg] \
created [nats::isotime_to_msec [nats::msg timestamp $msg]] \
operation [nats::header lookup $msg KV-Operation PUT]]
if {[dict get $entry operation] in {DEL PURGE}} {
throw [list NATS ErrKeyDeleted [dict get $entry revision]] "Key $key was deleted or purged"
}
return $entry
}
method put {key value} {
try {
return [dict get [my PublishToStream $key $value] seq]
} trap {NATS ErrNoResponders} err {
throw {NATS ErrBucketNotFound} "Bucket $Bucket not found"
}
}
method create {key value} {
try {
return [my update $key $value 0]
} trap {NATS ErrWrongLastSequence} err {
# was the key deleted?
try {
my Get $key
# not deleted - rethrow the first error
throw {NATS ErrWrongLastSequence} $err
} trap {NATS ErrKeyDeleted} {err errOpts} {
# unlike Python, Tcl doesn't allow to pass my own data with an error
# luckily ErrKeyDeleted is internal, and all I need is a revision number
set revision [lindex [dict get $errOpts -errorcode] end]
# retry with a proper revision
return [my update $key $value $revision]
}
}
}
method update {key value revision} {
# nats.go Update doesn't use WritePrefix - seems like their bug
set header [dict create Nats-Expected-Last-Subject-Sequence $revision]
set resp [my PublishToStream $key $value $header] ;# throws ErrWrongLastSequence in case of mismatch
return [dict get $resp seq]
}
method delete {key {revision ""}} {
set header [dict create KV-Operation DEL]
if {$revision ne "" && $revision > 0} {
dict set header Nats-Expected-Last-Subject-Sequence $revision
}
my PublishToStream $key "" $header
return
}
method purge {key} {
my PublishToStream $key "" [dict create KV-Operation PURGE Nats-Rollup sub]
return
}
method revert {key revision} {
set entry [my get $key -revision $revision]
return [my put $key [dict get $entry value]]
}
method status {} {
try {
set stream_info [$Js stream_info $Stream]
} trap {NATS ErrStreamNotFound} err {
throw {NATS BucketNotFound} "Bucket $Bucket not found"
}
return [my StreamInfoToKvInfo $stream_info]
}
method watch {key_pattern args} {
set spec {callback str ""
include_history bool false
meta_only bool false
ignore_deletes bool false
updates_only bool false
values_array str ""
idle_heartbeat str null}
nats::_parse_args $args $spec
if {$include_history && $updates_only} {
throw {NATS ErrInvalidArg} "-include_history conflicts with -updates_only"
}
set deliver_policy [expr {$include_history ? "all" : "last_per_subject"}]
if {$updates_only} {
set deliver_policy "new"
}
set filter_subject "$ReadPrefix.$key_pattern"
set consumerOpts [list -description "KV watcher" -headers_only $meta_only -deliver_policy $deliver_policy -filter_subject $filter_subject]
if [info exists idle_heartbeat] {
lappend consumerOpts -idle_heartbeat $idle_heartbeat
}
set watcher [nats::kv_watcher new [self] $consumerOpts $callback $ignore_deletes $values_array]
$Js addRef $watcher
return $watcher
}
method keys {} {
set w [my watch > -ignore_deletes 1 -meta_only 1]
set ns [info object namespace $w]
set result [${ns}::my Gather keys]
$w destroy
if {[llength $result] == 0} {
throw {NATS ErrKeyNotFound} "No keys found in bucket $Bucket" ;# nats.go raises ErrNoKeysFound instead
}
return $result
}
method history {key} {
set w [my watch $key -include_history 1]
set ns [info object namespace $w]
set result [${ns}::my Gather history]
$w destroy
if {[llength $result] == 0} {
throw {NATS ErrKeyNotFound} "Key $key not found in bucket $Bucket"
}
return $result
}
method StreamInfoToKvInfo {stream_info} {
set config [dict get $stream_info config]
set isCompressed [expr {[dict lookup $config compression none] ne "none"}]
set kv_info [dict create \
bucket $Bucket \
bytes [dict get $stream_info state bytes] \
history [dict get $config max_msgs_per_subject] \
ttl [dict get $config max_age] \
values [dict get $stream_info state messages] \
is_compressed $isCompressed]
if {[dict exists $config mirror name]} {
# strip the leading "KV_"
dict set kv_info mirror_name [string range [dict get $config mirror name] 3 end]
if {[dict exists $config mirror external api]} {
# in format "$JS.some-domain.API" unless it is imported from another account
set externalApi [split [dict get $config mirror external api] .]
if {[llength $externalApi] == 3 && [lindex $externalApi 2] eq "API"} {
dict set kv_info mirror_domain [lindex $externalApi 1]
}
}
}
# do it here so that underlying stream config will be at the end
dict set kv_info stream_config [dict get $stream_info config]
dict set kv_info stream_state [dict get $stream_info state]
return $kv_info
}
method CheckKeyName {key} {
if {[string index $key 0] eq "." || \
[string index $key end] eq "." || \
[string range $key 0 2] eq "_kv" || \
![regexp {^[-/_=\.a-zA-Z0-9]+$} $key]} {
throw {NATS ErrInvalidArg} "Invalid key name $key"
}
}
}
oo::class create ::nats::kv_watcher {
# watcher options/vars
variable SubID UserCb InitDone IgnoreDeletes Gathering ResultList ValuesArray Consumer
# copied from the parent KV bucket, so that the user can destroy it while the watcher is living
variable Conn Bucket PrefixLen Js
constructor {kv consumer_opts cb ignore_del arr} {
set InitDone false ;# becomes true after the current/historical data has been received
set Gathering ""
set kvNS [info object namespace $kv]
set Conn [set ${kvNS}::Conn]
set Bucket [set ${kvNS}::Bucket]
set stream [set ${kvNS}::Stream]
set Js [set ${kvNS}::Js]
set PrefixLen [string length [set ${kvNS}::ReadPrefix]]
set UserCb $cb
set IgnoreDeletes $ignore_del
if {$arr ne ""} {
upvar 2 $arr [self namespace]::ValuesArray
}
try {
set Consumer [$Js ordered_consumer $stream -callback [nats::mymethod OnMsg] -post false {*}$consumer_opts]
} trap {NATS ErrStreamNotFound} err {
throw {NATS BucketNotFound} "Bucket $Bucket not found"
}
if {[dict get [$Consumer info] num_pending] == 0} {
after 0 [nats::mymethod InitStageDone] ;# NB do not call it directly, because the user should be able to call e.g. "history" right after "watch"
}
}
destructor {
if {[info exists Consumer]} {
$Consumer destroy ;# account for the case when ordered_consumer throws, like in test key_value_watchers-watch-5
}
$Js releaseRef [self]
}
method InitStageDone {} {
set InitDone true
if {$UserCb ne ""} {
after 0 [list {*}$UserCb ""]
}
}
method OnMsg {msg} {
set meta [::nats::metadata $msg]
set delta [dict get $meta num_pending]
set op [nats::header lookup $msg KV-Operation PUT] ;# note that normal PUT entries are delivered using MSG, so they can't have headers
if {$IgnoreDeletes} {
if {$op in {PURGE DEL}} {
if {$delta == 0 && !$InitDone} {
my InitStageDone
}
return
}
}
set key [string range [nats::msg subject $msg] $PrefixLen+1 end]
set entry [dict create \
bucket $Bucket \
key $key \
value [nats::msg data $msg] \
revision [dict get $meta stream_seq] \
created [dict get $meta timestamp] \
delta $delta \
operation $op]
switch -- $Gathering {
keys {
lappend ResultList $key
}
history {
lappend ResultList $entry
}
default {
if {$UserCb ne ""} {
after 0 [list {*}$UserCb $entry]
}
if {[info exists ValuesArray]} {
if {$op eq "PUT"} {
set ValuesArray($key) [dict get $entry value]
} else {
unset ValuesArray($key)
}
}
}
}
if {$delta == 0 && !$InitDone} {
my InitStageDone
}
}
method Gather {what} {
set Gathering $what ;# keys or history
set ResultList [list]
set timerID [after [$Js timeout] [list set [self namespace]::InitDone "timeout"]]
nats::_coroVwait [self namespace]::InitDone
if {$InitDone eq "timeout"} {
throw {NATS ErrTimeout} "Timeout while gathering $what in bucket $Bucket"
}
after cancel $timerID
return $ResultList
}
method consumer {} {
return $Consumer
}
}
proc ::nats::make_kv_origin {args} {
set spec {
stream valid_str null
bucket valid_str NATS_TCL_REQUIRED
keys str null
api valid_str null
deliver valid_str null
domain valid_str null}
nats::_parse_args $args $spec
if {[info exists domain]} {
if {[info exists api]} {
throw {NATS ErrInvalidArg} "-domain and -api are mutually exclusive"
}
set api "\$JS.$domain.API"
unset domain
}
return [nats::_local2dict $spec]
}