(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)