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
|
(declare (unit api))
(declare (uses rmt))
(declare (uses db))
;; These are called by the server on recipt of /api calls
(define (api:execute-requests db cmd params)
(debug:print-info 1 "api:execute-requests cmd=" cmd " params=" params)
((get-test-info-by-id) (vector->list (apply db:get-test-info-by-id db params)))
((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params))
((testmeta-get-record) (vector->list (apply db:testmeta-get-record db params)))
((test-set-state-status-by-id) (apply db:test-set-state-status-by-id db params))
;; RUNS
((get-run-info) (let ((res (apply db:get-run-info db params)))
(list (vector-ref res 0)
(vector->list (vector-ref res 1)))))
((register-run) (apply db:register-run db params))
((login) ;(apply db:login db params)
(debug:print 0 "WOOHOO: Got login") #t)
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
;; db:*
;;
|
<
|
>
|
<
|
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
|
(declare (unit api))
(declare (uses rmt))
(declare (uses db))
;; These are called by the server on recipt of /api calls
(define (api:execute-requests db cmd params)
(case (string->symbol cmd)
;; KEYS
((get-key-val-pairs) (apply db:get-key-val-pairs db params))
;; TESTS
;; json doesn't do vectors, convert to list
((get-test-info-by-id) (let ((res (apply db:get-test-info-by-id db params)))
(if (vector? res)(vector->list res) res)))
((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params))
((testmeta-get-record) (vector->list (apply db:testmeta-get-record db params)))
((test-set-state-status-by-id) (apply db:test-set-state-status-by-id db params))
;; RUNS
((get-run-info) (let ((res (apply db:get-run-info db params)))
(list (vector-ref res 0)
(vector->list (vector-ref res 1)))))
((register-run) (apply db:register-run db params))
((login) (apply db:login db params))
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
;; db:*
;;
|