76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
read-test-data
read-test-data*
login
tasks-get-last
testmeta-get-record
have-incompletes?
synchash-get
get-changed-record-ids
))
(define api:write-queries
'(
get-keys-write ;; dummy "write" query to force server start
;; SERVERS
|
|
>
|
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
read-test-data
read-test-data*
login
tasks-get-last
testmeta-get-record
have-incompletes?
synchash-get
get-changed-record-ids
get-run-record-ids
))
(define api:write-queries
'(
get-keys-write ;; dummy "write" query to force server start
;; SERVERS
|
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
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
;;===============================================
|
>
>
>
>
>
|
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
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
;;===============================================
|
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
|
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params))
;; TESTMETA
((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
;;
|
|
|
>
>
>
>
>
|
>
>
>
>
|
|
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
|
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params))
((get-run-record-ids) (apply db:get-run-record-ids dbstruct params))
;; TESTMETA
((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
;;
|