| ︙ | | | ︙ | |
47
48
49
50
51
52
53
54
55
56
57
58
59
60
|
get-testinfo-state-status
test-get-top-process-pid
test-get-paths-matching-keynames-target-new
get-prereqs-not-met
get-count-tests-running-for-run-id
get-run-info
get-run-status
get-run-stats
get-run-times
get-targets
get-target
;; register-run
get-tests-tags
get-test-times
|
>
|
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
get-testinfo-state-status
test-get-top-process-pid
test-get-paths-matching-keynames-target-new
get-prereqs-not-met
get-count-tests-running-for-run-id
get-run-info
get-run-status
get-run-state
get-run-stats
get-run-times
get-targets
get-target
;; register-run
get-tests-tags
get-test-times
|
| ︙ | | | ︙ | |
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
cmd-in
(string->symbol cmd-in)))
(params (vector-ref dat 1))
(start-t (current-milliseconds))
(readonly-mode (dbr:dbstruct-read-only dbstruct))
(readonly-command (member cmd api:read-only-queries))
(writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
(res
(if writecmd-in-readonly-mode
(conc "attempt to run write command "cmd" on a read-only database")
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
|
>
>
>
>
>
|
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
|
cmd-in
(string->symbol cmd-in)))
(params (vector-ref dat 1))
(start-t (current-milliseconds))
(readonly-mode (dbr:dbstruct-read-only dbstruct))
(readonly-command (member cmd api:read-only-queries))
(writecmd-in-readonly-mode (and readonly-mode (not readonly-command)))
(foo (begin
(common:telemetry-log (conc "api-in:"(->string cmd))
payload: `((params . ,params)))
#t))
(res
(if writecmd-in-readonly-mode
(conc "attempt to run write command "cmd" on a read-only database")
(case cmd
;;===============================================
;; READ/WRITE QUERIES
;;===============================================
|
| ︙ | | | ︙ | |
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
|
((synchash-get) (apply synchash:server-get dbstruct params))
((get-raw-run-stats) (apply db:get-raw-run-stats dbstruct params))
((get-test-times) (apply db:get-test-times dbstruct params))
;; RUNS
((get-run-info) (apply db:get-run-info dbstruct params))
((get-run-status) (apply db:get-run-status dbstruct params))
((set-run-status) (apply db:set-run-status dbstruct params))
((get-tests-for-run) (apply db:get-tests-for-run dbstruct params))
((get-test-id) (apply db:get-test-id dbstruct params))
((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct params))
((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata dbstruct params))
((get-runs) (apply db:get-runs dbstruct params))
((simple-get-runs) (apply db:simple-get-runs dbstruct params))
((get-num-runs) (apply db:get-num-runs dbstruct params))
|
>
>
|
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
|
((synchash-get) (apply synchash:server-get dbstruct params))
((get-raw-run-stats) (apply db:get-raw-run-stats dbstruct params))
((get-test-times) (apply db:get-test-times dbstruct params))
;; RUNS
((get-run-info) (apply db:get-run-info dbstruct params))
((get-run-status) (apply db:get-run-status dbstruct params))
((get-run-state) (apply db:get-run-state dbstruct params))
((set-run-status) (apply db:set-run-status dbstruct params))
((set-run-state-status) (apply db:set-run-state-status dbstruct params))
((get-tests-for-run) (apply db:get-tests-for-run dbstruct params))
((get-test-id) (apply db:get-test-id dbstruct params))
((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct params))
((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata dbstruct params))
((get-runs) (apply db:get-runs dbstruct params))
((simple-get-runs) (apply db:simple-get-runs dbstruct params))
((get-num-runs) (apply db:get-num-runs dbstruct params))
|
| ︙ | | | ︙ | |
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
|
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
(else
(debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
(conc "ERROR: BAD api call " cmd))))))
;; save all stats
(let ((delta-t (- (current-milliseconds)
start-t)))
(hash-table-set! *db-api-call-time* cmd
(cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
(if writecmd-in-readonly-mode
(vector #f res)
(vector #t res)))))))
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
|
>
>
>
>
>
|
>
>
>
>
|
|
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
|
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))
(else
(debug:print 0 *default-log-port* "ERROR: bad api call " cmd)
(conc "ERROR: BAD api call " cmd))))))
;; save all stats
(let ((delta-t (- (current-milliseconds)
start-t)))
(hash-table-set! *db-api-call-time* cmd
(cons delta-t (hash-table-ref/default *db-api-call-time* cmd '()))))
(if writecmd-in-readonly-mode
(begin
(common:telemetry-log (conc "api-out:"(->string cmd))
payload: `((params . ,params)
(ok-res . #t)))
(vector #f res))
(begin
(common:telemetry-log (conc "api-out:"(->string cmd))
payload: `((params . ,params)
(ok-res . #f)))
(vector #t res))))))))
;; http-server send-response
;; api:process-request
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
|
| ︙ | | | ︙ | |