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.
114 lines
3.8 KiB
114 lines
3.8 KiB
(use-modules (system repl server))
|
|
|
|
;;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
|
|
;; :
|
|
;; :
|
|
|
|
;; Backchannel
|
|
(define repl-sock (make-unix-domain-server-socket #:path "./bc"))
|
|
(spawn-server repl-sock)
|
|
|
|
;; endpoint 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 (get-by-postal code)
|
|
(let* ((pc-sym (ssa> "PC" code))
|
|
(hr-sym (car (if-some-else (symbol-fref pc-sym) '(ndef)))))
|
|
(symbol-property hr-sym 'json-string)))
|
|
|
|
(define (verify-hr code)
|
|
(regexp-match? (string-match "^[0-9][0-9][0-9][0-9]$" code)))
|
|
|
|
(define (get-by-hr code)
|
|
(let ((hr-sym (ssa> "HR" code)))
|
|
(symbol-property hr-sym 'json-string)))
|
|
|
|
;; endpoints
|
|
(init-server #:statics '(png jpg jpeg ico html js css)
|
|
#:cache-statics? #t #:exclude '())
|
|
|
|
(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"))))
|
|
|
|
;; No SSL. Sad.
|
|
(run #:port 1665)
|