You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
119 lines
3.8 KiB
119 lines
3.8 KiB
|
|
(define-module (yacswa routes)
|
|
#:use-module (artanis artanis)
|
|
#:use-module (artanis config)
|
|
#:use-module (ice-9 regex)
|
|
#:use-module (tk listlogic)
|
|
#:use-module (tk short)
|
|
#:use-module (yacswa data)
|
|
#:export (std-display))
|
|
|
|
;;TODO: Better verify functions
|
|
;; : figure out the #:mtime directive for (response-emit)
|
|
;; : Change the API around to separate expiry tagging
|
|
;; : Provide API for populating a dropdown selection for regions
|
|
;; :
|
|
;; :
|
|
|
|
;; Helpers
|
|
(define (err: text) (scm->json-string `((error . ,text))))
|
|
|
|
(define err:notfound (err: "not-found"))
|
|
(define err:invalid (err: "invalid-code"))
|
|
(define err:maintenance (err: "admin-maintenance"))
|
|
(define err:scheduled (err: "scheduled-maintenance"))
|
|
|
|
(define postal-first-digits "[ABCEGHJKLMNPRSTVXY]")
|
|
(define postal-final-digits "[ABCEGHJKLMNPRSVWXYTZ]")
|
|
|
|
(define (verify-postal code)
|
|
(regexp-match? (string-match (string-append "^" postal-first-digits
|
|
"[0-9]"
|
|
postal-final-digits "$")
|
|
code)))
|
|
|
|
(define (verify-hr code)
|
|
(regexp-match? (string-match "^[0-9][0-9][0-9][0-9]$" code)))
|
|
|
|
;; Init
|
|
|
|
;; Artanis steals stdout/stderr
|
|
(define std-display
|
|
(let ((stdout (current-output-port)))
|
|
(lambda (obj)
|
|
(display obj stdout))))
|
|
|
|
(display "Calling init-server...\n")
|
|
(init-server #:statics '(png jpg jpeg ico html js css)
|
|
#:cache-statics? #t #:exclude '())
|
|
(display "Artanis initialized!\n")
|
|
(display "Setting routes...")
|
|
|
|
;; Routes
|
|
(get "/json/pc/:pc"
|
|
(lambda (rc)
|
|
(response-emit
|
|
(case (who-locked?)
|
|
((admin) err:maintenance)
|
|
((mcron) err:scheduled)
|
|
(else (let ((pc (string-upcase! (params rc "pc"))))
|
|
(if (verify-postal pc)
|
|
(if-some-else (get-by-postal pc)
|
|
err:notfound)
|
|
err:invalid))))
|
|
#:status 200 #:headers '((content-type . (application/json))))))
|
|
|
|
(get "/json/hr/:hr"
|
|
(lambda (rc)
|
|
(response-emit
|
|
(case (who-locked?)
|
|
((admin) err:maintenance)
|
|
((mcron) err:scheduled)
|
|
(else (let ((hr (params rc "hr")))
|
|
(if (verify-hr hr)
|
|
(if-some-else (get-by-hr hr)
|
|
err:notfound)
|
|
err:invalid))))
|
|
#:status 200 #:headers '((content-type . (application/json))))))
|
|
|
|
(post "/json/batch" #:from-post 'json
|
|
(lambda (rc)
|
|
(response-emit
|
|
(case (who-locked?)
|
|
((admin) err:maintenance)
|
|
((mcron) err:scheduled)
|
|
(else (let-values (((pc-list hr-list)
|
|
(:from-post rc 'get-vals "pc-list" "hr-list")))
|
|
(let* ((hrs (string-join
|
|
(map (lambda (hr) (if-some-else (get-by-hr hr)
|
|
err:notfound))
|
|
hr-list)
|
|
","))
|
|
(pcs (string-join
|
|
(map (lambda (pc) (if-some-else (get-by-pc pc)
|
|
err:notfound))
|
|
pc-list)
|
|
",")))
|
|
(string-append "[" (string-join (list hrs pcs) ",") "]")))))
|
|
#:status 200 #:headers '((content-type . (application/json))))))
|
|
|
|
(get "/update/last"
|
|
(lambda (rc)
|
|
(number->string $base-time)))
|
|
|
|
(get "/update/next"
|
|
(lambda (rc)
|
|
(number->string $expiry-timestamp)))
|
|
|
|
(get "/update/delta"
|
|
(lambda (rc)
|
|
(number->string (next-timestamp))))
|
|
|
|
(get "/update/status"
|
|
(lambda (rc)
|
|
(case (updated?)
|
|
((#t) "Updated")
|
|
((#f) "Expecting"))))
|
|
|
|
(std-display "done.\n")
|